AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
• Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Stringvergleich mit Wildcards

Ein Thema von Willie1 · begonnen am 12. Dez 2008 · letzter Beitrag vom 11. Feb 2010
 
Vorheriger Beitrag Vorheriger Beitrag   Nächster Beitrag Nächster Beitrag
Benutzerbild von himitsu
himitsu

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

Re: Stringvergleich mit Wildcards

  Alt 6. Mai 2009, 23: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:
zusammenfalten · markieren
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:
zusammenfalten · markieren
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:
zusammenfalten · markieren
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.
zusammenfalten · markieren
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;
Ein Therapeut entspricht 1024 Gigapeut.
  Mit Zitat antworten Zitat
 

« Vorheriges Thema | Nächstes Thema »

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 03:46 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz