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.
Related
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;
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 have an app that needs to do heavy text manipulation in a TStringList. Basically i need to split text by a delimiter ; for instance, if i have a singe line with 1000 chars and this delimiter occurs 3 times in this line, then i need to split it in 3 lines. The delimiter can contain more than one char, it can be a tag like '[test]' for example.
I've wrote two functions to do this task with 2 different approaches, but both are slow in big amounts of text (more then 2mbytes usually).
How can i achieve this goal in a faster way ?
Here are both functions, both receive 2 paramaters : 'lines' which is the original tstringlist and 'q' which is the delimiter.
function splitlines(lines : tstringlist; q: string) : integer;
var
s, aux, ant : string;
i,j : integer;
flag : boolean;
m2 : tstringlist;
begin
try
m2 := tstringlist.create;
m2.BeginUpdate;
result := 0;
for i := 0 to lines.count-1 do
begin
s := lines[i];
for j := 1 to length(s) do
begin
flag := lowercase(copy(s,j,length(q))) = lowercase(q);
if flag then
begin
inc(result);
m2.add(aux);
aux := s[j];
end
else
aux := aux + s[j];
end;
m2.add(aux);
aux := '';
end;
m2.EndUpdate;
lines.text := m2.text;
finally
m2.free;
end;
end;
function splitLines2(lines : tstringlist; q: string) : integer;
var
aux, p : string;
i : integer;
flag : boolean;
begin
//maux1 and maux2 are already instanced in the parent class
try
maux2.text := lines.text;
p := '';
i := 0;
flag := false;
maux1.BeginUpdate;
maux2.BeginUpdate;
while (pos(lowercase(q),lowercase(maux2.text)) > 0) and (i < 5000) do
begin
flag := true;
aux := p+copy(maux2.text,1,pos(lowercase(q),lowercase(maux2.text))-1);
maux1.add(aux);
maux2.text := copy(maux2.text,pos(lowercase(q),lowercase(maux2.text)),length(maux2.text));
p := copy(maux2.text,1,1);
maux2.text := copy(maux2.text,2,length(maux2.text));
inc(i);
end;
finally
result := i;
maux1.EndUpdate;
maux2.EndUpdate;
if flag then
begin
maux1.add(p+maux2.text);
lines.text := maux1.text;
end;
end;
end;
I've not tested the speed, but for academic purposes, here's an easy way to split the strings:
myStringList.Text :=
StringReplace(myStringList.Text, myDelimiter, #13#10, [rfReplaceAll]);
// Use [rfReplaceAll, rfIgnoreCase] if you want to ignore case
When you set the Text property of TStringList, it parses on new lines and splits there, so converting to a string, replacing the delimiter with new lines, then assigning it back to the Text property works.
The problems with your code (at least second approach) are
You are constantly using lowecase which is slow if called so many times
If I saw correctly you are copying the whole remaining text back to the original source. This is sure to be extra slow for large strings (eg files)
I have a tokenizer in my library. Its not the fastest or best but it should do (you can get it from Cromis Library, just use the units Cromis.StringUtils and Cromis.Unicode):
type
TTokens = array of ustring;
TTextTokenizer = class
private
FTokens: TTokens;
FDelimiters: array of ustring;
public
constructor Create;
procedure Tokenize(const Text: ustring);
procedure AddDelimiters(const Delimiters: array of ustring);
property Tokens: TTokens read FTokens;
end;
{ TTextTokenizer }
procedure TTextTokenizer.AddDelimiters(const Delimiters: array of ustring);
var
I: Integer;
begin
if Length(Delimiters) > 0 then
begin
SetLength(FDelimiters, Length(Delimiters));
for I := 0 to Length(Delimiters) - 1 do
FDelimiters[I] := Delimiters[I];
end;
end;
constructor TTextTokenizer.Create;
begin
SetLength(FTokens, 0);
SetLength(FDelimiters, 0);
end;
procedure TTextTokenizer.Tokenize(const Text: ustring);
var
I, K: Integer;
Counter: Integer;
NewToken: ustring;
Position: Integer;
CurrToken: ustring;
begin
SetLength(FTokens, 100);
CurrToken := '';
Counter := 0;
for I := 1 to Length(Text) do
begin
CurrToken := CurrToken + Text[I];
for K := 0 to Length(FDelimiters) - 1 do
begin
Position := Pos(FDelimiters[K], CurrToken);
if Position > 0 then
begin
NewToken := Copy(CurrToken, 1, Position - 1);
if NewToken <> '' then
begin
if Counter > Length(FTokens) then
SetLength(FTokens, Length(FTokens) * 2);
FTokens[Counter] := Trim(NewToken);
Inc(Counter)
end;
CurrToken := '';
end;
end;
end;
if CurrToken <> '' then
begin
if Counter > Length(FTokens) then
SetLength(FTokens, Length(FTokens) * 2);
FTokens[Counter] := Trim(CurrToken);
Inc(Counter)
end;
SetLength(FTokens, Counter);
end;
How about just using StrTokens from the JCL library
procedure StrTokens(const S: string; const List: TStrings);
It's open source
http://sourceforge.net/projects/jcl/
As an additional option, you can use regular expressions. Recent versions of Delphi (XE4 and XE5) come with built in regular expression support; older versions can find a free regex library download (zip file) at Regular-Expressions.info.
For the built-in regex support (uses the generic TArray<string>):
var
RegexObj: TRegEx;
SplitArray: TArray<string>;
begin
SplitArray := nil;
try
RegexObj := TRegEx.Create('\[test\]'); // Your sample expression. Replace with q
SplitArray := RegexObj.Split(Lines, 0);
except
on E: ERegularExpressionError do begin
// Syntax error in the regular expression
end;
end;
// Use SplitArray
end;
For using TPerlRegEx in earlier Delphi versions:
var
Regex: TPerlRegEx;
m2: TStringList;
begin
m2 := TStringList.Create;
try
Regex := TPerlRegEx.Create;
try
Regex.RegEx := '\[test\]'; // Using your sample expression - replace with q
Regex.Options := [];
Regex.State := [preNotEmpty];
Regex.Subject := Lines.Text;
Regex.SplitCapture(m2, 0);
finally
Regex.Free;
end;
// Work with m2
finally
m2.Free;
end;
end;
(For those unaware, the \ in the sample expression used are because the [] characters are meaningful in regular expressions and need to be escaped to be used in the regular expression text. Typically, they're not required in the text.)
I implemented this code but again i am not able to search through the subdirectories .
procedure TFfileSearch.FileSearch(const dirName:string);
begin
//We write our search code here
if FindFirst(dirName,faAnyFile or faDirectory,searchResult)=0 then
begin
try
repeat
ShowMessage(IntToStr(searchResult.Attr));
if (searchResult.Attr and faDirectory)=0 then //The Result is a File
//begin
lbSearchResult.Items.Append(searchResult.Name)
else
begin
FileSearch(IncludeTrailingBackSlash(dirName)+searchResult.Name);
//
end;
until FindNext(searchResult)<>0
finally
FindClose(searchResult);
end;
end;
end;
procedure TFfileSearch.btnSearchClick(Sender: TObject);
var
filePath:string;
begin
lbSearchResult.Clear;
if Trim(edtMask.Text)='' then
MessageDlg('EMPTY INPUT', mtWarning, [mbOK], 0)
else
begin
filePath:=cbDirName.Text+ edtMask.Text;
ShowMessage(filePath);
FileSearch(filePath);
end;
end;
I am giving the search for *.ini files in E:\ drive. so initially filePath is E:*.ini.
But the code does not search the directories in E:\ drive. How to correct it?
Thanks in Advance
You can't apply a restriction to the file extension in the call to FindFirst. If you did so then directories do not get enumerated. Instead you must check for matching extension in your code. Try something like this:
procedure TMyForm.FileSearch(const dirName:string);
var
searchResult: TSearchRec;
begin
if FindFirst(dirName+'\*', faAnyFile, searchResult)=0 then begin
try
repeat
if (searchResult.Attr and faDirectory)=0 then begin
if SameText(ExtractFileExt(searchResult.Name), '.ini') then begin
lbSearchResult.Items.Append(IncludeTrailingBackSlash(dirName)+searchResult.Name);
end;
end else if (searchResult.Name<>'.') and (searchResult.Name<>'..') then begin
FileSearch(IncludeTrailingBackSlash(dirName)+searchResult.Name);
end;
until FindNext(searchResult)<>0
finally
FindClose(searchResult);
end;
end;
end;
procedure TMyForm.FormCreate(Sender: TObject);
begin
FileSearch('c:\windows');
end;
I'd recommend doing as follows:
uses
System.Types,
System.IOUtils;
procedure TForm7.Button1Click(Sender: TObject);
var
S: string;
begin
Memo1.Lines.Clear;
for S in TDirectory.GetFiles('C:\test', '*.bmp', TSearchOption.soAllDirectories) do
Memo1.Lines.Add(S);
Showmessage('Finished!');
end;
I hate those recursive solutions with FindFirst/FindNext and I consider it troublesome that some even forget to use FindClose to clean up resources. So, for the fun of it, a non-recursive solution that should be practical to use...
procedure FindDocs(const Root: string);
var
SearchRec: TSearchRec;
Folders: array of string;
Folder: string;
I: Integer;
Last: Integer;
begin
SetLength(Folders, 1);
Folders[0] := Root;
I := 0;
while (I < Length(Folders)) do
begin
Folder := IncludeTrailingBackslash(Folders[I]);
Inc(I);
{ Collect child folders first. }
if (FindFirst(Folder + '*.*', faDirectory, SearchRec) = 0) then
begin
repeat
if not ((SearchRec.Name = '.') or (SearchRec.Name = '..')) then
begin
Last := Length(Folders);
SetLength(Folders, Succ(Last));
Folders[Last] := Folder + SearchRec.Name;
end;
until (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end;
{ Collect files next.}
if (FindFirst(Folder + '*.doc', faAnyFile - faDirectory, SearchRec) = 0) then
begin
repeat
if not ((SearchRec.Attr and faDirectory) = faDirectory) then
begin
WriteLn(Folder, SearchRec.Name);
end;
until (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end;
end;
end;
While it seems to eat a lot of memory because it uses a dynamic array, a recursive method will do exactly the same but recursion happens on the stack! Also, with a recursive method, space is allocated for all local variables while my solution only allocates space for the folder names.
When you check for speed, both methods should be just as fast. The recursive method is easier to remember, though. You can also use a TStringList instead of a dynamic array, but I just like dynamic arrays.
One additional trick with my solution: It can search in multiple folders! I Initialized the Folders array with just one root, but you could easily set it's length to 3, and set Folders[0] to C:\, Folders[1] to D:\ and Folders[2] to E:\ and it will search on multiple disks!
Btw, replace the WriteLn() code with whatever logic you want to execute...
This is worked for me with multi-extension search support:
function GetFilesPro(const Path, Masks: string): TStringDynArray;
var
MaskArray: TStringDynArray;
Predicate: TDirectory.TFilterPredicate;
begin
MaskArray := SplitString(Masks, ',');
Predicate :=
function(const Path: string; const SearchRec: TSearchRec): Boolean
var
Mask: string;
begin
for Mask in MaskArray do
if MatchesMask(SearchRec.Name, Mask) then
exit(True);
exit(False);
end;
Result := TDirectory.GetFiles(Path, Predicate);
end;
Usage:
FileList := TStringList.Create;
FileSearch(s, '.txt;.tmp;.exe;.doc', FileList);
The problem with this file search is that it will loop infinitely, FindClose is like it does not exist.
procedure FindFilePattern(root:String;pattern:String);
var
SR:TSearchRec;
begin
root:=IncludeTrailingPathDelimiter(root);
if FindFirst(root+'*.*',faAnyFile,SR) = 0 then
begin
repeat
Application.ProcessMessages;
if ((SR.Attr and faDirectory) = SR.Attr ) and (pos('.',SR.Name)=0) then
FindFilePattern(root+SR.Name,pattern)
else
begin
if pos(pattern,SR.Name)>0 then Form1.ListBox1.Items.Add(Root+SR.Name);
end;
until FindNext(SR)<>0;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FindFilePattern('C:\','.exe');
end;
This searches recursively to all folders displaying filenames that contain a certain pattern.
In Delphi 2007 how can I make a program to read the first file and then close it to read the second one and so on until the last file?
Are you trying to read every file in a directory? Try this class. This isn't my original code but I've modified and customized it a bit. It'll give you all the filenames that match criteria you set in a string list that you can pass to TFilestream.
unit findfile;
interface
uses
Classes;
type
TFileAttrKind = (ffaReadOnly, ffaHidden, ffaSysFile, ffaDirectory, ffaArchive, ffaAnyFile);
TFileAttr = set of TFileAttrKind;
TFindFile = class(TObject)
private
s: TStringList;
fSubFolder : boolean;
fAttr: TFileAttr;
FPath : string;
FBasePath: string;
fFileMask : string;
FDepth: integer;
procedure SetPath(Value: string);
procedure FileSearch(const inPath : string);
function cull(value: string): string;
public
constructor Create(path: string);
destructor Destroy; override;
function SearchForFiles: TStringList;
property FileAttr: TFileAttr read fAttr write fAttr;
property InSubFolders : boolean read fSubFolder write fSubFolder;
property Path : string read fPath write SetPath;
property FileMask : string read fFileMask write fFileMask ;
end;
implementation
{$WARN SYMBOL_PLATFORM OFF}
{$WARN UNIT_PLATFORM OFF}
uses
Windows, SysUtils, FileCtrl;
constructor TFindFile.Create(path: string);
begin
inherited Create;
FPath := path;
FBasePath := path;
FileMask := '*.*';
FileAttr := [ffaReadOnly, ffaDirectory, ffaArchive];
s := TStringList.Create;
FDepth := -1;
end;
procedure TFindFile.SetPath(Value: string);
begin
if fPath <> Value then
begin
if (Value <> '') and (DirectoryExists(Value)) then
fPath := IncludeTrailingPathDelimiter(Value);
end;
end;
function TFindFile.SearchForFiles: TStringList;
begin
s.Clear;
try
FileSearch(Path);
finally
Result := s;
end;
end;
function TFindFile.cull(value: string): string;
begin
result := StringReplace(value, FBasePath, '', []);
end;
destructor TFindFile.Destroy;
begin
s.Free;
inherited Destroy;
end;
procedure TFindFile.FileSearch(const InPath : string);
var Rec : TSearchRec;
Attr : integer;
begin
inc(FDepth);
try
Attr := 0;
if ffaReadOnly in FileAttr then
Attr := Attr + faReadOnly;
if ffaHidden in FileAttr then
Attr := Attr + faHidden;
if ffaSysFile in FileAttr then
Attr := Attr + faSysFile;
if ffaDirectory in FileAttr then
Attr := Attr + faDirectory;
if ffaArchive in FileAttr then
Attr := Attr + faArchive;
if ffaAnyFile in FileAttr then
Attr := Attr + faAnyFile;
if SysUtils.FindFirst(inPath + FileMask, Attr, Rec) = 0 then
try
repeat
if (Rec.Name = '.') or (Rec.Name = '..') then
Continue;
s.Add(cull(inPath) + Rec.Name);
until SysUtils.FindNext(Rec) <> 0;
finally
SysUtils.FindClose(Rec);
end;
If not InSubFolders then
Exit;
if SysUtils.FindFirst(inPath + '*.*', faDirectory, Rec) = 0 then
try
repeat
if ((Rec.Attr and faDirectory) <> 0) and (Rec.Name <> '.') and (Rec.Name <> '..') then
begin
FileSearch(IncludeTrailingPathDelimiter(inPath + Rec.Name));
end;
until SysUtils.FindNext(Rec) <> 0;
finally
SysUtils.FindClose(Rec);
end;
finally
dec(FDepth);
end;
end;
end.
DIFileFinder might be something that you would like.
If you want to repeat an action, then what you want is called a loop. Delphi comes with three reserved words for loops: for, repeat, and while. All are documented in the help file; I think the overarching topic is called structured statements. You would do well to read about them.
A traditional for loop is most appropriate when you already have an array or list of things you want to process. In your case, probably a list of file names. You could write the loop like this:
for i := 0 to High(FileNames) do begin ... end;
or this:
for i := 0 to Pred(FileNames.Count) do begin ... end;
Then you would refer to FileNames[i] within the loop to get the file name of the current iteration. There's also a new-style for loop that you would use when the thing that contains your file names has an enumerator or iterator available. Then you would write the loop like this:
for name in FileNames do begin ... end;
While and repeat loops are used when you don't necessarily know before the loop starts how many times you'll need to run the code. You could use that in conjunction with the FindFirst and FindNext Delphi functions. For example:
if FindFirst('*.txt', faAnyFile, SearchResult) = 0 then try
repeat
// Do something with SearchResult.Name
until FindNext(SearchResult) <> 0;
finally
SysUtils.FindClose(SearchResult);
end;