怎样实现DelTree的功能？

[delphi_fan]

用api 函数　shfileoperation 好象只能删空目录。

[pipimei]

使用RemoveDir函数。

[winterlove]

有两种方式：
第一：广度搜索，这种算法效率较高；
第二：深度搜索，微软Dos下的Deltree就是这样实现的，用递归实现。

[929]

用REMOVEDIR函数不行，REMOVEDIR只能删除空目录。DELPHI的RMDIR过程及API函数REMOVEDIRETORY也只能删掉空目录。还是按WINTERLOVE的做法做吧。要不然如果有DOS的话，直接应用WINEXEC（‘DELTREE XX’）得了。

[Venne]

这是递归的删除源码，你可能需要自己加上一些出错控制。

procedure TForm1.deltree(nowpath: string);
var
search:TSearchRec;
ret:integer;
key:string;
begin
if NowPath[Length(NowPath)]<>'\' then
NowPath:=NowPath+'\';
key:=Nowpath+'*.*';
ret:=findFirst(key,faanyfile,search);
while ret=0 do begin
if ((search.Attr and fadirectory)= faDirectory)
then begin
if (Search.Name <>'.') and (Search.name<>'..') then
Deltree(NowPath+Search.name);
end else begin
if ((search.attr and fadirectory)<> fadirectory) then begin
deletefile(NowPath+search.name);
end;
end;
ret:=FindNext(search);
end;
findClose(search);
removedir(NowPath);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
screen.cursor:=crHourClass;
deltree('c:\temp');
screen.cursor:=crDefault;

end;

[wyj]

用递归较简单，下面这段程序是我自己写的：

function DeleteDirectory(sPath:String):Boolean;
var
SR:TSearchRec;
begin
Result:=True;
try
if FindFirst(sPath+'*.*',faAnyFile and (not faVolumeId),SR)=0 then
begin
Repeat
begin
FileSetAttr(sPath+Trim(SR.Name),SR.Attr and not (faReadOnly or faHidden or faSysFile));
if (faDirectory and SR.Attr)=0 then
DeleteFile(sPath+Trim(SR.Name))
else if (SR.Name<>'.') and (SR.Name<>'..') then
begin
DeleteAllFilesOnDirectory(sPath+Trim(SR.Name)+'\');
DeleteFile(sPath+Trim(SR.Name));
end;
end;
Until FindNext(SR)<>0;
FindClose(SR);
end;
except
on EInOutError do
Result:=False;
end;
if Result=False then
ShowMessage('删除目录'+sPath+'中的文件时出错,可能磁盘已损坏或写保护口未打开.');
end;

[wyj]

不好意思，打错了一个单词，应当是：
function DeleteDirectory(sPath:String):Boolean;
var
SR:TSearchRec;
begin
Result:=True;
try
if FindFirst(sPath+'*.*',faAnyFile and (not faVolumeId),SR)=0 then
begin
Repeat
begin
FileSetAttr(sPath+Trim(SR.Name),SR.Attr and not (faReadOnly or faHidden or faSysFile));
if (faDirectory and SR.Attr)=0 then
DeleteFile(sPath+Trim(SR.Name))
else if (SR.Name<>'.') and (SR.Name<>'..') then
begin
DeleteDirectory(sPath+Trim(SR.Name)+'\');
DeleteFile(sPath+Trim(SR.Name));
end;
end;
Until FindNext(SR)<>0;
FindClose(SR);
end;
except
on EInOutError do
Result:=False;
end;
if Result=False then
ShowMessage('删除目录'+sPath+'中的文件时出错,可能磁盘已损坏或写保护口未打开.');
end;

[jll]

以下是本人的解决方案，带出错保护和注释信息。注意：遇到只读类文件或文件夹就无能为力了。

function JudgeDir(Attr:integer):boolean;
{判断是否是目录}
var
i:integer;
begin
i:=Attr; if i>=32 then i:=i-32; //排除文档文件
if i>=16
then Result:=true
else Result:=false; //返回是否是目录
end;

function DelTree(Dir:string):integer;
{删除整个目录，含出错处理，返回值为出错的文件数目}
var
Sr:TSearchRec; Err,ErrorFile,i:integer;
CurFilePath,TempFilePath:string;
begin
ErrorFile:=0; //初始化错误文件数
CurFilePath:=Dir; TempFilePath:=CurFilePath; //初始化
Err:=FindFirst(Dir+'\*.*',$37,Sr); //查找第一个文件
while (Err = 0) do
begin
if Sr.Name[1]<>'.' //判断特殊目录"."和".."
then begin
if JudgeDir(Sr.Attr)
then begin //处理目录情况
TempFilePath:=CurFilePath; //保存当前目录
CurFilePath:=CurFilePath+'\'+Sr.Name;
i:=DelTree(CurFilePath); //递归调用
if i<>0 then ErrorFile:=ErrorFile+i-1;
ChDir('..'); //返回上一级目录
if not RemoveDir(CurFilePath)
then ErrorFile:=ErrorFile+1; //删除目录
CurFilePath:=TempFilePath; //恢复当前目录
end
else begin //处理文件情况
if not DeleteFile(CurFilePath+'\'+Sr.Name)
then ErrorFile:=ErrorFile+1;
end;
end;
Err:=FindNext(Sr); //查找下一个文件或目录
end;
ChDir('..'); //返回总目录
if not RemoveDir(Dir) then ErrorFile:=ErrorFile+1;
//处理无法删除总目录
Result:=ErrorFile; //返回出错的文件数目
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin //DelTree中的参数就是待删除的目录
i:=DelTree('D:\1'); //删除"D:\1"目录下所有文件和子目录
if i<>0 //提示出错的文件数目
then MessageDlg('未删除文件和目录:'+IntToStr(i),mtWarning,[mbOK],0);
end;