Accueil > > > COMPOSANT : TDBPVERNAM (CRYPTEUR DE TEXTE/FICHIER)
COMPOSANT : TDBPVERNAM (CRYPTEUR DE TEXTE/FICHIER)
Information sur la source
Description
Hello, 4eme source parlant du Vernam (j'en connais un qui va etre content :D) Ce composant reprends les fonctions de cryptage Vernam de Mauricio, autant pour les fichiers que pour le texte. Ses fonctions ont été une améliorations de la source de RM50Man. Une demo est dispo dans le zip. Voyez l'utilisation (simple) du composant grace a cette demo. <pub> Dispo aussi sur http://diabloporc.free.fr :D </pub>
Source
- {
- ################################################################################
- # DBPVERNAM #
- ################################################################################
- # #
- # VERSION : 1.2 #
- # FICHIERS : dbpVernam.pas,.dcu,.dcr,.bmp,ReadMe.htm #
- # AUTEUR : Julio P. (Diabloporc) #
- # CREATION : 09 dec 2004 #
- # MODIFIEE : 10 dec 2004 #
- # SITE WEB : http://diabloporc.free.fr #
- # MAIL : diabloporc@laposte.net #
- # LEGAL : Free sous Licence GNU/GPL #
- # INFOS : Retrouvez moi sur www.delphifr.com : "JulioDelphi" #
- # #
- ################################################################################
- }
-
- unit dbpVernam;
-
- interface
-
- uses
- Math, SysUtils, Classes;
-
- type
- TdbpVernam = class(TComponent)
- private
- fText, fTextEncode, fTextDecode, fTextCle, fAbout: string;
- fFile, fFileEncoded, fFileDecoded, fFileKey: TFileName;
- fUseTextCle, fUseFileKey: boolean;
-
- procedure SetFile(const Value: TFileName);
- procedure SetFileEncoded(const Value: TFileName);
- procedure setFileDecoded(const Value: TFileName);
- procedure SetFileKey(const Value: TFileName);
- procedure SetAbout(const Value: string);
-
- protected
- { Protected declarations }
- public
- constructor Create(AOwner: TComponent); override;
- published
- property About: String read fAbout write SetAbout;
- property Fichier: TFileName read fFile write SetFile;
- property FichierEncode: TFileName read fFileEncoded write SetFileEncoded;
- property FichierDecode: TFileName read fFileDecoded write SetFileDecoded;
- property FichierCle: TFileName read fFileKey write SetFileKey;
- property UtiliserFichierCle: boolean read fUseFileKey write fUseFileKey;
- property Text: string read fText write fText;
- property TextEncode: string read fTextEncode write fTextEncode;
- property TextDecode: string read fTextDecode write fTextDecode;
- property TextCle: string read fTextCle write fTextCle;
- property UtiliserTextCle: boolean read fUseTextCle write fUseTextCle;
-
- function EncodeFichier: boolean;
- function DecodeFichier: boolean;
- function EncodeText: boolean;
- function DecodeText: boolean;
- end;
-
- procedure Register;
-
- implementation
- {$R dbpVernam.dcr}
-
- procedure VERNAM_CRYPT_FILE(Src, Dest, Chave: TFileName);
- var fs_Src, fs_Dest, fs_Chave: TFileStream;
- fs_Src_Buffer, fs_Dest_Buffer, fs_Chave_Buffer: Array[0..1023] of byte; // Buffers de 1Ko ...
- fs_Buffer_size: Int64;
- i: Integer;
- begin
- Randomize;
- fs_Src := TFileStream.Create(Src, fmOpenRead or fmShareDenyWrite);
- fs_Dest := TFileStream.Create(Dest, fmCreate or fmShareExclusive);
- fs_Chave := TFileStream.Create(Chave, fmCreate or fmShareExclusive);
-
- Try
- While fs_Src.Position < fs_Src.Size Do
- begin
- fs_Buffer_size := fs_Src.Size - fs_Src.Position;
-
- If fs_Buffer_size > 1024
- Then fs_Buffer_size := 1024;
-
- fs_Src.Read(fs_Src_Buffer, fs_Buffer_size);
-
- for i := 0 to fs_Buffer_size - 1 do
- begin
- fs_Chave_Buffer[i] := RandomRange(0, 247); // 1 byte = 8bits (1 octet en français) donc valeur max. est de 11111111 en binaire = 247 en décimal ...
- fs_Dest_Buffer[i] := fs_Chave_Buffer[i] XOR fs_Src_Buffer[i];
- end;
-
- fs_Chave.Write(fs_Chave_Buffer, fs_Buffer_size);
- fs_Dest.Write(fs_Dest_Buffer, fs_Buffer_size);
- end;
- Finally
- fs_Src.Free;
- fs_Dest.Free;
- fs_Chave.Free;
- End;
- end;
-
- procedure VERNAM_CRYPT_FILE_WITH_PREDEF_KEY(Src, Dest, Chave: TFileName);
- var fs_Src, fs_Dest, fs_Chave: TFileStream;
- fs_Src_Buffer, fs_Dest_Buffer, fs_Chave_Buffer, fs_Chave_Buffer2: Array[0..1023] of byte; // Buffers de 1Ko ...
- fs_Src_Buffer_size, fs_Chave_Buffer_size, TransfBytes: Int64;
- i: Integer;
- begin
- Randomize;
- fs_Src := TFileStream.Create(Src, fmOpenRead or fmShareDenyWrite);
- fs_Dest := TFileStream.Create(Dest, fmCreate or fmShareExclusive);
- fs_Chave := TFileStream.Create(Chave, fmOpenRead or fmShareDenyWrite);
-
- Try
- While fs_Src.Position < fs_Src.Size Do
- begin
- fs_Src_Buffer_size := fs_Src.Size - fs_Src.Position;
- If fs_Src_Buffer_size > 1024
- Then fs_Src_Buffer_size := 1024;
- fs_Src.Read(fs_Src_Buffer, fs_Src_Buffer_size);
-
- // On doit contrôler la lecture du fichier clé parce que celui-ci peut être + petit que le fichier crypté !
- fs_Chave_Buffer_size := 0;
- While fs_Chave_Buffer_size < fs_Src_Buffer_size do // On doit avoir le meme nombre de bytes ...
- begin
- TransfBytes := fs_Chave.Size - fs_Chave.Position; // Bytes dispo à lire dans le fichier clé ...
-
- If TransfBytes = 0 // On est à la fin du fichier clé ...
- Then Begin
- fs_Chave.Seek(0, soFromBeginning);
- TransfBytes := fs_Chave.Size;
- End;
-
- If TransfBytes + fs_Chave_Buffer_size > fs_Src_Buffer_size
- Then TransfBytes := fs_Src_Buffer_size - fs_Chave_Buffer_size;
-
- fs_Chave.Read(fs_Chave_Buffer2, TransfBytes); // Mémoire temporaire pour transférer vers fs_Chave_Buffer ...
-
- for i := 0 to TransfBytes - 1 do // Compléter le buffer de la clé ...
- fs_Chave_Buffer[fs_Chave_Buffer_size + i] := fs_Chave_Buffer2[i];
-
- fs_Chave_Buffer_size := fs_Chave_Buffer_size + TransfBytes;
- end;
-
- for i := 0 to fs_Src_Buffer_size - 1 do
- fs_Dest_Buffer[i] := fs_Chave_Buffer[i] XOR fs_Src_Buffer[i];
-
- fs_Dest.Write(fs_Dest_Buffer, fs_Src_Buffer_size);
- end;
- Finally
- fs_Src.Free;
- fs_Dest.Free;
- fs_Chave.Free;
- End;
- end;
-
- procedure VERNAM_DECRYPT_FILE(Src, Dest, Chave: TFileName);
- var fs_Src, fs_Dest, fs_Chave: TFileStream;
- fs_Src_Buffer, fs_Dest_Buffer, fs_Chave_Buffer, fs_Chave_Buffer2: Array[0..1023] of byte; // Buffers de 1Ko ...
- fs_Src_Buffer_size, fs_Chave_Buffer_size, TransfBytes: Int64;
- i: Integer;
- begin
- fs_Src := TFileStream.Create(Src, fmOpenRead or fmShareDenyWrite);
- fs_Dest := TFileStream.Create(Dest, fmCreate or fmShareExclusive);
- fs_Chave := TFileStream.Create(Chave, fmOpenRead or fmShareDenyWrite);
-
- Try
- While fs_Src.Position < fs_Src.Size Do
- begin
- fs_Src_Buffer_size := fs_Src.Size - fs_Src.Position;
- If fs_Src_Buffer_size > 1024
- Then fs_Src_Buffer_size := 1024;
- fs_Src.Read(fs_Src_Buffer, fs_Src_Buffer_size);
-
- // On doit contrôler la lecture du fichier clé parce que celui-ci peut être + petit que le fichier crypté !
- fs_Chave_Buffer_size := 0;
- While fs_Chave_Buffer_size < fs_Src_Buffer_size do
- begin
- TransfBytes := fs_Chave.Size - fs_Chave.Position; // Bytes dispo à lire dans le fichier clé ...
-
- If TransfBytes = 0 // On est à la fin du fichier clé ...
- Then Begin
- fs_Chave.Seek(0, soFromBeginning);
- TransfBytes := fs_Chave.Size;
- End;
-
- If TransfBytes + fs_Chave_Buffer_size > fs_Src_Buffer_size
- Then TransfBytes := fs_Src_Buffer_size - fs_Chave_Buffer_size;
-
- fs_Chave.Read(fs_Chave_Buffer2, TransfBytes); // Mémoire temporaire pour transférer vers fs_Chave_Buffer ...
-
- for i := 0 to TransfBytes - 1 do // Compléter le buffer de la clé ...
- fs_Chave_Buffer[fs_Chave_Buffer_size + i] := fs_Chave_Buffer2[i];
-
- fs_Chave_Buffer_size := fs_Chave_Buffer_size + TransfBytes;
- end;
-
- for i := 0 to fs_Src_Buffer_size - 1 do
- fs_Dest_Buffer[i] := fs_Chave_Buffer[i] XOR fs_Src_Buffer[i];
-
- fs_Dest.Write(fs_Dest_Buffer, fs_Src_Buffer_size);
- end;
- Finally
- fs_Src.Free;
- fs_Dest.Free;
- fs_Chave.Free;
- End;
- end;
-
- function VERNAM_CRYPT(Texto: String; Var Chave: String): String;
- var i, curOrd: Integer;
- RandomVal : byte;
- begin
- RESULT := '';
- Chave := '';
- Randomize;
-
- for i := 1 to length(Texto) do
- begin
- repeat
- RandomVal := RandomRange(1, 127);
- curOrd := Ord(Texto[i]) XOR RandomVal;
- until curOrd <> 0; // Ça foire si curOrd = 0 (Quand Ord(Texto[i]) = RandomVal) parce que chr(0) n' existe pas !!!
-
- RESULT := RESULT + Chr(curOrd);
- Chave := Chave + chr(RandomVal);
- end;
- end;
-
- function VERNAM_CRYPT_WITH_PREDEF_KEY(Texto: String; Chave: String): String;
- var i, curOrd, lengthChave, lengthTexto, repetir: Integer;
- begin
- RESULT := '';
-
- if chave = '' then chave := 'a'; // Mettre qque chose sinon ça va foiré ...
-
- lengthChave := length(Chave);
- lengthTexto := length(Texto);
-
- if lengthChave < lengthTexto // La taille de la clé doit être au moins aussi grande que le message crypté ...
- then begin
- Repetir := 1;
- for i := lengthChave + 1 to lengthTexto do
- begin
- Chave := chave + chave[Repetir];
-
- if Repetir < lengthChave
- then Repetir := Repetir + 1
- else Repetir := 1;
- end;
- end;
-
- for i := 1 to length(Texto) do
- begin
- curOrd := Ord(Texto[i]) XOR Ord(Chave[i]);
-
- if curOrd = 0 // Ça arrive quand Texto[i] = Chave[i] ...
- then curOrd := Ord(Texto[i]); // Chr(0) n' existe pas, donc on peut pas coder ce caractere ...
-
- RESULT := RESULT + Chr(curOrd);
- end;
- end;
-
- function VERNAM_DECRYPT(Criptado, Chave: String): String;
- var i, repetir, curOrd, lengthChave, lengthTexto: Integer;
- begin
- RESULT := '';
-
- if chave = '' then chave := 'a';
-
- lengthChave := length(Chave);
- lengthTexto := length(Criptado);
-
- if lengthChave < lengthTexto
- then begin
- Repetir := 1;
- for i := lengthChave + 1 to lengthTexto do
- begin
- Chave := chave + chave[Repetir];
-
- if Repetir < lengthChave
- then Repetir := Repetir + 1
- else Repetir := 1;
- end;
- end;
-
- for i := 1 to lengthTexto do
- begin
- curOrd := Ord(Criptado[i]) XOR Ord(Chave[i]);
-
- if curOrd = 0 // On est dans le cas où Texto[i] était égal à Chave[i] ...
- then curOrd := Ord(Criptado[i]); // Donc, la lettre ne fut pas cryptée ...
-
- RESULT := RESULT + Chr(curOrd);
- end;
- end;
-
- procedure TdbpVernam.SetAbout;
- begin
- // rien
- end;
-
- constructor TdbpVernam.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FAbout := 'v1.2 par Julio P. (Diabloporc), Mauricio (Fafe Portugal), RM50Man';
- fFile := '';
- fFileEncoded := '';
- fFileDecoded := '';
- fFileKey := '';
- fUseFileKey := false;
- fUseTextCle := false;
- end;
-
- procedure Register;
- begin
- RegisterComponents('Diabloporc', [TdbpVernam]);
- end;
-
- procedure TdbpVernam.SetFile(const Value: TFileName);
- begin
- if (not fileexists(Value)) and (length(value)>0) then exit;
- fFile := Value;
- end;
-
- procedure TdbpVernam.SetFileDecoded(const Value: TFileName);
- begin
- if fFileDecoded=Value then exit;
- fFileDecoded := Value;
- end;
-
- procedure TdbpVernam.SetFileEncoded(const Value: TFileName);
- begin
- if fFileEncoded=Value then exit;
- fFileEncoded := Value;
- end;
-
- procedure TdbpVernam.SetFileKey(const Value: TFileName);
- begin
- if (not fileexists(Value)) and (length(value)>0) then exit;
- fFileKey := Value;
- end;
-
- function TdbpVernam.EncodeFichier: boolean;
- begin
- if fFile='' then begin result := false; exit; end;
- if fUseFileKey then
- begin
- if fFileKey='' then begin result := false; exit; end;
- VERNAM_CRYPT_FILE_WITH_PREDEF_KEY(fFile, fFileEncoded+'.vn', fFileKey);
- end
- else
- VERNAM_CRYPT_FILE(fFile, fFileEncoded+'.vn', fFile+'.vnk');
-
- result := fileexists(fFileEncoded+'.vn');
- end;
-
- function TdbpVernam.DecodeFichier: boolean;
- begin
- if (fFile='') or (fFileKey='') then begin result := false; exit; end;
- VERNAM_DECRYPT_FILE(fFile, fFileDecoded, fFileKey);
- result := fileexists(fFileDecoded);
- end;
-
- function TdbpVernam.DecodeText: boolean;
- begin
- if (fText='') then begin result := false; exit; end;
- fTextDecode := '';
- fTextDecode := VERNAM_DECRYPT(fText, fTextCle);
- result := fTextDecode <> '';
- end;
-
- function TdbpVernam.EncodeText: boolean;
- begin
- if (fText='') then begin result := false; exit; end;
- if not fUseTextCle then
- begin
- fTextEncode := '';
- fTextEncode := VERNAM_CRYPT(fText, fTextCle);
- result := fTextEncode <> '';
- end
- else
- begin
- fTextEncode := '';
- fTextEncode := VERNAM_CRYPT_WITH_PREDEF_KEY(fText, fTextCle);
- result := fTextEncode <> '';
- end;
- end;
-
- end.
{
################################################################################
# DBPVERNAM #
################################################################################
# #
# VERSION : 1.2 #
# FICHIERS : dbpVernam.pas,.dcu,.dcr,.bmp,ReadMe.htm #
# AUTEUR : Julio P. (Diabloporc) #
# CREATION : 09 dec 2004 #
# MODIFIEE : 10 dec 2004 #
# SITE WEB : http://diabloporc.free.fr #
# MAIL : diabloporc@laposte.net #
# LEGAL : Free sous Licence GNU/GPL #
# INFOS : Retrouvez moi sur www.delphifr.com : "JulioDelphi" #
# #
################################################################################
}
unit dbpVernam;
interface
uses
Math, SysUtils, Classes;
type
TdbpVernam = class(TComponent)
private
fText, fTextEncode, fTextDecode, fTextCle, fAbout: string;
fFile, fFileEncoded, fFileDecoded, fFileKey: TFileName;
fUseTextCle, fUseFileKey: boolean;
procedure SetFile(const Value: TFileName);
procedure SetFileEncoded(const Value: TFileName);
procedure setFileDecoded(const Value: TFileName);
procedure SetFileKey(const Value: TFileName);
procedure SetAbout(const Value: string);
protected
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
published
property About: String read fAbout write SetAbout;
property Fichier: TFileName read fFile write SetFile;
property FichierEncode: TFileName read fFileEncoded write SetFileEncoded;
property FichierDecode: TFileName read fFileDecoded write SetFileDecoded;
property FichierCle: TFileName read fFileKey write SetFileKey;
property UtiliserFichierCle: boolean read fUseFileKey write fUseFileKey;
property Text: string read fText write fText;
property TextEncode: string read fTextEncode write fTextEncode;
property TextDecode: string read fTextDecode write fTextDecode;
property TextCle: string read fTextCle write fTextCle;
property UtiliserTextCle: boolean read fUseTextCle write fUseTextCle;
function EncodeFichier: boolean;
function DecodeFichier: boolean;
function EncodeText: boolean;
function DecodeText: boolean;
end;
procedure Register;
implementation
{$R dbpVernam.dcr}
procedure VERNAM_CRYPT_FILE(Src, Dest, Chave: TFileName);
var fs_Src, fs_Dest, fs_Chave: TFileStream;
fs_Src_Buffer, fs_Dest_Buffer, fs_Chave_Buffer: Array[0..1023] of byte; // Buffers de 1Ko ...
fs_Buffer_size: Int64;
i: Integer;
begin
Randomize;
fs_Src := TFileStream.Create(Src, fmOpenRead or fmShareDenyWrite);
fs_Dest := TFileStream.Create(Dest, fmCreate or fmShareExclusive);
fs_Chave := TFileStream.Create(Chave, fmCreate or fmShareExclusive);
Try
While fs_Src.Position < fs_Src.Size Do
begin
fs_Buffer_size := fs_Src.Size - fs_Src.Position;
If fs_Buffer_size > 1024
Then fs_Buffer_size := 1024;
fs_Src.Read(fs_Src_Buffer, fs_Buffer_size);
for i := 0 to fs_Buffer_size - 1 do
begin
fs_Chave_Buffer[i] := RandomRange(0, 247); // 1 byte = 8bits (1 octet en français) donc valeur max. est de 11111111 en binaire = 247 en décimal ...
fs_Dest_Buffer[i] := fs_Chave_Buffer[i] XOR fs_Src_Buffer[i];
end;
fs_Chave.Write(fs_Chave_Buffer, fs_Buffer_size);
fs_Dest.Write(fs_Dest_Buffer, fs_Buffer_size);
end;
Finally
fs_Src.Free;
fs_Dest.Free;
fs_Chave.Free;
End;
end;
procedure VERNAM_CRYPT_FILE_WITH_PREDEF_KEY(Src, Dest, Chave: TFileName);
var fs_Src, fs_Dest, fs_Chave: TFileStream;
fs_Src_Buffer, fs_Dest_Buffer, fs_Chave_Buffer, fs_Chave_Buffer2: Array[0..1023] of byte; // Buffers de 1Ko ...
fs_Src_Buffer_size, fs_Chave_Buffer_size, TransfBytes: Int64;
i: Integer;
begin
Randomize;
fs_Src := TFileStream.Create(Src, fmOpenRead or fmShareDenyWrite);
fs_Dest := TFileStream.Create(Dest, fmCreate or fmShareExclusive);
fs_Chave := TFileStream.Create(Chave, fmOpenRead or fmShareDenyWrite);
Try
While fs_Src.Position < fs_Src.Size Do
begin
fs_Src_Buffer_size := fs_Src.Size - fs_Src.Position;
If fs_Src_Buffer_size > 1024
Then fs_Src_Buffer_size := 1024;
fs_Src.Read(fs_Src_Buffer, fs_Src_Buffer_size);
// On doit contrôler la lecture du fichier clé parce que celui-ci peut être + petit que le fichier crypté !
fs_Chave_Buffer_size := 0;
While fs_Chave_Buffer_size < fs_Src_Buffer_size do // On doit avoir le meme nombre de bytes ...
begin
TransfBytes := fs_Chave.Size - fs_Chave.Position; // Bytes dispo à lire dans le fichier clé ...
If TransfBytes = 0 // On est à la fin du fichier clé ...
Then Begin
fs_Chave.Seek(0, soFromBeginning);
TransfBytes := fs_Chave.Size;
End;
If TransfBytes + fs_Chave_Buffer_size > fs_Src_Buffer_size
Then TransfBytes := fs_Src_Buffer_size - fs_Chave_Buffer_size;
fs_Chave.Read(fs_Chave_Buffer2, TransfBytes); // Mémoire temporaire pour transférer vers fs_Chave_Buffer ...
for i := 0 to TransfBytes - 1 do // Compléter le buffer de la clé ...
fs_Chave_Buffer[fs_Chave_Buffer_size + i] := fs_Chave_Buffer2[i];
fs_Chave_Buffer_size := fs_Chave_Buffer_size + TransfBytes;
end;
for i := 0 to fs_Src_Buffer_size - 1 do
fs_Dest_Buffer[i] := fs_Chave_Buffer[i] XOR fs_Src_Buffer[i];
fs_Dest.Write(fs_Dest_Buffer, fs_Src_Buffer_size);
end;
Finally
fs_Src.Free;
fs_Dest.Free;
fs_Chave.Free;
End;
end;
procedure VERNAM_DECRYPT_FILE(Src, Dest, Chave: TFileName);
var fs_Src, fs_Dest, fs_Chave: TFileStream;
fs_Src_Buffer, fs_Dest_Buffer, fs_Chave_Buffer, fs_Chave_Buffer2: Array[0..1023] of byte; // Buffers de 1Ko ...
fs_Src_Buffer_size, fs_Chave_Buffer_size, TransfBytes: Int64;
i: Integer;
begin
fs_Src := TFileStream.Create(Src, fmOpenRead or fmShareDenyWrite);
fs_Dest := TFileStream.Create(Dest, fmCreate or fmShareExclusive);
fs_Chave := TFileStream.Create(Chave, fmOpenRead or fmShareDenyWrite);
Try
While fs_Src.Position < fs_Src.Size Do
begin
fs_Src_Buffer_size := fs_Src.Size - fs_Src.Position;
If fs_Src_Buffer_size > 1024
Then fs_Src_Buffer_size := 1024;
fs_Src.Read(fs_Src_Buffer, fs_Src_Buffer_size);
// On doit contrôler la lecture du fichier clé parce que celui-ci peut être + petit que le fichier crypté !
fs_Chave_Buffer_size := 0;
While fs_Chave_Buffer_size < fs_Src_Buffer_size do
begin
TransfBytes := fs_Chave.Size - fs_Chave.Position; // Bytes dispo à lire dans le fichier clé ...
If TransfBytes = 0 // On est à la fin du fichier clé ...
Then Begin
fs_Chave.Seek(0, soFromBeginning);
TransfBytes := fs_Chave.Size;
End;
If TransfBytes + fs_Chave_Buffer_size > fs_Src_Buffer_size
Then TransfBytes := fs_Src_Buffer_size - fs_Chave_Buffer_size;
fs_Chave.Read(fs_Chave_Buffer2, TransfBytes); // Mémoire temporaire pour transférer vers fs_Chave_Buffer ...
for i := 0 to TransfBytes - 1 do // Compléter le buffer de la clé ...
fs_Chave_Buffer[fs_Chave_Buffer_size + i] := fs_Chave_Buffer2[i];
fs_Chave_Buffer_size := fs_Chave_Buffer_size + TransfBytes;
end;
for i := 0 to fs_Src_Buffer_size - 1 do
fs_Dest_Buffer[i] := fs_Chave_Buffer[i] XOR fs_Src_Buffer[i];
fs_Dest.Write(fs_Dest_Buffer, fs_Src_Buffer_size);
end;
Finally
fs_Src.Free;
fs_Dest.Free;
fs_Chave.Free;
End;
end;
function VERNAM_CRYPT(Texto: String; Var Chave: String): String;
var i, curOrd: Integer;
RandomVal : byte;
begin
RESULT := '';
Chave := '';
Randomize;
for i := 1 to length(Texto) do
begin
repeat
RandomVal := RandomRange(1, 127);
curOrd := Ord(Texto[i]) XOR RandomVal;
until curOrd <> 0; // Ça foire si curOrd = 0 (Quand Ord(Texto[i]) = RandomVal) parce que chr(0) n' existe pas !!!
RESULT := RESULT + Chr(curOrd);
Chave := Chave + chr(RandomVal);
end;
end;
function VERNAM_CRYPT_WITH_PREDEF_KEY(Texto: String; Chave: String): String;
var i, curOrd, lengthChave, lengthTexto, repetir: Integer;
begin
RESULT := '';
if chave = '' then chave := 'a'; // Mettre qque chose sinon ça va foiré ...
lengthChave := length(Chave);
lengthTexto := length(Texto);
if lengthChave < lengthTexto // La taille de la clé doit être au moins aussi grande que le message crypté ...
then begin
Repetir := 1;
for i := lengthChave + 1 to lengthTexto do
begin
Chave := chave + chave[Repetir];
if Repetir < lengthChave
then Repetir := Repetir + 1
else Repetir := 1;
end;
end;
for i := 1 to length(Texto) do
begin
curOrd := Ord(Texto[i]) XOR Ord(Chave[i]);
if curOrd = 0 // Ça arrive quand Texto[i] = Chave[i] ...
then curOrd := Ord(Texto[i]); // Chr(0) n' existe pas, donc on peut pas coder ce caractere ...
RESULT := RESULT + Chr(curOrd);
end;
end;
function VERNAM_DECRYPT(Criptado, Chave: String): String;
var i, repetir, curOrd, lengthChave, lengthTexto: Integer;
begin
RESULT := '';
if chave = '' then chave := 'a';
lengthChave := length(Chave);
lengthTexto := length(Criptado);
if lengthChave < lengthTexto
then begin
Repetir := 1;
for i := lengthChave + 1 to lengthTexto do
begin
Chave := chave + chave[Repetir];
if Repetir < lengthChave
then Repetir := Repetir + 1
else Repetir := 1;
end;
end;
for i := 1 to lengthTexto do
begin
curOrd := Ord(Criptado[i]) XOR Ord(Chave[i]);
if curOrd = 0 // On est dans le cas où Texto[i] était égal à Chave[i] ...
then curOrd := Ord(Criptado[i]); // Donc, la lettre ne fut pas cryptée ...
RESULT := RESULT + Chr(curOrd);
end;
end;
procedure TdbpVernam.SetAbout;
begin
// rien
end;
constructor TdbpVernam.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAbout := 'v1.2 par Julio P. (Diabloporc), Mauricio (Fafe Portugal), RM50Man';
fFile := '';
fFileEncoded := '';
fFileDecoded := '';
fFileKey := '';
fUseFileKey := false;
fUseTextCle := false;
end;
procedure Register;
begin
RegisterComponents('Diabloporc', [TdbpVernam]);
end;
procedure TdbpVernam.SetFile(const Value: TFileName);
begin
if (not fileexists(Value)) and (length(value)>0) then exit;
fFile := Value;
end;
procedure TdbpVernam.SetFileDecoded(const Value: TFileName);
begin
if fFileDecoded=Value then exit;
fFileDecoded := Value;
end;
procedure TdbpVernam.SetFileEncoded(const Value: TFileName);
begin
if fFileEncoded=Value then exit;
fFileEncoded := Value;
end;
procedure TdbpVernam.SetFileKey(const Value: TFileName);
begin
if (not fileexists(Value)) and (length(value)>0) then exit;
fFileKey := Value;
end;
function TdbpVernam.EncodeFichier: boolean;
begin
if fFile='' then begin result := false; exit; end;
if fUseFileKey then
begin
if fFileKey='' then begin result := false; exit; end;
VERNAM_CRYPT_FILE_WITH_PREDEF_KEY(fFile, fFileEncoded+'.vn', fFileKey);
end
else
VERNAM_CRYPT_FILE(fFile, fFileEncoded+'.vn', fFile+'.vnk');
result := fileexists(fFileEncoded+'.vn');
end;
function TdbpVernam.DecodeFichier: boolean;
begin
if (fFile='') or (fFileKey='') then begin result := false; exit; end;
VERNAM_DECRYPT_FILE(fFile, fFileDecoded, fFileKey);
result := fileexists(fFileDecoded);
end;
function TdbpVernam.DecodeText: boolean;
begin
if (fText='') then begin result := false; exit; end;
fTextDecode := '';
fTextDecode := VERNAM_DECRYPT(fText, fTextCle);
result := fTextDecode <> '';
end;
function TdbpVernam.EncodeText: boolean;
begin
if (fText='') then begin result := false; exit; end;
if not fUseTextCle then
begin
fTextEncode := '';
fTextEncode := VERNAM_CRYPT(fText, fTextCle);
result := fTextEncode <> '';
end
else
begin
fTextEncode := '';
fTextEncode := VERNAM_CRYPT_WITH_PREDEF_KEY(fText, fTextCle);
result := fTextEncode <> '';
end;
end;
end.
Conclusion
Bugs, améliorations ? MP moi !
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Comment crypter un EXE? [ par Manthis ]
Salut,je voudrais savoir comment crypter un fichier EXE alors si qqn as du source ou une DLL à me proposer je le remercie d'avance de tout coeur.Manth
Coder un serveur smtp [ par SuperSonic ]
Bonjour, ma question est simple.J'aimerais programmer un serveur smtp en delphi et j'aimerais en savoir un peu sur le protocole, enfin sur ce qu'il y
recherche coder delphi [ par WaReD ]
bon alors voila j aurais besoin d un bon coder en delphi, pour bossé sur un projet que j expliquerai par mail, et j ai dit un BON coder po une bréle d
Cryptage MD2 MD4 MD5 [ par MAsterC ]
Bonjour à tous! J'ai Delphi 7 et Borland C++ Builder 6 puis dans le logiciel C++ de Borland dans l'onglet "Indy - Divers" il y a Les composant de
Cryptage MD5 [ par Kruger ]
Bonjour tous le monde, je suis en train de develloper une petite application sous delphi 6 entreprise dont une partie est "protégée" par un mots de p
Cryptage 128 bits [ par Artegon ]
Salut a tous, j' aimerais savoir comment crypteune chaine de caractere en 128 bits...J' ai bien vus l' algorithme crypter/decrypter 128/256 bits, mais
cryptage windows [ par ralfspark ]
salut a tous j ai crypte certains fichier dans windows (comme mes photos), et apres reinstalation je ne peut plus les lire, que doit je faire ?merci
cle de 128 bits et cryptage [ par MoveX ]
une cle de 128 bits en cryptage ca correspond a quoi? je veux dire, ca n est pas une cle de 128 caracteres?
crypter en delphi [ par sandroagboka ]
je dispose d'un TIWEdit (composant d'IntraWeb)je récupère le donnée dans une variable. ( password)comment crypter cette variable et ins
Décrypter un fichier ZIP [ par kelian ]
Salut salut donc mon probleme est un fichier crypter et ziper et il y a un pass donc ma question qui va etre stupide pour certain est commen décr
|
Derniers Blogs
[RIA SERVICES] INCLUDE ET DOMAINDATASOURCE[RIA SERVICES] INCLUDE ET DOMAINDATASOURCE par Audrey
Dans un de mes articles précédents , j'avais parlé des DomainDataSource avec RIA Services dans le cas d'une interface Maître - Détail. Dans le même principe, je vais parler d'une autre manière de mettre en forme ce cas d'interface avec RIA Services. Et po...
Cliquez pour lire la suite de l'article par Audrey ZUNE : VERSION ZUNE SOFTWARE V 4.2 ET LA SOCIALISATIONZUNE : VERSION ZUNE SOFTWARE V 4.2 ET LA SOCIALISATION par ROMELARD Fabrice
Une des nouveautés de la version V 3.0 était l'apparition de l'onglet Social qui ne fonctionnait que si le MarketPlace était activé sur son poste. Cela limitait donc son intérêt, car hors du cadre commercial USA-CANADA, peu de monde trouva...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice PRATIQUE DE SILVERLIGHT PAR ERIC AMBROSIPRATIQUE DE SILVERLIGHT PAR ERIC AMBROSI par MPOWARE
Je viens de finir la lecture du dernier livre d'
Eric Ambrosi
éditions PEARSON
Son livre donne une approche pratique de Silverlight qui sera aussi bien comprise par le développeur que par le designeur.
Tous les aspects du développement RIA sont abor...
Cliquez pour lire la suite de l'article par MPOWARE APPRENDRE à DéVELOPPER POUR LES MOBILES AVEC LA NOUVELLE GéNéRATION .NETAPPRENDRE à DéVELOPPER POUR LES MOBILES AVEC LA NOUVELLE GéNéRATION .NET par odewit
2 déclinaisons de Silverlight et 2 déclinaisons de Mono permettent dorénavant (ou permettront prochainement) de développer des applications .NET mobiles pour les principales plates-formes du marché :
Silverlight pour Symbian, basé sur Silverlight 2...
Cliquez pour lire la suite de l'article par odewit ZUNE : NOUVELLE VERSION DU ZUNE SOFTWARE - V 4.2ZUNE : NOUVELLE VERSION DU ZUNE SOFTWARE - V 4.2 par ROMELARD Fabrice
Avec la dernière génération du lecteur MP3 de Microsoft, le ZUNE HD, Microsoft a publié une nouvelle version du logiciel pour PC. Ainsi, je me suis décidé à installer celle-ci sur mon Tablet PC ACER, comme toujours le logiciel est donc tél...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Forum
RE : DELPHIRE : DELPHI par overtaker
Cliquez pour lire la suite par overtaker RE : DELPHIRE : DELPHI par rt15
Cliquez pour lire la suite par rt15
Logiciels
Academy System (10.9.4.0)ACADEMY SYSTEM (10.9.4.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Xilisoft Convertisseur Vidéo Ultimate (5.1.39.0305)XILISOFT CONVERTISSEUR VIDéO ULTIMATE (5.1.39.0305)Xilisoft Convertisseur Vidéo Ultimate est un outil puissant de conversion vidéo, facile à utilise... Cliquez pour télécharger Xilisoft Convertisseur Vidéo Ultimate Xilisoft DVD Ripper Ultimate (5.0.64.0304)XILISOFT DVD RIPPER ULTIMATE (5.0.64.0304)Xilisoft DVD Ripper Ultimate est un logiciel excellent pour copier et convertir DVD vers presque ... Cliquez pour télécharger Xilisoft DVD Ripper Ultimate Rigs of Rods (63.3)RIGS OF RODS (63.3)c'est un jeu de multi-simulation camions,autobus voitures, avions, bateaux, hélicoptère avec défo... Cliquez pour télécharger Rigs of Rods
|