从搜索中排除文件夹和文件

时间:2013-07-31 18:54:15

标签: delphi delphi-7

我投降,我花了大约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;

1 个答案:

答案 0 :(得分: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的呼叫。一旦你挑选出你想要处理的文件,你就可以随心所欲地做到。

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

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

相关问题