Stringvergleich mit Wildcards

[GPRSNerd]

Hi himitsu,

die Escaped-Sourcen in Post#15 laufen schon ganz gut.
Der Escape von | funktioniert noch nicht so ganz:
MatchText('te\|23', 'te|23', false) ist FALSE.

Danke für deine Mühe,
Stefan

[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

[himitsu]

nur zur Info:
grad ist noch 'ne schnelle Unicode-Version entstanden:

Code:

10.000.000*20     1.000.000*500     100*1MB           500*2MB            (1)

true false case   true false case   true false case   true false case    (2)

1454 1454  2844   1750 1766  5281   375   375  1187   3766  3750 11953   (3)
1391 6270  6328   1813 9853  9732   390  2375  2360   3871 23797 23797   (4)
1234 1328  1640   1578 1563  3172   328   344   734   3375  3391  7391   (5)

(1)  Durchgänge * Stringlänge (Unicodezufallszeichenfolge ohne Maskenzeichen,
     welche immer TRUE lieferten)

(2)  true  > CaseSensitiv
     false > nicht CaseSensitiv
     Case  > nicht CaseSensitiv + unterschiedliche Eingangs-Strings

(3)  true  > CompareStringW
     false > CompareStringW + NORM_IGNORECASE

(4)  MatchText + UnicodeString

(5)  MatchText + UnicodeString intern nur PWideChar mit Vergleichstabelle

( )  Zeiten in Millisekunden

Ich muß aber mal sehen ob/wie ich diese schnellere Funktion (einzeln) veröffentlichen werde.
Abgesehn davon, daß diese im OpenSourceProjekt himXML enthalten sein wird und die anderen Versionen auch nicht soooo langsam sind.
Aber von der Art her müßte ich sie wohl besser in ein Objekt packen und ob sich dagegen der kleine Geschwindigkeitsvorteil noch lohnt?

[GPRSNerd]

Unter D2009 laufen in der String-Variante alle meine Unittests einwandfrei durch!

Danke himitsu für den Code.

[himitsu]

neue Version:
- die Codes aus Beitrag #3 und #22 wurden kombiniert
- es wurde alles auf 2/4 Hauptfunktionen (2x je ansi und wide) gekürzt
- alle Funktionen je als PAnsiChar-, PWideChar-, AnsiString-, WideString- und UnicodeString-Version
- und ich hoff mal es läuft alles noch

Delphi-Quellcode:

Type TCompareFlags = Set of (cfNotCaseSensitive, cfCanMask);

Function MatchString  (Const Mask, S: String; Flags: TCompareFlags = []): Boolean;
Function MatchText    (Const Mask, S: String): Boolean;
Function MatchStringEx(Const Mask, S: String; Flags: TCompareFlags = []): TAnsiStringDynArray;
Function MatchStringEx(Const Mask, S: String; Flags: TCompareFlags;
  Offset: Integer; Out EndOffset: Integer): TAnsiStringDynArray;

MatchString prüft, ob ein String der Maske entspricht

MatchStringEx kopiert die den Maskenzeichen entsprechenden Teile aus S in ein Array,
wenn der String der Maske entspricht, sonst ist das Array leer

MathText = MathString(..., [cfNotCaseSensitive])

Maskenzeichen:
* und ?

Sonderzeichen:
| Trennzeichen für mehrere Masken
\ zum maskieren von *, ?, | und natürlich \

dank des neuen Offsets kann nun auch sequentiell gesucht werden:
(das von da Drüben ist ja nicht sooo der Bringer)

Delphi-Quellcode:

Var S, Se: String;
  i, i2: Integer;
  X: TStringDynArray;

S := 'irgendwas_FesterTeil1_VeränderlicherTeil1_FesterTeil2_irgendwas'
  + 'irgendwas_FesterTeil1_VeränderlicherTeil2_FesterTeil2_irgendwas'
  + 'irgendwas_FesterTeil1_VeränderlicherTeil3_FesterTeil2_irgendwas';

i := 1;
i2 := -1;
While True do Begin
  X := MatchStringEx('*FesterTeil1*FesterTeil2*', S, [], i, i);
  If X = nil Then Break;
  Se := X[1];
  Inc(i2);

  ShowMessage('Se[' + IntToStr(i2) + '] = "' + Se + '"');
End;

[add]
! ich hab grad eben mitbekommen, daß es ein Problem mit | gibt ... ansonsten scheint es zu laufen

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

[himitsu]

praktsich, daß keiner den "kleinen" Fehler bei Verwendung von | bemerkte, wodurch da oftmals FALSE zurückkam, oder eine Exception

hab da gleich nochmal die Gelegenheit genutzt und alles überarbeitet:
* im Grunde ist jetzt alles auf eine einzige Funktion gekürzt (die allerletze Funktion der Unit),
welche dann nochmal in 4 Untervrsion aufgesplittet wurde ... drum nicht über die eigenartigen Kommentare in dieser Funktion wundern, diese markieren nur die Unterschiede zu den anderen drei Funktionsversionen (die davor, also die restlichen Internen)
> so hab ich's jetzt bei Änderungen einfacher, da es im Prinzip nur noch eine Funktion zum bearbeiten gibt
* der Fehler mit | wurde behoben
* eine neuer Parameter "~" wurde eingeführt .. ~c wollte ich zwar erst nur reinmachen und da es mit einer ( ) in der Maske umständlich zu lösen gewesen wäre, ist es nun als "Präfix-Parameter" vorhanden und hat noch ein paar Freunde dazubekommen
(sehr viel mehr wird es wohl nicht geben ... eventuell noch irgendwas wie [a-z] und Co., [edit]grad noch schnell eingebaut[/edit] es wird aber immer bei einer linearen und nicht zusatzinformationspeichernden Funktionsweise bleiben)

Code:

almost all functions are defined with AnsiString, WideString,
UnicodeString (D2009+), PAnsiChar and PWideChar

options flags: cfNotCaseSensitive         if not set, then the comparison is case sensitive
               cfOnlyWild                 only * and ? will gibt used as mask chars
               cfIgnoreOuterAsterix       no values for outer mask chars in result array
                                            (MatchStringEx, MatchStringAll and internal)

mask chars: *                             any number of arbitrary characters
            ?                             an arbitrary character
            {abc} {a-z} {a-z0-9ß} ...     an spezified character
            ~d    *~d  ?~d                delete previous result entry
            ~c    *~c  ?~c                concat the last 2 result entries,
                                            including all characters in between
            ~a    *~a  ?~a                add clear result entry
            |                             start new mask
            \     \*  \?  \{  \~  \|  \\  deactivate an mask char

Function MatchString     (Mask, S, Flags=[]): Boolean;
Function MatchText       (Mask, S):           Boolean;
Function MatchStringEx   (Mask, S, Flags=[]): TStringDynArray;
Function MatchStringEx   (Mask, S, Flags, Offset, Out EndOffset): TStringDynArray;

Function MatchStringCount(Mask, S, Flags=[]): Integer;
Function MatchStringAll  (Mask, S, Flags=[]): TStringDynArray;

[edit 22.06.2009 16°°] das {$IF ersetzt, für ältere Delphi-Versionen
[edit 22.06.2009 19°°] Fehler beseitigt (siehe #30 bis #32)
[edit 22.06.2009 22°°] noch'n Fehler (siehe #33+#34)

[GPRSNerd]

Hi himitsu,

danke für den upgedateten Code.

Irgendwie kann ich den dritten Parameter-Set für die Flags nicht benutzen.
Delphi 2009 bietet mir in der Codevervollständigung immer nur die Varianten mit den zwei Parameters Mask und S an.
Wenn ich ein Set als dritten Parameter hinzufüge, gibt der Compiler die Fehlermeldung "Zu viele Parameter" aus.

Irgendne Ahnung, was ich hier falsch machen?

Gruß,
Stefan

[himitsu]

Bei welcher Funktion denn?

MatchText gibt es nur ohne diesen Parameter, aber da wird quasi intern eh nur an MatchString(Mask, S, [cfNotCaseSensitive]) weitergeleitet.

[GPRSNerd]

Jau, bin ich blöd/blind!

MatchText und MatchString.

[GPRSNerd]

Sorry, aber deine Funktionen liefern nur noch TRUE zurück.

Folgende Unittests schlagen alle fehl (liefern TRUE, anstatt FALSE):

Assert(MatchString('test*23', 'test012', [cfNotCaseSensitive])=false);
Assert(MatchString('test?23', 'test0123', [cfNotCaseSensitive])=false);
Assert(MatchString('test*23?56*9', 'test01234a6789', [cfNotCaseSensitive])=false);
Assert(MatchString('tEst*23', 'TEst0123', [])=false);
Assert(MatchText('te\*23', 'te023')=false);
... viele weitere
[/delphi]