DelTree

uses FileCtrl; procedure DelTree(const Directory: TFileName);
var
DrivesPathsBuff: array[0..1024] of char;
DrivesPaths: string;
len: longword;
ShortPath: array[0..MAX_PATH] of char;
dir: TFileName;
procedure rDelTree(const Directory: TFileName);
var
SearchRec: TSearchRec;
Attributes: LongWord;
ShortName, FullName: TFileName;
pname: pchar;
begin
if FindFirst(Directory + '*', faAnyFile and not faVolumeID,
SearchRec) = 0 then begin
try
repeat // 检测所有的文件和目录
if SearchRec.FindData.cAlternateFileName[0] = #0 then
ShortName := SearchRec.Name
else
ShortName := SearchRec.FindData.cAlternateFileName;
FullName := Directory + ShortName;
if (SearchRec.Attr and faDirectory) <> 0 then begin
// 是一个目录
if (ShortName <> '.') and (ShortName <> '..') then
rDelTree(FullName + ');
end else begin
// 是一个文件
pname := PChar(FullName);
Attributes := GetFileAttributes(pname);
if Attributes = $FFFFFFFF then
raise EInOutError.Create(SysErrorMessage(GetLastError));
if (Attributes and FILE_ATTRIBUTE_READONLY) <> 0 then
SetFileAttributes(pname, Attributes and not
FILE_ATTRIBUTE_READONLY);
if Windows.DeleteFile(pname) = False then
raise EInOutError.Create(SysErrorMessage(GetLastError));
end;
until FindNext(SearchRec) <> 0;
except
FindClose(SearchRec);
raise;
end;
FindClose(SearchRec);
end;
if Pos(#0 + Directory + #0, DrivesPaths) = 0 then begin
// 如果不是根目录，就删除
pname := PChar(Directory);
Attributes := GetFileAttributes(pname);
if Attributes = $FFFFFFFF then
raise EInOutError.Create(SysErrorMessage(GetLastError));
if (Attributes and FILE_ATTRIBUTE_READONLY) <> 0 then
SetFileAttributes(pname, Attributes and not
FILE_ATTRIBUTE_READONLY);
if Windows.RemoveDirectory(pname) = False then begin
raise EInOutError.Create(SysErrorMessage(GetLastError));
end;
end;
end;
// ----------------
begin
DrivesPathsBuff[0] := #0;
len := GetLogicalDriveStrings(1022, @DrivesPathsBuff[1]);
if len = 0 then
raise EInOutError.Create(SysErrorMessage(GetLastError));
SetString(DrivesPaths, DrivesPathsBuff, len + 1);
DrivesPaths := Uppercase(DrivesPaths);
len := GetShortPathName(PChar(Directory), ShortPath, MAX_PATH);
if len = 0 then
raise EInOutError.Create(SysErrorMessage(GetLastError));
SetString(dir, ShortPath, len);
dir := Uppercase(dir);
rDelTree(IncludeTrailingBackslash(dir));
end;
　
Sample calls
------------
删除 C:　目录
DelTree('C:');
使用方法：
DelTree('A:'); // or DelTree('A;