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