{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: Windows cryptographic API wrappers for easy  | }
{ |                usage.                                       | }
{ |                                                             | }
{ |   Copyright (C) - 2003 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code dstributed under MIT license.                 | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMWinCrypt;

interface
                                                                                                         
uses {$IFNDEF JEDIAPI}Windows{$ELSE}jwaWinType{$ENDIF}, jwaWinCrypt, GMStrDef, GMActiveX, GMIntf, GMCommon;


const

  cDfltKeyFlags = CRYPT_EXPORTABLE or CRYPT_NO_SALT;
  cDfltKeyKind = AT_SIGNATURE;

  cDfltCryptAlgoId = CALG_RC4;
  cDfltKeyDataHashAlgoId = CALG_MD5;


type

  TGMCryptKeyFunction = function: AnsiString;

  EGMCryptException = class(EAPIException);


  // -------------------------------------------- //
  // ---- Smart cryptographic helper classes ---- //
  // -------------------------------------------- //

  TGMCryptBaseClass = class(TGMRefCountedObj, IGMGetHandle)
   protected
    FHandle: THandle;
    function GetHandle: THandle; stdcall;
   public
    constructor Create(const ARefLifeTime: Boolean = True); override;
    property Handle: THandle read FHandle;
  end;


  TGMCryptServiceProvider = class(TGMCryptBaseClass)
   public
    constructor Create(const AProviderType: LongWord; const AContainerName, AProviderName: PGMChar; const AFlags: LongWord = 0); reintroduce;
    destructor Destroy; override;
  end;


  TGMCryptProviderDependent = class(TGMCryptBaseClass)
   protected
    FCSProvider: IUnknown;
    function CryptProviderHandle: THandle;
   public
    constructor Create(const ACSProvider: IUnknown); reintroduce;
  end;


  IGMCryptHash = interface(IGMGetHandle)
    ['{A44DEA4E-395A-47a3-9B06-668DB0C8D010}']
    procedure HashData(pbData: Pointer; dwDataLen: DWORD; dwFlags: DWORD = 0);
    procedure HashSessionKey(hKey: HCRYPTKEY; dwFlags: DWORD = 0);
    procedure GetHashParam(dwParam: DWORD; pbData: Pointer; dwDataLen: DWORD);
    function DataSize: DWORD;
  end;


  TGMCryptHash = class(TGMCryptProviderDependent, IGMCryptHash)
   public
    constructor Create(const ACSProvider: IUnknown; const AAlgoId: ALG_ID; const AKey: IUnknown = nil; const AFlags: DWORD = 0);
    destructor Destroy; override;

    procedure HashData(pbData: Pointer; dwDataLen: DWORD; dwFlags: DWORD = 0);
    procedure HashSessionKey(hKey: HCRYPTKEY; dwFlags: DWORD = 0);
    procedure GetHashParam(dwParam: DWORD; pbData: Pointer; dwDataLen: DWORD);
    function DataSize: DWORD;
  end;


  TGMCryptKey = class(TGMCryptProviderDependent)
   public
    constructor Derive(const ACSProvider: IUnknown; const ACryptAlgoId: ALG_ID; const AHash: IUnknown; AFlags: DWORD = cDfltKeyFlags);
    constructor Generate(const ACSProvider: IUnknown; const ACryptAlgoId: ALG_ID; const AFlags: DWORD = cDfltKeyFlags);
    constructor UserKey(const ACSProvider: IUnknown; const AKeyKind: DWORD = cDfltKeyKind);
    destructor Destroy; override;
  end;


  TGMCryptStream = class(TGMChainedIStream)
   protected
    FCryptKey: IGMGetHandle;

   public
    function Read(pv: Pointer; cb: LongInt; pcbRead: PLongint): HResult; override;
    function Write(pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult; override;

   public
    constructor CreateFromKeyData(const AChainedStream: IStream;
                                  const AKeyData: AnsiString;
                                  const AKeyDataHashAlgoId: ALG_ID = cDfltKeyDataHashAlgoId;
                                  const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId;
                                  const ARefLifeTime: Boolean = True);
  end;


  // ------------------------------------------ //
  // ---- Smart certificate helper classes ---- //
  // ------------------------------------------ //

  TGMWinCertificate = class;

  IGMWinCertificate = interface
    function Obj: TGMWinCertificate;
  end;

  TGMWinCertificate = class(TGMRefCountedObj, IGMWinCertificate)
   protected
    FFreeCertCtx: Boolean;
    FCertCtx: PCCERT_CONTEXT;

   public
    constructor Create(const ACertCtx: PCCERT_CONTEXT; const AFreeCertCtx: Boolean = True; const ARefLifeTime: Boolean = True); reintroduce;
    destructor Destroy; override;
    function Obj: TGMWinCertificate;
    function GetASN1EncodedData: AnsiString;
    function DisplayString: TGMString;
    function Subject: TGMString;
    function Issuer: TGMString;
    function NotBefore: TDateTime;
    function NotAfter: TDateTime;
    function PrivateKeyData: AnsiString;
  end;


  TGMWinCertStore = (wcsMy, wcsRoot, wcsTrust, wcsCA);

  TGMWinCertificateStorage = class;

  IGMCertificateStorage = interface
    function Obj: TGMWinCertificateStorage;
  end;

  TGMWinCertificateStorage = class(TGMRefCountedObj, IGMCertificateStorage)
   protected
    FCertStorage: HCERTSTORE;

   public
    constructor Create(const ACertificateStorageName: TGMString = 'MY';
                       const AFlags: DWORD = CERT_SYSTEM_STORE_CURRENT_USER;
                       const AStoreProvider: PAnsiChar = CERT_STORE_PROV_SYSTEM;
                       const ARefLifeTime: Boolean = True); reintroduce;

    destructor Destroy; override;
    function Obj: TGMWinCertificateStorage;
    function FindCertificate(const ACertName: TGMString;
                             const ASearchKind: DWORD = CERT_FIND_ISSUER_STR;
                             const AEncodingTypes: DWORD = X509_ASN_ENCODING): IGMWinCertificate;
  end;


// ------------------------- //
// ---- ALG_ID crackers ---- //
// ------------------------- //

function GET_ALG_CLASS(AAlgoId: ALG_ID): ALG_ID;
function GET_ALG_TYPE(AAlgoId: ALG_ID): ALG_ID;
function GET_ALG_SID(AAlgoId: ALG_ID): ALG_ID;


// ------------------------ //
// ---- Crypt Routines ---- //
// ------------------------ //

function GMRSAandAESCryptProvider: IGMGetHandle;
//function GMAESCryptProvider: IGMGetHandle;

function GMCreateCryptKeyFromData(const AKeyData: AnsiString; const AKeyDataHashAlgoId: ALG_ID = cDfltKeyDataHashAlgoId; const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId): IGMGetHandle;
//function GMUserCryptKey: AnsiString;
//function GMMachineCryptKey: AnsiString;


function GMCalcHashValue(const AData: Pointer; const ADataSize: DWORD; AAlgoId: ALG_ID = cDfltKeyDataHashAlgoId): AnsiString; overload;
function GMCalcHashValue(const AData: AnsiString; const AAlgoId: ALG_ID = cDfltKeyDataHashAlgoId): AnsiString; overload;

procedure GMKeyEncryptData(var AData: AnsiString; const AKey: IGMGetHandle; const ACaller: TObject = nil);
procedure GMKeyDecryptData(var AData: AnsiString; const AKey: IGMGetHandle; const ACaller: TObject = nil);

procedure GMKeyDataEncryptData(var AData: AnsiString; const AKeyData: AnsiString; const AKeyDataHashAlgoId: ALG_ID = cDfltKeyDataHashAlgoId; const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId; const ACaller: TObject = nil);
procedure GMKeyDataDecryptData(var AData: AnsiString; const AKeyData: AnsiString; const AKeyDataHashAlgoId: ALG_ID = cDfltKeyDataHashAlgoId; const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId; const ACaller: TObject = nil);

procedure GMHashEncryptData(var AData: AnsiString; const AHash: IGMCryptHash; const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId; const ACaller: TObject = nil);
procedure GMHashDecryptData(var AData: AnsiString; const AHash: IGMCryptHash; const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId; const ACaller: TObject = nil);

//function GMEncryptGuid(const AGuid: TGuid; const AKeyData: AnsiString; const ACaller: TObject = nil): TGuid;
//function GMDecryptGuid(const AGuid: TGuid; const AKeyData: AnsiString; const ACaller: TObject = nil): TGuid;

function GMEncryptStringA(const AValue, AKeyData: AnsiString; const AKeyDataHashAlgoId: ALG_ID = cDfltKeyDataHashAlgoId; const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId; const ACaller: TObject = nil): AnsiString;
function GMDecryptStringA(const AEncryptedRaw, AKeyData: AnsiString; const AKeyDataHashAlgoId: ALG_ID = cDfltKeyDataHashAlgoId; const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId; const ACaller: TObject = nil): AnsiString;

function GMEncryptStringW(const AValue: UnicodeString; const AKeyData: AnsiString; const AKeyDataHashAlgoId: ALG_ID = cDfltKeyDataHashAlgoId; const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId; const ACaller: TObject = nil): AnsiString;
function GMDecryptStringW(const AEncryptedRaw, AKeyData: AnsiString; const AKeyDataHashAlgoId: ALG_ID = cDfltKeyDataHashAlgoId; const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId; const ACaller: TObject = nil): UnicodeString;

function GMEncryptString(const AValue: TGMString; const AKeyData: AnsiString; const AKeyDataHashAlgoId: ALG_ID = cDfltKeyDataHashAlgoId; const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId; const ACaller: TObject = nil): AnsiString;
function GMDecryptString(const AEncryptedRaw, AKeyData: AnsiString; const AKeyDataHashAlgoId: ALG_ID = cDfltKeyDataHashAlgoId; const ACryptAlgoId: ALG_ID = cDfltCryptAlgoId; const ACaller: TObject = nil): TGMString;

//function GMUserEncryptStringA(const AValue: AnsiString; const ACaller: TObject = nil): AnsiString;
//function GMUserDecryptStringA(const AValue: AnsiString; const ACaller: TObject = nil): AnsiString;

//function GMReadEncryptedString(const DataStorage: IUnknown; const ValueName: TGMString; const DefaultValue: TGMString = ''): TGMString; overload;
//procedure GMWriteEncryptedString(const DataStorage: IUnknown; const ValueName, Value: TGMString; const ACaller: TObject = nil); overload;

//function GMReadEncryptedString(const DataStorage: IUnknown; const ValueName: TGMString; const Key: TGuid; const DefaultValue: TGMString = ''): TGMString; overload;
//procedure GMWriteEncryptedString(const DataStorage: IUnknown; const ValueName, Value: TGMString; const Key: TGuid; const ACaller: TObject = nil); overload;


//function GMHmacMd5(AData: Pointer; ADataSizeInBytes: LongInt; AKey: AnsiString): AnsiString; overload;
function GMHmacMd5(AData, AKey: AnsiString): AnsiString;


// ------------------------------ //
// ---- Certificate routines ---- //
// ------------------------------ //

function GMGetASN1EncodedCertData(const ACertificateName, ACertificateStorageName: TGMString;
                                  const ASearchKind: DWORD = CERT_FIND_ISSUER_STR;
                                  const ACertStoreFlags: DWORD = CERT_SYSTEM_STORE_CURRENT_USER;
                                  const AStoreProvider: PAnsiChar = CERT_STORE_PROV_SYSTEM): AnsiString;



procedure GMCryptCheck(const AValue: Boolean;
                       const AObj: TObject = nil;
                       const ARoutineName: TGMString = cDfltRoutineName;
                       const AHelpCtx: LongInt = cDfltHelpCtx);

procedure GMCryptCheckCode(const AReturnCode: DWORD;
                           const AObj: TObject = nil;
                           const ARoutineName: TGMString = cDfltRoutineName;
                           const AHelpCtx: LongInt = cDfltHelpCtx);


const

  cCertStoreName: array [TGMWinCertStore] of TGMString = ('MY', 'Root', 'Trust', 'CA');
                                                           

implementation

{$IFDEF JEDIAPI}uses jwaWinBase, jwaWinError;{$ENDIF}

var

  vCSCreateRSAandAESCryptProvider: IGMCriticalSection = nil;
  vRSAandAESCryptProvider: IGMGetHandle = nil;
//vAESCryptProvider: IGMGetHandle = nil;


resourcestring

  RStrTheHandle = 'The handle';

  RStrUsingCertificate = 'Using certificate: %s';

  //RStrSubject = 'Subject';
  //RStrIssuer = 'Issuer';
  RStrNotBefore = 'Not before';
  RStrNotAfter = 'Not after';

  

// ------------------------- //
// ---- ALG_ID crackers ---- //
// ------------------------- //

function GET_ALG_CLASS(AAlgoId: ALG_ID): ALG_ID;
begin
  Result := (AAlgoId and (7 shl 13));
end;

function GET_ALG_TYPE(AAlgoId: ALG_ID): ALG_ID;
begin
  Result := (AAlgoId and (15 shl 9));
end;

function GET_ALG_SID(AAlgoId: ALG_ID): ALG_ID;
begin
  Result := (AAlgoId and (511));
end;


// ------------------------ //
// ---- Error Handling ---- //
// ------------------------ //

procedure GMCryptCheck(const AValue: Boolean;
                       const AObj: TObject = nil;
                       const ARoutineName: TGMString = cDfltRoutineName;
                       const AHelpCtx: LongInt = cDfltHelpCtx);
begin
  if not AValue then raise EGMCryptException.ObjError(GetLastError, [], AObj, ARoutineName);
end;

procedure GMCryptCheckCode(const AReturnCode: DWORD;
                           const AObj: TObject = nil;
                           const ARoutineName: TGMString = cDfltRoutineName;
                           const AHelpCtx: LongInt = cDfltHelpCtx);
begin
  if AReturnCode <> 0 then raise EGMCryptException.ObjError(AReturnCode, [], AObj, ARoutineName);
end;


// -------------------------------- //
// ---- Cryptographic Provider ---- //
// -------------------------------- //

function GMRSAandAESCryptProvider: IGMGetHandle;
begin
  GMEnterCriticalSection(vCSCreateRSAandAESCryptProvider);
  try
   if vRSAandAESCryptProvider = nil then
    begin
 //  try
 //   vRSAandAESCryptProvider := TGMCryptServiceProvider.Create(PROV_RSA_FULL, nil, MS_ENHANCED_PROV, CRYPT_VERIFYCONTEXT);
 //  except end;
 //  if vRSAandAESCryptProvider = nil then vRSAandAESCryptProvider := TGMCryptServiceProvider.Create(PROV_RSA_FULL, nil, nil, CRYPT_VERIFYCONTEXT);
 //  if vRSAandAESCryptProvider = nil then
     vRSAandAESCryptProvider := TGMCryptServiceProvider.Create(PROV_RSA_AES, nil, nil, CRYPT_VERIFYCONTEXT);
    end;
   Result := vRSAandAESCryptProvider;
  finally
   GMLeaveCriticalSection(vCSCreateRSAandAESCryptProvider);
  end;
end;

//function GMAESCryptProvider: IGMGetHandle;
//begin
//if vAESCryptProvider = nil then
// begin
//  if vAESCryptProvider = nil then vAESCryptProvider := TGMCryptServiceProvider.Create(PROV_RSA_AES, nil, nil, CRYPT_VERIFYCONTEXT);
// end;
//Result := vAESCryptProvider;
//end;


// ---------------------- //
// ---- Global Guids ---- //
// ---------------------- //

function GMCreateCryptKeyFromData(const AKeyData: AnsiString; const AKeyDataHashAlgoId, ACryptAlgoId: ALG_ID): IGMGetHandle;
var cryptHash: IGMCryptHash;
begin
  if Length(AKeyData) > 0 then
   begin
    cryptHash := TGMCryptHash.Create(GMRSAandAESCryptProvider, AKeyDataHashAlgoId);
    cryptHash.HashData(PAnsiChar(AKeyData), Length(AKeyData));
    Result := TGMCryptKey.Derive(GMRSAandAESCryptProvider, ACryptAlgoId, cryptHash);
   end
  else Result := TGMCryptKey.UserKey(GMRSAandAESCryptProvider);
end;


// ------------------------- //
// ---- Helper Routines ---- //
// ------------------------- //

function HashDataSize(const AHash: IUnknown): DWORD;
const cStrRoutineName = 'HashDataSize';
var  PIHash: IGMCryptHash; // PIHandle: IGMGetHandle dwLen: DWORD;
begin
  Result := 0;
  if AHash = nil then Exit;
  GMCheckQueryInterface(AHash, IGMCryptHash, PIHash, cStrRoutineName);
  //if PIHandle.Handle = 0 then Exit;
  //dwLen := SizeOf(Result);
  PIHash.GetHashParam(HP_HASHSIZE, @Result, SizeOf(Result));
  //GMCryptCheck(CryptGetHashParam(PIHandle.Handle, HP_HASHSIZE, @Result, dwLen, 0), nil, cStrRoutineName);
  //Assert(dwLen = SizeOf(Result));
end;

function GMCalcHashValue(const AData: Pointer; const ADataSize: DWORD; AAlgoId: ALG_ID): AnsiString;
var cryptHash: IGMCryptHash;
begin
  if AAlgoId = 0 then AAlgoId := cDfltKeyDataHashAlgoId;
  cryptHash := TGMCryptHash.Create(GMRSAandAESCryptProvider, AAlgoId);
  cryptHash.HashData(AData, ADataSize);
  SetLength(Result, cryptHash.DataSize);
  cryptHash.GetHashParam(HP_HASHVAL, PAnsiChar(Result), Length(Result));
end;

function GMCalcHashValue(const AData: AnsiString; const AAlgoId: ALG_ID): AnsiString;
begin
  Result := GMCalcHashValue(PAnsiChar(AData), Length(AData), AAlgoId);
end;

function GetAlgoInfo(const Provider: IUnknown; const AAlgoId: ALG_ID): PROV_ENUMALGS_EX;
const cEnum: array [Boolean] of DWORD = (0, CRYPT_FIRST);
var provHandle: IGMGetHandle; first: Boolean; len: DWORD;
begin
  Result := Default(PROV_ENUMALGS_EX);
  //FillChar(Result, SizeOf(Result), 0);
  if GMQueryInterface(Provider, IGMGetHandle, provHandle) then Exit;
  first := True;
  repeat
   len := SizeOf(Result);
   if not CryptGetProvParam(provHandle.Handle, PP_ENUMALGS_EX, Pointer(@Result), len, cEnum[first]) then Break;
   if Result.aiAlgid = AAlgoId then Exit;
   first := False;
  until False;
  FillChar(Result, SizeOf(Result), 0);
end;


// ------------------------------------ //
// ---- Data Encryption/Decryption ---- //
// ------------------------------------ //

procedure GMKeyEncryptData(var AData: AnsiString; const AKey: IGMGetHandle; const ACaller: TObject = nil);
const cStrRoutineName = 'GMKeyEncryptData';
var len, orgDataLen: DWORD; success: BOOL; errCode: DWORD;
begin
  if (Length(AData) <= 0) or (AKey = nil) then Exit;
  orgDataLen := Length(AData);
  repeat
   len := orgDataLen;
   success := CryptEncrypt(AKey.Handle, 0, True, 0, Pointer(PAnsiChar(AData)), len, Length(AData));
   if not success then
    begin
     errCode := GetLastError;
     if (errCode = ERROR_MORE_DATA) and (len > 0) then SetLength(AData, len) else
        GMCryptCheckCode(errCode, ACaller, cStrRoutineName);
    end;
  until success;
  SetLength(AData, len);
end;

procedure GMKeyDecryptData(var AData: AnsiString; const AKey: IGMGetHandle; const ACaller: TObject = nil);
const cStrRoutineName = 'GMKeyDecryptData';
var len: DWORD;
begin
  if (Length(AData) <= 0) or (AKey = nil) then Exit;
  len := Length(AData);
  GMCryptCheck(CryptDecrypt(AKey.Handle, 0, True, 0, Pointer(PAnsiChar(AData)), len), ACaller, cStrRoutineName);
  SetLength(AData, len);
end;


procedure GMHashEncryptData(var AData: AnsiString; const AHash: IGMCryptHash; const ACryptAlgoId: ALG_ID; const ACaller: TObject);
var cryptKey: IGMGetHandle;
begin
  if Length(AData) <= 0 then Exit;
  cryptKey := TGMCryptKey.Derive(GMRSAandAESCryptProvider, ACryptAlgoId, AHash);
  GMKeyEncryptData(AData, cryptKey, ACaller);
end;

procedure GMHashDecryptData(var AData: AnsiString; const AHash: IGMCryptHash; const ACryptAlgoId: ALG_ID; const ACaller: TObject);
var cryptKey: IGMGetHandle;
begin
  if Length(AData) <= 0 then Exit;
  cryptKey := TGMCryptKey.Derive(GMRSAandAESCryptProvider, ACryptAlgoId, AHash);
  GMKeyDecryptData(AData, cryptKey, ACaller);
end;


procedure GMKeyDataEncryptData(var AData: AnsiString; const AKeyData: AnsiString; const AKeyDataHashAlgoId, ACryptAlgoId: ALG_ID; const ACaller: TObject);
var cryptKey: IGMGetHandle;
begin
  if Length(AData) <= 0 then Exit;
  cryptKey := GMCreateCryptKeyFromData(AKeyData, AKeyDataHashAlgoId, ACryptAlgoId);
  GMKeyEncryptData(AData, cryptKey, ACaller);
end;

procedure GMKeyDataDecryptData(var AData: AnsiString; const AKeyData: AnsiString; const AKeyDataHashAlgoId, ACryptAlgoId: ALG_ID; const ACaller: TObject);
var cryptKey: IGMGetHandle;
begin
  if Length(AData) <= 0 then Exit;
  cryptKey := GMCreateCryptKeyFromData(AKeyData, AKeyDataHashAlgoId, ACryptAlgoId);
  GMKeyDecryptData(AData, cryptKey, ACaller);
end;

//function GMEncryptGuid(const AGuid: TGuid; const AKeyData: AnsiString; const ACaller: TObject): TGuid;
//begin
//Result := AGuid;
//GMKeyDataEncryptData(@Result, SizeOf(Result), AKeyData, CALG_MD5, CALG_RC4, ACaller);
//end;
//
//function GMDecryptGuid(const AGuid: TGuid; const AKeyData: AnsiString; const ACaller: TObject): TGuid;
//begin
//Result := AGuid;
//GMKeyDataDecryptData(@Result, SizeOf(Result), AKeyData, CALG_MD5, CALG_RC4, ACaller);
//end;

function GMEncryptStringA(const AValue, AKeyData: AnsiString; const AKeyDataHashAlgoId, ACryptAlgoId: ALG_ID; const ACaller: TObject): AnsiString;
begin
  SetString(Result, PAnsiChar(AValue), Length(AValue)); // <- creates a copy of the TGMString
  if Length(Result) > 0 then GMKeyDataEncryptData(Result, AKeyData, AKeyDataHashAlgoId, ACryptAlgoId, ACaller);
end;

function GMDecryptStringA(const AEncryptedRaw, AKeyData: AnsiString; const AKeyDataHashAlgoId, ACryptAlgoId: ALG_ID; const ACaller: TObject): AnsiString;
begin
  SetString(Result, PAnsiChar(AEncryptedRaw), Length(AEncryptedRaw)); // <- creates a copy of the TGMString
  if Length(Result) > 0 then GMKeyDataDecryptData(Result, AKeyData, AKeyDataHashAlgoId, ACryptAlgoId, ACaller);
end;


function GMEncryptStringW(const AValue: UnicodeString; const AKeyData: AnsiString; const AKeyDataHashAlgoId, ACryptAlgoId: ALG_ID; const ACaller: TObject): AnsiString;
begin
  SetLength(Result, Length(AValue) * SizeOf(WideChar));
  if Length(Result) > 0 then
   begin
    System.Move(AValue[1], Result[1], Length(Result));
    GMKeyDataEncryptData(Result, AKeyData, AKeyDataHashAlgoId, ACryptAlgoId, ACaller);
   end;
end;

function GMDecryptStringW(const AEncryptedRaw, AKeyData: AnsiString; const AKeyDataHashAlgoId, ACryptAlgoId: ALG_ID; const ACaller: TObject): UnicodeString;
var decryptBufStr: AnsiString;
begin
  if Length(AEncryptedRaw) <= 0 then begin Result := ''; Exit; end;
  decryptBufStr := AEncryptedRaw;
  GMKeyDataDecryptData(decryptBufStr, AKeyData, AKeyDataHashAlgoId, ACryptAlgoId, ACaller);
  SetLength(Result, Length(decryptBufStr) div SizeOf(WideChar));
  System.Move(decryptBufStr[1], Result[1], Length(Result) * SizeOf(WideChar));
end;

function GMEncryptString(const AValue: TGMString; const AKeyData: AnsiString; const AKeyDataHashAlgoId, ACryptAlgoId: ALG_ID; const ACaller: TObject): AnsiString;
begin
  {$IFDEF UNICODE}
  Result := GMEncryptStringW(AValue, AKeyData, AKeyDataHashAlgoId, ACryptAlgoId, ACaller);
  {$ELSE}
  Result := GMEncryptStringA(AValue, AKeyData, AKeyDataHashAlgoId, ACryptAlgoId, ACaller);
  {$ENDIF}
end;

function GMDecryptString(const AEncryptedRaw, AKeyData: AnsiString; const AKeyDataHashAlgoId, ACryptAlgoId: ALG_ID; const ACaller: TObject): TGMString;
begin
  {$IFDEF UNICODE}
  Result := GMDecryptStringW(AEncryptedRaw, AKeyData, AKeyDataHashAlgoId, ACryptAlgoId, ACaller);
  {$ELSE}
  Result := GMDecryptStringA(AEncryptedRaw, AKeyData, AKeyDataHashAlgoId, ACryptAlgoId, ACaller);
  {$ENDIF}
end;

function GMHmacMd5(AData, AKey: AnsiString): AnsiString;
const cBlockSize = 64;
var ipad, opad: AnsiString; i: LongInt;
begin
  if Length(AKey) > cBlockSize then AKey := GMCalcHashValue(AKey, CALG_MD5);

  ipad := StringOfChar(#$36, cBlockSize);
  opad := StringOfChar(#$5C, cBlockSize);

//SetLength(ipad, 64);
//FillChar(PAnsiChar(ipad)^, Length(ipad), $36);
//
//SetLength(opad, 64);
//FillChar(PAnsiChar(opad)^, Length(opad), $5c);

  for i:=1 to Length(AKey) do
   begin
    ipad[i] := AnsiChar(Byte(ipad[i]) xor Byte(AKey[i]));
    opad[i] := AnsiChar(Byte(opad[i]) xor Byte(AKey[i]));
   end;

  Result := GMCalcHashValue(opad + GMCalcHashValue(ipad + AData, CALG_MD5), CALG_MD5);
end;


//function GMUserEncryptStringA(const AValue: AnsiString; const ACaller: TObject): AnsiString;
//var cryptKey: IGMGetHandle;
//begin
//cryptKey := TGMCryptKey.UserKey(GMRSAandAESCryptProvider, AT_SIGNATURE);
//SetString(Result, PAnsiChar(AValue), Length(AValue)); // <- creates a copy of the TGMString
//GMKeyEncryptData(PAnsiChar(Result), Length(Result), cryptKey, ACaller);
//end;

//function GMUserDecryptStringA(const AValue: AnsiString; const ACaller: TObject): AnsiString;
//var cryptKey: IGMGetHandle;
//begin
//cryptKey := TGMCryptKey.UserKey(GMRSAandAESCryptProvider, AT_SIGNATURE);
//SetString(Result, PAnsiChar(AValue), Length(AValue)); // <- creates a copy of the TGMString
//GMKeyDecryptData(PAnsiChar(Result), Length(Result), cryptKey, ACaller);
//end;


{function GMReadEncryptedString(const DataStorage: IUnknown; const ValueName: TGMString; const DefaultValue: TGMString = ''): TGMString;
begin
  Result := GMReadEncryptedString(DataStorage, ValueName, GMMachineCryptKey, DefaultValue);
end;

procedure GMWriteEncryptedString(const DataStorage: IUnknown; const ValueName, Value: TGMString; const ACaller: TObject = nil);
begin
  GMWriteEncryptedString(DataStorage, ValueName, Value, GMMachineCryptKey, ACaller);
end;


function GMReadEncryptedString(const DataStorage: IUnknown; const ValueName: TGMString; const Key: TGuid; const DefaultValue: TGMString = ''): TGMString;
const cStrRoutineName = 'GMReadEncryptedString';
var PIBinaryData: IGMBinaryStorage; Len: LongWord;
begin
  try
   Result := DefaultValue;
   GMCheckQueryInterface(DataStorage, IGMBinaryStorage, PIBinaryData, cStrRoutineName);
   Len := PIBinaryData.ReadBinary(ValueName, PGMChar(Result)^, 0);
   if Len > 0 then
    begin
     SetLength(Result, Len);
     Assert(PIBinaryData.ReadBinary(ValueName, PGMChar(Result)^, Length(Result)) = Len);
     GMKeyDecryptData(PGMChar(Result), Length(Result), Key, nil);
    end;
  except end;
end;

procedure GMWriteEncryptedString(const DataStorage: IUnknown; const ValueName, Value: TGMString; const Key: TGuid; const ACaller: TObject = nil);
const cStrRoutineName = 'GMWriteEncryptedString';
var PIBinaryData: IGMBinaryStorage; TmpVal: TGMString;
begin
  if Value = '' then begin GMVsdDeleteValue(DataStorage, ValueName); Exit; end;
  TmpVal := PGMChar(Value); // <- force the compiler to create a deep copy of the TGMString
  GMCheckQueryInterface(DataStorage, IGMBinaryStorage, PIBinaryData, cStrRoutineName);
  GMKeyEncryptData(PGMChar(TmpVal), Length(TmpVal), Key, ACaller);
  PIBinaryData.WriteBinary(ValueName, PGMChar(TmpVal)^, Length(TmpVal));
end;}


// ------------------------------------- //
// ---- Global certificate routines ---- //
// ------------------------------------- //

function GMGetASN1EncodedCertData(const ACertificateName, ACertificateStorageName: TGMString;
                                  const ASearchKind, ACertStoreFlags: DWORD; const AStoreProvider: PAnsiChar): AnsiString;
var certStore: IGMCertificateStorage; cert: IGMWinCertificate; privKeyData: AnsiString;
begin
  certStore := TGMWinCertificateStorage.Create(ACertificateStorageName, ACertStoreFlags, AStoreProvider);
  cert := certStore.Obj.FindCertificate(ACertificateName, ASearchKind);

  privKeyData := cert.Obj.PrivateKeyData;

  vfGMTrace(GMFormat(RStrUsingCertificate, [cert.Obj.DisplayString]), 'CERTIFICATE');
  Result := cert.Obj.GetASN1EncodedData;
end;


// --------------------------- //
// ---- TGMCryptBaseClass ---- //
// --------------------------- //

constructor TGMCryptBaseClass.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
end;

function TGMCryptBaseClass.GetHandle: THandle;
begin
  Result := FHandle;
end;


// --------------------------------- //                                                            
// ---- TGMCryptServiceProvider ---- //
// --------------------------------- //

constructor TGMCryptServiceProvider.Create(const AProviderType: LongWord; const AContainerName, AProviderName: PGMChar; const AFlags: LongWord);
//const cCreateKeyset: array [Boolean] of DWORD = (0, CRYPT_NEWKEYSET);
//var RetCode: DWORD;
begin
  inherited Create;
//  if not CryptAcquireContext(FHandle, AContainerName, AProviderName, AProviderType, AFlags) then // and not cCreateKeyset[AContainerName <> nil]
//   begin
//    RetCode := GetLastError;
//    if RetCode <> DWORD(NTE_BAD_KEYSET) then raise EGMCryptException.ObjError(RetCode, [], Self, 'CryptAcquireContext');
    GMCryptCheck({$IFDEF UNICODE}CryptAcquireContextW{$ELSE}CryptAcquireContextA{$ENDIF}(FHandle, AContainerName, AProviderName, AProviderType, AFlags), Self, 'CryptAcquireContext'); //  or cCreateKeyset[AContainerName <> nil]
//   end;
end;

destructor TGMCryptServiceProvider.Destroy;
begin
  if FHandle <> 0 then begin CryptReleaseContext(FHandle, 0); FHandle := 0; end;
  inherited Destroy;
end;


// ----------------------------------- //
// ---- TGMCryptProviderDependent ---- //
// ----------------------------------- //

constructor TGMCryptProviderDependent.Create(const ACSProvider: IUnknown);
begin
  inherited Create;
  FCSProvider := ACSProvider;
end;

function TGMCryptProviderDependent.CryptProviderHandle: THandle;
const cStrMethodName = 'TGMCryptProviderDependent.CryptProviderHandle';
begin
  Result := GMCheckGetIntfHandle(FCSProvider, cStrMethodName);
end;


// ---------------------- //
// ---- TGMCryptHash ---- //
// ---------------------- //

constructor TGMCryptHash.Create(const ACSProvider: IUnknown; const AAlgoId: ALG_ID; const AKey: IUnknown; const AFlags: DWORD);
const cStrMethodName = 'TGMCryptHash.Create';
var hKey: THandle; PIKeyHandle: IGMGetHandle;
begin
  inherited Create(ACSProvider);

  if AKey = nil then hKey := 0 else
   begin
    GMCheckQueryInterface(AKey, IGMGetHandle, PIKeyHandle, cStrMethodName);
    hKey := PIKeyHandle.Handle;
   end;

  GMCryptCheck(CryptCreateHash(CryptProviderHandle, AAlgoId, hKey, AFlags, FHandle), Self, cStrMethodName);
end;

destructor TGMCryptHash.Destroy;
begin
  if FHandle <> 0 then begin CryptDestroyHash(FHandle); FHandle := 0; end;
  inherited Destroy;
end;

function TGMCryptHash.DataSize: DWORD;
begin                                                                                                                                  
  Result := HashDataSize(Self);
end;

procedure TGMCryptHash.HashData(pbData: Pointer; dwDataLen: DWORD; dwFlags: DWORD = 0);
const cStrMethodName = 'HashData';
begin
  GMCryptCheck(CryptHashData(FHandle, pbData, dwDataLen, dwFlags), Self, cStrMethodName);
end;

procedure TGMCryptHash.HashSessionKey(hKey: HCRYPTKEY; dwFlags: DWORD = 0);
const cStrMethodName = 'HashSessionKey';
begin
  GMCryptCheck(CryptHashSessionKey(FHandle, hKey, dwFlags), Self, cStrMethodName);
end;

procedure TGMCryptHash.GetHashParam(dwParam: DWORD; pbData: Pointer; dwDataLen: DWORD);
const cStrMethodName = 'GetHashParam';
var oldDataLen: DWORD;
begin
  oldDataLen := dwDataLen;
  GMCryptCheck(CryptGetHashParam(FHandle, dwParam, pbData, dwDataLen, 0), Self, cStrMethodName);
  Assert(dwDataLen = oldDataLen, 'dwDataLen = oldDataLen');
end;


// --------------------- //
// ---- TGMCryptKey ---- //
// --------------------- //

constructor TGMCryptKey.Derive(const ACSProvider: IUnknown; const ACryptAlgoId: ALG_ID; const AHash: IUnknown; AFlags: DWORD);
const cStrMethodName = 'TGMCryptKey.Derive';
var hHash: IGMGetHandle; // keyBitSize: DWORD; algoInfo: PROV_ENUMALGS_EX;
begin
  inherited Create(ACSProvider);
  GMCheckQueryInterface(AHash, IGMGetHandle, hHash, cStrMethodName);

//if HiWord(AFlags) = 0 then
// begin
//  keyBitSize := (HashDataSize(AHash) * 8); // <- set key size in bits according to AHash size
//  algoInfo := GetAlgoInfo(ACSProvider, AAlgoId);
//  if (algoInfo.aiAlgid = AAlgoId) and (algoInfo.dwMaxLen > 0) then keyBitSize := Min(algoInfo.dwMaxLen, keyBitSize);
//  // if (GMWinVersion < wvWin2000   wvWinNT) ...
//  //if (GMWinVersion < wvWin2000) and ((AAlgoId = CALG_RC2) or (AAlgoId = CALG_RC4) or (AAlgoId = CALG_DES)) then keyBitSize := Min(56, keyBitSize);
//  AFlags := AFlags or (keyBitSize shl 16);
// end;

  GMCryptCheck(CryptDeriveKey(CryptProviderHandle, ACryptAlgoId, hHash.Handle, AFlags, FHandle), Self, 'CryptDeriveKey');
end;

constructor TGMCryptKey.Generate(const ACSProvider: IUnknown; const ACryptAlgoId: ALG_ID; const AFlags: DWORD);
begin
  inherited Create(ACSProvider);
  // if no key size is specified in HiWord(AFlags) the default key size is gernerated
  GMCryptCheck(CryptGenKey(CryptProviderHandle, ACryptAlgoId, AFlags, FHandle), Self, 'CryptGenKey');
end;

constructor TGMCryptKey.UserKey(const ACSProvider: IUnknown; const AKeyKind: DWORD);
begin
  inherited Create(ACSProvider);
  GMCryptCheck(CryptGetUserKey(CryptProviderHandle, AKeyKind, FHandle), Self, 'CryptGetUserKey');
end;

destructor TGMCryptKey.Destroy;
begin
  if FHandle <> 0 then
   begin
    CryptDestroyKey(FHandle);
    FHandle := 0;
   end;
  inherited Destroy;
end;


// ------------------------ //
// ---- TGMCryptStream ---- //
// ------------------------ //

constructor TGMCryptStream.CreateFromKeyData(const AChainedStream: IStream;
                                             const AKeyData: AnsiString;
                                             const AKeyDataHashAlgoId: ALG_ID;
                                             const ACryptAlgoId: ALG_ID;
                                             const ARefLifeTime: Boolean);
begin
  inherited Create(AChainedStream, ARefLifeTime);
  FCryptKey := GMCreateCryptKeyFromData(AKeyData, AKeyDataHashAlgoId, ACryptAlgoId);
end;

function TGMCryptStream.Read(pv: Pointer; cb: LongInt; pcbRead: PLongint): HResult;
const cStrRoutineName = 'Read';
var len: DWORD;
begin
  try
   len := 0;
   Result := inherited Read(pv, cb, {$IFNDEF FPC}PLongInt({$ENDIF}@len{$IFNDEF FPC}){$ENDIF});
   if not GMHrSucceeded(Result) then Exit;
   GMCryptCheck(CryptDecrypt(FCryptKey.Handle, 0, len < DWORD(cb), 0, pv, len), Self, cStrRoutineName); {todo: only use FINAL = True on last call}
   if pcbRead <> nil then pcbRead^ := len;
   Result := GMIStreamReadResult(pcbRead, len = LongWord(cb));
  except
   Result := vfGMHrExceptionHandler(GMExceptObject, cHrPrntWnd, GM_E_STREAMREAD);
  end;
end;

function TGMCryptStream.Write(pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult;
const cStrRoutineName = 'Write';
var len: DWORD;
begin
  try
   if pv = nil then begin Result := STG_E_INVALIDPOINTER; Exit; end;
   len := cb;
   {todo: some encryptions produce more data than given at input!}
   GMCryptCheck(CryptEncrypt(FCryptKey.Handle, 0, True, 0, pv, len, cb), Self, cStrRoutineName); {todo: only use FINAL = True on last call}
   Result := inherited Write(pv, len, pcbWritten);
  except
   Result := vfGMHrExceptionHandler(GMExceptObject, cHrPrntWnd, GM_E_STREAMWRITE);
  end;
end;


// --------------------------- //
// ---- TGMWinCertificate ---- //
// --------------------------- //

constructor TGMWinCertificate.Create(const ACertCtx: PCCERT_CONTEXT; const AFreeCertCtx, ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FFreeCertCtx := AFreeCertCtx;
  FCertCtx := ACertCtx;
end;

destructor TGMWinCertificate.Destroy;
begin
  if FFreeCertCtx and (FCertCtx <> nil) then
   begin
    CertFreeCertificateContext(FCertCtx);
    FCertCtx := nil;
   end;

  inherited Destroy;
end;

function TGMWinCertificate.Obj: TGMWinCertificate;
begin
  Result := Self;
end;

function TGMWinCertificate.GetASN1EncodedData: AnsiString;
begin
  Result := '';
  if FCertCtx = nil then Exit;
  SetString(Result, PAnsiChar(FCertCtx.pbCertEncoded), FCertCtx.cbCertEncoded);
//Result := '-----BEGIN CERTIFICATE-----' + cNewLine + GMEncodeBase64Str(Result) + cNewLine + '-----END CERTIFICATE-----';
end;

function TGMWinCertificate.DisplayString: TGMString;
const sValSep = '='; cEntrySep = '; ';
var dt: TDateTime;
begin
//Result := GMStringJoin(GMStringJoin(RStrSubject, sValSep, Subject), cEntrySep, );
  Result := Issuer; // GMStringJoin(RStrIssuer, sValSep, Issuer);
  dt := NotBefore;
  if dt <> 0.0 then Result := GMStringJoin(Result, cEntrySep, GMStringJoin(RStrNotBefore, sValSep, GMDateTimeToStr(dt)));
  dt := NotAfter;
  if dt <> 0.0 then Result := GMStringJoin(Result, cEntrySep, GMStringJoin(RStrNotAfter, sValSep, GMDateTimeToStr(dt)));
end;

function TGMWinCertificate.Subject: TGMString;
begin
  if FCertCtx = nil then Result := '' else
   begin
    SetLength(Result, 1024);
    SetLength(Result, {$IFDEF UNICODE}CertNameToStrW{$ELSE}CertNameToStrA{$ENDIF}(X509_ASN_ENCODING, @FCertCtx.pCertInfo.Subject, CERT_SIMPLE_NAME_STR, PGMChar(Result), Length(Result) + 1) - 1);
   end;
end;

function TGMWinCertificate.Issuer: TGMString;
begin
  if FCertCtx = nil then Result := '' else
   begin
    SetLength(Result, 1024);
    SetLength(Result, {$IFDEF UNICODE}CertNameToStrW{$ELSE}CertNameToStrA{$ENDIF}(X509_ASN_ENCODING, @FCertCtx.pCertInfo.Issuer, CERT_SIMPLE_NAME_STR, PGMChar(Result), Length(Result) + 1) - 1);
   end;
end;

function TGMWinCertificate.NotBefore: TDateTime;
begin
  if FCertCtx = nil then Result := 0.0 else Result := GMFileTimeToDateTime(FCertCtx.pCertInfo.NotBefore, Self);
end;

function TGMWinCertificate.NotAfter: TDateTime;
begin
  if FCertCtx = nil then Result := 0.0 else Result := GMFileTimeToDateTime(FCertCtx.pCertInfo.NotAfter, Self);
end;

function TGMWinCertificate.PrivateKeyData: AnsiString;
var hProvider: THandle; keyUsage: DWORD; freeHandle: BOOL;
begin
  if FCertCtx = nil then Result := '' else
   begin
    hProvider := 0; keyUsage := 0; freeHandle := False;
    GMApiCheckObj('CryptAcquireCertificatePrivateKey', '', GetLastError, CryptAcquireCertificatePrivateKey(FCertCtx, CRYPT_ACQUIRE_CACHE_FLAG, nil, hProvider, @keyUsage, @freeHandle), Self);
    try

    finally
     if freeHandle then
       case keyUsage of
        AT_KEYEXCHANGE, AT_SIGNATURE: CryptReleaseContext(hProvider, 0);
//      else CERT_NCRYPT_KEY_SPEC   NCryptFreeObject();
       end;
    end;
   end;
end;


// ---------------------------------- //
// ---- TGMWinCertificateStorage ---- //
// ---------------------------------- //

constructor TGMWinCertificateStorage.Create(const ACertificateStorageName: TGMString; const AFlags: DWORD;
  const AStoreProvider: PAnsiChar; const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FCertStorage := CertOpenStore(AStoreProvider, 0, 0, AFlags, PGMChar(ACertificateStorageName));
  if FCertStorage = nil then raise EGMCryptException.ObjError(GetLastError, [], Self, 'CertOpenStore');
end;

destructor TGMWinCertificateStorage.Destroy;
begin
  if FCertStorage <> nil then
   begin
    {$IFDEF DEBUG}
    if not CertCloseStore(FCertStorage, CERT_CLOSE_STORE_CHECK_FLAG) then
       GMTrace('CertCloseStore: '+ GMSysErrorMsg(LongInt(GetLastError), []));
    {$ELSE}
    CertCloseStore(FCertStorage, 0);
    {$ENDIF}
    FCertStorage := nil;
   end;

  inherited Destroy;
end;

function TGMWinCertificateStorage.Obj: TGMWinCertificateStorage;
begin
  Result := Self;
end;

function TGMWinCertificateStorage.FindCertificate(const ACertName: TGMString; const ASearchKind, AEncodingTypes: DWORD): IGMWinCertificate;
const cStrMethodName = 'FindCertificate';
var certCtx: PCCERT_CONTEXT;
begin
  GMCheckPointerAssigned(FCertStorage, RStrTheHandle, Self, cStrMethodName);
  certCtx := CertFindCertificateInStore(FCertStorage, AEncodingTypes, 0, ASearchKind, PGMChar(ACertName), nil);
  if certCtx = nil then raise EGMCryptException.ObjError(GetLastError, [], Self, 'CertFindCertificateInStore');
  Result := TGMWinCertificate.Create(certCtx, True, True);
end;


initialization

  vCSCreateRSAandAESCryptProvider := TGMCriticalSection.Create;

end.