Soyez le premier à donner votre avis sur cette source.
Vue 12 123 fois - Téléchargée 1 214 fois
/////////////////////////////////////////////////////////// // Fichier : uTransposition.pas // // Auteur : Stéphane Haimet // // Date de création : 01/02/08 // // Date de modification : 15/02/08 // /////////////////////////////////////////////////////////// unit uTransposition; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, uFonctions; type TForm1 = class(TForm) eMessage: TEdit; Label1: TLabel; Label2: TLabel; eCle: TEdit; bCrypter: TBitBtn; bFermer: TBitBtn; eResultat: TEdit; Label3: TLabel; bDecrypter: TBitBtn; procedure eCleChange(Sender: TObject); procedure eMessageChange(Sender: TObject); procedure bCrypterClick(Sender: TObject); procedure bDecrypterClick(Sender: TObject); private { Déclarations privées } public { Déclarations publiques } end; var Form1: TForm1; implementation {$R *.dfm} //Quand on fait un changement dans eCle procedure TForm1.eCleChange(Sender: TObject); begin eResultat.Text:=''; //on efface le résultat end; //Quand on fait un changement dans eMessage procedure TForm1.eMessageChange(Sender: TObject); var verif : string; begin eResultat.Text:=''; //on efface le résultat end; //Quand on clique sur le bouton 'crypter' procedure TForm1.bCrypterClick(Sender: TObject); var cle , chaineBloc, chaineBlocResultat : string[8]; message, chaineFinale, varVerifMessage, varVerifCle : string; i, j, nbBloc, longeurCourteChaine : integer; begin //On vérifie tout d'abord si la clé et le message sont corrects varVerifCle:=verifCle(eCle.text); varVerifMessage:=verifMessage(eMessage.Text); if((varVerifCle<>'ok') or (varVerifMessage<>'ok') or (eCle.text='') or (eMessage.Text='')) then begin messagedlg('Le message doit contenir des caractères compris entre A et Z ainsi que l''espace.La clé doit contenir les chiffres de 1 à 8', mtWarning, [mbOk], 0); end else begin message := eMessage.Text; message := mettreEnMajuscule(message); eMessage.text:=message; cle := eCle.Text; chaineFinale:=''; chaineBlocResultat:='00000000'; //On remplace tous les espaces par des 0 for i:=1 to length(message) do begin if (message[i]=' ') then message[i]:='0'; end; if((length(message))mod 8<>0) then nbBloc:=trunc(length(message)/8)+1 //On regarde combien on a de bloc de 8char else nbBloc:=trunc(length(message)/8); //Si la longueur du message est multiple de 8 //On parcourt les blocs un par un for i:=1 to nbBloc do begin chaineBloc:=copy(message,(i*8-7),8); //Si on a la derniere chaine avec moins de 8 char, on rajoute des '0' à la fin if (length(chaineBloc)<8) then begin longeurCourteChaine:=8-length(chaineBloc); for j:=1 to longeurCourteChaine do chaineBloc:=chaineBloc+'0'; end; //On remplace les caractère par rapport à la clé for j:=1 to 8 do begin chaineBlocResultat[j]:=chaineBloc[strtoint(cle[j])]; end; chaineFinale:=chaineFinale+chaineBlocResultat; //On affect au résultat end; eResultat.Text:=chaineFinale; //Affichage du résultat end; end; procedure TForm1.bDecrypterClick(Sender: TObject); var cle , chaineBloc, chaineBlocResultat : string[8]; message, chaineFinale, varVerifMessage, varVerifCle : string; i, j, nbBloc : integer; begin //On vérifie tout d'abord si la clé et le message sont corrects varVerifCle:=verifCle(eCle.text); varVerifMessage:=verifMessage(eMessage.Text); if((varVerifCle<>'ok') or (varVerifMessage<>'ok') or (eCle.text='') or (eMessage.Text='')) then begin messagedlg('Le message doit contenir des caractères compris entre A et Z ainsi que l''espace.La clé doit contenir les chiffres de 1 à 8', mtWarning, [mbOk], 0); end else begin message := eMessage.Text; message := mettreEnMajuscule(message); eMessage.text:=message; cle := eCle.Text; chaineFinale:=''; chaineBlocResultat:='00000000'; //Si on a pas une longueur de message multiple de 8, c'est qu'on a une erreur if((length(message))mod 8<>0) then messagedlg('Le message à décrypter est erroné', mtWarning, [mbOk],0) else begin nbBloc:=trunc(length(message)/8); //Si la longueur du message est multiple de 8 //On parcourt les blocs un par un for i:=1 to nbBloc do begin chaineBloc:=copy(message,(i*8-7),8); //On remplace les caractère par rapport à la clé for j:=1 to 8 do begin chaineBlocResultat[strtoint(cle[j])]:=chaineBloc[j]; end; chaineFinale:=chaineFinale+chaineBlocResultat; //On affect au résultat end; //On remplace les 0 par des espaces : for i:=1 to length(chaineFinale) do begin if(chaineFinale[i]='0') then chaineFinale[i]:=' '; end; eResultat.Text:=chaineFinale; //Affichage du résultat end; end; end; end.
12345678 => ne change rien
13245678 => inverse seulement 2 caractères
et toutes les clefs qui comportent 3 chiffres consécutifs l'un après l'autre (123, 678, 345, ...).
Bref, il doit rester quatre ou cinq clefs valables, qu'il suffit de tester ... En plus l'algo répète la clef ... ouch.
Côté sécurité, ça marchait peut-être du temps de César mais là on sait faire mieux :)
(Je ne critique pas le code, mais uniquement le principe de l'algorithme)
Cordialement, Bacterius !
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.