| 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
|
|---|
| 26 | SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FileCtrl;
|
|---|
| 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 | procedure Register;
|
|---|
| 58 |
|
|---|
| 59 | implementation
|
|---|
| 60 |
|
|---|
| 61 | resourcestring
|
|---|
| 62 | SDirNotFound = 'Directory not found';
|
|---|
| 63 |
|
|---|
| 64 | procedure Register;
|
|---|
| 65 | begin
|
|---|
| 66 | RegisterComponents('Samples', [TFindFile]);
|
|---|
| 67 | end;
|
|---|
| 68 |
|
|---|
| 69 | constructor TFindFile.Create(AOwner: TComponent);
|
|---|
| 70 | begin
|
|---|
| 71 | inherited Create(AOwner);
|
|---|
| 72 | Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir));
|
|---|
| 73 | FileMask := '*.*';
|
|---|
| 74 | FileAttr := [ffaAnyFile];
|
|---|
| 75 | s := TStringList.Create;
|
|---|
| 76 | end;
|
|---|
| 77 |
|
|---|
| 78 | destructor TFindFile.Destroy;
|
|---|
| 79 | begin
|
|---|
| 80 | s.Free;
|
|---|
| 81 | inherited Destroy;
|
|---|
| 82 | end;
|
|---|
| 83 |
|
|---|
| 84 | procedure TFindFile.SetPath(Value: string);
|
|---|
| 85 | begin
|
|---|
| 86 | if fPath <> Value then
|
|---|
| 87 | begin
|
|---|
| 88 | if Value <> '' then
|
|---|
| 89 | if DirectoryExists(UTF8Decode(Value)) then
|
|---|
| 90 | fPath := IncludeTrailingBackslash(Value)
|
|---|
| 91 | else raise EDirNotFound.Create(SDirNotFound);
|
|---|
| 92 | end;
|
|---|
| 93 | end;
|
|---|
| 94 |
|
|---|
| 95 | function TFindFile.SearchForFiles: TStringList;
|
|---|
| 96 | begin
|
|---|
| 97 | s.Clear;
|
|---|
| 98 | try
|
|---|
| 99 | FileSearch(Path);
|
|---|
| 100 | finally
|
|---|
| 101 | Result := s;
|
|---|
| 102 | end;
|
|---|
| 103 | end;
|
|---|
| 104 |
|
|---|
| 105 | procedure TFindFile.FileSearch(const InPath : string);
|
|---|
| 106 | var Rec : TSearchRec;
|
|---|
| 107 | Attr : integer;
|
|---|
| 108 | begin
|
|---|
| 109 | Attr := 0;
|
|---|
| 110 | if ffaReadOnly in FileAttr then Attr := Attr + faReadOnly;
|
|---|
| 111 | if ffaHidden in FileAttr then Attr := Attr + faHidden;
|
|---|
| 112 | if ffaSysFile in FileAttr then Attr := Attr + faSysFile;
|
|---|
| 113 | if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;
|
|---|
| 114 | if ffaDirectory in FileAttr then Attr := Attr + faDirectory;
|
|---|
| 115 | if ffaArchive in FileAttr then Attr := Attr + faArchive;
|
|---|
| 116 | if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile;
|
|---|
| 117 |
|
|---|
| 118 | if SysUtils.FindFirst(UTF8Decode(inPath + FileMask), Attr, Rec) = 0 then
|
|---|
| 119 | try
|
|---|
| 120 | repeat
|
|---|
| 121 | s.Add(inPath + UTF8Encode(Rec.Name));
|
|---|
| 122 | until SysUtils.FindNext(Rec) <> 0;
|
|---|
| 123 | finally
|
|---|
| 124 | SysUtils.FindClose(Rec);
|
|---|
| 125 | end;
|
|---|
| 126 |
|
|---|
| 127 | If not InSubFolders then Exit;
|
|---|
| 128 |
|
|---|
| 129 | if SysUtils.FindFirst(UTF8Decode(inPath + '*.*'), faDirectory, Rec) = 0 then
|
|---|
| 130 | try
|
|---|
| 131 | repeat
|
|---|
| 132 | if ((Rec.Attr and faDirectory) > 0) and (Rec.Name <> '.')
|
|---|
| 133 | and (Rec.Name <> '..') then
|
|---|
| 134 | FileSearch(IncludeTrailingBackslash(inPath + UTF8Encode(Rec.Name)));
|
|---|
| 135 | until SysUtils.FindNext(Rec) <> 0;
|
|---|
| 136 | finally
|
|---|
| 137 | SysUtils.FindClose(Rec);
|
|---|
| 138 | end;
|
|---|
| 139 | end;
|
|---|
| 140 |
|
|---|
| 141 | end.
|
|---|
| 142 |
|
|---|