{
  Clever Internet Suite
  Copyright (C) 2014 Clever Components
  All Rights Reserved
  www.CleverComponents.com
}

unit clEncryptor;

interface

{$I clVer.inc}

uses
{$IFNDEF DELPHIXE2}
  Classes, Windows, SysUtils,
{$ELSE}
  System.Classes, System.SysUtils, Winapi.Windows,
{$ENDIF}
  clTranslator, clUtils, clWUtils, clCryptUtils, clCryptAPI, clCertificateStore,
  clCertificate{$IFDEF LOGGER}, clLogger{$ENDIF};

type
  TclEncryptor = class(TComponent)
  private
    FSignAlgorithm: string;
    FSignStore: string;
    FEncryptCertificate: string;
    FEncodingType: Integer;
    FEncryptAlgorithm: string;
    FEncryptStore: string;
    FSignCertificate: string;
    FCertificateStore: TclCertificateStore;
    FIsExtractCertificates: Boolean;
    FOnProgress: TclProgressEvent;
    FExtractedCertificates: TclCertificateStore;
    FExtractedAlgorithm: string;
    FIsExtractAlgorithms: Boolean;

    procedure CheckCertificate(ACertificate: TclCertificate);
    procedure CheckCertificates(ACertificates: TclCertificateList);
    function FindCertificate(AStore: TclCertificateStore;
      const ACertificate: string; ARequirePrivateKey: Boolean): TclCertificate;
    function ExtractAlgorithm(AData: TclCryptData; AlgType: Integer): string;
    function GetExtractedAlgorithmName: string;
  protected
    function GetCertificateStore(const AStoreName: string): TclCertificateStore; virtual;
    function GetCertificate(const AStoreName, ACertificate: string; ARequirePrivateKey: Boolean): TclCertificate; virtual;
    function GetExtractedCertificate: TclCertificate; virtual;
    procedure DoProgress(ABytesProceed, ATotalBytes: Int64); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Close; virtual;

    procedure Sign(const ASourceFile, ADestinationFile: string; ADetachedSignature: Boolean); overload;
    procedure Sign(ASource, ADestination: TStream; ADetachedSignature: Boolean); overload;
    procedure Sign(ASource, ADestination: TStream; ADetachedSignature, AIncludeCertificate: Boolean;
      ACertificate: TclCertificate; AExtraCerts: TclCertificateList); overload;
    function Sign(const AData: TclCryptData; ADetachedSignature, AIncludeCertificate: Boolean;
      ACertificate: TclCertificate; AExtraCerts: TclCertificateList): TclCryptData; overload;
    function Sign(const AData: TclCryptData; ADetachedSignature, AIncludeCertificate: Boolean;
      ACertificate: TclCertificate): TclCryptData; overload;
    function Sign(const AData: TclByteArray; ADetachedSignature, AIncludeCertificate: Boolean;
      ACertificate: TclCertificate; AExtraCerts: TclCertificateList): TclByteArray; overload;
    function Sign(const AData: TclByteArray; ADetachedSignature, AIncludeCertificate: Boolean;
      ACertificate: TclCertificate): TclByteArray; overload;

    procedure VerifyEnveloped(const ASourceFile, ADestinationFile: string); overload;
    procedure VerifyEnveloped(ASource, ADestination: TStream); overload;
    procedure VerifyEnveloped(ASource, ADestination: TStream; ACertificate: TclCertificate); overload;
    function VerifyEnveloped(const AData: TclCryptData; ACertificate: TclCertificate): TclCryptData; overload;
    function VerifyEnveloped(const AData: TclByteArray; ACertificate: TclCertificate): TclByteArray; overload;

    procedure VerifyDetached(const ASourceFile, ASignatureFile: string); overload;
    procedure VerifyDetached(ASource, ASignature: TStream); overload;
    procedure VerifyDetached(ASource, ASignature: TStream; ACertificate: TclCertificate); overload;
    procedure VerifyDetached(const AData, ASignature: TclCryptData; ACertificate: TclCertificate); overload;
    procedure VerifyDetached(const AData, ASignature: TclByteArray; ACertificate: TclCertificate); overload;

    procedure Encrypt(const ASourceFile, ADestinationFile: string); overload;
    procedure Encrypt(ASource, ADestination: TStream); overload;
    procedure Encrypt(ASource, ADestination: TStream; ACertificates: TclCertificateList); overload;
    function Encrypt(const AData: TclCryptData; ACertificates: TclCertificateList): TclCryptData; overload;
    function Encrypt(const AData: TclCryptData; ACertificate: TclCertificate): TclCryptData; overload;
    function Encrypt(const AData: TclByteArray; ACertificates: TclCertificateList): TclByteArray; overload;
    function Encrypt(const AData: TclByteArray; ACertificate: TclCertificate): TclByteArray; overload;

    procedure Decrypt(const ASourceFile, ADestinationFile: string); overload;
    procedure Decrypt(ASource, ADestination: TStream); overload;
    procedure Decrypt(ASource, ADestination: TStream; ACertificate: TclCertificate); overload;
    function Decrypt(const AData: TclCryptData; ACertificate: TclCertificate): TclCryptData; overload;
    function Decrypt(const AData: TclByteArray; ACertificate: TclCertificate): TclByteArray; overload;

    function ExtractCertificates(const ASourceFile: string): TclCertificateList; overload;
    function ExtractCertificates(ASource: TStream): TclCertificateList; overload;
    function ExtractCertificates(const AData: TclCryptData): TclCertificateList; overload;
    function ExtractCertificates(const AData: TclByteArray): TclCertificateList; overload;

    function ExtractHashAlgorithm(const ASourceFile: string): string; overload;
    function ExtractHashAlgorithm(ASource: TStream): string; overload;
    function ExtractHashAlgorithm(const AData: TclCryptData): string; overload;
    function ExtractHashAlgorithm(const AData: TclByteArray): string; overload;

    function ExtractEncryptionAlgorithm(const ASourceFile: string): string; overload;
    function ExtractEncryptionAlgorithm(ASource: TStream): string; overload;
    function ExtractEncryptionAlgorithm(const AData: TclCryptData): string; overload;
    function ExtractEncryptionAlgorithm(const AData: TclByteArray): string; overload;

    property ExtractedCertificates: TclCertificateStore read FExtractedCertificates;
    property ExtractedAlgorithm: string read FExtractedAlgorithm;
    property ExtractedAlgorithmName: string read GetExtractedAlgorithmName;
  published
    property SignStore: string read FSignStore write FSignStore;
    property EncryptStore: string read FEncryptStore write FEncryptStore;

    property SignCertificate: string read FSignCertificate write FSignCertificate;
    property EncryptCertificate: string read FEncryptCertificate write FEncryptCertificate;

    property SignAlgorithm: string read FSignAlgorithm write FSignAlgorithm;
    property EncryptAlgorithm: string read FEncryptAlgorithm write FEncryptAlgorithm;

    property EncodingType: Integer read FEncodingType write FEncodingType default DefaultEncoding;

    property IsExtractCertificates: Boolean read FIsExtractCertificates write FIsExtractCertificates default True;
    property IsExtractAlgorithms: Boolean read FIsExtractAlgorithms write FIsExtractAlgorithms default True;

    property OnProgress: TclProgressEvent read FOnProgress write FOnProgress;
  end;

