delphi - Excluding folder and files from search -


i surrender, spend time 12hours want, can't.

this code search folders , filenames, want exclude folders including sub directory of folders want exclude searching.

i wish there's 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 begin       repeat         if (sr.attr , (fadirectory or favolumeid)) = 0 begin           //showmessage('filename :>'+ adir + sr.name);           if (notthispath.indexof(adir + sr.name)>=0) or dfound begin             showmessage('do not include filename :>'+ adir + sr.name);           end else begin             showmessage('>>> include filename :>'+ adir + sr.name);             // have file (as opposed directory or             // else). write 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 file             tmpstream := tfilestream.create(adir + sr.name, fmopenread or fmsharedenywrite);             outstream.copyfrom(tmpstream, tmpstream.size);             tmpstream.free;           end;         end;          if (sr.attr , fadirectory) > 0 begin           if (sr.name <> '.') , (sr.name <> '..') begin             //showmessage('dir is:>'+ adir + sr.name);             //if (pos(adir, notthispath.text)>0)             if (notthispath.indexof(adir + sr.name)>=0) begin               showmessage('do not include dir:>'+ adir + sr.name);               dfound:=true;             end else begin               showmessage('>>> include dir:>'+ adir + sr.name);               // write 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 directory             recursedirectory(includetrailingpathdelimiter(adir + sr.name));           end;         end;       until findnext(sr) <> 0;       findclose(sr);     end;     // show done directory     ae.entrytype := aeeod;     outstream.write(ae, sizeof(ae));   end;  begin recursedirectory(includetrailingpathdelimiter(indir)); end; 

notthispath tstringlist;

i think fundamental problem have mixed file enumeration, file name filtering, , gui 1 unholy blob of goo. should not see findfirst being called method of form. code calls findfirst belongs in helper classes or functions.

i'm not going attempt answer question directly, not least because did not ask question. i'm going attempt show how separate concerns of enumerating files , filtering names.

first of all, i'm going implement function:

procedure enumeratefiles(dir: string;    const enumeratefilename: tenumeratefilenamemethod); 

this function passed directory in dir parameter , proceeds enumerate files within directory, sub-directories, , on recursively. each file found passed callback method enumeratefilename. defined so:

type   tenumeratefilenamemethod = procedure(const filename: string) of object; 

the implementation simple indeed. it's standard findfirst based repeat loop. function rejects special directories . , ... recurse directories encounters.

procedure enumeratefiles(dir: string;   const enumeratefilename: tenumeratefilenamemethod); var   sr: tsearchrec; begin   dir := includetrailingpathdelimiter(dir);   if findfirst(dir + '*', faanyfile, sr) = 0     try       repeat         if (sr.name = '.') or (sr.name = '..')           continue;         if (sr.attr , fadirectory) <> 0           enumeratefiles(dir + sr.name, enumeratefilename)         else           enumeratefilename(dir + sr.name);       until findnext(sr) <> 0;           findclose(sr);     end; end; 

now, should simple enough follow hope. next issue filtering. can implement in callback method provide. here's complete demo illustrates filtering picks out delphi source files .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     try       repeat         if (sr.name = '.') or (sr.name = '..')           continue;         if (sr.attr , fadirectory) <> 0           enumeratefiles(dir + sr.name, enumeratefilename)         else           enumeratefilename(dir + sr.name);       until findnext(sr) <> 0;           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')     writeln(filename); end;  procedure main; begin   enumeratefiles('c:\users\heff\development', tdummyclass.enumeratefilename); end;  begin   try     main;     readln;   except     on e: exception       writeln(e.classname, ': ', e.message);   end; end. 

now, know that's not type of filtering want do, point have generality. can replace call sametext whatever filtering want. , once have picked out files want deal with, can them.

i used class method convenience. did not want demo laden down boiler-plate of instantiating object. needs want create class handle enumeration callback. class encapsulate file archiving operation performing. class own instance of output stream. , callback method instance method write archive.

now, i've not implemented complete solution problem, hope i've done better. namely show how factor code make solving problem simple.


Comments

Popular posts from this blog

basic authentication with http post params android -

vb.net - Virtual Keyboard commands -

css - Firefox for ubuntu renders wrong colors -