Delphi/MiTec
Delphi/MiTec
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
master
MiTec/Common/MiTeC_Cert.pas
Daso 9407845155
Init
2024-07-06 22:30:25 +02:00

1463 lines
50 KiB
ObjectPascal
Raw Permalink Blame History

{*******************************************************}
{ }
{ 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.
Reference in New Issue View Git Blame Copy Permalink