Question

我开发了一个应用程序，它基本上扫描文件或文件列表的所有位置。当我扫描像10 000个文件和子文件这样的小文件夹时没有问题。但是当我扫描我的整个用户文件夹超过10万个项目时，我的处理器非常沉重。它需要大约40％的处理器功率。

有没有办法优化此代码，以便它使用更少的CPU？

procedure GetAllSubFolders(sPath: String);
var
  Path: String;
  Rec: TSearchRec;
begin
  try
    Path := IncludeTrailingBackslash(sPath);
    if FindFirst(Path + '*.*', faAnyFile, Rec) = 0 then
      try
        repeat
          Application.ProcessMessages;
          if (Rec.Name <> '.') and (Rec.Name <> '..') then
          begin
            if (ExtractFileExt(Path + Rec.Name) <> '') And
              (ExtractFileExt(Path + Rec.Name).ToLower <> '.lnk') And
              (Directoryexists(Path + Rec.Name + '\') = False) then
            begin
              if (Pos(Path + Rec.Name, main.Memo1.Lines.Text) = 0) then
              begin
                main.ListBox1.Items.Add(Path + Rec.Name);
                main.Memo1.Lines.Add(Path + Rec.Name)
              end;
            end;

            GetAllSubFolders(Path + Rec.Name);
          end;
        until FindNext(Rec) <> 0;
      finally
        FindClose(Rec);
      end;
  except
    on e: Exception do
      ShowMessage(e.Message);
  end;
end;

我的应用会搜索所选文件夹和子文件夹中的所有文件，压缩它们并将它们复制到您指定的其他位置。

Application.ProcessMessages命令用于确保应用程序看起来不像挂起而用户将其关闭。因为例如找到100 000个文件可能需要一个小时左右......

我担心处理器的使用情况，内存并没有真正受到影响。

注意：备忘录是为了确保未选择相同的文件两次。

Answer 1

我发现以下性能问题：

对Application.ProcessMessages的调用有点贵。您正在轮询消息而不是使用阻塞等待，即GetMessage。除了性能问题之外，Application.ProcessMessages的使用通常表明由于各种原因导致设计不佳，并且通常应该避免需要调用它。
非虚拟列表框对很多文件表现不佳。
使用备忘录控件（GUI控件）存储字符串列表非常昂贵。
每次添加到GUI控件时，它们都会更新和刷新，这非常昂贵。
Memo1.Lines.Text的评估非常昂贵。
Pos的使用同样非常昂贵。
DirectoryExists的使用既昂贵又虚假。搜索记录中返回的属性包含该信息。

我会做出以下更改：

将搜索代码移动到一个帖子中，以避免需要ProcessMessages。您需要设计一些方法将信息传输回主线程以便在GUI中显示。
使用虚拟列表视图显示文件。
将要搜索重复项的文件列表存储在字典中，以便进行O(1)查找。注意文件名不区分大小写，这个问题到目前为止你可能已经忽略了。这取代了备忘录。
使用Rec.Attr检查项目是否为目录。这是检查Rec.Attr and faDirectory <> 0。

Answer 2

我同意这个答案，说你最好在后台线程中做你正在做的事情，我不想鼓励你坚持在你的主线程中这样做。

但是，如果您转到命令提示符并执行此操作：

dir c:\*.* /s > dump.txt & notepad dump.txt

你可能会对Notepad弹出视图的速度感到惊讶。

因此，即使您将其保留在主线程中，也可以采取一些措施来加速GetAllSubFolders，例如：通过调用main.Memo1.Lines.BeginUpdate和main.Memo1.Lines.EndUpdate来括起代码，同样是main.Listbox1.Items.BeginUpdate和EndUpdate。这将阻止这些控件在执行时进行更新（这实际上是您的代码花费大部分时间进行的操作，以及我在下面评论过的“if Pos（...）”业务）。而且，如果你还没有收集，Application.ProcessMessages是邪恶的（主要是）。

我在D：驱动器上做了一些计时，这是一个500Gb SSD，在35949个目录中有263562个文件。

q：6777秒的代码
根据以上内容对记事本执行dir：15秒
以下代码，主线程：9.7秒

我在这个答案中包含下面代码的原因是你会发现在线程中执行起来要容易得多，因为它会将结果收集到一个TStringlist中，然后你可以将其内容分配给你的备忘录和列表框线程已经完成。

关于q中代码的一些注释，我想你可能已经从某个地方获得了这些代码。

即使Rec中的当前条目是普通文件，也毫无意义地进行递归。以下代码仅在当前Rec条目是目录时才会递归。
它显然试图通过“if Pos（...）”业务避免重复，这不应该是必要的（除非可能存在符号链接（例如，使用MkLink命令创建）在驱动器上的其他地方）并且以非常低效的方式进行，即通过在备忘录内容中搜索文件名 - 随着找到更多文件，这些文件将变得越来越长。在下面的代码中，stringlist被设置为丢弃重复项并将其Sorted属性设置为True，这使得它更快地检查重复项，因为它可以通过其内容而不是串行内容进行二进制搜索。
它为每个找到的东西计算6次Path + Rec.Name，这在r / t时可以避免效率低下并使源代码膨胀。然而，与前两个相比，这只是一个小问题。

代码：

function GetAllSubFolders(sPath: String) : TStringList;

  procedure GetAllSubFoldersInner(sPath : String);
  var
    Path,
    AFileName,
    Ext: String;
    Rec: TSearchRec;
    Done: Boolean;
  begin
    Path := IncludeTrailingBackslash(sPath);
    if FindFirst(Path + '*.*', faAnyFile, Rec) = 0 then begin
        Done := False;
        while not Done do begin
         if (Rec.Name <> '.') and (Rec.Name <> '..') then begin
            AFileName := Path + Rec.Name;
            Ext := ExtractFileExt(AFileName).ToLower;
           if not ((Rec.Attr and faDirectory) = faDirectory) then begin
             Result.Add(AFileName)
           end
           else begin
             GetAllSubFoldersInner(AFileName);
           end;
         end;
         Done := FindNext(Rec) <> 0;
        end;
      FindClose(Rec);
    end;
  end;

begin
  Result := TStringList.Create;
  Result.BeginUpdate;
  Result.Sorted := True;
  Result.Duplicates := dupIgnore;  // don't add duplicate filenames to the list

  GetAllSubFoldersInner(sPath);
  Result.EndUpdate;
end;

procedure TMain.Button1Click(Sender: TObject);
var
  T1,
  T2 : Integer;
  TL : TStringList;
begin
  T1 := GetTickCount;

  TL := GetAllSubfolders('D:\');

  try
    Memo1.Lines.BeginUpdate;
    try
      Memo1.Lines.Text := TL.Text;
    finally
      Memo1.Lines.EndUpdate;
    end;

    T2 := GetTickCount;

    Caption := Format('GetAll: %d, Load: %d, Files: %d', [T2 - T1, GetTickCount - T2, TL.Count]);
  finally
    TL.Free;
  end;
end;

如何在扫描文件夹/子文件夹/文件时降低CPU使用率？

2 个答案: