Stringvergleich mit Wildcards

[Willie1]

Hallo,
ich habe mir vor einiger Zeit einen Stringvergleich mit Wildcards gebaut:

Delphi-Quellcode:

function MatchesMask(text, mask: string; Modus: byte; CaseSensitive: Boolean): boolean;
var
  po,i: Integer;
{ Modus 0 = exakt - 1 = mit Joker - 2 = kommt vor
  Joker =
  *  jeweils 1* entweder am Anfang oder Ende z.B. Hamb* oder *burg
  ?  gleiche Länge von Text und Maske z.B. M??er
  auch Kombinationen sind möglich z.B. ?amb* oder *b?rg}
begin
  case Modus of
    0,
    1: begin
       if Modus = 1 then begin
         po:=Pos('*',mask);
         if po = 1 then begin   // * am Anfang
           if Length(Mask) = 1 then begin   //nur *  = alles!
             Result:=true;
             Exit;
           end;
           System.Delete(text,1,Length(text)-Pred(Length(Mask)));
           text:='*'+text
         end
         else
         if po > 1 then begin   // * am Ende
           System.Delete(text,po,MAXINT);
           text:=text+'*'
         end;
         if Length(mask) = Length(text) then
           for i:=1 to Length(text) do
             if mask[i] = '?' 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}

Anders als der Tipp von Shmia kommt er ohne GOTO aus und bietet noch mehr Möglichkeiten.

MfG

[SubData]

Vor langer Zeit habe ich mal folgende Funktion gefunden:
Wer sie geschrieben hat weiß ich aber nicht.

Delphi-Quellcode:

function Like(const sStr, sSub: String): Boolean;
var
  sPtr  : PChar;
  pPtr  : PChar;
  sRes  : PChar;
  pRes  : PChar;
