Stringvergleich mit Wildcards

[sx2008]

Zitat von Willie1:

Die Joker *? dürfen in text natürlich nicht vorkommen - in Dateinamen sind seit den DOS-Zeiten diese Zeichen verboten!

Vielleicht möchte man damit auch URLs oder andere Dinge vergleichen und dann können auch die Jokerzeichen im Text vorkommen.
Wenn du den Stringvergleich nur auf Dateinamen und einmaliges Vorkommen von "*" beschränkst ist das auch OK, aber das schränkt die allgemeine Verwendbarkeit doch sehr ein.

[Willie1]

Obwohl ich es selbst z.Z. nicht brauche, noch ein Codebeispiel, wo auch in mask die Joker selbst vorkommen können. Dem Joker # voranstellen. Also: #? #* und ##. #0 darf in text NICHT vorkommen!

Delphi-Quellcode:

  function MatchesMask_(text, mask: string; Modus: byte; CaseSensitive: Boolean): boolean;
  const
    Joker = ['*','?','#'];
  var
    po,i: Integer;
    tmp: string;
    ch: Char;
  { Modus 0 = exakt - 1 = mit Joker - 2 = Suchwort kommt vor
    Joker =
    *  jeweils 1* NICHT *ambu*
    ?  gleiche Länge von Text und Maske z.B. M??er
    auch Kombinationen sind möglich z.B. ?amb* oder *b?rg
    Wenn in mask Joker-Zeichen selbst vorkommen sollen, # voranstellen z.B #? #* ##}
  begin
    case Modus of
      0,
      1: begin
           if Modus = 1 then begin
             po:=Pos('#',mask);
             while po > 0 do begin
               ch:=mask[Succ(po)];
               if ch in Joker then begin
                 System.Delete(mask,Succ(po),1);
                 case ch of
                   '*': ch:=#1;
                   '?': ch:=#2;
                   '#': ch:=#3
                 end;
                 mask[po]:=ch;
                 po:=Pos('#',mask)
               end
               else begin
                 Result:=false;  // einmal # in mask ergibt immer false!!!
                 Exit
               end;
             end;

             po:=Pos('?',mask);
             while po > 0 do begin
               mask[po]:=#0;
               po:=Pos('?',mask)
             end;

             i:=Pos('*',mask);

             po:=Pos(#1,mask);
             while po > 0 do begin
               mask[po]:='*';
               po:=Pos(#1,mask)
             end;
             po:=Pos(#2,mask);
             while po > 0 do begin
               mask[po]:='?';
               po:=Pos(#2,mask)
             end;
             po:=Pos(#3,mask);
             while po > 0 do begin
               mask[po]:='#';
               po:=Pos(#3,mask)
             end;

             if i > 0 then begin
               tmp:=text;
               System.Delete(text,i,MAXINT);
               System.Delete(tmp,1,Length(tmp) - Length(mask) + i);
               text:=text + '*' + tmp;
             end;
             if Length(mask) = Length(text) then
               for i:=1 to Length(text) do
                 if mask[i] = #0 then text[i]:=mask[i];
           end;
           if CaseSensitive then
             Result:=AnsiCompareStr(text,mask) = 0
           else
             Result:=AnsiCompareText(text,mask) = 0;
         end;
      2: begin
           if not CaseSensitive then begin
             text:=AnsiUpperCase(text);
             mask:=AnsiUpperCase(mask)
           end;
           Result:=Pos(mask,text) > 0
         end;
    end
  end; {MatchesMask_}

W.

[Codewalker]

Ich verweise nochmal auf http://www.delphipraxis.net/internal...341&highlight=. Hier darf ohne Probleme auch im Namen ein Joker vorkommen und es macht kein Hinderniss (habs eben mal schnell ausprobiert, Testprogramm hängt am Beitrag mit dran)

[himitsu]

@Willie1: daß man nur ein * verwenden darf, dieses jeweils auch nur am Anfang oder Ende der Maske und dann auch noch die Position des * in Modus übergeben muß, ist schon recht umständlich und schränkt die Wahl der Maske schon sehr stark ein.

> M*er
oder gar mehrere *

Zitat:

Die Joker *? dürfen in text natürlich nicht vorkommen - in Dateinamen sind seit den DOS-Zeiten diese Zeichen verboten!

in Linux kannst du sehr wohl auch diese Zeichen in Dateinamen verwenden
und auch FAT und Co. kann man beibringen diese Zeichen etwas zu mögen. (du glaubst nicht wie effektiv man den Zugriff auf eine Datei verhindern kann (also bei fast allen Windowsprogrammen), wenn man ihr nur solch ein Zeichen in den Dateinamen schmugglt )

Zitat:

aber wenn ich sehe, wie himitsu mit GOTO's hantiert

Wenn man weiß was man macht, ist das eigentlich kein Problem.
Und wenn es sein muß, kann ich auch mit 'ner anderen Schleife (z.B. while/repeat) in Programm effektiv lahmlegen.
Abgesehn davon, daß ich ein GOTO nur verwendet hab, um mir doppelten Code zu ersparren

Zitat:

Ich halte meine Lösung für effizient.

wann man viele/schnelle Vergleiche durchführen will, dann wohl nicht

zu der neuen Version mit #,
da du dich so schön auf Dateinamen beziehst, dann verwende doch auch statt dem # ein /
(dad darf auch nicht im Dateinamen vorkommen und fast alle verwenden dieses Zeichen zum Maskieren von irgendwelchen Zeichen)

[himitsu]

[add] aktuelle Version in Beitrag #22 [/add]

Hab meinen Code nochmal etwas überarbeitet.
Er wurde auch auf D2009 angepaßt und ein Fehler bezüglich * am Ende wurde behöben. (1)

Zusätzlich wurde eine Version auf Basis von PChar erstellt. (2)
Und von dieser PChar-Version gibt es noch Eine, welche mehrere Masken, durch | getrennt, übernimmt (3)
(ich muß mal sehn, wann ich die Zeit finde auch die MultiMatchText als String-Version umzustellen)

Der Stringversion sollt auch #0 in den Strings keine Probleme bereiten.

Alle Versionen kommen mit beliebigen Kombinationen an "?" und "*" klar
und die 3. Version kennt noch standardmäßig das "|", als Trennzeichen (siehe Parameter "Delemiter") von mehreren Masken.
Außerdem können über "\" die Zeichen "?", "*" und "\", sowie das "|" in MultiMatchText, in der Maske maskiert werden (also "\*" wird zu dem Zeichen "*" und nicht als Maskenzeichen ausgewertet).

1:

Delphi-Quellcode:

Function MatchText(Const Mask, S: WideString; CaseSensitive: Boolean = False): Boolean;
  Var Mp, Me, Mm, Sp, Se, Sm: PWideChar;
    Ml, Sl: WideString;

  Label LMask;

  Begin
    Result := False;
    If CaseSensitive Then Begin
      Mp := PWideChar(Mask);
      Sp := PWideChar(S);
    End Else Begin
      Ml := Mask;
      Sl := S;
      UniqueString(Ml);
      UniqueString(Sl);
      Mp := PWideChar(Ml);
      Sp := PWideChar(Sl);
      CharLowerBuffW(Mp, Length(Ml));
      CharLowerBuffW(Sp, Length(Sl));
    End;
    Me := Mp + Length(Mask);
    Se := Sp + Length(S);
    Mm := nil;
    Sm := Se;
    While (Mp < Me) 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 < Me) and (Sp >= Se) Then Exit;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mp^) > 1}
            //If ((Mp + 1)^ = '*') or ((Mp + 1)^ = '?') or ((Mp + 1)^ = '\') Then Inc(Mp);
            Case (Mp + 1)^ of  '*', '?', '\': Inc(Mp);  End;
          {$ELSE}
            If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
          {$IFEND}
          If Mp^ <> Sp^ Then GoTo LMask;
        End;
        Else If Mp^ <> Sp^ Then GoTo LMask;
      End;
      If (Mp >= Me) or (Sp >= Se) Then GoTo LMask;
      Inc(Mp);
      Inc(Sp);
    End;
    Result := True;
  End;

2:

Delphi-Quellcode:

Function MatchText(Mask, S: PWideChar; CaseSensitive: Boolean = False): Boolean;
  Var Mm, Sm: PWideChar;
    Ml, Sl: WideString;

  Label LMask;

  Begin
    Result := False;
    If not CaseSensitive Then Begin
      Ml   := Mask;
      Sl   := S;
      Mask := PWideChar(Ml);
      S    := PWideChar(Sl);
      CharLowerBuffW(Mask, Length(Ml));
      CharLowerBuffW(S,    Length(Sl));
    End;
    Mm := nil;
    Sm := S + lstrlenW(S);
    While (Mask^ <> #0) or (S^ <> #0) do Begin
      Case Mask^ of
        '*': Begin
          While Mask^ = '*' do Inc(Mask);
          Mm := Mask;
          Sm := S + 1;
          Continue;

          LMask:
          Mask := Mm;
          S    := Sm;
          Inc(Sm);
          If ((Mask = nil) or (Mask^ <> #0)) and (S^ = #0) Then Exit;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mask^) > 1}
            Case (Mask + 1)^ of  '*', '?', '\': Inc(Mask);  End;
          {$ELSE}
            If (Mask + 1)^ in ['*', '?', '\'] Then Inc(Mask);
          {$IFEND}
          If Mask^ <> S^ Then GoTo LMask;
        End;
        Else If Mask^ <> S^ Then GoTo LMask;
      End;
      If (Mask^ = #0) or (S^ = #0) Then GoTo LMask;
      Inc(Mask);
      Inc(S);
    End;
    Result := True;
  End;

3:

Delphi-Quellcode:

Function MultiMatchText(Mask, S: PWideChar; CaseSensitive: Boolean = False): Boolean;
  Var Mp, Mm, Me, Ms, Sp, Sm: PWideChar;
    Ml, Sl: WideString;

  Label LMulti, LMask;

  Begin
    Result := False;
    If CaseSensitive Then Begin
      Ml := Mask;
      Mp := PWideChar(Ml);
      Sp := S;
    End Else Begin
      Ml := Mask;
      Sl := S;
      Mp := PWideChar(Ml);
      Sp := PWideChar(Sl);
      CharLowerBuffW(Mp, Length(Ml));
      CharLowerBuffW(Sp, Length(Sl));
    End;
    Me := Mp + lstrlenW(Mp);
    Ms := Mp;
    Mm := Mp;
    While Mm^ <> #0 do Begin
      Case Mm^ of
        '\': {$IF SizeOf(Mp^) > 1}
               Case (Mp + 1)^ of  '*', '?', '\': Inc(Mp);  End;
             {$ELSE}
               If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
             {$IFEND}
        '|': Mm^ := #0;
      End;
      Inc(Mm);
    End;

    LMulti:
    Mm := nil;
    Sm := Sp + lstrlenW(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
            While Ms < Me do Begin
              Inc(Ms);
              If (Ms - 1)^ = #0 Then Begin
                Mp := Ms;
                If CaseSensitive Then Sp := S Else Sp := PWideChar(Sl);
                Goto LMulti;
              End;
            End;
            Exit;
          End;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mp^) > 1}
            Case (Mp + 1)^ of  '*', '?', '\': Inc(Mp);  End;
          {$ELSE}
            If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
          {$IFEND}
          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;

Und falls wer 'ne angepaßte Ansi-/Wide-/Unicode-Version braucht,
der hat hier mochmals alle Versionen von oben, nur daß hier die zu ändernden Typen als Kommentare drinstehn ... also einfach alle Kommentare so bearbeiten, daß nur noch der nötige Typ an deren Stelle zurück bleibt.

Delphi-Quellcode:

// 1:

Function MatchText(Const Mask, S: {String|AnsiString|WideString|UnicodeString}; CaseSensitive: Boolean = False): Boolean;
  Var Mp, Me, Mm, Sp, Se, Sm: {PChar|PAnsiChar|PWideChar};
    Ml, Sl: {String|AnsiString|WideString|UnicodeString};

  Label LMask;

  Begin
    Result := False;
    If CaseSensitive Then Begin
      Mp := {PChar|PAnsiChar|PWideChar}(Mask);
      Sp := {PChar|PAnsiChar|PWideChar}(S);
    End Else Begin
      Ml := Mask;
      Sl := S;
      UniqueString(Ml);
      UniqueString(Sl);
      Mp := {PChar|PAnsiChar|PWideChar}(Ml);
      Sp := {PChar|PAnsiChar|PWideChar}(Sl);
      {CharLowerBuff|CharLowerBuffA|CharLowerBuffW}(Mp, Length(Ml));
      {CharLowerBuff|CharLowerBuffA|CharLowerBuffW}(Sp, Length(Sl));
    End;
    Me := Mp + Length(Mask);
    Se := Sp + Length(S);
    Mm := nil;
    Sm := Se;
    While (Mp < Me) 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 < Me) and (Sp >= Se) Then Exit;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mp^) > 1}
            //If ((Mp + 1)^ = '*') or ((Mp + 1)^ = '?') or ((Mp + 1)^ = '\') Then Inc(Mp);
            Case (Mp + 1)^ of  '*', '?', '\': Inc(Mp);  End;
          {$ELSE}
            If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
          {$IFEND}
          If Mp^ <> Sp^ Then GoTo LMask;
        End;
        Else If Mp^ <> Sp^ Then GoTo LMask;
      End;
      If (Mp >= Me) or (Sp >= Se) Then GoTo LMask;
      Inc(Mp);
      Inc(Sp);
    End;
    Result := True;
  End;

// 2:

Function MatchText(Mask, S: {PChar|PAnsiChar|PWideChar}; CaseSensitive: Boolean = False): Boolean;
  Var Mm, Sm: {PChar|PAnsiChar|PWideChar};
    Ml, Sl: {String|AnsiString|WideString|UnicodeString};

  Label LMask;

  Begin
    Result := False;
    If not CaseSensitive Then Begin
      Ml   := Mask;
      Sl   := S;
      Mask := {PChar|PAnsiChar|PWideChar}(Ml);
      S    := {PChar|PAnsiChar|PWideChar}(Sl);
      {CharLowerBuff|CharLowerBuffA|CharLowerBuffW}(Mask, Length(Ml));
      {CharLowerBuff|CharLowerBuffA|CharLowerBuffW}(S,    Length(Sl));
    End;
    Mm := nil;
    Sm := S + {lstrlen|lstrlenA|lstrlenW}(S);
    While (Mask^ <> #0) or (S^ <> #0) do Begin
      Case Mask^ of
        '*': Begin
          While Mask^ = '*' do Inc(Mask);
          Mm := Mask;
          Sm := S + 1;
          Continue;

          LMask:
          Mask := Mm;
          S    := Sm;
          Inc(Sm);
          If ((Mask = nil) or (Mask^ <> #0)) and (S^ = #0) Then Exit;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mask^) > 1}
            Case (Mask + 1)^ of  '*', '?', '\': Inc(Mask);  End;
          {$ELSE}
            If (Mask + 1)^ in ['*', '?', '\'] Then Inc(Mask);
          {$IFEND}
          If Mask^ <> S^ Then GoTo LMask;
        End;
        Else If Mask^ <> S^ Then GoTo LMask;
      End;
      If (Mask^ = #0) or (S^ = #0) Then GoTo LMask;
      Inc(Mask);
      Inc(S);
    End;
    Result := True;
  End;

// 3:

Function MultiMatchText(Mask, S: {PChar|PAnsiChar|PWideChar}; CaseSensitive: Boolean = False): Boolean;
  Var Mp, Mm, Me, Ms, Sp, Sm: {PChar|PAnsiChar|PWideChar};
    Ml, Sl: {String|AnsiString|WideString|UnicodeString};

  Label LMulti, LMask;

  Begin
    Result := False;
    If CaseSensitive Then Begin
      Ml := Mask;
      Mp := {PChar|PAnsiChar|PWideChar}(Ml);
      Sp := S;
    End Else Begin
      Ml := Mask;
      Sl := S;
      Mp := {PChar|PAnsiChar|PWideChar}(Ml);
      Sp := {PChar|PAnsiChar|PWideChar}(Sl);
      {CharLowerBuff|CharLowerBuffA|CharLowerBuffW}(Mp, Length(Ml));
      {CharLowerBuff|CharLowerBuffA|CharLowerBuffW}(Sp, Length(Sl));
    End;
    Me := Mp + {lstrlen|lstrlenA|lstrlenW}(Mp);
    Ms := Mp;
    Mm := Mp;
    While Mm^ <> #0 do Begin
      Case Mm^ of
        '\': {$IF SizeOf(Mp^) > 1}
               Case (Mp + 1)^ of  '*', '?', '\': Inc(Mp);  End;
             {$ELSE}
               If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
             {$IFEND}
        '|': Mm^ := #0;
      End;
      Inc(Mm);
    End;

    LMulti:
    Mm := nil;
    Sm := Sp + {lstrlen|lstrlenA|lstrlenW}(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
            While Ms < Me do Begin
              Inc(Ms);
              If (Ms - 1)^ = #0 Then Begin
                Mp := Ms;
                If CaseSensitive Then Sp := S Else Sp := {PChar|PAnsiChar|PWideChar}(Sl);
                Goto LMulti;
              End;
            End;
            Exit;
          End;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mp^) > 1}
            Case (Mp + 1)^ of  '*', '?', '\': Inc(Mp);  End;
          {$ELSE}
            If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
          {$IFEND}
          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;

[GPRSNerd]

@himitsu: Du hast in den neuen Version die Escape-Möglichkeiten für ? und * nicht implementiert, oder?
Matchtext('te\*23', 'te*23', false) ergibt FALSE.

Edit:
Matchtext('te?23', 'te123', false) ergibt auch FALSE.

[himitsu]

nee, ist hier nicht drin
[add]
(jetzt weiß ich wieder wofür die goElse-Sprungmarke war, welche nun sinnlos im code rumlag )
ich kann's ja wieder einbauen
[/add]


zum [edit] ups muß ich mal sehn

hab mir zwar 'ne Testreihe aufgebaut und das MatchText('a?def','abcdef') lieferte eigentlich ein richtiges Ergebnis
(allerdings muß ich zugeben, daß ich nur die UnicodeVersion getestet hab ... vielleicht hab ich ja nur bei der Umstellung 'nen Fehler gemacht )

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 MultiMatchText('a*d|a*',  'abcdef') Then Beep;

[GPRSNerd]

Vergiss den Edit, mein Fehler! Ich habe test123 auf te?23 geprüft. Copy&Paste-Error!

[himitsu]

Zitat von GPRSNerd:

Vergiss den Edit, mein Fehler! Ich habe test123 auf te?23 geprüft. Copy&Paste-Error!

OK

PS:
du kannst übrigens auch 'test?23' auf 'test'#0'23' anwenden oder 'te'#0't?23' auf 'te'#0't123' (mit der StringVersion natürlich)

[add]
ich hab im Post #15 mal die Versionen gegen je eine mit "\" (Escape-Möglichkeit) ersetzt

[edit]
hab noch 'nen Fehler in MultiMatchText ersetzt
bei "\\|" wurde im Vorfeld das "|" fälschlicher Weise als maskiert "\|" erkannt.

jetzt wo's Maskieren wieder drin ist, werd' ich nun wohl Beides (MatchText und MultiMatchText) in einem vereinigen

[himitsu]

Blos mal 'ne kleine und nicht ganz durchgeteste Vorschau auf alle vier Versionen (also nun auch eine MultiMatchText als String-Version).
Also aktuell ist noch alles in Post #15 vorzuziehen.
Wenn ich es jetzt noch schaff die Bearbeitung des "|", von vor der Hauptschleife, in die Hauptschleife reinzubekommen, dann wird es nur noch je eine String- und PChar-Vesion geben (MultiMatchText und MatchText in einem), ansonsten laß ich es performancemäßig getrennt, aber ich bin (noch) guter Dinge

Delphi-Quellcode:

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

  Label LMask;

  Begin
    Result := False;
    If CaseSensitive Then Begin
      Mp := PWideChar(Mask);
      Sp := PWideChar(S);
    End Else Begin
      Mt := Mask;
      St := S;
      UniqueString(Mt);
      UniqueString(St);
      Mp := PWideChar(Mt);
      Sp := PWideChar(St);
      CharLowerBuffW(Mp, Length(Mt));
      CharLowerBuffW(Sp, Length(St));
    End;
    Me := Mp + Length(Mask);
    Se := Sp + Length(S);
    Mm := nil;
    Sm := Se;
    While (Mp < Me) 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 < Me) and (Sp >= Se) Then Exit;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mp^) > 1}
            //If ((Mp + 1)^ = '*') or ((Mp + 1)^ = '?') or ((Mp + 1)^ = '\') Then Inc(Mp);
            Case (Mp + 1)^ of  '*', '?', '\': Inc(Mp);  End;
          {$ELSE}
            If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
          {$IFEND}
          If Mp^ <> Sp^ Then GoTo LMask;
        End;
        Else If Mp^ <> Sp^ Then GoTo LMask;
      End;
      If (Mp >= Me) or (Sp >= Se) Then GoTo LMask;
      Inc(Mp);
      Inc(Sp);
    End;
    Result := True;
  End;

Function {Multi}MatchText(Const Mask, S: WideString; CaseSensitive: Boolean = False): Boolean;
  Var Mp, Me2, Me, Mm, Sp, Se, Sm: PWideChar;
    Mt, St: WideString;

  Label LMulti, LMask;

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

    LMulti:
    While Me2 < Me do Begin
      Case Me2^ of
        '\': {$IF SizeOf(Mp^) > 1}
               Case (Mp + 1)^ of  '*', '?', '\': Inc(Mp);  End;
             {$ELSE}
               If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
             {$IFEND}
        '|': Begin
               If (Mt = '') and (Mask <> '') Then Begin
                 Mt := Mask;
                 UniqueString(Mt);
                 Mp := Mp - PWideChar(Mask) + PWideChar(Mt);
                 Me := PWideChar(Mt) + Length(Mask);
               End;
               Me2^ := #0;
               Break;
             End;
      End;
      Inc(Me2);
    End;

    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);
              Goto LMulti;
            End Else Exit;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mp^) > 1}
            //If ((Mp + 1)^ = '*') or ((Mp + 1)^ = '?') or ((Mp + 1)^ = '\') Then Inc(Mp);
            Case (Mp + 1)^ of  '*', '?', '\': Inc(Mp);  End;
          {$ELSE}
            If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
          {$IFEND}
          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;

Function MatchText(Mask, S: PWideChar; CaseSensitive: Boolean = False): Boolean;
  Var Mm, Sm: PWideChar;
    Mt, St: WideString;

  Label LMask;

  Begin
    Result := False;
    If not CaseSensitive Then Begin
      Mt   := Mask;
      St   := S;
      Mask := PWideChar(Mt);
      S    := PWideChar(St);
      CharLowerBuffW(Mask, Length(Mt));
      CharLowerBuffW(S,    Length(St));
    End;
    Mm := nil;
    Sm := S + lstrlenW(S);
    While (Mask^ <> #0) or (S^ <> #0) do Begin
      Case Mask^ of
        '*': Begin
          While Mask^ = '*' do Inc(Mask);
          Mm := Mask;
          Sm := S + 1;
          Continue;

          LMask:
          Mask := Mm;
          S    := Sm;
          Inc(Sm);
          If ((Mask = nil) or (Mask^ <> #0)) and (S^ = #0) Then Exit;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mask^) > 1}
            Case (Mask + 1)^ of  '*', '?', '\': Inc(Mask);  End;
          {$ELSE}
            If (Mask + 1)^ in ['*', '?', '\'] Then Inc(Mask);
          {$IFEND}
          If Mask^ <> S^ Then GoTo LMask;
        End;
        Else If Mask^ <> S^ Then GoTo LMask;
      End;
      If (Mask^ = #0) or (S^ = #0) Then GoTo LMask;
      Inc(Mask);
      Inc(S);
    End;
    Result := True;
  End;

Function MultiMatchText(Mask, S: PWideChar; CaseSensitive: Boolean = False): Boolean;
  Var Mp, Mm, Me, Ms, Sp, Sm: PWideChar;
    Mt, St: WideString;

  Label LMulti, LMask;

  Begin
    Result := False;
    If CaseSensitive Then Begin
      Mt := Mask;
      Mp := PWideChar(Mt);
      Sp := S;
    End Else Begin
      Mt := Mask;
      St := S;
      Mp := PWideChar(Mt);
      Sp := PWideChar(St);
      CharLowerBuffW(Mp, Length(Mt));
      CharLowerBuffW(Sp, Length(St));
    End;
    Me := Mp + lstrlenW(Mp);
    Ms := Mp;
    Mm := Mp;
    While Mm^ <> #0 do Begin
      Case Mm^ of
        '\': {$IF SizeOf(Mp^) > 1}
               Case (Mp + 1)^ of  '*', '?', '\': Inc(Mp);  End;
             {$ELSE}
               If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
             {$IFEND}
        '|': Mm^ := #0;
      End;
      Inc(Mm);
    End;

    LMulti:
    Mm := nil;
    Sm := Sp + lstrlenW(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
            While Ms < Me do Begin
              Inc(Ms);
              If (Ms - 1)^ = #0 Then Begin
                Mp := Ms;
                If CaseSensitive Then Sp := S Else Sp := PWideChar(St);
                Goto LMulti;
              End;
            End;
            Exit;
          End;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mp^) > 1}
            Case (Mp + 1)^ of  '*', '?', '\': Inc(Mp);  End;
          {$ELSE}
            If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
          {$IFEND}
          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;