Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Source/uROEncryption.pas

unit uROEncryption;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the RemObjects SDK             }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I RemObjects.inc}

// todo : add hash checksum to encrypted stream to ensure integrity

interface

uses
  Windows, SysUtils, Classes,
  uROCipher, uROCiphers, uROCipher1;

type
  TROEncryptionEvent = procedure(Sender: TObject;
    OriginalStream: TStream; var ProcessedStream: TStream) of object;

  // keep related encryption types together so the class arrays below will work
  // be sure to add new types to both the appropriate class array and
  // the set assignment (in Initialization)
  //
  // if you add a new cipher family (like DECCiphers), be sure to add
  // a "if iEncMethod in MyCiphers" block to both the Extract and Enclose methods
  // where you handle default keys and instantiating the Cipher variable
  //
  TROEncryptionMethod = (tetNone,       //no encryption
    tetDES, tetBlowfish, tetTwoFish, tetRijndael // DEC encryption}
    );

  TROCryptoKey = type string;

const
  TDECEncryptionClasses: array[tetDES..tetRijndael] of TROCipherClass =
    (TROCipher_3TDES, TROCipher_Blowfish, TROCipher_Twofish, TROCipher_Rijndael);

const
  ROStreamIdentifier: string = 'rorocks';
  // the following are binary values - 1, 2, 4, etc.
  ROStreamCompressed = $00000001;
  ROStreamEncrypted = $00000002;

  ValidStreams      = $00000003;        // sum of all stream types - for detecting invalid values

  // key is Ripe256 hash of 'RemObjects Rules!'
  // 256 bit key is enough for any of the included ciphers
  // if a DEC-based cipher is added which needs more than a 256-bit key, replace this.

  DefaultDECCipherKey = '12E4F3024E6F3D720E05984053ED365D7994B471691D8520979AD8D4DB81DF78';

var
  DECCiphers        : set of TROEncryptionMethod;
  LastCompressTime,
    LastEncryptTime : Double;
  HPCFreq           : Int64;

type
  TROEncryption = class(TPersistent)
  private
    { Private declarations }
    FEncryptionSendMethod: TROEncryptionMethod;
    FEncryptionSendKey: TROCryptoKey;
    FEncryptionRecvKey: TROCryptoKey;
    FUseCompression: Boolean;
    FOnBeforeEncryption: TROEncryptionEvent; { Defined in Classes unit. }
    FOnAfterDecryption: TROEncryptionEvent;

    timebefore, timeafter: Int64;

    procedure Enclose(const iSourceStream, iDestStream: TStream;
      iEncMethod: TROEncryptionMethod; isCompressed: Boolean;
      iKey: string = '');
    function Extract(const iSourceStream, iDestStream: TStream;
      iKey: string = ''): Int64;
  protected
    { Protected declarations }
    function GetEncryptionSendMethod: TROEncryptionMethod; virtual;
    procedure SetEncryptionSendMethod(NewValue: TROEncryptionMethod); virtual;
    function GetEncryptionSendKey: TROCryptoKey; virtual;
    procedure SetEncryptionSendKey(NewValue: TROCryptoKey); virtual;
    function GetEncryptionRecvKey: TROCryptoKey; virtual;
    procedure SetEncryptionRecvKey(NewValue: TROCryptoKey); virtual;
    function GetUseCompression: Boolean; virtual;
    procedure SetUseCompression(NewValue: Boolean); virtual;
    { Event triggers: }
    procedure TriggerBeforeEncryptionEvent(iOriginalStream: TStream; var iProcessedStream: TStream); virtual;
    procedure TriggerAfterDecryptionEvent(iOriginalStream: TStream; var iProcessedStream: TStream); virtual;
    procedure AssignTo(Dest: TPersistent); override;
  public
    { Public declarations }
    constructor Create;//(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure Encrypt(iPlaintext, iCiphertext: TStream); virtual;
    procedure Decrypt(iCiphertext, iPlaintext: TStream); virtual;
  published
    { Published properties and events }
    property EncryptionMethod: TROEncryptionMethod read GetEncryptionSendMethod write SetEncryptionSendMethod default tetNone; { Published }
    property EncryptionSendKey: TROCryptoKey read GetEncryptionSendKey write SetEncryptionSendKey; { Published }
    property EncryptionRecvKey: TROCryptoKey read GetEncryptionRecvKey write SetEncryptionRecvKey; { Published }
    property UseCompression: Boolean read GetUseCompression write SetUseCompression default False; { Published }
    property OnBeforeEncryption: TROEncryptionEvent read FOnBeforeEncryption write FOnBeforeEncryption;
    property OnAfterDecryption: TROEncryptionEvent read FOnAfterDecryption write FOnAfterDecryption;
  end;                                  { TROEncryption }

