Утечка памяти out of memory

Taras2020 · #1 28.01.2018, 22:10

Добрый день, уважаемые пользователи.
Суть проблемы: При запуске процедуры идет работа в файле размеров в .... мегабайт. И после 5 секунд выскакивает окно out of memory. Хотя файлы до 200 мегабайт нормально.

Я так понял что это из за недостатка выделенной памяти на массив, строку. Какие ошибки допущены в коде и как решить эту проблему?

Код:

procedure Tfrm_Main.Run;
var afList: TStringDynArray;
    i, j, k: integer;
    L, rL, fL: TStringList;
    NewName, tmp: String;

begin
 memo_Log.Lines.Add(Format('Начало обработки: %s', [DateTimeToStr(Now)]));
 memo_Log.Lines.Add('///');
 memo_Log.Lines.Add('');
 L := TStringList.Create;
 for i := 0 to memo_Folders.Lines.Count - 1 do
  
begin
   afList := TDirectory.GetFiles(memo_Folders.Lines[i], '*.txt', SO);
   for j := 0 to Length(afList) - 1 do
    L.Add(afList[j]);
  end;
 rL := TStringList.Create;
 rL.Text := Trim(memo_List.Text);
 k := 0;
 fL := TStringList.Create;
 for i := 0 to L.Count - 1 do
  
begin
   memo_Log.Lines.Add(Format('Обработка файлов %s', [L.Strings[i]]));
   fL.LoadFromFile(L.Strings[i]);
   tmp := ExtractFileName(L.Strings[i]);
   tmp := Copy(tmp, 1, Pos('.', tmp) - 1);
   NewName := Format('%s%s.%s', [ExtractFilePath(L.Strings[i]),
                                     tmp,
                                     FormatDateTime('ddmmyy_hhnn', Now)]);
   
if rg_Order.ItemIndex = 1 then
    for j := 0 to rL.Count - 1 do
     rL.Exchange(j, RandomRange(0, rL.Count));
   for j := 0 to fL.Count - 1 do
    begin
     fL.Strings[j] := StringReplace(fL.Strings[j], edt_Word.Text, rL.Strings[k], RF);
     inc(k);
     if k = rL.Count then k := 0;
    end;
   fL.SaveToFile(NewName);
   memo_Log.Lines.Add(Format('Сохранение под именем %s', [NewName]));
   memo_Log.Lines.Add('');
  end;
 memo_Log.Lines.Add('///');
 memo_Log.Lines.Add(Format('Окончание обработки: %s', [DateTimeToStr(Now)]));
 fL.Free;
 rL.Free;
 L.Free;
 btn_Next.Enabled := false;
 LoadBMP(btn_Prev, 5);
 btn_Prev.Caption := 'С начала';
end;

lmikle · #2 30.01.2018, 07:14

Ну, убивать, в смысле руки отрывать, за такое надо.
Ты же все-равно делаешь замену в рамках одной строки. Ну так нафига читать файл целиком? Читай по одной строке. Что-то типа:

Код:

procedure ReplaceSubStringInFile(ASrcFileName, ATgtFileName, ASrcStr, ATgtStr : String);
var
  F_Src, F_Tgt : TextFile;
  S : String;
begin
  AssignFile(F_Src,ASrcFileName);
  AssingFile(F_Tgt,ATgtFileName);
  Reset(F_Src);
  Reqwrite(F_Tgt);
  While Not EOF(F_Src) Do
    Begin
      ReadLN(F_Src,S);
      S := StringReplace(S,ASrcStr,ATgtStr,[srReplaceAll]);
      WriteLn(F_Tgt,S);
    End;
  CloseFile(F_Src);
  CloseFile(F_Tgt);
end;

Taras2020 · #3 30.01.2018, 12:24

Цитата:

Сообщение от lmikle

Ну, убивать, в смысле руки отрывать, за такое надо.
Ты же все-равно делаешь замену в рамках одной строки. Ну так нафига читать файл целиком? Читай по одной строке. Что-то типа:

К сожалению я делаю замену не в рамках одной строки а во всех строках. Про ReplaceSubStringInFile знаю, но решение пока что не нашел. Может еще есть варианты ?

dr. F.I.N. · #4 30.01.2018, 14:00

Цитата:

Сообщение от Taras2020

К сожалению я делаю замену не в рамках одной строки а во всех строках. Про ReplaceSubStringInFile знаю, но решение пока что не нашел. Может еще есть варианты ?

Тебе говорят, что замену ты выполняешь только в пределах строки....КАЖДОЙ строки файла. Т.е. построчно. Тебе и предлагают, не вываливать (полная загрузка в TStrings) всю кашу файла в память, а обрабатываеть его считывая ПОСТРОЧНО.

Taras2020 · #5 31.01.2018, 11:16

Цитата:

Сообщение от dr. F.I.N.

Тебе говорят, что замену ты выполняешь только в пределах строки....КАЖДОЙ строки файла. Т.е. построчно. Тебе и предлагают, не вываливать (полная загрузка в TStrings) всю кашу файла в память, а обрабатываеть его считывая ПОСТРОЧНО.

A какой алгоритм считывая построчно выходя из моего кода. Подскажите пожалуйста ?

dr. F.I.N. · #6 31.01.2018, 11:41

Не стал разбираться досконально с кодом, но что-то такое должно получится. Imikle все и так написал.

