[28] | 1 | {TFindFile
|
---|
| 2 |
|
---|
| 3 | Article:
|
---|
| 4 | http://delphi.about.com/library/weekly/aa052300a.htm
|
---|
| 5 |
|
---|
| 6 | Tired of using FindFirst, Next and Close?
|
---|
| 7 | Come see how to encapsulate all those functions
|
---|
| 8 | in a single "find-files-recursively" component.
|
---|
| 9 | It's easy to use, free and with code.
|
---|
| 10 |
|
---|
| 11 |
|
---|
| 12 | ********************************************
|
---|
| 13 | Zarko Gajic
|
---|
| 14 | About.com Guide to Delphi Programming
|
---|
| 15 | http://delphi.about.com
|
---|
| 16 | email: delphi.guide@about.com
|
---|
| 17 | ********************************************
|
---|
| 18 |
|
---|
| 19 | }
|
---|
| 20 |
|
---|
| 21 | unit UFindFile;
|
---|
| 22 |
|
---|
| 23 | interface
|
---|
| 24 |
|
---|
| 25 | uses
|
---|
[38] | 26 | SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
|
---|
[28] | 27 |
|
---|
| 28 | type
|
---|
| 29 | EDirNotFound = class(Exception);
|
---|
| 30 |
|
---|
| 31 | TFileAttrKind = (ffaReadOnly, ffaHidden, ffaSysFile, ffaVolumeID, ffaDirectory, ffaArchive, ffaAnyFile);
|
---|
| 32 | TFileAttrib = set of TFileAttrKind;
|
---|
| 33 |
|
---|
| 34 | TFindFile = class(TComponent)
|
---|
| 35 | private
|
---|
| 36 | s : TStringList;
|
---|
| 37 |
|
---|
| 38 | fSubFolder : boolean;
|
---|
| 39 | fAttr: TFileAttrib;
|
---|
| 40 | fPath : string;
|
---|
| 41 | fFileMask : string;
|
---|
| 42 |
|
---|
| 43 | procedure SetPath(Value: string);
|
---|
| 44 | procedure FileSearch(const inPath : string);
|
---|
| 45 | public
|
---|
| 46 | constructor Create(AOwner: TComponent); override;
|
---|
| 47 | destructor Destroy; override;
|
---|
| 48 |
|
---|
| 49 | function SearchForFiles: TStringList;
|
---|
| 50 | published
|
---|
| 51 | property FileAttr: TFileAttrib read fAttr write fAttr;
|
---|
| 52 | property InSubFolders : boolean read fSubFolder write fSubFolder;
|
---|
| 53 | property Path : string read fPath write SetPath;
|
---|
| 54 | property FileMask : string read fFileMask write fFileMask ;
|
---|
| 55 | end;
|
---|
| 56 |
|
---|
| 57 | const
|
---|
| 58 | {$IFDEF WINDOWS}
|
---|
| 59 | FilterAll = '*.*';
|
---|
| 60 | {$ENDIF}
|
---|
| 61 | {$IFDEF LINUX}
|
---|
| 62 | FilterAll = '*';
|
---|
| 63 | {$ENDIF}
|
---|
| 64 |
|
---|
| 65 | procedure Register;
|
---|
| 66 |
|
---|
| 67 | implementation
|
---|
| 68 |
|
---|
| 69 | resourcestring
|
---|
| 70 | SDirNotFound = 'Directory not found';
|
---|
| 71 |
|
---|
| 72 | procedure Register;
|
---|
| 73 | begin
|
---|
| 74 | RegisterComponents('Common', [TFindFile]);
|
---|
| 75 | end;
|
---|
| 76 |
|
---|
| 77 | constructor TFindFile.Create(AOwner: TComponent);
|
---|
| 78 | begin
|
---|
| 79 | inherited Create(AOwner);
|
---|
| 80 | Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir));
|
---|
| 81 | FileMask := FilterAll;
|
---|
| 82 | FileAttr := [ffaAnyFile];
|
---|
| 83 | s := TStringList.Create;
|
---|
| 84 | end;
|
---|
| 85 |
|
---|
| 86 | destructor TFindFile.Destroy;
|
---|
| 87 | begin
|
---|
| 88 | s.Free;
|
---|
| 89 | inherited Destroy;
|
---|
| 90 | end;
|
---|
| 91 |
|
---|
| 92 | procedure TFindFile.SetPath(Value: string);
|
---|
| 93 | begin
|
---|
| 94 | if fPath <> Value then
|
---|
| 95 | begin
|
---|
| 96 | if Value <> '' then
|
---|
| 97 | if DirectoryExists(UTF8Decode(Value)) then
|
---|
| 98 | fPath := IncludeTrailingBackslash(Value)
|
---|
| 99 | else raise EDirNotFound.Create(SDirNotFound);
|
---|
| 100 | end;
|
---|
| 101 | end;
|
---|
| 102 |
|
---|
| 103 | function TFindFile.SearchForFiles: TStringList;
|
---|
| 104 | begin
|
---|
| 105 | s.Clear;
|
---|
| 106 | try
|
---|
| 107 | FileSearch(Path);
|
---|
| 108 | finally
|
---|
| 109 | Result := s;
|
---|
| 110 | end;
|
---|
| 111 | end;
|
---|
| 112 |
|
---|
| 113 | procedure TFindFile.FileSearch(const InPath : string);
|
---|
| 114 | var Rec : TSearchRec;
|
---|
| 115 | Attr : integer;
|
---|
| 116 | begin
|
---|
| 117 | Attr := 0;
|
---|
| 118 | if ffaReadOnly in FileAttr then Attr := Attr + faReadOnly;
|
---|
[38] | 119 | if ffaHidden in FileAttr then Attr := Attr + 2; //faHidden; use constant to avoid platform warning
|
---|
| 120 | if ffaSysFile in FileAttr then Attr := Attr + 4; //faSysFile; use constant to avoid platform warning
|
---|
| 121 | // Deprecated: if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;
|
---|
[28] | 122 | if ffaDirectory in FileAttr then Attr := Attr + faDirectory;
|
---|
| 123 | if ffaArchive in FileAttr then Attr := Attr + faArchive;
|
---|
| 124 | if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile;
|
---|
| 125 |
|
---|
[38] | 126 | if SysUtils.FindFirst(inPath + FileMask, Attr, Rec) = 0 then
|
---|
[28] | 127 | try
|
---|
| 128 | repeat
|
---|
[38] | 129 | s.Add(inPath + Rec.Name);
|
---|
[28] | 130 | until SysUtils.FindNext(Rec) <> 0;
|
---|
| 131 | finally
|
---|
| 132 | SysUtils.FindClose(Rec);
|
---|
| 133 | end;
|
---|
| 134 |
|
---|
| 135 | If not InSubFolders then Exit;
|
---|
| 136 |
|
---|
[38] | 137 | if SysUtils.FindFirst(inPath + FilterAll, faDirectory, Rec) = 0 then
|
---|
[28] | 138 | try
|
---|
| 139 | repeat
|
---|
| 140 | if ((Rec.Attr and faDirectory) > 0) and (Rec.Name <> '.')
|
---|
| 141 | and (Rec.Name <> '..') then
|
---|
[38] | 142 | FileSearch(IncludeTrailingBackslash(inPath + Rec.Name));
|
---|
[28] | 143 | until SysUtils.FindNext(Rec) <> 0;
|
---|
| 144 | finally
|
---|
| 145 | SysUtils.FindClose(Rec);
|
---|
| 146 | end;
|
---|
| 147 | end;
|
---|
| 148 |
|
---|
| 149 | end.
|
---|
[38] | 150 |
|
---|