Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2006.03.26;
Скачать: [xml.tar.bz2];

Вниз

Утечка памяти при поиске файлов.   Найти похожие ветки 

 
pargo ©   (2006-02-18 18:04) [0]

Здравствуйте !
Для поиска файлов использую следующую процедуру:

procedure FindMaskFilesRec(const PrimaryPath,Mask:string;List:TStrings);
var
Source:string;      
SearchRec:TSearchRec;
begin
FindFirst(PrimaryPath+"*",faAnyFile,SearchRec);
if MatchesMask(SearchRec.Name,Mask) then
 if not((SearchRec.Attr and faDirectory)=faDirectory) then
  begin
   Source:=PrimaryPath+ExtractFileName(SearchRec.Name);
   List.Add(Source);
  end;
while FindNext(SearchRec)=0 do
 if MatchesMask(SearchRec.Name,Mask) then
  if not((SearchRec.Attr and faDirectory)=faDirectory) then
   begin
    Source:=PrimaryPath+ExtractFileName(SearchRec.Name);
    List.Add(Source);
   end;
SysUtils.FindClose(SearchRec);
FindFirst(PrimaryPath+"*",faAnyFile,SearchRec);
if ((SearchRec.Attr and faDirectory)=faDirectory)
 and(SearchRec.Name<>".")
 and(SearchRec.Name<>"..") then FindMaskFilesRec(PrimaryPath+SearchRec.Name+PathDelim,Mask,List);
while FindNext(SearchRec)=0 do
 if ((SearchRec.Attr and faDirectory)=faDirectory)
  and(SearchRec.Name<>".")
  and(SearchRec.Name<>"..") then FindMaskFilesRec(PrimaryPath+SearchRec.Name+PathDelim,Mask,List);
SysUtils.FindClose(SearchRec);
end;


При ее использовании происходит утечка памяти.
Не могу понять почему. Вроде все освобождается...
Подскажите, что надо в процедуре исправить, чтобы избежать этого.


 
Palladin ©   (2006-02-18 18:07) [1]

:) ну а то что List заполняется ты не учитываешь?


 
pargo ©   (2006-02-18 18:13) [2]

Учитываю. Ставлю маску так, чтобы файлы не находились.
Все равно память растет, причем размер прироста зависит от
количества перебираемых файлов. :(((


 
Palladin ©   (2006-02-18 18:17) [3]

попробуй эту

Procedure vtGetFilesList(Const p_strMask,p_strRootPath:String;p_cstrList:TStringList;p_isRecurse:Boolean=False) ;
Var
rSearch:TSearchRec;
cstrDirList:TStringList;
I:Integer;
Begin
If p_isRecurse Then cstrDirList:=TStringList.Create Else cstrDirList:=Nil;
If FindFirst(p_strRootPath+p_strMask,faAnyFile,rSearch)=0 Then
 Repeat
  If (rSearch.Name<>".") and (rSearch.Name<>"..") Then
   If ((rSearch.Attr and faDirectory)=faDirectory) And p_isRecurse
    Then cstrDirList.Add(rSearch.Name)
    Else p_cstrList.Add(p_strRootPath+rSearch.Name)
 Until FindNext(rSearch)<>0;
FindClose(rSearch);
If p_isRecurse Then
 Begin
  For I:=0 To cstrDirList.Count-1 Do vtGetFilesList(p_strMask,p_strRootPath+cstrDirList[i]+"\",p_cstrList,True);
  cstrDirList.Free;
 End;
End;


 
pargo ©   (2006-02-18 18:21) [4]

Сейчас попробую.


 
pargo ©   (2006-02-18 18:30) [5]

Palladin ©   (18.02.06 18:17) [3]
С твоей процедурой все в полном порядке...


 
pargo ©   (2006-02-18 18:41) [6]

Все-таки интересно: что в моей не так ?


 
Anatoly Podgoretsky ©   (2006-02-18 20:21) [7]

А где в твоей FindClose


 
pargo ©   (2006-02-18 23:59) [8]

Anatoly Podgoretsky ©   (18.02.06 20:21) [7]
После каждого FindFirst


 
Джо ©   (2006-02-19 00:13) [9]

> [6] pargo ©   (18.02.06 18:41)
> Все-таки интересно: что в моей не так ?

По меньшей мере, в коде одна ошибка есть: не проверяется результат вызова FindFirst. Дальше даже можно не смотреть, наверняка есть и другие погрешности. Приведи сначала код в порядок, да заодно избавься от дублирования кода.


 
API   (2006-02-19 01:06) [10]

К слову. Я вот думаю, может, выйти с предложением выкинуть try...finally...end из языка в связи с невостребованностью?



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2006.03.26;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.033 c
15-1141630533
McSimm
2006-03-06 10:35
2006.03.26
Тэг <canvas>


15-1141060496
I am
2006-02-27 20:14
2006.03.26
Оптимальный вариант проверки подлинности


3-1138708213
Андрей1223
2006-01-31 14:50
2006.03.26
Добавление в запрос сравнения с текущей датой Опции


2-1141896174
kyn66
2006-03-09 12:22
2006.03.26
Проверка активности элементов


8-1129624851
Chaser
2005-10-18 12:40
2006.03.26
Как правильно открыть, сжать и сохранить JPEG?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский