Показать сообщение отдельно
  #1  
Старый 11.04.2018, 19:40
Taras2020 Taras2020 вне форума
Прохожий
 
Регистрация: 15.01.2018
Сообщения: 36
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Результат в один файл / Delphi XE

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

Ребята, Может кто подскажет ?
Код:
procedure ProcessedFile(var F: TextFile; const Matching: array of string);
type
  // Информация об искомых строках
  StrInfo = record
    // В какой файл пишем результат
    F: TextFile;
    // Текущая позиция поиска
    Idx: Integer;
  end;
var
  LenArray: Integer;
  Str: string;
  InfoData: array of StrInfo;
  i: Integer;
  // Какой символ из считанной строки сравнивается
  CharIdx: Integer;
  // Сколько подстрок совпало
  MatchCnt: Integer;
  LenStr: Integer;
begin
  LenArray := Length(Matching);
  SetLength(InfoData, LenArray);
  // Используем это поле, чтобы узнать какие файлы удалось открыть
  // 0 - файл закрыт
  for i := 0 to LenArray - 1 do
    InfoData[i].Idx := 0;
  try
    // Открываем все файлы на запись
    for i := 0 to LenArray - 1 do begin
      AssignFile(InfoData[i].F, IntToStr(i + 1) + '.txt');
      Rewrite(InfoData[i].F);
      // Файл открылся, 0 убрали
      InfoData[i].Idx := 1;
    end;
 
    while not Eof(F) do begin
      // Читаем следующую строку из файла
      Readln(F, Str);
      // Сравнение для всех подстрок начинаем с 1 символа
      for i := 0 to LenArray - 1 do
        InfoData[i].Idx := 1;
      // Пока не нашли ни одной подстроки
      MatchCnt := 0;
      // Сравниваем каждый считанный символ с текущей позицией в искомой подстроке
      for CharIdx := 1 to Length(Str) do begin
        for i := 0 to LenArray - 1 do begin
          LenStr := Length(Matching[i]);
          // Если еще не нашли всю подстроку
          if InfoData[i].Idx <= LenStr then begin
            // Если текущий считанный символ совпадает с текущим символом в искомой подстроке
            if Str[CharIdx] = Matching[i, InfoData[i].Idx] then begin
              // Если дошли до конца подстроки, то совпали все символы
              if InfoData[i].Idx = LenStr then begin
                // Увеличиваем число совпадений
                Inc(MatchCnt);
                // Записываем считанную строку в нуужный файл
                Writeln(InfoData[i].F, Str);
              end else
                // Увеличиваем позицию
                Inc(InfoData[i].Idx);
            end else begin
              // Если текущий считанный символ НЕ совпадает с текущим символом в искомой подстроке
              // то начинаем поиск по этой подстроке сначала
              InfoData[i].Idx := 1;
            end;
          end;
        end;
        // Если нашли ВСЕ подстроки, то дальше проверять символы не нужно
        if MatchCnt = LenArray then
          Break;  // прерываем текущую итерацию
      end;
    end;
  finally
    // Закрываем все открытые файлы
    for i := 0 to LenArray - 1 do begin
      // Если файл был открыт, то закрываем
      if InfoData[i].Idx <> 0 then
        CloseFile(InfoData[i].F);
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  F: TextFile;
begin
  if OpenDialog1.Execute then begin
    AssignFile(F, OpenDialog1.FileName);
    Reset(F);
    try
      ProcessedFile(F, [Edit1.Text, Edit2.Text, Edit3.Text]);
    finally
      CloseFile(F);
    end;
  end;
end;
Ответить с цитированием