A parent directory D:\AAA has 2 child empty Directory D:\AAA\BB1 and D:\AAA\BB2
my requirement is how to remove empty Directory recursively.
Here are two function found on internet as below :
//remove empty Directory recursively
function RemoveEmptyDirectory(path: string) : Boolean;
var
MySearch: TSearchRec;
Ended: Boolean;
begin
if FindFirst(path + '\*.*', faDirectory, MySearch) = 0 then
begin
repeat
if ((MySearch.Attr and faDirectory) = faDirectory) and
(MySearch.Name[1] <> '.') then
begin
if DirectoryIsEmpty(path + '\' + MySearch.Name) then
TDirectory.Delete(path + '\' + MySearch.Name)
else
begin
RemoveEmptyDirectory(path + '\' + MySearch.Name);
if DirectoryIsEmpty(path + '\' + MySearch.Name) then
RemoveEmptyDirectory(path + '\' + MySearch.Name);
end;
end;
until FindNext(MySearch) <> 0;
FindClose(MySearch);
end;
end;
// check directory is empty or not
function DirectoryIsEmpty(Directory: string): Boolean;
var
SR: TSearchRec;
i: Integer;
begin
Result := False;
FindFirst(IncludeTrailingPathDelimiter(Directory) + '*', faAnyFile, SR);
for i := 1 to 2 do
if (SR.Name = '.') or (SR.Name = '..') then
Result := FindNext(SR) <> 0;
FindClose(SR);
end;
My problem is here : at first run function RemoveEmptyDirectory will found D:\AAA is not empty, then will run send round (recursively way),
After remove 2 child directory D:\AAA\BB1 and D:\AAA\BB2, the parent will become an empty Directory,
Back to first round place the function DirectoryIsEmpty report the parent is not an empty directory!!!!
Why !!!!
Is windows system still not change the directory state ???
So, is there any good suggestion that could meet my requirement.
You never check D:\AAA itself.
Just make checking and deletion in the end:
function RemoveEmptyDirectory(path: string) : Boolean;
var
MySearch: TSearchRec;
Ended: Boolean;
begin
if FindFirst(path + '\*.*', faDirectory, MySearch) = 0 then
begin
repeat
if ((MySearch.Attr and faDirectory) = faDirectory) and
(MySearch.Name[1] <> '.') then
begin
if DirectoryIsEmpty(path + '\' + MySearch.Name) then
TDirectory.Delete(path + '\' + MySearch.Name)
else
begin
RemoveEmptyDirectory(path + '\' + MySearch.Name);
if DirectoryIsEmpty(path + '\' + MySearch.Name) then
RemoveEmptyDirectory(path + '\' + MySearch.Name);
end;
end;
until FindNext(MySearch) <> 0;
FindClose(MySearch);
end;
if DirectoryIsEmpty(path) then
TDirectory.Delete(path);
end;
You can use TDirectory as
TDirectory.Delete('D:\AAA', True);
If you need to check if the directories are empty or not, you can use TDirectory.GetDirectories() as
Var
S: string;
begin
for S in TDirectory.GetDirectories('D:\AAA', '*', TSearchOption.soAllDirectories) do
begin
if TDirectory.IsEmpty(S) then
TDirectory.Delete(S);
end;
If TDirectory.IsEmpty('D:\AAA') then
TDirectory.Delete('D:\AAA');
I think this is simple and straightforward and should do fine if top performance is not crucial:
procedure RemoveEmptyDirs;
var
i,Removed:integer;
Arr:TStringDynArray;
const
TargedDir = 'C:\BunchOfDirs\';
begin
Arr := TDirectory.GetDirectories(TargedDir,'*',TSearchOption.soAllDirectories);
Repeat
Removed := 0;
For i := High(Arr) downto Low(Arr) do begin
If TDirectory.IsEmpty(Arr[i]) then begin
TDirectory.Delete(Arr[i]);
System.Delete(Arr,i,1);
Inc(Removed);
end;
end;
Until Removed = 0;
end;
Related
I am using the following code to get a list of files and folders. I cannot seem to get the list to include hidden files and folders.
procedure GetAllSubFolders(sPath: String; Listbox: TListbox);
var
Path: String;
Rec: TSearchRec;
begin
try
Path := IncludeTrailingBackslash(sPath);
if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then
try
repeat
if (Rec.Name <> '.') and (Rec.Name <> '..') then
begin
if (ExtractFileExt(Path + Rec.Name) <> '') And (Directoryexists(Path + Rec.Name + '\') = False) then
Begin
Listbox.Items.Add(Path+Rec.Name);
End;
GetAllSubFolders(Path + Rec.Name, Listbox);
end;
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
except
on e: Exception do
Showmessage('Err : TForm1.GetAllSubFolders - ' + e.Message);
end;
end;
Here's a quote from Delphi help:
The Attr parameter specifies the special files to include in addition to all normal files. Choose from these file attribute constants when specifying the Attr parameter.
You should use faDirectory or faHidden or other flags instead of just faDirectory and read help on FindFirst!
To change the attribute of a file is easy with FileSetAttr.
I want to change the attributes of all files located on any partition ("D:" for example).
For the search function I tried:
procedure FileSearch(const PathName, FileName : string) ;
var
Rec : TSearchRec;
Path : string;
begin
Path := IncludeTrailingPathDelimiter(PathName) ;
if FindFirst (Path + FileName, faAnyFile - faDirectory, Rec) = 0 then
try
repeat
ListBox1.Items.Add(Path + Rec.Name) ;
until FindNext(Rec) <> 0;
finally
FindClose(Rec) ;
end;
But how can I use this to traverse the entire drive?
You will indeed need to iterate across the entire drive setting attributes file by file. You will need to modify the code to recurse into sub-directories. And obviously you will actually need to call the function that sets attributes.
The basic approach looks like this:
type
TFileAction = reference to procedure(const FileName: string);
procedure WalkDirectory(const Name: string; const Action: TFileAction);
var
F: TSearchRec;
begin
if FindFirst(Name + '\*', faAnyFile, F) = 0 then begin
try
repeat
if (F.Attr and faDirectory <> 0) then begin
if (F.Name <> '.') and (F.Name <> '..') then begin
WalkDirectory(Name + '\' + F.Name, Action);
end;
end else begin
Action(Name + '\' + F.Name);
end;
until FindNext(F) <> 0;
finally
FindClose(F);
end;
end;
end;
I've written this in a generic way to allow you to use the same walking code with different actions. If you were to use this code you'd need to wrap up the attribute setting code into a procedure which you pass as Action. If you don't need the generality, then remove all mention of TFileAction and replace the call to Action with your attribute setting code. Like this:
procedure WalkDirectory(const Name: string);
var
F: TSearchRec;
begin
if FindFirst(Name + '\*', faAnyFile, F) = 0 then begin
try
repeat
if (F.Attr and faDirectory <> 0) then begin
if (F.Name <> '.') and (F.Name <> '..') then begin
WalkDirectory(Name + '\' + F.Name);
end;
end else begin
DoSetAttributes(Name + '\' + F.Name);
end;
until FindNext(F) <> 0;
finally
FindClose(F);
end;
end;
end;
Expect this to take quite a while when you try to run it on an entire volume. You'll want to do your testing on a directory containing only a few files and a couple of sub-directory levels.
Also, be prepared for your code that modifies attributes to fail for some files. You cannot expect to perform volume wide operations without sometimes encountering failures due to, for instance, security. Make your code robust to such scenarios.
I am trying to delete a folder and all of its sub-folders recursively but it is not working at all, so can someone please check the code and tell me what I am doing wrong here?
I am running this code through D7 under Windows XP
if FindFirst (FolderPath + '\*', faAnyFile, f) = 0 then
try
repeat
if (f.Attr and faDirectory) <> 0 then
begin
if (f.Name <> '.') and (f.Name <> '..') then
begin
RemoveDir(FolderPath +'\'+ f.Name);
end
else
begin
//Call function recursively...
ClearFolder(FolderPath +'\'+ f.Name, mask, recursive);
end;
end;
until (FindNext (f) <> 0);
finally
SysUtils.FindClose (f)
end;
end;
Rather than do all this hard work yourself, I'd just use SHFileOperation:
uses
ShellAPI;
procedure DeleteDirectory(const DirName: string);
var
FileOp: TSHFileOpStruct;
begin
FillChar(FileOp, SizeOf(FileOp), 0);
FileOp.wFunc := FO_DELETE;
FileOp.pFrom := PChar(DirName+#0);//double zero-terminated
FileOp.fFlags := FOF_SILENT or FOF_NOERRORUI or FOF_NOCONFIRMATION;
SHFileOperation(FileOp);
end;
For what it is worth, the problem with your code is that it doesn't ever call DeleteFile. And so the directories are never getting emptied, the calls to RemoveDir fail and so on. The lack of error checking in your code doesn't really help, but adding code to delete files would get that code in half-decent shape. You also need to take care with the recursion. You must make sure that all the children are deleted first, and then the parent container. That takes a certain degree of skill to get right. The basic approach is like this:
procedure DeleteDirectory(const Name: string);
var
F: TSearchRec;
begin
if FindFirst(Name + '\*', faAnyFile, F) = 0 then begin
try
repeat
if (F.Attr and faDirectory <> 0) then begin
if (F.Name <> '.') and (F.Name <> '..') then begin
DeleteDirectory(Name + '\' + F.Name);
end;
end else begin
DeleteFile(Name + '\' + F.Name);
end;
until FindNext(F) <> 0;
finally
FindClose(F);
end;
RemoveDir(Name);
end;
end;
I've omitted error checking for the sake of clarity, but you should check the return values of DeleteFile and RemoveDir.
procedure DeleteDir(const DirName: string);
var
Path: string;
F: TSearchRec;
begin
Path:= DirName + '\*.*';
if FindFirst(Path, faAnyFile, F) = 0 then begin
try
repeat
if (F.Attr and faDirectory <> 0) then begin
if (F.Name <> '.') and (F.Name <> '..') then begin
DeleteDir(DirName + '\' + F.Name);
end;
end
else
DeleteFile(DirName + '\' + F.Name);
until FindNext(F) <> 0;
finally
FindClose(F);
end;
end;
RemoveDir(DirName);
end;
Starting with Delphi 2010 there is a TDirectory record in System.IOUtils unit with some methods, including
TDirectory.Delete('path_to_dir', True);
using code from a tutorial and making various modifications i have got working code for a recursive procedure which searches for a file with a file name which has been entered by the user at a given path and through sub folders when the parameters are passed from another procedure at a button click.
it is as follows :
procedure TfrmProject.btnOpenDocumentClick(Sender: TObject);
begin
FileSearch('C:\Users\Guest\Documents', edtDocument.Text+'.docx');
end;
procedure TfrmProject.FileSearch(const Pathname, FileName : string);
var Word : Variant;
Rec : TSearchRec;
Path : string;
begin
Path := IncludeTrailingBackslash(Pathname);
if FindFirst(Path + FileName, faAnyFile - faDirectory, Rec) = 0
then repeat Word:=CreateOLEObject('Word.Application');
Word.Visible:=True;
Word.Documents.Open(Path + FileName);
until FindNext(Rec) <> 0;
FindClose(Rec);
if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then
try
repeat
if ((Rec.Attr and faDirectory) <> 0) and (Rec.Name<>'.') and (Rec.Name<>'..') then
FileSearch(Path + Rec.Name, FileName);
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
end; //procedure FileSearch
After trying to learn what is happening of i have gained a good understanding up until the point of the first FindClose(Rec), however this section of code i'm still unsure of :
if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then
try
repeat
if ((Rec.Attr and faDirectory) <> 0) and (Rec.Name<>'.') and (Rec.Name<>'..') then
FileSearch(Path + Rec.Name, FileName);
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
end;
my guess is that the first line is checking whether there are any subfolders found in the given path, but i'm not too sure on the rest and how it works if that is even correct.
help would be appreciated.
I am using Delphi2006 and I want to find the location of a particular program using Delphi code.
Here's a Delphi program that can find all files called aFileName, and puts the results into the aDestFiles stringlist.
function findFilesCalled(aFileName : String; aDestFiles : TStringList) : boolean;
var
subDirs : TStringList;
dir : Char;
sRec : TSearchRec;
toSearch : string;
begin
subdirs := TStringList.Create;
for dir := 'A' to 'Z' do
if DirectoryExists(dir + ':\') then
subdirs.add(dir + ':');
try
while (subdirs.count > 0) do begin
toSearch := subdirs[subdirs.count - 1];
subdirs.Delete(subdirs.Count - 1);
if FindFirst(toSearch + '\*.*', faDirectory, sRec) = 0 then begin
repeat
if (sRec.Attr and faDirectory) <> faDirectory then
Continue;
if (sRec.Name = '.') or (sRec.Name = '..') then
Continue;
subdirs.Add(toSearch + '\' + sRec.Name);
until FindNext(sRec) <> 0;
end;
FindClose(sRec);
if FindFirst(toSearch + '\' + aFileName, faAnyFile, sRec) = 0 then begin
repeat
aDestFiles.Add(toSearch + '\' + sRec.Name);
until FindNext(sRec) <> 0;
end;
FindClose(sRec);
end;
finally
FreeAndNil(subdirs);
end;
Result := aDestFiles.Count > 0;
end;