понедельник, 16 декабря 2013 г.

Перебор файлов по маске. При помощи "анонимных функций"

У нас был код для перебора файлов:

 type
  TFileProcessingFunc = function (const aFileName: string;
                                  aData: Pointer): Boolean;

function ConcatDirName(aDirName : TFileName; aFileName : TFileName) : TFileName;
 begin
  if Length(aDirName) = 0 then
   Result := aFileName
  else
  begin
   Result := aDirName;
   If (Length(aFileName) = 0) then Exit;
   If Result[Length(Result)] <> '\' then Result := Result + '\';
   If (aFileName[1] = '\') then Delete(aFileName,1,1);
   Result := Result + aFileName;
  end;
 end;

procedure ProcessFilesWithMask(const aDir, aFileNameMask: TFileName;
                               aFileProcessingFunc: TFileProcessingFunc;
                               aData: Pointer = nil);
var
 l_SearchRec: TSearchRec;
 l_FindResult: Integer;
begin
 l_FindResult := FindFirst(ConcatDirName(aDir, aFileNameMask),
                           faAnyFile,
                           l_SearchRec);
 try
  while l_FindResult = 0 do
  begin
   if (l_SearchRec.Attr and (faDirectory or faVolumeID or faSymLink)) = 0 then
    if not aFileProcessingFunc(ConcatDirName(aDir, l_SearchRec.Name), aData) then
     Break;

   l_FindResult:=FindNext(l_SearchRec);
  end;
 finally
  FindClose(l_SearchRec);
 end;
end;

Он переписывается с помощью анонимных функций так:

 type
  TFileProcessingFunc = reference to function (const aFileName: string): Boolean;

function ConcatDirName(aDirName : TFileName; aFileName : TFileName) : TFileName;
 begin
  if Length(aDirName) = 0 then
   Result := aFileName
  else
  begin
   Result := aDirName;
   If (Length(aFileName) = 0) then Exit;
   If Result[Length(Result)] <> '\' then Result := Result + '\';
   If (aFileName[1] = '\') then Delete(aFileName,1,1);
   Result := Result + aFileName;
  end;
 end;


procedure ProcessFilesWithMask(const aDir, aFileNameMask: TFileName;
                               aFileProcessingFunc: TFileProcessingFunc);
var
 l_SearchRec: TSearchRec;
 l_FindResult: Integer;
begin
 l_FindResult := FindFirst(ConcatDirName(aDir, aFileNameMask),
                           faAnyFile,
                           l_SearchRec);
 try
  while l_FindResult = 0 do
  begin
   if (l_SearchRec.Attr and (faDirectory or faVolumeID or faSymLink)) = 0 then
    if not aFileProcessingFunc(ConcatDirName(aDir, l_SearchRec.Name)) then
     Break;

   l_FindResult:=FindNext(l_SearchRec);
  end;
 finally
  FindClose(l_SearchRec);
 end;
end;

И используется так:

ProcessFilesWithMask('c:\temp', '*.tmp', 
  function (const aFileName: string): Boolean
  begin 
   Result := true; 
   WriteLn(aFileName); 
  end
 );

Ну это из разряда "tips'n'tricks"....

P.S. Аналогично можно "переписать" и вот это:

procedure ProcessDirectory(const aDir: TFileName;
                           aFileProcessingFunc: TFileProcessingFunc;
                           aData: Pointer = nil);
var
 l_SearchRec: TSearchRec;
 l_FindResult: Integer;
begin
 l_FindResult := FindFirst(ConcatDirName(aDir, '*.*'),
                           faDirectory ,
                           l_SearchRec);
 try
  while l_FindResult = 0 do
  begin
   if ((l_SearchRec.Attr and faDirectory) <> 0) and (l_SearchRec.Name <> '.') and (l_SearchRec.Name <> '..') then
    if not aFileProcessingFunc(l_SearchRec.Name, aData) then
     Break;

   l_FindResult:= FindNext(l_SearchRec);
  end;
 finally
  FindClose(l_SearchRec);
 end;
end;

3 комментария:

  1. В последнее время я очень полюбил вот такую простую конструкцию (uses System.IOUtils):
    for FileName in TDirectory.GetFiles(...) do ;

    ОтветитьУдалить
  2. Занятно. Не знал. Хотя под xCode ровно такой конструкцией пользуюсь. Спасибо.

    ОтветитьУдалить
  3. NSArray *vFiles = [[NSFileManager defaultManager] contentsOfDirectoryAtPath: [[self class] path] error: NULL];
    for (NSString *vFileName in vFiles) { ... }

    ОтветитьУдалить