Cześć.
Poniższy kod działa i robi to, co chcę. Czyli dostosowany do WinAPI - pobiera obrazek JPEG i pokazuje go dla testów w kontrolce typu TImage (docelowo będę go oczywiście rysować na kontrolce nie VCL-'owej). Jednak nigdy nie wiem i nie umiem używać narzędzi do tego by sprawdzić czy mam gdzieś wyciek pamięci czy nie. Po prostu nie posługiwałem się często funkcjami "z serii" ...Memory. Gdzie i jak powinienem tutaj dać FreeMem. I jeżeli dostrzegacie jeszcze jakieś inne błędy, to dajcie mi proszę znać. Z góry dziękuję i sorry za lamienie, ale nawet udzielającym się tutaj często zdarzają się zaćmienia. A i nie we wszystkich niuansach znanego nam języka musimy być perfekcyjni :)
//...
uses
ActiveX, simpletcp;
var
FWidth, FHeight : integer; // To i tak później będzie obsłużone w osobnej klasie jako jej właśności.
type
TArrayOfBytes = array of Byte;
const
WWW_Prefix = 'www.';
IID_IPicture : TGUID =
(D1 : $7BF80980; D2 : $BF32; D3 : $101A;
D4 : ($8B, $BB, $00, $AA, $00, $30, $0C, $AB));
Default_Http_Port = 80;
Http_Prefix = 'http:'#47#47;
Opera_UserAgent = 'Opera/9.80 (Windows NT 6.1) Presto/2.12.388 Version/12.16';
function LoadGfxFromBytesArrayToBitmap(BytesArr : TArrayOfBytes; var ResBmp : HBITMAP) : boolean;
var
Pic : IPicture;
ArrSize : DWORD;
DIB : TDIBSection;
FBitmap : THandle;
PStream : IStream;
GlobalH : HGLOBAL;
DestData : Pointer;
begin
Pic := nil;
ResBmp := 0;
ArrSize := Length(BytesArr);
GLobalH := GlobalAlloc(GMEM_MOVEABLE or GMEM_NODISCARD, ArrSize);
Result := GlobalH > 0;
if Result then
begin
GlobalH := GlobalAlloc(GMEM_MOVEABLE, ArrSize);
DestData := GlobalLock(GlobalH);
CopyMemory(DestData, @BytesArr[0], ArrSize);
GlobalUnlock(GlobalH);
Result := CreateStreamOnHGlobal(GlobalH, True, PStream) = S_OK;
if Result then
begin
Result := OleLoadPicture(PStream, 0, False, IID_IPicture, Pic) = S_OK;
if Result then
begin
Pic.get_Handle(FBitmap);
GetObject(FBitmap, SizeOf(DIB), @DIB);
FWidth := dib.dsBm.bmWidth;
FHeight := dib.dsBm.bmHeight;
end;
FBitmap := CopyImage(FBitmap, IMAGE_BITMAP, FWidth, FHeight, LR_COPYRETURNORG);
ResBmp := FBitmap;
end;
GlobalFree(GLobalH);
end;
end;
function GetOnlyHostName(Url : string; OnlyDomain : boolean) : string;
var
I, Cnt : integer;
AddWWWPrefix : boolean;
begin
Url := AnsiLowerCase(Url);
if Pos(Http_Prefix, Url) = 1 then
begin
Delete(Url, 1, Length(Http_Prefix));
end;
if not OnlyDomain then
begin
AddWWWPrefix := Pos(WWW_Prefix, Url) = 1;
if AddWwwPrefix then
begin
Delete(Url, 1, Length(WWW_Prefix));
end;
I := Pos('/', Url);
if (I > 0) then
begin
I := I - 1;
end
else
begin
I := Length(Url);
end;
Result := Copy(Url, 1, I);
end
else
begin
AddWWWPrefix := Pos(WWW_Prefix, Url) = 1;
if AddWWWPrefix then
begin
Delete(Url, 1, Length(WWW_Prefix));
end;
I := Pos('/', Url);
if (I > 0) then
begin
I := I - 1;
end
else
begin
I := Length(Url);
end;
Url := Copy(Url, 1, I);
Cnt := 0;
for I := Length(Url) downto 1 do
begin
if Url[I] = '.' then
begin
Cnt := Cnt + 1;
if Url[I - 1] = '.' then
begin
Url[I - 1] := '\';
end;
end;
if Cnt > 1 then
begin
Break;
end;
end;
Delete(Url, 1, I);
repeat
Cnt := Pos('\', Url);
if Cnt > 0 then
begin
Delete(Url, Cnt, 1);
end;
until Cnt = 0;
Result := Url;
end;
end;
function DownloadFileFromWeb(Url : string; var Arr : TArrayOfBytes) : boolean;
const
Content_Length_Prefix = 'Content-Length: ';
var
Clnt : TTcpClient;
//BytesWritten : DWORD;
Header, OnlyHost, S : string;
Buffer : array[0..65535 - 1] of Byte;
Cnt, SlashPos, Tmp, DownloadedBytes, TotalFileSize : integer;
begin
TotalFileSize := 0;
OnlyHost := GetOnlyHostName(Url, False);
if Pos(Http_Prefix, Url) = 1 then
begin
Delete(Url, 1, Length(Http_Prefix));
end;
SlashPos := Pos('/', Url);
if SlashPos > 0 then
begin
Url := Copy(Url, SlashPos, MaxInt);
end;
Clnt := TTcpClient.Create(OnlyHost, Default_Http_Port);
Clnt.Timeout := 500;
Clnt.WriteLn('GET ' + Url + ' HTTP/1.0' + CRLF + 'Host: ' + OnlyHost +
CRLF + 'User-Agent: ' + Opera_UserAgent + CRLF);
Header := '';
repeat
Clnt.ReadLn(S);
Header := Header + S + CRLF;
until S = '';
Tmp := Pos(Content_Length_Prefix, Header);
if Tmp > 0 then
begin
Tmp := Tmp + Length(Content_Length_Prefix);
Header := Copy(Header, Tmp, MaxInt);
Tmp := 1;
while Header[Tmp] <> CR do
begin
Tmp := Tmp + 1;
end;
Delete(Header, Tmp, MaxInt);
Val(Header, TotalFileSize, Tmp);
end;
Result := TotalFileSize > 0;
if Result then
begin
SetLength(Arr, TotalFileSize);
DownloadedBytes := 0;
repeat
Cnt := Clnt.Read(Buffer, SizeOf(Buffer));
MoveMemory(@Arr[DownloadedBytes], @Buffer[0], Cnt);
DownloadedBytes := DownloadedBytes + Cnt;
until DownloadedBytes = TotalFileSize;
end;
Clnt.Free;
end;
procedure TForm1.Button5Click(Sender : TObject);
var
BmpH : HBITMAP;
a : TArrayOfBytes;
begin
DownloadFileFromWeb('http://www.gover.pl/userfiles/publikacje/szczecin.jpg', a);
LoadGfxFromBytesArrayToBitmap(a, BmpH);
Image1.Picture.Bitmap.Handle := BmpH;
end;