遍历指定目录下指定类型文件的函数

// ================================================================
// 遍历某个文件夹下某种文件,
// 使用说明
//  _GetFileList(ListBox1.Items,'c:/*.doc');
// _GetFileList(MyTStringList,'c:/*.exe');
// ================================================================
procedure TForm1._GetFileList(AStrings: TStrings ; ASourFile: string);
var sour_path,sour_file: string;
TmpList:TStringList;
FileRec:TSearchrec;
begin

sour_path:=ExtractFilePath(ASourFile);
sour_file:=ExtractFileName(ASourFile);

if not DirectoryExists(sour_path) then
begin
AStrings.Clear;
exit;
end;

TmpList:=TStringList.Create;
TmpList.Clear;

if FindFirst(sour_path+sour_file,faAnyfile,FileRec) = 0 then
repeat
if ((FileRec.Attr and faDirectory) = 0) then
begin
TmpList.Add(sour_path+FileRec.Name)
end;
until FindNext(FileRec)<>0;

SysUtils.FindClose(FileRec);

AStrings.Assign(TmpList);

TmpList.Free;
end;

// ================================================================
// 遍历某个文件夹及子文件夹下某种文件,
// 使用说明
//  _GetFileList(ListBox1.Items, 'c:/', '*.doc');
// _GetFileList(MyTStringList, 'c:/', '*.exe');
// ================================================================
procedure _GetFileList(AStrings: TStrings; ASourFile,
FileName: string);
var sour_path,sour_file: string;
TmpList:TStringList;
FileRec, subFileRec:TSearchrec;
i: Integer;
begin
if rightStr(trim(ASourFile), 1) <> '/' then
sour_path :=trim(ASourFile) + '/'
else
sour_path :=trim(ASourFile);
sour_file:= FileName;

if not DirectoryExists(sour_path) then
begin
AStrings.Clear;
exit;
end;

TmpList:=TStringList.Create;
TmpList.Clear;

if FindFirst(sour_path+'*.*',faAnyfile,FileRec) = 0 then
repeat
if ((FileRec.Attr and faDirectory) <> 0) then
begin
if ((FileRec.Name<> '.') and (FileRec.Name <> '..')) then
_GetFileList(AStrings, sour_path+ FileRec.Name + '/', sour_file);
end
else
if FindFirst(sour_path + FileName,faAnyfile,subFileRec) = 0 then
repeat
if ((subFileRec.Attr and faDirectory) = 0) then
TmpList.Add(sour_path+subFileRec.Name);
until FindNext(subFileRec)<>0;

until FindNext(FileRec)<>0;

SysUtils.FindClose(FileRec);
for i := 0 to TmpList.Count -1 do
AStrings.Add(TmpList.Strings[i]);

TmpList.Free;
end;

==================== 判断文件是否存在，是否正在使用 =====================================

function IsFileInUse(fName: string): boolean;
var
HFileRes: HFILE;
begin
Result := false;
if not FileExists(fName) then //如果文件不存在
exit;
HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE,
0 {this is the trick!}, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
Result := (HFileRes = INVALID_HANDLE_VALUE);
if not Result then
CloseHandle(HFileRes);
end;

调用

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
if IsFileInUse(OpenDialog1.FileName) = true then
showmessage('文件正在使用')
else
showmessage('文件没有使用');
end;
end;

====================遍历指定目录下指定类型文件==========================

procedure GetFileList(AStrings,AStrings2:TStrings;ASourFile,FExt:string); //递归遍历文件

调用: GetFileList(ListBox1.Items,ListBox2.Items,fpath,'.pis');
...
procedure TForm1.GetFileList(AStrings,AStrings2:TStrings;ASourFile,FExt: string);
var sour_path: string;
TmpList:TStringList;
FileRec:TSearchrec;
found: Integer;
begin
sour_path:=trim(ASourFile);

if not DirectoryExists(sour_path) then
begin
AStrings.Clear;
exit;
end;
TmpList:=TStringList.Create;
TmpList.Clear;

found:=FindFirst(sour_path+'*.*',faAnyfile,FileRec);
while found = 0 do
begin
if ((FileRec.Attr and faDirectory) <> 0) then
begin
if ((FileRec.Name<> '.') and (FileRec.Name <> '..')) then
GetFileList(AStrings,AStrings2,sour_path+FileRec.Name + '/',FExt);
end
else
if UpperCase(extractfileext(sour_path+FileRec.Name)) = UpperCase(FExt) then
begin
AStrings.Add(sour_path+FileRec.Name);
AStrings2.Add(FileRec.Name);
end;
found:=FindNext(FileRec);
end;
FindClose(FileRec);
TmpList.Free;
end;