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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 23.05.2018, 23:17   #1
kladsss
Пользователь
 
Регистрация: 22.10.2017
Сообщений: 50
По умолчанию Обрабатывать каждый файл в папке Delphi XE

Как, в данный кусок кода, добавить возможность: обрабатывать не один файл, а все файлы что находятся в папке и подпапках. Сейчас обрабатывает только один файл. Друзья - Помогите решить задачу!
Код:
var
    SynArr: Array of Array of String;
      VocFile,SrcFile,DstFile: TextFile;
      TxtLine: String;
      SynList: TStringList;
    begin
     AssignFile(VocFile, OpenDialog2.FileName);
     Reset(VocFile);
     SetLength(SynArr, 0);
     SynList := TStringList.Create;
     while not Eof(VocFile)
     do begin
        ReadLn(VocFile, TxtLine);
        SynList.Text := StringReplace(WrapText(TxtLine,#13#10,['|'],1),'|','',[rfReplaceAll]);
        SetLength(SynArr, Length(SynArr)+1);
        SetLength(SynArr[High(SynArr)],SynList.Count);
        for i := 0 to SynList.Count - 1
        do SynArr[High(SynArr),i] := SynList.Strings[i];
        end;
     SynList.Free;
     CloseFile(VocFile);
 
     AssignFile(SrcFile, OpenDialog3.FileName);
     Reset(SrcFile);
 
     AssignFile(DstFile, OpenDialog4.FileName);
     Rewrite(DstFile);
     while not Eof(SrcFile)
     do begin
        ReadLn(SrcFile, TxtLine);
        for i := 0 to High(SynArr)
        do for j := 0 to High(SynArr[i])
           do TxtLine := StringReplace(TxtLine,SynArr[i,j],SynArr[i,Random(High(SynArr[i]))+1],[]);
        WriteLn(DstFile, TxtLine);
        end;
     CloseFile(DstFile);
     CloseFile(Srcfile);
    end;
kladsss вне форума Ответить с цитированием
Старый 23.05.2018, 23:25   #2
Sciv
Старожил
 
Аватар для Sciv
 
Регистрация: 16.05.2012
Сообщений: 3,211
По умолчанию

FindFirst, FindNext и рекурсия

Или может тип TDirectory, только я не помню, с какой версии он появился
Начал решать проблему с помощью регулярных выражений. Теперь решаю две проблемы...
Sciv вне форума Ответить с цитированием
Старый 23.05.2018, 23:27   #3
kladsss
Пользователь
 
Регистрация: 22.10.2017
Сообщений: 50
По умолчанию

Цитата:
Сообщение от Sciv Посмотреть сообщение
FindFirst, FindNext и рекурсия

Или может тип TDirectory, только я не помню, с какой версии он появился
Как это реализовать - опыта у меня точно не хватит. Если возможно то подскажите ? Буду благодарен за любую помощь.
kladsss вне форума Ответить с цитированием
Старый 24.05.2018, 07:09   #4
NetSpace
Участник клуба
 
Аватар для NetSpace
 
Регистрация: 03.06.2009
Сообщений: 1,792
По умолчанию

вот тут у Кропоткиной Алисы http://www.programmersforum.ru/showt...E0%E9%EB%EE%E2
как раз есть в коде пример работы с файлами, используя нужные вам функции и процедуры
Программирование - это единственный способ заставить компьютер делать то, что тебе хочется, а не то, что приходится.
NetSpace вне форума Ответить с цитированием
Старый 29.05.2018, 10:32   #5
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Примерно так
Код:
uses
ShlObj;

{$R *.dfm}

//Функция диалога выбора директории
function GetDirectory(Handle: HWND; TitleName: string): string;
var
  lpItemID: PItemIDList;
  BrowseInfo: TBrowseInfo;
  DisplayName: array[0..MAX_PATH] of char;
  TempPath: array[0..MAX_PATH] of char;
begin
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
  BrowseInfo.hwndOwner :=Handle;
  BrowseInfo.pszDisplayName := @DisplayName;
  BrowseInfo.lpszTitle := PChar(TitleName);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  lpItemID := SHBrowseForFolder(BrowseInfo);
  if lpItemId <> nil then
  begin
    SHGetPathFromIDList(lpItemID, TempPath);
    GlobalFreePtr(lpItemID);
    result:=TempPath;
    result:=result;
  end;
end;


//Ваша функция пока не пойму что она делает с SrcFileDlg и DstFileDlg
procedure FilesResultEdit(FileName, SrcFileDlg, DstFileDlg: string);
var
    SynArr: Array of Array of String;
    VocFile,SrcFile,DstFile: TextFile;
    TxtLine: String;
    SynList: TStringList;
    i, j: integer;
begin
     AssignFile(VocFile, FileName);
     Reset(VocFile);
     SetLength(SynArr, 0);
     SynList := TStringList.Create;
     while not Eof(VocFile) do
   begin
        ReadLn(VocFile, TxtLine);
        SynList.Text := StringReplace(WrapText(TxtLine, #13#10, ['|'], 1), '|', '', [rfReplaceAll]);
        SetLength(SynArr, Length(SynArr) + 1);
        SetLength(SynArr[High(SynArr)], SynList.Count);
        for i := 0 to SynList.Count - 1 do
        SynArr[High(SynArr),i] := SynList.Strings[i];
        end;
     SynList.Free;
     CloseFile(VocFile);

     AssignFile(SrcFile, SrcFileDlg);
     Reset(SrcFile);

     AssignFile(DstFile, DstFileDlg);
     Rewrite(DstFile);
     while not Eof(SrcFile) do
     begin
        ReadLn(SrcFile, TxtLine);
        for i := 0 to High(SynArr) do
        for j := 0 to High(SynArr[i]) do
        TxtLine := StringReplace(TxtLine, SynArr[i, j], SynArr[i, Random(High(SynArr[i])) + 1], []);
        WriteLn(DstFile, TxtLine);
        end;
     CloseFile(DstFile);
 CloseFile(Srcfile);
end;

procedure FindFiles(StartDir, SrcFile, DstFile: string; FilesList: TStrings);
var
  SR: TSearchRec;
  DirList: TStringList;
  IsFound: Boolean;
  i: integer;
begin
  if StartDir[length(StartDir)] <> '\' then
    StartDir := StartDir + '\';

  IsFound :=
  FindFirst(StartDir + '*.*', faAnyFile-faDirectory, SR) = 0;
  while IsFound do
  begin
  //Необходимо для закрытия формы
  Application.ProcessMessages;
  if Application.Terminated then
   exit;
    FilesList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;

    FilesResultEdit(StartDir + SR.Name, SrcFile, DstFile);
  end;
  FindClose(SR);

  DirList := TStringList.Create;
  try
  IsFound := FindFirst(StartDir + '*.*', faAnyFile, SR) = 0;
  while IsFound do begin
    if ((SR.Attr and faDirectory) <> 0) and
         (SR.Name[1] <> '.') then
      DirList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);

  for i := 0 to DirList.Count - 1 do
  begin
     //Необходимо для закрытия формы
  Application.ProcessMessages;
  if Application.Terminated then
   exit;
   FindFiles(DirList[i], SrcFile, DstFile, FilesList);
  end;

  finally
   DirList.Free;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
Dirs,
SrcFile,
DstFile: AnsiString;
DirFilesList: TStringList;
begin
Dirs:= GetDirectory(handle, '');
if Dirs = '' then
exit;
if not OpenDialog1.Execute then
exit;
SrcFile:= OpenDialog1.FileName;
if not OpenDialog1.Execute then
exit;
DstFile:= OpenDialog1.FileName;
DirFilesList:= TStringList.Create;
FindFiles(Dirs, SrcFile, DstFile, DirFilesList);
DirFilesList.Free;
end;

Последний раз редактировалось Aliens_wolfs; 29.05.2018 в 10:36.
Aliens_wolfs вне форума Ответить с цитированием
Старый 29.05.2018, 10:46   #6
Sciv
Старожил
 
Аватар для Sciv
 
Регистрация: 16.05.2012
Сообщений: 3,211
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Код:
and
         (SR.Name[1] <> '.')
Вроде бы тут ещё нужно проверку:

Код:
and (SR.Name[1] <> '..')
Начал решать проблему с помощью регулярных выражений. Теперь решаю две проблемы...
Sciv вне форума Ответить с цитированием
Старый 29.05.2018, 11:15   #7
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от Aliens_wolfs Посмотреть сообщение
Примерно так
ага.
просто автор уже использует аналогичный код.
см. ScanDir() в его теме-продолжении - http://www.programmersforum.ru/showthread.php?t=320350
Serge_Bliznykov вне форума Ответить с цитированием
Старый 29.05.2018, 12:14   #8
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Цитата:
Вроде бы тут ещё нужно проверку:
Я в листе смотрел все нормально отображает папки + файлы, поэтому проверку не делал


Цитата:
ага.
просто автор уже использует аналогичный код.
Понятно.
Я просто дополнил его код, чтобы автор если что под себя допилил

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


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Можно ли создать SFX архив с несколькими файлами, при распаковке вводить пароль на определенный файл (на каждый файл свой пароль) и распаковывался только это файл? jeksembiev Windows 11 11.05.2017 15:28
показать файл в папке Delphi digital-stream Общие вопросы Delphi 1 21.06.2011 14:59
Проверка есть ли файл в папке!!! angelada Общие вопросы C/C++ 5 20.01.2011 13:17
Файл в папке zumm Общие вопросы Delphi 5 21.05.2010 18:30