{$IFDEF DEMO}
{$IFNDEF IDEDEMO}
var
  IsEncryptorDemoDisplayed: Boolean = False;
{$ENDIF}
{$ENDIF}

implementation

{ TclEncryptor }

procedure TclEncryptor.CheckCertificates(ACertificates: TclCertificateList);
begin
  if (ACertificates.Count = 0) then
  begin
    RaiseCryptError(CertificateNotFound, CertificateNotFoundCode);
  end;
end;

procedure TclEncryptor.CheckCertificate(ACertificate: TclCertificate);
begin
  if (ACertificate = nil) then
  begin
    RaiseCryptError(CertificateNotFound, CertificateNotFoundCode);
  end;
end;

procedure TclEncryptor.Close;
begin
  if (FCertificateStore <> nil) then
  begin
    FCertificateStore.Close();
  end;
  ExtractedCertificates.Close();
  FExtractedAlgorithm := '';
end;

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

  FExtractedCertificates := TclCertificateStore.Create(nil);
  FExtractedCertificates.StoreName := 'addressbook';

  FExtractedAlgorithm := '';

  FCertificateStore := nil;
  FEncodingType := DefaultEncoding;
  FSignAlgorithm := szOID_NIST_sha512;
  FEncryptAlgorithm := szOID_NIST_AES256_CBC;
  FIsExtractCertificates := True;
  FIsExtractAlgorithms := True;
end;

function TclEncryptor.Decrypt(const AData: TclCryptData; ACertificate: TclCertificate): TclCryptData;
var
  decryptPara: CRYPT_DECRYPT_MESSAGE_PARA;
  cbDecrypted: DWORD;
  rghCertStore: array[0..0] of HCERTSTORE;
  hStore: HCERTSTORE;
