Vernam File Crypter

Es werden benötigt : 7xEditBox, 6xButton

uses Math

var

procedure VERNAM_CRYPT_FILE(Src, Dest, Chave: TFileName);
procedure VERNAM_CRYPT_FILE_WITH_PREDEF_KEY(Src, Dest, Chave: TFileName);
procedure VERNAM_DECRYPT_FILE(Src, Dest, Chave: TFileName);

//

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);
        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;
    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);

      fs_Chave_Buffer_size := 0;
      While fs_Chave_Buffer_size < fs_Src_Buffer_size do
      begin
        TransfBytes := fs_Chave.Size - fs_Chave.Position;

        If TransfBytes = 0
        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);

        for i := 0 to TransfBytes - 1 do
          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);

      fs_Chave_Buffer_size := 0;
      While fs_Chave_Buffer_size < fs_Src_Buffer_size do
      begin
        TransfBytes := fs_Chave.Size - fs_Chave.Position;

        If TransfBytes = 0
        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);

        for i := 0 to TransfBytes - 1 do
          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;

Beispiele :

procedure TForm1.Button1Click(Sender: TObject);
begin
  If OpenDialog1.Execute
  Then
    If Sender = Button1
    Then Begin                 // Crypt ...
      Edit1.Text        := OpenDialog1.FileName;
      Edit2.Text := OpenDialog1.FileName + '.crpt';
      Edit3.Text           := OpenDialog1.FileName + '.cle';
    End;

    If Sender = Button2
    Then Begin                 // Decrypt ...
      Edit5.Text := OpenDialog1.FileName;
      Edit7.Text  := Copy(OpenDialog1.FileName, 1, length(OpenDialog1.FileName) - 5);
      Edit6.Text           := Edit7.Text + '.cle';

      Edit7.Text := Edit7.Text + '  decode';
    End;

    If Sender = Button3
    Then Edit4.Text := OpenDialog1.FileName;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  VERNAM_CRYPT_FILE_WITH_PREDEF_KEY(Edit1.Text, Edit2.Text, Edit4.Text);
  Screen.Cursor := crDefault;
end;

// Crypt
procedure TForm1.ButtonCryptClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  VERNAM_CRYPT_FILE(Edit1.Text, Edit2.Text, Edit3.Text);
  Screen.Cursor := crDefault;
end;

// Decrypt
procedure TForm1.ButtonDecryptClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  VERNAM_DECRYPT_FILE(Edit5.Text, Edit7.Text, Edit6.Text);
  Screen.Cursor := crDefault;
end;