Crypter une chaine de caractère

Version imprimable

21/08/2006, 10h44
davels

Crypter une chaine de caractère

J'ai une chaine de caractère qui peut être composée entre 2 et 10 caractères et j'aimerais qu'elle soit codée/cryptée de telle sorte qu'elle soit incompréhensible par l'utilisateur finale.
Par contre, je voudrais qu'en sortie il ne puisse y avoir que de l'alphanumérique pour ne pas que ce soit trop compliqué!
Je parle de codage/encryption car les données ne sont pas vitale, je veux juste qu'elle soit difficile à comprendre :D
Même si la solution d'encryptage reste la meilleure.

Connaissez vous un composant qui pourrais me convenir?

Sans aller jusqu'au composant, tu peu utiliser un procédé de codage vieux comme le monde, qui s'appelle l'algorythme de Blaise de Vigenère :
http://www.chez.com/algor/vigenere.htm

Voici ce que je te propose :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
function Trans(Ch1,Ch2: Char;Sens:smallint): Char;
var a,b,r:integer;
begin
  a:=Ord(Ch1)-32;
  b:=Ord(Ch2)-32;
  r:=(a+b*sens);
  if r<0 then r:=224+r;
  if r>224 then r:=r-224;
  Result := Chr(r+32);
end;
 
function Code(S,Clef:string):string;
var I,J: Integer;
    S2:string;
begin
  S2:='';
  if (Clef<>'') and (S<>'') then
  begin
    J := 1;
    for I:=1 to Length(s) do
    begin
      S2:=S2+Trans(S[I],Clef[J],-1);
      J:=(J mod Length(Clef)) + 1;
    end;
  end;
  Result:=S2;
end;
 
function Decode(S,Clef:string):string;
var I,J: integer;
    S2:string;
begin
  S2:='';
  if (Clef<>'') and (S<>'') then
  begin
    J := 1;
    for I:=1 to length(S) do
    begin
      S2:=S2+Trans(S[I],Clef[J],1);
      J:=(J mod Length(Clef)) + 1;
    end;
  end;
  Result:=S2;
end;

Utilisation :

Pour Coder avec comme le mot "Coquelicot" comme "mot de passe" :

Code:

1
2
3
4
procedure TForm1.Button2Click(Sender: TObject);
begin
  MotCode:=Code(MotACoder,'Coquelicot');
end;

Et pour le décodage :

Code:

1
2
3
4
procedure TForm1.Button3Click(Sender: TObject);
begin
  MotDecode:=Decode(MotADecoder,'Coquelicot');
end;

Un mot codé avec un certain "mot de passe" ne peut être décodé Qu'avec le même mot de passe.

C'est tout et bon dev ;)

21/08/2006, 13h05
davels

Merci, c'est dans cet optique la que je recherche, il faut maintenant rentrer dans le code et le modifier pour n'obtenir que de l'alphanumérique en sortie :)
Mais je ne suis pas certains que cela soit aussi facile ... :oops:

Si quelqu'un à une solution facile je suis preneur :mouarf: :aie:

Citation:

Envoyé par davels

Merci, c'est dans cet optique la que je recherche, il faut maintenant rentrer dans le code et le modifier pour n'obtenir que de l'alphanumérique en sortie :)
Mais je ne suis pas certains que cela soit aussi facile ... :oops:

Si quelqu'un à une solution facile je suis preneur :mouarf: :aie:

Ce que je t'ai donné ne donne (je te le jure) que des Chiffres et des Lettres (promis, juré, craché par terre, beuark :aie: )

Ca dépend en fait avec quelle police tu utilise là chose : ici on prend en compte les caractères accentués.

Si tu ne veux pas d'accents, en admettant que tu codes des chaines de caractères sans accents, tu remplace la fonction trans par ceci :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 function Trans(Ch1,Ch2: Char;Sens:smallint): Char; const Alphanum='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; var a,b,r, l:integer; begin l:=Length(Alphanum); a:=Pos(Ch1,Alphanum)-1; b:=Pos(Ch2,Alphanum)-1; r:=(a+b*sens); if r<0 then r:=l+r; if r>l then r:=r-l; Result := Alphanum[r+1]; end;
Si tu veux rajouter certains caractères accentués comme é, è, ï, etc...
tu as juste à les ajouter Alphanum...

PS : j'ai pas testé le code, je l'ai écrit "en live" dans l'éditeur de message.

21/08/2006, 14h56
davels

Merci ca fonctionne d'enfer :yaisse:

Par contre, j'ai juste un soucis, ma "phrase" de sortie ne change pas bcp ... mais comme je pense coder sur 10 caractères et combler par des espaces quand il n'y a rien à inclure, je peux toujours décaler mes 2 caractères dans les 10 dispos

