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.