お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル

"ファイル名のマスクマッチ"





 Delphi3.1,4のC/S版にはMatchesMaskがるのですが、一文字も?に
漢字などの2バイトコードがマッチしません。
 そこで、MatchesMaskEx関数を作ってみました。
 拡張子部分とファイル名部分を分けてチェックしてます。
 冗長なコードになってしまっていますので添削をよろしく(^_^;)
-------------- CUT LINE ------------------------------------------
unit KyMask;

interface

uses
  SysUtils;

function MatchesMaskEx(const filename,mask: string):boolean;

implementation

function MatchesMaskEx(const filename,mask: string):boolean;
var
   mask1,mask2:string;
   fn0,fn1,fn2:string;
   i,j,k:integer;
begin
     Result := True;

     i := AnsiPos('.',mask);
     j := length(mask);
     if i > 1 then
     begin
          mask1 := copy(mask,1,(i-1));
          if j > i then mask2 := copy(mask,(i+1),(j-i))
          else mask2 := '*';
     end
     else begin
          if i = 0 then
          begin
               mask1 := mask;
               mask2 := '*';
          end
          else begin
               mask1 := '*';
               if j > i then mask2 := copy(mask,(i+1),(j-i))
               else mask2 := '*';
          end;
     end;

     fn0 := ExtractFileName(filename);
     i := AnsiPos('.',fn0);
     j := length(fn0);
     if i > 1 then
     begin
          fn1 := copy(fn0,1,(i-1));
          if j > i then fn2 := copy(fn0,(i+1),(j-i))
          else fn2 := '';
     end
     else begin
          if i = 0 then
          begin
               fn1 := fn0;
               fn2 := '';
          end
          else begin
               fn1 := '';
               if j > i then fn2 := copy(fn0,(i+1),(j-i))
               else fn2 := '';
          end;
     end;

     i := length(fn1);
     j := length(mask1);
     k := 1;
     while (i > 0) and (j > 0) do
     begin
          if mask1[k] = '*' then
          begin
               i := 0;
               j := 0;
               Break;
          end;
          if mask1[k] = '?' then
          begin
               if StrByteType(Pchar(fn1),(k-1)) <> mbSingleByte then
                    dec(i);
          end
          else begin
               if StrByteType(Pchar(mask1),(k-1)) = mbSingleByte then
               begin
                    if mask1[k] <> fn1[k] then
                    begin
                         Result := False;
                         Exit;
                    end;
               end
               else begin
                    if (i <= 1) or (mask1[k] <> fn1[k]) or
                       (mask1[k+1] <> fn1[k+1]) then
                    begin
                         Result := False;
                         exit;
                    end;
                    dec(i);
                    dec(j);
                    inc(k);
               end;
          end;
          dec(i);
          dec(j);
          inc(k);
     end;
     if (i > 0) or (j > 0) then
     begin
          Result := False;
          exit;
     end;

     i := length(fn2);
     j := length(mask2);
     k := 1;
     while (i > 0) and (j > 0) do
     begin
          if mask2[k] = '*' then
          begin
               i := 0;
               j := 0;
               Break;
          end;
          if mask2[k] = '?' then
          begin
               if StrByteType(Pchar(fn2),(k-1)) <> mbSingleByte then
                    dec(i);
          end
          else begin
               if StrByteType(Pchar(mask2),(k-1)) = mbSingleByte then
               begin
                    if mask2[k] <> fn2[k] then
                    begin
                         Result := False;
                         Exit;
                    end;
               end
               else begin
                    if (i <= 1) or (mask2[k] <> fn2[k]) or
                       (mask2[k+1] <> fn2[k+1]) then
                    begin
                         Result := False;
                         exit;
                    end;
                    dec(i);
                    dec(j);
                    inc(k);
               end;
          end;
          dec(i);
          dec(j);
          inc(k);
     end;
     if (i > 0) or (j > 0) then
     begin
          Result := False;
          exit;
     end;
end;

end.
--------------------- CUT LINE ----------------------------------
                              98/10/17(Sat)  PXP15210 清明

Original document by 清明            氏 ID:(PXP15210)


ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。

Copyright 1996-2002 Delphi Users' Forum