begin
{$IFDEF DEMO}
{$IFNDEF STANDALONEDEMO}
  if FindWindow('TAppBuilder', nil) = 0 then
  begin
    MessageBox(0, 'This demo version can be run under Delphi/C++Builder IDE only. ' +
      'Please visit www.clevercomponents.com to purchase your ' +
      'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    ExitProcess(1);
  end else
{$ENDIF}
  begin
{$IFNDEF IDEDEMO}
    if (not IsEncryptorDemoDisplayed) and (not IsCertDemoDisplayed) then
    begin
      MessageBox(0, 'Please visit www.clevercomponents.com to purchase your ' +
        'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    end;
    IsEncryptorDemoDisplayed := True;
    IsCertDemoDisplayed := True;
{$ENDIF}
  end;
{$ENDIF}

{$IFDEF LOGGER}try clPutLogMessage(Self, edEnter, 'Decrypt');{$ENDIF}
  if IsExtractCertificates then
  begin
    ExtractCertificates(AData);
  end;

  if IsExtractAlgorithms then
  begin
    ExtractEncryptionAlgorithm(AData);
  end;

  CheckCertificate(ACertificate);

  Result := TclCryptData.Create();
  try
    ZeroMemory(@decryptPara, SizeOf(decryptPara));
    decryptPara.cbSize := SizeOf(decryptPara);
    decryptPara.dwMsgAndCertEncodingType := FEncodingType;
    decryptPara.rghCertStore := @rghCertStore[0];
    decryptPara.cCertStore := 1;
    cbDecrypted := 0;

    hStore := CertOpenStore(CERT_STORE_PROV_MEMORY, 0, nil, 0, nil);
    try
      if (hStore = nil)
        or (not CertAddCertificateContextToStore(hStore, ACertificate.Context, CERT_STORE_ADD_NEW, nil)) then
      begin
        RaiseCryptError('CertAddCertificateContextToStore');
      end;
      rghCertStore[0] := hStore;
      if CryptDecryptMessage(@decryptPara, AData.Data, AData.DataSize, nil, @cbDecrypted, nil) then
      begin
        Result.Allocate(cbDecrypted);
        if CryptDecryptMessage(@decryptPara, AData.Data, AData.DataSize, Result.Data, @cbDecrypted, nil) then
        begin
          Result.Reduce(cbDecrypted);
          Exit;
        end;
      end;

      RaiseCryptError('Decrypt');
    finally
      if (hStore <> nil) then
      begin
        CertCloseStore(hStore, 0);
      end;
    end;
  except
    Result.Free();
    raise;
  end;
{$IFDEF LOGGER}clPutLogMessage(Self, edLeave, 'Decrypt'); except on E: Exception do begin clPutLogMessage(Self, edLeave, 'Decrypt', E); raise; end; end;{$ENDIF}
end;

procedure TclEncryptor.Decrypt(ASource, ADestination: TStream; ACertificate: TclCertificate);
var
  srcData, dstData: TclCryptData;
  sourceSize, sourceStart: Integer;
begin
  sourceSize := ASource.Size - ASource.Position;
  sourceStart := ASource.Position;
  DoProgress(ASource.Position - sourceStart, sourceSize);

  srcData := nil;
  dstData := nil;
  try
    srcData := TclCryptData.Create();
    srcData.Allocate(ASource.Size - ASource.Position);

    ASource.Read(srcData.Data^, srcData.DataSize);

    dstData := Decrypt(srcData, ACertificate);
    ADestination.Write(dstData.Data^, dstData.DataSize);
  finally
    dstData.Free();
    srcData.Free();
  end;

  DoProgress(ASource.Position - sourceStart, sourceSize);
end;

procedure TclEncryptor.Decrypt(ASource, ADestination: TStream);
begin
  Decrypt(ASource, ADestination, GetCertificate(EncryptStore, EncryptCertificate, True));
end;

procedure TclEncryptor.Decrypt(const ASourceFile, ADestinationFile: string);
var
  src, dst: TStream;
begin
  src := nil;
  dst := nil;
  try
    src := TFileStream.Create(ASourceFile, fmOpenRead or fmShareDenyWrite);
    dst := TFileStream.Create(ADestinationFile, fmCreate);

    Decrypt(src, dst);
  finally
    dst.Free();
    src.Free();
  end;
end;

function TclEncryptor.Decrypt(const AData: TclByteArray; ACertificate: TclCertificate): TclByteArray;
var
  cryptData, cryptResult: TclCryptData;
begin
  cryptData := nil;
  cryptResult := nil;
  try
    cryptData := TclCryptData.Create();

    cryptData.FromBytes(AData);

    cryptResult := Decrypt(cryptData, ACertificate);

    Result := cryptResult.ToBytes();
  finally
    cryptResult.Free();
    cryptData.Free();
  end;
end;

destructor TclEncryptor.Destroy;
begin
  Close();
  FreeAndNil(FCertificateStore);
  FExtractedCertificates.Free();

  inherited Destroy();
end;

procedure TclEncryptor.DoProgress(ABytesProceed, ATotalBytes: Int64);
begin
  if Assigned(FOnProgress) then
  begin
    FOnProgress(Self, ABytesProceed, ATotalBytes);
  end;
end;

function TclEncryptor.Encrypt(const AData: TclCryptData; ACertificate: TclCertificate): TclCryptData;
var
  list: TclCertificateList;
begin
  list := TclCertificateList.Create(False);
  try
    list.Add(ACertificate);
    Result := Encrypt(AData, list);
  finally
    list.Free();
  end;
end;

function TclEncryptor.ExtractCertificates(const ASourceFile: string): TclCertificateList;
var
  src: TStream;
begin
  src := TFileStream.Create(ASourceFile, fmOpenRead or fmShareDenyWrite);
  try
    Result := ExtractCertificates(src);
  finally
    src.Free();
  end;
end;

function TclEncryptor.ExtractCertificates(ASource: TStream): TclCertificateList;
var
  srcData: TclCryptData;
  sourceSize, sourceStart: Integer;
begin
  sourceSize := ASource.Size - ASource.Position;
  sourceStart := ASource.Position;
  DoProgress(ASource.Position - sourceStart, sourceSize);

  srcData := TclCryptData.Create();
  try
    srcData.FromStream(ASource);

    Result := ExtractCertificates(srcData);
  finally
    srcData.Free();
  end;

  DoProgress(ASource.Position - sourceStart, sourceSize);
end;

function TclEncryptor.Encrypt(const AData: TclByteArray; ACertificates: TclCertificateList): TclByteArray;
var
  cryptData, cryptResult: TclCryptData;
begin
  cryptData := nil;
  cryptResult := nil;
  try
    cryptData := TclCryptData.Create();

    cryptData.FromBytes(AData);

    cryptResult := Encrypt(cryptData, ACertificates);

    Result := cryptResult.ToBytes();
  finally
    cryptResult.Free();
    cryptData.Free();
  end;
end;

function TclEncryptor.ExtractAlgorithm(AData: TclCryptData; AlgType: Integer): string;
var
  hMsg: HCRYPTMSG;
  param: TclCryptData;
  len: DWORD;
  alfId: PCRYPT_ALGORITHM_IDENTIFIER;
  buf: TclByteArray;
begin
  hMsg := CryptMsgOpenToDecode(DefaultEncoding, 0, 0, nil, nil, nil);
  if (hMsg = nil) then
  begin
    RaiseCryptError('CryptMsgOpenToDecode');
  end;
  try
    if not CryptMsgUpdate(hMsg, AData.Data, AData.DataSize, True) then
    begin
      RaiseCryptError('CryptMsgUpdate');
    end;

    param := TclCryptData.Create();
    try
      len := 0;
      if not CryptMsgGetParam(hMsg, AlgType, 0, nil, @len) then
      begin
        RaiseCryptError('CryptMsgGetParam');
      end;

      param.Allocate(len);
      if not CryptMsgGetParam(hMsg, AlgType, 0, param.Data, @len) then
      begin
        RaiseCryptError('CryptMsgGetParam');
      end;

      param.Reduce(len);

      alfId := PCRYPT_ALGORITHM_IDENTIFIER(param.Data);

      len := Length(alfId.pszObjId);
      SetLength(buf, len);
      system.Move(alfId.pszObjId^, buf[0], len);

      Result := TclTranslator.GetString(buf, 0, len, '');
    finally
      param.Free();
    end;
  finally
    CryptMsgClose(hMsg);
  end;
end;

function TclEncryptor.ExtractCertificates(const AData: TclCryptData): TclCertificateList;
begin
  ExtractedCertificates.Items.Clear();
  ExtractedCertificates.ImportFromMessage(AData);
  Result := ExtractedCertificates.Items;
end;

function TclEncryptor.ExtractEncryptionAlgorithm(const ASourceFile: string): string;
var
  src: TStream;
begin
  src := TFileStream.Create(ASourceFile, fmOpenRead or fmShareDenyWrite);
  try
    Result := ExtractEncryptionAlgorithm(src);
  finally
    src.Free();
  end;
end;

function TclEncryptor.ExtractEncryptionAlgorithm(ASource: TStream): string;
var
  srcData: TclCryptData;
  sourceSize, sourceStart: Integer;
begin
  sourceSize := ASource.Size - ASource.Position;
  sourceStart := ASource.Position;
  DoProgress(ASource.Position - sourceStart, sourceSize);

  srcData := TclCryptData.Create();
  try
    srcData.FromStream(ASource);

    Result := ExtractEncryptionAlgorithm(srcData);
  finally
    srcData.Free();
  end;

  DoProgress(ASource.Position - sourceStart, sourceSize);
end;

function TclEncryptor.ExtractEncryptionAlgorithm(const AData: TclCryptData): string;
begin
  FExtractedAlgorithm := ExtractAlgorithm(AData, CMSG_ENVELOPE_ALGORITHM_PARAM);
  Result := FExtractedAlgorithm;
end;

function TclEncryptor.ExtractHashAlgorithm(const AData: TclByteArray): string;
var
  cryptData: TclCryptData;
begin
  cryptData := TclCryptData.Create();
  try
    cryptData.FromBytes(AData);
    Result := ExtractHashAlgorithm(cryptData);
  finally
    cryptData.Free();
  end;
end;

function TclEncryptor.ExtractHashAlgorithm(const ASourceFile: string): string;
var
  src: TStream;
begin
  src := TFileStream.Create(ASourceFile, fmOpenRead or fmShareDenyWrite);
  try
    Result := ExtractHashAlgorithm(src);
  finally
    src.Free();
  end;
end;

function TclEncryptor.ExtractHashAlgorithm(ASource: TStream): string;
var
  srcData: TclCryptData;
  sourceSize, sourceStart: Integer;
begin
  sourceSize := ASource.Size - ASource.Position;
  sourceStart := ASource.Position;
  DoProgress(ASource.Position - sourceStart, sourceSize);

  srcData := TclCryptData.Create();
  try
    srcData.FromStream(ASource);

    Result := ExtractHashAlgorithm(srcData);
  finally
    srcData.Free();
  end;

  DoProgress(ASource.Position - sourceStart, sourceSize);
end;

function TclEncryptor.ExtractHashAlgorithm(const AData: TclCryptData): string;
begin
  FExtractedAlgorithm := ExtractAlgorithm(AData, CMSG_SIGNER_HASH_ALGORITHM_PARAM);
  Result := FExtractedAlgorithm;
end;

procedure TclEncryptor.Encrypt(const ASourceFile, ADestinationFile: string);
var
  src, dst: TStream;
begin
  src := nil;
  dst := nil;
  try
    src := TFileStream.Create(ASourceFile, fmOpenRead or fmShareDenyWrite);
    dst := TFileStream.Create(ADestinationFile, fmCreate);

    Encrypt(src, dst);
  finally
    dst.Free();
    src.Free();
  end;
end;

procedure TclEncryptor.Encrypt(ASource, ADestination: TStream);
var
  list: TclCertificateList;
  cert: TclCertificate;
begin
  list := TclCertificateList.Create(False);
  try
    cert := GetCertificate(EncryptStore, EncryptCertificate, False);
    list.Add(cert);
    Encrypt(ASource, ADestination, list);
  finally
    list.Free();
  end;
end;

procedure TclEncryptor.Encrypt(ASource, ADestination: TStream; ACertificates: TclCertificateList);
var
  srcData, dstData: TclCryptData;
  sourceSize, sourceStart: Integer;
begin
  sourceSize := ASource.Size - ASource.Position;
  sourceStart := ASource.Position;
  DoProgress(ASource.Position - sourceStart, sourceSize);

  srcData := nil;
  dstData := nil;
  try
    srcData := TclCryptData.Create();
    srcData.Allocate(ASource.Size - ASource.Position);

    ASource.Read(srcData.Data^, srcData.DataSize);

    dstData := Encrypt(srcData, ACertificates);
    ADestination.Write(dstData.Data^, dstData.DataSize);
  finally
    dstData.Free();
    srcData.Free();
  end;

  DoProgress(ASource.Position - sourceStart, sourceSize);
end;

function TclEncryptor.FindCertificate(AStore: TclCertificateStore;
  const ACertificate: string; ARequirePrivateKey: Boolean): TclCertificate;
begin
  Result := AStore.FindByEmail(ACertificate, ARequirePrivateKey);
  if (Result = nil) then
  begin
    Result := AStore.FindByIssuedTo(ACertificate, ARequirePrivateKey);
  end;
  if (Result = nil) then
  begin
    Result := AStore.FindBySerialNo(ACertificate, '', ARequirePrivateKey);
  end;
end;

function TclEncryptor.GetCertificate(const AStoreName, ACertificate: string; ARequirePrivateKey: Boolean): TclCertificate;
begin
  if (AStoreName <> '') and (ACertificate <> '') then
  begin
    Result := FindCertificate(GetCertificateStore(AStoreName), ACertificate, ARequirePrivateKey);
  end else
  begin
    Result := nil;
  end;
end;

function TclEncryptor.GetCertificateStore(const AStoreName: string): TclCertificateStore;
begin
  if (FCertificateStore = nil) then
  begin
    FCertificateStore := TclCertificateStore.Create(nil);
    FCertificateStore.Open(AStoreName);
  end;
  Result := FCertificateStore;

  if (Result.StoreName <> AStoreName) then
  begin
    Result.Open(AStoreName);
  end;
end;

function TclEncryptor.GetExtractedAlgorithmName: string;
var
  pOidInfo: PCCRYPT_OID_INFO;
  s: string;
begin
  Result := ExtractedAlgorithm;

  if (Result = '') then Exit;

  pOidInfo := CryptFindOIDInfo(CRYPT_OID_INFO_OID_KEY, PclChar(GetTclString(Result)), 0);

  if (pOidInfo <> nil) then
  begin
    s := string(WideString(pOidInfo.pwszName));
    Result := system.Copy(s, 1, Length(s));
  end;
end;

function TclEncryptor.GetExtractedCertificate: TclCertificate;
begin
  Result := FindCertificate(ExtractedCertificates, SignCertificate, False);

  if (Result = nil) and (ExtractedCertificates.Items.Count > 0) then
  begin
    Result := ExtractedCertificates.Items[0];
  end;
end;

function TclEncryptor.Sign(const AData: TclCryptData; ADetachedSignature, AIncludeCertificate: Boolean;
  ACertificate: TclCertificate; AExtraCerts: TclCertificateList): TclCryptData;
var
  data: array[0..0] of PByte;
  msgCert: PCCERT_CONTEXT;
  dwDataSizeArray: array[0..0] of DWORD;
  sigParams: CRYPT_SIGN_MESSAGE_PARA;
  cbSignedBlob: DWORD;
  p: ^PCCERT_CONTEXT;
  i, cnt: Integer;
begin
{$IFDEF DEMO}
{$IFNDEF STANDALONEDEMO}
  if FindWindow('TAppBuilder', nil) = 0 then
  begin
    MessageBox(0, 'This demo version can be run under Delphi/C++Builder IDE only. ' +
      'Please visit www.clevercomponents.com to purchase your ' +
      'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    ExitProcess(1);
  end else
{$ENDIF}
  begin
{$IFNDEF IDEDEMO}
    if (not IsEncryptorDemoDisplayed) and (not IsCertDemoDisplayed) then
    begin
      MessageBox(0, 'Please visit www.clevercomponents.com to purchase your ' +
        'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    end;
    IsEncryptorDemoDisplayed := True;
    IsCertDemoDisplayed := True;
{$ENDIF}
  end;
{$ENDIF}

  CheckCertificate(ACertificate);

{$IFDEF LOGGER}try clPutLogMessage(Self, edEnter, 'Sign');{$ENDIF}
  Result := TclCryptData.Create();
  try
    ZeroMemory(@sigParams, SizeOf(CRYPT_SIGN_MESSAGE_PARA));
    sigParams.cbSize := SizeOf(CRYPT_SIGN_MESSAGE_PARA);
    sigParams.dwMsgEncodingType := FEncodingType;
    sigParams.pSigningCert := ACertificate.Context;
    sigParams.HashAlgorithm.pszObjId := PclChar(GetTclString(FSignAlgorithm));

    if (AExtraCerts <> nil) then
    begin
      cnt := AExtraCerts.Count;
    end else
    begin
      cnt := 0;
    end;

    GetMem(msgCert, SizeOf(PCCERT_CONTEXT) * (cnt + 1));
    try
      if AIncludeCertificate then
      begin
        p := Pointer(TclIntPtr(msgCert) + SizeOf(PCCERT_CONTEXT) * 0);
        p^ := ACertificate.Context;

        for i := 0 to cnt - 1 do
        begin
          p := Pointer(TclIntPtr(msgCert) + SizeOf(PCCERT_CONTEXT) * (i + 1));
          p^ := AExtraCerts[i].Context;
        end;

        sigParams.cMsgCert := cnt + 1;
        sigParams.rgpMsgCert := msgCert;
      end;

      data[0] := AData.Data;
      dwDataSizeArray[0] := AData.DataSize;
      cbSignedBlob := 0;
      if CryptSignMessage(@sigParams, ADetachedSignature, 1, @data[0], @dwDataSizeArray[0], nil, @cbSignedBlob) then
      begin
        Result.Allocate(cbSignedBlob);
        if CryptSignMessage(@sigParams, ADetachedSignature, 1, @data[0], @dwDataSizeArray[0], Result.Data, @cbSignedBlob) then
        begin
          Result.Reduce(cbSignedBlob);
          Exit;
        end;
      end;

      RaiseCryptError('Sign');
    finally
      FreeMem(msgCert);
    end;
  except
    Result.Free();
    raise;
  end;
{$IFDEF LOGGER}clPutLogMessage(Self, edLeave, 'Sign'); except on E: Exception do begin clPutLogMessage(Self, edLeave, 'Sign', E); raise; end; end;{$ENDIF}
end;

function TclEncryptor.Sign(const AData: TclCryptData; ADetachedSignature, AIncludeCertificate: Boolean;
  ACertificate: TclCertificate): TclCryptData;
begin
  Result := Sign(AData, ADetachedSignature, AIncludeCertificate, ACertificate, nil);
end;

procedure TclEncryptor.Sign(const ASourceFile, ADestinationFile: string; ADetachedSignature: Boolean);
var
  src, dst: TStream;
begin
  src := nil;
  dst := nil;
  try
    src := TFileStream.Create(ASourceFile, fmOpenRead or fmShareDenyWrite);
    dst := TFileStream.Create(ADestinationFile, fmCreate);

    Sign(src, dst, ADetachedSignature);
  finally
    dst.Free();
    src.Free();
  end;
end;

procedure TclEncryptor.Sign(ASource, ADestination: TStream; ADetachedSignature: Boolean);
begin
  Sign(ASource, ADestination, ADetachedSignature, True, GetCertificate(SignStore, SignCertificate, True), nil);
end;

procedure TclEncryptor.Sign(ASource, ADestination: TStream; ADetachedSignature,
  AIncludeCertificate: Boolean; ACertificate: TclCertificate; AExtraCerts: TclCertificateList);
var
  srcData, dstData: TclCryptData;
  sourceSize, sourceStart: Integer;
begin
  sourceSize := ASource.Size - ASource.Position;
  sourceStart := ASource.Position;
  DoProgress(ASource.Position - sourceStart, sourceSize);

  srcData := nil;
  dstData := nil;
  try
    srcData := TclCryptData.Create();
    srcData.Allocate(ASource.Size - ASource.Position);

    ASource.Read(srcData.Data^, srcData.DataSize);

    dstData := Sign(srcData, ADetachedSignature, AIncludeCertificate, ACertificate, AExtraCerts);
    ADestination.Write(dstData.Data^, dstData.DataSize);
  finally
    dstData.Free();
    srcData.Free();
  end;

  DoProgress(ASource.Position - sourceStart, sourceSize);
end;

function GetSignerCertificate(pvGetArg: PVOID;
  dwCertEncodingType: DWORD; pSignerId: PCERT_INFO;
  hMsgCertStore: HCERTSTORE): PCCERT_CONTEXT; stdcall;
begin
  Result := CertDuplicateCertificateContext(PCCERT_CONTEXT(pvGetArg));
end;

procedure TclEncryptor.VerifyDetached(const AData, ASignature: TclCryptData; ACertificate: TclCertificate);
var
  verifyPara: CRYPT_VERIFY_MESSAGE_PARA;
  rgpbToBeSigned: array[0..0] of PBYTE;
  rgcbToBeSigned: array[0..0] of DWORD;
begin
{$IFDEF DEMO}
{$IFNDEF STANDALONEDEMO}
  if FindWindow('TAppBuilder', nil) = 0 then
  begin
    MessageBox(0, 'This demo version can be run under Delphi/C++Builder IDE only. ' +
      'Please visit www.clevercomponents.com to purchase your ' +
      'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    ExitProcess(1);
  end else
{$ENDIF}
  begin
{$IFNDEF IDEDEMO}
    if (not IsEncryptorDemoDisplayed) and (not IsCertDemoDisplayed) then
    begin
      MessageBox(0, 'Please visit www.clevercomponents.com to purchase your ' +
        'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    end;
    IsEncryptorDemoDisplayed := True;
    IsCertDemoDisplayed := True;
{$ENDIF}
  end;
{$ENDIF}

{$IFDEF LOGGER}try clPutLogMessage(Self, edEnter, 'VerifyDetached');{$ENDIF}
  if IsExtractCertificates then
  begin
    ExtractCertificates(ASignature);
  end;

  if IsExtractAlgorithms then
  begin
    ExtractHashAlgorithm(ASignature);
  end;

  if (ACertificate = nil) then
  begin
    ACertificate := GetExtractedCertificate();
  end;

  CheckCertificate(ACertificate);

  ZeroMemory(@verifyPara, SizeOf(verifyPara));
  verifyPara.cbSize := SizeOf(verifyPara);
  verifyPara.dwMsgAndCertEncodingType := FEncodingType;
  verifyPara.pfnGetSignerCertificate := GetSignerCertificate;
  verifyPara.pvGetArg := ACertificate.Context;
  rgpbToBeSigned[0] := AData.Data;
  rgcbToBeSigned[0] := AData.DataSize;
  if not CryptVerifyDetachedMessageSignature(@verifyPara,
    0, ASignature.Data, ASignature.DataSize, 1, @rgpbToBeSigned[0], @rgcbToBeSigned[0], nil) then
  begin
    RaiseCryptError('CryptVerifyDetachedMessageSignature');
  end;
{$IFDEF LOGGER}clPutLogMessage(Self, edLeave, 'VerifyDetached'); except on E: Exception do begin clPutLogMessage(Self, edLeave, 'VerifyDetached', E); raise; end; end;{$ENDIF}
end;

procedure TclEncryptor.VerifyEnveloped(const ASourceFile, ADestinationFile: string);
var
  src, dst: TStream;
begin
  src := nil;
  dst := nil;
  try
    src := TFileStream.Create(ASourceFile, fmOpenRead or fmShareDenyWrite);
    dst := TFileStream.Create(ADestinationFile, fmCreate);

    VerifyEnveloped(src, dst);
  finally
    dst.Free();
    src.Free();
  end;
end;

procedure TclEncryptor.VerifyEnveloped(ASource, ADestination: TStream);
begin
  VerifyEnveloped(ASource, ADestination, GetCertificate(SignStore, SignCertificate, False));
end;

procedure TclEncryptor.VerifyEnveloped(ASource, ADestination: TStream; ACertificate: TclCertificate);
var
  srcData, dstData: TclCryptData;
  sourceSize, sourceStart: Integer;
begin
  sourceSize := ASource.Size - ASource.Position;
  sourceStart := ASource.Position;
  DoProgress(ASource.Position - sourceStart, sourceSize);

  srcData := nil;
  dstData := nil;
  try
    srcData := TclCryptData.Create();
    srcData.Allocate(ASource.Size - ASource.Position);

    ASource.Read(srcData.Data^, srcData.DataSize);

    dstData := VerifyEnveloped(srcData, ACertificate);
    ADestination.Write(dstData.Data^, dstData.DataSize);
  finally
    dstData.Free();
    srcData.Free();
  end;

  DoProgress(ASource.Position - sourceStart, sourceSize);
end;

procedure TclEncryptor.VerifyDetached(ASource, ASignature: TStream; ACertificate: TclCertificate);
var
  srcData, sigData: TclCryptData;
  sourceSize, sourceStart: Integer;
begin
  sourceSize := ASource.Size - ASource.Position;
  sourceStart := ASource.Position;
  DoProgress(ASource.Position - sourceStart, sourceSize);

  srcData := nil;
  sigData := nil;
  try
    srcData := TclCryptData.Create();
    srcData.Allocate(ASource.Size - ASource.Position);
    ASource.Read(srcData.Data^, srcData.DataSize);

    sigData := TclCryptData.Create();
    sigData.Allocate(ASignature.Size - ASignature.Position);
    ASignature.Read(sigData.Data^, sigData.DataSize);

    VerifyDetached(srcData, sigData, ACertificate);
  finally
    sigData.Free();
    srcData.Free();
  end;

  DoProgress(ASource.Position - sourceStart, sourceSize);
end;

procedure TclEncryptor.VerifyDetached(ASource, ASignature: TStream);
begin
  VerifyDetached(ASource, ASignature, GetCertificate(SignStore, SignCertificate, False));
end;

procedure TclEncryptor.VerifyDetached(const ASourceFile, ASignatureFile: string);
var
  src, sig: TStream;
begin
  src := nil;
  sig := nil;
  try
    src := TFileStream.Create(ASourceFile, fmOpenRead or fmShareDenyWrite);
    sig := TFileStream.Create(ASignatureFile, fmOpenRead or fmShareDenyWrite);

    VerifyDetached(src, sig);
  finally
    sig.Free();
    src.Free();
  end;
end;

function TclEncryptor.VerifyEnveloped(const AData: TclCryptData; ACertificate: TclCertificate): TclCryptData;
var
  verifyPara: CRYPT_VERIFY_MESSAGE_PARA;
  cbVerified: DWORD;
begin
{$IFDEF DEMO}
{$IFNDEF STANDALONEDEMO}
  if FindWindow('TAppBuilder', nil) = 0 then
  begin
    MessageBox(0, 'This demo version can be run under Delphi/C++Builder IDE only. ' +
      'Please visit www.clevercomponents.com to purchase your ' +
      'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    ExitProcess(1);
  end else
{$ENDIF}
  begin
{$IFNDEF IDEDEMO}
    if (not IsEncryptorDemoDisplayed) and (not IsCertDemoDisplayed) then
    begin
      MessageBox(0, 'Please visit www.clevercomponents.com to purchase your ' +
        'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    end;
    IsEncryptorDemoDisplayed := True;
    IsCertDemoDisplayed := True;
{$ENDIF}
  end;
{$ENDIF}

{$IFDEF LOGGER}try clPutLogMessage(Self, edEnter, 'VerifyEnveloped');{$ENDIF}
  if IsExtractCertificates then
  begin
    ExtractCertificates(AData);
  end;

  if IsExtractAlgorithms then
  begin
    ExtractHashAlgorithm(AData);
  end;

  if (ACertificate = nil) then
  begin
    ACertificate := GetExtractedCertificate();
  end;

  CheckCertificate(ACertificate);

  Result := TclCryptData.Create();
  try
    ZeroMemory(@verifyPara, SizeOf(verifyPara));
    verifyPara.cbSize := SizeOf(verifyPara);
    verifyPara.dwMsgAndCertEncodingType := FEncodingType;
    verifyPara.pfnGetSignerCertificate := GetSignerCertificate;
    verifyPara.pvGetArg := ACertificate.Context;
    cbVerified := 0;
    if CryptVerifyMessageSignature(@verifyPara, 0, AData.Data, AData.DataSize, nil, @cbVerified, nil) then
    begin
      Result.Allocate(cbVerified);
      if CryptVerifyMessageSignature(@verifyPara, 0, AData.Data, AData.DataSize, Result.Data, @cbVerified, nil) then
      begin
        Result.Reduce(cbVerified);
        Exit;
      end;
    end;

    RaiseCryptError('VerifyEnveloped');
  except
    Result.Free();
    raise;
  end;
{$IFDEF LOGGER}clPutLogMessage(Self, edLeave, 'VerifyEnveloped'); except on E: Exception do begin clPutLogMessage(Self, edLeave, 'VerifyEnveloped', E); raise; end; end;{$ENDIF}
end;

function TclEncryptor.Encrypt(const AData: TclCryptData; ACertificates: TclCertificateList): TclCryptData;
var
  i: Integer;
  encryptPara: CRYPT_ENCRYPT_MESSAGE_PARA;
  cbEncrypted: DWORD;
  gpRecipientCerts: PCCERT_CONTEXT;
  p: ^PCCERT_CONTEXT;
begin
{$IFDEF DEMO}
{$IFNDEF STANDALONEDEMO}
  if FindWindow('TAppBuilder', nil) = 0 then
  begin
    MessageBox(0, 'This demo version can be run under Delphi/C++Builder IDE only. ' +
      'Please visit www.clevercomponents.com to purchase your ' +
      'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    ExitProcess(1);
  end else
{$ENDIF}
  begin
{$IFNDEF IDEDEMO}
    if (not IsEncryptorDemoDisplayed) and (not IsCertDemoDisplayed) then
    begin
      MessageBox(0, 'Please visit www.clevercomponents.com to purchase your ' +
        'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    end;
    IsEncryptorDemoDisplayed := True;
    IsCertDemoDisplayed := True;
{$ENDIF}
  end;
{$ENDIF}

  CheckCertificates(ACertificates);

  Result := TclCryptData.Create();
  try
    ZeroMemory(@encryptPara, SizeOf(encryptPara));
    encryptPara.cbSize := SizeOf(encryptPara);
    encryptPara.dwMsgEncodingType := FEncodingType;
    encryptPara.ContentEncryptionAlgorithm.pszObjId := PclChar(GetTclString(FEncryptAlgorithm));

    GetMem(gpRecipientCerts, SizeOf(PCCERT_CONTEXT) * ACertificates.Count);
    try
      for i := 0 to ACertificates.Count - 1 do
      begin
        p := Pointer(TclIntPtr(gpRecipientCerts) + SizeOf(PCCERT_CONTEXT) * i);
        p^ := ACertificates[i].Context;
      end;

      cbEncrypted := 0;
      if CryptEncryptMessage(@encryptPara, ACertificates.Count, gpRecipientCerts, AData.Data, AData.DataSize, nil, @cbEncrypted) then
      begin
        Result.Allocate(cbEncrypted);
        if CryptEncryptMessage(@encryptPara, ACertificates.Count, gpRecipientCerts, AData.Data, AData.DataSize, Result.Data, @cbEncrypted) then
        begin
          Result.Reduce(cbEncrypted);
          Exit;
        end;
      end;
    finally
      FreeMem(gpRecipientCerts);
    end;

    RaiseCryptError('Encrypt');
  except
    Result.Free();
    raise;
  end;
end;

function TclEncryptor.ExtractCertificates(const AData: TclByteArray): TclCertificateList;
var
  cryptData: TclCryptData;
begin
  cryptData := TclCryptData.Create();
  try
    cryptData.FromBytes(AData);
    Result := ExtractCertificates(cryptData);
  finally
    cryptData.Free();
  end;
end;

function TclEncryptor.ExtractEncryptionAlgorithm(const AData: TclByteArray): string;
var
  cryptData: TclCryptData;
begin
  cryptData := TclCryptData.Create();
  try
    cryptData.FromBytes(AData);
    Result := ExtractEncryptionAlgorithm(cryptData);
  finally
    cryptData.Free();
  end;
end;

function TclEncryptor.Encrypt(const AData: TclByteArray; ACertificate: TclCertificate): TclByteArray;
var
  cryptData, cryptResult: TclCryptData;
begin
  cryptData := nil;
  cryptResult := nil;
  try
    cryptData := TclCryptData.Create();

    cryptData.FromBytes(AData);

    cryptResult := Encrypt(cryptData, ACertificate);

    Result := cryptResult.ToBytes();
  finally
    cryptResult.Free();
    cryptData.Free();
  end;
end;

procedure TclEncryptor.VerifyDetached(const AData, ASignature: TclByteArray; ACertificate: TclCertificate);
var
  cryptData, cryptSignature: TclCryptData;
begin
  cryptData := nil;
  cryptSignature := nil;
  try
    cryptData := TclCryptData.Create();
    cryptSignature := TclCryptData.Create();

    cryptData.FromBytes(AData);
    cryptSignature.FromBytes(ASignature);

    VerifyDetached(cryptData, cryptSignature, ACertificate);
  finally
    cryptSignature.Free();
    cryptData.Free();
  end;
end;

function TclEncryptor.VerifyEnveloped(const AData: TclByteArray; ACertificate: TclCertificate): TclByteArray;
var
  cryptData, cryptResult: TclCryptData;
begin
  cryptData := nil;
  cryptResult := nil;
  try
    cryptData := TclCryptData.Create();

    cryptData.FromBytes(AData);

    cryptResult := VerifyEnveloped(cryptData, ACertificate);

    Result := cryptResult.ToBytes();
  finally
    cryptResult.Free();
    cryptData.Free();
  end;
end;

function TclEncryptor.Sign(const AData: TclByteArray; ADetachedSignature,
  AIncludeCertificate: Boolean; ACertificate: TclCertificate): TclByteArray;
var
  cryptData, cryptResult: TclCryptData;
begin
  cryptData := nil;
  cryptResult := nil;
  try
    cryptData := TclCryptData.Create();

    cryptData.FromBytes(AData);

    cryptResult := Sign(cryptData, ADetachedSignature, AIncludeCertificate, ACertificate);

    Result := cryptResult.ToBytes();
  finally
    cryptResult.Free();
    cryptData.Free();
  end;
end;

function TclEncryptor.Sign(const AData: TclByteArray; ADetachedSignature,
  AIncludeCertificate: Boolean; ACertificate: TclCertificate;
  AExtraCerts: TclCertificateList): TclByteArray;
var
  cryptData, cryptResult: TclCryptData;
begin
  cryptData := nil;
  cryptResult := nil;
  try
    cryptData := TclCryptData.Create();

    cryptData.FromBytes(AData);

    cryptResult := Sign(cryptData, ADetachedSignature, AIncludeCertificate, ACertificate, AExtraCerts);

    Result := cryptResult.ToBytes();
  finally
    cryptResult.Free();
    cryptData.Free();
  end;
end;

end.
