Stringvergleich mit Wildcards

[himitsu]

War doch fast so einfach, wie ich's mir dachte.

String-Version: (bis D2007 als ANSI und in D2009 als Unicode)

Delphi-Quellcode:

Function MatchText(Const Mask, S: String; CaseSensitive: Boolean = False): Boolean;
  Var Mp, Me2, Me, Mm, Sp, Se, Sm: PChar;
    Mt, St: String;

  Label LMulti, LMask;

  Begin
    Result := False;
    If CaseSensitive Then Begin
      Mp := PChar(Mask);
      Sp := PChar(S);
    End Else Begin
      Mt := Mask;
      St := S;
      UniqueString(Mt);
      UniqueString(St);
      Mp := PChar(Mt);
      Sp := PChar(St);
      CharLowerBuff(Mp, Length(Mt));
      CharLowerBuff(Sp, Length(St));
    End;
    Me  := Mp + Length(Mask);
    Me2 := Me;
    Se  := Sp + Length(S);

    LMulti:
    Mm := nil;
    Sm := Se;
    While (Mp < Me2) or (Sp < Se) do Begin
      Case Mp^ of
        '*': Begin
          While Mp^ = '*' do Inc(Mp);
          Mm := Mp;
          Sm := Sp + 1;
          Continue;

          LMask:
          Mp := Mm;
          Sp := Sm;
          Inc(Sm);
          If (Mp < Me2) and (Sp >= Se) Then
            If Me2 < Me Then Begin
              Inc(Me2);
              Mp := Me2;
              If CaseSensitive Then Sp := PChar(S) Else Sp := PChar(St);
              While Me2 < Me do
                Case Me2^ of
                  '\': Case (Me2 + 1)^ of
                         '*', '?', '|', '\': Inc(Me2, 2);
                         Else                Inc(Me2);
                       End;
                  '|': Begin
                         Me2^ := #0;
                         Goto LMulti;
                       End;
                  Else Inc(Me2);
                End;
              Goto LMulti;
            End Else Exit;
          Continue;
        End;
        '?': ;
        '|': Begin
               If (Mt = '') and (Mask <> '') Then Begin
                 Mt := Mask;
                 UniqueString(Mt);
                 Mp := Mp - PChar(Mask) + PChar(Mt);
                 Me := PChar(Mt) + Length(Mask);
                 If Mm <> nil Then Mm := Mm - PChar(Mask) + PChar(Mt);
               End;
               Mp^ := #0;
               Me2 := Mp;
               Continue;
             End;
        '\': Begin
          Case (Mp + 1)^ of  '*', '?', '|', '\': Inc(Mp);  End;
          If Mp^ <> Sp^ Then GoTo LMask;
        End;
        Else If Mp^ <> Sp^ Then GoTo LMask;
      End;
      If (Mp >= Me2) or (Sp >= Se) Then GoTo LMask;
      Inc(Mp);
      Inc(Sp);
    End;
    Result := True;
  End;

PChar-Version: (bis D2007 als PAnsiChar und in D2009 als PWideChar)

Delphi-Quellcode:

