Prüfen ob ein String auf eine Maske passt

[Codewalker]

Auch auf die Gefahr hin, dass man das mit regulären Ausdrücken und ähnlichem einfacher lösen kann, habe ich eine kleine Funktion geschrieben, die überpüft, ob ein String auf eine Maske passt. Die Funktion arbeitet auf Wunsch Case-Sensitive und ermöglich einen * als Wildcard für eine beliebige Anzahl Zeichen und ein ? für genau ein beliebiges Zeichen.

Lob, Kritik und Kommentare sind gern gesehen bzw. gelesen

Delphi-Quellcode:

function TestMask(Token, Mask: string; CaseSensitive: boolean = False): boolean;
var
  post: integer;  // Aktuelle Position im Token
  posm: integer;  // Aktuelle Position in der Maske
  lt:   integer;  // Länge des Tokens
  lm:   integer;  // Länge der Maske
  ignorend: boolean;
 { wenn das letzte Zeichen der Maske ein '*' ist, darf nicht überpüft werden,
  ob der Token komplett bearbeitet wurde, da an dieser Stelle jegliche weitere
  Untersuchung beendet wird }
  endrekurs: boolean;
 { Wird auf true gesetzt, sobald der Rekursionsabstieg nicht mehr notwendig ist,
  da eine Möglichkeit erreicht wurde, bei der die Maske auf das Token passt }
begin
  if not CaseSensitive then
  begin
    Token := LowerCase(Token);
    Mask  := LowerCase(Mask);
  end;
  post   := 1;
  posm   := 1;
  lt     := Length(Token);
  lm     := Length(Mask);
  ignorend := False;
  Result := True;
  endrekurs := False;

  // aufeinander folgende * durch einen ersetzen, da es sonst Fehler gibt,
  while (Pos('**', Mask) > 0) do
    Mask := StringReplace('**', '*', Mask, [rfReplaceAll]);

  while (post <= lt) and (posm <= lm) and Result and not endrekurs do
  begin
    case Mask[posm] of
      '*':
      begin // unbestimmte Anzahl Zeichen ist uninteressant
        Inc(posm);
        if posm <= lm then
        begin
          endrekurs := False;
          while (post <= lt) and not endrekurs do
          begin
            if (Token[post] = mask[posm]) then
            begin
           { Die Rekursion wird dazu verwendet, die verschiedenen Möglichkeiten nach dem Auftreten eines '*'
           möglich sind zu testen. Sobald eine Möglichkeit gefunden wurde, wird der Abstieg beendet. Die
           Copyfunktionen liefern den jweils noch zu bearbeitenden Teil der Strings }
              if TestMask(Copy(token, post, lt - post + 1),
                Copy(Mask, posm, lm - posm + 1), CaseSensitive) then
                endrekurs := True
              else
                Inc(post);
            end
            else
              Inc(post);
          end;
          if not endrekurs then
            Result := False;
        end
        else
          ignorend := True;
      end;
      '?':
      begin // Aktuelles Zeichen ist uninteressant
        Inc(posm);
        Inc(post);
      end;
      else // Zeichen müssen identisch sein
      begin
        if Mask[posm] = token[post] then
        begin
          Inc(posm);
          Inc(post);
        end
        else
          Result := False;
      end;
    end;
  end;
  // Überprüfe, ob beide String komplett bearbeitet wurden (wenn nötig)
  if (not endrekurs) and (not ignorend) and Result and not ((post - 1 = lt) and (posm - 1 = lm)) then
    Result := False;
end;

Ein Beispielaufruf wäre wie folgt:

Delphi-Quellcode:

procedure TForm3.ButtonClick(Sender: TObject);
begin
  if TestMask(ED_String.Text, ED_Mask.Text, CB_CaseSensitive.Checked) then
    ShowMessage('Maske passt')
  else
    ShowMessage('Maske passt nicht');
end;

[edit=Matze]Ergänzung zum Code hinzugefügt. Mfg, Matze[/edit]

[SirThornberry]

Ich will dich nicht entmutigen aber sowas gibts schon:
http://www.delphi-fundgrube.de/files/like.txt

[Codewalker]

Naja, dann war's halt eine nette Übung

[Matze]

Dann haben wir sowas auch in der DP, ist doch gut.