Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Programm zur polyalphabetischen Codierung (aus Vorlage) (https://www.delphipraxis.net/84114-programm-zur-polyalphabetischen-codierung-aus-vorlage.html)

jenny87 11. Jan 2007 14:29


Programm zur polyalphabetischen Codierung (aus Vorlage)
 
Liste der Anhänge anzeigen (Anzahl: 2)
Seid gegrüßt liebe Informatika,

ich soll aus dem angehängten (Delphie 4) Programm, welches eine monoalphabetische Codierung nach "Cäsar" darstellt, eine polyalphabetische Codierung erstellen.
Bis jetzt ist es ja so, dass der User mittels EINEM beliebig wählbaren Buchstaben einen beliebigen Text codieren kann.
Nun soll er aber mittels einem beliebig wählbaren CODEWORT den Text verschlüsseln... und daran scheitere ich!
Vielleicht könnt ihr mir ja da helfen, ich verzweifle langsam...

Vielen Dank und lieb(st)e Grüße, Jenny :)


Hier noch der Quelltext:
Code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;

type
  TfrmKodierung = class(TForm)
    gbxSatz: TGroupBox;
    gbxCode: TGroupBox;
    edtCodeBuchstabe: TEdit;
    lblCodeBuchstabe: TLabel;
    bbtnEnde: TBitBtn;
    bbtnNeu: TBitBtn;
    bbtnCode: TBitBtn;
    mmoSatz: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure mmoSatzChange(Sender: TObject);
    procedure bbtnCodeClick(Sender: TObject);
  private
    { Private-Deklarationen}
  public
    { Public-Deklarationen}
  end;

var
  frmKodierung: TfrmKodierung;

implementation

{$R *.DFM}

 VAR CodeRichtung : -1 .. 1;

procedure TfrmKodierung.FormCreate(Sender: TObject);
begin
   gbxSatz.Caption := 'Geben Sie den zu verschlüsselnden Text ein:';
   WITH mmoSatz DO
      BEGIN
         Text   := '';
         Enabled := true
      END;
   WITH edtCodeBuchstabe DO
      BEGIN
         Text   := '';
         Enabled := true
      END;
   bbtnCode.Enabled := false;
   CodeRichtung    := 1 // d.h. als erstes wird kodiert
end;

procedure TfrmKodierung.mmoSatzChange(Sender: TObject);
begin
   IF (mmoSatz.Text <> '') AND (edtCodeBuchstabe.Text <> '')
    THEN bbtnCode.Enabled := true
    ELSE bbtnCode.Enabled := false;
