Mega Code Archive
Delete an entire directory tree using recursion
<![CDATA[
Title: Delete an entire directory tree using recursion
Question: How do I use recursion to delete a directory and all of its subirectories and files?
Answer:
{Use this unit to remove an entire directory tree
using recursion}
unit DeleTree;
interface
uses Classes, FileCtrl, SysUtils;
procedure RemoveTree(path: string);
procedure RemoveDirectory(path: string);
procedure GetFileList(FileSpec: string;
NamesOnly: Boolean;
var FileList: TStringList);
procedure GetSubDirList(DirRoot: string;
NamesOnly: Boolean;
var SubDirList: TStringList);
function BackSlash(FileSpec: string): string;
function NoBackSlash(FileSpec: string): string;
implementation
{--------------------------------------------------------}
{this procedure will remove an entire directory tree}
procedure RemoveTree(path: string);
var
SubDirList: TStringList;
FileList: TStringList;
i: integer;
begin
SubDirList := TStringList.Create;
GetSubDirList(path,False,SubDirList);
{if this tree has more than one sub-directory
then recurse to remove each sub-directory tree}
if SubDirList.Count0 then
begin
for i := 0 to SubDirList.Count-1 do
begin
RemoveTree(SubDirList[i]);
end;
end;
SubDirList.free;
{if we are here then all sub-directory trees have been
removed, or there were none. So we only need to
delete all the files}
FileList := TStringList.Create;
GetFileList(BackSlash(path)+'*.*',False,FileList);
for i := 0 to FileList.Count-1 do
begin
DeleteFile(PChar(FileList[i]));
end;
FileList.Free;
RemoveDirectory(path);
end;
{--------------------------------------------------------}
{this procedure will remove a directory if it exists}
procedure RemoveDirectory(path: string);
var
Dir: string;
begin
{remove the final back-slash if one exists}
Dir := NoBackSlash(path);
if DirectoryExists(Dir) then RmDir(Dir);
end;
{--------------------------------------------------------}
{this procedure will fill a StringList with the names of
all files matching the FileSpec. If NamesOnly is true
then the path will not be included}
procedure GetFileList(FileSpec: string;
NamesOnly: Boolean;
var FileList: TStringList);
var
SR: TSearchRec;
DosError: integer;
begin
FileList.Clear;
DosError := FindFirst(FileSpec, faAnyFile-faDirectory, SR);
while DosError=0 do
begin
if NamesOnly
then FileList.Add(SR.Name)
else FileList.Add(ExtractFilePath(FileSpec)+SR.Name);
DosError := FindNext(SR);
end;
end;
{--------------------------------------------------------}
{this procedure will fill a StringList with the names of
all sub-directories in the directory specified by DirRoot.
If NamesOnly is true then only the deepest directory
names will be included}
procedure GetSubDirList(DirRoot: string;
NamesOnly: Boolean;
var SubDirList: TStringList);
var
SR: TSearchRec;
DosError: integer;
Root: string;
begin
SubDirList.Clear;
{add a final backslash if none exists}
Root := BackSlash(DirRoot);
{use FindFirst/FindNext to return only directories}
DosError := FindFirst(Root+'*.*', faDirectory, SR);
while DosError=0 do
begin
{don't include the directories . and ..}
if pos('.',SR.Name)1 then
begin
if SR.Attr=faDirectory then
begin
if NamesOnly
then SubDirList.Add(SR.Name)
else SubDirList.Add(Root+SR.Name);
end;
end;
DosError := FindNext(SR);
end;
end;
{--------------------------------------------------------}
{Add a backslash if none exists}
function BackSlash(FileSpec: string): string;
begin
if (FileSpec[length(FileSpec)]'\')
then Result := FileSpec+'\'
else Result := FileSpec;
end;
{Remove a backslash if one exists}
function NoBackSlash(FileSpec: string): string;
begin
if (FileSpec[length(FileSpec)]='\')
then Result := Copy(FileSpec,1,length(FileSpec)-1)
else Result := FileSpec;
end;
end.
]]>