(De)Crittazione Vigenere - mainunit.pas
Cerca
 
Programmi ~ Forum ~ Blog ~ Community ~ Project Zone ~ Supportaci ~ Feeds    











Ico Feeds
Ico Sondaggio
Google Plus o Facebook?

Facebook
Google Plus

Ico Condividi
Entra nel nostro gruppo su FB!

Ico Supportaci

16,40 €
Visita il negozio
Ico Numeri
Programmi: 2510
Articoli: 585
Progetti: 327
Sorgenti: 3546
Topics: 19195
Membri: 277

mainunit.pas

 Caricato da: A_butta
Scarica il programma completo

  1. unit mainunit;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  9.   StdCtrls, ExtCtrls, Buttons, Grids;
  10.  
  11. type
  12.  
  13.   { TMainForm }
  14.  
  15.   TMainForm = class(TForm)
  16.     Key: TLabeledEdit;
  17.     Chiaro: TLabeledEdit;
  18.     Cifrato: TLabeledEdit;
  19.     Label1: TLabel;
  20.     Report: TMemo;
  21.     SpeedButton1: TSpeedButton;
  22.     SpeedButton2: TSpeedButton;
  23.     StringGrid1: TStringGrid;
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure SpeedButton1Click(Sender: TObject);
  26.     procedure SpeedButton2Click(Sender: TObject);
  27.   private
  28.     { private declarations }
  29.   public
  30.     { public declarations }
  31.   end;
  32.  
  33. var
  34.   MainForm: TMainForm;
  35.  
  36. implementation
  37.  
  38. { TMainForm }
  39.  
  40. function createKey(key,chiaro:string):string;
  41. var s,k:string;
  42.     j:integer;
  43. begin
  44.  j:= 1;
  45.  s:= UpperCase(chiaro);
  46.  k:= UpperCase(key);
  47.  if length(k)>=length(s)
  48.  then
  49.     k:= copy(k,1,length(s))
  50.  else
  51.     while length(k) <> length(s) do
  52.       begin
  53.         k:= k + k[j];
  54.         j:=j+1;
  55.       end;
  56.  result:= k;
  57. end;
  58.  
  59. function Control(str:string):boolean;
  60. var i:integer;
  61.     controllo: boolean;
  62.     car: byte;
  63. begin
  64. controllo := true;
  65. if length(str) = 0 then
  66.    controllo := false
  67. else
  68. for i:= 1 to length(str) do
  69.    begin
  70.       car:= ord(str[i]);
  71.       if not( ((car>64) and (car<91)) or ((car>96) and (car<123))) then
  72.       controllo:= false;
  73.    end;
  74. result:= controllo;
  75. end;
  76.  
  77. procedure TMainForm.SpeedButton1Click(Sender: TObject);
  78. var s,k:string;
  79.     l,i: integer;
  80.     codice: string;
  81.     Rect: TRect;
  82. begin
  83. s:= UpperCase(Chiaro.Text);
  84. if Control(s) and Control(Key.Text) then
  85. begin
  86.  Report.Clear;
  87.  Report.Lines.Add('--- Start Encoding ---');
  88.  Report.Lines.Add('');
  89.  k:= createKey(Key.Text,s);
  90.  for i:= 1 to Length(s) do
  91.  begin
  92.     l:= Ord(s[i]) + Ord(k[i]) - 129;
  93.     if (l>26) then l:=l-26;
  94.     codice:= codice + Chr(l+64);
  95.     Report.Lines.Add('    '+s[i]+' + '+k[i]+' = '+Chr(l+64));
  96.  end;
  97.  Cifrato.Text:= codice;
  98.  Report.Lines.Add('');
  99.  Report.Lines.Add('--- End Encoding ---');
  100. end
  101.    else if not(Control(s)) then
  102.       ShowMessage('Il TESTO IN CHIARO contiene caratteri non alfabetici [A-Z,a-z] o è vuota')
  103.    else
  104.       ShowMessage('La CHIAVE contiene caratteri non alfabetici [A-Z,a-z] o è vuota');
  105.  
  106. end;
  107.  
  108. procedure TMainForm.FormCreate(Sender: TObject);
  109. var i,j,k,car:byte;
  110. begin
  111. k:= 1;
  112.  for i:= 0 to 25 do
  113.   begin
  114.      for j:= 0 to 25 do
  115.          begin
  116.            car := j+k;
  117.            if car>26 then car:= car-26;
  118.            StringGrid1.Cells[i,j]:= Chr(car+64);
  119.          end;
  120.      inc(k);
  121.   end;
  122. end;
  123.  
  124. procedure TMainForm.SpeedButton2Click(Sender: TObject);
  125.  
  126. var s,k:string;
  127.     l,i: integer;
  128.     codice: string;
  129. begin
  130. s:= UpperCase(Cifrato.Text);
  131. if Control(s) and Control(Key.Text) then
  132. begin
  133.  k:= createKey(Key.Text,s);
  134.  for i:= 1 to Length(s) do
  135.      begin
  136.           l:= Ord(s[i]) - Ord(k[i]) +1;
  137.           if (l<0) then l:=l+26;
  138.           codice:= codice + Chr(l+64);
  139.      end;
  140.  Chiaro.Text:= codice;
  141. end
  142.    else if not(Control(s)) then
  143.       ShowMessage('Il TESTO CIFRATO contiene caratteri non alfabetici [A-Z,a-z] o è vuota')
  144.    else
  145.       ShowMessage('La CHIAVE contiene caratteri non alfabetici [A-Z,a-z] o è vuota');
  146. end;
  147.  
  148. initialization
  149.   {$I mainunit.lrs}
  150.  
  151. end.
 

Creative Commons License
Il layout di questo sito è concesso sotto licenza Creative Commons.
Per maggiori informazioni sulle licenze dei contenuti del sito, clicca.