{*******************************************************}
{                                                       }
{                Certificate routines                   }
{                                                       }
{        Copyright (c) 2013-2021 Michal Mutl            }
{                                                       }
{*******************************************************}

{$I Compilers.Inc}

unit MiTeC_Cert;

interface

uses {$IFDEF RAD9PLUS}
     WinAPI.Windows, System.SysUtils, System.Classes,
     {$ELSE}
     Windows, SysUtils, Classes,
     {$ENDIF}
     MiTeC_Windows, MiTeC_WinCrypt;

type
  TCertContextInfo = record
    EncodingType: Cardinal;
    Encoding: string;
    Version: Integer;
    Issuer,
    QIssuer,
    Subject,
    QSubject,
    Serial,
    SignatureAlgorithm,
    PublicKeyAlgorithm: string;
    PublicKeyBits: Integer;
    ValidFrom,
    ValidTo: TDateTime;
    KeyUsageFlags: Word;
    KeyUsage,
    EnhancedKeyUsage,
    Thumbprint,
    ProgramName,
    PublisherLink,
    MoreInfoLink: string;
  end;

  TCertStoreInfo = array of TCertContextInfo;

function BLOBToStr(ABLOB: DATA_BLOB): string;
function BLOBToOIDStr(ABLOB: DATA_BLOB): string;
function BLOBToX500Str(ABLOB: DATA_BLOB): string;
function GetOIDInfo(AValue: string): string;
function GetCertStore(const AFilename: string; out ACertStore: HCERTSTORE): Boolean; overload;
function GetCertStore(AStream: TStream; out ACertStore: HCERTSTORE): Boolean; overload;
function GetCertStore(AData: TBytes; out ACertStore: HCERTSTORE): Boolean; overload;
function GetCertStoreText(const AData: string; out ACertStore: HCERTSTORE): Boolean; overload;
function GetPFXCertStore(const AFilename, APassword: string; out ACertStore: HCERTSTORE): boolean;
function GetCertContext(const AFilename: string; out ACertContext: PCCERT_CONTEXT): boolean;
function GetCertContextText(const AText: string; out ACertContext: PCCERT_CONTEXT): boolean;
function GetCertContextPEM(const AFilename: string; out ACertContext: PCCERT_CONTEXT): boolean;
function GetPFXCertContext(const AFilename, APassword: string; out ACertContext: PCCERT_CONTEXT): boolean; overload;
function GetCertContextFromSignedFile(const AFilename, ASubject: string; out ACertContext: PCCERT_CONTEXT): boolean;
function GetCertStoreFromSignedFile(const AFilename: string; out ACertStore: HCERTSTORE; var ASignerInfo: PCmsgSignerInfo): boolean;
function GetCertStoreFromSignerInfo(ASignerInfo: PCmsgSignerInfo; out ACertStore: HCERTSTORE): boolean;
function SaveCertContextToPFX(ACertContext: PCCERT_CONTEXT; const APassword,AFilename: string): boolean; overload;
function SaveCertContextToPFX(ACertContext: PCCERT_CONTEXT; const APassword: string; AStream: TMemoryStream): boolean; overload;
function SaveCertContextToDER(ACertContext: PCCERT_CONTEXT; AStream: TMemoryStream): boolean; overload;
function SaveCertContextToDER(ACertContext: PCCERT_CONTEXT; const AFilename: string): boolean; overload;
function SaveCertContextToPEM(ACertContext: PCCERT_CONTEXT; AStream: TMemoryStream): boolean; overload;
function SaveCertContextToPEM(ACertContext: PCCERT_CONTEXT; const AFilename: string): boolean; overload;
function SaveCertStoreToPFX(ACertStore: HCERTSTORE; const APassword: string; AStream: TMemoryStream): boolean; overload;
function SaveCertStoreToPFX(ACertStore: HCERTSTORE; const APassword,AFilename: string): boolean; overload;
function SaveCertStoreToDER(ACertStore: HCERTSTORE; AStream: TMemoryStream): boolean; overload;
function SaveCertStoreToDER(ACertStore: HCERTSTORE; const AFilename: string): boolean; overload;
function SaveCertStoreToPEM(ACertStore: HCERTSTORE; AStream: TMemoryStream): boolean; overload;
function SaveCertStoreToPEM(ACertStore: HCERTSTORE; const AFilename: string): boolean; overload;
function AddCertContextToStore(ACertContext: PCCERT_CONTEXT; const ACertStoreName: string = 'MY'): boolean;
procedure RetrieveCertContextInfo(ACertContext: PCCERT_CONTEXT; out ACertContextInfo: TCertContextInfo);
procedure RetrieveCertStoreInfo(ACertStore: HCERTSTORE; ASignerInfo: PCmsgSignerInfo; out ACertStoreInfo: TCertStoreInfo);
function VerifyFile(const AFilename: string; var ASigner: string; var ATimestamp: TDatetime; var AProgramName,APublisherLink,AMoreInfoLink: string; AHandle: THandle = INVALID_HANDLE_VALUE): Integer; overload;
function IsFileSigned(const AFilename: string): boolean;
function VerifyFile(const AFilename: string; AHandle: THandle = INVALID_HANDLE_VALUE): Integer; overload;
procedure ViewPFXCertificate(AHandle: THandle; const AFilename, APassword: string);
procedure ViewCertificate(AHandle: THandle; const AFilename: string);
function CreateSelfSignedCert(const ASubject, APassword: string; out ACertContext: PCCERT_CONTEXT): boolean; overload;
function CreateSelfSignedCert(const ASubject, APassword, AFilename: string): boolean; overload;
function GetCertErrorText(ACode: integer): string;

implementation

uses {$IFDEF RAD9PLUS}
     System.Math,
     {$ELSE}
     Math,
     {$ENDIF}
     {$IFDEF RAD15PLUS}
     System.NetEncoding,
     {$ELSE}
     {$IFDEF RAD9PLUS}
     Soap.EncdDecd,
     {$ELSE}
     {$IFDEF FPC}
     Base64,
     {$ELSE}
     EncdDecd,
     {$ENDIF}
     {$ENDIF}
     {$ENDIF}
     MiTeC_WinTrust, MiTeC_Datetime, MiTeC_CryptUI;

function BLOBToStr(ABLOB: DATA_BLOB): string;
var
  n: Cardinal;
begin
  n:=CertNameToStr(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,@ABLOB,CERT_SIMPLE_NAME_STR,nil,0);
  SetString(Result,PChar(ABLOB.pbData),n);
  CertNameToStr(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,@ABLOB,CERT_SIMPLE_NAME_STR,PChar(Result),n);
end;

function BLOBToOIDStr(ABLOB: DATA_BLOB): string;
var
  n: Cardinal;
begin
  n:=CertNameToStr(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,@ABLOB,CERT_OID_NAME_STR,nil,0);
  SetString(Result,PChar(ABLOB.pbData),n);
  CertNameToStr(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,@ABLOB,CERT_OID_NAME_STR,PChar(Result),n);
end;

function BLOBToX500Str(ABLOB: DATA_BLOB): string;
var
  n: Cardinal;
begin
  n:=CertNameToStr(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,@ABLOB,CERT_X500_NAME_STR,nil,0);
  SetString(Result,PChar(ABLOB.pbData),n);
  CertNameToStr(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,@ABLOB,CERT_X500_NAME_STR,PChar(Result),n);
end;

function NormalizeSerial(const AValue: string): string;
var
  i,l: Integer;
begin
  Result:='';
  i:=1;
  l:=Length(AValue);
  while i<l do begin
    Result:=Result+Copy(AValue,l-i,2);
    Inc(i,2);
  end;
end;

function GetOIDInfo(AValue: string): string;
var
  oid: PCCRYPT_OID_INFO;
begin
  Result:=AValue;
  oid:=CryptFindOIDInfo(CRYPT_OID_INFO_OID_KEY,PAnsiChar(WideToAnsi(Avalue)),0);
  if Assigned(oid) then
    Result:=oid.pwszName;
end;

function GetCertContext(const AFilename: string; out ACertContext: PCCERT_CONTEXT): boolean;
var
  cs: HCERTSTORE;
