unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const
{$IFDEF LINUX}
PathSeparator = '/';
{$ENDIF LINUX}
{$IFDEF
WIN32}
DriveLetters = ['a'..'z', 'A'..'Z'];
PathDevicePrefix = '\\.\';
PathSeparator = '\';
PathUncPrefix = '\\';
{$ENDIF
WIN32}
type
TDelTreeProgress = function (const FileName: string; Attr: DWORD): Boolean;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
function DelTree(const Path: string): Boolean;
function PathRemoveSeparator(const Path: string): string;
function BuildFileList(const Path: string; const Attr: Integer; const List: TStrings): Boolean;
function DelTreeEx(const Path: string; AbortOnFailure: Boolean; Progress: TDelTreeProgress): Boolean;
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses filectrl;
function TForm1.DelTree(const Path: string): Boolean;
begin
Result := DelTreeEx(Path, False, nil);
end;
//------------------------------------------------------------------------------
function TForm1.DelTreeEx(const Path: string; AbortOnFailure: Boolean; Progress: TDelTreeProgress): Boolean;
var
Files: TStringList;
LPath: string; // writable copy of Path
FileName: string;
I: Integer;
PartialResult: Boolean;
Attr: DWORD;
begin
Result := True;
Files := TStringList.Create;
try
LPath := PathRemoveSeparator(Path);
BuildFileList(LPath + '\*.*', faAnyFile, Files);
for I := 0 to Files.Count - 1 do
begin
FileName := LPath + '\' + Files[I];
PartialResult := True;
// If the current file is itself a directory then recursively delete it
Attr := GetFileAttributes(PChar(FileName));
if (Attr <> DWORD(-1)) and ((Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
PartialResult := DelTreeEx(FileName, AbortOnFailure, Progress)
else
begin
if Assigned(Progress) then
PartialResult := Progress(FileName, Attr);
if PartialResult then
begin
// Set attributes to normal in case it's a readonly file
PartialResult := SetFileAttributes(PChar(FileName), FILE_ATTRIBUTE_NORMAL);
if PartialResult then
PartialResult := DeleteFile(FileName);
end;
end;
if not PartialResult then
begin
Result := False;
if AbortOnFailure then
Break;
end;
end;
finally
FreeAndNil(Files);
end;
if Result then
begin
// Finally remove the directory itself
Result := SetFileAttributes(PChar(LPath), FILE_ATTRIBUTE_NORMAL);
if Result then
begin
{$I-}
RmDir(LPath);
{$I+}
Result := IOResult = 0;
end;
end;
end;
function TForm1.PathRemoveSeparator(const Path: string): string;
var
L: Integer;
begin
L := Length(Path);
if (L <> 0) and (AnsiLastChar(Path) = PathSeparator) then
Result := Copy(Path, 1, L - 1)
else
Result := Path;
end;
function TForm1.BuildFileList(const Path: string; const Attr: Integer;
const List: TStrings): Boolean;
var
SearchRec: TSearchRec;
R: Integer;
begin
Assert(List <> nil);
R := FindFirst(Path, Attr, SearchRec);
Result := R = 0;
if Result then
begin
while R = 0 do
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
List.Add(SearchRec.Name);
R := FindNext(SearchRec);
end;
Result := R = ERROR_NO_MORE_FILES;
SysUtils.FindClose(SearchRec);
end;
end;
//------------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
if DirectoryExists(edit1.text)then
begin
DELTREE(edit1.text);
end;
end;
end.