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 2 von 5     12 34     Letzte » 
Benutzerbild von sx2008
sx2008

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

Re: Stringvergleich mit Wildcards

  Alt 17. Dez 2008, 09:29
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.
  Mit Zitat antworten Zitat
Willie1

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

Re: Stringvergleich mit Wildcards

  Alt 17. Dez 2008, 19:11
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.
  Mit Zitat antworten Zitat
Benutzerbild von Codewalker
Codewalker

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

Re: Stringvergleich mit Wildcards

  Alt 17. Dez 2008, 19:16
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)
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

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

Re: Stringvergleich mit Wildcards

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

> M*er
oder gar mehrere *

Zitat:
Die Joker *? dürfen in text natürlich nicht vorkommen - in Dateinamen sind seit den DOS-Zeiten diese Zeichen verboten!
in Linux kannst du sehr wohl auch diese Zeichen in Dateinamen verwenden
und auch FAT und Co. kann man beibringen diese Zeichen etwas zu mögen. (du glaubst nicht wie effektiv man den Zugriff auf eine Datei verhindern kann (also bei fast allen Windowsprogrammen), wenn man ihr nur solch ein Zeichen in den Dateinamen schmugglt )

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

Zitat:
Ich halte meine Lösung für effizient.
wann man viele/schnelle Vergleiche durchführen will, dann wohl nicht

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

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

Re: Stringvergleich mit Wildcards

  Alt 7. Mai 2009, 00:38
[add] aktuelle Version in Beitrag #22 [/add]

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

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

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

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

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

  Label LMask;

  Begin
    Result := False;
    If CaseSensitive Then Begin
      Mp := PWideChar(Mask);
      Sp := PWideChar(S);
    End Else Begin
      Ml := Mask;
      Sl := S;
      UniqueString(Ml);
      UniqueString(Sl);
      Mp := PWideChar(Ml);
      Sp := PWideChar(Sl);
      CharLowerBuffW(Mp, Length(Ml));
      CharLowerBuffW(Sp, Length(Sl));
    End;
    Me := Mp + Length(Mask);
    Se := Sp + Length(S);
    Mm := nil;
    Sm := Se;
    While (Mp < Me) or (Sp < Se) do Begin
      Case Mp^ of
        '*': Begin
          While Mp^ = '*do Inc(Mp);
          Mm := Mp;
          Sm := Sp + 1;
          Continue;

          LMask:
          Mp := Mm;
          Sp := Sm;
          Inc(Sm);
          If (Mp < Me) and (Sp >= Se) Then Exit;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mp^) > 1}
            //If ((Mp + 1)^ = '*') or ((Mp + 1)^ = '?') or ((Mp + 1)^ = '\') Then Inc(Mp);
            Case (Mp + 1)^ of '*', '?', '\': Inc(Mp); End;
          {$ELSE}
            If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
          {$IFEND}
          If Mp^ <> Sp^ Then GoTo LMask;
        End;
        Else If Mp^ <> Sp^ Then GoTo LMask;
      End;
      If (Mp >= Me) or (Sp >= Se) Then GoTo LMask;
      Inc(Mp);
      Inc(Sp);
    End;
    Result := True;
  End;
