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