Archived Forum Post

Index of archived forum posts

Question:

VB6: LoadPkcs8Encrypted VS LoadPkcs8EncryptedFile methods in "privateKey" class

Jan 17 '14 at 16:43

I have created a couple of methods in VB6, consider:

Dim keyPEMstr as String Dim KeyPathName as String Dim errDesc as String

KeyPathName = "anyfile.key" ' a valid .key file keyPassword = "thePassw" ' a valid password for this .key file

Let keyPEMstr = get_keyPEMstrFromKEYfile(KeyPathName, keyPassword, errDesc) ' up to here there is no problem I get the string I want: a string with the PEM.

' by the other hand if I try:

**Let KEYstr = Encode64(StringArrayLoad(KeyPathName, "AbreLLaveCHILKAT"), False) ' converting to base64 the string representing the .key file

Let keyPEMstr = get_keyPEMstr(KEYstr, keyPassword, errDesc)**

' I get problems at the LoadPkcs8Encrypted method of the keyPEMstr function ' ' WHAT IS HPPENING IN THE SECOND CASE ? ' HOW CAN I GET IT WORKING? ' I am using DllDate: Aug 15 2013, ChilkatVersion: 9.4.1.42 '
'

Best Regards.

Art.


the next functions are used:

Public Function get_keyPEMstr(ByVal base64_KEYstr As String, ByVal keyPassword As String, _ Optional ByRef errDescripcion As String) As String

' by Arturo González Rivera, http://www.gorsa.net.mx

Dim privKey As privateKey 'chilkatcert.dll Dim rsa As ChilkatRsa 'chilkatrsa.dll Dim privKeyXml As String

Dim success As Long

Let errDescripcion = ""

Let get_keyPEMstr = ""

Set privKey = New privateKey

Let success = privKey.LoadPkcs8Encrypted(base64_KEYstr, keyPassword) ' ERROR!

If (success <> 1) Then Let errDescripcion = privKey.LastErrorText Set privKey = Nothing Exit Function End If

Let get_keyPEMstr = privKey.GetRsaPem ' en base64

Set privKey = Nothing

End Function '----------- Public Function get_keyPEMstrFromKEYfile(ByVal PathFileNameKey As String, ByVal keyPassword As String, _ Optional ByRef errDescripcion As String) As String

' by Arturo González Rivera, http://www.gorsa.net.mx

Dim privKey As privateKey 'chilkatcert.dll

Dim success As Long

Let errDescripcion = ""

Let get_keyPEMstrFromKEYfile = ""

Set privKey = New privateKey

Let success = privKey.LoadPkcs8EncryptedFile(PathFileNameKey, keyPassword) ' loadXML(privKeyXml) If (success <> 1) Then Let errDescripcion = privKey.LastErrorText Set privKey = Nothing Exit Function End If

Let get_keyPEMstrFromKEYfile = privKey.GetRsaPem ' en base64

Set privKey = Nothing End Function

' ----- USED EXTRA FUNCTIONS FOR THIS EXAMPLE ---------------

Public Function Encode64(sString As String, Optional ByVal incluyeCaracteresCRLF As Boolean = True) As String

Dim bTrans(63) As Byte, lPowers8(255) As Long, lPowers16(255) As Long, bOut() As Byte, bIn() As Byte
Dim lChar As Long, lTrip As Long, iPad As Integer, lLen As Long, lTemp As Long, lPos As Long, lOutSize As Long
Dim sStringOut As String

For lTemp = 0 To 63                                 'Fill the translation table.
    Select Case lTemp
        Case 0 To 25
            bTrans(lTemp) = 65 + lTemp              'A - Z
        Case 26 To 51
            bTrans(lTemp) = 71 + lTemp              'a - z
        Case 52 To 61
            bTrans(lTemp) = lTemp - 4               '1 - 0
        Case 62
            bTrans(lTemp) = 43                      'Chr(43) = "+"
        Case 63
            bTrans(lTemp) = 47                      'Chr(47) = "/"
    End Select
Next lTemp

For lTemp = 0 To 255                                'Fill the 2^8 and 2^16 lookup tables.
    lPowers8(lTemp) = lTemp * cl2Exp8
    lPowers16(lTemp) = lTemp * cl2Exp16
Next lTemp

iPad = Len(sString) Mod 3                           'See if the length is divisible by 3
If iPad Then                                        'If not, figure out the end pad and resize the input.
    iPad = 3 - iPad
    sString = sString & String(iPad, Chr(0))
End If

bIn = StrConv(sString, vbFromUnicode)               'Load the input string.
lLen = ((UBound(bIn) + 1) \ 3) * 4                  'Length of resulting string.
lTemp = lLen \ 72                                   'Added space for vbCrLfs.
lOutSize = ((lTemp * 2) + lLen) - 1                 'Calculate the size of the output buffer.
ReDim bOut(lOutSize)                                'Make the output buffer.

lLen = 0                                            'Reusing this one, so reset it.

For lChar = LBound(bIn) To UBound(bIn) Step 3
    lTrip = lPowers16(bIn(lChar)) + lPowers8(bIn(lChar + 1)) + bIn(lChar + 2)    'Combine the 3 bytes
    lTemp = lTrip And clOneMask                     'Mask for the first 6 bits
    bOut(lPos) = bTrans(lTemp \ cl2Exp18)           'Shift it down to the low 6 bits and get the value
    lTemp = lTrip And clTwoMask                     'Mask for the second set.
    bOut(lPos + 1) = bTrans(lTemp \ cl2Exp12)       'Shift it down and translate.
    lTemp = lTrip And clThreeMask                   'Mask for the third set.
    bOut(lPos + 2) = bTrans(lTemp \ cl2Exp6)        'Shift it down and translate.
    bOut(lPos + 3) = bTrans(lTrip And clFourMask)   'Mask for the low set.
    If lLen = 68 Then                               'Ready for a newline
        bOut(lPos + 4) = 13                         'Chr(13) = vbCr
        bOut(lPos + 5) = 10                         'Chr(10) = vbLf
        lLen = 0                                    'Reset the counter
        lPos = lPos + 6
    Else
        lLen = lLen + 4
        lPos = lPos + 4
    End If
Next lChar

If bOut(lOutSize) = 10 Then lOutSize = lOutSize - 2 'Shift the padding chars down if it ends with CrLf.

If iPad = 1 Then                                    'Add the padding chars if any.
    bOut(lOutSize) = 61                             'Chr(61) = "="
ElseIf iPad = 2 Then
    bOut(lOutSize) = 61
    bOut(lOutSize - 1) = 61
End If

If incluyeCaracteresCRLF Then
  sStringOut = StrConv(bOut, vbUnicode)                 'Convert back to a string and return it.
Else
  sStringOut = Replace(StrConv(bOut, vbUnicode), vbCr, vbNullString)  'Convert back to a string and return it.
  sStringOut = Replace(sStringOut, vbLf, vbNullString)      'either order.
End If
Encode64 = sStringOut

End Function

Public Function StringArrayLoad(FileName As String, Optional ByVal RutinaDeProcedencia As String = "") As String Dim f As Integer Dim strCadena As String

On Error GoTo Ver

f = FreeFile

Open FileName For Binary Access Read As #f Let strCadena = Space(LOF(f)) Get #f, , strCadena Let StringArrayLoad = strCadena Close #f Exit Function Ver: MsgBox "Nº de error: " & Err.Number & " | " & Err.Description, vbCritical, "Control de errores [" & RutinaDeProcedencia & "]" Err.Clear Close #f End Function