//////////////////////////////////////////////////
//  DB Access Components
//  Copyright © 1998-2014 Devart. All right reserved.
//  CR Encryption
//////////////////////////////////////////////////
{$IFNDEF CLR}

{$I Dac.inc}

unit CREncryption;
{$ENDIF}

interface

uses
{$IFDEF CLR}
  System.Runtime.InteropServices, System.Text,
{$ELSE}
  CLRClasses,
{$ENDIF}
{$IFDEF VER6P}
  Variants,
{$ENDIF}
  SysUtils, Classes, CRTypes, CRFunctions,
  CRSymmetricAlgorithm, CRHashAlgorithm, CRRNG;

type
  TEncryptionMethod = function (const Data: TValueArr; DataType: Word; var Length: cardinal): Variant of object;
  TDecryptionMethod = function (Data: IntPtr; DataType: Word; var Length: cardinal): boolean of object;

  TCREncryptionAlgorithm =
    (eaTripleDES, eaBlowfish, eaAES128, eaAES192, eaAES256, eaCast128, eaRC4);
  TCRHashAlgorithm = (haSHA1, haMD5);
  TCREncDataHeader = (ehTagAndHash, ehTag, ehNone);
  TCRInvalidHashAction = (ihFail, ihSkipData, ihIgnoreError);

  TCREncryptor = class(TComponent)
  private
    FDataHeader: TCREncDataHeader;
    FEncryptionAlgorithm: TCREncryptionAlgorithm;
    FHashAlgorithm: TCRHashAlgorithm;
    FInvalidHashAction: TCRInvalidHashAction;
    FEncryptor: TSymmetricAlgorithm;
    FHashSHA1: THashAlgorithm;
    FHashMD5: THashAlgorithm;
    FHash: THashAlgorithm;
    FPassword: string;
    FKeyFromPassword: TBytes;
    FKey: TBytes;
    FTmpBuffer: IntPtr;

    procedure SetEncryptionAlgorithm(const Value: TCREncryptionAlgorithm);
    procedure SetPassword(const Value: string);
    procedure Password2Key;
    procedure CheckEncryptor;

  protected
    function Encrypt(const Data: TValueArr; DataType: Word; var Length: cardinal): Variant;
    function Decrypt(Data: IntPtr; DataType: Word; var Length: cardinal): boolean;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  {$IFNDEF CLR}
    procedure SetKey(const Key; Count: Integer); overload;
  {$ENDIF}
    procedure SetKey(const Key: TBytes; Offset, Count: Integer); {$IFNDEF CLR}overload;{$ENDIF}

  published
    property DataHeader: TCREncDataHeader read FDataHeader write FDataHeader default ehTagAndHash;
    property EncryptionAlgorithm: TCREncryptionAlgorithm read FEncryptionAlgorithm write SetEncryptionAlgorithm default eaBlowfish;
    property HashAlgorithm: TCRHashAlgorithm read FHashAlgorithm write FHashAlgorithm default haSHA1;
    property InvalidHashAction: TCRInvalidHashAction read FInvalidHashAction write FInvalidHashAction default ihFail;
    property Password: string read FPassword write SetPassword;
  end;

  EInvalidEncData = class (Exception)
  end;

  EInvalidHash = class (Exception)
  end;

  TCREncryptorUtils = class
  public
    class function Encryptor(Obj: TCREncryptor): TEncryptionMethod;
    class function Decryptor(Obj: TCREncryptor): TDecryptionMethod;
  end;

function _GetRandomGenerator: TScRandom;

implementation

uses
  Math, CRCipher, CRSHA1, CRMD5, MemUtils, MemData, DAConsts;

var
  Random: TScRandom;
  PKEY_GUID: IntPtr;

const
  INTERNAL_HEADER_LEN = 8; {sizeof($BAADF00D) + sizeof(CipherDataLength)}
  IV_LEN = 8;
  KEY_GUID_LEN = 16;
  KEY_GUID: array[0..15] of byte =
    ($C5, $44, $E5, $29, $2C, $9C, $42, $A5, $B9, $4F, $E2, $79, $12, $70, $29, $01);

