ワイルドカードマッチコンポーネント(2004/8/20)

TMaskを使用する前の自前判定コンポーネントを復活させました。
wm2.zipのダウンロード(2,359byte)

拙作 MIClean のユーザ指定のファイルマスク検索に用いたものです。
いつかなにかで使うこともあるかもしれないのでコンポーネント化しました。
TMaskを使用した処理に変更しました。'*A*.*B*'のような指定も可能になりました。


property
    Mask: TStringList;  マッチ確認したいファイルマスクを指定する。
                        複数の指定が出来る。なお、指定し直すは使用する側で処理する
                        例）
                          WildMatch1.Mask.Clear;
                          WildMatch1.Mask.Add('abc*.d??');
                          WildMatch1.Mask.Add('cde???.f*');
    FileName: String;   マッチするかどうかを確認するファイル名を指定する。

method
    Execute;            マッチ確認を実行する。リターンコードはマッチすれば TRUE, 
                        しなければ FALSE を返す。

event
    OnMatch;            マッチした場合に発生。

ここから下をコピーして wildmatch.pas として保存して下さい。
コンポーネントのインストール方法は、Delphiのマニュアルを参照してください。

{
  ワイルドカードマッチ
  1999/2/14

  1999/2/28  *や*.でマッチしない不具合を修正
  1999/6/13 .がいくつもあるファイルにマッチしない不具合を修正
  1999/9/4  .のあとの*がマッチしない不具合を修正
  1999/10/8  *のあとに文字があった場合のマッチ処理を追加するために
            全面書換実施（以前の面影は０）
  2001/9/6  ファイル名，拡張子共にひとつの'*'しか処理出来ないことに
            対応するため、独自の処理を廃止してTMaskに依存
            ※こんな便利なクラスがあったんですね(^^;
  ===============================================================
  ワイルドマスク仕様
    '*'  0個以上の文字列とマッチ
    '?' 任意の文字とマッチ

    '*.*'もしくは'*'は全てのファイル名とマッチ。

    例）
      'ABC*.*' は先頭に'ABC'を含むファイル名とマッチ
      '????.*' はファイル名が４文字のファイル名とマッチ
      'AB*C.*' は先頭に'AB'，最後に'C'を含むファイル名とマッチ
      '*B*.*'  は'B'が含まれるファイル名とマッチ
      ※上記の例は拡張子のマッチについても当てはまる
      ※WINDOWSの仕様上、大文字と小文字の区別はない。全て大文字に
      　変換した後にマッチ確認を行なう
}
unit WildMatch;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Masks;

type
  TOnMatchEvent = procedure(Sender: TObject) of Object;
  TWildMatch = class(TComponent)
  private
    { Private 宣言 }
    FMask: TStrings;
    FName: string;
    FOnMatch: TOnMatchEvent;
    procedure SetMask(const Value: TStrings);
    function Match(const Name, Mask: string): boolean;
    procedure DoMatch(Sender: TObject);
  protected
    { Protected 宣言 }
  public
    { Public 宣言 }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function Execute: Boolean;
  published
    { Published 宣言 }
    property Mask: TStrings read FMask write SetMask;
    property FileName: string read FName write FName;
    property OnMatch: TOnMatchEvent read FOnMatch write FOnMatch;
  end;

procedure Register;

implementation

constructor TWildMatch.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMask := TStringList.Create;
end;

destructor TWildMatch.Destroy;
begin
  FMask.Free;
  inherited Destroy;
end;

procedure TWildMatch.SetMask(const Value: TStrings);
begin
  FMask.Assign(Value);
end;

function TWildMatch.Match(const Name, Mask:string):boolean;
var
  Msk: TMask;
begin
  Msk := TMask.Create(Mask);
  try
    Result := Msk.Matches(Name);
  finally
    Msk.Free;
  end;
end;

function TWildMatch.Execute: boolean;
var
  i: integer;
begin
  Result := False;
  if (FName = '') or (FMask.Count = 0) then
    Exit;
  for i := 0 to FMask.Count - 1 do
    if Match(FName, FMask.Strings[i]) then
    begin
      Result := True;
      DoMatch(Self);
      Exit;
    end;
end;

procedure TWildMatch.DoMatch(Sender: TObject);
begin
  if Assigned(FOnMatch) then
    FOnMatch(Sender);
end;

procedure Register;
begin
  RegisterComponents('Sample', [TWildMatch]);
end;

end.