条件に合致するファイルを探し出し、見つかったファイルに対して何か作業ができるようにイベントを発生させています。
指定フォルダ以下のサブフォルダに対しても検索をかけています。サブフォルダの階層を制限する場合や、サブフォルダの検索が不要な際には、イベント中で DigDir 引数に対し False を返すとそれ以上のサブフォルダを処理しません。
見つかったときの処理を直コーディングせずにイベントにしたことでクラス化が行え、再利用性が高まっています。別にライブラリでもよかったのですが、コンポーネントのほうが視覚的に見えてダブルクリックでコーディングしていけるので皆さんに使ってもらいやすいかな?というぐらいのものです。
利用方法:
- FileMask
見つけるべき対象のファイルとそうでないファイルとを分けるフィルタ文字列を設定します。
フィルタ文字列の設定方法は Mask ユニットの TMask の記述を参照してください。 - Root
検索対象フォルダの最上位のフォルダを指定します。
実行の際最初に一度だけ参照されます。 - OnFound
ファイルが見つかった場合、サブフォルダが見つかった場合に起こるイベントです。
詳細はコメントを参考にしてください。
unit DigDir; interface uses SysUtils, Classes, Masks; const DefaultMaskStr = '*.*'; type ///ファイル/フォルダ発見時のコールバック関数 /// 見つけたパス /// ファイルかどうか(ファイル=True) /// 掘り進んだレベル(Root=0) /// フォルダの場合掘るかどうか /// 処理中断 TFoundEvent = procedure(const Path: string; const IsFile: Boolean; const Level: integer; var DigDir: Boolean; var Cancel: Boolean) of object; TDigDirectory = class(TComponent) private FFileMaskStr: string; FFileMask: TMask; FRoot: string; FOnFound: TFoundEvent; /// ファイル検索マスク設定 /// マスクパターン文字列 procedure SetFileMask(const Value: string); /// フォルダ検索 procedure DigDirectory(const DirPath: string; const Level: integer); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; /// フォルダ検索 procedure Execute(); published /// ファイル検索マスク文字列 property FileMask: string read FFileMaskStr write SetFileMask; /// 検索ルートフォルダ property Root: string read FRoot write FRoot; /// 条件に一致するファイルが見つかった場合のイベント property OnFound: TFoundEvent read FOnFound write FOnFound; end; procedure Register; implementation { TDigDirectory } constructor TDigDirectory.Create(AOwner: TComponent); begin inherited; SetFileMask(DefaultMaskStr); end; destructor TDigDirectory.Destroy; begin inherited; FreeAndNil(FFileMask); end; procedure TDigDirectory.Execute(); begin DigDirectory(FRoot, 0); end; procedure TDigDirectory.DigDirectory(const DirPath: string; const Level: integer); var Rec: TSearchRec; Path: string; DigDir, Cancel: Boolean; begin Cancel := false; Path := IncludeTrailingPathDelimiter(DirPath); // 付け if FindFirst(Path + '*.*', faAnyFile, Rec) = 0 then // 初回検索 begin // 見つかった try repeat // フォルダ発見 if (Rec.Attr and faDirectory > 0) and (Rec.Name <> '.') and (Rec.Name <> '..') then begin // 通知 DigDir := true; if Assigned(FOnFound) then FOnFound(Path + Rec.Name, false, Level, DigDir, Cancel); // キャンセルの場合 if Cancel then break; // さらに掘る場合 if DigDir then DigDirectory(Path + Rec.Name, Level + 1); end // ファイル発見 else if (Rec.Name <> '.') and (Rec.Name <> '..') and (FFileMask.Matches(Rec.Name)) then begin // 通知 if Assigned(FOnFound) then FOnFound(Path + Rec.Name, true, Level, DigDir, Cancel); if Cancel then break; // キャンセルの場合 end; until (FindNext(Rec) <> 0); finally FindClose(Rec); // 解放 end; end; end; procedure TDigDirectory.SetFileMask(const Value: string); var NewMaskStr: String; OldMask: TMask; begin if (Value = '') then NewMaskStr := DefaultMaskStr else NewMaskStr := Value; if (FFileMaskStr = NewMaskStr) then exit; OldMask := FFileMask; try FFileMask := TMask.Create(NewMaskStr); FFileMaskStr := NewMaskStr; except FFileMask := OldMask; end; end; procedure Register; begin RegisterComponents('Black Cat', [TDigDirectory]); end; end.
以下のコメントは、その投稿者が所有するものでサイト管理者はコメントに関する責任を負いません。