end;

 FUNCTION EinLesen(AnzeigeText : STRING) : STRING;
    var zwtext:string;
        zeichen:integer;
    BEGIN
       Zwtext:='';
       For zeichen:=1 to length(anzeigetext) do
        case anzeigetext[zeichen] of
        'a'..'z','A'..'Z':zwtext:=zwtext+uppercase(anzeigetext[zeichen]);
        'ä','Ä'         :zwtext:=zwtext+'AE';
        'ö','Ö'         :zwtext:=zwtext+'OE';
        'ü','Ü'         :zwtext:=zwtext+'UE';
        'ß'             :zwtext:=zwtext+'SS';
        'â','á','à'     :zwtext:=zwtext+'A';
        'ê','é','è'     :zwtext:=zwtext+'E';
        'û','ú','ù'     :zwtext:=zwtext+'U';
        'ô','ó','ò'     :zwtext:=zwtext+'O';
        'î','í','ì'     :zwtext:=zwtext+'I';
        '°'             :zwtext:=zwtext+'GRAD';
        '@'             :zwtext:=zwtext+'AT';
        '_'             :zwtext:=zwtext+'UNTERSTRICH';
        '1'             :zwtext:=zwtext+'EINS';
        '2'             :zwtext:=zwtext+'ZWEI';
        '3'             :zwtext:=zwtext+'DREI';
        '4'             :zwtext:=zwtext+'VIER';
        '5'             :zwtext:=zwtext+'FUENF';
        '6'             :zwtext:=zwtext+'SECHS';
        '7'             :zwtext:=zwtext+'SIEBEN';
        '8'             :zwtext:=zwtext+'ACHT';
        '9'             :zwtext:=zwtext+'NEUN';
        '0'             :zwtext:=zwtext+'NULL';
        '"'             :zwtext:=zwtext+'ANFUEHRUNGSZEICHEN';
        '!'             :zwtext:=zwtext+'AUSRUFEZEICHEN';
        '?'             :zwtext:=zwtext+'FRAGEZEICHEN';
        '.'             :zwtext:=zwtext+'PUNKT';
        ','             :zwtext:=zwtext+'KOMMA';
        ';'             :zwtext:=zwtext+'SEMIKOLON';
        ':'             :zwtext:=zwtext+'DOPPELPUNKT';
        '-'             :zwtext:=zwtext+'MINUS';
        '+'             :zwtext:=zwtext+'PLUS';
        '%'             :zwtext:=zwtext+'PROZENT';
        '&'             :zwtext:=zwtext+'UND';
        '('             :zwtext:=zwtext+'KLAMMERAUF';
        ')'             :zwtext:=zwtext+'KLAMMERZU';
        '['             :zwtext:=zwtext+'ECKIGEKLAMMERAUF';
        ']'             :zwtext:=zwtext+'ECKIGEKLAMMERZU';
        '='             :zwtext:=zwtext+'ISTGLEICH';
        '²'             :zwtext:=zwtext+'HOCHZWEI';
        '³'             :zwtext:=zwtext+'HOCHDREI';
        '$'             :zwtext:=zwtext+'DOLLAR';
        '€'             :zwtext:=zwtext+'EURO';
        '*'             :zwtext:=zwtext+'STERNCHEN';
        '\'             :zwtext:=zwtext+'BACKSLASH';
        '/'             :zwtext:=zwtext+'SLASH';
        '#'             :zwtext:=zwtext+'RAUTE';
        {'10'            :zwtext:=zwtext+'ZEHN';
        '11'            :zwtext:=zwtext+'ELF';
        '12'            :zwtext:=zwtext+'ZWOELF';
        '13'            :zwtext:=zwtext+'DREIZEHN';
        '14'            :zwtext:=zwtext+'VIERZEHN';
        '15'            :zwtext:=zwtext+'FUENFZEHN';
        '16'            :zwtext:=zwtext+'SECHSZEHN';
        '17'            :zwtext:=zwtext+'SIEBZEHN';
        '18'            :zwtext:=zwtext+'ACHTZEHN';
        '19'            :zwtext:=zwtext+'NEUNZEHN';
        '20'            :zwtext:=zwtext+'ZWANZIG';
        '21'            :zwtext:=zwtext+'EINUNDZWANZING';
        '22'            :zwtext:=zwtext+'ZWEIUNDZWANZIG';
        '23'            :zwtext:=zwtext+'DREIUNDZWANZIG';
        '24'            :zwtext:=zwtext+'VIERUNDZWANZIG';
        '25'            :zwtext:=zwtext+'FUENFUNDZWANZIG';
        '26'            :zwtext:=zwtext+'SECHSUNDZWANZIG';
        '27'            :zwtext:=zwtext+'SIEBENUNDZWANZIG';
        '28'            :zwtext:=zwtext+'ACHTUNDZWANZIG';
        '29'            :zwtext:=zwtext+'NEUNUNDZWANZIG';
        '30'            :zwtext:=zwtext+'DREIZIG'; }






        end;
       Einlesen:=zwtext;
       // Diese Funktion soll dafür sorgen, dass in dem zu kodierenden
       // Text nur große Buchstaben stehen, Umlaute umgeschrieben und
       // Satzzeichen entfernt werden.
    END; // von EinLesen

 PROCEDURE Code(VAR C_Text : STRING;
                C_Buchstabe : CHAR;
                C_Richtung : SHORTINT);
      VAR index:integer;
          Verschiebung:shortint;
      BEGIN
      Verschiebung:=C_Richtung*(ord(C_Buchstabe)-ord('A'));
      FOR index:=1 to length(C_Text) do
          C_Text[Index]:=chr((ord(C_Text[Index])-ord('A')+Verschiebung+26)MOD 26+ORD('A'));
      // Hier soll die (De)Kodierung stattfinden.
   END;

 FUNCTION BlockAusgabe(AusgabeText : STRING) : STRING;
    CONST Block = 5; // <-- Anzahl der Buchstaben, die zu einem Block zusammengefasst werden
     VAR index:byte;
         zwtext:string;
    BEGIN
       for index:=1 to length(Ausgabetext) do
       begin
           ZwText:=Zwtext+Ausgabetext[index];
           if Index MOD block = 0
           then ZWText:=zwtext+' ';
       end;
       blockausgabe:=zwtext;
       // Diese Funktion soll den auszugebenden Text in Blöcke
       // der angegebnen Länge "zerhacken" und die einzelnen
       // Blöcke durch Leerzeichen trennen.
    END; // von BlockAusgabe

