Composant : tdbpvernam (crypteur de texte/fichier)

Télécharger le projet
Commenter

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 / Exemple : 


{
################################################################################
# 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 !
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (JulioDelphi)