Function MatchText(Mask, S: PChar; CaseSensitive: Boolean = False): Boolean;
  Var Mp, Mm, Me, Me2, Sp, Sm: PChar;
    Mt, St: String;

  Label LMulti, LMask;

  Begin
    Result := False;
    If CaseSensitive Then Begin
      Mt := Mask;
      Mp := PChar(Mt);
      Sp := S;
    End Else Begin
      Mt := Mask;
      St := S;
      Mp := PChar(Mt);
      Sp := PChar(St);
      CharLowerBuff(Mp, Length(Mt));
      CharLowerBuff(Sp, Length(St));
    End;
    Me  := Mp + lstrlen(Mp);
    Me2 := Me;

    LMulti:
    Mm := nil;
    Sm := Sp + lstrlen(Sp);
    While (Mp^ <> #0) or (Sp^ <> #0) do Begin
      Case Mp^ of
        '*': Begin
          While Mp^ = '*' do Inc(Mp);
          Mm := Mp;
          Sm := Sp + 1;
          Continue;

          LMask:
          Mp := Mm;
          Sp := Sm;
          Inc(Sm);
          If ((Mp = nil) or (Mp^ <> #0)) and (Sp^ = #0) Then Begin
            If Me2 < Me Then Begin
              Inc(Me2);
              Mp := Me2;
              If CaseSensitive Then Sp := S Else Sp := PChar(St);
              While Me2 < Me do
                Case Me2^ of
                  '\': Case (Me2 + 1)^ of
                         '*', '?', '|', '\': Inc(Me2, 2);
                         Else                Inc(Me2);
                       End;
                  '|': Begin
                         Me2^ := #0;
                         Goto LMulti;
                       End;
                  Else Inc(Me2);
                End;
              Goto LMulti;
            End Else Exit;
          End;
          Continue;
        End;
        '?': ;
        '|': Begin
               Mp^ := #0;
               Me2 := Mp;
               Continue;
             End;
        '\': Begin
          Case (Mp + 1)^ of  '*', '?', '|', '\': Inc(Mp);  End;
          If Mp^ <> Sp^ Then GoTo LMask;
        End;
        Else If Mp^ <> Sp^ Then GoTo LMask;
      End;
      If (Mp^ = #0) or (Sp^ = #0) Then GoTo LMask;
      Inc(Mp);
      Inc(Sp);
    End;
    Result := True;
  End;

diese Testmuster laufen mit dem richtigen Ergebnis durch:

Delphi-Quellcode:

If     MatchText('',        'abcdef') Then Beep;
If     MatchText('def',     '')       Then Beep;
If not MatchText('abcdef',  'abcdef') Then Beep;
If     MatchText('df',      'abcdef') Then Beep;
If     MatchText('abc',     'abcdef') Then Beep;
If     MatchText('def',     'abcdef') Then Beep;
If     MatchText('abc?f',   'abcdef') Then Beep;
If not MatchText('abc??f',  'abcdef') Then Beep;
If not MatchText('abc*f',   'abcdef') Then Beep;
If     MatchText('a?def',   'abcdef') Then Beep;
If not MatchText('a??def',  'abcdef') Then Beep;
If not MatchText('a*def',   'abcdef') Then Beep;
If     MatchText('abcd?',   'abcdef') Then Beep;
If not MatchText('abcd??',  'abcdef') Then Beep;
If     MatchText('abcd???', 'abcdef') Then Beep;
If not MatchText('abcd*',   'abcdef') Then Beep;
If     MatchText('a?def',   'abcdef') Then Beep;
If not MatchText('a??def',  'abcdef') Then Beep;
If not MatchText('a*def',   'abcdef') Then Beep;
If     MatchText('?cdef',   'abcdef') Then Beep;
If not MatchText('??cdef',  'abcdef') Then Beep;
If not MatchText('*cdef',   'abcdef') Then Beep;
If     MatchText('b*c*f',   'abcdef') Then Beep;
If not MatchText('a*c*f',   'abcdef') Then Beep;
If not MatchText('a?c*f',   'abcdef') Then Beep;
If     MatchText('a?d*f',   'abcdef') Then Beep;
If not MatchText('*a*f*',   'abcdef') Then Beep;
If     MatchText('*a?bf*',  'abcdef') Then Beep;
If not MatchText('*c*f*',   'abcdef') Then Beep;
If not MatchText('*c*d*',   'abcdef') Then Beep;
If     MatchText('*c?f*',   'abcdef') Then Beep;
If not MatchText('*d?f*',   'abcdef') Then Beep;
If not MatchText('*',       '')       Then Beep;
If not MatchText('*',       'abcdef') Then Beep;
If not MatchText('a*',      'abcdef') Then Beep;
If not MatchText('*f',      'abcdef') Then Beep;

If not MatchText('a*d|a*',  'abcdef') Then Beep;
If     MatchText('abc|ef',  'abc|ef') Then Beep;
If not MatchText('abc\|ef', 'abc|ef') Then Beep;

Und im Anhang alle Versionen überladen unter einem Namen in 'ner Unit verpackt.
> String, AnsiString, WideString, UnicodeString (ab D2009), PChar, PAnsiChar und PWideChar

Ich hoffe die laufen nun auch alle richtig

[edit 22.06.2009]
Anhang entfernt > aktuelle Version siehe Beitrag #26