Public Sub TestCertBase64()
Dim strCertFile As String
Dim strBase64 As String
Dim strNewFile As String
' Read in the certificate in binary format
strCertFile = "AAA010101AAAsd.cer"
strBase64 = ReadX509CertAsBase64(strCertFile)
Debug.Print strBase64
' Save as a new
strNewFile = "AAA010.new.cer"
If SaveCertFromBase64(strNewFile, strBase64) Then
Debug.Print "Created new cert file " & strNewFile
Else
Debug.Print "ERROR: Failed to create a new file"
End If
End Sub
Private Function ReadX509CertAsBase64(strCertFile As String) As String
' Read in the X.509 certificate and convert to base64 format
' Use to create the content of a <X509Certificate> element.
' This assumes a BER-encoded certificate
' (If already in base64/PEM format, then read into a string
' and strip the "-----BEGIN" and "-----END" encapsulation)
Dim abCertData() As Byte
abCertData = ReadFileIntoBytes(strCertFile)
' Check
If abCertData(0) = 0 Then
MsgBox "Unable to read the certificate file '" & strCertFile & "'", vbCritical
Exit Function
End If
If abCertData(0) <> &H30 Then
MsgBox "Invalid format for certificate file '" & strCertFile & "'", vbCritical
Exit Function
End If
' Convert to base64
ReadX509CertAsBase64 = cnvB64StrFromBytes(abCertData)
End Function
Public Function SaveCertFromBase64(strCertFile As String, ByVal strBase64 As String) As Boolean
Dim abCertData() As Byte
' Remove any unwanted non-base64 chars
strBase64 = cnvB64Filter(strBase64)
' Convert to an array of bytes
abCertData = cnvBytesFromB64Str(strBase64)
' And save to a file
SaveCertFromBase64 = WriteFileFromBytes(strCertFile, abCertData)
End Function
Private Function ReadFileIntoBytes(sFilePath As String) As Variant
' Reads file (if it exists) into a byte array.
On Error GoTo OnError
Dim abIn() As Byte
Dim hFile As Integer
' Check if file exists
If Len(Dir(sFilePath)) = 0 Then
' If not return a single zero byte
ReDim abIn(0)
ReadFileIntoBytes = abIn
Exit Function
End If
hFile = FreeFile
Open sFilePath For Binary Access Read As #hFile
abIn = InputB(LOF(hFile), #hFile)
Close #hFile
ReadFileIntoBytes = abIn
Done:
Exit Function
OnError:
Resume Done
End Function
Private Function WriteFileFromBytes(sFilePath As String, abData() As Byte) As Boolean
' Creates a file from a string. Clobbers any existing file.
On Error GoTo OnError
Dim hFile As Integer
If Len(Dir(sFilePath)) > 0 Then
Kill sFilePath
End If
hFile = FreeFile
Open sFilePath For Binary Access Write As #hFile
Put #hFile, , abData
Close #hFile
WriteFileFromBytes = True
Done:
Exit Function
OnError:
Resume Done
End Function