WinCryptAPI 证书组链Delphi演示

简介

  通过CertCreateCertificateChainEngine 可以自定义 受信任的集合(根证书、中级证书和终端证书;只支持WIN7以上版本) 用于创建和验证证书链(CertGetCertificateChain)。

 

代码

{
  * by: HouSoft
  * site: www.yryz.net
  * created: 2011/07/21
}
unit ChainEngine_u;
 
interface
 
uses
  Windows, Messages, SysUtils, IOUtils, jwaWinCrypt, MSCrypt, IMSCrypt;
 
procedure Test;
 
implementation
 
procedure Test;
type
  _CERT_CHAIN_ENGINE_CONFIG = record
    cbSize: DWORD;
    hRestrictedRoot: HCERTSTORE;
    hRestrictedTrust: HCERTSTORE;
    hRestrictedOther: HCERTSTORE;
    cAdditionalStore: DWORD;
    rghAdditionalStore: PHCERTSTORE;
    dwFlags: DWORD;
    dwUrlRetrievalTimeout: DWORD;
    MaximumCachedCertificates: DWORD;
    CycleDetectionModulus: DWORD;
    hExclusiveRoot: HCERTSTORE;
    hExclusiveTrustedPeople: HCERTSTORE;
  end;
 
  CERT_CHAIN_ENGINE_CONFIG = _CERT_CHAIN_ENGINE_CONFIG;
 
var
  I: Integer;
  hSysCAStore: HCERTSTORE;
  hSysRootStore: HCERTSTORE;
  hChainEngine: HCERTCHAINENGINE;
  ChainConfig: CERT_CHAIN_ENGINE_CONFIG;
  ChainPara: CERT_CHAIN_PARA;
  ChainContext: PCCERT_CHAIN_CONTEXT;
  CertContext: PCCERT_CONTEXT;
 
  LBytes: TBytes;
begin
  // 系统CA
  hSysCAStore := CertOpenStore(CERT_STORE_PROV_MEMORY,
    0, 0, 0, nil);
 
  // 系统ROOT
  hSysRootStore := CertOpenStore(CERT_STORE_PROV_MEMORY,
    0, 0, 0, nil);
 
  LBytes := TFile.ReadAllBytes('HouSoft_Root_CA.cer');
  CertAddEncodedCertificateToStore(hSysRootStore,
    X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
    @LBytes[0],
    Length(LBytes),
    CERT_STORE_ADD_NEW,
    nil);
 
  LBytes := TFile.ReadAllBytes('HouSoft_Code_Signing_CA.cer');
  CertAddEncodedCertificateToStore(hSysCAStore,
    X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
    @LBytes[0],
    Length(LBytes),
    CERT_STORE_ADD_NEW,
    nil);
 
  LBytes := TFile.ReadAllBytes('HouSoft_Test.cer');
  CertContext := CertCreateContext(CERT_STORE_CERTIFICATE_CONTEXT,
    X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
    @LBytes[0],
    Length(LBytes),
    0,
    nil);
 
  ZeroMemory(@ChainConfig, SizeOf(ChainConfig));
  ChainConfig.cbSize := sizeof(CERT_CHAIN_ENGINE_CONFIG);
  ChainConfig.hRestrictedRoot := nil;
  ChainConfig.hRestrictedTrust := nil;
  ChainConfig.hRestrictedOther := nil;
  ChainConfig.cAdditionalStore := 1;
  ChainConfig.rghAdditionalStore := @hSysCAStore;
  ChainConfig.dwFlags := CERT_CHAIN_CACHE_END_CERT;
  ChainConfig.dwUrlRetrievalTimeout := 0;
  ChainConfig.MaximumCachedCertificates := 0;
  ChainConfig.CycleDetectionModulus := 0;
  // 独立的信任集合 win7+ http://msdn.microsoft.com/en-us/library/aa377184(v=VS.85).aspx
  // 系统存储将被忽略
  ChainConfig.hExclusiveRoot := hSysRootStore; // ca
  ChainConfig.hExclusiveTrustedPeople := nil;  // cert
 
  if CertCreateCertificateChainEngine(
    @ChainConfig,
    hChainEngine) then
    WriteLn('CertCreateCertificateChainEngine ok');
 
  ZeroMemory(@ChainPara, SizeOf(ChainPara));
  ChainPara.cbSize := sizeof(CERT_CHAIN_PARA);
  ChainPara.RequestedUsage.dwType := USAGE_MATCH_TYPE_AND;
 
  if not CertGetCertificateChain(
    hChainEngine, // use the default chain engine
    CertContext,  // pointer to the end certificate
    nil,          // use the default time
    nil,          // search no additional stores
    @ChainPara,   // use AND logic and enhanced key usage
    // as indicated in the ChainPara
    // data structure
    CERT_CHAIN_CACHE_END_CERT
    or CERT_CHAIN_CACHE_ONLY_URL_RETRIEVAL,
    nil, // currently reserved
    @ChainContext) then
    raise Exception.CreateFmt('CertGetCertificateChain (%s)',
      [SysErrorMessage(GetLastError)]);
 
  // http://msdn.microsoft.com/en-us/library/aa377590(v=vs.85).aspx
  case ChainContext.TrustStatus.dwErrorStatus of
    CERT_TRUST_IS_COMPLEX_CHAIN:
      WriteLn('证书链是不完整的。');
    CERT_TRUST_NO_ERROR:
      WriteLn('Verify Ok');
  else
    WriteLn(Format('Verify Error 0x%.8x  see http://msdn.microsoft.com/en-us/library/aa377590(v=vs.85).aspx',
      [ChainContext.TrustStatus.dwErrorStatus]));
  end;
 
{$POINTERMATH ON}
  WriteLn('Certificate Chain:');
  for I := ChainContext.rgpChain^.cElement - 1 downto 0 do
  begin
    with ICertificate(TCertificate.Create(ChainContext.rgpChain^.rgpElement[I]^.pCertContext)) do
    begin
      WriteLn(StringOfChar(' ', ChainContext.rgpChain^.cElement - I - 1), '|- ',
        Name, #9, Thumbprint);
    end;
 
  end;
 
  // WriteLn(ChainContext.rgpChain^.rgpElement^.TrustStatus.dwErrorStatus);
  Sleep(60 * 1000);
end;
 
end.

DEMO

  下载ChainEngine.rar