当前位置: 行情首页 >> 技术文章 >> 技术文章 >> 怎样实现DelTree的功能?

  • 怎样实现DelTree的功能? Delphi / VCL组件开发及应用
  • 2007-10-18 15:40:32 杭州电脑数码城 转载来源:csdn.net
  • 社区 - Delphi / VCL组件开发及应用

    怎样实现DelTree的功能?

    delphi_fan () 2000-02-01 19:57:00在 Delphi / VCL组件开发及应用 提问

    用api 函数 shfileoperation 好象只能删空目录。
    问题点数:0、回复次数:7

    1楼 pipimei () 回复于 2000-02-01 20:04:00 得分 0


    使用RemoveDir函数。

    2楼 () 回复于 2000-02-01 20:18:00 得分 0


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

    3楼 929 () 回复于 2000-02-02 13:51:00 得分 0


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

    4楼 Venne (感觉一下) 回复于 2000-02-02 14:37:00 得分 0


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

    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;

    5楼 wyj () 回复于 2000-02-02 16:31:00 得分 0


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

    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;

    6楼 wyj () 回复于 2000-02-02 16:32:00 得分 0


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

    7楼 jll (你快乐,所以我快乐) 回复于 2000-02-04 00:09:00 得分 0


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

    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;

竟价广告:

    业界行情新闻声明事项:

    • ☉本网转载出于传递更多信息之目的,并不意味着赞同其观点或证实其内容的真实性!
    • ☉如其他媒体、网站或个人从本网下载使用,必须保留本网注明的“稿件来源”,并自负版权等法律责任。如对稿件内容有疑议,请及时与我们联系.
    • ☉如本网转载稿涉及版权等问题,请作者在速来电或来函与杭州电脑数码城网联系.
    • ☉本站网址:http://www.ititt.com/投诉邮箱:6371222@qq.com