Код:

procedure Tfrm_Main.Run;
var afList: TStringDynArray;
    i, j, k: integer;
    L, rL{, fL}: TStringList;
    NewName, tmp: String;
//====
F_Src, F_Tgt : TextFile;
  S : String;
begin
 memo_Log.Lines.Add(Format('Начало обработки: %s', [DateTimeToStr(Now)]));
 memo_Log.Lines.Add('///');
 memo_Log.Lines.Add('');
 L := TStringList.Create;
 for i := 0 to memo_Folders.Lines.Count - 1 do
  
begin
   afList := TDirectory.GetFiles(memo_Folders.Lines[i], '*.txt', SO);
   for j := 0 to Length(afList) - 1 do
    L.Add(afList[j]);
  end;
 rL := TStringList.Create;
 rL.Text := Trim(memo_List.Text);
 k := 0;
 //fL := TStringList.Create;
 for i := 0 to L.Count - 1 do
  
begin
   memo_Log.Lines.Add(Format('Обработка файлов %s', [L.Strings[i]]));
   //fL.LoadFromFile(L.Strings[i]);
   AssignFile(F_Src,L.Strings[i]);
  Reset(F_Src);
   tmp := ExtractFileName(L.Strings[i]);
   tmp := Copy(tmp, 1, Pos('.', tmp) - 1);
   NewName := Format('%s%s.%s', [ExtractFilePath(L.Strings[i]),
                                     tmp,
                                     FormatDateTime('ddmmyy_hhnn', Now)]);

  AssingFile(F_Tgt,NewName);
  Rewrite(F_Tgt);

if rg_Order.ItemIndex = 1 then
    for j := 0 to rL.Count - 1 do
     rL.Exchange(j, RandomRange(0, rL.Count));

While Not EOF(F_Src) Do
    Begin
      ReadLN(F_Src,S);
      S := StringReplace(S, edt_Word.Text, rL.Strings[k], RF);
      WriteLn(F_Tgt,S);
inc(k);
     if k = rL.Count then k := 0;
    End;
  // for j := 0 to fL.Count - 1 do
    //begin
     //fL.Strings[j] := StringReplace(fL.Strings[j], edt_Word.Text, rL.Strings[k], RF);
     //inc(k);
     //if k = rL.Count then k := 0;
    //end;
   //fL.SaveToFile(NewName);
  CloseFile(F_Src);
  CloseFile(F_Tgt);
   memo_Log.Lines.Add(Format('Сохранение под именем %s', [NewName]));
   memo_Log.Lines.Add('');
  end;
 memo_Log.Lines.Add('///');
 memo_Log.Lines.Add(Format('Окончание обработки: %s', [DateTimeToStr(Now)]));
 //fL.Free;
 rL.Free;
 L.Free;
 btn_Next.Enabled := false;
 LoadBMP(btn_Prev, 5);
 btn_Prev.Caption := 'С начала';
end;

Кстати, есть полезная функция - ExtractFileExt

Taras2020 · #7 31.01.2018, 11:50

Цитата:

Сообщение от dr. F.I.N.

Не стал разбираться досконально с кодом, но что-то такое должно получится. Imikle все и так написал.

Отлично и спасибо. Сделал по вашей рекомендации и использовал функцию - ExtractFileExt. Все работает. Благодарю за помощь.

lmikle · #8 01.02.2018, 01:44

на самом деле зря вставил код в существующий. Я же не зря написал отдельную процку, просто ее надо было использовать, а то теперь получился размазанный по всей процедуре код.

Кстати, вот меня смущает такая строка:

Код:

if k = rL.Count then k := 0;

А значение в k потом нигде не используется. Нафига оно вообще?

И еще. Если у тебя много файлов, да еще и больших, то я бы подумал на тему написания многопоточного приложения.

dr. F.I.N. · #9 01.02.2018, 04:09

Цитата:

Сообщение от lmikle

А значение в k потом нигде не используется. Нафига оно вообще?

Не внимательный

Код:

While Not EOF(F_Src) Do
    Begin
      ReadLN(F_Src,S);
      S := StringReplace(S, edt_Word.Text, rL.Strings[k], RF); //<-----rL.Strings[k]
      WriteLn(F_Tgt,S);
inc(k);
     if k = rL.Count then k := 0;
    End;

@Rafa3L · #10 01.02.2018, 05:00

Цитата:

Сообщение от dr. F.I.N.

Не внимательный

А в таком варианте никогда не будет считана последняя строчка rL.Strings, инкремент нужно вниз переместить и k:=-1
4250

lmikle · #11 01.02.2018, 05:39

Цитата:

Сообщение от dr. F.I.N.

Не внимательный

Код:

While Not EOF(F_Src) Do
    Begin
      ReadLN(F_Src,S);
      S := StringReplace(S, edt_Word.Text, rL.Strings[k], RF); //<-----rL.Strings[k]
      WriteLn(F_Tgt,S);
inc(k);
     if k = rL.Count then k := 0;
    End;

Да бред какой-то получается.
Надо точно знать задачу. Что-то там точно не просто так.

dr. F.I.N. · #12 04.02.2018, 15:16

Цитата:

Сообщение от Taras2020

Добрый день, уважаемые пользователи.
...

Так ты Тарас или Татьяна?

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
Taras2020 (30.01.2018)

Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение:
Taras2020 (31.01.2018)