{ functions }

function _GetRandomGenerator: TScRandom;
begin
  Result := Random;
end;

{ TCREncryptor }

constructor TCREncryptor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FEncryptionAlgorithm := eaBlowfish;
  FHashAlgorithm := haSHA1;
  FDataHeader := ehTagAndHash;
  FInvalidHashAction := ihFail;
  FHashSHA1 := TSHA1CryptoServiceProvider.Create;
  FHashMD5 := TMD5CryptoServiceProvider.Create;
  FTmpBuffer := Marshal.AllocHGlobal(32);
{$IFDEF WIN64}
  if not Assigned(Random) then begin
    Random := TScRandom_LFSR.Create;
    Random.Randomize;
  end;
{$ENDIF}
end;

destructor TCREncryptor.Destroy;
begin
  Marshal.FreeHGlobal(FTmpBuffer);
  FHashSHA1.Free;
  FHashMD5.Free;
  FEncryptor.Free;

  inherited;
end;

procedure TCREncryptor.Password2Key;
var
  PassBuf: TBytes;
begin
  if FPassword <> '' then begin
    FHashSHA1.Initialize;
    FHashMD5.Initialize;
    SetLength(PassBuf, 0);
    PassBuf := Encoding.Unicode.{$IFNDEF VER5}GetBytes{$ELSE}GetBytesWide{$ENDIF}(WideString(FPassword));
    FHashSHA1.ComputeHash(PassBuf);
    FHashMD5.ComputeHash(PassBuf);
    SetLength(FKeyFromPassword, Length(FHashSHA1.Hash) + Length(FHashMD5.Hash));
    Buffer.BlockCopy(FHashSHA1.Hash, 0, FKeyFromPassword, 0, Length(FHashSHA1.Hash));
    Buffer.BlockCopy(FHashMD5.Hash, 0, FKeyFromPassword, Length(FHashSHA1.Hash), Length(FHashMD5.Hash));
  end;
end;

procedure TCREncryptor.CheckEncryptor;
var
  KeySize: integer;
  KeyBuf: TBytes;
begin
  case FHashAlgorithm of
    haSHA1:
      FHash := FHashSHA1;
    haMD5:
      FHash := FHashMD5;
  else
    Assert(False);
  end;

  if FEncryptor = nil then begin
    case FEncryptionAlgorithm of
      eaTripleDES:
        FEncryptor := TCipher_3DES.Create;
      eaBlowfish:
        FEncryptor := TCipher_Blowfish.Create;
      eaAES128, eaAES192, eaAES256:
        FEncryptor := TCipher_Rijndael.Create;
      eaCast128:
        FEncryptor := TCipher_Cast128.Create;
      eaRC4:
        FEncryptor := TCipher_RC4.Create;
    else
      Assert(False);
    end;

    FEncryptor.Mode := cmCBC;
  end;

  if FEncryptor.Initialized and (FEncryptionAlgorithm <> eaRC4) then
    Exit;

  if Length(FKey) > 0 then begin
    FEncryptor.Key := FKey;
    Exit;
  end;

  if FPassword = '' then
    raise Exception.Create(SInvalidKey);

  case FEncryptionAlgorithm of
    eaAES128:
      KeySize := 16;
    eaAES192:
      KeySize := 24;
    eaAES256:
      KeySize := 32;
  else
    KeySize := FEncryptor.KeySize;
  end;

  Assert(Length(FKeyFromPassword) >= 32);
  SetLength(KeyBuf, Min(KeySize, 32));
  Buffer.BlockCopy(FKeyFromPassword, 0, KeyBuf, 0, Length(KeyBuf));
  FEncryptor.Key := KeyBuf;
end;

function TCREncryptor.Encrypt(const Data: TValueArr; DataType: Word; var Length: cardinal): Variant;
var
  CipherLen, DataLen, HashLen: cardinal;
  Output: TBytes;
  Hash: TBytes;
  s: AnsiString;
  ws: WideString;