implementation

uses
  uROZLib;

function TROEncryption.GetEncryptionSendMethod: TROEncryptionMethod;
{ Returns the value of data member FEncryptionSendMethod. }
begin
  { ToDo -cCDK: Add query/calculation code here and/or modify result below. }
  GetEncryptionSendMethod := FEncryptionSendMethod;
end;                                    { GetEncryptionSendMethod }

procedure TROEncryption.SetEncryptionSendMethod(NewValue: TROEncryptionMethod);
{ Sets data member FEncryptionSendMethod to newValue. }
begin
  if FEncryptionSendMethod <> NewValue then
  begin
    FEncryptionSendMethod := NewValue;
    { ToDo -cCDK: Add display update code here if needed. }
  end;
end;                                    { SetEncryptionSendMethod }

function TROEncryption.GetEncryptionSendKey: TROCryptoKey;
{ Returns the value of data member FEncryptionSendKey. }
begin
  { ToDo -cCDK: Add query/calculation code here and/or modify result below. }
  GetEncryptionSendKey := FEncryptionSendKey;
end;                                    { GetEncryptionSendKey }

procedure TROEncryption.SetEncryptionSendKey(NewValue: TROCryptoKey);
{ Sets data member FEncryptionSendKey to newValue. }
begin
  if FEncryptionSendKey <> NewValue then
  begin
    FEncryptionSendKey := NewValue;
    { ToDo -cCDK: Add display update code here if needed. }
  end;
end;                                    { SetEncryptionSendKey }

function TROEncryption.GetEncryptionRecvKey: TROCryptoKey;
{ Returns the value of data member FEncryptionRecvKey. }
begin
  { ToDo -cCDK: Add query/calculation code here and/or modify result below. }
  GetEncryptionRecvKey := FEncryptionRecvKey;
end;                                    { GetEncryptionRecvKey }

procedure TROEncryption.SetEncryptionRecvKey(NewValue: TROCryptoKey);
{ Sets data member FEncryptionRecvKey to newValue. }
begin
  if FEncryptionRecvKey <> NewValue then
  begin
    FEncryptionRecvKey := NewValue;
    { ToDo -cCDK: Add display update code here if needed. }
  end;
end;                                    { SetEncryptionRecvKey }

function TROEncryption.GetUseCompression: Boolean;
{ Returns the value of data member FUseCompression. }
begin
  { ToDo -cCDK: Add query/calculation code here and/or modify result below. }
  GetUseCompression := FUseCompression;
end;                                    { GetUseCompression }

procedure TROEncryption.SetUseCompression(NewValue: Boolean);
{ Sets data member FUseCompression to newValue. }
begin
  if FUseCompression <> NewValue then
  begin
    FUseCompression := NewValue;
    { ToDo -cCDK: Add display update code here if needed. }
  end;
end;                                    { SetUseCompression }

procedure TROEncryption.Encrypt(iPlaintext, iCiphertext: TStream); { public }
var
  NewStream         : TStream;