2:
Delphi-Quellcode:
Function MatchText(Mask, S: PWideChar; CaseSensitive: Boolean = False): Boolean;
  Var Mm, Sm: PWideChar;
    Ml, Sl: WideString;

  Label LMask;

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

          LMask:
          Mask := Mm;
          S := Sm;
          Inc(Sm);
          If ((Mask = nil) or (Mask^ <> #0)) and (S^ = #0) Then Exit;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mask^) > 1}
            Case (Mask + 1)^ of '*', '?', '\': Inc(Mask); End;
          {$ELSE}
            If (Mask + 1)^ in ['*', '?', '\'] Then Inc(Mask);
          {$IFEND}
          If Mask^ <> S^ Then GoTo LMask;
        End;
        Else If Mask^ <> S^ Then GoTo LMask;
      End;
      If (Mask^ = #0) or (S^ = #0) Then GoTo LMask;
      Inc(Mask);
      Inc(S);
    End;
    Result := True;
  End;
3:
Delphi-Quellcode:
Function MultiMatchText(Mask, S: PWideChar; CaseSensitive: Boolean = False): Boolean;
  Var Mp, Mm, Me, Ms, Sp, Sm: PWideChar;
    Ml, Sl: WideString;

  Label LMulti, LMask;

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

    LMulti:
    Mm := nil;
    Sm := Sp + lstrlenW(Sp);
    While (Mp^ <> #0) or (Sp^ <> #0) do Begin
      Case Mp^ of
        '*': Begin
          While Mp^ = '*do Inc(Mp);
          Mm := Mp;
          Sm := Sp + 1;
          Continue;

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


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

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

  Label LMask;

  Begin
    Result := False;
    If CaseSensitive Then Begin
      Mp := {PChar|PAnsiChar|PWideChar}(Mask);
      Sp := {PChar|PAnsiChar|PWideChar}(S);
    End Else Begin
      Ml := Mask;
      Sl := S;
      UniqueString(Ml);
      UniqueString(Sl);
      Mp := {PChar|PAnsiChar|PWideChar}(Ml);
      Sp := {PChar|PAnsiChar|PWideChar}(Sl);
      {CharLowerBuff|CharLowerBuffA|CharLowerBuffW}(Mp, Length(Ml));
      {CharLowerBuff|CharLowerBuffA|CharLowerBuffW}(Sp, Length(Sl));
    End;
    Me := Mp + Length(Mask);
    Se := Sp + Length(S);
    Mm := nil;
    Sm := Se;
    While (Mp < Me) or (Sp < Se) do Begin
      Case Mp^ of
        '*': Begin
          While Mp^ = '*do Inc(Mp);
          Mm := Mp;
          Sm := Sp + 1;
          Continue;

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

// 2:

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

  Label LMask;

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

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

// 3:

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

  Label LMulti, LMask;

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

    LMulti:
    Mm := nil;
    Sm := Sp + {lstrlen|lstrlenA|lstrlenW}(Sp);
    While (Mp^ <> #0) or (Sp^ <> #0) do Begin
      Case Mp^ of
        '*': Begin
          While Mp^ = '*do Inc(Mp);
          Mm := Mp;
          Sm := Sp + 1;
          Continue;

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

Registriert seit: 30. Dez 2004
Ort: Ruhrpott
239 Beiträge
 
Delphi 10.4 Sydney
 
#16

Re: Stringvergleich mit Wildcards

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

Edit:
Matchtext('te?23', 'te123', false) ergibt auch FALSE.
Stefan
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

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

Re: Stringvergleich mit Wildcards

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


zum [edit] ups muß ich mal sehn

hab mir zwar 'ne Testreihe aufgebaut und das MatchText('a?def','abcdef') lieferte eigentlich ein richtiges Ergebnis
(allerdings muß ich zugeben, daß ich nur die UnicodeVersion getestet hab ... vielleicht hab ich ja nur bei der Umstellung 'nen Fehler gemacht )
Delphi-Quellcode:
If MatchText('', 'abcdef') Then Beep;
If MatchText('def', '') Then Beep;
If not MatchText('abcdef', 'abcdef') Then Beep;
If MatchText('df', 'abcdef') Then Beep;
If MatchText('abc', 'abcdef') Then Beep;
If MatchText('def', 'abcdef') Then Beep;
If MatchText('abc?f', 'abcdef') Then Beep;
If not MatchText('abc??f', 'abcdef') Then Beep;
If not MatchText('abc*f', 'abcdef') Then Beep;
If MatchText('a?def', 'abcdef') Then Beep;
If not MatchText('a??def', 'abcdef') Then Beep;
If not MatchText('a*def', 'abcdef') Then Beep;
If MatchText('abcd?', 'abcdef') Then Beep;
If not MatchText('abcd??', 'abcdef') Then Beep;
If MatchText('abcd???', 'abcdef') Then Beep;
If not MatchText('abcd*', 'abcdef') Then Beep;
If MatchText('a?def', 'abcdef') Then Beep;
If not MatchText('a??def', 'abcdef') Then Beep;
If not MatchText('a*def', 'abcdef') Then Beep;
If MatchText('?cdef', 'abcdef') Then Beep;
If not MatchText('??cdef', 'abcdef') Then Beep;
If not MatchText('*cdef', 'abcdef') Then Beep;
If MatchText('b*c*f', 'abcdef') Then Beep;
If not MatchText('a*c*f', 'abcdef') Then Beep;
If not MatchText('a?c*f', 'abcdef') Then Beep;
If MatchText('a?d*f', 'abcdef') Then Beep;
If not MatchText('*a*f*', 'abcdef') Then Beep;
If MatchText('*a?bf*', 'abcdef') Then Beep;
If not MatchText('*c*f*', 'abcdef') Then Beep;
If not MatchText('*c*d*', 'abcdef') Then Beep;
If MatchText('*c?f*', 'abcdef') Then Beep;
If not MatchText('*d?f*', 'abcdef') Then Beep;
If not MatchText('*', '') Then Beep;
If not MatchText('*', 'abcdef') Then Beep;
If not MatchText('a*', 'abcdef') Then Beep;
If not MatchText('*f', 'abcdef') Then Beep;

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

Registriert seit: 30. Dez 2004
Ort: Ruhrpott
239 Beiträge
 
Delphi 10.4 Sydney
 
#18

Re: Stringvergleich mit Wildcards

  Alt 7. Mai 2009, 11:31
Vergiss den Edit, mein Fehler! Ich habe test123 auf te?23 geprüft. Copy&Paste-Error!
Stefan
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

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

Re: Stringvergleich mit Wildcards

  Alt 7. Mai 2009, 11:50
Zitat von GPRSNerd:
Vergiss den Edit, mein Fehler! Ich habe test123 auf te?23 geprüft. Copy&Paste-Error!
OK

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

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

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

jetzt wo's Maskieren wieder drin ist, werd' ich nun wohl Beides (MatchText und MultiMatchText) in einem vereinigen
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 himitsu
himitsu

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

Re: Stringvergleich mit Wildcards

  Alt 7. Mai 2009, 14:51
Blos mal 'ne kleine und nicht ganz durchgeteste Vorschau auf alle vier Versionen (also nun auch eine MultiMatchText als String-Version).
Also aktuell ist noch alles in Post #15 vorzuziehen.
Wenn ich es jetzt noch schaff die Bearbeitung des "|", von vor der Hauptschleife, in die Hauptschleife reinzubekommen, dann wird es nur noch je eine String- und PChar-Vesion geben (MultiMatchText und MatchText in einem), ansonsten laß ich es performancemäßig getrennt, aber ich bin (noch) guter Dinge
Delphi-Quellcode:
Function MatchText(Const Mask, S: WideString; CaseSensitive: Boolean = False): Boolean;
  Var Mp, Me, Mm, Sp, Se, Sm: PWideChar;
    Mt, St: WideString;

  Label LMask;

  Begin
    Result := False;
    If CaseSensitive Then Begin
      Mp := PWideChar(Mask);
      Sp := PWideChar(S);
    End Else Begin
      Mt := Mask;
      St := S;
      UniqueString(Mt);
      UniqueString(St);
      Mp := PWideChar(Mt);
      Sp := PWideChar(St);
      CharLowerBuffW(Mp, Length(Mt));
      CharLowerBuffW(Sp, Length(St));
    End;
    Me := Mp + Length(Mask);
    Se := Sp + Length(S);
    Mm := nil;
    Sm := Se;
    While (Mp < Me) or (Sp < Se) do Begin
      Case Mp^ of
        '*': Begin
          While Mp^ = '*do Inc(Mp);
          Mm := Mp;
          Sm := Sp + 1;
          Continue;

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

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

  Label LMulti, LMask;

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

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

    Mm := nil;
    Sm := Se;
    While (Mp < Me2) or (Sp < Se) do Begin
      Case Mp^ of
        '*': Begin
          While Mp^ = '*do Inc(Mp);
          Mm := Mp;
          Sm := Sp + 1;
          Continue;

          LMask:
          Mp := Mm;
          Sp := Sm;
          Inc(Sm);
          If (Mp < Me2) and (Sp >= Se) Then
            If Me2 < Me Then Begin
              Inc(Me2);
              Goto LMulti;
            End Else Exit;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mp^) > 1}
            //If ((Mp + 1)^ = '*') or ((Mp + 1)^ = '?') or ((Mp + 1)^ = '\') Then Inc(Mp);
            Case (Mp + 1)^ of '*', '?', '\': Inc(Mp); End;
          {$ELSE}
            If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
          {$IFEND}
          If Mp^ <> Sp^ Then GoTo LMask;
        End;
        Else If Mp^ <> Sp^ Then GoTo LMask;
      End;
      If (Mp >= Me2) or (Sp >= Se) Then GoTo LMask;
      Inc(Mp);
      Inc(Sp);
    End;
    Result := True;
  End;

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

  Label LMask;

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

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

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

  Label LMulti, LMask;

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

    LMulti:
    Mm := nil;
    Sm := Sp + lstrlenW(Sp);
    While (Mp^ <> #0) or (Sp^ <> #0) do Begin
      Case Mp^ of
        '*': Begin
          While Mp^ = '*do Inc(Mp);
          Mm := Mp;
          Sm := Sp + 1;
          Continue;

          LMask:
          Mp := Mm;
          Sp := Sm;
          Inc(Sm);
          If ((Mp = nil) or (Mp^ <> #0)) and (Sp^ = #0) Then Begin
            While Ms < Me do Begin
              Inc(Ms);
              If (Ms - 1)^ = #0 Then Begin
                Mp := Ms;
                If CaseSensitive Then Sp := S Else Sp := PWideChar(St);
                Goto LMulti;
              End;
            End;
            Exit;
          End;
          Continue;
        End;
        '?': ;
        '\': Begin
          {$IF SizeOf(Mp^) > 1}
            Case (Mp + 1)^ of '*', '?', '\': Inc(Mp); End;
          {$ELSE}
            If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
          {$IFEND}
          If Mp^ <> Sp^ Then GoTo LMask;
        End;
        Else If Mp^ <> Sp^ Then GoTo LMask;
      End;
      If (Mp^ = #0) or (Sp^ = #0) Then GoTo LMask;
      Inc(Mp);
      Inc(Sp);
    End;
    Result := True;
  End;
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  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 20:17 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