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