begin
  NewStream := nil;
  TriggerBeforeEncryptionEvent(iPlaintext, NewStream);

  if NewStream <> nil then
  begin
    NewStream.Seek(0,soFromBeginning);
    Enclose(NewStream, iCiphertext, FEncryptionSendMethod, FUseCompression,
      FEncryptionSendKey);
    NewStream.Free;
  end
  else
  begin
    iPlaintext.seek(0, soFromBeginning);
    Enclose(iPlaintext, iCiphertext, FEncryptionSendMethod, FUseCompression,
      FEncryptionSendKey);
  end;
end;                                    { Encrypt }

procedure TROEncryption.Decrypt(iCiphertext, iPlaintext: TStream); { public }
var
  NewStream         : TStream;
  OutStream         : TMemoryStream;
begin
  OutStream := TMemoryStream.Create;
  try
    Extract(iCiphertext, OutStream, FEncryptionRecvKey);
    NewStream := nil;
    TriggerAfterDecryptionEvent(OutStream, NewStream);
    if NewStream <> nil then
    begin
      NewStream.Seek(0,soFromBeginning);
      iPlaintext.CopyFrom(NewStream, NewStream.Size);
      NewStream.Free;
    end
    else
      OutStream.Seek(0,soFromBeginning);
      iPlaintext.CopyFrom(OutStream, OutStream.Size);
  finally                               // wrap up
    OutStream.Free;
  end;                                  // try/finally
end;                                    { Decrypt }

{ Event triggers: }

procedure TROEncryption.TriggerBeforeEncryptionEvent(iOriginalStream: TStream; var iProcessedStream: TStream);
{ Triggers the OnBeforeEncryption event. This is a virtual method (descendants of this component can override it). }
{ ToDo -cCDK: Call as needed to trigger event. }
begin
  if Assigned(FOnBeforeEncryption) then
    FOnBeforeEncryption(Self, iOriginalStream, iProcessedStream);
end;                                    { TriggerBeforeEncryptionEvent }

procedure TROEncryption.TriggerAfterDecryptionEvent(iOriginalStream: TStream; var iProcessedStream: TStream);
{ Triggers the OnAfterDecryption event. This is a virtual method (descendants of this component can override it). }
{ ToDo -cCDK: Call as needed to trigger event. }
begin
  if Assigned(FOnAfterDecryption) then
    FOnAfterDecryption(Self, iOriginalStream, iProcessedStream);
end;                                    { TriggerAfterDecryptionEvent }

procedure TROEncryption.AssignTo(Dest: TPersistent);
var
  DestEncr: TROEncryption;
begin
  if Dest is TROEncryption then begin
    DestEncr := TROEncryption(Dest);
    DestEncr.EncryptionMethod := EncryptionMethod;
    DestEncr.EncryptionSendKey := EncryptionSendKey;
    DestEncr.EncryptionRecvKey := EncryptionRecvKey;
    DestEncr.UseCompression := UseCompression;
    DestEncr.OnBeforeEncryption := OnBeforeEncryption;
    DestEncr.OnAfterDecryption := OnAfterDecryption;
  end else begin
    inherited;
  end;
end;

destructor TROEncryption.Destroy;
begin
  { ToDo -cCDK: Free allocated memory and created objects here. }
  inherited Destroy;
end;                                    { Destroy }

constructor TROEncryption.Create;//(aOwner: TComponent);
{ Creates an object of type TROEncryption, and initializes properties. }
begin
  inherited Create;//(aOwner);
  { Initialize properties with default values: }
  FEncryptionSendMethod := tetNone;
  FUseCompression := False;
  { ToDo -cCDK: Add your initialization code here. }
end;                                    { Create }

procedure TROEncryption.Enclose(const iSourceStream, iDestStream: TStream;
  iEncMethod: TROEncryptionMethod; isCompressed: Boolean; iKey: string = '');
