Очередной пример манипуляции с файлами

Автор: Bernhard Angerer

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

GetAllFiles возвращает в stringlist все файлы удовлетворяющие заданному критерию. Эта функция относится к типу рекурсивных.
Работает на все версиях Delphi.

procedure GetAllFiles(aPathPlusMask:string;aSubFolders: boolean;
                      aResultList: TStringList);
var Search: TSearchrec;
    hDir: string;
    hMask: string;

begin
  hMask := aPathPlusMask;
  hDir := ExtractFilepath(aPathPlusMask);
  if hDir[length(hDir)]<>'\' then hDir := hDir + '\';

  // Внимание: FindFirst ищей все файлы в общей папке
  // Если дирректория недоступна ( hDir содержит ошибку)
  if not DirExists(hDir) then
    EXIT;

  if FindFirst(hMask, $23, Search)= 0 then
  repeat
     aResultList.Add(hDir + Search.Name);
  until FindNext(Search)<>0;

  if aSubFolders then
    if FindFirst(hDir + '*.*',fadirectory, Search)= 0 then
      repeat
         if((search.attr and fadirectory)=fadirectory) and
            (search.name[1]<>'.') then
           GetAllFiles(hDir+Search.Name+'\'+hMask, aSubFolders,
                       aResultList);
      until FindNext(Search) <> 0;
end;


Теперь не составляет труда создать функцию, которая будет устанавливать атрибуты у всех файлов:

procedure SetAllFilesAttr(aPathPlusMask: string;
                          aSubFolders: boolean;
                          aAttr: Integer);
var i: integer;
    hStrList: TStringList;
begin
  hStrList:= TStringList.Create;

  GetAllFiles(aPathPlusMask,aSubFolders, hStrList);

  for i := 0 to hStrlist.Count - 1 do
    FileSetAttr(hStrlist[i], aAttr);

  hStrList.Destroy;
end;


Вызов этой функции будет выглядеть примерно так:

SetAllFilesAttr('*.*', false, faArchive );

Впринципе такие функции как CopyAllFiles или FindInFiles могут быть реализованы различными способами !

Автор: Michael Huisking

У меня возникли проблемы с функцией GetAllFiles. Если путь задавать в виде path + originalpath с маской, то функция всё время выходит на ошибку.  Также я заметил, что aResultList передаётся в функцию значением, а не указателем.  Это хорошо для объектов, но у меня переменная величина.

Итак, изменил функцию, чтобы извлекать из aPathPlusMask только маску.

Собственно моя процедура

procedure GetAllFiles(aPathPlusMask:string;aSubFolders: boolean;
                       var aResultList: TStringList);
var Search: TSearchrec;
    hDir: string;
    hMask: string;
begin
  hDir := ExtractFilepath(aPathPlusMask);
  if length(hDir) > 0 then
  begin
    if hDir[length(hDir)]<>`\` then hDir := hDir + `\`;
  end
  else
  begin
   // No Path -- Get the current and tack on the mask
    hDir:= ExtractFilePath(Application.ExeName);
    aPathPlusMask:= hDir + aPathPlusMask;
  end;

  hMask := copy(aPathPlusMask,length(hDir)+1,(length(aPathPlusMask) - length(hDir)));

  // Внимание: FindFirst ищей все файлы в общей папке
  // Если дирректория недоступна ( hDir содержит ошибку)
  if not DirectoryExists(hDir) then
    EXIT;

  if FindFirst(hMask, faAnyFile, Search)= 0 then
  repeat
     aResultList.Add(hDir + Search.Name);
  until FindNext(Search)<>0;

  if aSubFolders then
    if FindFirst(hDir + `*.*`,fadirectory, Search)= 0 then
      repeat
         if((search.attr and fadirectory)=fadirectory) and
            (search.name[1]<>`.`) then
           GetAllFiles(hDir+Search.Name+`\`+hMask, aSubFolders,
                       aResultList);
      until FindNext(Search) <> 0;
end;