Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Zeichenketten nach Maske generieren (https://www.delphipraxis.net/158605-zeichenketten-nach-maske-generieren.html)

jan17 23. Feb 2011 17:03

Delphi-Version: XE

Zeichenketten nach Maske generieren
 
Hi,

Ich versuche gerade eine Funktion zu programmieren, die Zeichenketten nach einer bestimmten Maske generiert.
Also "l" sind z.B. alle Kleinbuchstaben, "u" alle Großbuchstaben, "d" alle Zahlen, "m" alle Groß- und Kleinbuchstaben und "a" alle Groß-/Kleinbuchstaben und Zahlen.

Der Funktion übergibt man nun z.B. den Parameter "uld" und es werden dann alle 6760 möglichen Zeichenketten daraus generiert.
Delphi-Quellcode:
Aa0
Aa1
Aa2
Aa3
...
Zz7
Zz8
Zz9
Ich habe es bisher nur so hinbekommen:
Delphi-Quellcode:
const
  len=3;
var
  c1,c2,c3:char;
  s:string;
  f:textfile;
begin
  assignfile(f,'test.txt');
  rewrite(f);
  setlength(s,len);
  for c1 := 'A' to 'Z' do
    for c2 := 'a' to 'z' do
      for c3 := '0' to '9' do
      begin
        s[1]:=c1;
        s[2]:=c2;
        s[3]:=c3;
        writeln(f,s);
      end;
  closefile(f);
end;
Das funktioniert aber nur für diesen speziellen Fall und ist nicht allgemeingültig, so dass man es jedes mal wieder ändern muss.

Zur Berechnung der Anzahl der Kombinationen habe ich diese Funktion:
Delphi-Quellcode:
function calc(const s:string):uint64;
var i:byte;
begin
  result:=1;
  for i := 1 to length(s) do
    case s[i] of
      'l','u':result:=result*26;
      'm'   :result:=result*52;
      'd'   :result:=result*10;
      'a'   :result:=result*62;
    end;
end;
Könnt ihr mir helfen eine allgemeingültige Funktion zu schreiben? Ich bin mir ziemlich sicher, dass es mit Rekursion recht einfach gehen könnte :)

Hawkeye219 23. Feb 2011 19:49

AW: Zeichenketten nach Maske generieren
 
Herzlich Willkommen in der Delphi-PRAXiS, jan17!

Mit der Idee, eine Rekursion einzusetzen, bist du schon einmal auf dem richtigen Weg.

Ich würde zunächst mit SetLength einen Ausgabestring in der Länge des Musters vorbereiten und dann die rekursive Routine zum ersten Mal aufrufen (Stufe 1). In der Routine wird das Zeichen des Musters für die aktuelle Rekursionstiefe betracthtet und eine zugehörige Menge von erlaubten Zeichen ermittelt (z.B. als TSysCharSet). Nun können nacheinnander alle Zeichen dieser Menge an die zur Rekursionstiefe gehörende Stelle des Ausgabestrings geschrieben werden. Nach jedem Schritt wird geprüft, ob bereits die letzte Rekursionstiefe erreicht wurde. Falls ja, wird der aktuelle Ausgabestring zur Lösungsmenge hinzugefügt, anderenfalls die Routine erneut aufgerufen, um die nächste Rekursionstiefe zu erreichen (Stufe n+1).

Ich hoffe, diese Beschreibung war nicht zu kompliziert. Die notwendigen Statements hast du ja zum Teil schon in deinem geposteten Quelltext verwendet. Vielleicht ist die Umsetzung ja nun gar nicht mehr so schwer.

Gruß Hawkeye

jan17 23. Feb 2011 20:49

AW: Zeichenketten nach Maske generieren
 
Hawkeye, ich weiss nicht, was ich sagen soll.
Als ich diese Frage gestellt habe, hätte ich niemals gedacht, dass ich es jemals selber schaffe.
Aber deine Beschreibung war so genial einfach, dass ich es gleich beim ersten Versuch geschafft habe. :wink:
Delphi-Quellcode:
  procedure a1(const mask:string);
  var s:string;

    procedure a2(n:byte);
    var c,c1,c2:char;
    begin
      if n >= length(mask)+1 then
        listbox1.Items.add(s)
      else
      begin
        case mask[n] of
          'l':
          begin
            c1:='a';
            c2:='z';
          end;
          'u':
          begin
            c1:='A';
            c2:='Z';
          end;
          'd':
          begin
            c1:='0';
            c2:='9';
          end;
        end;
        for c := c1 to c2 do
        begin
          s[n]:=c;
          a2(n+1);
        end;
      end;
    end;

  begin
    setlength(s,length(mask));
    a2(1);
  end;
Wie man sieht, ist noch lange nicht perfekt und es fehlt noch einiges, aber den Rest kriege ich auch noch hin.
Jedenfalls vielen Dank, dass du geantwortet hast! :thumb:


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:36 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