Grand merci pour ta solution :)
06/05/2020, 14h41
varilux56

Petit problème.

Bonjour.

J'ai fait un essai avec la première fonction "trans".

Le codage/décodage ne prend pas en compte tous les caractères ou codes ASCII.

Exemple :
Premier essai.

retourne :
PremierĀessai.

L'espace (code 32) n'est pas/mal crypté décrypté.
06/05/2020, 15h36
tourlourou

Bonjour,

Je suppose que le code proposé était compatible exclusivement avec les AnsiString et AnsiChar, et qu'il se trouve en défaut avec les chaînes UTF8 ou UTF16 et des caractères codés sur 1 à 4 octets ou sur 2 octets.
Sous une version Unicode utilisant UTF-8 (Lazarus, par ex.) ou des WideChar (Delphi depuis 2009 ?), il devrait suffire de remplacer les types Char et String par leurs homologues Ansi.
06/05/2020, 16h29
sergio_is_back

Citation:

Envoyé par davels

J'ai une chaine de caractère qui peut être composée entre 2 et 10 caractères et j'aimerais qu'elle soit codée/cryptée de telle sorte qu'elle soit incompréhensible par l'utilisateur finale.
Par contre, je voudrais qu'en sortie il ne puisse y avoir que de l'alphanumérique pour ne pas que ce soit trop compliqué!
Je parle de codage/encryption car les données ne sont pas vitale, je veux juste qu'elle soit difficile à comprendre :D
Même si la solution d'encryptage reste la meilleure.

Connaissez vous un composant qui pourrais me convenir?

En matière de chiffrage les composants LockBox de TurboPower sont très faciles à utiliser : https://sourceforge.net/projects/tplockbox/
Et Open Source en plus, ce qui ne gâche rien

Ils sont disponibles avec GetIt dans les versions récentes de Delphi
06/05/2020, 17h04
varilux56

??

Citation:

Bonjour,

Je suppose que le code proposé était compatible exclusivement avec les AnsiString et AnsiChar, et qu'il se trouve en défaut avec les chaînes UTF8 ou UTF16 et des caractères codés sur 1 à 4 octets ou sur 2 octets.
Sous une version Unicode utilisant UTF-8 (Lazarus, par ex.) ou des WideChar (Delphi depuis 2009 ?), il devrait suffire de remplacer les types Char et String par leurs homologues Ansi.

Je ne pense pas. Le code fourni par LadyWasky ne mentionne rien de particulier sur le codage UTF.
Il y a une erreur de code ou une routine incomplète.

Merci sergio_is_back je vais aller voir.
Je voudrais bien utiliser les routines de LadyWasky car elles sont simples. Il y a juste une correction à faire.

PS : L'autre routine "trans" présente le même problème.
06/05/2020, 18h00
tourlourou

Effectivement, si r vaut 224, l'ajout de 32 conduit au caractère nul et la chaîne s'affiche tronquée. problème réglé avec le test if r >= 224 au lieu de simplement > 224.
06/05/2020, 22h37
Paul TOTH

tu peux utiliser ceci
http://lookinside.free.fr/delphi.php?Cryptage

ce n'est pas parfait, j'ai ouïe dire qu'il y avait des failles dans le système, mais ça rend les chose un peu compliquées, et c'est ce que tu cherches je crois...petit bonus, les données étant liées au poste, tu ne peux pas décoder la chaîne depuis un autre PC.

et pour ce qui est du format texte, le plus simple est de convertir le résultat en Base64
07/05/2020, 11h56
varilux56

Merci Paul.

J'ai trouvé un code qui ressemble à celui de LadyWasky qui fonctionne très bien et que j'ai un peu modifié pour qu'il intègre la totalité de la table ASCII.

Je met à résolut.
15/05/2020, 20h51
Coussati

Citation:

Envoyé par varilux56

Merci Paul.

J'ai trouvé un code qui ressemble à celui de LadyWasky qui fonctionne très bien et que j'ai un peu modifié pour qu'il intègre la totalité de la table ASCII.

Je met à résolut.

N'hésite pas à nous le partager, ça pourrait servir à d'autres ;)

Source

Voici.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Procedure ConstruireAlphanum;
Var
   I      : Integer;
Begin
  // Alphanum :='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz .àèéç-_=,;:/\!?';
  // Exit;
   Alphanum := '';
   For I:= 32 To 126 Do Alphanum := Concat(Alphanum,Char(I));
   Alphanum := Alphanum + 'éèàçùûïê';
end;
//---------------------------------------------------------------------------
Function Code(S,Clef:STring):STring;
 
