AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Algorithmen Delphi Prüfen ob ein String auf eine Maske passt

Prüfen ob ein String auf eine Maske passt

Ein Thema von Codewalker · begonnen am 27. Nov 2006 · letzter Beitrag vom 28. Nov 2006
Antwort Antwort
Benutzerbild von Codewalker
Codewalker

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

Prüfen ob ein String auf eine Maske passt

  Alt 27. Nov 2006, 21:01
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]
Angehängte Dateien
Dateityp: exe mask_110.exe (175,0 KB, 80x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von SirThornberry
SirThornberry
(Moderator)

Registriert seit: 23. Sep 2003
Ort: Bockwen
12.235 Beiträge
 
Delphi 2006 Professional
 
#2

Re: Prüfen ob ein String auf eine Maske passt

  Alt 28. Nov 2006, 09:50
Ich will dich nicht entmutigen aber sowas gibts schon:
http://www.delphi-fundgrube.de/files/like.txt
Jens
Mit Source ist es wie mit Kunst - Hauptsache der Künstler versteht's
  Mit Zitat antworten Zitat
Benutzerbild von Codewalker
Codewalker

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

Re: Prüfen ob ein String auf eine Maske passt

  Alt 28. Nov 2006, 11:03
Naja, dann war's halt eine nette Übung
  Mit Zitat antworten Zitat
Benutzerbild von Matze
Matze
(Co-Admin)

Registriert seit: 7. Jul 2003
Ort: Schwabenländle
14.987 Beiträge
 
Turbo Delphi für Win32
 
#4

Re: Prüfen ob ein String auf eine Maske passt

  Alt 28. Nov 2006, 15:07
Dann haben wir sowas auch in der DP, ist doch gut.
  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 19:32 Uhr.
Powered by vBulletin® Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2019 by Daniel R. Wolf