Excluding folder and files from search [duplicate] - delphi

This question already has an answer here:
Delphi function, Not allowing files and folders from main directory during compression
(1 answer)
Closed 9 years ago.
I surrender, I spend my time almost 12hours to get what I want, but I can't.
This code search all folders and filenames, but I want to exclude some folders including the sub directory of folders I want to exclude from searching.
I wish there's someone can help.
procedure TForm1.CombineDir(InDir : string; OutStream : TStream);
var AE : TArchiveEntry;
dFound:boolean;
procedure RecurseDirectory(ADir : string);
var sr : TSearchRec;
TmpStream : TStream;
begin
if FindFirst(ADir + '*', faAnyFile, sr) = 0 then begin
repeat
if (sr.Attr and (faDirectory or faVolumeID)) = 0 then begin
//ShowMessage('Filename is :>'+ ADir + sr.Name);
if (NotThisPath.IndexOf(ADir + sr.Name)>=0) or dFound then begin
ShowMessage('DO NOT INCLUDE THIS FILENAME :>'+ ADir + sr.Name);
end else begin
ShowMessage('>>> INCLUDE THIS FILENAME :>'+ ADir + sr.Name);
// We have a file (as opposed to a directory or anything
// else). Write the file entry header.
AE.EntryType := aeFile;
AE.FileNameLen := Length(sr.Name);
AE.FileLength := sr.Size;
OutStream.Write(AE, SizeOf(AE));
OutStream.Write(sr.Name[1], Length(sr.Name));
// Write the file itself
TmpStream := TFileStream.Create(ADir + sr.Name, fmOpenRead or fmShareDenyWrite);
OutStream.CopyFrom(TmpStream, TmpStream.Size);
TmpStream.Free;
end;
end;
if (sr.Attr and faDirectory) > 0 then begin
if (sr.Name <> '.') and (sr.Name <> '..') then begin
//ShowMessage('DIR is:>'+ ADir + sr.Name);
//if (Pos(ADir, NotThisPath.Text)>0) then
if (NotThisPath.IndexOf(ADir + sr.Name)>=0) then begin
ShowMessage('DO NOT INCLUDE THIS DIR:>'+ ADir + sr.Name);
dFound:=True;
end else begin
ShowMessage('>>> INCLUDE THIS DIR:>'+ ADir + sr.Name);
// Write the directory entry
AE.EntryType := aeDirectory;
AE.DirNameLen := Length(sr.Name);
OutStream.Write(AE, SizeOf(AE));
OutStream.Write(sr.Name[1], Length(sr.Name));
end;
// Recurse into this directory
RecurseDirectory(IncludeTrailingPathDelimiter(ADir + sr.Name));
end;
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
// Show that we are done with this directory
AE.EntryType := aeEOD;
OutStream.Write(AE, SizeOf(AE));
end;
begin
RecurseDirectory(IncludeTrailingPathDelimiter(InDir));
end;
NotThisPath is a TStringList;

I think your fundamental problem is that you have mixed together file enumeration, file name filtering, and your GUI into one unholy blob of goo. You simply should not see FindFirst being called from a method of a form. Code that calls FindFirst belongs in helper classes or functions.
I'm not going to attempt to answer your question directly, not least because you did not actually ask a question. What I'm going to attempt is to show you how to separate the concerns of enumerating files and filtering for names.
First of all, I'm going to implement this function:
procedure EnumerateFiles(Dir: string;
const EnumerateFileName: TEnumerateFileNameMethod);
This function is passed a directory in the Dir parameter and it proceeds to enumerate all files within that directory, its sub-directories, and so on recursively. Each file that is found is passed to the callback method EnumerateFileName. This is defined like so:
type
TEnumerateFileNameMethod = procedure(const FileName: string) of object;
The implementation is very simple indeed. It's just the standard FindFirst based repeat loop. The function rejects the special directories . and ... It will recurse into any directories that it encounters.
procedure EnumerateFiles(Dir: string;
const EnumerateFileName: TEnumerateFileNameMethod);
var
SR: TSearchRec;
begin
Dir := IncludeTrailingPathDelimiter(Dir);
if FindFirst(Dir + '*', faAnyFile, SR) = 0 then
try
repeat
if (SR.Name = '.') or (SR.Name = '..') then
continue;
if (SR.Attr and faDirectory) <> 0 then
EnumerateFiles(Dir + SR.Name, EnumerateFileName)
else
EnumerateFileName(Dir + SR.Name);
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
end;
Now, this should be simple enough to follow I hope. The next issue is filtering. You can implement that in the callback method that you provide. Here's a complete demo that illustrates filtering that picks out Delphi source files with the .pas extension.
program EnumerateFilesDemo;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TEnumerateFileNameMethod = procedure(const FileName: string) of object;
procedure EnumerateFiles(Dir: string;
const EnumerateFileName: TEnumerateFileNameMethod);
var
SR: TSearchRec;
begin
Dir := IncludeTrailingPathDelimiter(Dir);
if FindFirst(Dir + '*', faAnyFile, SR) = 0 then
try
repeat
if (SR.Name = '.') or (SR.Name = '..') then
continue;
if (SR.Attr and faDirectory) <> 0 then
EnumerateFiles(Dir + SR.Name, EnumerateFileName)
else
EnumerateFileName(Dir + SR.Name);
until FindNext(SR) <> 0;
finally
FindClose(SR);
end;
end;
type
TDummyClass = class
class procedure EnumerateFileName(const FileName: string);
end;
class procedure TDummyClass.EnumerateFileName(const FileName: string);
begin
if SameText(ExtractFileExt(FileName), '.pas') then
Writeln(FileName);
end;
procedure Main;
begin
EnumerateFiles('C:\Users\heff\Development', TDummyClass.EnumerateFileName);
end;
begin
try
Main;
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Now, I know that's not the type of filtering that you want to do, but the point is that we now have generality. You can replace the call to SameText with whatever filtering you want. And once you have picked out the files that you want to deal with, you can do what you like with them.
I used a class method for convenience. I did not want my demo to be laden down with the boiler-plate of instantiating an object. But for your needs you would want to create a class to handle the enumeration callback. That class would encapsulate the file archiving operation that you are performing. That class would own an instance of the output stream. And the callback method would be an instance method that would write to the archive.
Now, I've not implemented a complete solution to your problem, but I hope I've done something better. Namely to show you how to factor code to make solving your problem simple.

Related

FindfirstEx using recursion

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;

Can't delete folder from a different partition

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.

Delphi set to read only files from folder and subfolders

How can I put the files from a specific folder and subfolders to read only in delphi?
I know that I can put the folder with FileSetAttr to read only but is there a way to put the files from the folder and subfolders ?
Thanks
You need to iterate over all the files in a directory, and recursively over all the sub-directories. You can use this function to do that:
type
TFileEnumerationCallback = procedure(const Name: string);
procedure EnumerateFiles(const Name: string;
const Callback: TFileEnumerationCallback);
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
EnumerateFiles(Name + '\' + F.Name, Callback);
end;
end else begin
Callback(Name + '\' + F.Name);
end;
until FindNext(F) <> 0;
finally
FindClose(F);
end;
end;
end;
This is a general purpose routine. You can supply a callback procedure that will be called with the name of each file. Inside that callback procedure do what ever you want.
Your callback procedure would look like this:
procedure MakeReadOnly(const Name: string);
begin
FileSetAttr(Name, FileGetAttr(Name) or faReadOnly);
end;
And you'd put it together like this:
EnumerateFiles('C:\MyDir', MakeReadOnly);

Change the attributes of all files in a drive partition

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.

File Masking in delphi

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.

Resources