{***************************************************************
 *
 * Unit Name: SecUtils
 * Purpose  : Declaration and implementation of TCipher helper class
 * Author   : Henrick Hellström
 * History  : Original version, 2000 dec 11
 *
 ****************************************************************}

{$Q-,R-}

{*******************************************************}
{                                                       }
{     StreamSec Security Library for Borland Delphi     }
{     Security Utilities Unit                           }
{     http://www.streamsec.com                          }
{     Copyright (C) 2000 StreamSec Handelsbolag         }
{                                                       }
{*******************************************************}

unit SecUtils;

interface

uses
  Classes;

resourcestring
  S_ERR_BUF_TOO_SMALL = 'Procedure HexToBin: Buffer is too small.';

type
  TCipher = class
  protected
    procedure CleanUp; virtual; abstract;
    function GetVector: string; virtual; abstract;
    procedure SetVector(const Value: string); virtual; abstract;
  public
    constructor Create(const AKey; Count, VectorSize: Integer); virtual;
    destructor Destroy; override;
    procedure Decrypt(var Buf; Count: Integer); virtual; abstract;
    procedure Encrypt(var Buf; Count: Integer); virtual; abstract;
    procedure SetUp(const AKey; Count, VectorSize: Integer); virtual; abstract;
    property IVector: string read GetVector write SetVector;
  end;

  TCipherClass = class of TCipher;

  TPRGTest = class(TCipher)
  protected
    procedure CleanUp; override;
    function GetVector: string; override;
    procedure SetVector(const Value: string); override;
  public
    procedure Decrypt(var Buf; Count: Integer); override;
    procedure Encrypt(var Buf; Count: Integer); override;
    procedure SetUp(const AKey; Count, VectorSize: Integer); override;
  end;


procedure ProtectClear(var ABuf; Count: Integer);

// Data conversion routines:

function BinToHex(const ABuf; Count: Integer): string;
procedure HexToBin(const Value: string; var ABuf; var Count: Integer);

function GetTrimmedHex(Strings: TStrings): string;
function TrimHex(const Value: string): string;

implementation

uses
  SysUtils;

function TrimHex(const Value: string): string;
var
  P: PChar;
  I: Integer;
  S: string;
begin
  P := Pointer(Value);
  S := '';
  while (P <> nil) and (P^ <> #0) do begin
    if P^ = #32 then begin
      while Length(S) > 1 do begin
        Result := Result + Copy(S,Length(S)-1,2);
        Delete(S,Length(S)-1,2);
      end;
      if Length(S) = 1 then
        Result := Result + '0' + S;
    end else
      S := S + P^;
    Inc(P);
  end;
end;

function GetTrimmedHex(Strings: TStrings): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Strings.Count - 1 do
    Result := Result + TrimHex(Strings[I]);
end;

procedure ProtectClear(var ABuf; Count: Integer);
begin
  if Count <= 0 then Exit;
  FillChar(ABuf,Count,$FF);
  FillChar(ABuf,Count,$AA);
  FillChar(ABuf,Count,$55);
  FillChar(ABuf,Count,$00);
end;

function BinToHex(const ABuf; Count: Integer): string;
var
  P: ^Byte;
begin
  Result := '';
  P := @ABuf;
  while Count > 0 do begin
    Result := Result + IntToHex(P^,2) + ' ';
    Inc(LongInt(P));
    Dec(Count);
  end;
end;

procedure HexToBin(const Value: string; var ABuf; var Count: Integer);
var
  P: ^Byte;
  I: Integer;
begin
  Trim(Value);
  if Count < (Length(Value) div 2) then
    raise Exception.Create(S_ERR_BUF_TOO_SMALL);
  Count := Length(Value) div 2;
  FillChar(ABuf,Count,0);
  P := @ABuf;
  for I := 0 to Count-1 do begin
    P^ := StrToInt('$'+Copy(Value,I*2+1,2));
    Inc(LongInt(P));
  end;
end;

{ TCipher }

constructor TCipher.Create(const AKey; Count, VectorSize: Integer);
begin
  SetUp(AKey,Count,VectorSize);
end;

destructor TCipher.Destroy;
begin
  CleanUp;
  inherited;
end;

{ TPRGTest }

procedure TPRGTest.CleanUp;
begin
  // Nothing to do.
end;

procedure TPRGTest.Decrypt(var Buf; Count: Integer);
begin
  // Nothing to do.
end;

procedure TPRGTest.Encrypt(var Buf; Count: Integer);
var
  P: ^Byte;
  I: Integer;
begin
  P := @Buf;
  for I := 0 to Count-1 do begin
    P^ := Random(256);
    Inc(LongInt(P));
  end;
end;

function TPRGTest.GetVector: string;
begin
  Result := '';
end;

procedure TPRGTest.SetUp(const AKey; Count, VectorSize: Integer);
begin
  // Nothing to do.
end;

procedure TPRGTest.SetVector(const Value: string);
begin
  // Nothing to do.
end;

end.