begin
  CheckEncryptor;

  Assert((Data <> nil) or (Length = 0));

  if FDataHeader = ehTagAndHash then
    HashLen := FHash.HashSize shr 3
  else
    HashLen := 0;

  case FDataHeader of
    ehTagAndHash, ehTag: begin
      CipherLen := (((INTERNAL_HEADER_LEN + Length + HashLen) div cardinal(FEncryptor.BlockSize)) + 1) * cardinal(FEncryptor.BlockSize);
      DataLen := KEY_GUID_LEN + IV_LEN + CipherLen;
      SetLength(Output, DataLen);
      Buffer.BlockCopy({$IFNDEF CLR}TBytes(@KEY_GUID){$ELSE}KEY_GUID{$ENDIF}, 0, Output, 0, KEY_GUID_LEN);
      Random.Random(Output, KEY_GUID_LEN, IV_LEN);
      FEncryptor.SetIVBytes(Output, KEY_GUID_LEN, IV_LEN);

      Marshal.WriteInt32(Output, KEY_GUID_LEN + IV_LEN, integer($BAADF00D));
      Marshal.WriteInt32(Output, KEY_GUID_LEN + IV_LEN + 4, integer(Length));

      if Data <> nil then
        Buffer.BlockCopy(TBytes(Data), 0, Output, KEY_GUID_LEN + IV_LEN + INTERNAL_HEADER_LEN, Length);
      Random.Random(Output, KEY_GUID_LEN + IV_LEN + INTERNAL_HEADER_LEN + Length, CipherLen - {$IFDEF FPC}Integer{$ENDIF}(INTERNAL_HEADER_LEN + Length + HashLen));

      if HashLen > 0 then begin
        SetLength(Hash, 0);
        FHash.Initialize;
        Hash := FHash.ComputeHash(TBytes(Data), 0, Length);
        Buffer.BlockCopy(Hash, 0, Output, KEY_GUID_LEN + IV_LEN + Integer(CipherLen - HashLen), HashLen);
      end;

      FEncryptor.EncryptCBC(Output, KEY_GUID_LEN + IV_LEN, CipherLen - HashLen, Output, KEY_GUID_LEN + IV_LEN);
      Length := DataLen;
    end;
    ehNone: begin
      if Length > 0 then begin
        SetLength(Output, Length);
        Buffer.BlockCopy(TBytes(Data), 0, Output, 0, Length);
        FEncryptor.ClearIV;
        FEncryptor.EncryptCBC(Output, 0, Length, Output, 0);
      end
      else begin
        Result := null;
        Exit;
      end;
    end;
  else
    Assert(False);
  end;

  case DataType of
    dtBytes: begin
      Result := Output;
    end;
    dtString: begin
      SetLengthA(s, Length * 2);
      BinToHexA(Output, PAnsiChar(s), Length);
      Length := Length * 2;
      Result := s;
    end;
    dtWideString: begin
      SetLength(ws, Length * 2);
      BinToHexW(Output, PWideChar(ws), Length);
      Length := Length * 2;
      Result := ws;
    end;
  else
    raise Exception.CreateFmt(SEncryptionNotSupported, [IntToStr(DataType)]);
  end;
end;

