procedure TForm1.Button1Click(Sender: TObject); var SearchRec:TSearchRec; found:integer; NameOld:string; begin path:='C:\Users\lenovo\Desktop\AutoCad资料\'; found:=FindFirst(path+'*.*',faAnyFile,SearchRec); while found=0 do begin if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') and (SearchRec.Attr<>faDirectory) then begin NameOld:=SearchRec.Name; end; found:=FindNext(SearchRec); end; FindClose(SearchRec); end;'.'当前目录,'..'上级目录 faDirectory文件夹
Delphi遍历文件夹及子文件夹 {------------------------------------------------------------------------------- 过程名: MakeFileList 遍历文件夹及子文件夹 作者: SWGWEB 日期: 2007.11.25 参数: Path,FileExt:string 1.需要遍历的目录 2.要遍历的文件扩展名 返回值: TStringList Eg:ListBox1.Items:= MakeFileList( 'E:\极品飞车','.exe') ; ListBox1.Items:= MakeFileList( 'E:\极品飞车','.*') ; -------------------------------------------------------------------------------} function 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; SysUtils.FindClose(sch); end; end;
function 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; SysUtils.FindClose(sch); end; end;
procedure SearchFiles(const MainPath: string; FoundResult: TStringList;
const FileExt: string; const AddFilePath: Boolean);
function IsValidFile(SearchRec: TSearchRec): Boolean;
begin
Result := (SearchRec.Name <> '.') and//排除掉文件夹
(SearchRec.Name <> '..') and//排除掉文件夹
(SearchRec.Attr and faDirectory <> faDirectory) and//排除掉文件夹
((FileExt = '') or//FileExt = ''代表查找所有类型的文件,不为空则只查找指定类型的文件,如.txt
(LowerCase(ExtractFileExt(SearchRec.Name)) = LowerCase(FileExt)));
end;
var
SR: TSearchRec;
sFilePattern: string;
Finished: integer;
begin
if MainPath = '' then exit;//如果查找的目录为空则退出
sFilePattern := MainPath;
if sFilePattern[Length(sFilePattern)] <> '\' then
sFilePattern := sFilePattern + '\';
Finished := FindFirst(sFilePattern + '*.*', faAnyFile, SR);//查找第一个文件
while (Finished = 0) do//Finished = 0说明有找到文件,所以进入循
begin
if IsValidFile(SR) then//是否是文件,过滤掉文件夹
begin
if AddFilePath then//是否添加全路径
FoundResult.Add(sFilePattern + SR.Name)
else
FoundResult.Add(SR.Name);
end;
Finished := FindNext(SR);//查找下一个文件
end;
FindClose(SR);//关闭查找
//FoundResult.Sort;
FoundResult.Sorted := False;
FoundResult.Sorted := True;//将查找到的文件名排序
end;
procedure TForm2.Button1Click(Sender: TObject);
var
lsTxtFiles: TStringList;
begin
lsTxtFiles := TStringList.Create;
try
SearchFiles('C:/', lsTxtFiles, '.txt', False);
Memo1.Lines.AddStrings(lsTxtFiles);
finally
lsTxtFiles.Free;
end;
end;
http://download.csdn.net/detail/xstdljj/4410553
procedure TForm1.Button1Click(Sender: TObject);
var
SearchRec:TSearchRec;
found:integer;
NameOld:string;
begin
path:='C:\Users\lenovo\Desktop\AutoCad资料\';
found:=FindFirst(path+'*.*',faAnyFile,SearchRec);
while found=0 do
begin
if (SearchRec.Name<>'.') and (SearchRec.Name<>'..')
and (SearchRec.Attr<>faDirectory) then
begin
NameOld:=SearchRec.Name;
end;
found:=FindNext(SearchRec);
end;
FindClose(SearchRec);
end;'.'当前目录,'..'上级目录 faDirectory文件夹
Delphi遍历文件夹及子文件夹
{-------------------------------------------------------------------------------
过程名: MakeFileList 遍历文件夹及子文件夹
作者: SWGWEB
日期: 2007.11.25
参数: Path,FileExt:string 1.需要遍历的目录 2.要遍历的文件扩展名
返回值: TStringList
Eg:ListBox1.Items:= MakeFileList( 'E:\极品飞车','.exe') ;
ListBox1.Items:= MakeFileList( 'E:\极品飞车','.*') ;
-------------------------------------------------------------------------------}
function 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;
SysUtils.FindClose(sch);
end;
end;
function 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;
SysUtils.FindClose(sch);
end;
end;