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