How to delete one directory having some files and some non empty sub directory.
I have tried SHFileOperation Function. It has some compatibility issue in Windows 7.
Then I have tried IFileOperation Interface. But it is not compatible in Windows XP.
Then I have tried the following codes as suggested by David Heffernan :
procedure TMainForm.BitBtn01Click(Sender: TObject);
var
FileAndDirectoryExist: TSearchRec;
ResourceSavingPath : string;
begin
ResourceSavingPath := (GetWinDir) + 'Web\Wallpaper\';
if FindFirst(ResourceSavingPath + '\*', faAnyFile, FileAndDirectoryExist) = 0 then
try
repeat
if (FileAndDirectoryExist.Name <> '.') and (FileAndDirectoryExist.Name <> '..') then
if (FileAndDirectoryExist.Attr and faDirectory) <> 0 then
//it's a directory, empty it
ClearFolder(ResourceSavingPath +'\' + FileAndDirectoryExist.Name, mask, recursive)
else
//it's a file, delete it
DeleteFile(ResourceSavingPath + '\' + FileAndDirectoryExist.Name);
until FindNext(FileAndDirectoryExist) <> 0;
//now that this directory is empty, we can delete it
RemoveDir(ResourceSavingPath);
finally
FindClose(FileAndDirectoryExist);
end;
end;
But it does not get compiled mentioning error as Undeclared Identifier at ClearFolder, mask and recursive. My requirement is to that "If any sub folder exist under WALLPAPER folder it will be deleted". The same sub folder may contain any number of non empty sub folder or files.
Well, for starters, SHFileOperation has no compatibility issues on Windows 7 or Windows 8. Yes, you are now recommended to use IFileOperation instead. But if you want to support older operating systems like XP, then you can and should just call SHFileOperation. It works and will continue to work. It's pefectly fine to use it on Windows 7 and Windows 8 and I'll eat my hat if it's ever removed from Windows. Microsoft go to extraordinary lengths to maintain backwards compatibility. So, SHFileOperation is your best option in my view.
Your FindFirst based approach fails because you need to put it in a separate function in order to allow recursion. And the code I posted in that other answer is incomplete. Here is a complete version:
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;
This deletes a directory and its contents. You'd want to walk the top level directory and then call this function for each subdirectory that you found.
Finally I have implemented the following Code:
uses
ShellAPI;
...
...
function GetWinDir: string;
var
WindowsDirectory: array[0..MAX_PATH] of Char;
begin
GetWindowsDirectory(WindowsDirectory, MAX_PATH - 1);
SetLength(Result, StrLen(WindowsDirectory));
Result := IncludeTrailingPathDelimiter(WindowsDirectory);
end;
...
...
procedure DeleteDirectory(const DirName: string);
var
FileFolderOperation: TSHFileOpStruct;
begin
FillChar(FileFolderOperation, SizeOf(FileFolderOperation), 0);
FileFolderOperation.wFunc := FO_DELETE;
FileFolderOperation.pFrom := PChar(ExcludeTrailingPathDelimiter(DirName) + #0);
FileFolderOperation.fFlags := FOF_SILENT or FOF_NOERRORUI or FOF_NOCONFIRMATION;
SHFileOperation(FileFolderOperation);
end;
...
...
procedure TMainForm.BitBtn01Click(Sender: TObject);
begin
DeleteDirectory((GetWinDir) + '\Web\Wallpapers\');
end
...
...
Please don't mention anything regarding 'TrailingPathDelimiter', I have intentionally implemented. I works successfully having one problem that the files or folder successfully deleted without going to 'Recycle Bin' in case of Windows XP, but in case of Vista and higher those files goes to 'Recycle Bin' and I don't have any option for directly deletion without sending to 'Recycle Bin' in case of Vista or Higher.
This is a pretty complete function that works both with files and folders.
It allows you to specify the following parameters:
DeleteToRecycle
ShowConfirm
TotalSilence
{---------------------------------------------------------------
DELETE FILE
Deletes a file/folder to RecycleBin.
----------------------------------------------------------------}
function RecycleItem(CONST ItemName: string; CONST DeleteToRecycle: Boolean= TRUE; CONST ShowConfirm: Boolean= TRUE; CONST TotalSilence: Boolean= FALSE): Boolean;
VAR
SHFileOpStruct: TSHFileOpStruct;
begin
FillChar(SHFileOpStruct, SizeOf(SHFileOpStruct), #0);
SHFileOpStruct.wnd := Application.MainForm.Handle; { Others are using 0. But Application.MainForm.Handle is better because otherwise, the 'Are you sure you want to delete' will be hidden under program's window }
SHFileOpStruct.wFunc := FO_DELETE;
SHFileOpStruct.pFrom := PChar(ItemName+ #0);
SHFileOpStruct.pTo := NIL;
SHFileOpStruct.hNameMappings := NIL;
if DeleteToRecycle
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_ALLOWUNDO;
if TotalSilence
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NO_UI
else
if NOT ShowConfirm
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NOCONFIRMATION;
Result:= SHFileOperation(SHFileOpStruct)= 0;
end;
Related
Scenario
I'm trying to duplicate the standard way to fill a Treeview with directories/folders from a folder structure, starting at the root, but using IdFTP to get the structure from a remote server instead of my local hard drive. I'd like the result to look similar to clients like Filezilla.
I used this reasonably standard code from the Swiss Delphi Centre (which works to display my hard drive's structure) and then modified it to use IdFTP.ChangeDir(Directory) and IdFTP.List instead of FindFirst() and FindNext().
Problem
I seem to have got myself in a muddle as it is not correctly 'unwinding' the recursion so that once it traverses down the /cpanel/cashes/config directories on the remote server it doesn't return and traverse all the other directories hanging off the root but exits the procedure without displaying anything else. Also it doesn't seem to show all the top level folders but this could be simply due to the order that IdFTP.List returns them in
Can anyone tell me what I have done wrong here?
If you can also tell me how I should get the root (/) shown as well that would be very helpful
(I've commented out displaying non directories as I only want folders at this stage)
What I expected to see Copied from Filezilla
What I did see Using a Ttreeview in Delphi
My Code
procedure TForm2.Button1Click(Sender: TObject);
var StartingDir : string;
begin
TreeView1.Items.BeginUpdate;
try
StartingDir := '/';
Screen.Cursor := crHourGlass;
TreeView1.Items.Clear;
FTPconnect; //procedure to connect to remote server
GetDirectories(TreeView1, StartingDir, nil, True);
FTPDisconnect; //procedure to disconnect from remote server
finally
TreeView1.Items.EndUpdate;
Screen.Cursor := crDefault;
end;
end;
procedure TForm2.GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode; IncludeFiles: Boolean);
var
ItemTemp: TTreeNode;
DirItemType : TIdDirItemType ;
Filename , NewStartingDirectory: string;
i : Integer;
begin
Tree.Items.BeginUpdate;
IdFTP.ChangeDir(Directory);
IdFTP.List; //get directory of remote folder
i:=0;
repeat
DirItemType := IdFTP.DirectoryListing[I].ItemType;
Filename := IdFTP.DirectoryListing[I].FileName;
If (DirItemType = ditDirectory) and (Filename <> '.') and (Filename <> '..')then
begin
if DirItemType = ditDirectory then
Item := Tree.Items.AddChild(Item, Filename);
ItemTemp := Item.Parent;
if Directory = '/' then
NewStartingDirectory := Directory + Filename
else
NewStartingDirectory := Directory + '/' +Filename;
GetDirectories(Tree, NewStartingDirectory, Item, IncludeFiles);
Item := ItemTemp;
end
else
if IncludeFiles then
begin //this bit commented out as we only want to see directories
// if (Filename <> '.') and (Filename <> '..') then
// Tree.Items.AddChild(Item, Filename);
end;
inc(i);
until i = IdFTP.DirectoryListing.Count;
Tree.Items.EndUpdate;
end;
Swiss Delhpi Centre's code (for comparison)
procedure TForm1.Button1Click(Sender: TObject);
var
Node: TTreeNode;
Path: string;
Dir: string;
begin
Dir := 'c:\temp';
Screen.Cursor := crHourGlass;
TreeView1.Items.BeginUpdate;
try
TreeView1.Items.Clear;
GetDirectories(TreeView1, Dir, nil, True);
finally
Screen.Cursor := crDefault;
TreeView1.Items.EndUpdate;
end;
end;
procedure TForm1.GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode; IncludeFiles: Boolean);
var
SearchRec: TSearchRec;
ItemTemp: TTreeNode;
begin
Tree.Items.BeginUpdate;
if Directory[Length(Directory)] <> '\' then Directory := Directory + '\';
if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
begin
repeat
if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
begin
if (SearchRec.Attr and faDirectory > 0) then
Item := Tree.Items.AddChild(Item, SearchRec.Name);
ItemTemp := Item.Parent;
GetDirectories(Tree, Directory + SearchRec.Name, Item, IncludeFiles);
Item := ItemTemp;
end
else if IncludeFiles then
if SearchRec.Name[1] <> '.' then
Tree.Items.AddChild(Item, SearchRec.Name);
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
Tree.Items.EndUpdate;
end;
I've looked on SO here - too complicated and wrong language and here - similar to the Swiss Delphi Centre and here - wrong language and not sure what its doing.
if it's better to use a TlistView, can you please show me the equivalent code to use that instead?
Untested:
I made the TIdFTP variable a parameter, since TTreeView was also one and it should be done consistently, not archaic.
Using for loops instead of repeat until.
Eliminating IncludeFiles when it wasn't used anyway.
Eliminating weird logic to always get the new TreeNode's parent.
Not locking the TreeView anymore - do this once before calling this method and unlock it after calling - otherwise you do that dozens of times in vain.
Basic logic is as I wrote in the comments:
Store all folder strings into your own list and avoid recursion at this point.
Fix the path to be concatenated once, not with every iteration of a loop.
Go through that list to do the recursion - at this point the state of FTP is irrelevant and you won't mess up listings at different levels.
Of course, release the created instance of the StringList.
procedure TForm2.GetFolders
( Ftp: TIdFTP // The source, from which we read the content
; Tree: TTreeView // The destination, which we want to fill
; ParentNode: TTreeNode // Node under which all new child nodes should be created
; Path: String // Starting directory
);
var
NewNode: TTreeNode; // New child in the tree
Filename: String; // Check against unwanted folder entries
i: Integer; // Looping over both lists
sl: TStringList; // Collect folders only
begin
FTP.ChangeDir( Path );
FTP.List; // Entire remote listing
sl:= TStringList.Create; // Collect all entries we're interested in
try
for i:= 0 to FTP.DirectoryListing.Count- 1 do begin // For each entry
Filename:= FTP.DirectoryListing[i].FileName;
if (FTP.DirectoryListing[i].ItemType= ditDirectory) // Only folders
and (Filename<> '.')
and (Filename<> '..') then begin
sl.Add( Filename ); // Only the name, not the full path
end;
end;
// Do this only once
if Path<> '/' then Path:= '/'+ Path+ '/';
for i:= 0 to sl.Count- 1 do begin // All collected folders
NewNode:= Tree.Items.AddChild( ParentNode, sl[i] ); // Populate tree
GetFolders( Ftp, Tree, NewNode, Path+ sl[i] ); // Recursion of folder name + current path
end;
finally
sl.Free;
end;
end;
Untested, but should compile.
It drives me nuts (I'll should learn about recursion though)
But I'll can't make it work, something I'm doing wrong.
I was trying to make an exact copy of the FindFirst code below just with FindFirstEx but on the recursion I'll got stackoverflow and a lot of strange things happen so I'll guess that must be the wrong way using it so I'll removed it and replace it with the comment I'm stuck here...
So basically I'll need a procedure where I'm able to specify a directory and a file mask thats it.
procedure FetchFilesAndFolders(aPath, AMask; lbSearchResult: TMemo);
const
Find_First_Ex_Large_Fetch = 2;
var
hFile: Cardinal;
searchResult: Win32_Find_DataW;
begin
lbSearchResults.Lines.BeginUpdate;
hFile := FindFirstFileEx(PChar(aPath + aMask), FindExInfoStandard, #searchResult,
FindExSearchNameMatch, nil, Find_First_Ex_Large_Fetch);
If (hFile <> INVALID_HANDLE_VALUE) Then
begin
try
repeat
If (searchResult.dwFileAttributes And faDirectory = faDirectory) Then
begin
lbSearchResult.Lines.Append(IncludeTrailingBackSlash(aPath) +
string(searchResult.cFileName));
end
else
begin
// I'm stuck here...
end;
until (not FindNextFile(hFile, searchResult))
finally Winapi.Windows.FindClose(hFile);;
lbSearchResult.Lines.EndUpdate;
end;
Something like this but with FindFirstFileEx instead:
procedure FileSearch(const dirName, aMask: string; lbSearchResult:
TMemo);
var
searchResult: TSearchRec;
begin
lbSearchResult.Lines.BeginUpdate;
if FindFirst(dirName+ aMask, faAnyFile, searchResult) = 0 then
begin
try
repeat
if (searchResult.Attr and faDirectory) = 0 then
begin
lbSearchResult.Lines.Append(IncludeTrailingBackSlash(dirName) +
searchResult.Name);
end
else if (searchResult.Name <> '.') and (searchResult.Name <> '..') then
begin
FileSearch(IncludeTrailingBackSlash(dirName) + searchResult.Name,
lbSearchResult);
end;
until FindNext(searchResult) <> 0 finally FindClose(searchResult);
lbSearchResult.Lines.EndUpdate;
end;
end;
end;
So I'll need someone to show me doing it right.
Thank you!
Version 3 (still not working but no exception):
procedure FileSearch(const aPath, aMask: string; lbSearchResult: TMemo);
const
Find_First_Ex_Large_Fetch = 2;
var
hFile: Cardinal;
searchResult: Win32_Find_DataW;
begin
lbSearchResult.Lines.BeginUpdate;
hFile := FindFirstFileEx(PChar(aPath + aMask), FindExInfoStandard,
#searchResult, FindExSearchNameMatch, nil, Find_First_Ex_Large_Fetch);
If (hFile <> INVALID_HANDLE_VALUE) Then
begin
try
repeat
If (0 = (searchResult.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) then
begin
lbSearchResult.Lines.Add(IncludeTrailingBackSlash(aPath) +
string(searchResult.cFileName));
end
else
begin
If (searchResult.cFileName <> String('.')) And
(searchResult.cFileName <> '..') Then
lbSearchResult.Lines.Add(IncludeTrailingBackSlash(aPath) +
string(searchResult.cFileName));
// the following is not good, infinite!!!
// FileSearch(aPath, aMask, lbSearchResult);
end;
until (not FindNextFile(hFile, searchResult))
finally Winapi.Windows.FindClose(hFile);;
lbSearchResult.Lines.EndUpdate;
end;
end;
end;
All files and folders are shown which are inside the test folder but not any deeper so no recursion...
FileSearch('D:\projects\Test\', '*.*', Memo1);
So for example:
D:\projects\Test\Blubb
is shown but not the files inside or any directories from Test\Blubb\
The cause of your infinite recursion appears to be that you are omitting the test for the files '.' and '..'.
in the second code there is the line
else if (searchResult.Name <> '.') and (searchResult.Name <> '..') then
These two values are special directories that mean 'current directory' and 'parent directory' respectively. So while analysing the current directory it will find a 'subdirectory' called '.', which is actually a pointer to the directory that you are currently analysing. Therefore a recursive call to this subdirectory will analyse the same directory again, during which it will again find the directory '.' and again attempt to analyse the same directory, and so on for ever.
A similar situation arises for '..' which would analyse the parent directory.
It is critical that this test not be omitted.
Note on your version 3
One of my pet hates is not including begin...end blocks in if statements, and your 3rd version seems to illustrate why. You still get the infinite loop because your if statement does not apply to the recursion - which is exactly where it must apply.
The second, more serious issue is that the parameters of the recursive call are exactly the same as the original call. I can think of no circumstances where it is ever valid to do that (although I am sure that someone will correct me). Instead you must call with the name of the child directory. I have added a new variable fNewPath to simplify things.
procedure FileSearch(const aPath, aMask: string; lbSearchResult: TMemo);
const
Find_First_Ex_Large_Fetch = 2;
var
hFile: Cardinal;
searchResult: Win32_Find_DataW;
fNewPath : string;
begin
lbSearchResult.Lines.BeginUpdate;
hFile := FindFirstFileEx(PChar(aPath + aMask), FindExInfoStandard,
#searchResult, FindExSearchNameMatch, nil, Find_First_Ex_Large_Fetch);
If (hFile <> INVALID_HANDLE_VALUE) Then
begin
try
repeat
If (0 = (searchResult.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) then
begin
lbSearchResult.Lines.Add(IncludeTrailingBackSlash(aPath) +
string(searchResult.cFileName));
end
else
begin
If (searchResult.cFileName <> String('.')) And
(searchResult.cFileName <> '..') Then
begin // <-------------------
fNewPath := IncludeTrailingBackSlash(aPath) +
string(searchResult.cFileName);
lbSearchResult.Lines.Add( fNewPath );
FileSearch(fNewPath, aMask, lbSearchResult);
end; //<--------------- The recurstion *must* be covered by the if statement
end;
until (not FindNextFile(hFile, searchResult));
finally Winapi.Windows.FindClose(hFile);
lbSearchResult.Lines.EndUpdate;
end;
end;
end;
I'm having a problem when deleting folders that are on a different partition (E:/) from my software. I can delete files, using the DeleteFile function, but I'm not able to delete a folder using the code below:
function RemoveDirectory(strDir : String) : Boolean;
var
SearchRec : TSearchRec;
strFile : String;
nResult : Integer;
begin
try
Result := false;
nResult := FindFirst(strDir + '*', faAnyFile, SearchRec);
while (nResult = 0) do
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
strFile := strDir + SearchRec.Name;
if FileExists(strFile) then
DeleteFile(strFile)
else if DirectoryExists(strFile) then
RemoveDirectory(strFile);
end;
nResult := FindNext(SearchRec);
end;
Result := RemoveDir(strDir);
finally
FindClose(SearchRec);
end;
end;
With this code I can delete folders that are on the same partition from my software. Somebody knows what's going on? Is it because it's on a different partition?
You are trying to remove directories while you still have open search handles. Since this is a recursive function, if the directory hierarchy is deep, you would have multiple search handles open at a time and that is a lot of system resources being used when the deeper folders are reached.
It is better to collect the immediate subfolders into a temp list, then you can close the current search handle before iterating that list. This way, there is ever only 1 search handle active at a time, and there is no search handle active when each folder is actually being deleted.
Try this:
function RemoveDirectory(strDir : String) : Boolean;
var
SearchRec : TSearchRec;
nResult,i : Integer;
SubFolders: TStringList;
begin
SubFolders := nil;
try
strDir := IncludeTrailingPathDelimiter(strDir);
nResult := FindFirst(strDir + '*', faAnyFile, SearchRec);
if (nResult = 0) then
try
repeat
if (SearchRec.Attr and faDirectory) = 0 then
DeleteFile(strDir + SearchRec.Name)
else
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
if not Assigned(SubFolders) then SubFolders := TStringList.Create;
SubFolders.Add(strDir + SearchRec.Name);
end;
end;
until FindNext(SearchRec) <> 0;
finally
FindClose(SearchRec);
end;
if Assigned(SubFolders) then
begin
for i := 0 to SubFolders.Count-1 do
RemoveDirectory(SubFolders[i]);
end;
finally
SubFolders.Free;
end;
Result := RemoveDir(strDir);
end;
If this still fails, then someone else outside of your app/loop is actually using the directories, and you can use a tool like SysInternals Process Explorer to check that.
DeleteFile() is boolean function and you can receive only information was it successful or not. If you want more details return to the plain old Erase():
var f: file;
begin
AssignFile(f,strFile);
Erase(f);
end;
Here, if Erase() is not completed, an exception will be raised and you can receive more info, especially in the debugging phase.
How to determine which folder in a windows directory is the latest by 'modified date' ?
Like this one, but for folder not file.
I need to create a function like GetLastModifiedFolderName('D:\LogFolder\'):string;
After some suggestion below (from MBo) then reading some findfirst reference. I modified the answered link become like this one :
function TForm1.GetLastModifiedFolderName(AFolder: String): string;
var
sr: TSearchRec;
aTime: Integer;
begin
Result := '';
aTime := 0;
if FindFirst(IncludeTrailingPathDelimiter(AFolder)+'*',faDirectory, sr) = 0 then
begin
// directory found
repeat
if (sr.Attr and faDirectory)=faDirectory then
begin
// directory only
if (sr.Name <> '.') and (sr.name<>'..') then
begin
// exclude '.' and '..' directory
if sr.Time > aTime then
begin
aTime := sr.Time;
Result := sr.Name;
end;
end;
end;
until FindNext(sr) <> 0;
FindClose(sr);
end else
begin
// not found
Result:='-1';
end;
end;
You can use slightly modified function from linked answer. Because you need folders only, just check that filesystem object (found by FindXX functions) is a directory:
if (sr.Attr and faDirectory) = faDirectory ...
P.S. Note that fresh Delphi versions include System.IOUtils unit with variety of useful methods.
I am trying to find all files that have the extenstion .cbr or .cbz
If i set my mask to *.cb?
it finds *.cbproj files. How can i set the mask to only find .cbr and .cbz files?
here is code i am using.
I have two edit boxes EDIT1 is the location to search, EDIT2 is where i put my mask. A listbox to show what it found and a Search button.
edit1 := c:\
edit2 := mask (*.cb?)
space
procedure TFAutoSearch.FileSearch(const PathName, FileName : string; const InDir : boolean);
var Rec : TSearchRec;
Path : string;
begin
Path := IncludeTrailingBackslash(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;
If not InDir then Exit;
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, True);
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
end; //procedure FileSearch
procedure TFAutoSearch.Button1Click(Sender: TObject);
begin
FileSearch(Edit1.Text, Edit2.Text, CheckBox1.State in [cbChecked]);
end;
end.
The easiest way is to use ExtractFileExt against the current filename and check to see if it matches either of your desired extensions.
Here's a fully-rewritten version of your FileSearch routine which does exactly what you're trying to do (according to your question, anyway):
procedure TFAutoSearch.FileSearch(const ARoot: String);
var
LExt, LRoot: String;
LRec: TSearchRec;
begin
LRoot := IncludeTrailingPathDelimiter(ARoot);
if FindFirst(LRoot + '*.*', faAnyFile, LRec) = 0 then
begin
try
repeat
if (LRec.Attr and faDirectory <> 0) and (LRec.Name <> '.') and (LRec.Name <> '..') then
FileSearch(LRoot + LRec.Name)
else
begin
LExt := UpperCase(ExtractFileExt(LRoot + LRec.Name));
if (LExt = '.CBR') or (LExt = '.CBZ') then
ListBox1.Items.Add(LRoot + LRec.Name);
end;
until (FindNext(LRec) <> 0);
finally
FindClose(LRec);
end;
end;
end;
While the other answer suggesting the use of multiple extensions as a mask *.cbr;*.cbz should (in principal anyway) work, I've noted through bitter experience that the FindFirst and FindNext methods in Delphi tend not to accept multiple extensions in a mask!
The code I've provided should work just fine for your needs, so enjoy!
UPDATED: To allow the use of multiple extensions in a Mask dynamically at runtime (as indicated by the OP's first comment to this answer).
What we're going to do is take a String from your TEdit control (this String is one or more File Extensions as you would expect), "Explode" the String into an Array, and match each file against each Extension in the Array.
Sounds more complicated than it is:
type
TStringArray = Array of String; // String Dynamic Array type...
// Now let's provide a "Mask Container" inside the containing class...
TFAutoSearch = class(TForm)
// Normal stuff in here
private
FMask: TStringArray; // Our "Mask Container"
end;
This code will populate FMask with each individual mask extension separated by a ; such as .CBR;.CBZ.
Note this method will not accept Wildcard characters or any other Regex magic, but you can modify it as you require!
procedure TFAutoSearch.ExplodeMask(const AValue: String);
var
LTempVal: String;
I, LPos: Integer;
begin
LTempVal := AValue;
I := 0;
while Length(LTempVal) > 0 do
begin
Inc(I);
SetLength(FMask, I);
LPos := Pos(';', LTempVal);
if (LPos > 0) then
begin
FMask[I - 1] := UpperCase(Copy(LTempVal, 0, LPos - 1));
LTempVal := Copy(LTempVal, LPos + 1, Length(LTempVal));
end
else
begin
FMask[I - 1] := UpperCase(LTempVal);
LTempVal := EmptyStr;
end;
end;
end;
We now need a function to determine if the nominated file matches any of the defined Extensions:
function TFAutoSearch.MatchMask(const AFileName: String): Boolean;
var
I: Integer;
LExt: String;
begin
Result := False;
LExt := UpperCase(ExtractFileExt(LExt));
for I := Low(FMask) to High(FMask) do
if (LExt = FMask[I]) then
begin
Result := True;
Break;
end;
end;
Now here's the modified FileSearch procedure:
procedure TFAutoSearch.FileSearch(const ARoot: String);
var
LRoot: String;
LRec: TSearchRec;
begin
LRoot := IncludeTrailingPathDelimiter(ARoot);
if FindFirst(LRoot + '*.*', faAnyFile, LRec) = 0 then
begin
try
repeat
if (LRec.Attr and faDirectory <> 0) and (LRec.Name <> '.') and (LRec.Name <> '..') then
FileSearch(LRoot + LRec.Name)
else
begin
if (MatchMask(LRoot + LRec.Name)) then
ListBox1.Items.Add(LRoot + LRec.Name);
end;
until (FindNext(LRec) <> 0);
finally
FindClose(LRec);
end;
end;
end;
Finally, here's how you initiate your search:
procedure TFAutoSearch.btnSearchClick(Sender: TObject);
begin
ExplodeMask(edMask.Text);
FileSearch(edPath.Text);
end;
Where edMask is defined in your question as Edit2 and edPath is defined in your question as Edit1. Just remember that this method doesn't support the use of Wildcard or other Special Chars, so edMask.Text should be something like .CBR;.CBZ
If you use the Regex library for Delphi, you could easily modify this method to support all of the Expression Cases you could ever imagine!
Dorin's suggestion to replace your mask with *.cbr;*.cbz should work. That is, it won't match cbproj anymore. It would, however, still match cbzy or any other extension that starts with cbr or cbz. The reason for this is that FindFirst/FindNext match both the long form and the legacy short forms (8.3) of file names. So the short forms will always have truncated extensions where cbproj is shortened to cbp, and therefore matches cb?.
This is supposed to be avoidable by using FindFirstEx instead, but this requires a small rewrite of your search function and actually didn't work for me. So instead I just double checked all matches with the MatchesMask function.