Thema: Delphi Stringvergleich mit Wildcards

Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.120 Beiträge
 
Delphi 12 Athens
 

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;
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat