Attribute VB_Name = "basGetCertsFromPFX"
' $Id: basGetCertsFromPFX.bas $
' Last updated:
' $Date: 2020-11-11 05:23Z $
' $Revision: 1.0.0 $
' /******************************* LICENSE ***********************************
' * Copyright (C) 2020 David Ireland, DI Management Services Pty Limited.
' * All rights reserved. <www.di-mgt.com.au> <www.cryptosys.net>
' * The code in this module is licensed under the terms of the MIT license.
' * For a copy, see <http://opensource.org/licenses/MIT>
' ****************************************************************************
' Requires modules basCrPKI v20.0.0 and basCrPKIWrappers v20.0.2 in the project.
Option Explicit
Option Base 0
' A one-off processing of the PFX file
' 1. Read in private key just like from a PKCS8 key file
' 2. Extract all X.509 certificates in the chain
' 3. Show details of all these certificates
' 4. Find the certificate that matches the private key and copy it
' INPUT: name of PFX/p12 file, password, name of our certificate to be copied.
' RESULT: creates the following files:
' certs.p7b (may be deleted afterwards)
' cert1.cer, cert2.cer, ..., certN.cer
' Certificado.cer
Public Sub GetCertsFromPFX()
Dim strPfxName As String
Dim strPassword As String
Dim strPriKey As String
Dim strPubKey As String
Dim strMyCertName As String
Dim strCertFile As String
Dim strP7Name As String
Dim r As Long
Dim nCerts As Long
Dim iCert As Long
Dim strInfo As String
Dim strDigVal As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
' Hard-coded parameters - adjust to suit
strPfxName = "user.pfx"
strPassword = "password"
strMyCertName = "Certificado.cer"
' Expecting `work` subdirectory with working files in it - adjust to suit
ChDir Application.CurrentProject.Path & "\work"
Debug.Print "CurDir=" & CurDir()
' Read in our private key directly from the PFX file (just like a .p8e encrypted private key file)
strPriKey = rsaReadPrivateKey(strPfxName, strPassword)
Debug.Assert (Len(strPriKey) > 0)
Debug.Print "Pri key bits=" & RSA_KeyBits(strPriKey)
' Extract all the certificates as a P7 certificate chain file
' Strictly should be .p7c but use .p7b on Windows so you can click and read it
strP7Name = "certs.p7b"
r = X509_GetCertFromPFX(strP7Name, strPfxName, strPassword, PKI_PFX_P7CHAIN)
Debug.Print "X509_GetCertFromPFX returns " & r & " (expected >0)"
' How many certs do we have
nCerts = X509_GetCertFromP7Chain("", strP7Name, 0, 0)
Debug.Print "nCerts = " & nCerts
Debug.Assert nCerts > 0
' Enumerate through them all
For iCert = 1 To nCerts
strCertFile = "cert" & iCert & ".cer"
r = X509_GetCertFromP7Chain(strCertFile, strP7Name, iCert, 0)
Debug.Print "X509_GetCertFromP7Chain(" & iCert & ") returns " _
& r & " -> " & strCertFile
Debug.Assert r > 0
Debug.Print "FILE: " & strCertFile
' Extract details from certificate in XML-required form
strInfo = x509QueryCert(strCertFile, "subjectName", PKI_X509_LDAP)
Debug.Print "subjectName: " & strInfo
strInfo = x509QueryCert(strCertFile, "issuerName", PKI_X509_LDAP)
Debug.Print "issuerName : " & strInfo
strInfo = x509QueryCert(strCertFile, "serialNumber", PKI_X509_DECIMAL)
Debug.Print "serialNumber: " & strInfo
' Compute SHA-1 digest value of cert in hex-encoding
strDigVal = x509CertThumb(strCertFile, PKI_HASH_SHA1)
Debug.Print "DigestValue (hex) = " & strDigVal
' We want the base64-encoded form for XML
Debug.Print "DigestValue (b64) = " & cnvB64StrFromHexStr(strDigVal)
' See if this cert matches the private key from above
strPubKey = rsaReadPublicKey(strCertFile)
If RSA_KeyMatch(strPriKey, strPubKey) = 0 Then
Debug.Print "**MATCH: Private key matches the public key in '" & strCertFile & "'"
fso.CopyFile strCertFile, strMyCertName, True
Debug.Print "Copied '" & strCertFile & "' to '" & strMyCertName & "'"
Else
Debug.Print "Private key does not match this certificate"
End If
Next
' Clean up
strPassword = wipeString(strPassword)
End Sub