begin
  Result:=False;
  ACertContext:=nil;
  cs:=CertOpenStore(CERT_STORE_PROV_FILENAME,X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,0,CERT_STORE_OPEN_EXISTING_FLAG or CERT_STORE_READONLY_FLAG,PChar(AFilename));
  if Assigned(cs) then begin
    ACertContext:=CertEnumCertificatesInStore(cs,nil);
    Result:=Assigned(ACertContext);
    CertCloseStore(cs,0);
  end;
end;

function GetCertContextText(const AText: string; out ACertContext: PCCERT_CONTEXT): boolean;
const
  cBegin = '-----BEGIN';
  cBeginCert = '-----BEGIN CERTIFICATE-----';
  cEndCert = '-----END CERTIFICATE-----';
  cBeginPKCS7 = '-----BEGIN PKCS7-----';
  cEndPKCS7 = '-----END PKCS7-----';
var
  certDecoded: TBytes;
  n: Cardinal;
  s: string;
  p: integer;
begin
  Result:=False;
  ACertContext:=nil;
  s:=AText;
  if Pos(cBegin,s)=1 then begin
    p:=Pos(cBeginCert,s);
    if p>0 then
      s:=Trim(Copy(s,p+Length(cBeginCert),Length(s)-p-1-Length(cBeginCert)-Length(cEndCert)))
    else begin
      p:=Pos(cBeginPKCS7,s);
      if p>0 then
        s:=Trim(Copy(s,p+Length(cBeginPKCS7),Length(s)-p-1-Length(cBeginPKCS7)-Length(cEndPKCS7)))
      else
        Exit;
    end;
    CryptStringToBinary(PChar(s),Length(s),CRYPT_STRING_BASE64_ANY,nil,n,nil,nil);
    SetLength(certDecoded,n);
    CryptStringToBinary(PChar(s),Length(s),CRYPT_STRING_BASE64_ANY,@certDecoded[0],n,nil,nil);
  end else begin
    n:=Length(s)*sizeof(Char);
    SetLength(certDecoded,n);
    Move(s[1],certDecoded[0],n);
  end;
  ACertContext:=CertCreateCertificateContext(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,@certDecoded[0],n);
  Result:=Assigned(ACertContext);
end;

function GetCertContextPEM(const AFilename: string; out ACertContext: PCCERT_CONTEXT): boolean;
var
  cfh: THandle;
  certEncoded: TBytes;
  certEncodedSize,cfs: Cardinal;
  s: string;
