200分求： 如何快速遍历某个文件夹内的所有文件（包括子目录文件）！还有100分在Delphi 语言基础/算法/系统设计问题 里！

[d7fans]

遍历过程中获取文件修改时间和大小，存入字符串列表中。

我试过用递归的方法，没用线程做， 但比较费时间，遍历对象是局域网内的其他机子上的内容，局域网为100MB连接，1个GB的内容要40秒左右，但在同样的情况下，我用同步大师进行遍历，却只要2－3秒，而且遍历整个D盘也只要10左右，（D盘有89.4GB），我不知道它是怎么做的，但速度却是很快！

这个问题我比较急！希望大家能给我点意见！

[ksaiy]

基本用递归也差不多是最优算法。

只是在处理的时候采用了其它的技术，比如多线程等等。

[zwb666]

up

[zdq801104]

UP

[hsmserver]

unit MainFrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, FileCtrl, Grids, Outline, DirOutln;

type
TMainForm = class(TForm)
dcbDrives: TDriveComboBox;
edtFileMask: TEdit;
lblFileMask: TLabel;
btnSearchForFiles: TButton;
lbFiles: TListBox;
dolDirectories: TDirectoryOutline;
procedure btnSearchForFilesClick(Sender: TObject);
procedure dcbDrivesChange(Sender: TObject);
private
FFileName: String;
function GetDirectoryName(Dir: String): String;
procedure FindFiles(APath: String);
end;

var
MainForm: TMainForm;

implementation

{$R *.DFM}

function TMainForm.GetDirectoryName(Dir: String): String;
{ This function formats the directory name so that it is a valid
directory containing the back-slash (\) as the last character. }
begin
if Dir[Length(Dir)]<> '\' then
Result := Dir+'\'
else
Result := Dir;
end;

procedure TMainForm.FindFiles(APath: String);
{ This is a procedure which is called recursively so that it finds the
file with a specified mask through the current directory and its
sub-directories. }
var
FSearchRec,
DSearchRec: TSearchRec;
FindResult: integer;

function IsDirNotation(ADirName: String): Boolean;
begin
Result := (ADirName = '.') or (ADirName = '..');
end;

begin
APath := GetDirectoryName(APath); // Obtain a valid directory name
{ Find the first occurrence of the specified file name }
FindResult := FindFirst(APath+FFileName,faAnyFile+faHidden+
faSysFile+faReadOnly,FSearchRec);
try
{ Continue to search for the files according to the specified
mask. If found, add the files and their paths to the listbox.}
while FindResult = 0 do
begin
lbFiles.Items.Add(LowerCase(APath+FSearchRec.Name));
FindResult := FindNext(FSearchRec);
end;

{ Now search the sub-directories of this current directory. Do this
by using FindFirst to loop through each subdirectory, then call
FindFiles (this function) again. This recursive process will
continue until all sub-directories have been searched. }
FindResult := FindFirst(APath+'*.*', faDirectory, DSearchRec);

while FindResult = 0 do
begin
if ((DSearchRec.Attr and faDirectory) = faDirectory) and not
IsDirNotation(DSearchRec.Name) then
FindFiles(APath+DSearchRec.Name); // Recursion here
FindResult := FindNext(DSearchRec);
end;
finally
FindClose(FSearchRec);
end;
end;

procedure TMainForm.btnSearchForFilesClick(Sender: TObject);
{ This method starts the searching process. It first changes the cursor
to an hourglass since the process may take awhile. It then clears the
listbox and calls the FindFiles() function which will be called
recursively to search through sub-directories }
begin
Screen.Cursor := crHourGlass;
try
lbFiles.Items.Clear;
FFileName := edtFileMask.Text;
FindFiles(dolDirectories.Directory);
finally
Screen.Cursor := crDefault;
end;
end;

procedure TMainForm.dcbDrivesChange(Sender: TObject);
begin
dolDirectories.Drive := dcbDrives.Drive;
end;

end.
//自己看一下吧，或许对你有些帮助

[蓝色光芒]

uses
Windows, SysUtils , Classes , ShlObj,ComObj,ActiveX;

Function SearchFileAtW(SPath,Filter:String;InChildDir:Boolean; var StrLS : TStringList):Boolean;
Function SearchFileS(SPath,Filter:String;InChildDir : Boolean ; var StrLS : TStringList ) : Boolean;
var
i: Integer;
SearchRec: TSearchRec;
FileName : String;
begin
Result := True;
if copy(Spath,Length(Spath),1)<>'\' then SPath := SPath+'\';
try
i:=FindFirst(SPath+Filter,faAnyFile,SearchRec);
except
Result := False;
exit;
end;
while i=0 do begin
FileName := SearchRec.name;
if Fileexists(SPath+FileName) then StrLS.Add(SPath+FileName)
else if (FileName<>'.') and (FileName<>'..') then
begin
if InChildDir then SearchFileS(SPath+FileName,Filter,InChildDir,StrLS)
else StrLS.Add(SPath+FileName);
end
else if FileName='..' then StrLS.Add(SPath);
i := FindNext(SearchRec);
end;
try
i:=FindFirst(SPath+'*.*',faDirectory,SearchRec);
except
Result := False;
exit;
end;
while i=0 do begin
FileName := SearchRec.name;
if Fileexists(SPath+FileName) then
else if (FileName<>'.') and (FileName<>'..') then
begin
if InChildDir then SearchFileS(SPath+FileName,Filter,InChildDir,StrLS)
else StrLS.Add(SPath+FileName);
end;
// else if FileName='..' then StrLS.Add(SPath);
i := FindNext(SearchRec);
end;

end;


例子：SearchFileAtW('C:\Windows\','*.EXE',True,StrList);
Memo1.Text := StrList.Text

[ahjoe]

我有控件，搜索速度与文件个数有关，与文件的尺寸是没关的。

[jackie168]

procedure TForm1.Button1Click(Sender: TObject);
var ss:TSearchRec;
filepath:string;
begin
filepath:='c:\';
listbox1.Items.Clear;
if FindFirst(filepath+'\*.*',faanyfile,ss)=0 then
begin
if not ((ss.attr and fadirectory)=fadirectory) then
listbox1.items.Add(ss.name);
while findnext(ss)=0 do
begin
if not((ss.attr and fadirectory)=fadirectory) then
listbox1.items.add(ss.Name);
end;
findclose(ss);
end;
end;