Attribute VB_Name = "basMexicoSAT"
' $Id: basMexicoSAT $
' $Date: 2009-09-03 17:09 $
' $Author: dai $
' This module uses functions from the CryptoSys (tm) PKI Toolkit available from
' <www.cryptosys.net/pki/>.
' Include the module `basCrPKI' in your project.
' *************************** COPYRIGHT NOTICE ******************************
' This code was originally written by David Ireland and is copyright
' (C) 2005-9 DI Management Services Pty Ltd <www.di-mgt.com.au>.
' Provided "as is". No warranties. Use at your own risk. You must make your
' own assessment of its accuracy and suitability for your own purposes.
' It is not to be altered or distributed, except as part of an application.
' You are free to use it in any application, provided this copyright notice
' is left unchanged.
' ************************ END OF COPYRIGHT NOTICE **************************
Option Explicit
Option Compare Text
Public Sub Main()
Call Mex_CreateSignature
Call Mex_ExtractDigestFromSignature
Call Mex_CreateDigestFromString
Call Mex_CheckKeyAndCertMatch
Call Mex_Convert_Latin1_To_UTF8
Call Mex_ValidateCert
Call Mex_CertToBase64String
Call Mex_SAT_SerialNumber
Call Mex_QueryCertString
End Sub
Public Sub Mex_CreateSignature()
'@Proc: Mex_CreateSignature
'@Lang: VB6
'@ Creates a signature (sello) value in base64 format given the piped-string input and the private key
Dim strDataFile As String
Dim strKeyFile As String
Dim strPassword As String
Dim strPrivateKey As String
Dim abDigest() As Byte
Dim abBlock() As Byte
Dim nBlockLen As Long
Dim nLen As Long
Dim nRet As Long
Dim strBase64 As String
' INPUT: File containing piped-string formed from XML doc in UTF-8 format (NOTE: no Unicode markers in the file),
' private key file and its secret password(!)
strDataFile = "Muestra-v2_PipedString-UTF8.txt"
strKeyFile = "aaa010101aaa_CSD_01.key"
' Test password - CAUTION: DO NOT hardcode production passwords!
strPassword = "a0123456789"
' 1. Form the message digest hash of the piped-string directly from the file
ReDim abDigest(PKI_MD5_BYTES - 1)
nRet = HASH_File(abDigest(0), PKI_MD5_BYTES, strDataFile, PKI_HASH_MD5)
Debug.Print "HASH_File returns " & nRet
If nRet <= 0 Then
Debug.Print "ERROR: Failed to create hash of file. Error code: " & nRet
Exit Sub
End If
' Display in hex
Debug.Print "Digest=" & cnvHexStrFromBytes(abDigest)
' 2. Sign the message digest using the private key
' 2.1 Read in private key from encrypted .key file
strPrivateKey = rsaReadPrivateKey(strKeyFile, strPassword)
If Len(strPrivateKey) = 0 Then
Debug.Print "ERROR: Failed to read private key"
Exit Sub
End If
' -- show we got something
Debug.Print "Private key is " & RSA_KeyBits(strPrivateKey) & " bits long"
' 2.2 Encode the digest ready for signing with `Encoded Message for Signature' block using PKCS#1 v1.5 method
nBlockLen = RSA_KeyBytes(strPrivateKey)
ReDim abBlock(nBlockLen - 1)
nLen = RSA_EncodeMsg(abBlock(0), nBlockLen, abDigest(0), PKI_MD5_BYTES, PKI_EMSIG_DEFAULT + PKI_EMSIG_DIGESTONLY + PKI_HASH_MD5)
If nLen < 0 Then
Debug.Print "RSA_EncodeMsg: ERROR: " & nRet
Exit Sub
End If
Debug.Print "INPUT BLOCK= " & cnvHexStrFromBytes(abBlock)
' 2.3 Sign using the RSA private key
nRet = RSA_RawPrivate(abBlock(0), nBlockLen, strPrivateKey, 0)
' Display in hex
Debug.Print "OUTPUT BLOCK=" & cnvHexStrFromBytes(abBlock)
' 2.4 Clean up
strPrivateKey = wipeString(strPrivateKey)
strPassword = wipeString(strPassword)
' 3. Convert to base64 and output result
strBase64 = cnvB64StrFromBytes(abBlock)
Debug.Print "SIGNATURE VALUE=" & strBase64
End Sub
Public Function Mex_ExtractDigestFromSignature() As String
'@Proc: Mex_ExtractDigestFromSignature
'@Lang: VB6
'@ Extracts the message digest from a signature (sello) string using the X.509 certificate (certificado) value
Dim strPublicKey As String
Dim strSello As String
Dim strCertificado As String
Dim abMsg() As Byte
Dim abData() As Byte
Dim nRet As Long
Dim nSigLen As Long
Dim nMsgLen As Long
Dim strDigestHex As String
' INPUT: Base64 strings extracted from the XML file (Ref: Muestra_v2_signed2.xml)
strSello = "UlUSwGNEicfigV6i4RhTy0eb2RYWFYyFatJFcM/u5Wlkb5XRxXiCizTGw5Yxz9oZNk8msAgO4C5Gevjh+S2TJPZueYhaQeZlo6k0rE3CQexkOGVRpHkvAoAgOM5kGKzYe24DKZbTgjNL+ai+tbhEHmRAFcpv2rDpehbL3w6BnYU="
strCertificado = "MIIDhDCCAmygAwIBAgIUMTAwMDEyMDAwMDAwMDAwMjI1MTcwDQYJKoZIhvcNAQEFBQAwgcMxGTAXBgNVBAcTEENpdWRhZCBkZSBNZXhpY28xFTATBgNVBAgTDE1leGljbywgRC5GLjELMAkGA1UEBhMCTVgxGjAYBgNVBAMTEUFDIGRlIFBydWViYXMgU0FUMTYwNAYDVQQLFC1BZG1pbmlzdHJhY2nzbiBkZSBTZWd1cmlkYWQgZGUgbGEgSW5" & _
"mb3JtYWNp824xLjAsBgNVBAoUJVNlcnZpY2lvIGRlIEFkbWluaXN0cmFjafNuIFRyaWJ1dGFyaWEwHhcNMDgwODIxMTUyMjA4WhcNMTAwODIxMTUyMjA4WjCBmDElMCMGA1UELRMcQUFBMDEwMTAxQUFBIC8gQUFBQTAxMDEwMUFBQTEeMBwGA1UEBRMVIC8gQUFBQTAxMDEwMUhERlJYWDAxMRIwEAYDVQQKEwlNYXRyaXogU0ExEzARBgNVBA" & _
"sTClVuaWRhZCAxMCAxEjAQBgNVBAMTCU1hdHJpeiBTQTESMBAGA1UEKRMJTWF0cml6IFNBMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDpmiW1q9gyzCFtMcbaFDJexk2IpLoTdNXg4ToGRZ/f+hIjmj3N6ODWX1ARNFGYocEHf113GpW5Oe/mj6UqhBpiH4JRTNR4Udb8myJTArIlODynVHuIUuyhKo7gbMbDdXjilTAYY2XWQuQ7aDtWw" & _
"ntUmNg4vAC/F3OtRz3+y9wM5QIDAQABox0wGzAMBgNVHRMBAf8EAjAAMAsGA1UdDwQEAwIGwDANBgkqhkiG9w0BAQUFAAOCAQEAafyD4gMsOvq7E3raPntmQlJTxpWwNySqskE7fe23HVL9UKFCUlWWx/W8gluxIX9S19y17iWnGbtmbNddHxG5PznPsy/a8PlwNHjDW0FOpia2LsvDrNcdPiJhzL/1OVagkenffFf8bLEetF3ktxZ7ifcH1yxV" & _
"xpZ7PS/pe8YIOpWRuMmTV4ypGdsw9TW3HVP5IJ/canuQGPTb3LQ8ojihW2dHnC6ojaWW4GHFSZAPhQJ/DaH/UgFjaQke/RBtoAketfROdG+1qYeA1q/is04O4AXNmMByGp7ZnvGNrO9LDBvs3eKN4ZYcQyjxFEbr1X/xUqHCRF1VEkkC5jJQ1ktC4g=="
' 1. Read in Public key from X.509 certificate string directly
strPublicKey = rsaGetPublicKeyFromCert(strCertificado)
If Len(strPublicKey) = 0 Then
Debug.Print "ERROR: failed to read Certificado string"
Exit Function
End If
' --Show we got something useful
Debug.Print "Public key is " & RSA_KeyBits(strPublicKey) & " bits long"
' 2. Convert base64 signature value to byte array
abData = cnvBytesFromB64Str(strSello)
nSigLen = UBound(abData) - LBound(abData) + 1
' 2a. Check lengths match
Debug.Print "Signature bytes=" & nSigLen
Debug.Print "Key bytes =" & RSA_KeyBytes(strPublicKey)
If nSigLen <> RSA_KeyBytes(strPublicKey) Then
Debug.Print "ERROR: key length does not match signature"
Exit Function
End If
' 3.Decrypt using RSA public key
nRet = RSA_RawPublic(abData(0), nSigLen, strPublicKey, 0)
Debug.Print "RSA_RawPublic returns " & nRet & " (expected 0)"
If nRet <> 0 Then
Debug.Print "ERROR: failed to decrypt RSA signature: error code " & nRet
Exit Function
End If
' Display result in hex
Debug.Print "Decrypted signature=" & vbCrLf & cnvHexStrFromBytes(abData)
' 4. Decode to extract the original message digest
nMsgLen = RSA_DecodeMsg(0, 0, abData(0), nSigLen, PKI_EMSIG_DEFAULT)
ReDim abMsg(nMsgLen - 1)
nMsgLen = RSA_DecodeMsg(abMsg(0), nMsgLen, abData(0), nSigLen, PKI_EMSIG_DEFAULT)
' 5. Convert to hex format
strDigestHex = cnvHexStrFromBytes(abMsg)
' OUTPUT: Digest in hex format
Debug.Print "MD5 digest as hex: " & strDigestHex
Mex_ExtractDigestFromSignature = LCase(cnvHexStrFromBytes(abMsg))
End Function
Public Function Mex_CreateDigestFromString() As String
'@Proc: Mex_CreateDigestFromString
'@Lang: VB6
'@ Creates the MD5 digest of the input string after converting to UTF-8 encoding
Dim strData As String
Dim strDataUTF8 As String
Dim strDigest As String
Dim nRet As Long
Dim nLen As Long
' INPUT: Our original string data in "Latin-1" encoding
strData = "||2.0|A|1|2009-08-16T16:30:00|1|2009|ingreso|Una sola exhibición|350.00|5.25|397.25|ISP900909Q88|Industrias del Sur Poniente, S.A. de C.V.|Alvaro Obregón|37|3|Col. Roma Norte|México|Cuauhtémoc|Distrito Federal|México|06700|Pino Suarez|23|Centro|Monterrey|Monterrey|Nuevo Léon|México|95460|CAUR390312S87|Rosa María Calderón Uriegas|Topochico|52|Jardines del Valle|Monterrey|Monterrey|Nuevo León|México|95465|10|Caja|Vasos decorados|20.00|200|1|pieza|Charola metálica|150.00|150|IVA|15.00|52.50||"
Debug.Print "INPUT=" & strData
' 1. Convert Latin-1 to UTF-8, if necessary
If CNV_CheckUTF8(strData) = 0 Then
' Our input string is in Latin-1 and we want UTF-8
nLen = CNV_UTF8FromLatin1("", 0, strData)
strDataUTF8 = String(nLen, " ")
nLen = CNV_UTF8FromLatin1(strDataUTF8, Len(strDataUTF8), strData)
Else
strDataUTF8 = strData
End If
' 2. Create the message digest hash
' but first dimension the string to receive it
strDigest = String(PKI_MD5_CHARS, " ")
nRet = HASH_HexFromString(strDigest, Len(strDigest), strDataUTF8, Len(strDataUTF8), PKI_HASH_MD5)
Debug.Print "HASH_HexFromString returns " & nRet
' OUTPUT: Display digest in hex format
Debug.Print "Digest=" & strDigest
Mex_CreateDigestFromString = strDigest
End Function
Public Sub Mex_CheckKeyAndCertMatch()
'@Proc: Mex_Create_Digest
'@Lang: VB6
'@ Checks that the keys in the private key and certificate match
Dim strCertFile As String
Dim strKeyFile As String
Dim strPassword As String
Dim strPublicKey As String
Dim strPrivateKey As String
Dim nRet As Long
' INPUT: filenames for certificate and private key files
strCertFile = "aaa010101aaa_CSD_01.cer"
strKeyFile = "aaa010101aaa_CSD_01.key"
' Test password - CAUTION: DO NOT hardcode production passwords!
strPassword = "a0123456789"
' 1. Read in private key from encrypted .key file
strPrivateKey = rsaReadPrivateKey(strKeyFile, strPassword)
If Len(strPrivateKey) > 0 Then
Debug.Print "Private key is " & RSA_KeyBits(strPrivateKey) & " bits"
Else
Debug.Print "ERROR: Cannot read private key file."
Exit Sub
End If
' 2. Clean up password as we are done with it
strPassword = wipeString(strPassword)
' 3. Read in public key from certificate
strPublicKey = rsaGetPublicKeyFromCert(strCertFile)
If Len(strPublicKey) > 0 Then
Debug.Print "Public key is " & RSA_KeyBits(strPublicKey) & " bits"
Else
Debug.Print "ERROR: Cannot read certificate file."
Exit Sub
End If
' 4. See if the two key strings match
nRet = RSA_KeyMatch(strPrivateKey, strPublicKey)
If nRet = 0 Then
Debug.Print "OK, key strings match."
Else
Debug.Print "FAILED: key strings do not match."
End If
' 5. Clean up private key string
strPrivateKey = wipeString(strPrivateKey)
End Sub
Public Sub Mex_Convert_Latin1_To_UTF8()
'@Proc: Mex_Convert_Latin1_To_UTF8
'@Lang: VB6 $
'@ Checks if a string is valid UTF-8 and converts between Latin-1 and UTF-8 encodings
Dim strData As String
Dim strDataUTF8 As String
Dim strDataLatin1 As String
Dim nRet As Long
Dim nLen As Long
' Our original string data is in "Latin-1" encoding
strData = "Asociación Mexicana de Estándares para el Comercio Electrónico A.C.|México|"
Debug.Print "INPUT: " & strData
' Is it valid UTF-8?
nRet = CNV_CheckUTF8(strData)
Debug.Print "CNV_CheckUTF8 returns " & nRet & " (0 => Not valid UTF-8)"
' So convert to UTF-8
nLen = CNV_UTF8FromLatin1("", 0, strData)
If nLen < 0 Then
Debug.Print "Failed to convert to UTF-8: " & nLen
Exit Sub
End If
strDataUTF8 = String(nLen, " ")
nLen = CNV_UTF8FromLatin1(strDataUTF8, nLen, strData)
' Which may not display correctly in VB6...!
Debug.Print "UTF-8: " & strDataUTF8
' Now convert back to Latin-1
nLen = CNV_Latin1FromUTF8("", 0, strDataUTF8)
strDataLatin1 = String(nLen, " ")
nLen = CNV_Latin1FromUTF8(strDataLatin1, nLen, strDataUTF8)
Debug.Print "Latin-1: " & strDataLatin1
End Sub
Public Sub Mex_ValidateCert()
'@Proc: Mex_ValidateCert
'@Lang: VB6
'@ Checks that a given X.509 certificate really was issued by the issuer and has not expired
Dim strCert As String
Dim strIssuerCert As String
Dim nRet As Long
' INPUT: Filenames of certificate to be checked and issuer's certificate
strCert = "aaa010101aaa_CSD_01.cer"
strIssuerCert = "AC_SAT2048.cer"
' 1. Was this cert signed by the purported issuer?
nRet = X509_VerifyCert(strCert, strIssuerCert, 0)
Debug.Print "X509_VerifyCert returns " & nRet
If nRet < 0 Then
Debug.Print "ERROR: Validation failed"
ElseIf nRet > 0 Then
Debug.Print "ERROR: " & pkiErrorLookup(nRet)
Else
Debug.Print "OK, cert was signed by issuer."
End If
' 2. Is this cert still valid now?
nRet = X509_CertIsValidNow(strCert, 0)
Debug.Print "X509_CertIsValidNow returns " & nRet
If nRet < 0 Then
Debug.Print "ERROR: cert has expired"
ElseIf nRet > 0 Then
Debug.Print "ERROR: " & pkiErrorLookup(nRet)
Else
Debug.Print "OK, cert is still valid now."
End If
End Sub
Public Sub Mex_CertToBase64String()
'@Proc: Mex_CertToBase64String
'@Lang: VB6
'@ Converts an X.509 certificate file into a base64 string suitable for Certificado field in XML,
' and shows how this string form can be treated just like the .cer file.
Dim nRet As Long
Dim strCertString As String
Dim strCertFile As String
Dim strThumb1 As String
Dim strThumb2 As String
strCertFile = "aaa010101aaa_CSD_01.cer"
' Read in certificate file's data to a string
nRet = X509_ReadStringFromFile("", 0, strCertFile, 0)
Debug.Print "X509_ReadStringFromFile returns " & nRet
If nRet <= 0 Then
Debug.Print "ERROR: Unable to read certificate file. Error: " & nRet
Exit Sub
End If
strCertString = String(nRet, " ")
nRet = X509_ReadStringFromFile(strCertString, Len(strCertString), strCertFile, 0)
Debug.Print "For certificate '" & strCertFile & "':"
Debug.Print strCertString
' Check that the two versions of the certificate are identical by computing their SHA-1 thumbprints
strThumb1 = String(PKI_SHA1_CHARS, " ")
strThumb2 = String(PKI_SHA1_CHARS, " ")
nRet = X509_CertThumb(strCertFile, strThumb1, Len(strThumb1), 0)
nRet = X509_CertThumb(strCertString, strThumb2, Len(strThumb2), 0)
Debug.Print "SHA-1(file) =" & strThumb1
Debug.Print "SHA-1(string)=" & strThumb2
If strThumb1 = strThumb2 Then
Debug.Print "Certificates are identical"
Else
Debug.Print "ERROR: certificates do not match"
End If
End Sub
Public Sub Mex_SAT_SerialNumber()
'@Proc: Mex_SAT_SerialNumber
'@Lang: VB6
'@ Extracts the serial number from a SAT-issued X.509 certificate and displays in base64 format
Dim nLen As Long
Dim strCertFile As String
Dim strSerialNumber As String
Dim strSerialSAT As String
' Extract the certificate's serial number
strCertFile = "AAA010101AAAsd.cer"
nLen = X509_CertSerialNumber(strCertFile, "", 0, 0)
If (nLen <= 0) Then Exit Sub
strSerialNumber = String(nLen, " ")
nLen = X509_CertSerialNumber(strCertFile, strSerialNumber, Len(strSerialNumber), 0)
Debug.Print "X.509 Serial Number=0x" & strSerialNumber
' Decode from hex-encoded integer to string of ASCII digits
strSerialSAT = StrConv(cnvBytesFromHexStr(strSerialNumber), vbUnicode)
Debug.Print "Decoded SAT Format ='" & strSerialSAT & "'"
End Sub
Public Sub Mex_QueryCertString()
'@Proc: Mex_QueryCertString
'@Lang: VB6
'@ Extracts various details from a certificate string
Dim strCertificado As String
Dim strOutput As String
Dim strQuery As String
Dim nLen As Long
' INPUT: Certificado string frm XML file. This is the same as in the file aaa010101aaa_CSD_01.cer.
strCertificado = "MIIDhDCCAmygAwIBAgIUMTAwMDEyMDAwMDAwMDAwMjI1MTcwDQYJKoZIhvcNAQEFBQAwgcMxGTAXBgNVBAcTEENpdWRhZCBkZSBNZXhpY28xFTATBgNVBAgTDE1leGljbywgRC5GLjELMAkGA1UEBhMCTVgxGjAYBgNVBAMTEUFDIGRlIFBydWViYXMgU0FUMTYwNAYDVQQLFC1BZG1pbmlzdHJhY2nzbiBkZSBTZWd1cmlkYWQgZGUgbGEgSW5" & _
"mb3JtYWNp824xLjAsBgNVBAoUJVNlcnZpY2lvIGRlIEFkbWluaXN0cmFjafNuIFRyaWJ1dGFyaWEwHhcNMDgwODIxMTUyMjA4WhcNMTAwODIxMTUyMjA4WjCBmDElMCMGA1UELRMcQUFBMDEwMTAxQUFBIC8gQUFBQTAxMDEwMUFBQTEeMBwGA1UEBRMVIC8gQUFBQTAxMDEwMUhERlJYWDAxMRIwEAYDVQQKEwlNYXRyaXogU0ExEzARBgNVBA" & _
"sTClVuaWRhZCAxMCAxEjAQBgNVBAMTCU1hdHJpeiBTQTESMBAGA1UEKRMJTWF0cml6IFNBMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDpmiW1q9gyzCFtMcbaFDJexk2IpLoTdNXg4ToGRZ/f+hIjmj3N6ODWX1ARNFGYocEHf113GpW5Oe/mj6UqhBpiH4JRTNR4Udb8myJTArIlODynVHuIUuyhKo7gbMbDdXjilTAYY2XWQuQ7aDtWw" & _
"ntUmNg4vAC/F3OtRz3+y9wM5QIDAQABox0wGzAMBgNVHRMBAf8EAjAAMAsGA1UdDwQEAwIGwDANBgkqhkiG9w0BAQUFAAOCAQEAafyD4gMsOvq7E3raPntmQlJTxpWwNySqskE7fe23HVL9UKFCUlWWx/W8gluxIX9S19y17iWnGbtmbNddHxG5PznPsy/a8PlwNHjDW0FOpia2LsvDrNcdPiJhzL/1OVagkenffFf8bLEetF3ktxZ7ifcH1yxV" & _
"xpZ7PS/pe8YIOpWRuMmTV4ypGdsw9TW3HVP5IJ/canuQGPTb3LQ8ojihW2dHnC6ojaWW4GHFSZAPhQJ/DaH/UgFjaQke/RBtoAketfROdG+1qYeA1q/is04O4AXNmMByGp7ZnvGNrO9LDBvs3eKN4ZYcQyjxFEbr1X/xUqHCRF1VEkkC5jJQ1ktC4g=="
' 1. Get the Issuer's distinguished name (converting any UTF-8 characters to Latin-1)
nLen = X509_CertIssuerName(strCertificado, "", 0, "", PKI_X509_LATIN1)
Debug.Print "X509_CertIssuerName returns " & nLen
If (nLen <= 0) Then Exit Sub
strOutput = String(nLen, " ")
nLen = X509_CertIssuerName(strCertificado, strOutput, Len(strOutput), "", PKI_X509_LATIN1)
Debug.Print "ISSUER= [" & strOutput & "]"
' 2. Get the Subject's distinguished name
nLen = X509_CertSubjectName(strCertificado, "", 0, "", PKI_X509_LATIN1)
Debug.Print "X509_CertSubjectName returns " & nLen
If (nLen <= 0) Then Exit Sub
strOutput = String(nLen, " ")
nLen = X509_CertSubjectName(strCertificado, strOutput, Len(strOutput), "", PKI_X509_LATIN1)
Debug.Print "SUBJECT=[" & strOutput & "]"
' 3. Get the Serial Number
nLen = X509_CertSerialNumber(strCertificado, "", 0, 0)
If (nLen <= 0) Then Exit Sub
strOutput = String(nLen, " ")
nLen = X509_CertSerialNumber(strCertificado, strOutput, Len(strOutput), 0)
Debug.Print "X.509 Serial Number=0x" & strOutput
' 4. Get the expiry date
nLen = X509_CertExpiresOn(strCertificado, "", 0, 0)
If (nLen <= 0) Then Exit Sub
strOutput = String(nLen, " ")
nLen = X509_CertExpiresOn(strCertificado, strOutput, Len(strOutput), 0)
Debug.Print "Expires on: " & strOutput
' 5. Get the signature algorithm
strQuery = "signatureAlgorithm"
nLen = X509_QueryCert("", 0, strCertificado, strQuery, 0)
If (nLen <= 0) Then Exit Sub
strOutput = String(nLen, " ")
nLen = X509_QueryCert(strOutput, Len(strOutput), strCertificado, strQuery, 0)
Debug.Print strQuery & "=" & strOutput
End Sub