この発言は
#00836　わいわい        さんのワイルドカード処理（２）
に対するコメントです



　おはようさん。わいわいです。

おもっきし亀レスですが・・・・
この #00836 は、関数内関数で文字列引数を使ってしまってるため、
Ｄ５のバグにぶち当たってしまっています。

次のように関数を外に出せばＯＫです。

＃なんだ、これだけかい。

------------------- 始まり ---------------

    // s から最初の１文字を a に取得し、
    // s も更新する。
    function gmbc(var s:Pchar):integer;
    begin
        result:=0;
        if s=nil then Exit;
        if strByteType(s,0)=mbLeadByte then
        begin
            result:= integer(s^) shl 8;
            inc(s);
        end;
        result:=result+integer(s^);
        if s^<>#0 then inc(s);
    end;

    // 文字列のマスクチェック
    // fp:チェック文字列 mp:マスク文字列
    // ワイルドカードは次の２文字のみ
    // ?:任意の１文字にマッチ
    // *:０文字以上の文字にマッチ
    //   この文字が来たら無条件にマッチとする。
    // 戻り値:マッチしたら True
    function strMask(fp,mp:Pchar):boolean;
    var f,m:integer;
    begin
        result:=false;
        repeat
            f:=gmbc(fp); m:=gmbc(mp);
            case m of
            0:  break;
            integer('*'):
                begin
                    result:=true; Exit;
                end;
            integer('?'):
                if f=0 then Exit;
            else
                if m<>f then Exit;
            end;
        until false;
        Result:= (f=0);
    end;


// ************** 本体 ****************
// ファイル名 fname が、ファイルマスク mask
// とマッチしているか。
// 戻り値:マッチしていれば True
function Check_Mask(fname,mask:string):boolean;
var m1,m2:Pchar;    // マスク文字列
    f1,f2:Pchar;    // マッチ文字列
begin
    result:=false;

    // 無条件に True とするマスク文字列
    if(mask='*.*') or (mask='') or (mask='*') then begin
    result:=true; Exit;
    end;

    m1:=strNew(Pchar(AnsiUppercase(mask)));
    f1:=strNew(Pchar(AnsiUppercase(fname)));
    try
        // ファイル名と拡張子を分離
        m2:=AnsiStrRscan(m1,'.');
        f2:=AnsiStrRscan(f1,'.');
        if m2<>nil then begin m2^:=#0; inc(m2); end;
        if f2<>nil then begin f2^:=#0; inc(f2); end;

        // この時点で、f1:マッチファイル名 f2:マッチ拡張子
        // m1:マスクファイル名 m2:マスク拡張子
        if strMask(f1,m1) then
            result:=strmask(f2,m2);
    finally
        strDispose(m1);
        strDispose(f1);
    end;
end;

--------------- 終わり -------------------
ではでは。
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 01/08/16 -

Original document by わいわい        氏 ID:(QZC10252)

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