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