Link to home
Start Free TrialLog in
Avatar of nickdelphi777
nickdelphi777

asked on

Can you spot any memory leaks in these functions?

Can you spot any memory leaks in this code? RAM seems pretty stable.. but after downloading around 200,000 images it crashes with a "out of memory" message.. even though the ram is still stable.

Please help..

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;

Open in new window

Avatar of jimyX
jimyX

> but after downloading around 200,000 images it crashes with a "out of memory" message.
You created 200,000 threads? A thread for each image you download?

How may threads you create and how many concurrent threads are running?

Did you try limiting the created threads?

If your code works for few threads, then there is no problem in your code. Creating too many threads, that is the exact problem.
Avatar of nickdelphi777

ASKER

No of course not, I was using 30 threads and each thread has 10 worker threads under it.

I re-use the same 10 worker threads over and over.. when i was destroying and recreating threads i noticed too many memory issues.
What version of Delphi are you using?
ASKER CERTIFIED SOLUTION
Avatar of jimyX
jimyX

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Also, instead of "Object.free;" use "FreeAndNil(Object);

Out of curiosity, why do you advice this?
FreeAndNil is safer than free, specially when objects are reused.
The only time when FreeAndNil() has additional value is when you free a non local object which you test later for nil (if assigned()), which is not the case here. FreeAndNil() is not safer in any way then Free().
You are right if you have a simple structured application. But for potentially refactored code I recommend using FreeAndNil for the Objects.
Besides, there is no harm in ensuring you free'd and nil'd your objects.
True, that it's no harm. I personally only use it when it has additional value, that way it serves a documentation function as well (if I see FreeAndNil() I know that I need to be aware that object will be reused).
There is a big discussion, lot of talks about using FreeAndNil vs. Free.
Some intend to use Free and some recommend FreeAndNil (me included in this last), as long as the var in question is TObject descendent.

I remember reading something about this in About.com, will look for it later.
ever heard of try finally ?
> I don't see it being used ... so if you get an error ... free might not get called

bm : =TBitmap.Create;
try
  ... raise an error

finally
  bm.Free;
end;

Open in new window


and indenting ? 2 or 3 spaces doesn't matter
the code is awful for reading
looking at my code ... i know at a glance when i have a leak
just with correct indenting
Can you please answer what Delphi version you are running?