Unit1;

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

CRYPTOAPI_BLOB = packed record
cbData: DWORD;
pbData: PByte;
end;

CRYPT_INTEGER_BLOB = CRYPTOAPI_BLOB;
CRYPT_OBJID_BLOB = CRYPTOAPI_BLOB;
CERT_NAME_BLOB = CRYPTOAPI_BLOB;

CRYPT_ALGORITHM_IDENTIFIER = packed record
pszObjId: LPSTR;
Parameters: CRYPT_OBJID_BLOB;
end;

CRYPT_BIT_BLOB = packed record
cbData: DWORD;
pbData: PBYTE;
cUnusedBits: DWORD;
end;

CERT_PUBLIC_KEY_INFO = packed record
Algorithm: CRYPT_ALGORITHM_IDENTIFIER;
PublicKey: CRYPT_BIT_BLOB;
end;

CERT_EXTENSION = packed record
pszObjId: LPSTR;
fCritical: BOOL;
Value: CRYPT_OBJID_BLOB;
end;
PCERT_EXTENSION = ^CERT_EXTENSION;
TARR_CERT_EXTENSION = PCERT_EXTENSION;

CERT_INFO = packed record
dwVersion: DWORD;
SerialNumber: CRYPT_INTEGER_BLOB;
SignatureAlgorithm: CRYPT_ALGORITHM_IDENTIFIER;
Issuer: CERT_NAME_BLOB;
NotBefore: FILETIME;
NotAfter: FILETIME;
Subject: CERT_NAME_BLOB;
SubjectPublicKeyInfo: CERT_PUBLIC_KEY_INFO;
IssuerUniqueId: CRYPT_BIT_BLOB;
SubjectUniqueId: CRYPT_BIT_BLOB;
cExtension: DWORD;
rgExtension: TARR_CERT_EXTENSION;
end;
PCERT_INFO = ^CERT_INFO;

HCERTSTORE = Pointer;
HCRYPTPROV = ULONG;

CERT_CONTEXT = packed record
dwCertEncodingType: DWORD;
pbCertEncoded: PBYTE;
cbCertEncoded: DWORD;
pCertInfo: PCERT_INFO;
hCertStore: HCERTSTORE;
end;
PCERT_CONTEXT = ^CERT_CONTEXT;
PCCERT_CONTEXT = ^CERT_CONTEXT;

function CertFreeCertificateContext(pCertContext:
PCCERT_CONTEXT): BOOL; stdcall external 'crypt32.dll';

function CertCreateCertificateContext(dwCertEncodingType: DWORD;
pbCertEncoded: PBYTE; cbCertEncoded: DWORD): PCCERT_CONTEXT; stdcall
external 'crypt32.dll';

const
X509_ASN_ENCODING = $00000001;
PKCS_7_ASN_ENCODING = $00010000;

var
Form1: TForm1;

implementation

{$R *.dfm}

function ByteArrayToStr(pbData: PByte; cbData: DWORD): String;
var
I, J: Integer;
S: String;
begin
Result := '';
if not Assigned(pbData) or (cbData Exit;
for I := 0 to cbData - 1 do
begin
J := PByteArray(pbData)^[I];
S := IntToHex(J, 2);
if (I > 0) and (I and 1 = 0) then
S := S + ' ';
Result := S + Result;
end;
end;

function GetSerialNumber(CertInfo: PCCERT_CONTEXT): String;
begin
Result := ByteArrayToStr(CertInfo.pCertInfo.SerialNumber.pbData,
CertInfo.pCertInfo.SerialNumber.cbData);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Context: PCCERT_CONTEXT;
M: TMemoryStream;
begin
if OpenDialog1.Execute then
begin
M := TMemoryStream.Create;
try
M.LoadFromFile(OpenDialog1.FileName);
Context := CertCreateCertificateContext(X509_ASN_ENCODING or
PKCS_7_ASN_ENCODING, M.Memory, M.Size);
if Assigned(Context) then
try
ShowMessage(GetSerialNumber(Context));
finally
if not CertFreeCertificateContext(Context) then
ShowMessage(SysErrorMessage(GetLastError));
end;
finally
M.Free;
end;
end;
end;

end.