怎样实现DelTree的功能？

Question

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

Answer 1

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

Answer 2

这是递归的删除源码，你可能需要自己加上一些出错控制。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;

Answer 3

用递归较简单，下面这段程序是我自己写的：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;

Answer 4

不好意思，打错了一个单词，应当是：
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;

Answer 5

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