《Delphi 版 everything、光速搜索代码》 关于获取文件全路径 GetFullFileName 函数的优化

本文介绍了一种针对Delphi版Everything搜索工具的优化方法,通过先处理目录以减少重复查询,实现文件全路径获取效率的提升。对于百万级文件数量,处理速度可达到数秒级别。

《Delphi 版 everything、光速搜索代码》,文章中关于获取文件全路径的函数:GetFullFileName,有一个地方值得优化。

就是有多个文件,它们可能属于同一个目录。

譬如 System32 目录下有2000多个文件,GetFullFileName 还是进行了2000多次的查询,效率肯定是受影响的。

先处理目录,获取目录全路径名称。

然后文件只用查询一次,就知道它的父路径的全路径了。效率肯定会提高的。尝试了一下。

{ 获取文件全路径,包含路径和文件名 }
procedure GetFullFileName(var FileList: TStringList; const chrLogiclDiskName: Char; const bSort: Boolean = False);
var
  UInt64DirList    : TArray<UInt64>;
  III              : Integer;
  UPID             : UInt64;
  intIndex         : Integer;
  dirList          : TStringList;
  intDirectoryCount: Integer;
begin
  { 将 FileList 按 FileReferenceNumber 数值排序 }
  FileList.Sorted := False;
  FileList.CustomSort(Int64Sort);

  { 先处理目录,获取路径的全路径名称 }
  dirList := TStringList.Create;
  try
    { 获取目录的总数 }
    intDirectoryCount := 0;
    for III           := 0 to FileList.Count - 1 do
    begin
      if PFileInfo(FileList.Objects[III])^.bDirectory then
      begin
        Inc(intDirectoryCount);
      end;
    end;
    SetLength(UInt64DirList, intDirectoryCount);

    { 将所有目录信息添加到目录列表 }
    intDirectoryCount := 0;
    for III           := 0 to FileList.Count - 1 do
    begin
      if PFileInfo(FileList.Objects[III])^.bDirectory then
      begin
        dirList.AddObject(PFileInfo(FileList.Objects[III])^.strFileName, FileList.Objects[III]);
        UInt64DirList[intDirectoryCount] := PFileInfo(FileList.Objects[III])^.FileReferenceNumber;
        Inc(intDirectoryCount);
      end;
    end;

    { 获取目录的全路径名称 }
    intDirectoryCount := 0;
    for III           := 0 to FileList.Count - 1 do
    begin
      if PFileInfo(FileList.Objects[III])^.bDirectory then
      begin
        UPID := PFileInfo(FileList.Objects[III])^.ParentFileReferenceNumber;
        while TArray.BinarySearch(UInt64DirList, UPID, intIndex) do
        begin
          UPID                  := PFileInfo(dirList.Objects[intIndex])^.ParentFileReferenceNumber;
          FileList.Strings[III] := PFileInfo(dirList.Objects[intIndex])^.strFileName + '\' + FileList.Strings[III];
        end;
        FileList.Strings[III]              := (chrLogiclDiskName + ':\' + FileList.Strings[III]);
        dirList.Strings[intDirectoryCount] := FileList.Strings[III];
        Inc(intDirectoryCount);
      end;
    end;

    { 再获取每个文件的全路径 }
    for III := 0 to FileList.Count - 1 do
    begin
      if not PFileInfo(FileList.Objects[III])^.bDirectory then
      begin
        UPID := PFileInfo(FileList.Objects[III])^.ParentFileReferenceNumber;
        if TArray.BinarySearch(UInt64DirList, UPID, intIndex) then
        begin
          FileList.Strings[III] := dirList.Strings[intIndex] + '\' + FileList.Strings[III];
        end
        else
        begin
          FileList.Strings[III] := chrLogiclDiskName + '\' + FileList.Strings[III];
        end;
      end;
    end;

    { 将所有文件按文件名排序 }
    if bSort then
      FileList.Sort;
  finally
    dirList.Free;
  end;
end;

这个函数比原来的函数效率上刚好提高了一倍。

100万个的文件,耗时4秒左右。200万个的文件,耗时8秒左右。

 

 

注:原有的  TFileInfo 添加个目录属性:

  TFileInfo = record
    strFileName: String;               // 文件名称
    bDirectory: Boolean;               // 是否是目录 <增加>
    FileReferenceNumber: UInt64;       // 文件的ID
    ParentFileReferenceNumber: UInt64; // 文件的父ID

  end;

在代码 

FileList.AddObject(strFileName, TObject(pfi)); 

前,添加一行:

pfi^.bDirectory  := UsnRecord^.FileAttributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY;

源码:https://github.com/dbyoung720/PBox/tree/master/module/uFiles

 
搜索TXT 文件的示例unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls; type TForm1 = class(TForm) ListBox1: TListBox; Memo2: TMemo; Panel1: TPanel; Label1: TLabel; Label2: TLabel; Label3: TLabel; Edit1: TEdit; ButtonSearchFile: TButton; FolderPath: TEdit; FileExt: TEdit; ProgressBar1: TProgressBar; procedure ButtonSearchFileClick(Sender: TObject); procedure ListBox1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } procedure SearchFile1(FileName: string; FindText: string); function MakeFileList(Path, FileExt: string): TStringList; function FileInUsed(FileName: TFileName): Boolean; public { Public declarations } end; var Form1: TForm1; implementation uses StrUtils; {$R *.dfm} { Search Options KeyWord in file FileName FileSize FileCreateTime FileModifyTime keyword filepath openfile found addListbox } var FileNamePathList, FileNameList: TStringList; procedure TForm1.FormCreate(Sender: TObject); begin FileNameList := TStringList.Create; FileNamePathList := TStringList.Create; end; { if FileInUsed ('D:\Administrator\Documents\MyProjects\FileSearch\Win32\Debug\Project1.exe') then ShowMessage('File is in use.') else ShowMessage('File not in use.'); } function TForm1.FileInUsed(FileName: TFileName): Boolean; var HFileRes: HFILE; begin Result := False; if not FileExists(FileName) then Exit; // 如果文件不存在,返回false HFileRes := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); Result := (HFileRes = INVALID_HANDLE_VALUE); if not Result then CloseHandle(HFileRes); end; procedure TForm1.SearchFile1(FileName: string; FindText: string); var SearchList: TStringList; begin try SearchList := TStringList.Create; if FileExists(FileName) and (not FileInUsed(FileName)) then begin SearchList.LoadFromFile(FileName); if Boolean(Pos(UpperCase(FindText), UpperCase(SearchList.Text))) then begin FileNameList.Add(ExtractFileName(FileName)); FileNamePathList.Add(FileName); end; end; finally SearchList.Free; end; end; procedure TForm1.ButtonSearchFileClick(Sender: TObject); var I, n: Integer; List: TStringList; begin try ButtonSearchFile.Caption := 'SearchFile'; List := TStringList.Create; List.Clear; FileNameList.Clear; FileNamePathList.Clear; List := MakeFileList(FolderPath.Text, FileExt.Text); ProgressBar1.Max := List.Count; for I := 0 to List.Count - 1 do begin Application.ProcessMessages; SearchFile1(List[I], Edit1.Text); ProgressBar1.Position := I; end; ListBox1.Items.Text := FileNameList.Text; ButtonSearchFile.Caption := IntToStr(FileNamePathList.Count) + ' 条'; finally List.Free; end; end; { 这个过程得显示进度 } function TForm1.MakeFileList(Path, FileExt: string): TStringList; var sch: TSearchrec; begin Result := TStringList.Create; if RightStr(Trim(Path), 1) '\' then Path := Trim(Path) + '\' else Path := Trim(Path); if not DirectoryExists(Path) then begin Result.Clear; Exit; end; if FindFirst(Path + '*', faAnyfile, sch) = 0 then begin repeat Application.ProcessMessages; if ((sch.Name = '.') or (sch.Name = '..')) then Continue; if DirectoryExists(Path + sch.Name) then begin Result.AddStrings(MakeFileList(Path + sch.Name, FileExt)); end else begin if (UpperCase(ExtractFileExt(Path + sch.Name)) = UpperCase(FileExt)) or (FileExt = '.*') then Result.Add(Path + sch.Name); end; until FindNext(sch) 0; FindClose(sch); end; end; procedure TForm1.ListBox1Click(Sender: TObject); var s: string; txt: string; begin if not FileExists(FileNamePathList[ListBox1.ItemIndex]) then Exit; Memo2.Lines.LoadFromFile(FileNamePathList[ListBox1.ItemIndex]); Caption := FileNamePathList[ListBox1.ItemIndex]; txt := Form1.Memo2.Text; if Boolean(Pos(UpperCase(Edit1.Text), UpperCase(txt))) then begin Memo2.SetFocus; Memo2.SelStart := Pos(UpperCase(Edit1.Text), UpperCase(txt)) - 1; Memo2.SelLength := Length(Edit1.Text); end; end; end.
评论 5
成就一亿技术人!
拼手气红包6.0元
还能输入1000个字符
 
红包 添加红包
表情包 插入表情
 条评论被折叠 查看
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

dbyoung

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值