A Delphi Encryption Unit: Using DCP Components

[cairnswm]

This is a simple code example. I have not made it into a proper tutorial but thought people might be able to use it as is.

The DCP Components are available from http://www.cityinthesky.co.uk/cryptography.html

This is the CryptoUnit It needs no Initialization except to include the unit in your project:



[pascal]unit CryptoUnit;

interface

// ---------------------------------------------------
// CryptoUnit
// Version 1.1
//
// Copywrite CairnsGames S.A.
//
// This unit is free for use (for anything)
// Let me know if you sell it though
//
// ---------------------------------------------------
// Requires the DCP Components to be installed and in the search path
// of the application
// DCP Components are available from :
// http://www.cityinthesky.co.uk/cryptography.html

uses
SysUtils, Classes, DCPcrypt2, DCPsha512, DCPblockciphers, DCPcast256, JPEG,
GLXImageList;

type
CryptoException = Class(Exception);
TCrypto = class
private
Cipher: TDCP_cast256;
FPassword: String;
procedure SetPassword(const Value: String);
{ Private declarations }
public
{ Public declarations }
Constructor Create;
Destructor Destroy;
Property Password : String read FPassword write SetPassword;
Procedure Encrypt(Stream: TStream; OutFile : String);
Procedure Decrypt(Stream : TStream; InFile : String);
end;

var
Crypto: TCrypto;

// Quick Functions to load specific format data
Function LoadJPGImage(FileName : String) : TJPEGImage;
Function LoadGLXImage(FileName : String; ImageList : TGLXImageList = Nil) : TGLXImageItem;

implementation

{ TCrypto }

procedure TCrypto.Decrypt(Stream: TStream; InFile: String);
Var
Source : TFileStream;
begin
// This is the key to decrypting the data stream
// We load the encrypted data from a file and pass it through the
// Decrypt function placing the data into an output stream
// which would typically be a MemoryStream passed to the Procedure
// that then passes it into a 'LoadFromStream' method of another
// object.
try
Source := TFileStream.Create(InFile,fmOpenRead);
Source.Seek(0,soFromBeginning);
Cipher.InitStr(Password,TDCP_sha512); // initialize the cipher with a hash of the passphrase
Cipher.DecryptStream(Source,Stream,Source.Size); // encrypt the contents of the file
Stream.Seek(0,soFromBeginning);
Cipher.Burn;
Source.Free;
except
Raise CryptoException.CreateFmt('File ''%s'' not opened.',[InFile] );
end;
end;

procedure TCrypto.Encrypt(Stream: TStream; OutFile: String);
Var
Dest : TFileStream;
begin
// The Encrypt function takes a stream, typically a MemoryStream that is
// populated by a 'SaveToStream' method call of an object, and then
// encrypted into a file on the disk.
try
Stream.Seek(0,soFromBeginning);
Dest := TFileStream.Create(OutFile,fmCreate);
Cipher.InitStr(Password,TDCP_sha512); // initialize the cipher with a hash of the passphrase
Cipher.EncryptStream(Stream,Dest,Stream.Size); // encrypt the contents of the file
Stream.Seek(0,soFromBeginning);
Cipher.Burn;
Dest.Free;
except
Raise CryptoException.CreateFmt('Cannot create file ''%s''.',[OutFile] );
end;
end;

Constructor TCrypto.Create;
begin
// Initialize the objects
// and set up the ultra secret password
Inherited;
Password := 'CairnsGames S.A. ultra secret image encrypting Password for GLXTreem.';
Cipher:= TDCP_cast256.Create(Nil);
end;

procedure TCrypto.SetPassword(const Value: String);
begin
FPassword := Trim(Value);
end;

Function LoadJPGImage(FileName : String) : TJPEGImage;
Var
J : TJPEGImage;
Stream : TMemoryStream;
Begin
Stream := TMemoryStream.Create;
Crypto.Decrypt(Stream,FileName);
Stream.Seek(0,soFromBeginning);
J := TJPEGImage.Create;
J.LoadFromStream(Stream);
J.DIBNeeded;
Result := J;
Stream.Free;
End;

Function LoadGLXImage(FileName : String; ImageList : TGLXImageList) : TGLXImageItem;
Var
Stream : TMemoryStream;
G : TGLXImageItem;
Begin
Stream := TMemoryStream.Create;
Crypto.Decrypt(Stream,FileName);
Stream.Seek(0,soFromBeginning);
If ImageList <> Nil then
G := TGLXImageItem.Create(ImageList.Items)
Else
G := TGLXImageItem.Create(Nil);
G.LoadFromStream(Stream);
Result := G;
Stream.Free;
End;

destructor TCrypto.Destroy;
begin
Cipher.Free;

Inherited;
end;

Initialization
Crypto := TCrypto.Create;

Finalization
Crypto.Free;

end.[/pascal]

To demonstrate the Crypto unit I wrote a small EncryptPad application that acts as a text editor but loads and stores encrypted data, For example the text 'This is a test' is stored on the disk as '3A,r
A_A¬øA¬¶N?¢_¬¢?¢_ dj' using the password 'This is my password'.

The form requires a TMemo, a Menu and an Edit box. (I will see about loading this along with the source code to my web site soon.

[pascal]
unit EncryptPadForm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ExtCtrls, CryptoUnit;

type
TForm1 = class(TForm)
Memo1: TMemo;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
MainMenu1: TMainMenu;
File1: TMenuItem;
New1: TMenuItem;
Open1: TMenuItem;
Save1: TMenuItem;
SaveAs1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Panel1: TPanel;
labelPassword: TLabel;
EditPassword: TEdit;
procedure New1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure SaveAs1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.New1Click(Sender: TObject);
begin
Memo1.Lines.Clear;
end;

procedure TForm1.Open1Click(Sender: TObject);
Var
Stream : TMemoryStream;
begin
If OpenDialog1.Execute then
Begin
Stream := TMemoryStream.Create;
Crypto.Password := EditPassword.Text;
Crypto.Decrypt(Stream,OpenDialog1.FileName);
Memo1.Lines.LoadFromStream(Stream);
Stream.Free;
End;
end;

procedure TForm1.Save1Click(Sender: TObject);
Var
Stream : TMemoryStream;
begin
Stream := TMemoryStream.Create;
Memo1.Lines.SaveToStream(Stream);
Crypto.Password := EditPassword.Text;
Crypto.Encrypt(Stream,SaveDialog1.FileName);
Stream.Free;
end;

procedure TForm1.SaveAs1Click(Sender: TObject);
Var
Stream : TMemoryStream;
begin
If SaveDialog1.Execute then
Begin
Save1Click(Sender);
End;
end;

end.

[/pascal]

[xGTx]

Very nice thank you. I'll put this to good use in my MMORPG