var
  Size              : Integer;
  nextStream        : TStream;
  Cipher            : TROBaseCipher;
  CipherKey         : string;

  FreeNext          : Boolean;

  StreamType        : Integer;
begin
  // don't do anything if streamsize is 0
  if iSourceStream.Size = 0 then
    Exit;

  if (isCompressed) or (iEncMethod <> tetNone) then begin
    iDestStream.Write(ROStreamIdentifier[1], Length(ROStreamIdentifier)); { brazil }

    if isCompressed then
      StreamType := ROStreamCompressed
    else
      StreamType := 0;

    if iEncMethod <> tetNone then
    begin
      StreamType := StreamType or ROStreamEncrypted;
    end;

    iDestStream.Write(StreamType, SizeOf(StreamType));

    if iEncMethod <> tetNone then
    begin
      StreamType := Integer(iEncMethod);
      iDestStream.Write(StreamType, SizeOf(StreamType));
    end;

    FreeNext := False;
    Cipher := nil;
    nextStream := nil;

    LastCompressTime := 0;
    LastEncryptTime := 0;

    try
      if isCompressed then
      begin
        // only create NextStream if we need the intermediate result before encryption
        if iEncMethod <> tetNone then
        begin
          nextStream := TMemoryStream.Create;
          nextStream.Size := iSourceStream.Size;
          FreeNext := True;
        end
        else
          nextStream := iDestStream;

        Size := iSourceStream.Size;
        nextStream.Write(Size, 4);

        with TCompressionStream.Create(clMax, nextStream) do
        try
          //iStream.Seek(0,soFromBeginning);
          QueryPerformanceCounter(timebefore);
          CopyFrom(iSourceStream, iSourceStream.Size);
          QueryPerformanceCounter(timeafter);
          LastCompressTime := (timeafter - timebefore) / HPCFreq;
        finally
          Free();
        end;
        nextStream.seek(0, soFromBeginning);
      end
      else
      begin
        if iEncMethod <> tetNone then
          nextStream := iSourceStream;
      end;

      if iEncMethod <> tetNone then
      begin
        // get key value
        // - add new sections if new encryption types are added
        // - new section should include assign default key if
        //   fEncryptionRecvKey = ''
        // - otherwise convert fEncryptionRecvKey to key value and
        //   raise exception if invalid value

        if iEncMethod in DECCiphers then
        begin
          if iKey = '' then
          begin
            CipherKey := DefaultDECCipherKey;
          end
          else
          begin
            CipherKey := iKey;
          end;

          Cipher := TroDECCipher.Create(TDECEncryptionClasses[iEncMethod], CipherKey);
        end;

        // do decryption

        if Cipher = nil then
          raise Exception.Create('OK, who forgot to create the cipher?');

        try
          QueryPerformanceCounter(timebefore);
          Cipher.EncryptStream(nextStream, iDestStream);
          QueryPerformanceCounter(timeafter);
          LastEncryptTime := (timeafter - timebefore) / HPCFreq;
        finally                         // wrap up
          Cipher.Free;
        end;                            // try/finally
      end;

    finally
      if FreeNext then
        nextStream.Free;
    end;
  end
  else
  begin                                 // nothing happened - copy src to dest
    iDestStream.CopyFrom(iSourceStream, iSourceStream.Size - iSourceStream.Position);
  end;
end;

function TROEncryption.Extract(const iSourceStream, iDestStream: TStream;
  iKey: string = ''): Int64;
var
  isCompressed      : Boolean;
  StreamIdentifier  : string[6];
  StreamType        : Integer;
  EncMethodRead     : Integer;
  EncMethod         : TROEncryptionMethod;
  OrigPos           : Integer;

  Len               : Integer;
  nextStream        : TStream;
  DecompressionStream: TDecompressionStream;
  Cipher            : TROBaseCipher;
  CipherKey         : string;

  FreeNext          : Boolean;
