0

我投降了，我花了将近 12 个小时来得到我想要的东西，但我做不到。

此代码搜索所有文件夹和文件名，但我想排除一些文件夹，包括我想从搜索中排除的文件夹的子目录。

我希望有人可以提供帮助。

procedure TForm1.CombineDir(InDir : string; OutStream : TStream);
var  AE : TArchiveEntry;
     dFound:boolean;

  procedure RecurseDirectory(ADir : string);
  var  sr : TSearchRec;
       TmpStream : TStream;
  begin
    if FindFirst(ADir + '*', faAnyFile, sr) = 0 then begin
      repeat
        if (sr.Attr and (faDirectory or faVolumeID)) = 0 then begin
          //ShowMessage('Filename is :>'+ ADir + sr.Name);
          if (NotThisPath.IndexOf(ADir + sr.Name)>=0) or dFound then begin
            ShowMessage('DO NOT INCLUDE THIS FILENAME :>'+ ADir + sr.Name);
          end else begin
            ShowMessage('>>> INCLUDE THIS FILENAME :>'+ ADir + sr.Name);
            // We have a file (as opposed to a directory or anything
            // else). Write the file entry header.
            AE.EntryType := aeFile;
            AE.FileNameLen := Length(sr.Name);
            AE.FileLength := sr.Size;
            OutStream.Write(AE, SizeOf(AE));
            OutStream.Write(sr.Name[1], Length(sr.Name));
            // Write the file itself
            TmpStream := TFileStream.Create(ADir + sr.Name, fmOpenRead or fmShareDenyWrite);
            OutStream.CopyFrom(TmpStream, TmpStream.Size);
            TmpStream.Free;
          end;
        end;

        if (sr.Attr and faDirectory) > 0 then begin
          if (sr.Name <> '.') and (sr.Name <> '..') then begin
            //ShowMessage('DIR is:>'+ ADir + sr.Name);
            //if (Pos(ADir, NotThisPath.Text)>0) then
            if (NotThisPath.IndexOf(ADir + sr.Name)>=0) then begin
              ShowMessage('DO NOT INCLUDE THIS DIR:>'+ ADir + sr.Name);
              dFound:=True;
            end else begin
              ShowMessage('>>> INCLUDE THIS DIR:>'+ ADir + sr.Name);
              // Write the directory entry
              AE.EntryType := aeDirectory;
              AE.DirNameLen := Length(sr.Name);
              OutStream.Write(AE, SizeOf(AE));
              OutStream.Write(sr.Name[1], Length(sr.Name));
            end;
            // Recurse into this directory
            RecurseDirectory(IncludeTrailingPathDelimiter(ADir + sr.Name));
          end;
        end;
      until FindNext(sr) <> 0;
      FindClose(sr);
    end;
    // Show that we are done with this directory
    AE.EntryType := aeEOD;
    OutStream.Write(AE, SizeOf(AE));
  end;

begin
RecurseDirectory(IncludeTrailingPathDelimiter(InDir));
end;

NotThisPath 是一个 TStringList；

4

1 回答 1

5

我认为您的基本问题是您将文件枚举、文件名过滤和您的 GUI 混合在一起成为一个邪恶的粘性物。您根本不应该看到FindFirst从表单的方法中调用。调用的代码FindFirst属于辅助类或函数。

我不会尝试直接回答您的问题，尤其是因为您实际上并没有提出问题。我将尝试向您展示如何区分枚举文件和过滤名称的关注点。

首先，我要实现这个功能：

procedure EnumerateFiles(Dir: string; 
  const EnumerateFileName: TEnumerateFileNameMethod);

该函数在Dir参数中传递了一个目录，并继续递归地枚举该目录中的所有文件、其子目录等。找到的每个文件都将传递给回调方法EnumerateFileName。这是这样定义的：

type
  TEnumerateFileNameMethod = procedure(const FileName: string) of object;

实现确实非常简单。这只是基于标准FindFirst的重复循环。该函数拒绝特殊目录.和... 它将递归到它遇到的任何目录。

procedure EnumerateFiles(Dir: string;
  const EnumerateFileName: TEnumerateFileNameMethod);
var
  SR: TSearchRec;
begin
  Dir := IncludeTrailingPathDelimiter(Dir);
  if FindFirst(Dir + '*', faAnyFile, SR) = 0 then
    try
      repeat
        if (SR.Name = '.') or (SR.Name = '..') then
          continue;
        if (SR.Attr and faDirectory) <> 0 then
          EnumerateFiles(Dir + SR.Name, EnumerateFileName)
        else
          EnumerateFileName(Dir + SR.Name);
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
end;

现在，我希望这应该很简单。下一个问题是过滤。您可以在您提供的回调方法中实现它。这是一个完整的演示，它说明了筛选出带有.pas扩展名的 Delphi 源文件的过滤。

program EnumerateFilesDemo;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  TEnumerateFileNameMethod = procedure(const FileName: string) of object;

procedure EnumerateFiles(Dir: string;
  const EnumerateFileName: TEnumerateFileNameMethod);
var
  SR: TSearchRec;
begin
  Dir := IncludeTrailingPathDelimiter(Dir);
  if FindFirst(Dir + '*', faAnyFile, SR) = 0 then
    try
      repeat
        if (SR.Name = '.') or (SR.Name = '..') then
          continue;
        if (SR.Attr and faDirectory) <> 0 then
          EnumerateFiles(Dir + SR.Name, EnumerateFileName)
        else
          EnumerateFileName(Dir + SR.Name);
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
end;

type
  TDummyClass = class
    class procedure EnumerateFileName(const FileName: string);
  end;

class procedure TDummyClass.EnumerateFileName(const FileName: string);
begin
  if SameText(ExtractFileExt(FileName), '.pas') then
    Writeln(FileName);
end;

procedure Main;
begin
  EnumerateFiles('C:\Users\heff\Development', TDummyClass.EnumerateFileName);
end;

begin
  try
    Main;
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

现在，我知道这不是您想要执行的过滤类型，但关键是我们现在有了通用性。SameText您可以使用您想要的任何过滤替换调用。一旦你选择了你想要处理的文件，你就可以对它们做你喜欢的事情。

为了方便起见，我使用了类方法。我不希望我的演示充满了实例化对象的样板。但是为了您的需要，您可能希望创建一个类来处理枚举回调。该类将封装您正在执行的文件归档操作。该类将拥有输出流的一个实例。回调方法将是写入存档的实例方法。

现在，我还没有为您的问题实施完整的解决方案，但我希望我做得更好。即向您展示如何分解代码以简化解决您的问题。

于 2013-07-31T20:05:29.020 回答