AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Stringvergleich mit Wildcards

Ein Thema von Willie1 · begonnen am 12. Dez 2008 · letzter Beitrag vom 11. Feb 2010
Antwort Antwort
Seite 1 von 5  1 23     Letzte » 
Willie1

Registriert seit: 28. Mai 2008
618 Beiträge
 
Delphi 10.1 Berlin Starter
 
#1

Stringvergleich mit Wildcards

  Alt 12. Dez 2008, 13:04
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
  Mit Zitat antworten Zitat
Benutzerbild von SubData
SubData

Registriert seit: 14. Sep 2004
Ort: Stuhr
1.078 Beiträge
 
Delphi 11 Alexandria
 
#2

Re: Stringvergleich mit Wildcards

  Alt 12. Dez 2008, 14:03
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;
Ronny
/(bb|[^b]{2})/
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.014 Beiträge
 
Delphi 12 Athens
 
#3

Re: Stringvergleich mit Wildcards

  Alt 13. Dez 2008, 00:19
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
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Benutzerbild von Codewalker
Codewalker

Registriert seit: 18. Nov 2005
Ort: Ratingen
945 Beiträge
 
Delphi XE2 Professional
 
#4

Re: Stringvergleich mit Wildcards

  Alt 13. Dez 2008, 16:38
Haben wir schon in der CodeLib. Am besten zusammenführen in ein Thema
http://www.delphipraxis.net/internal...341&highlight=
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.014 Beiträge
 
Delphi 12 Athens
 
#5

Re: Stringvergleich mit Wildcards

  Alt 13. Dez 2008, 23:53
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).
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
ringli

Registriert seit: 7. Okt 2004
504 Beiträge
 
Delphi 11 Alexandria
 
#6

Re: Stringvergleich mit Wildcards

  Alt 14. Dez 2008, 00:29
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;
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.014 Beiträge
 
Delphi 12 Athens
 
#7

Re: Stringvergleich mit Wildcards

  Alt 14. Dez 2008, 01:05
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?
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Willie1

Registriert seit: 28. Mai 2008
618 Beiträge
 
Delphi 10.1 Berlin Starter
 
#8

Re: Stringvergleich mit Wildcards

  Alt 16. Dez 2008, 22:42
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.
  Mit Zitat antworten Zitat
Benutzerbild von sx2008
sx2008

Registriert seit: 16. Feb 2008
Ort: Baden-Württemberg
2.332 Beiträge
 
Delphi 2007 Professional
 
#9

Re: Stringvergleich mit Wildcards

  Alt 17. Dez 2008, 03:30
@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.
  Mit Zitat antworten Zitat
Willie1

Registriert seit: 28. Mai 2008
618 Beiträge
 
Delphi 10.1 Berlin Starter
 
#10

Re: Stringvergleich mit Wildcards

  Alt 17. Dez 2008, 08:48
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.
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:00 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz