Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.115 Beiträge
 
Delphi 12 Athens
 

Re: Stringvergleich mit Wildcards

  Alt 7. Mai 2009, 15:51
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
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat