4

Добрый день, уважаемые пользователи. Суть проблемы: При запуске процедуры идет работа в файле размеров в .... мегабайт. И после 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;
3
  • 3
    Я так понял, Татьяна. Интересно
    – Zergatul
    29 янв 2018 в 18:45
  • 1
    Воспользуйтесь классом TStreamReader вместо TStringList 30 янв 2018 в 7:17
  • @Zergatul its a trap?) 31 янв 2018 в 9:51

1 ответ 1

6

Это не утечка. TStringList имеет ограничение на работу с очень большими файлами (учитывая, что размер файла в памяти после загрузки увеличится вдвое). Как раз 5-10 секунд проходит до того момента, как он упирается в него.
Используйте либо классический readln, либо перерабатывайте под себя TFileStream. Вот пример, давно использованный в нашей программе для работы с большими текстами, переработайте его под себя:

type

  TTextFileStream = class(TFileStream)
  private
    FBuffer: string;
  public
    function Eof: Boolean;
    procedure WriteLn(Text: string);
    function ReadLn: string;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    function RowsCount: Integer;
  end;

implementation

{ TTextFileStream }

function TTextFileStream.Eof: Boolean;
begin
  Eof := ((Position - Length(FBuffer)) = Size);
end;

function TTextFileStream.ReadLn: string;
const
  BufferLength = 10000;
var
  NewBuffer: string;
  Readed: Integer;
begin
  Readed := 1;
  while (Pos(#13, FBuffer) = 0) and (Readed > 0) do begin
    SetLength(NewBuffer, BufferLength + 2);
    Readed := Read(NewBuffer[1], BufferLength);
    SetLength(NewBuffer, Readed);
    FBuffer := FBuffer + NewBuffer;
  end;
  if Pos(#13, FBuffer) > 0 then begin
    Result := Copy(FBuffer, 1, Pos(#13, FBuffer) - 1);
    Delete(FBuffer, 1, Pos(#13, FBuffer) + 1);
  end else begin
    Result := FBuffer;
    FBuffer := '';
  end;
end;

function TTextFileStream.RowsCount: Integer;
begin
  Result := 1;
  FBuffer := '';
  Seek(0, soBeginning);
  while not Eof do begin
    ReadLn;
    Inc(Result);
  end;
  Seek(0, soBeginning);
end;

function TTextFileStream.Seek(const Offset: Int64;
  Origin: TSeekOrigin): Int64;
begin
  if Origin = soCurrent then
    Result := inherited Seek(Offset - Length(FBuffer), Origin)
    else Result := inherited Seek(Offset, Origin);
  FBuffer := '';
end;

procedure TTextFileStream.WriteLn(Text: string);
const
  NewLine = #13#10;
begin
  Seek(0, soCurrent);
  Write(Text[1], Length(Text));
  Write(NewLine, 2);
end;
4
  • Вопрос решила, всем спасибо за подсказки! 31 янв 2018 в 12:37
  • @Татьяна, если ответ вам помог, отметьте его галочкой :) 31 янв 2018 в 14:04
  • Я, конечно, ни разу не программист, но, на мой нубский взгляд, код выше - это яркий пример как не_надо делать, если вы хотите обрабатывать большие файлы... начиная от двух SetLength() в цикле и трёх одинаковых вызовов Pos() в функции ReadLn() и заканчивая фукцией RowsCount().
    – Alekcvp
    2 фев 2018 в 21:01
  • @Alekcvp Я вроде тоже ни разу не программист, но данный код работает с нашими данными эффективнее, чем классический readln, и немного, но быстрее, чем TStringlist 5 фев 2018 в 2:36

Ваш ответ

Нажимая на кнопку «Отправить ответ», вы соглашаетесь с нашими пользовательским соглашением, политикой конфиденциальности и политикой о куки

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.