begin
  Result := False;
  sPtr := PChar(sStr);
  pPtr := PChar(sSub);
  sRes := nil;
  pRes := nil;
  repeat
    repeat // ohne vorangegangenes "*"
      case pPtr^ of
        #0:   begin
                Result := (sPtr^ = #0);
                if ((Result) or (sRes = nil) or (pRes = nil)) then Exit;
                sPtr := sRes;
                pPtr := pRes;
                Break;
              end;
        '*':  begin
                Inc(pPtr);
                pRes := pPtr;
                Break;
              end;
        '?':  begin
                if (sPtr^ = #0) then Exit;
                Inc(sPtr);
                Inc(pPtr);
              end;
      else
              begin
                if (sPtr^ = #0) then Exit;
                if (sPtr^ <> pPtr^) then
                begin
                  if ((sRes = nil) or (pRes = nil)) then Exit;
                  sPtr := sRes;
                  pPtr := pRes;
                  Break;
                end else
                begin
                  Inc(sPtr);
                  Inc(pPtr);
                end;
              end;
      end;
    until False;
    repeat // mit vorangegangenem "*"
      case pPtr^ of
        #0:   begin
                Result := True;
                Exit;
              end;
        '*':  begin
                Inc(pPtr);
                pRes := pPtr;
              end;
        '?':  begin
                if (sPtr^ = #0) then Exit;
                Inc(sPtr);
                Inc(pPtr);
              end;
      else
              begin
                repeat
                  if (sPtr^ = #0) then Exit;
                  if (sPtr^ = pPtr^) then Break;
                  Inc(sPtr);
                until False;
                Inc(sPtr);
                sRes := sPtr;
                inc(pPtr);
                Break;
              end;
      end;
    until False;
  until False;
end;

[himitsu]

für die CodeLibMods: Stringvergleich mit Wildcards (* und ?)


@Willie:
deiner Beschreibung nach, hab ich also mit Ha*rg arge Probleme?

Was sind die "noch mehr Möglichkeiten"?

Ja und bei den Modi versteh ich die Beschreibung nicht ganz ... was macht demnach die 2?
*nicht in den QuellCode guck*



Und bezüglich des GOTOs ... IfThen, Repeat und While sind sind auch nur GOTOs (von Seite des Prozessors / in ASM).
Man muß hierbei halt nur besser aufpassen, da der Programmablauf recht unübersichtlich und fehleranfällig sein kann.


[edit 20.06.2009]
* neues/zweites CompareWildEx eingefügt
* und fitt für D2009 gemacht
* ganz aktuelle Version, siehe Post #25
[/edit]


gern nochma von mir

Delphi-Quellcode:

Type TCompareFlags = Set of (cfNotCaseSensitive, cfCanMask);

Function CompareWildString    (Wild, Name: String; Flags: TCompareFlags = []): Boolean;
Function CompareWildText(Const Wild, Name: String; Flags: TCompareFlags = []): Boolean;
Function CompareWildStringEx  (Wild, Name: String; Flags: TCompareFlags = []): TStringDynArray; Overload;
Function CompareWildStringEx  (Wild, Name: String; Flags: TCompareFlags; Offset: Integer; Out EndOffset: Integer): TStringDynArray; Overload;

Function CompareWildString(Wild, Name: String; Flags: TCompareFlags = []): Boolean;
  Var W, N, We, Ne, WildW, WildN: PChar;

  Label goWild, goElse;

  Begin
    If cfNotCaseSensitive in Flags Then Begin
      Wild := LowerCase(Wild);
      Name := LowerCase(Name);
    End;
    Result := False;
    W := PChar(Wild);  We := W + Length(Wild);  WildW := nil;
    N := PChar(Name);  Ne := N + Length(Name);  WildN := nil;
    While (W < We) or (N < Ne) do Begin
      Case W^ of
        '*': Begin
          While W^ = '*' do Inc(W);
          WildW := W;
          WildN := N + 1;
          Continue;

          goWild:
          W := WildW;
          N := WildN;
          Inc(WildN);
          If (W = nil) or (N > Ne) Then Exit;
          Continue;
        End;
        '?': If N >= Ne Then GoTo goWild;
        '\': Begin
          If (cfCanMask in Flags) and ((W + 1)^ in ['*', '?', '\']) Then Inc(W);
          GoTo goElse;
        End;
        Else
          goElse:
          If N^ <> W^ Then GoTo goWild;
      End;
      If (W >= We) or (N >= Ne) Then GoTo goWild;
      Inc(W);
      Inc(N);
    End;
    Result := True;
  End;

Function CompareWildText(Const Wild, Name: String; Flags: TCompareFlags = []): Boolean;
  Begin  Result := CompareWildString(Wild, Name, Flags + [cfNotCaseSensitive]);  End;

Function CompareWildStringEx(Wild, Name: String; Flags: TCompareFlags = []): TStringDynArray;
  Var W, N, We, Ne, WildW, WildN: PChar;
    WildLA, WildLS, i: Integer;
    isWild: Boolean;

  Label goWild, goElse;

  Begin
    If cfNotCaseSensitive in Flags Then Begin
      Wild := LowerCase(Wild);
      Name := LowerCase(Name);
    End;
    Result := nil;
    WildLA := 0;  WildLS := 0;
    isWild := False;
    W := PChar(Wild);  We := W + Length(Wild);  WildW := nil;
    N := PChar(Name);  Ne := N + Length(Name);  WildN := nil;
    While (W < We) or (N < Ne) do Begin
      Case W^ of
        '*': Begin
          While W^ = '*' do Inc(W);
          WildW := W;
          WildN := N + 1;
          If not isWild Then SetLength(Result, Length(Result) + 1);
          i := Length(Result);
          WildLA := i;
          WildLS := Length(Result[i - 1]);
          isWild := True;
          Continue;

          goWild:
          W := WildW;
          N := WildN;
          Inc(WildN);
          If (W = nil) or (N > Ne) Then Begin
            Result := nil;
            Exit;
          End;
          SetLength(Result, WildLA);
          Result[WildLA - 1] := Copy(Result[WildLA - 1], 1, WildLS) + (N - 1)^;
          Inc(WildLS);
          isWild := True;
          Continue;
        End;
        '?': Begin
          If N >= Ne Then GoTo goWild;
          If not isWild Then SetLength(Result, Length(Result) + 1);
          i := High(Result);
          Result[i] := Result[i] + N^;
          isWild := True;
        End;
        '\': Begin
          If (cfCanMask in Flags) and ((W + 1)^ in ['*', '?', '\']) Then Inc(W);
          GoTo goElse;
        End;
        Else
          goElse:
          If N^ <> W^ Then GoTo goWild;
          isWild := False;
      End;
      If (W >= We) or (N >= Ne) Then GoTo goWild;
      Inc(W);
      Inc(N);
    End;
    If Result = nil Then SetLength(Result, 1);
  End;

Function CompareWildStringEx(Wild, Name: String; Flags: TCompareFlags; Offset: Integer; Out EndOffset: Integer): TStringDynArray;
  Var W, N, We, Ne, WildW, WildN: PChar;
    WildLA, WildLS, i: Integer;
    isWild: Boolean;

  Label goWild, goElse;

  Begin
    If cfNotCaseSensitive in Flags Then Begin
      Wild := LowerCase(Wild);
      Name := LowerCase(Name);
    End;
    Result    := nil;
    EndOffset := Offset;
    Dec(Offset);
    If Offset >= Length(Name) Then Exit
    Else If Offset < 0 Then Offset := 0;
    WildLA := 0;  WildLS := 0;
    W := PChar(Wild);           We := W + Length(Wild);           WildW := nil;
    N := PChar(Name) + Offset;  Ne := N + Length(Name) - Offset;  WildN := nil;
    isWild := False;
    While (W < We) or (N < Ne) do Begin
      Case W^ of
        '*': Begin
          While W^ = '*' do Inc(W);
          WildW := W;
          WildN := N + 1;
          If not isWild Then Begin
            EndOffset := N - PChar(Name) + 1;
            SetLength(Result, Length(Result) + 1);
          End;
          i := Length(Result);
          WildLA := i;
          WildLS := Length(Result[i - 1]);
          isWild := True;
          Continue;

          goWild:
          W := WildW;
          N := WildN;
          Inc(WildN);
          If (W = nil) or (N > Ne) Then Begin
            Result := nil;
            Exit;
          End;
          SetLength(Result, WildLA);
          Result[WildLA - 1] := Copy(Result[WildLA - 1], 1, WildLS) + (N - 1)^;
          Inc(WildLS);
          isWild := True;
          Continue;
        End;
        '?': Begin
          If N >= Ne Then GoTo goWild;
          EndOffset := N - PChar(Name) + 1;
          If not isWild Then SetLength(Result, Length(Result) + 1);
          i := High(Result);
          Result[i] := Result[i] + N^;
          isWild := True;
        End;
        '\': Begin
          If (cfCanMask in Flags) and ((W + 1)^ in ['*', '?', '\']) Then Inc(W);
          GoTo goElse;
        End;
        Else
          goElse:
          If N^ <> W^ Then GoTo goWild;
          isWild := False;
      End;
      If (W >= We) or (N >= Ne) Then GoTo goWild;
      Inc(W);
      Inc(N);
    End;
    If Result = nil Then SetLength(Result, 1);
  End;

cfNotCaseSensitive sollte klar sein (klingt zwar ein bissl blöd, aber da CaseSensitive Standard ist...)

bei cfCanMask kann mit einem vorrangestellem "\" das "*" oder "?" maskiert werden und in diesem Fall natürlich auch das "\" (sich selbst).

Code:

Maske       String

test*123  = test0123
test\*123 = test*123

CompareWildStringEx liefert nicht TRUE bei erfolgreichem Vergleich, sondern die in den WildCards enthaltenen Zeichen/Strings.

Delphi-Quellcode:

Program Project1;

{$APPTYPE CONSOLE}

Uses Types, SysUtils, WildCards;

Var A: TStringDynArray;
  i: Integer;

Begin
  WriteLn('Maske  = String     Ergebnis');

  WriteLn;
  WriteLn('te*23  = test0123   ', CompareWildString('te*23',  'test0123'));
  WriteLn('te\*23 = test0123   ', CompareWildString('te\*23', 'test0123', [cfCanMask]));
  WriteLn('te\*23 = te*23      ', CompareWildString('te\*23', 'te*23',    [cfCanMask]));

  WriteLn;
  WriteLn('te*23  = test0123');
  A := CompareWildStringEx('te*23', 'test0123');
  For i := 0 to High(A) do WriteLn('   [', i, '] = ', A[i]);

  WriteLn;
  WriteLn('te*23?56*9  = test0123456789');
  A := CompareWildStringEx('te*23?56*9', 'test0123456789');
  For i := 0 to High(A) do WriteLn('   [', i, '] = ', A[i]);

  WriteLn;
  WriteLn('te*23  = test012');
  A := CompareWildStringEx('te*23', 'test012');
  WriteLn('   nil    = ', A = nil);
  WriteLn('   Length = ', Length(A));

  WriteLn;
  WriteLn;
  WriteLn('Beenden mit [Enter]');
  ReadLn;
End.

Code:

Maske  = String     Ergebnis

te*23  = test0123   TRUE
te\*23 = test0123   FALSE
te\*23 = te*23      TRUE

te*23  = test0123
   [0] = st01

te*23?56*9  = test0123456789
   [0] = st01
   [1] = 4
   [2] = 78

te*23  = test012
   nil    = TRUE
   Length = 0

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

[Codewalker]

Haben wir schon in der CodeLib. Am besten zusammenführen in ein Thema ;-)
http://www.delphipraxis.net/internal...341&highlight=

[himitsu]

Gibt "leider" schon 'ne Weile zu einigen Themen mehrere Einträge in der CodeLib,

Aber was ich an deiner (Codewalker) Version etwas unschön empfinde, ist etwas die Rekursion (gut, dafür halt kein "böses" GOTO) und vorallem das COPY (die langsamen Stringoperationen).

[ringli]

Ich verwende im Moment folgende Lösung:

Delphi-Quellcode:

uses
  ShlwAPI;

function StrMatchesMask(pszFile, pszSpec : WideString) : Boolean;
begin
  Result := PathMatchSpecW(PWideChar(pszFile), PWideChar(pszSpec));
end;

[himitsu]

Delphi-Quellcode:

uses
  ShlwAPI;

function StrMatchesMask(Mask, S : String) : Boolean;
begin
  Result := PathMatchSpec(PChar(S), PChar(Mask));
end;

hmmm, nette Funktion,
aber erwähnen sollte man noch, daß diese nicht CaseSensitive arbeitet.


für .Net sieht das vermutlich nett aus http://msdn.microsoft.com/en-us/library/e7sf90t3.aspx

[add]
http://msdn.microsoft.com/en-us/libr...rdpattern.aspx
hmmmmmmmmmmm?

[Willie1]

Hallo Leute,

wie ist es damit:

Delphi-Quellcode:

function MatchesMask_(text, mask: string; Modus: byte; CaseSensitive: Boolean): boolean;
  var
    po,i: Integer;
    tmp: string;
  { 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}
  begin
    case Modus of
      0,
      1: begin
         if Modus = 1 then begin
           po:=Pos('*',mask);
           if po > 0 then begin
             tmp:=text;
             System.Delete(text,po,MAXINT);
             System.Delete(tmp,1,Length(tmp) - Length(mask) + po);
             text:=text + '*' + tmp
           end;
           if Length(mask) = Length(text) then
             for i:=1 to Length(text) do
               if mask[i] = '?' 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_}

Ich denke, dass sich bis auf ganz wenige Ausnahmen GOTO vermeiden lässt und mit Zeigern nur operieren sollte, wenn es wirklich nötig ist.

[sx2008]

@Willie1:
ich sehe bei deinem Code das Problem, dass du die Variable "Text" missbrauchst um interne Zustände zu speichern.
Ich meine damit z.B. folgende Zeile:

Delphi-Quellcode:

if mask[i] = '?' then text[i]:=mask[i];

Was aber, wenn in "Text" von vorneherein schon die Zeichen ? und * enthalten sind?
Dann kann es zu Treffern kommen obwohl der Text nicht auf Mask passt.

[Willie1]

Hallo sx2800,
ich verstehe deinen Einwand nicht ganz. Die Joker *? dürfen in text natürlich nicht vorkommen - in Dateinamen sind seit den DOS-Zeiten diese Zeichen verboten! Das ich text verändere, ist sicher ein Schönheitsfehler, aber wenn ich sehe, wie himitsu mit GOTO's hantiert, denke ich, ist das hin zu nehmen.
Ich halte meine Lösung für effizient.

W.

[sx2008]

Zitat:

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 :stupid: )

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 :stupid:

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. :stupid:

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?

Delphi-Quellcode:

Matchtext('te\*23', 'te*23', false)

ergibt FALSE.

Edit:

Delphi-Quellcode:

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 :nerd: )
ich kann's ja wieder einbauen :angel:
[/add]


zum [edit] ups :shock: muß ich mal sehn

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

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:

Zitat von GPRSNerd

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

OK :stupid:

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 :angel:

[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 :angel:

[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 :stupid:

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;

[GPRSNerd]

Hi himitsu,

die Escaped-Sourcen in Post#15 laufen schon ganz gut.
Der Escape von | funktioniert noch nicht so ganz:

Delphi-Quellcode:

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. :firejump:

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. :stupid:
Aber von der Art her müßte ich sie wohl besser in ein Objekt packen und ob sich dagegen der kleine Geschwindigkeitsvorteil noch lohnt? :gruebel:

[GPRSNerd]

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

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 :shock:

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 :stupid:
* 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 :mrgreen:
(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]

[himitsu]

menno ... ich schau mal

eigentlich dachte ich, diesbezüglich hätt ich nichts verändert :oops:

hatte grad nur noch einen Parameter nachgetragen, damit bei den "wiederholenden" Aufrufen die äußeren und eventuell recht großen Strings nicht mit im Result landen (führendes und letztes * in der Abfrage).
(siehe nächster Beitrag)

ich glaub ich bau so'nen Assert mal mit in die Unit direkt ein ... so auch für die Zukunft :nerd:

[himitsu]

das ist eigentlich zu peinlich zum Erwähnen: :oops:
meine Tests hatte ich, da es einfacher zum Debuggen war, meißt direkt mir der Hauptgrundfunktion gemacht und da traten einige Fehler nicht auf ...
z.B. wie der 1-Startindex bei String, welcher nicht als 0-Index für PChar angegeben wurde
und ein Copy&Paste-Fehler, wo Result gleich mit True initialisiert wurde, anstatt mit False :wall:

nja, hatte jetzt dabei auch gleich noch eine Idee bekommen, wie der Vergleich vorzeitig abbrechen kann, wenn das letzte Maskenzeichen ein * ist ... bislang wurde dennoch der restliche Stringinhalt geprüft.

und wie schon erwähnt, funktioniert nun auch sowas: suchen folgender Masken in einem String:
wenn Maskenanfang und -ende * lauten, dann wird das dazwischen gesucht und zusammen mit dem neuen cfIgnoreOuterAsterix kann man so auch "recht" speichersparend den einen String nach allen Vorkommen der "Teil"Maske (ohne erstes und letztes * ) durchforsten :-D

Delphi-Quellcode:

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

Begin
  S := 'i|F1|V1|F2|i'
    + 'i|F1|V2|F2|i'
    + 'i|F1|V3|F2|i';

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

    ShowMessage('1:'#13#10'Sr[' + IntToStr(i2) + '] = "' + Sr + '"');
  End;



  i  := 1;
  i2 := -1;
  While True do Begin
    X := MatchStringEx('*F1*F2*', S, [cfIgnoreOuterAsterix], i, i);
    If X = nil Then Break;
    Sr := X[0];
    Inc(i2);

    ShowMessage('2:'#13#10'Sr[' + IntToStr(i2) + '] = "' + Sr + '"');
  End;



  i := MatchStringCount('*F1*F2*', S, []);

  ShowMessage('3:'#13#10'C = ' + IntToStr(i));



  X := MatchStringAll('*F1*F2*~a~a~a', S, []);
  If X <> nil Then Begin
    Sr := '';
    For i := 0 to Length(X) div 3 - 1 do
      Sr := Sr + 'Sr[' + IntToStr(i) + '] = "' + X[i * 3 + 1] + '"'#13#10
  End Else Sr := 'nichts gefunden';

  ShowMessage('4:'#13#10 + Sr);



  X := MatchStringAll('*V{13}*', S, []);
  If X <> nil Then Begin
    Sr := '';
    For i := 0 to Length(X) div 3 - 1 do
      Sr := Sr + 'Sr[' + IntToStr(i) + '] = "' + X[i * 3 + 1] + '"'#13#10
  End Else Sr := 'nichts gefunden';

  ShowMessage('5:'#13#10 + Sr);


  X := MatchStringAll('*V{13}*', S, [cfIgnoreOuterAsterix]);
  If X <> nil Then Begin
    Sr := '';
    For i := 0 to High(X) do
      Sr := Sr + 'Sr[' + IntToStr(i) + '] = "' + X[i] + '"'#13#10
  End Else Sr := 'nichts gefunden';

  ShowMessage('6:'#13#10 + Sr);

theoretisch müßte auch sowas möglich sein (hab's jetzt nicht geteste)

Delphi-Quellcode:

X := MatchStringAll('*<img *src="*"*', S, [cfNotCaseSensitive, cfIgnoreOuterAsterix]);

da müßten nun abwechseln (evt. vorhandene) weitere Parameter und die URL in X drinstehn ... denk ich mal :gruebel:

Download siehe #26

[GPRSNerd]

Hi,

besser, aber immer noch nicht auf dem guten Stand vor deinen Änderungen!

Folgende Tests schlagen immer noch fehl, größtenteils im zusammenhang mit Escaping:

Delphi-Quellcode:

Assert(MatchText('te\*23', 'te023')=false);
Assert(MatchText('te\?23', 'te023')=false);
Assert(MatchText('te\|23', 'te023')=false);
Assert(MatchText('te\\23', 'te023')=false);

Assert(MatchText('a*d|a*',  'abcdef')=True);

Du näherst dich wieder dem Ziel...

[himitsu]

Bezüglich des Escaping:

Delphi-Quellcode:

'\': If not (cfOnlyWild in Flags) and (Mp + 1 < Me2) Then
       Case (Mp + 1)^ of  '*', '?', '{', '~', '|', '\': Inc(Mp);  End
     Else GoTo LElse;

kleiner Unterschied, große Wirkung :freak:

Delphi-Quellcode:

'\': Begin
       If not (cfOnlyWild in Flags) and (Mp + 1 < Me2) Then
         Case (Mp + 1)^ of  '*', '?', '{', '~', '|', '\': Inc(Mp);  End;
       GoTo LElse;
     End;

und das Andere ... eine kleine Variable übersehn
(neues MaskenEnde Me in '|' nicht gesetzt)


Download siehe #26

[GPRSNerd]

Jau, jetzt geht wieder alles. :thumb:
Da sieht man wie wichtig Unittests sind bei so komplexen Funktionen! (benutze ich aber auch noch nicht so lange :angel2: ).

Danke für deinen Code (und deine Geduld mit meinen Nörgeleien :wink: )!

[himitsu]

Achtung: diese Veränderung bewirkt nur eine Verbesserung bei UnicodeStrings (PWideChar, WideString und UnicodeString)

Eigentlich hatte ich sowas zwar nicht vor, aber ich hab mich doch mal entschlossen die Unicodebehandlung aus meinem himXML zu extrahieren und hier mit einzubauen.

Es wird beim Unit-Start ein kleines Abbild des gesamten Unicode-2-Zeichensatzes angelegt und dann direkt darüber verglichen.

Nun wird also keine "LowerCase"-Kopie des Strings mehr benötigt, wenn nicht CaseSensitiv verglichen wird.
Und auch nicht mehr, wenn ein | im Suchmuster vorkommt.

Es gibt also vorallem bei langen Strings Vorteile, da nichts mehr rumkopiert werden muß. :stupid:

Alleine nachfolgender Code ist damit gleich so etwa 3 mal schneller, als mit der alten Version:

Allerdings ist diese Version nicht zur Geschwindigkeitsoptimierung gedacht,
(im Durchschnitt mag sich dieses nur minimal ändern und vorallam nicht bei CaseSensitivem Vergleich)
sondern der Speicheroptimierung (kein unnötiges Rumhantieren im Speichermanager)

Außerdem gibt es noch ein paar zusätzliche Funktionen
* WideLowerCase > sollte klar sein
* WideSameText > das auch
* und eine abgewandelte Version von Hagen's ELF-Hash, welcher auf Unicode erweitert wurde und auch noch die Maskenzeichen beachtet

Delphi-Quellcode:

Var T: LongWord;

T := GetTickCount;
For i := 1 to 100000 do Begin
  MatchText('',        'abcdef');
  MatchText('abc',     '');
  MatchText('abcdef',  'abcdef');
  MatchText('df',      'abcdef');
  MatchText('abc',     'abcdef');
  MatchText('def',     'abcdef');
  MatchText('abc?f',   'abcdef');
  MatchText('abc??f',  'abcdef');
  MatchText('abc*f',   'abcdef');
  MatchText('a?def',   'abcdef');
  MatchText('a??def',  'abcdef');
  MatchText('a*def',   'abcdef');
  MatchText('abcd?',   'abcdef');
  MatchText('abcd??',  'abcdef');
  MatchText('abcd???', 'abcdef');
  MatchText('abcd*',   'abcdef');
  MatchText('a?def',   'abcdef');
  MatchText('a??def',  'abcdef');
  MatchText('a*def',   'abcdef');
  MatchText('?cdef',   'abcdef');
  MatchText('??cdef',  'abcdef');
  MatchText('*cdef',   'abcdef');
  MatchText('b*c*f',   'abcdef');
  MatchText('a*c*f',   'abcdef');
  MatchText('a?c*f',   'abcdef');
  MatchText('a?d*f',   'abcdef');
  MatchText('*a*f*',   'abcdef');
  MatchText('*a?bf*',  'abcdef');
  MatchText('*c*f*',   'abcdef');
  MatchText('*c*d*',   'abcdef');
  MatchText('*c?f*',   'abcdef');
  MatchText('*d?f*',   'abcdef');
  MatchText('*',       '');
  MatchText('*',       'abcdef');
  MatchText('a*',      'abcdef');
  MatchText('*f',      'abcdef');

  MatchText('ab\*ef',  'abcdef');
  MatchText('ab\*ef',  'ab*ef');
  MatchText('ab\*ef',  'abcef');

  MatchText('a*d|a*', 'abcdef');
  MatchText('a*d|a*', 'abcdef');
  MatchText('a*d|z*', 'abcdef');
End;
T := GetTickCount - T;
ShowMessage(IntToStr(T));

und wo ich den Code einzeln hab, kann ich nun auch mal in Ruhe (einfacher) schauen, ob mit der LowerCase-Behandlung auch alles richtig läuft ... mal sehn ob auch alles wirklich stimmt :angel:

[GPRSNerd]

Funktioniert noch alles ;-)

Ich werde in den nächsten Tagen mal ein paar Unittests für die unterschiedlichen String-Varianten, insbesondere Unicode, bauen und die Ergebnisse posten.

Cheers!

[himitsu]

gibt jetzt keine großartigen Veränderungen ... ich hab nur den UTF8String hinzugefügt.

theoretisch/praktisch wird dort genauso verglichen, wie beim AnsiString, aber der Compiler nörgelt etwas rum, wenn man einen UTF8String an einen AnsiString übergeben möchte.
Drum hab ich einfach die Versionen mit AnsiString geklont und auf UTF8String (siehe System.pas) umgestellt. :angel:

[edit 11.02.2010]
Anhang entfernt > aktuelle Version siehe Beitrag #36

[himitsu]

Und noch 'ne kleine Anpassung bezüglich "älteren" Delphis.

Mein D7 mochte verständlicher Weise das {$STRINGCHECKS OFF} nicht, welches Letztens mir reinrutschte.
Darum würde dieses etwas verschoben, bzw. von Delphi < 2009 versteckt.

[edit 11.02.2010]
Anhang entfernt > aktuelle Version siehe Beitrag #36

[DelphiBandit]

Zitat:

Zitat von himitsu

gibt jetzt keine großartigen Veränderungen ... ich hab nur den UTF8String hinzugefügt.

ich habe gerade mal versucht die letzte Version der Unit einzubauen und zu benutzen. Leider werde ich mit Fehlermeldungen "MatchStringEx" "Doppeldeutig überladene Version von..." zugebomt (RS 2007, also ohne UniCode). Nehme ich die Version 1.2 ohne UTF8 lässt es sich durchkompilieren.

Gibt es dafür einen Compilerschalter, damit er auch die UTF8-Version durchkompilieren kann? Oder hat einer von Euch eine andere Idee warum das nicht funktioniert?