function TCREncryptor.Decrypt(Data: IntPtr; DataType: Word; var Length: cardinal): boolean;
var
  HashLen: integer;

  procedure DecryptBlob(Blob: TBlob; Offset: integer; var Length: cardinal);
  var
    CipherRest, DataRest: cardinal;
    Len, PieceRest, NextLen: integer;
    PieceOffset: integer;
    Piece: PPieceHeader;
    Hash: TBytes;
  begin
    Assert(Blob <> nil);
    Piece := Blob.FirstPiece;
    Data := PieceData(Piece);

    CipherRest := Length;
    DataRest := Length;
    PieceOffset := 0;
    PieceRest := 0;

    while CipherRest > 0 do begin
      Assert(Data <> nil);
      Len := Min(cardinal(((Piece.Used - Offset) div FEncryptor.BlockSize) * FEncryptor.BlockSize), CipherRest);
      if Len = 0 then
        Len := CipherRest;

      FEncryptor.DecodeBuffer(PtrOffset(Data, Offset), PtrOffset(Data, Offset), Len);
      CipherRest := CipherRest - cardinal(Len);

      if (Piece = Blob.FirstPiece) and (FDataHeader in [ehTagAndHash, ehTag]) then begin /// first block
        DataRest := cardinal(Marshal.ReadInt32(Data, Offset + 4));
        if DataRest > Length - INTERNAL_HEADER_LEN then
          raise EInvalidEncData.Create(SInvalidEncData);

        Piece.Used := Piece.Used - Offset - INTERNAL_HEADER_LEN;
        Len := Len - INTERNAL_HEADER_LEN;
        CopyBuffer(PtrOffset(Data, Offset + INTERNAL_HEADER_LEN), PtrOffset(Data, 0), Piece.Used);
        Offset := 0;
      end;

      PieceRest := Min(cardinal(Piece.Used - (Offset + Len)), CipherRest);

      if PieceRest > 0 then begin
        CopyBuffer(PtrOffset(Data, Offset + Len), FTmpBuffer, PieceRest);

        NextLen := Min(FEncryptor.BlockSize, CipherRest) - PieceRest;
        if NextLen > 0 then
          CopyBuffer(PieceData(Piece.Next), PtrOffset(FTmpBuffer, PieceRest), NextLen);
        FEncryptor.DecodeBuffer(FTmpBuffer, FTmpBuffer, PieceRest + NextLen);
        CipherRest := CipherRest - cardinal(PieceRest + NextLen);

        CopyBuffer(FTmpBuffer, PtrOffset(Data, Offset + Len), PieceRest);
        Len := Len + PieceRest;

        if NextLen > 0 then
          CopyBuffer(PtrOffset(FTmpBuffer, PieceRest), PieceData(Piece.Next), NextLen);
      end
      else begin
        NextLen := 0;
      end;

      PieceOffset := Offset + Len;
      if Piece.Used > PieceOffset then
        PieceRest := Piece.Used - PieceOffset
      else
        PieceRest := 0;

      Len := Min(Len, DataRest);
      if HashLen > 0 then
        FHash.TransformBlock(PtrOffset(Data, Offset), Len);
      DataRest := DataRest - cardinal(Len);
      Piece.Used := Offset + Len;

      if PieceRest = 0 then begin
        Piece := Piece.Next;
        Data := PieceData(Piece);
        Offset := NextLen;
        PieceOffset := Offset;
        if IntPtr(Piece) <> nil then
          PieceRest := Piece.Used - Offset;

        NextLen := Min(NextLen, DataRest);
        if HashLen > 0 then
          FHash.TransformBlock(Data, NextLen);
        DataRest := DataRest - cardinal(NextLen);
      end;
    end;

    Length := Blob.Size;
    Result := True;
    if HashLen > 0 then begin
      FHash.TransformFinalBlock(nil, 0, 0);
      SetLength(Hash, 0);
      Hash := FHash.Hash;

      Assert(PieceRest > 0);
      CopyBuffer(PtrOffset(Data, PieceOffset), FTmpBuffer, PieceRest);
      if PieceRest < HashLen then begin
        Piece := Piece.Next;
        Data := PieceData(Piece);
        Piece.Used := 0;
        CopyBuffer(Data, PtrOffset(FTmpBuffer, PieceRest), HashLen - PieceRest);
      end;

      if not CompareMem({$IFDEF CLR}Marshal.UnsafeAddrOfPinnedArrayElement(Hash, 0){$ELSE}@Hash[0]{$ENDIF}, FTmpBuffer, HashLen) then begin
        case FInvalidHashAction of
          ihFail:
            raise EInvalidHash.Create(SInvalidHash);
          ihSkipData: begin
            Length := 0;
            Result := False;
          end;
          ihIgnoreError:
            Length := Blob.Size;
        else
          Assert(False);
        end;
      end
      else
        Length := Blob.Size;
    end;
  end;

