Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.04.2018, 20:24   #1
kladsss
Пользователь
 
Регистрация: 22.10.2017
Сообщений: 50
По умолчанию Результат в один файл / 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;
kladsss вне форума Ответить с цитированием
Старый 16.04.2018, 15:53   #2
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Цитата:
не могу разобраться как сохранить все результаты в один файл.
Немного переделал ваш код для сохранения в один файл
Код:
procedure ProcessedFile(var F: TextFile; const Matching: array of string);
var
  LenArray: Integer;
  Str: string;
  // В какой файл пишем результат
  fResult: TextFile;
  Idx: array of Integer;
  i: Integer;
  // Какой символ из считанной строки сравнивается
  CharIdx: Integer;
  // Сколько подстрок совпало
  MatchCnt: Integer;
  LenStr: Integer;
begin
  LenArray := Length(Matching);
  SetLength(Idx, LenArray);
  try
    // Открываем файл для записи найденых данных
      AssignFile(fResult, 'D:\Result.txt');
      Rewrite(fResult);
      // Файл открылся, 0 убрали
     for i := 0 to LenArray - 1 do
      Idx[i] := 1;

    while not Eof(F) do
    begin
      // Читаем следующую строку из файла
      Readln(F, Str);
      // Сравнение для всех подстрок начинаем с 1 символа
      for i := 0 to LenArray - 1 do
        Idx[i] := 1;
      // Пока не нашли ни одной подстроки
      MatchCnt := 0;
      // Сравниваем каждый считанный символ с текущей позицией в искомой подстроке
      for CharIdx := 1 to Length(Str) do
        for i := 0 to LenArray - 1 do
        begin
          LenStr := Length(Matching[i]);
          // Если еще не нашли всю подстроку
          if Idx[i] <= LenStr then
          begin
            // Если текущий считанный символ совпадает с текущим символом в искомой подстроке
            if Str[CharIdx] = Matching[i, Idx[i]] then
            begin
              // Если дошли до конца подстроки, то совпали все символы
              if Idx[i] = LenStr then
              begin
                // Увеличиваем число совпадений
                Inc(MatchCnt);
                // Записываем считанную строку в нуужный файл
                Writeln(fResult, Str);
              end
            else
                // Увеличиваем позицию
                Inc(Idx[i]);
            end
          else
              // Если текущий считанный символ НЕ совпадает с текущим символом в искомой подстроке
              // то начинаем поиск по этой подстроке сначала
              Idx[i] := 1;
          end;
        end;
        // Если нашли ВСЕ подстроки, то дальше проверять символы не нужно
        if MatchCnt = LenArray then
          Break;  // прерываем текущую итерацию
      end;
  finally
         // Закрываем файл с полученным результатом
        CloseFile(fResult);
  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;

Последний раз редактировалось Aliens_wolfs; 16.04.2018 в 18:00.
Aliens_wolfs вне форума Ответить с цитированием
Старый 18.04.2018, 14:17   #3
kladsss
Пользователь
 
Регистрация: 22.10.2017
Сообщений: 50
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Немного переделал ваш код для сохранения в один файл
Спасибо огромное. А не подскажите как еще не учитывать пустые Edit (в первом варианте то есть если по разным файлам). К примеру если Edit поле не заполнено то не создавать пустой файл.

Последний раз редактировалось kladsss; 18.04.2018 в 14:21.
kladsss вне форума Ответить с цитированием
Старый 18.04.2018, 20:24   #4
digitalis
Старожил
 
Аватар для digitalis
 
Регистрация: 04.02.2011
Сообщений: 4,536
По умолчанию

If EditN.Text = '' then ....
Это имелось в виду ?
digitalis вне форума Ответить с цитированием
Старый 18.04.2018, 22:18   #5
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Попробуйте сделать такое изменение
Код:
      // Сравниваем каждый считанный символ с текущей позицией в искомой подстроке
      for CharIdx := 1 to Length(Str) do
        for i := 0 to LenArray - 1 do
        begin
          LenStr := Length(Matching[i]);
          // Если еще не нашли всю подстроку
          if (LenStr > 0) and (Idx[i] <= LenStr)then
          begin

Последний раз редактировалось Aliens_wolfs; 18.04.2018 в 22:22.
Aliens_wolfs вне форума Ответить с цитированием
Старый 04.05.2018, 23:09   #6
kladsss
Пользователь
 
Регистрация: 22.10.2017
Сообщений: 50
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Попробуйте сделать такое изменение
Все сделал, большое спасибо. Не подскажите как в вашем коде сделать условие: если файл с таким именем существует, то - формируем новое имя файла.
kladsss вне форума Ответить с цитированием
Старый 05.05.2018, 01:42   #7
northener
ПШП
Участник клуба
 
Регистрация: 15.07.2013
Сообщений: 1,859
По умолчанию

Цитата:
Сообщение от kladsss Посмотреть сообщение
как сделать условие: если файл с таким именем существует
Ну это проще простого. Для такой проверки есть функция FileExists
А вот с
Цитата:
Сообщение от kladsss Посмотреть сообщение
формируем новое имя файла
непонятка. А как вы формируете исходное имя файла, которое потом нужно проверять?
P.S. Предвижу что ваш код собран из кусков, хаотично надыбанных на всемирной помойке. И уж если вы просите помощи, то вам лучше всего просить довести до ума ваш проект целиком.
northener вне форума Ответить с цитированием
Старый 05.05.2018, 10:56   #8
Filka
Форумчанин
 
Регистрация: 29.10.2015
Сообщений: 272
По умолчанию

kladsss, так?
Код:
function GenerateFileName(const FileName: string): string;
var
  Name, Ext: string;
  I: Integer;
begin
  Result := FileName;
  if FileExists(Result) then
  begin
    Name := ChangeFileExt(Result, '');
    Ext  := ExtractFileExt(Result);
    I := 0;
    repeat
      Inc(I);
      Result := Format('%s(%d)%s', [Name, I, Ext]);
    until not FileExists(Result);
  end;
end;
Код:
var
  F: TextFile;
begin
  if OpenDialog1.Execute then
  begin
    AssignFile(F, GenerateFileName(OpenDialog1.FileName));
    {...}
  end;
end;
Filka вне форума Ответить с цитированием
Старый 05.05.2018, 11:52   #9
kladsss
Пользователь
 
Регистрация: 22.10.2017
Сообщений: 50
По умолчанию

Цитата:
Сообщение от Filka Посмотреть сообщение
kladsss, так?
Может и то, но не могу понять как Ваш код подключить к коду Aliens_wolfs (Пост 2).
kladsss вне форума Ответить с цитированием
Старый 05.05.2018, 11:58   #10
Filka
Форумчанин
 
Регистрация: 29.10.2015
Сообщений: 272
По умолчанию

Код:
AssignFile(fResult, GenerateFileName('D:\Result.txt'));

Последний раз редактировалось Filka; 05.05.2018 в 12:01.
Filka вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
[C#] Выводит один и тот же результат при разных параметрах artems67 Помощь студентам 1 09.11.2017 06:36
Дан файл f, который содержит вещественные числа. Найти сумму чисел и записать результат в новый файл. (Delphi) 2Nboy Помощь студентам 1 08.06.2012 17:01
Один результат из двух столбцов Kpak Помощь студентам 0 07.05.2012 11:05
Один результат из двух столбцов Kpak Microsoft Office Excel 2 04.05.2012 18:50
Две лабы: файл - обработать слова; массив - найти три наибольших элемента за один проход ( Delphi ) Emma_Imp Помощь студентам 5 26.12.2010 21:13