Var
   S2:String;
   LClef,L,LLEttres,i,j,k,n:Byte;
 
Begin
   Result := S;
   LClef:=LENGTH(Clef);
   If Not Crypte Then EXIT;
   LLettres:=LENGTH(Alphanum);
   L:=LENGTH(S);
   S2:='';
   For i:=1 TO L DO
    Begin
       j:=1+(i-1) mod LClef;
       k:=POS(Clef[j],Alphanum)-1;
       n:=POS(S[i],Alphanum);
       S2:=S2+Alphanum[1+(n+k-1) MOD LLettres]
    End;
 
   Result:=S2
END;
//---------------------------------------------------------------------------
Function Decode(S,Clef:STring):STring;
 
Var
  S2:String;
  LClef,L,LLEttres,i,j,k,n:Byte;
 
Begin
   Result := S;
   LClef:=LENGTH(Clef);
   If Not Crypte Then EXIT;
   LLettres:=LENGTH(Alphanum);
   L:=LENGTH(S);
   S2:='';
 
   For i:=1 TO L Do
    Begin
       j:=1+(i-1) mod LClef;
       k:=POS(Clef[j],Alphanum)-1;
       n:=POS(S[i],Alphanum);
       S2:=S2+Alphanum[1+(LLettres+n-k-1) MOD LLettres];
    End;
   Result:=S2
END;

Bonjour,

j'ai testé ton code (avec quelques modifs car cela plantait) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
//---------------------------------------------------------------------------
//     Coded : Boolean ;   Variable globale : vrai si le texte à été codé
//---------------------------------------------------------------------------
Function Alphanum : String ;
Var
   I      : Integer;
   Chaine : String ;
Begin
  // Alphanum :='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz .àèéç-_=,;:/\!?';
   Chaine := '';
   For I := 32 To 126 Do Chaine := Chaine + Char(I);
   Chaine := Chaine + 'éèàçùûïê';
   Result := Chaine ;
end;
//---------------------------------------------------------------------------
Function Code(S, Clef:String): String;
Var
   S2:String ;
   LClef, L, LLettres, i, j, k, n : Byte ;
   Alpha : String ;
Begin
   Alpha := AlphaNum ;
   Result := S ;
   LClef := Length(Clef) ;
//   If Not Crypte Then Exit ;
   LLettres := Length(Alpha) ;
   L := Length(S) ;
   S2 := '' ;
   For i:= 1 To L Do
    Begin
       j := 1 + (i-1) Mod LClef ;
       k := Pos(Clef[j], Alpha) - 1 ;
       n := Pos(S[i], Alpha) ;
       S2 := S2 + Alpha[1+(n + k - 1) Mod LLettres]
    End;
   Result := S2 ;
End;
//---------------------------------------------------------------------------
Function Decode(S, Clef:String):String;
Var
  Alpha : String ;
  S2 : String;
  LClef, L, LLEttres, i, j, k, n : Byte ;
Begin
   Alpha := AlphaNum ;
   Result := S ;
   LClef:=Length(Clef) ;
//   If Not Crypte Then Exit ;
   LLettres := Length(Alpha) ;
   L := Length(S) ;
   S2 := '' ;
   For i := 1 To L Do
    Begin
       j := 1 + (i-1) Mod LClef ;
       k := Pos(Clef[j], Alpha)-1 ;
       n := Pos(S[i], Alpha) ;
       S2 := S2 + Alphanum[1 + (LLettres + n - k - 1) Mod LLettres];
    End;
   Result := S2 ;
End;
//---------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
  Coded := False ;
end;
//---------------------------------------------------------------------------
procedure TForm1.Button5Click(Sender: TObject);
// Codage et décodage de Edit5.text
begin
  If Coded Then
    Begin
      Edit5.Text := Decode(Edit5.Text, 'Bizarre') ;
      Coded := True ;
    End
  Else
    Begin
      Edit5.Text := Code(Edit5.Text, 'Bizarre') ;
      Coded := False ;
    End  ;
end;
//---------------------------------------------------------------------------

ça crypte bien, mais cela ne décrypte pas ?

A+
Charly

Ah comme ceci ça va mieux !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
procedure TForm1.Button5Click(Sender: TObject);
// Codage et décodage de Edit5.text
Var
  MotCode, MotACoder : String ;
begin
  If Coded Then
    Begin
      MotACoder := Edit5.Text ;
      MotCode := DeCode(MotACoder,'Bizarre');
      Edit5.Text := MotCode ;
      Coded := False ;
    End
  Else
    Begin
      MotACoder := Edit5.Text ;
      MotCode := Code(MotACoder,'Bizarre');
      Edit5.Text := MotCode ;
      Coded := True ;
    End  ;
end;