begin
  Result := 0;

  SetLength(StreamIdentifier, Length(ROStreamIdentifier));
  OrigPos := iSourceStream.Position;
  iSourceStream.read(StreamIdentifier[1], Length(ROStreamIdentifier));

  if StreamIdentifier = ROStreamIdentifier then
  begin
    iSourceStream.read(StreamType, 4);

    if StreamType or ValidStreams <> ValidStreams then
      //if StreamType <> CONST_StreamType then
      raise Exception.Create('Invalid response type: Newer Brazil DataSnap Server?');

    EncMethod := tetNone;

    if StreamType and ROStreamEncrypted <> 0 then
    begin
      iSourceStream.read(EncMethodRead, SizeOf(EncMethodRead));

      try
        EncMethod := TROEncryptionMethod(EncMethodRead);
      except
        on e: Exception do
          raise Exception.CreateFmt('Invalid encryption method (%d): Newer Brazil DataSnap Server?', [EncMethodRead]);
      end;                              // try/finally
    end;

    FreeNext := False;
    nextStream := nil;
    Cipher := nil;

    // don't do anything on empty stream
    if iSourceStream.Size = iSourceStream.Position then
      Exit;

    LastCompressTime := 0;
    LastEncryptTime := 0;

    isCompressed := (StreamType and ROStreamCompressed) <> 0;

    try
      if EncMethod <> tetNone then
      begin
        // only create NextStream if we need the intermediate result before decompression
        if isCompressed then
        begin
          nextStream := TMemoryStream.Create;
          nextStream.Size := iSourceStream.Size;
          FreeNext := True;
        end
        else
          nextStream := iDestStream;

        // get key value
        // - add new sections if new encryption types are added
        // - new section should include assign default key if
        //   fEncryptionRecvKey = ''
        // - otherwise convert fEncryptionRecvKey to key value and
        //   raise exception if invalid value

        if EncMethod in DECCiphers then
        begin
          if iKey = '' then
          begin
            CipherKey := DefaultDECCipherKey;
          end
          else
          begin
            CipherKey := iKey;
          end;

          Cipher := TroDECCipher.Create(TDECEncryptionClasses[EncMethod], CipherKey);
        end;

        // do decryption

        if Cipher = nil then
          raise Exception.Create('OK, who forgot to create the cipher?');

        try
          QueryPerformanceCounter(timebefore);
          Cipher.DecryptStream(iSourceStream, nextStream);
          QueryPerformanceCounter(timeafter);
          LastEncryptTime := (timeafter - timebefore) / HPCFreq;
        finally                         // wrap up
          Cipher.Free;
        end;                            // try/finally
        nextStream.seek(0, soFromBeginning);
      end
      else
      begin
        if isCompressed then
          nextStream := iSourceStream
        else
        begin                           // nothing happened - copy src to dest
          iDestStream.CopyFrom(iSourceStream, iSourceStream.Size - iSourceStream.Position);
        end;
      end;

      if isCompressed then
      begin
        nextStream.read(Len, 4);

        DecompressionStream := TDecompressionStream.Create(nextStream);
        try
          QueryPerformanceCounter(timebefore);
          iDestStream.CopyFrom(DecompressionStream, Len);
          QueryPerformanceCounter(timeafter);
          LastCompressTime := (timeafter - timebefore) / HPCFreq;
          iDestStream.seek(0, soFromBeginning);
        finally
          DecompressionStream.Free();
        end;                            { with }

        Result := iDestStream.Size - nextStream.Size;
      end;
    finally
      if FreeNext then
        nextStream.Free;
    end;
  end
  else
  begin
    iSourceStream.seek(OrigPos, soFromBeginning);
    iDestStream.CopyFrom(iSourceStream, iSourceStream.Size - OrigPos);
  end;
end;

initialization
  DECCiphers := [tetDES..tetRijndael];
  QueryPerformanceFrequency(HPCFreq);
finalization
end.