{ +-------------------------------------------------------------+ } { | | } { | GM-Software | } { | =========== | } { | | } { | Project: All Projects | } { | | } { | Description: Windows cryptographic API wrappers for easy | } { | usage. | } { | | } { | Copyright (C) - 2003 - Gerrit Moeller. | } { | | } { | Source code distributed 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; var PIHash: IGMCryptHash; // PIHandle: IGMGetHandle dwLen: DWORD; begin Result := 0; if AHash = nil then Exit; GMCheckQueryInterface(AHash, IGMCryptHash, PIHash, {$I %CurrentRoutine%}); //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, {$I %CurrentRoutine%}); //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); //FillByte(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; FillByte(Result, SizeOf(Result), 0); end; // ------------------------------------ // // ---- Data Encryption/Decryption ---- // // ------------------------------------ // procedure GMKeyEncryptData(var AData: AnsiString; const AKey: IGMGetHandle; const ACaller: TObject = nil); 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, {$I %CurrentRoutine%}); end; until success; SetLength(AData, len); end; procedure GMKeyDecryptData(var AData: AnsiString; const AKey: IGMGetHandle; const ACaller: TObject = nil); 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, {$I %CurrentRoutine%}); 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); //FillByte(PAnsiChar(ipad)^, Length(ipad), $36); // //SetLength(opad, 64); //FillByte(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; //var PIBinaryData: IGMBinaryStorage; Len: LongWord; //begin // try // Result := DefaultValue; // GMCheckQueryInterface(DataStorage, IGMBinaryStorage, PIBinaryData, {$I %CurrentRoutine%}); // 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); //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, {$I %CurrentRoutine%}); // 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; begin Result := GMCheckGetIntfHandle(FCSProvider, {$I %CurrentRoutine%}); end; // ---------------------- // // ---- TGMCryptHash ---- // // ---------------------- // constructor TGMCryptHash.Create(const ACSProvider: IUnknown; const AAlgoId: ALG_ID; const AKey: IUnknown; const AFlags: DWORD); var hKey: THandle; PIKeyHandle: IGMGetHandle; begin inherited Create(ACSProvider); if AKey = nil then hKey := 0 else begin GMCheckQueryInterface(AKey, IGMGetHandle, PIKeyHandle, {$I %CurrentRoutine%}); hKey := PIKeyHandle.Handle; end; GMCryptCheck(CryptCreateHash(CryptProviderHandle, AAlgoId, hKey, AFlags, FHandle), Self, {$I %CurrentRoutine%}); 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); begin GMCryptCheck(CryptHashData(FHandle, pbData, dwDataLen, dwFlags), Self, {$I %CurrentRoutine%}); end; procedure TGMCryptHash.HashSessionKey(hKey: HCRYPTKEY; dwFlags: DWORD = 0); begin GMCryptCheck(CryptHashSessionKey(FHandle, hKey, dwFlags), Self, {$I %CurrentRoutine%}); end; procedure TGMCryptHash.GetHashParam(dwParam: DWORD; pbData: Pointer; dwDataLen: DWORD); var oldDataLen: DWORD; begin oldDataLen := dwDataLen; GMCryptCheck(CryptGetHashParam(FHandle, dwParam, pbData, dwDataLen, 0), Self, {$I %CurrentRoutine%}); Assert(dwDataLen = oldDataLen, 'dwDataLen = oldDataLen'); end; // --------------------- // // ---- TGMCryptKey ---- // // --------------------- // constructor TGMCryptKey.Derive(const ACSProvider: IUnknown; const ACryptAlgoId: ALG_ID; const AHash: IUnknown; AFlags: DWORD); var hHash: IGMGetHandle; // keyBitSize: DWORD; algoInfo: PROV_ENUMALGS_EX; begin inherited Create(ACSProvider); GMCheckQueryInterface(AHash, IGMGetHandle, hHash, {$I %CurrentRoutine%}); //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; 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, {$I %CurrentRoutine%}); {todo: only use FINAL = True on last call} if pcbRead <> nil then pcbRead^ := len; Result := GMIStreamReadResult(pcbRead, len = LongWord(cb)); except on ex: TObject do Result := vfGMHrExceptionHandler(ex, cHrPrntWnd, GM_E_STREAMREAD); end; end; function TGMCryptStream.Write(pv: Pointer; cb: LongInt; pcbWritten: PLongint): HResult; 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, {$I %CurrentRoutine%}); {todo: only use FINAL = True on last call} Result := inherited Write(pv, len, pcbWritten); except on ex: TObject do Result := vfGMHrExceptionHandler(ex, 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; var certCtx: PCCERT_CONTEXT; begin GMCheckPointerAssigned(FCertStorage, RStrTheHandle, Self, {$I %CurrentRoutine%}); 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.