关于文件和目录的一个问题 (100分)

假设：目录A下边有两个子目录A1和A2（当然可能还有很多），A1目录下面有文件A11.mp3，
A12.mp3，A2下面有A21.mp3，A22.mp3（当然可能还有子目录和更多的文件），我想实现的
功能是：从根目录A自上往下逐级搜索，将所有的文件添加到一个数据库文件中，记录其文
件名及其路径，多谢！

//函数名: FindDisk
//参数:
// PathName:string 路径

//返回:无
//描述: 本函数将搜索指定路径下面的所有扩展名在FilterString中的文件,
// BSSubDirectory标志是真,则搜索指定目录下面的所有子目录.并且将
// 搜索到的文件名(含全路径)添加到FileList列表中.可以搜索只读文
// 件和隐藏文件.
procedure TFrmAceptXj.FindDisk(PathName:String );
var
fRec :TSearchRec;
filestring,tmpPathName,tmpstring:String ;
HaveBeen:boolean;
iLen:integer;
i:integer;

begin
iLen:=StrLen(PChar(PathName));
if(PathName[iLen]<>'/')then
begin
PathName:=PathName+'/';
end;
tmpPathName:=PathName+'*.*';
//找第一个文件
if(FindFirst(tmpPathName,faAnyFile,fRec)=0 ) then
begin

if((fRec.Attr>=faDirectory) and
(fRec.Attr <= 19 )) then //faDirectory+nfaReadOnly +faHidden
begin //如是目录
if((fRec.Name<>'.') and (fRec.Name <> '..'))then
begin
tmpPathName := PathName + fRec.Name+'/';
if(BSSubDirectory=true)then//是否搜索子目录
FindDisk(tmpPathName); //递归调用本身
end
end
else
begin //不是目录
HaveBeen:=false;
for i:=0 to FFilterCount-1 do
begin
//是否在条件内
tmpstring:= StrLower(PChar(fRec.Name));
if(StrPos(PChar(tmpstring),PChar(FilterString))<> nil)then
begin
HaveBeen:=true;
break;
end;
end ;
if(HaveBeen= true) then
begin //如符合条件
FileList.Add(PathName + Trim(fRec.Name));
end
end;
end
else exit;

while(true) do
begin
if(FindNext(fRec)=0 )then
begin
if((fRec.Attr>=faDirectory)and(fRec.Attr<=19)) then
begin
if((fRec.Name<>'.') and ( fRec.Name<>'..'))then
begin
tmpPathName := PathName +Trim(fRec.Name) + '/';
if(BSSubDirectory =true)then // //是否搜索子目录
FindDisk(tmpPathName);
end;
end
else
begin
HaveBeen:=false;
for i:=0 to FFilterCount-1 do
begin
tmpstring:= StrLower(PChar(fRec.Name));
if(StrPos(PChar(tmpstring),PChar(FilterString))<> nil)then
begin
HaveBeen:=true;
break;
end;
end;
if(HaveBeen=true )then
begin
FileList.Add(PathName + trim(fRec.Name));
end;
end;
end
else break;
end;

end;

以下也可参考：

删除子目录及其下文件

This doesn't check for attributes being set, which might preclude deletion of a file. Put a {$I-} {$I+} pair around the functions that cause the problem.

procedure removeTree (DirName: string);
var
FileSearch: SearchRec;
begin
{ first, go through and delete all the directories }
chDir (DirName);
FindFirst ('*.*', Directory, FileSearch);
while (DosError = 0) do
begin
if (FileSearch.name <> '.')
AND (FileSearch.name <> '..')
AND ((FileSearch.attr AND Directory) <> 0)
then begin
if DirName[length(DirName)] = '/' then
removeTree (DirName+FileSearch.Name)
else
removeTree (DirName+'/'+FileSearch.Name);
ChDir (DirName);
end;
FindNext (FileSearch)
end;
{then, go through and delete all the files }
FindFirst ('*.*', AnyFile, FileSearch);
while (DosError = 0) do
begin
if (FileSearch.name <> '.')
AND (FileSearch.name <> '..') then
Remove (workdir); ??Remove和WorkDir是何意，删除文件？
end; ??此行似乎不该有
FindNext (FileSearch)
end;
rmDir (DirName) ??应进入上层目录
end;

嗯，多谢，接受答案了！