var
  Hash: TBytes;
  DataLen: cardinal;
  Blob: TBlob;
  Len: integer;
begin
  CheckEncryptor;

  Assert(Data <> nil);
  Blob := nil;
  if FDataHeader = ehTagAndHash then
    HashLen := FHash.HashSize shr 3
  else
    HashLen := 0;

  case FDataHeader of
    ehTagAndHash, ehTag: begin
      Result := False;

      case DataType of
        dtBytes: begin
          if (Length < KEY_GUID_LEN) or not CompareMem(Data, PKEY_GUID, KEY_GUID_LEN) then
            Exit;
        end;
        dtString: begin
          Length := StrLen(PAChar(Data));
          if Length < KEY_GUID_LEN * 2 then
            Exit;

          Len := HexToBinA(Data, FTmpBuffer, KEY_GUID_LEN);
          if (Len < KEY_GUID_LEN) or not CompareMem(FTmpBuffer, PKEY_GUID, KEY_GUID_LEN) then
            Exit;

          Length := HexToBinA(Data, Data, Length shr 1);
        end;
        dtWideString: begin
          Length := StrLenW(Data);
          if Length < KEY_GUID_LEN * 2 then
            Exit;

          Len := HexToBinW(PWChar(Data), FTmpBuffer, KEY_GUID_LEN);
          if (Len < KEY_GUID_LEN) or not CompareMem(FTmpBuffer, PKEY_GUID, KEY_GUID_LEN) then
            Exit;

          Length := HexToBinW(PWChar(Data), Data, Length shr 1);
        end;
        dtBlob: begin
          Blob := TBlob(GetGCHandleTarget(Data));
          Data := PieceData(Blob.FirstPiece);
          Length := Blob.Size;

          if (Length < KEY_GUID_LEN) or (not CompareMem(Data, PKEY_GUID, KEY_GUID_LEN)) then
            Exit;
        end;
      else
        raise Exception.CreateFmt(SEncryptionNotSupported, [IntToStr(DataType)]);
      end;

      if Length < cardinal(KEY_GUID_LEN + IV_LEN + INTERNAL_HEADER_LEN + HashLen) then
        raise Exception.Create(SInvalidEncDataSize);

      Length := Length - (KEY_GUID_LEN + IV_LEN);
      FEncryptor.SetIVBuf(Data, KEY_GUID_LEN, IV_LEN);

      if DataType = dtBytes then begin
        while (Length > cardinal(FEncryptor.BlockSize)) and (Marshal.ReadByte(Data, KEY_GUID_LEN + IV_LEN + integer(Length) - 1) = 0) do
          Dec(Length);
        if (Length mod cardinal(FEncryptor.BlockSize)) <> 0 then
          Length := ((Length div cardinal(FEncryptor.BlockSize)) + 1) * cardinal(FEncryptor.BlockSize);
      end;

      if (Length mod cardinal(FEncryptor.BlockSize)) <> 0 then
        raise Exception.Create(SInvalidEncDataSize);

      if HashLen > 0 then
        FHash.Initialize;
      Length := Length - cardinal(HashLen);

      if DataType <> dtBlob then begin
        FEncryptor.DecodeBuffer(PtrOffset(Data, KEY_GUID_LEN + IV_LEN), PtrOffset(Data, KEY_GUID_LEN + IV_LEN), Length);
        DataLen := cardinal(Marshal.ReadInt32(Data, KEY_GUID_LEN + IV_LEN + 4));
        if DataLen > Length - INTERNAL_HEADER_LEN then
          raise EInvalidEncData.Create(SInvalidEncData);

        CopyBuffer(PtrOffset(Data, KEY_GUID_LEN + IV_LEN + INTERNAL_HEADER_LEN), PtrOffset(Data, 0), DataLen);

        Result := True;
        if HashLen > 0 then begin
          FHash.TransformBlock(Data, DataLen);
          FHash.TransformFinalBlock(nil, 0, 0);
          SetLength(Hash, 0);
          Hash := FHash.Hash;
          if not CompareMem({$IFDEF CLR}Marshal.UnsafeAddrOfPinnedArrayElement(Hash, 0){$ELSE}@Hash[0]{$ENDIF}, PtrOffset(Data, KEY_GUID_LEN + IV_LEN + Length), HashLen) then begin
            case FInvalidHashAction of
              ihFail:
                raise EInvalidHash.Create(SInvalidHash);
              ihSkipData: begin
                Length := 0;
                Result := False;
              end;
              ihIgnoreError:
                Length := DataLen;
            else
              Assert(False);
            end;
          end
          else
            Length := DataLen;
        end
        else
          Length := DataLen;
      end
      else
        DecryptBlob(Blob, KEY_GUID_LEN + IV_LEN, Length);
    end;

    ehNone: begin
      Result := True;
      FEncryptor.ClearIV;

      if DataType = dtBlob then begin
        Blob := TBlob(GetGCHandleTarget(Data));
        Length := Blob.Size;
        DecryptBlob(Blob, 0, Length);
      end
      else begin
        if DataType = dtString then
          Length := HexToBinA(Data, Data, StrLen(PAChar(Data)) shr 1)
        else if DataType = dtWideString then
          Length := HexToBinW(PWChar(Data), Data, StrLenW(Data) shr 1);

        FEncryptor.DecodeBuffer(Data, Data, Length);
      end;
    end;
  else
    Assert(False);
  end;
