procedure TDownloadThread.Execute;
var
BMP: TBitMap;
i,x:integer;
exitloop:boolean;
tempname:string;
begin
Bmp := TBitmap.Create;
repeat
application.processmessages;
sleep(1000);
for x := 0 to dlimagelist[tbaseindex][myindex].count-1 do begin
sleep(100);
application.processmessages;
bmp.Assign( nil );
// addlog('Download Image ' +dlpath[tbaseindex].Strings[x] +' '+dlname[tbaseindex].Strings[x] +' in thread'+inttostr(tbaseindex)+'-'+inttostr(myindex));
//downloadimage(dlimagelist[tbaseindex][myindex].strings[x],bmp);
if(downloadimage(dlimagelist[tbaseindex][myindex].strings[x],bmp)) then begin
tempname := inttostr(Math.RandomRange(99999,9999999));
// addlog('Save to : ' +dlpath[tbaseindex].Strings[x]+'/'+dlemail[tbaseindex].Strings[x]+'/'+dlname[tbaseindex].Strings[x]+'/tempimages/');
try
bmp.Canvas.Lock;
ResizeBitmap(bmp,50,50,clblack);
bmp.SaveToFile(dlpath[tbaseindex]+'/'+dlemail[tbaseindex]+'/'+dlname[tbaseindex]+'/'+inttostr(myindex)+dlname[tbaseindex]+inttostr(x)+dlcount[tbaseindex]+tempname+'.bmp');
bmp.canvas.Unlock;
tempname := '';
except
end;
end else begin
//addlog('Couldnt download image');
end;
exitloop := true;
end;//loop
if(exitloop) then begin
exitloop := false;
dlimagelist[tbaseindex][myindex].clear;
end;
until terminated;
bmp.Free;
end;
procedure TDownloadThread.ResizeBitmap(Bitmap: TBitmap; Width, Height: Integer; Background: TColor);
var
R: TRect;
B: TBitmap;
X, Y: Integer;
begin
B:= TBitmap.Create;
try
R.Right:= 50;//((Height * Bitmap.Width) div Bitmap.Height);
R.Bottom:= Height;
X:= (Width div 2) - (R.Right div 2);
Y:= 0;
R.Left:= 0;
R.Top:= 0;
B.PixelFormat:= Bitmap.PixelFormat;
B.Width:= Width;
B.Height:= Height;
B.Canvas.Brush.Color:= Background;
b.Canvas.Lock;
B.Canvas.FillRect(B.Canvas.ClipRect);
B.Canvas.StretchDraw(R, Bitmap);
b.Canvas.Unlock;
Bitmap.Width:= Width;
Bitmap.Height:= Height;
Bitmap.Canvas.Brush.Color:= Background;
bitmap.Canvas.Lock;
Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
Bitmap.Canvas.Draw(X, Y, B);
bitmap.canvas.Unlock;
except
addlog('Couldnt resize');
end;
B.Free;
//bitmap.free;
end;
function TDownloadThread.DownloadImage(CONST URL : STRING; theimage:tbitmap):boolean;
VAR
HTTP:THTTPSend;
JpgImage: TJPEGImage;
timeout:integer;
sl:TStringList;
retries:integer;
begin
retries := 1;
HTTP:=THTTPSend.Create;
sl := tStringList.Create;
Repeat
HTTP.UserAgent := 'Mozilla/5.0 (Windows NT 6.3; WOW64; rv:35.0) Gecko/20100101 Firefox/35.0';
HTTP.KeepAlive := true;
HTTP.KeepAliveTimeout := connecttimeout;
HTTP.Timeout := connecttimeout;
HTTP.TargetPort := '80';
HTTP.TargetHost := url;
HTTP.Protocol :='1.1';
HTTP.MimeType :='application/x-www-form-urlencoded';
http.Sock.HTTPTunnelTimeout := connecttimeout;
http.Sock.SocksTimeout := connecttimeout;
http.Sock.SetRecvTimeout(readtimeout);
HTTP.HTTPMETHOD('GET',url);
if((http.Sock.LastError <> 0) or (http.Document.Size <= 0)) then begin
addlog('ImageGETerror: '+http.Sock.LastErrorDesc);
http.sock.ResetLastError;
inc(retries);
sleep(1000);
end else begin
http.Document.Position := 0;
try
sl.Clear;
sl.loadfromstream(http.document);
except
end;
if(pos('Reference&',sl.text) > 0 )then begin
result := false;
//addlog('Error: Image does not exist on server.');
end else begin
try
JpgImage := TJPEGImage.Create;
http.Document.Position := 0;
JpgImage.LoadFromStream(http.document);
theimage.Assign(JpgImage);
jpgimage.Free;
result := true;
except
result := false;
end; //excep
end;//reference
end;
until ((http.Sock.LastError = 0) or (http.Document.Size > 0)) or (retries > 3);
try
http.Sock.CloseSocket;
http.Clear;
http.Free;
sl.Free;
except
end;
END;
Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.
When asked, what has been your best career decision?
Deciding to stick with EE.
Being involved with EE helped me to grow personally and professionally.
Connect with Certified Experts to gain insight and support on specific technology challenges including:
We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE