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

[Taras2018]

Добрый день, уважаемые пользователи.
Суть проблемы: При запуске процедуры идет замена слов в файле размеров в 400 мегабайт. И после 5-10 секунд выскакивает окно 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;

[Taras2018]

Проблема решена, использовал функцию ExtractFileExt. Всем спасибо за внимание.

[Пепел Феникса]

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

Проблема решена, использовал функцию ExtractFileExt.

она максимум вам помогает взять расширение файла, ошибка вылетала при чтении файла, ибо вы его целиком грузите в память.

[Taras2018]

Сообщение от Пепел Феникса

она максимум вам помогает взять расширение файла, ошибка вылетала при чтении файла, ибо вы его целиком грузите в память.

Эта функция + построчное чтение без загрузки в память всего файла через Assing = результат.

[PTyTb32]

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

Добрый день, уважаемые пользователи.
Суть проблемы: При запуске процедуры идет замена слов в файле размеров в 400 мегабайт. И после 5-10 секунд выскакивает окно 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;

у вас утечки памяти в TStringList, вы их освобождаете, а содержимое нет

[Аватар]

у вас утечки памяти в TStringList, вы их освобождаете, а содержимое нет

Чего это? Free и память под строки освождает

[Serge_Bliznykov]

PTyTb32, а что это Вы вдруг решили тему более чем полугодовой давности поднять?

p.s. с ответом Аватар согласен.