procedure TfrmKodierung.bbtnCodeClick(Sender: TObject);
 VAR TextFeld     : STRING;
      CodeBuchstabe : CHAR;
begin
         
   TextFeld     := EinLesen(mmoSatz.Text);
   CodeBuchstabe := edtCodeBuchstabe.Text[1];
   Code(TextFeld, CodeBuchstabe, CodeRichtung);
   mmoSatz.Text := BlockAusgabe(TextFeld);
   IF CodeRichtung = 1
    THEN
       BEGIN
          mmoSatz.Enabled         := false;
          edtCodeBuchstabe.Enabled := false;
          bbtnCode.Caption        := 'de&kodieren';
          gbxSatz.Caption         := 'kodierter Text:'
       END
    ELSE
       BEGIN
          mmoSatz.Enabled         := true;
          edtCodeBuchstabe.Enabled := true;
          bbtnCode.Caption        := '&kodieren';
          gbxSatz.Caption := 'Geben Sie den zu verschlüsselnden Text ein:'
       END;
   CodeRichtung := -1 * Coderichtung;
end;

end.
PS: im Prinzip müssen doch nur eins, zwei Zeilen verändert werden.. bloß wie?!

r2c2 11. Jan 2007 16:29

Re: Programm zur polyalphabetischen Codierung (aus Vorlage)
 
Da Jenny es nciht für nötig befunden hat Crossposts zu verlinken, mach ich mal die Arbeit anderer Leute:
http://forum.dsdt.info/viewtopic.php?t=32023
http://www.delphi-forum.de/viewtopic.php?t=68558

mfg

Christian

jenny87 11. Jan 2007 21:30

Re: Programm zur polyalphabetischen Codierung (aus Vorlage)
 
Jenny gibt dir gleich n Paar ;)

Um eine möglichst hohe Effiziens und Vielfalt an möglichst qualitativ hochwertigen Antworten zu bekommen, dachte ich, mein Problem in mehreren Foren zu posten... WO ist das Problem -.-

DAnke an alle Helfer :)


edit:
ok ich habe soeben erfahren was "crosspostings" sind und dass sie unbeliebt sind.. sry sry!!

Nevertheless das Problem besteht weiterhin ;)

mkinzler 11. Jan 2007 21:42

Re: Programm zur polyalphabetischen Codierung (aus Vorlage)
 
Zitat:

ok ich habe soeben erfahren was "crosspostings" sind und dass sie unbeliebt sind.. sry sry!!
Du kannst gerne die Frage in mehreren Foren stellen. Es wäre aber gut es bekannt zu geben.
Zu deinem Problem: Du mußt die Codierung nicht für jeden Buchstaben einmal sondern für jeden Buchstaben mit einem anderen Code und zwar den Buchstaben des Codeworts mit Modulo Codewortlänge.

marabu 12. Jan 2007 09:38

Re: Programm zur polyalphabetischen Codierung (aus Vorlage)
 
Herzlich willkommen in der Delphi-PRAXiS, jenny87.

Zitat:

... im Prinzip müssen doch nur eins, zwei Zeilen verändert werden ...
Wenn du das auf die Prozedure Code() beziehst, dann hast du allerdings Recht.

Statt C_Buchstabe brauchst du C_Wort. Da die Verschiebung sich jetzt bei jedem Buchstaben ändert, musst du sie in die FOR-Schleife einbringen und bei ihrer Berechnung musst du natürlich C_Buchstabe geeignet ersetzen.

Freundliche Grüße


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