end;

{$IFNDEF CLR}
procedure TCREncryptor.SetKey(const Key; Count: Integer);
begin
  SetKey(TBytes(@Key), 0, Count);
end;
{$ENDIF}

procedure TCREncryptor.SetKey(const Key: TBytes; Offset, Count: Integer);
begin
  SetLength(FKey, Count);
  Buffer.BlockCopy(Key, Offset, FKey, 0, Count);
  FPassword := '';

  FEncryptor.Free;
  FEncryptor := nil;
  CheckEncryptor;
end;

procedure TCREncryptor.SetPassword(const Value: string);
begin
  if Value <> FPassword then begin
    FPassword := Value;
    SetLength(FKey, 0);
    Password2Key;

    FEncryptor.Free;
    FEncryptor := nil;
    CheckEncryptor;
  end;
end;

procedure TCREncryptor.SetEncryptionAlgorithm(const Value: TCREncryptionAlgorithm);
begin
  if Value <> FEncryptionAlgorithm then begin
    FEncryptionAlgorithm := Value;
    FEncryptor.Free;
    FEncryptor := nil;
  end;
end;

{ TCREncryptorUtils }

class function TCREncryptorUtils.Encryptor(Obj: TCREncryptor): TEncryptionMethod;
begin
  Result := Obj.Encrypt;
end;

class function TCREncryptorUtils.Decryptor(Obj: TCREncryptor): TDecryptionMethod;
begin
  Result := Obj.Decrypt;
end;

{$IFDEF CLR}
var
  KEY_GUID_GC: GCHandle;
{$ENDIF}

initialization
{$IFNDEF WIN64}
  Random := TScRandom_LFSR.Create;
  Random.Randomize;
{$ENDIF}
{$IFDEF CLR}
  KEY_GUID_GC := GCHandle.Alloc(KEY_GUID, GCHandleType.Pinned);
  PKEY_GUID := Marshal.UnsafeAddrOfPinnedArrayElement(KEY_GUID, 0);
{$ELSE}
  PKEY_GUID := @KEY_GUID;
{$ENDIF}

finalization
{$IFDEF CLR}
  KEY_GUID_GC.Free;
{$ENDIF}
  Random.Free;

end.