begin
  Result:=False;
  ACertContext:=nil;
  cfh:=CreateFile(PChar(AFilename),GENERIC_READ,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  if (cfh=INVALID_HANDLE_VALUE) then
    Exit;
  try
    cfs:=GetFileSize(cfh,nil);
    SetLength(certEncoded,cfs);
    if not ReadFile(cfh,certEncoded[0],cfs,certEncodedSize,nil) then
      Exit;
    s:=string(PAnsiChar(certEncoded));
    Result:=GetCertContextText(s,ACertContext);
  finally
    CloseHandle(cfh);
  end;
end;

function GetPFXCertContext(const AFilename, APassword: string; out ACertContext: PCCERT_CONTEXT): boolean;
var
  cfh: THandle;
  certEncoded: TBytes;
  certEncodedSize,cfs: Cardinal;
  csh: HCERTSTORE;
  pfx: CRYPT_DATA_BLOB;
  pwd: WideString;
begin
  Result:=False;
  ACertContext:=nil;
  cfh:=CreateFile(PChar(AFilename),GENERIC_READ,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  if (cfh=INVALID_HANDLE_VALUE) then
    Exit;
  try
    cfs:=GetFileSize(cfh,nil);
    SetLength(certEncoded,cfs);
    if not ReadFile(cfh,certEncoded[0],cfs,certEncodedSize,nil) then
      Exit;
  finally
    CloseHandle(cfh);
  end;
  pfx.cbData:=cfs;
  pfx.pbData:=@certEncoded[0];
  pwd:=APassword;
  csh:=PFXImportCertStore(@pfx,PWideChar(pwd),0);
  if Assigned(csh) then begin
    ACertContext:=CertFindCertificateInStore(csh,X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,0,CERT_FIND_HAS_PRIVATE_KEY,nil,nil);
    if not Assigned(ACertContext) then
      ACertContext:=CertFindCertificateInStore(csh,X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,0,0,nil,nil);
    CertCloseStore(csh,0);
  end;
  Result:=Assigned(ACertContext);
end;

function GetCertContextFromSignedFile(const AFilename, ASubject: string; out ACertContext: PCCERT_CONTEXT): boolean;
var
  hFile: THandle;
  wc: PWinCertificate;
  n,c: Cardinal;
  ix: array[0..127] of DWORD;
  b: TBytes;
  cert: PCCERT_CONTEXT;
  cs: HCERTSTORE;
  Blob: CRYPTOAPI_BLOB;
  ci: TCertContextInfo;
begin
  Result:=False;
  ACertContext:=nil;
  hFile:=INVALID_HANDLE_VALUE;
  try
    hFile:=CreateFile(PChar(AFileName),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
    if hFile<>INVALID_HANDLE_VALUE then begin
      if Assigned(ImageEnumerateCertificates) then begin
        ZeroMemory(@ix,sizeof(ix));
        if ImageEnumerateCertificates(hFile,CERT_SECTION_TYPE_ANY,c,@ix,128) and Assigned(ImageGetCertificateData) then begin
          n:=0;
          ImageGetCertificateData(hFile,ix[0],nil,n);
          wc:=Allocmem(n);
          try
            if ImageGetCertificateData(hFile,ix[0],wc,n) then begin
              SetLength(b,n-2*sizeof(Cardinal));
              Move(wc.bCertificate[0],b[0],Length(b));

              Blob.cbData:=Length(b);
              Blob.pbData:=@b[0];
              cs:=CertOpenStore(CERT_STORE_PROV_PKCS7,X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,0,0,@Blob);
              if Assigned(cs) then begin
                cert:=CertEnumCertificatesInStore(cs,nil);
                while Assigned(cert) do begin
                  RetrieveCertContextInfo(cert,ci);
                  if Pos(ASubject,ci.Subject)>0 then begin
                    ACertContext:=cert;
                    Break;
                  end;
                  cert:=CertEnumCertificatesInStore(cs,cert);
                end;
                CertCloseStore(cs,0);
                Result:=True;
              end;
            end;
          finally
            Freemem(wc);
          end;
        end;
      end;
    end;
  finally
    if hFile<>INVALID_HANDLE_VALUE then
      CloseHandle(hFile);
  end;
end;

function GetCertStoreFromSignedFile(const AFilename: string; out ACertStore: HCERTSTORE; var ASignerInfo: PCmsgSignerInfo): boolean;
var
  {hFile: THandle;
  wc: PWinCertificate;
  ix: array[0..127] of DWORD;
  b: TBytes;
  Blob: CRYPTOAPI_BLOB;
  c,}n: Cardinal;
  cert: PCCERT_CONTEXT;

  ce,cct,cft: Cardinal;
  cmh: HCRYPTMSG;
begin
  Result:=False;
  ACertStore:=nil;
  ASignerInfo:=nil;

  if CryptQueryObject(CERT_QUERY_OBJECT_FILE,PWideChar(AFilename),CERT_QUERY_CONTENT_FLAG_PKCS7_SIGNED_EMBED,CERT_QUERY_FORMAT_FLAG_BINARY,0,
                      @ce,@cct,@cft,@ACertStore,@cmh,nil) then
    if Assigned(ACertStore) then begin
      cert:=CertEnumCertificatesInStore(ACertStore,nil);
      Result:=Assigned(cert);
      if Assigned(cert) then
        CertFreeCertificateContext(cert);

      n:=0;
      if CryptMsgGetParam(cmh,CMSG_SIGNER_INFO_PARAM,0,nil,n) then begin
        ASignerInfo:=AllocMem(n);
        CryptMsgGetParam(cmh,CMSG_SIGNER_INFO_PARAM,0,ASignerInfo,n);
      end

    end;

  {
  hFile:=INVALID_HANDLE_VALUE;
  try
    hFile:=CreateFile(PChar(AFileName),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
    if hFile<>INVALID_HANDLE_VALUE then begin
      if Assigned(ImageEnumerateCertificates) then begin
        ZeroMemory(@ix,sizeof(ix));
        if ImageEnumerateCertificates(hFile,CERT_SECTION_TYPE_ANY,c,@ix,128) and Assigned(ImageGetCertificateData) then begin
          n:=0;
          ImageGetCertificateData(hFile,ix[0],nil,n);
          wc:=Allocmem(n);
          try
            if ImageGetCertificateData(hFile,ix[0],wc,n) then begin
              SetLength(b,n-2*sizeof(Cardinal));
              Move(wc.bCertificate[0],b[0],Length(b));
              Blob.cbData:=Length(b);
              Blob.pbData:=@b[0];
              ACertStore:=CertOpenStore(CERT_STORE_PROV_PKCS7,X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,0,0,@Blob);
              cert:=CertEnumCertificatesInStore(ACertStore,nil);
              Result:=Assigned(ACertStore) and Assigned(cert);
            end;
          finally
            Freemem(wc);
            if Assigned(cert) then
              CertFreeCertificateContext(cert);
          end;
        end;
      end;
    end;
  finally
    if hFile<>INVALID_HANDLE_VALUE then
      CloseHandle(hFile);
  end;
  }
end;

function GetCertStoreFromSignerInfo(ASignerInfo: PCmsgSignerInfo; out ACertStore: HCERTSTORE): boolean;
const
  szOID_NESTED_SIGNATURE = '1.3.6.1.4.1.311.2.4.1';
var
  i,idx: integer;
  rgAttr: PCRYPT_ATTRIBUTE;
  ce,cct,cft: Cardinal;
  cmh: HCRYPTMSG;
begin
  Result:=False;
  ACertStore:=nil;
  if not Assigned(ASignerInfo) then
    Exit;

  idx:=-1;
  rgAttr:=ASignerInfo.UnauthAttrs.rgAttr;
  for i:=0 to ASignerInfo.UnauthAttrs.cAttr-1 do begin
    if SameText(string(rgAttr.pszObjId),szOID_NESTED_SIGNATURE) then begin
      idx:=i;
      Break;
    end;
    inc(rgAttr);
  end;

  if idx=-1 then
    Exit;

  Result:=CryptQueryObject(CERT_QUERY_OBJECT_BLOB,rgAttr.rgValue,CERT_QUERY_CONTENT_FLAG_PKCS7_SIGNED,CERT_QUERY_FORMAT_FLAG_BINARY,0,
                       @ce,@cct,@cft,@ACertStore,@cmh,nil);
end;

function SaveCertContextToPFX(ACertContext: PCCERT_CONTEXT; const APassword: string; AStream: TMemoryStream): boolean;
var
  cs: HCERTSTORE;
  pfx: CRYPT_DATA_BLOB;
  pwd: WideString;
begin
  Result:=False;
  AStream.Clear;
  cs:=CertOpenStore(CERT_STORE_PROV_MEMORY,0,0,CERT_STORE_CREATE_NEW_FLAG,nil);
  try
    if Assigned(cs) and CertAddCertificateContextToStore(cs,ACertContext,CERT_STORE_ADD_NEW,nil) then
      pfx.cbData:=0;
      pfx.pbData:=nil;
      pwd:=APassword;
      if PFXExportCertStoreEx(cs,@pfx,PWideChar(pwd),nil,EXPORT_PRIVATE_KEYS) then begin
        pfx.pbData:=CryptMemAlloc(SizeOf(BYTE)*pfx.cbData);
        try
          if Assigned(pfx.pbData) then begin
            if (PFXExportCertStoreEx(cs,@pfx,PWideChar(pwd),nil,EXPORT_PRIVATE_KEYS)) then begin
              AStream.WriteBuffer(pfx.pbData^,pfx.cbData);
              AStream.Position:=0;
              Result:=True;
            end;
          end;
        finally
          CryptMemFree(pfx.pbData);
        end;
      end;
  finally
    CertCloseStore(cs,0);
  end;
end;

function SaveCertContextToPFX(ACertContext: PCCERT_CONTEXT; const APassword,AFilename: string): boolean;
var
  ms: TMemoryStream;
begin
  ms:=TMemoryStream.Create;
  try
    Result:=SaveCertContextToPFX(ACertContext,APassword,ms);
    ms.SaveToFile(AFilename);
  finally
    ms.Free;
  end;
end;

function SaveCertStoreToPFX(ACertStore: HCERTSTORE; const APassword: string; AStream: TMemoryStream): boolean;
var
  pfx: CRYPT_DATA_BLOB;
  pwd: WideString;
begin
  Result:=False;
  AStream.Clear;
  pfx.cbData:=0;
  pfx.pbData:=nil;

  pwd:=APassword;
  if PFXExportCertStoreEx(ACertStore,@pfx,PWideChar(pwd),nil,EXPORT_PRIVATE_KEYS) then begin
    pfx.pbData:=CryptMemAlloc(SizeOf(BYTE)*pfx.cbData);
    try
      if Assigned(pfx.pbData) then begin
        if (PFXExportCertStoreEx(ACertStore,@pfx,PWideChar(pwd),nil,EXPORT_PRIVATE_KEYS {or PKCS12_INCLUDE_EXTENDED_PROPERTIES})) then begin
          AStream.WriteBuffer(pfx.pbData^,pfx.cbData);
          AStream.Position:=0;
          Result:=True;
        end;
      end;
    finally
      CryptMemFree(pfx.pbData);
    end;
  end;
end;

function SaveCertStoreToPFX(ACertStore: HCERTSTORE; const APassword,AFilename: string): boolean;
var
  ms: TMemoryStream;
begin
  ms:=TMemoryStream.Create;
  try
    Result:=SaveCertStoreToPFX(ACertStore,APassword,ms);
    ms.SaveToFile(AFilename);
  finally
    ms.Free;
  end;
end;

function SaveCertStoreToDER(ACertStore: HCERTSTORE; AStream: TMemoryStream): boolean; overload;
var
  b: CERT_BLOB;
begin
  AStream.Clear;
  Result:=False;
  b.cbData:=0;
  b.pbData:=nil;
  if CertSaveStore(ACertStore,PKCS_7_ASN_ENCODING or X509_ASN_ENCODING,CERT_STORE_SAVE_AS_PKCS7,CERT_STORE_SAVE_TO_MEMORY,@b,0) then begin
    b.pbData:=AllocMem(b.cbData);
    if CertSaveStore(ACertStore,PKCS_7_ASN_ENCODING or X509_ASN_ENCODING,CERT_STORE_SAVE_AS_PKCS7,CERT_STORE_SAVE_TO_MEMORY,@b,0) then begin
      AStream.Write(b.pbData^,b.cbData);
      AStream.Position:=0;
      Result:=AStream.Size>0;
    end;
  end;
end;

function SaveCertContextToDER(ACertContext: PCCERT_CONTEXT; const AFilename: string): boolean;
var
  cs: HCERTSTORE;
  s: {$IFDEF FPC}WideString{$ELSE}string{$ENDIF};
begin
  Result:=False;
  s:=AFilename;
  cs:=CertOpenStore(CERT_STORE_PROV_MEMORY,0,0,CERT_STORE_CREATE_NEW_FLAG,nil);
  try
    if Assigned(cs) and CertAddCertificateContextToStore(cs,ACertContext,CERT_STORE_ADD_NEW,nil) then
      Result:=CertSaveStore(cs,PKCS_7_ASN_ENCODING or X509_ASN_ENCODING,CERT_STORE_SAVE_AS_PKCS7,CERT_STORE_SAVE_TO_FILENAME,PWideChar(s),0);
  finally
    CertCloseStore(cs,0);
  end;
end;

function SaveCertContextToDER(ACertContext: PCCERT_CONTEXT; AStream: TMemoryStream): boolean;
var
  cs: HCERTSTORE;
  b: CERT_BLOB;
begin
  AStream.Clear;
  Result:=False;
  cs:=CertOpenStore(CERT_STORE_PROV_MEMORY,0,0,CERT_STORE_CREATE_NEW_FLAG,nil);
  try
    if Assigned(cs) and CertAddCertificateContextToStore(cs,ACertContext,CERT_STORE_ADD_NEW,nil) then begin
      b.cbData:=0;
      b.pbData:=nil;
      if CertSaveStore(cs,PKCS_7_ASN_ENCODING or X509_ASN_ENCODING,CERT_STORE_SAVE_AS_PKCS7,CERT_STORE_SAVE_TO_MEMORY,@b,0) then begin
        b.pbData:=AllocMem(b.cbData);
        if CertSaveStore(cs,PKCS_7_ASN_ENCODING or X509_ASN_ENCODING,CERT_STORE_SAVE_AS_PKCS7,CERT_STORE_SAVE_TO_MEMORY,@b,0) then begin
          AStream.Write(b.pbData^,b.cbData);
          AStream.Position:=0;
          Result:=AStream.Size>0;
        end;
      end;
    end;
  finally
    CertCloseStore(cs,0);
  end;
end;

function SaveCertContextToPEM(ACertContext: PCCERT_CONTEXT; AStream: TMemoryStream): boolean;
var
  ms: TMemoryStream;
  sl: TStringList;
  {$IFDEF RAD15PLUS}
  b64: TBase64Encoding;
  {$ENDIF}
  {$IFDEF FPC}
  b64: TBase64DecodingStream;
  {$ENDIF}
begin
  AStream.Clear;
  ms:=TMemoryStream.Create;
  sl:=TStringList.Create;
  {$IFDEF RAD15PLUS}
  b64:=TBase64Encoding.Create(64);
  {$ENDIF}
  try
    SaveCertContextToDER(ACertContext,ms);
    {$IFDEF RAD15PLUS}
    b64.Encode(ms,AStream);
    {$ELSE}
    {$IFDEF FPC}
    b64:=TBase64DecodingStream.Create(AStream);
    try
      b64.CopyFrom(ms,ms.Size);
    finally
      b64.Free;
    end;
    {$ELSE}
    EncodeStream(ms,AStream);
    {$ENDIF}
    {$ENDIF}
    AStream.Position:=0;
    ms.Position:=0;
    sl.LoadFromStream(AStream);
    sl.Insert(0,'-----BEGIN CERTIFICATE-----');
    sl.Add('-----END CERTIFICATE-----');
    AStream.Clear;
    sl.SaveToStream(AStream);
    AStream.Position:=0;
    Result:=AStream.Size>0;
  finally
    ms.Free;
    sl.Free;
    {$IFDEF RAD15PLUS}
    b64.Free;
    {$ENDIF}
  end;
end;

function SaveCertContextToPEM(ACertContext: PCCERT_CONTEXT; const AFilename: string): boolean;
var
  ms: TMemoryStream;
begin
  ms:=TMemoryStream.Create;
  try
    Result:=SaveCertContextToPEM(ACertContext,ms);
    ms.SaveToFile(AFilename);
  finally
    ms.Free;
  end;
end;

function SaveCertStoreToDER(ACertStore: HCERTSTORE; const AFilename: string): boolean;
var
  s: WideString;
begin
  s:=AFilename;
  Result:=CertSaveStore(ACertStore,PKCS_7_ASN_ENCODING or X509_ASN_ENCODING,CERT_STORE_SAVE_AS_PKCS7,CERT_STORE_SAVE_TO_FILENAME,PWideChar(s),0);
end;

function SaveCertStoreToPEM(ACertStore: HCERTSTORE; AStream: TMemoryStream): boolean;
var
  ms: TMemoryStream;
  sl: TStringList;
  {$IFDEF RAD15PLUS}
  b64: TBase64Encoding;
  {$ENDIF}
  {$IFDEF FPC}
  b64: TBase64EncodingStream;
  {$ENDIF}
  cert: PCCERT_CONTEXT;
  n: Cardinal;
  ki: PCRYPT_KEY_PROV_INFO;
  hProv: HCRYPTPROV;
  hKey: HCRYPTKEY;
  cs: HCERTSTORE;
  b: CERT_BLOB;
begin
  AStream.Clear;
  ms:=TMemoryStream.Create;
  sl:=TStringList.Create;

  {$IFDEF RAD15PLUS}
  b64:=TBase64Encoding.Create(64);
  {$ENDIF}
  try
    (*
    SaveCertStoreToDER(ACertStore,ms);
    {$IFDEF RAD15PLUS}
    b64.Encode(ms,AStream);
    {$ELSE}
    {$IFDEF FPC}
    b64:=TBase64EncodingStream.Create(AStream);
    try
      b64.CopyFrom(ms,ms.Size);
    finally
      b64.Free;
    end;
    {$ELSE}
    EncodeStream(ms,AStream);
    {$ENDIF}
    {$ENDIF}
    AStream.Position:=0;
    ms.Position:=0;
    sl.LoadFromStream(AStream);
    sl.Insert(0,'-----BEGIN CERTIFICATE-----');
    sl.Add('-----END CERTIFICATE-----');
    *)
    {$IFDEF RAD15PLUS}
    //(*
    cert:=CertEnumCertificatesInStore(ACertStore,nil);
    while Assigned(cert) do begin
      cs:=CertOpenStore(CERT_STORE_PROV_MEMORY,0,0,CERT_STORE_CREATE_NEW_FLAG,nil);
      try
        if Assigned(cs) and CertAddCertificateContextToStore(cs,cert,CERT_STORE_ADD_NEW,nil) then begin
          b.cbData:=0;
          b.pbData:=nil;
          if CertSaveStore(cs,X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,CERT_STORE_SAVE_AS_PKCS7,CERT_STORE_SAVE_TO_MEMORY,@b,0) then begin
            b.pbData:=AllocMem(b.cbData);
            if CertSaveStore(cs,X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,CERT_STORE_SAVE_AS_PKCS7,CERT_STORE_SAVE_TO_MEMORY,@b,0) then begin
              sl.Add('-----BEGIN CERTIFICATE-----');
              sl.Add(TNetEncoding.Base64.EncodeBytesToString(b.pbData,b.cbData));
              sl.Add('-----END CERTIFICATE-----');
            end;
          end;
        end;
      finally
        CertCloseStore(cs,0);
      end;
      cert:=CertEnumCertificatesInStore(ACertStore,cert);
    end;
    //*)


    cert:=CertEnumCertificatesInStore(ACertStore,nil);
    while Assigned(cert) do begin
      if CertGetCertificateContextProperty(cert,CERT_KEY_PROV_INFO_PROP_ID,nil,n) then begin
        ki:=Allocmem(n);
        try
          if CertGetCertificateContextProperty(cert,CERT_KEY_PROV_INFO_PROP_ID,ki,n) then begin
            if CryptAcquireContext(hProv,ki.pwszContainerName,ki.pwszProvName,ki.dwProvType,ki.dwFlags) then begin
               if CryptGetUserKey(hProv,ki.dwKeySpec,hKey) then begin
                 b.cbData:=0;
                 b.pbData:=nil;
                 if CryptExportKey(hKey,0,PRIVATEKEYBLOB,0,nil,b.cbData) then begin
                   b.pbData:=AllocMem(b.cbData);
                   try
                     if CryptExportKey(hKey,0,PRIVATEKEYBLOB,0,b.pbData,b.cbData) then begin
                       sl.Add('-----BEGIN PRIVATE KEY-----');
                       sl.Add(TNetEncoding.Base64.EncodeBytesToString(b.pbData,b.cbData));
                       sl.Add('-----END PRIVATE KEY-----');
                     end;
                   finally
                     SecureZeroMemory(b.pbData,n);
                     FreeMem(b.pbData);
                   end;
                 end;
                 CryptDestroyKey(hKey);
               end;
               CryptReleaseContext(hProv,0);
            end;
            CryptAcquireContext(hProv,ki.pwszContainerName,ki.pwszProvName,ki.dwProvType,CRYPT_DELETEKEYSET);
          end;
        finally
          Freemem(ki);
        end;
      end;
      cert:=CertEnumCertificatesInStore(ACertStore,cert);
    end;

    {$ENDIF}

    AStream.Clear;
    sl.SaveToStream(AStream);
    AStream.Position:=0;
    Result:=AStream.Size>0;
  finally
    ms.Free;
    sl.Free;
    {$IFDEF RAD15PLUS}
    b64.Free;
    {$ENDIF}
  end;
end;

function SaveCertStoreToPEM(ACertStore: HCERTSTORE; const AFilename: string): boolean;
var
  ms: TMemoryStream;
begin
  ms:=TMemoryStream.Create;
  try
    Result:=SaveCertStoreToPEM(ACertStore,ms);
    ms.SaveToFile(AFilename);
  finally
    ms.Free;
  end;
end;

function AddCertContextToStore(ACertContext: PCCERT_CONTEXT; const ACertStoreName: string = 'MY'): boolean;
var
  cs: HCERTSTORE;
begin
  cs:=CertOpenStore(CERT_STORE_PROV_SYSTEM,0,0,CERT_SYSTEM_STORE_CURRENT_USER,PChar(ACertStoreName));
  try
    Result:=Assigned(cs) and CertAddCertificateContextToStore(cs,ACertContext,CERT_STORE_ADD_REPLACE_EXISTING,nil);
  finally
    CertCloseStore(cs,0);
  end;
end;

procedure RetrieveCertContextInfo(ACertContext: PCCERT_CONTEXT; out ACertContextInfo: TCertContextInfo);
var
  n,c: Cardinal;
  p: PCtlUsage;
  buf: PAnsiChar;
  i: integer;
  d: double;
  tp: TBytes;
  s: string;
begin
  if not Assigned(ACertContext) then
    Exit;
  ACertContextInfo.EncodingType:=ACertContext.dwCertEncodingType;
  ACertContextInfo.Encoding:='';
  if ACertContextInfo.EncodingType and X509_ASN_ENCODING>0 then
    ACertContextInfo.Encoding:=ACertContextInfo.Encoding+'X509|';
  if ACertContextInfo.EncodingType and PKCS_7_ASN_ENCODING>0 then
    ACertContextInfo.Encoding:=ACertContextInfo.Encoding+'PKCS7|';
  SetLength(ACertContextInfo.Encoding,Length(ACertContextInfo.Encoding)-1);
  ACertContextInfo.Version:=ACertContext.pCertInfo.dwVersion+1;
  ACertContextInfo.Issuer:=BLOBToStr(ACertContext.pCertInfo.Issuer);
  ACertContextInfo.QIssuer:=BLOBToX500Str(ACertContext.pCertInfo.Issuer);
  ACertContextInfo.Subject:=BLOBToStr(ACertContext.pCertInfo.Subject);
  ACertContextInfo.QSubject:=BLOBToX500Str(ACertContext.pCertInfo.Subject);
  ACertContextInfo.SignatureAlgorithm:=GetOIDInfo(string(ACertContext.pCertInfo.SignatureAlgorithm.pszObjId));
  ACertContextInfo.PublicKeyAlgorithm:=GetOIDInfo(string(ACertContext.pCertInfo.SubjectPublicKeyInfo.Algorithm.pszObjId));
  n:=ACertContext.pCertInfo.SubjectPublicKeyInfo.PublicKey.cbData*8-ACertContext.pCertInfo.SubjectPublicKeyInfo.PublicKey.cUnusedBits;
  c:=1;
  d:=0;
  while d<n do begin
    d:=Power(2,c+1);
    inc(c);
  end;
  ACertContextInfo.PublicKeyBits:=Round(Power(2,c-1));
  ACertContextInfo.Serial:=NormalizeSerial(BinaryToFormat(ACertContext.pCertInfo.SerialNumber.pbData,ACertContext.pCertInfo.SerialNumber.cbData,CRYPT_STRING_HEX));
  ACertContextInfo.ValidFrom:=FiletimeToDatetime(ACertContext.pCertInfo.NotBefore,True);
  ACertContextInfo.ValidTo:=FiletimeToDatetime(ACertContext.pCertInfo.NotAfter,True);
  if CertGetIntendedKeyUsage(ACertContext.dwCertEncodingType,ACertContext.pCertInfo,@ACertContextInfo.KeyUsageFlags,sizeof(ACertContextInfo.KeyUsageFlags)) then begin
    ACertContextInfo.KeyUsage:='';
    if ACertContextInfo.KeyUsageFlags and CERT_DATA_ENCIPHERMENT_KEY_USAGE>0 then
      ACertContextInfo.KeyUsage:=ACertContextInfo.KeyUsage+'Data Encipherment, ';
    if ACertContextInfo.KeyUsageFlags and CERT_DIGITAL_SIGNATURE_KEY_USAGE>0 then
      ACertContextInfo.KeyUsage:=ACertContextInfo.KeyUsage+'Digital Signature, ';
    if ACertContextInfo.KeyUsageFlags and CERT_KEY_AGREEMENT_KEY_USAGE>0 then
      ACertContextInfo.KeyUsage:=ACertContextInfo.KeyUsage+'Key Agreement, ';
    if ACertContextInfo.KeyUsageFlags and CERT_KEY_CERT_SIGN_KEY_USAGE>0 then
      ACertContextInfo.KeyUsage:=ACertContextInfo.KeyUsage+'Certificate Signing, ';
    if ACertContextInfo.KeyUsageFlags and CERT_KEY_ENCIPHERMENT_KEY_USAGE>0 then
      ACertContextInfo.KeyUsage:=ACertContextInfo.KeyUsage+'Key Encipherment, ';
    if ACertContextInfo.KeyUsageFlags and CERT_NON_REPUDIATION_KEY_USAGE>0 then
      ACertContextInfo.KeyUsage:=ACertContextInfo.KeyUsage+'Non Repundation, ';
    if ACertContextInfo.KeyUsageFlags and CERT_OFFLINE_CRL_SIGN_KEY_USAGE>0 then
      ACertContextInfo.KeyUsage:=ACertContextInfo.KeyUsage+'Offline CLR Signing, ';
    SetLength(ACertContextInfo.KeyUsage,Length(ACertContextInfo.KeyUsage)-2);
  end;
  ACertContextInfo.EnhancedKeyUsage:='';
  if CertGetEnhancedKeyUsage(ACertContext,0,nil,n) then begin
    p:=AllocMem(n);
    try
      ZeroMemory(p,n);
      if CertGetEnhancedKeyUsage(ACertContext,0,p,n) then begin
        c:=p.cUsageIdentifier;
        buf:=p.rgpszUsageIdentifier;
        inc(buf,sizeof(NativeUInt)*c);
        if c>0 then
          for i:=0 to c-1 do begin
            s:=GetOIDInfo(string(buf));
            if s<>'' then
              ACertContextInfo.EnhancedKeyUsage:=ACertContextInfo.EnhancedKeyUsage+s+', ';
            Inc(buf,Length(buf)+1);
          end;
        SetLength(ACertContextInfo.EnhancedKeyUsage,Length(ACertContextInfo.EnhancedKeyUsage)-2);
      end;
    finally
      Freemem(p);
    end;
  end;

  if CryptHashCertificate(0,CALG_SHA1,0,ACertContext.pbCertEncoded,AcertContext.cbCertEncoded,nil,n) then begin
    SetLength(tp,n);
    if CryptHashCertificate(0,CALG_SHA1,0,ACertContext.pbCertEncoded,ACertContext.cbCertEncoded,@tp[0],n) then
      ACertContextInfo.Thumbprint:=Lowercase(BytesToHEX(tp));
  end;
end;

procedure RetrieveCertStoreInfo(ACertStore: HCERTSTORE; ASignerInfo: PCmsgSignerInfo; out ACertStoreInfo: TCertStoreInfo);
var
  cert: PCCERT_CONTEXT;
  ci: TCertContextInfo;
  cs: HCERTSTORE;
begin
  if not Assigned(ACertStore) then
    Exit;
  cert:=CertEnumCertificatesInStore(ACertStore,nil);
  while Assigned(cert) do begin
    RetrieveCertContextInfo(cert,ci);
    SetLength(ACertStoreInfo,Length(ACertStoreInfo)+1);
    ACertStoreInfo[High(ACertStoreInfo)]:=ci;
    cert:=CertEnumCertificatesInStore(ACertStore,cert);
  end;

  if GetCertStoreFromSignerInfo(ASignerInfo,cs) and Assigned(cs) then begin
    cert:=CertEnumCertificatesInStore(cs,nil);
    while Assigned(cert) do begin
      RetrieveCertContextInfo(cert,ci);
      SetLength(ACertStoreInfo,Length(ACertStoreInfo)+1);
      ACertStoreInfo[High(ACertStoreInfo)]:=ci;
      cert:=CertEnumCertificatesInStore(cs,cert);
    end;
  end;
end;

function GetCertStorePEM(const AFilename: string; out ACertStore: HCERTSTORE): boolean;
var
  cert: PCCERT_CONTEXT;
begin
  Result:=False;
  ACertStore:=nil;
  GetCertContextPEM(AFilename,cert);
  if Assigned(cert) then begin
    ACertStore:=CertOpenStore(CERT_STORE_PROV_MEMORY,0,0,CERT_STORE_CREATE_NEW_FLAG,nil);
    Result:=Assigned(ACertStore) and CertAddCertificateContextToStore(ACertStore,cert,CERT_STORE_ADD_NEW,nil);
    CertFreeCertificateContext(cert);
  end;
end;

function GetCertStore(const AFilename: string; out ACertStore: HCERTSTORE): Boolean;
var
  s: {$IFDEF FPC}WideString{$ELSE}string{$ENDIF};
  sl: TStringlist;
begin
  ACertStore:=nil;
  s:=AFilename;
  if SameText(ExtractFileExt(AFilename),'.pem') or SameText(ExtractFileExt(AFilename),'.p7b') then begin
    sl:=TStringList.Create;
    try
      sl.LoadFromFile(AFilename);
      GetCertStoreText(sl.Text,ACertStore);
    finally
      sl.Free;
    end;
  end;
  if not Assigned(ACertStore) then
    ACertStore:=CertOpenStore(CERT_STORE_PROV_FILENAME,X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,0,CERT_STORE_OPEN_EXISTING_FLAG or CERT_STORE_READONLY_FLAG,PChar(s));
  Result:=Assigned(ACertStore);
end;

function GetCertStore(AStream: TStream; out ACertStore: HCERTSTORE): Boolean;
var
  b: TBytes;
begin
  AStream.Position:=0;
  SetLength(b,AStream.Size);
  AStream.Read(b[0],AStream.Size);
  Result:=GetCertStore(b,ACertStore);
end;

function GetCertStore(AData: TBytes; out ACertStore: HCERTSTORE): Boolean;
var
  Blob: CRYPTOAPI_BLOB;
begin
  Blob.cbData:=Length(AData);
  Blob.pbData:=@AData[0];
  ACertStore:=CertOpenStore(CERT_STORE_PROV_PKCS7,X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,0,0,@Blob);
  Result:=Assigned(ACertStore);
end;

function GetCertStoreText(const AData: string; out ACertStore: HCERTSTORE): Boolean; overload;
const
  cBegin = '-----BEGIN';
  cBeginCert = '-----BEGIN CERTIFICATE-----';
  cEndCert = '-----END CERTIFICATE-----';
  cBeginPKCS7 = '-----BEGIN PKCS7-----';
  cEndPKCS7 = '-----END PKCS7-----';
var
  certDecoded: TBytes;
  n: Cardinal;
  s,d: string;
  p,pe: integer;
  cert: PCCERT_CONTEXT;
begin
  Result:=False;
  ACertStore:=CertOpenStore(CERT_STORE_PROV_MEMORY,0,0,CERT_STORE_CREATE_NEW_FLAG,nil);
  cert:=nil;
  s:=AData;
  p:=Pos(cBegin,s);
  while p>0 do begin
    p:=Pos(cBeginCert,s);
    pe:=Pos(cEndCert,s);
    if (p>0) and (pe>0) then begin
      d:=Trim(Copy(s,p+Length(cBeginCert),pe-p-1-Length(cBeginCert)));
      Delete(s,1,pe+Length(cEndCert));
    end else begin
      p:=Pos(cBeginPKCS7,s);
      pe:=Pos(cEndPKCS7,s);
      if (p>0) and (pe>0) then begin
        d:=Trim(Copy(s,p+Length(cBeginPKCS7),pe-p-1-Length(cBeginPKCS7)));
        Delete(s,1,pe+Length(cEndPKCS7));
      end else
        Break;
    end;
    CryptStringToBinary(PChar(d),Length(d),CRYPT_STRING_BASE64_ANY,nil,n,nil,nil);
    SetLength(certDecoded,n);
    CryptStringToBinary(PChar(d),Length(d),CRYPT_STRING_BASE64_ANY,@certDecoded[0],n,nil,nil);
    cert:=CertCreateCertificateContext(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,@certDecoded[0],n);
    if Assigned(cert) and Assigned(ACertStore) then
      Result:=CertAddCertificateContextToStore(ACertStore,cert,CERT_STORE_ADD_NEW,nil);
  end;
  if not Result then begin
    CertCloseStore(ACertStore,0);
    ACertStore:=nil;
  end;
end;

function GetPFXCertStore(const AFilename, APassword: string; out ACertStore: HCERTSTORE): boolean;
var
  cfh: THandle;
  certEncoded: TBytes;
  certEncodedSize,cfs: Cardinal;
  pfx: CRYPT_DATA_BLOB;
  pwd: WideString;
begin
  Result:=False;
  ACertStore:=nil;

  cfh:=CreateFile(PChar(AFilename),GENERIC_READ,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
  if (cfh=INVALID_HANDLE_VALUE) then
    Exit;
  try
    cfs:=GetFileSize(cfh,nil);
    SetLength(certEncoded,cfs);
    if not ReadFile(cfh,certEncoded[0],cfs,certEncodedSize,nil) then
      Exit;
  finally
    CloseHandle(cfh);
  end;
  pfx.cbData:=cfs;
  pfx.pbData:=@certEncoded[0];
  pwd:=APassword;
  ACertStore:=PFXImportCertStore(@pfx,PWideChar(pwd),CRYPT_EXPORTABLE);
  Result:=Assigned(ACertStore);
end;

function GetSigner(hWVTStateData: THANDLE): string;
var
  provider: PCRYPT_PROVIDER_DATA;
  signer: PCRYPT_PROVIDER_SGNR;
  cert: PCRYPT_PROVIDER_CERT;
  s: string;
  i: Integer;
begin
  provider:=WTHelperProvDataFromStateData(hWVTStateData);
  if not Assigned(provider) then
    Exit;
  signer:=WTHelperGetProvSignerFromChain(provider,0,False,0);
  if not Assigned(signer) then
    Exit;
  cert:=WTHelperGetProvCertFromChain(signer,0);
  if not Assigned(cert) then
    Exit;
  i:=CertGetNameString(cert.pCert,CERT_NAME_SIMPLE_DISPLAY_TYPE,0,nil,nil,0);
  SetLength(s,i);
  CertGetNameString(cert.pCert,CERT_NAME_SIMPLE_DISPLAY_TYPE,0,nil,@s[1],Length(s));
  Result:=Trim(s);
end;

procedure GetProgAndPublisherInfo(hWVTStateData: THANDLE; var AProgramName,APublisherLink,AMoreInfoLink: string);
var
  i: integer;
  dwData: Cardinal;
  provider: PCRYPT_PROVIDER_DATA;
  signer: PCRYPT_PROVIDER_SGNR;
  OpusInfo: PSPC_SP_OPUS_INFO;
  rgAttr: PCRYPT_ATTRIBUTE;
begin
  AProgramName:='';
  AMoreInfoLink:='';
  APublisherLink:='';

  provider:=WTHelperProvDataFromStateData(hWVTStateData);
  if not Assigned(provider) then
    Exit;
  signer:=WTHelperGetProvSignerFromChain(provider,0,False,0);
  if not Assigned(signer) then
    Exit;

  rgAttr:=signer.psSigner.AuthAttrs.rgAttr;
  for i:=0 to signer.psSigner.AuthAttrs.cAttr-1 do begin
    if SameText(SPC_SP_OPUS_INFO_OBJID,string(rgAttr.pszObjId)) then begin
      if not CryptDecodeObject(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
                               SPC_SP_OPUS_INFO_OBJID,
                               rgAttr.rgValue.pbData,
                               rgAttr.rgValue.cbData,
                               0,
                               nil,
                               dwData) then
        Exit;
      OpusInfo:=AllocMem(dwData);
      try
        if not CryptDecodeObject(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
                                 SPC_SP_OPUS_INFO_OBJID,
                                 rgAttr.rgValue.pbData,
                                 rgAttr.rgValue.cbData,
                                 0,
                                 OpusInfo,
                                 dwData) then
          Exit;
        AProgramName:=string(OpusInfo.pwszProgramName);
        if Assigned(OpusInfo.pMoreInfo) then
          AMoreInfoLink:=string(OpusInfo.pMoreInfo.pwszFile);
        if Assigned(OpusInfo.pPublisherInfo) then
          APublisherLink:=string(OpusInfo.pPublisherInfo.pwszFile);
      finally
        FreeMem(OpusInfo);
      end;
      Break;
    end;
    Inc(rgAttr);
  end;
end;

procedure GetTimeStampSignerInfo(hWVTStateData: THANDLE; var AIssuer,ASerial: string);
var
  i: integer;
  dwData: Cardinal;
  provider: PCRYPT_PROVIDER_DATA;
  signer: PCRYPT_PROVIDER_SGNR;
  rgAttr: PCRYPT_ATTRIBUTE;
  pCounterSignerInfo: PCMSG_SIGNER_INFO;
begin
  AIssuer:='';
  ASerial:='';

  provider:=WTHelperProvDataFromStateData(hWVTStateData);
  if not Assigned(provider) then
    Exit;
  signer:=WTHelperGetProvSignerFromChain(provider,0,False,0);
  if not Assigned(signer) then
    Exit;

  rgAttr:=signer.psSigner.UnauthAttrs.rgAttr;
  for i:=0 to signer.psSigner.UnauthAttrs.cAttr-1 do begin
    if SameText(szOID_RSA_counterSign,string(rgAttr.pszObjId)) then begin
      if not CryptDecodeObject(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
                               PKCS7_SIGNER_INFO,
                               rgAttr.rgValue.pbData,
                               rgAttr.rgValue.cbData,
                               0,
                               nil,
                               dwData) then
        Exit;
      pCounterSignerInfo:=AllocMem(dwData);
      try
        if not CryptDecodeObject(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
                                 PKCS7_SIGNER_INFO,
                                 rgAttr.rgValue.pbData,
                                 rgAttr.rgValue.cbData,
                                 0,
                                 pCounterSignerInfo,
                                 dwData) then
          Exit;
        AIssuer:=BLOBToStr(pCounterSignerInfo.Issuer);
        ASerial:=BLOBToStr(pCounterSignerInfo.SerialNumber);
      finally
        FreeMem(pCounterSignerInfo);
      end;
      Break;
    end;
    Inc(rgAttr);
  end;
end;

function GetTimestamp(hWVTStateData: THANDLE): TDatetime;
var
  provider: PCRYPT_PROVIDER_DATA;
  signer: PCRYPT_PROVIDER_SGNR;
  i: Integer;
  ft: TFiletime;
  n: Cardinal;
begin
  Result:=0;
  provider:=WTHelperProvDataFromStateData(hWVTStateData);
  if not Assigned(provider) then
    Exit;
  signer:=WTHelperGetProvSignerFromChain(provider,0,False,0);
  if not Assigned(signer) or not Assigned(signer.pasCounterSigners) then
    Exit;
  for i:=0 to signer.pasCounterSigners.psSigner.AuthAttrs.cAttr-1 do begin
    if signer.pasCounterSigners.psSigner.AuthAttrs.rgAttr.pszObjId=szOID_RSA_signingTime then begin
      n:=sizeof(ft);
      if CryptDecodeObject(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
                           szOID_RSA_signingTime,
                           signer.pasCounterSigners.psSigner.AuthAttrs.rgAttr.rgValue.pbData,
                           signer.pasCounterSigners.psSigner.AuthAttrs.rgAttr.rgValue.cbData,
                           0,@ft,n) then begin
        Result:=FileTimeToDatetime(ft,True);
      end;
    end;
    inc(signer.pasCounterSigners.psSigner.AuthAttrs.rgAttr);
  end;
end;

procedure ViewSignerInfo(AHandle,AStateData: THandle);
var
  viewSignerInfo: CRYPTUI_VIEWSIGNERINFO_STRUCT;
  provData: PCRYPT_PROVIDER_DATA;
  sgnr: PCRYPT_PROVIDER_SGNR;
begin
  provData:=WTHelperProvDataFromStateData(AStateData);
  if not Assigned(provData) then
    Exit;
  sgnr:=WTHelperGetProvSignerFromChain(provData,0,FALSE,0);
  if not Assigned(sgnr) then
    Exit;

  FillChar(ViewSignerInfo,sizeof(ViewSignerInfo),0);
  viewSignerInfo.dwSize:=sizeof(viewSignerInfo);
  viewSignerInfo.hwndParent:=AHandle;
  viewSignerInfo.pSignerInfo:=sgnr^.psSigner;
  viewSignerInfo.hMsg:=provData^.hMsg;
  viewSignerInfo.pszOID:=szOID_PKIX_KP_CODE_SIGNING;
  cryptUIDlgViewSignerInfo(@viewSignerInfo);
end;

function VerifyFile(const AFilename: string; var ASigner: string; var ATimestamp: TDatetime; var AProgramName,APublisherLink,AMoreInfoLink: string; AHandle: THandle = INVALID_HANDLE_VALUE): Integer;
var
  FileData: TWintrustFileInfo;
  WinTrustData: TWinTrustData;
  hAdmin,hFile,hCtx: THandle;
  {cb: Cardinal;
  buf: TBytes;}
  CatalogInfo: TCatalogInfo;
  WTDCatalogInfo: TWintrustCatalogInfo;
  s: string;
begin
  ASigner:='';
  ATimestamp:=0;
  hAdmin:=0;
  hCtx:=0;
  hFile:=INVALID_HANDLE_VALUE;
  try
    hFile:=CreateFile(PChar(AFileName),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
    if hFile<>INVALID_HANDLE_VALUE then begin
      {if CryptCATAdminAcquireContext(hAdmin,nil,0) then begin
        SetLength(buf,255);
        cb:=Length(buf);
        if CryptCATAdminCalcHashFromFileHandle(hFile,cb,@buf[0],0) then begin
          SetLength(buf,cb);
          s:=BytesToHEX(buf);
          hCtx:=CryptCATAdminEnumCatalogFromHash(hAdmin,@buf[0],cb,0,nil);
        end;
      end;}
    end;

    FillChar(FileData,SizeOf(TWintrustFileInfo),0);
    FillChar(WinTrustData,SizeOf(TWinTrustData),0);

    WinTrustData.cbStruct:=sizeof(TWinTrustData);
    WinTrustData.dwUIChoice:=WTD_UI_NONE;
    WinTrustData.fdwRevocationChecks:=WTD_REVOKE_WHOLECHAIN;
    WinTrustData.dwProvFlags:=WTD_SAFER_FLAG;
    WinTrustData.dwStateAction:=WTD_STATEACTION_VERIFY;
    if hCtx=0 then begin
      FileData.cbStruct:=sizeof(TWintrustFileInfo);
      FileData.pcwszFilePath:=PWideChar(AFilename);
      FileData.hFile:=hFile;
      WinTrustData.dwUnionChoice:=WTD_CHOICE_FILE;
      WinTrustData.InfoUnion.pFile:=@FileData;
    end else begin
      CryptCATCatalogInfoFromContext(hCtx,@CatalogInfo,0);
      FillChar(WTDCatalogInfo,SizeOf(WTDCatalogInfo),0);
      WTDCatalogInfo.cbStruct:=SizeOf(WTDCatalogInfo);
      WTDCatalogInfo.pcwszCatalogFilePath:=@CatalogInfo.wszCatalogFile[0];
      WTDCatalogInfo.pcwszMemberFilePath:=PWideChar(AFilename);
      WTDCatalogInfo.pcwszMemberTag:=PWideChar(s);
      WinTrustData.dwUnionChoice:=WTD_CHOICE_CATALOG;
      WinTrustData.InfoUnion.pCatalog:=@WTDCatalogInfo;
    end;

    try
      Result:=WinVerifyTrustEx(INVALID_HANDLE_VALUE,WINTRUST_ACTION_GENERIC_VERIFY_V2,@WinTrustData);

      if (WinTrustData.hWVTStateData>0) then begin
        ASigner:=GetSigner(WinTrustData.hWVTStateData);
        ATimestamp:=GetTimestamp(WinTrustData.hWVTStateData);
        GetProgAndPublisherInfo(WinTrustData.hWVTStateData,AProgramName,APublisherLink,AMoreInfoLink);
      end;

      if AHandle<>INVALID_HANDLE_VALUE then
        ViewSignerInfo(AHandle,WinTrustData.hWVTStateData);

      WinTrustData.dwStateAction:=WTD_STATEACTION_CLOSE;

      WinVerifyTrustEx(INVALID_HANDLE_VALUE,WINTRUST_ACTION_GENERIC_VERIFY_V2,@WinTrustData);
    except
      Result:=0;
    end;

  finally
    if hFile<>INVALID_HANDLE_VALUE then
      CloseHandle(hFile);
    if hCtx>0 then
      CryptCATAdminReleaseCatalogContext(hAdmin,hCtx,0);
    if hAdmin<>0 then
      CryptCATAdminReleaseContext(hAdmin,0);
  end;
end;

function IsFileSigned(const AFilename: string): boolean;
var
  cs: HCERTSTORE;
  si: PCmsgSignerInfo;
begin
  Result:=GetCertStoreFromSignedFile(AFilename,cs,si) and Assigned(cs);
  if Assigned(cs) then
    CertCloseStore(cs,0);
  if Assigned(si) then
    FreeMem(si);
end;

function VerifyFile(const AFilename: string; AHandle: THandle = INVALID_HANDLE_VALUE): Integer;
var
  s,pn,pl,mi: string;
  dt: TDatetime;
begin
  Result:=VerifyFile(AFilename,s,dt,pn,pl,mi,AHandle);
end;

procedure ViewPFXCertificate(AHandle: THandle; const AFilename, APassword: string);
var
  cert: PCCERT_CONTEXT;
  vcs: CRYPTUI_VIEWCERTIFICATE_STRUCT;
  b: Bool;
begin
  if GetPFXCertContext(AFilename,APassword,cert) then begin
    FillChar(vcs,SizeOf(vcs),0);
    vcs.dwSize:=SizeOf(vcs);
    vcs.hwndParent:=AHandle;
    vcs.pCertContext:=cert;
    CryptUIDlgViewCertificate(@vcs,b);
    CertFreeCertificateContext(cert);
  end;
end;

procedure ViewCertificate(AHandle: THandle; const AFilename: string);
var
  cert: PCCERT_CONTEXT;
  vcs: CRYPTUI_VIEWCERTIFICATE_STRUCT;
  b: Bool;
begin
   if GetCertContext(AFilename,cert) or (SameText(ExtractFileExt(AFilename),'.pem') and GetCertContextPEM(AFilename,cert)) then begin
    FillChar(vcs,SizeOf(vcs),0);
    vcs.dwSize:=SizeOf(vcs);
    vcs.hwndParent:=AHandle;
    vcs.pCertContext:=cert;
    CryptUIDlgViewCertificate(@vcs,b);
    CertFreeCertificateContext(cert);
  end;
end;

function CreateSelfSignedCert(const ASubject, APassword: string; out ACertContext: PCCERT_CONTEXT): boolean;
const
  szOID_RSA_SHA256RSA = '1.2.840.113549.1.1.11';
var
  s: string;
  hProv,hKey: THandle;
  n: Cardinal;
  p: PByte;
  ok: boolean;
  kpi: TCryptKeyProvInfo;
  et: SYSTEMTIME;
  exts: TCertExtensions;
  sib: CERT_NAME_BLOB;
  cai: CRYPT_ALGORITHM_IDENTIFIER;
begin
  s:=ASubject;
  if Pos('=',s)=0 then
    s:='CN='+s;
  n:=0;
  hProv:=0;
  hKey:=0;
  ACertContext:=nil;
  if CertStrToName(X509_ASN_ENCODING,PChar(s),CERT_OID_NAME_STR,nil,nil,n,nil) then begin
    p:=AllocMem(n);
    if CertStrToName(X509_ASN_ENCODING,PChar(s),CERT_OID_NAME_STR,nil,p,n,nil) then begin
      sib.cbData:=n;
      sib.pbData:=p;
    end;
  end;

  ok:=False;
  if not CryptAcquireContext(hProv,'TEST',MS_DEF_PROV,PROV_RSA_FULL,CRYPT_NEWKEYSET or CRYPT_MACHINE_KEYSET) then begin
    if GetLastError=Cardinal(NTE_EXISTS) then
      ok:=CryptAcquireContext(hProv,'TEST',MS_DEF_PROV,PROV_RSA_FULL,CRYPT_MACHINE_KEYSET);
  end else
    ok:=True;

  if ok and CryptGenKey(hProv,AT_KEYEXCHANGE,RSA1024BIT_KEY or CRYPT_EXPORTABLE,hKey) then begin
    ZeroMemory(@cai,sizeof(cai));
    cai.pszObjId:=szOID_RSA_SHA256RSA;
    ZeroMemory(@kpi,sizeof(kpi));
    kpi.pwszContainerName:='TEST';
    kpi.pwszProvName:=MS_DEF_PROV;
    kpi.dwProvType:=PROV_RSA_FULL;
    kpi.dwFlags:=CRYPT_MACHINE_KEYSET;
    kpi.dwKeySpec:=AT_KEYEXCHANGE;
    GetSystemTime(et);
    Inc(et.wYear,10);
    ZeroMemory(@exts,sizeof(exts));
    //exts.cExtension:=cc.pCertInfo.cExtension;
    //exts.rgExtension:=cc.pCertInfo.rgExtension;
    ACertContext:=CertCreateSelfSignCertificate(hProv,@sib,0,@kpi,@cai,nil,@et,@exts);
  end;
  Result:=Assigned(ACertContext);
end;

function CreateSelfSignedCert(const ASubject, APassword, AFilename: string): boolean;
var
  cs: HCERTSTORE;
  fc: PCCERT_CONTEXT;
begin
  Result:=False;
  CreateSelfSignedCert(ASubject,Apassword,fc);
  if Assigned(fc) then begin
    cs:=CertOpenStore(CERT_STORE_PROV_MEMORY,0,0,CERT_STORE_CREATE_NEW_FLAG,nil);
    if Assigned(cs) and CertAddCertificateContextToStore(cs,fc,CERT_STORE_ADD_NEW,nil) then begin
      Result:=SaveCertStoreToPFX(cs,APassword,AFilename);
      CertFreeCertificateContext(fc);
    end;
    CertCloseStore(cs,0);
  end;
end;

function GetCertErrorText(ACode: integer): string;
const
  CERT_E_VALIDITYPERIODNESTING = HRESULT($800B0102);
begin
  case ACode of
    TRUST_E_PROVIDER_UNKNOWN: Result:='The trust provider is not recognized on this system';
    TRUST_E_ACTION_UNKNOWN: Result:='The trust verification action specified is not supported by the specified trust provider';
    TRUST_E_SUBJECT_FORM_UNKNOWN: Result:='The form specified for the subject is not one supported or known by the specified trust provider';
    TRUST_E_SUBJECT_NOT_TRUSTED: Result:='The subject is not trusted for the specified action';
    DIGSIG_E_ENCODE: Result:='Error due to problem in ASN.1 encoding process';
    DIGSIG_E_DECODE: Result:='Error due to problem in ASN.1 decoding process';
    DIGSIG_E_EXTENSIBILITY: Result:='Reading / writing Extensions where Attributes are appropriate, and visa versa';
    DIGSIG_E_CRYPTO: Result:='Unspecified cryptographic failure';
    PERSIST_E_SIZEDEFINITE: Result:='The size of the data could not be determined';
    PERSIST_E_SIZEINDEFINITE: Result:='The size of the indefinite-sized data could not be determined';
    PERSIST_E_NOTSELFSIZING: Result:='This object does not read and write self-sizing data';
    TRUST_E_NOSIGNATURE: Result:='No signature was present in the subject';
    CERT_E_EXPIRED: Result:='A required certificate is not within its validity period';
    CERT_E_VALIDITYPERIODNESTING: Result:='The validity periods of the certification chain do not nest correctly';
    CERT_E_ROLE: Result:='A certificate that can only be used as an end-entity is being used as a CA or visa versa';
    CERT_E_PATHLENCONST: Result:='A path length constraint in the certification chain has been violated';
    CERT_E_CRITICAL: Result:='An extension of unknown type that is labeled ''critical'' is present in a certificate';
    CERT_E_PURPOSE: Result:='A certificate is being used for a purpose other than that for which it is permitted';
    CERT_E_ISSUERCHAINING: Result:='A parent of a given certificate in fact did not issue that child certificate';
    CERT_E_MALFORMED: Result:='A certificate is missing or has an empty value for an important field, such as a subject or issuer name';
    CERT_E_UNTRUSTEDROOT: Result:='A certification chain processed correctly, but terminated in a root certificate which isn''t trusted by the trust provider';
    CERT_E_CHAINING: Result:='A chain of certs didn''t chain as they should in a certain application of chaining';
    else Result:=Format('Error %8.8x',[ACode]);
  end;
end;

end.