Recent

Author Topic: [SOLVED] TStringList.free does not really release memory?  (Read 644 times)

senglit

  • Jr. Member
  • **
  • Posts: 55
[SOLVED] TStringList.free does not really release memory?
« on: April 26, 2020, 08:39:51 pm »
Hi all,

I have a procedure which is to find some files' location in a folder. The structure of the folder is already known so that I used some TStringList to store the result of each step. There are more than 20,000 subfolders in the sRootDir. And the number of subfolders will grows up very quickly(aroud 500 more per day). So I checked carefull if I use TStringList.Free procedure.

But still, every time when this procedure is called (around 1 time per 1 minute), I can see the used memory growing quickly (90MByte more after each calling) in windows task manager.

Please help me to check if I made some stupid mistakes. Thanks

Code: Pascal  [Select][+][-]
  1. procedure SearchFile(sRootDir: string);
  2. var
  3.   Found: integer;
  4.   SearchRec: TSearchRec;
  5.   i,j:integer;
  6.   SiteFolders,DayFolders,HourFolders,AudioFolders: TStringList;
  7. begin
  8.   SiteFolders:=TStringList.Create;  
  9.   DayFolders:=TStringList.Create;
  10.   HourFolders:=TStringList.Create;
  11.   AudioFolders:=TStringList.Create;
  12.   DoneFileList.Clear;
  13.   AudioFileList.Clear;
  14.   DataFileList.Clear;
  15.   Found := FindFirst(sRootDir + '\*', faDirectory, SearchRec);    
  16.   while Found = 0 do
  17.   begin
  18.     if  (SearchRec.Name <> '.') and  (SearchRec.Name <> '..') then
  19.     begin
  20.       SiteFolders.Add(sRootDir + '\'+SearchRec.Name);
  21.     end;
  22.     Found := FindNext(SearchRec);
  23.   end;
  24.   FindClose(SearchRec);
  25.  
  26.   for i:=0 to SiteFolders.Count-1 do
  27.   begin
  28.     Found := FindFirst(SiteFolders[i]+'\*', faDirectory, SearchRec);    
  29.     while Found = 0 do
  30.     begin
  31.       if  (SearchRec.Name <> '.') and  (SearchRec.Name <> '..') then
  32.       begin
  33.         DayFolders.Add(SiteFolders[i]+'\'+SearchRec.Name);
  34.       end;
  35.       Found := FindNext(SearchRec);
  36.     end;
  37.   end;
  38.   FindClose(SearchRec);
  39.  
  40.   for i:=0 to DayFolders.Count-1 do
  41.   begin
  42.     Found := FindFirst(DayFolders[i]+'\*', faDirectory, SearchRec);    
  43.     while Found = 0 do
  44.     begin
  45.       if  (SearchRec.Name <> '.') and  (SearchRec.Name <> '..') then
  46.       begin
  47.         HourFolders.Add(DayFolders[i]+'\'+SearchRec.Name);
  48.       end;
  49.       Found := FindNext(SearchRec);
  50.     end;
  51.   end;
  52.   FindClose(SearchRec);
  53.  
  54.   for i:=0 to HourFolders.Count-1 do
  55.   begin
  56.     Found := FindFirst(HourFolders[i]+'\*', faAnyFile, SearchRec);
  57.     while Found = 0 do
  58.     begin
  59.       if (SearchRec.Attr = faDirectory) then
  60.       begin
  61.          if (SearchRec.Name = 'Audio') then            
  62.          begin
  63.            AudioFolders.Add(HourFolders[i]+'\'+SearchRec.Name);
  64.          end;
  65.       end
  66.       else begin                                    
  67.         for j:=0 to DATA_TYPES.Count-1 do
  68.         begin
  69.           if (DATA_TYPES[j]+'.bid' = SearchRec.Name) then                        
  70.             if FileExists(HourFolders[i]+'\'+SearchRec.Name+'.done') then        
  71.             begin
  72.               DoneFileList.Add(HourFolders[i]+'\'+SearchRec.Name+'.done');
  73.             end
  74.             else begin
  75.               DataFileList.Add(HourFolders[i] + '\' + SearchRec.Name);
  76.               Inc(DataFileCount);
  77.             end;
  78.         end;
  79.       end;
  80.       Found := FindNext(SearchRec);
  81.     end;
  82.   end;
  83.   FindClose(SearchRec);
  84.  
  85.   for i:=0 to AudioFolders.Count-1 do
  86.   begin
  87.     Found := FindFirst(AudioFolders[i]+'\*', faAnyFile, SearchRec);
  88.     while Found = 0 do
  89.     begin
  90.       if RightStr(SearchRec.Name,4)='.bid' then                              
  91.         if FileExists(AudioFolders[i]+'\'+SearchRec.Name+'.done') then      
  92.         begin
  93.           DoneFileList.Add(AudioFolders[i]+'\'+SearchRec.Name+'.done');
  94.         end
  95.         else begin
  96.           AudioFileList.Add(AudioFolders[i] + '\' + SearchRec.Name);
  97.         end;
  98.       Found := FindNext(SearchRec);
  99.     end;
  100.   end;
  101.   FindClose(SearchRec);
  102.  
  103.   SiteFolders.Free;
  104.   DayFolders.Free;
  105.   HourFolders.Free;
  106.   AudioFolders.Free;
  107. end;            
  108.  

DoneFileList, DataFileList and AudioFolders are global vars.
« Last Edit: April 27, 2020, 09:30:14 am by senglit »
I use Win10 + Lazarus 2.0.6 + FPC 3.0.4. All 64bit.

bytebites

  • Sr. Member
  • ****
  • Posts: 281
Re: TStringList.free does not really release memory?
« Reply #1 on: April 26, 2020, 08:48:49 pm »
Code: Pascal  [Select][+][-]
  1.  
  2.   for i:=0 to SiteFolders.Count-1 do
  3.   begin
  4.     Found := FindFirst(SiteFolders[i]+'\*', faDirectory, SearchRec);    
  5.     while Found = 0 do
  6.     begin
  7.       if  (SearchRec.Name <> '.') and  (SearchRec.Name <> '..') then
  8.       begin
  9.         DayFolders.Add(SiteFolders[i]+'\'+SearchRec.Name);
  10.       end;
  11.       Found := FindNext(SearchRec);
  12.     end;
  13.     FindClose(SearchRec);<-- move within for loop
  14.   end;
  15.  
  16.  

furious programming

  • Sr. Member
  • ****
  • Posts: 422
  • I click a little.
    • TreeStructInfo — format for text and binary configuration files
Re: TStringList.free does not really release memory?
« Reply #2 on: April 26, 2020, 09:19:03 pm »
Shorter, safer and more readable usage of the FindFirst, FindNext and FindClose looks like this:

Code: Pascal  [Select][+][-]
  1. if FindFirst({parameters}) = 0 then
  2. try
  3.   repeat
  4.     {usage of the found item}
  5.   until FindNext({parameter}) <> 0;
  6. finally
  7.   FindClose({parameter});
  8. end;

Follow this schema — you will avoid memory leaks.
« Last Edit: April 26, 2020, 09:25:19 pm by furious programming »
Lazarus 2.0.6 with FPC 3.0.4 (SVN Revision 62129), Windows XP (all 32-bit)

senglit

  • Jr. Member
  • **
  • Posts: 55
Re: TStringList.free does not really release memory?
« Reply #3 on: April 27, 2020, 06:25:06 am »
Code: Pascal  [Select][+][-]
  1.  
  2.   for i:=0 to SiteFolders.Count-1 do
  3.   begin
  4.     Found := FindFirst(SiteFolders[i]+'\*', faDirectory, SearchRec);    
  5.     while Found = 0 do
  6.     begin
  7.       if  (SearchRec.Name <> '.') and  (SearchRec.Name <> '..') then
  8.       begin
  9.         DayFolders.Add(SiteFolders[i]+'\'+SearchRec.Name);
  10.       end;
  11.       Found := FindNext(SearchRec);
  12.     end;
  13.     FindClose(SearchRec);<-- move within for loop
  14.   end;
  15.  
  16.  

It works perfectly! Thank you.

But I'm still confused that even I put this FindClose at wrong pace, I still called it before the procedure is finished. So, the used memory will growing when the procedure is called, but it should be released before the 'end;'. Maybe there is something I don't know about TSearchRec?
« Last Edit: April 27, 2020, 06:57:59 am by senglit »
I use Win10 + Lazarus 2.0.6 + FPC 3.0.4. All 64bit.

senglit

  • Jr. Member
  • **
  • Posts: 55
Re: TStringList.free does not really release memory?
« Reply #4 on: April 27, 2020, 06:26:09 am »
Shorter, safer and more readable usage of the FindFirst, FindNext and FindClose looks like this:

Code: Pascal  [Select][+][-]
  1. if FindFirst({parameters}) = 0 then
  2. try
  3.   repeat
  4.     {usage of the found item}
  5.   until FindNext({parameter}) <> 0;
  6. finally
  7.   FindClose({parameter});
  8. end;

Follow this schema — you will avoid memory leaks.

Yes it looks more beautifull indeed. Thanks!
I use Win10 + Lazarus 2.0.6 + FPC 3.0.4. All 64bit.

PascalDragon

  • Hero Member
  • *****
  • Posts: 1698
  • Compiler Developer
Re: TStringList.free does not really release memory?
« Reply #5 on: April 27, 2020, 09:22:31 am »
But I'm still confused that even I put this FindClose at wrong pace, I still called it before the procedure is finished. So, the used memory will growing when the procedure is called, but it should be released before the 'end;'. Maybe there is something I don't know about TSearchRec?

Each call to FindFirst results in the creation of a new TSearchRec. The function does not care about what you pass in, so a previously initialized TSearchRec will leak. As you did so in your loop each loop run except for the last you leaked a TSearchRec.

furious programming

  • Sr. Member
  • ****
  • Posts: 422
  • I click a little.
    • TreeStructInfo — format for text and binary configuration files
Re: [SOLVED] TStringList.free does not really release memory?
« Reply #6 on: April 27, 2020, 02:55:32 pm »
In addition, if you iterate over all the elements of a given collection (e.g. list or array), you can use the for in loop — it will be easier to use the iterator, and the code itself will be shorter. So, in summary, you can do it in this way:

Code: Pascal  [Select][+][-]
  1. var
  2.   Folder: String;
  3.  
  4. {..}
  5.  
  6. for Folder in SiteFolders do
  7.   if FindFirst(Folder + '\*', faDirectory, SearchRec) = 0 then
  8.   try
  9.     repeat
  10.       if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
  11.         DayFolders.Add(Folder + '\' + SearchRec.Name);
  12.     until FindNext(SearchRec) <> 0;
  13.   finally
  14.     FindClose(SearchRec);
  15.   end;
Lazarus 2.0.6 with FPC 3.0.4 (SVN Revision 62129), Windows XP (all 32-bit)

senglit

  • Jr. Member
  • **
  • Posts: 55
Re: [SOLVED] TStringList.free does not really release memory?
« Reply #7 on: April 28, 2020, 08:21:53 am »
In addition, if you iterate over all the elements of a given collection (e.g. list or array), you can use the for in loop — it will be easier to use the iterator, and the code itself will be shorter. So, in summary, you can do it in this way:

Code: Pascal  [Select][+][-]
  1. var
  2.   Folder: String;
  3.  
  4. {..}
  5.  
  6. for Folder in SiteFolders do
  7.   if FindFirst(Folder + '\*', faDirectory, SearchRec) = 0 then
  8.   try
  9.     repeat
  10.       if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
  11.         DayFolders.Add(Folder + '\' + SearchRec.Name);
  12.     until FindNext(SearchRec) <> 0;
  13.   finally
  14.     FindClose(SearchRec);
  15.   end;

Rewrote the code following your instruction. It looks much beter now. Thanks
I use Win10 + Lazarus 2.0.6 + FPC 3.0.4. All 64bit.

 

TinyPortal © 2005-2018