Results 1 to 11 of 11

Thread: VB6 - Base64 Encoding

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,470

    VB6 - Base64 Encoding

    Below is a class to encode strings or files in Base64. The data can be sent to the class as an ANSI string, a Unicode string, or a Byte Array. The sample program provided demonstrates the usage.

    J.A. Coutts
    Code:
    Option Explicit
    
    Private Const CBS As String = "CryptBinaryToString"
    Private Const CSB As String = "CryptStringToBinary"
    Private Const CRYPT_STRING_BASE64 As Long = 1
    
    Private sBase64Buf As String
    Private m_bData() As Byte
    
    Private Declare Function CryptBinaryToString Lib "Crypt32.dll" Alias "CryptBinaryToStringW" (ByRef pbBinary As Byte, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, ByRef pcchString As Long) As Long
    Private Declare Function CryptStringToBinary Lib "Crypt32.dll" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByRef pcbBinary As Long, ByRef pdwSkip As Long, ByRef pdwFlags As Long) As Long
    
    '================================
    'EVENTS
    '================================
    Public Event Error(ByVal Number As Long, Description As String, ByVal Source As String)
    
    Public Property Get bBuffer() As Byte()
        bBuffer = m_bData
    End Property
    
    Public Property Let bBuffer(bNewValue() As Byte)
        m_bData = bNewValue
    End Property
    
    Public Property Get Base64Buf() As String
        Base64Buf = sBase64Buf
    End Property
    
    Public Property Let Base64Buf(sNewValue As String)
        sBase64Buf = sNewValue
    End Property
    
    Public Sub Base64Decode()
        Const Routine As String = "Base64.Base64Decode"
        Const CRYPT_STRING_BASE64 As Long = 1
        Const CRYPT_STRING_NOCRLF As Long = &H40000000
        Dim bTmp() As Byte
        Dim lLen As Long
        Dim dwActualUsed As Long
        'Get output buffer length
        If CryptStringToBinary(StrPtr(sBase64Buf), Len(sBase64Buf), CRYPT_STRING_BASE64, StrPtr(vbNullString), lLen, 0&, dwActualUsed) = 0 Then
            RaiseEvent Error(Err.LastDllError, CSB, Routine)
            GoTo ReleaseHandles
        End If
        'Convert Base64 to binary.
        ReDim bTmp(lLen - 1)
        If CryptStringToBinary(StrPtr(sBase64Buf), Len(sBase64Buf), CRYPT_STRING_BASE64, VarPtr(bTmp(0)), lLen, 0&, dwActualUsed) = 0 Then
            RaiseEvent Error(Err.LastDllError, CSB, Routine)
            GoTo ReleaseHandles
        Else
            m_bData = bTmp
        End If
    ReleaseHandles:
    End Sub
    
    Public Sub Base64Encode()
        Const Routine As String = "Base64.Base64Encode"
        Dim lLen As Long
        'Determine Base64 output String length required.
        If CryptBinaryToString(m_bData(0), UBound(m_bData) + 1, CRYPT_STRING_BASE64, StrPtr(vbNullString), lLen) = 0 Then
            RaiseEvent Error(Err.LastDllError, CBS, Routine)
            GoTo ReleaseHandles
        End If
        'Convert binary to Base64.
        sBase64Buf = String$(lLen - 1, Chr$(0))
        If CryptBinaryToString(m_bData(0), UBound(m_bData) + 1, CRYPT_STRING_BASE64, StrPtr(sBase64Buf), lLen) = 0 Then
            RaiseEvent Error(Err.LastDllError, CBS, Routine)
            GoTo ReleaseHandles
        End If
    ReleaseHandles:
    End Sub
    
    Public Property Get sBuffer() As String
        sBuffer = ByteToStr(m_bData)
    End Property
    
    Public Property Let sBuffer(sNewValue As String)
        Dim bTmp() As Byte
        bTmp = StrToByte(sNewValue)
        m_bData = bTmp
    End Property
    
    Public Property Get uBuffer() As String
        uBuffer = ByteToUni(m_bData)
    End Property
    
    Public Property Let uBuffer(sNewValue As String)
        Dim bTmp() As Byte
        bTmp = sNewValue
        uBuffer = bTmp
    End Property
    Attached Files Attached Files

  2. #2
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 - Base64 Encoding

    Handy API. I also use it to display binary data as a hex dump: CRYPT_STRING_HEX

    Not sure why the module is needed, nor the complicated way of getting string data to bytes & vice-versa

    bytes() = StrConv(sourceString, vbFromUnicode) creates a byte array 1-byte characters
    bytes() = sourceString creates a byte array 2-byte characters
    vbString = bytes() when bytes contains 2-byte characters
    vbString = StrConv(bytes(), vbUnicode) when bytes contains 1-byte characters
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  3. #3

    Thread Starter
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,470

    Re: VB6 - Base64 Encoding

    These functions were located in a cryptography class. I had need of the Base64 functions without the rest of the class, so I created a separate class. StrConv causes problems on systems set for non-latin character sets, so I don't use them anymore.

    J.A. Coutts

  4. #4
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 - Base64 Encoding

    Quote Originally Posted by couttsj View Post
    StrConv causes problems on systems set for non-latin character sets, so I don't use them anymore.
    Not sure that's completely true. Improper usage is likely the reason. For example, you cannot convert say Chinese characters to ANSI, or vice versa, with StrConv and expect success.

    Just a note: I think if people will consider using your class, they'd prefer to have the class self-contained, not needing to also include a bas module for a function or two when any needed function could be included in the class itself.
    Last edited by LaVolpe; Jul 12th, 2017 at 07:26 AM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  5. #5
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: VB6 - Base64 Encoding

    Quote Originally Posted by couttsj View Post
    These functions were located in a cryptography class. I had need of the Base64 functions without the rest of the class, so I created a separate class. StrConv causes problems on systems set for non-latin character sets, so I don't use them anymore.

    J.A. Coutts
    Not so much a problem except that it uses the system default code page / LCID if you don't specify.
    If you want it hard coded to a specific LocaleID you have to pass in the 3rd parameter to StrConv.

    Locale IDs
    https://msdn.microsoft.com/en-us/lib...edded.10).aspx

  6. #6
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    19,541

    Re: VB6 - Base64 Encoding

    Quote Originally Posted by DEXWERX View Post
    Not so much a problem except that it uses the system default code page / LCID if you don't specify.
    If you want it hard coded to a specific LocaleID you have to pass in the 3rd parameter to StrConv.
    Wouldn't think, in this case, that would be an issue since conversion is being done to/from byte arrays and Base64 (ANSI). In other scenarios, misuse is likely the reason, not the function itself.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  7. #7
    New Member
    Join Date
    Mar 2013
    Posts
    5

    Re: VB6 - Base64 Encoding

    Okay to summaries it.
    Carefully study ByteToStr and StrToByte...
    ... and delete them!
    They are great for headaches, or good for the 'english only version' but yeah :
    That's how it's not gonna work.

    For char between 0..127 the results may be fine but for rests there'll be all the time the one or other 'off's', char artefacts, trouble chars or other oddities. That depend from language the program is ran.

    Use StrConv!
    That'll be the only reliable way.
    Code:
    Public Property Get sBuffer() As String
    '   sBuffer = StrConv(m_bData, vbUnicode)
        sBuffer = AToU(m_bData)
    End Property
    
    Public Property Let sBuffer(sNewValue As String)
        m_bData = UToA(sNewValue)
    End Property
    
    
    Public Function UToA(unicode)
       UToA = StrConv(unicode, vbFromUnicode, LCID)
    End Function
    
    Public Function AToU(unicode)
       AToU = StrConv(unicode, vbUnicode, LCID)
    End Function
    Well you can just delete the optional LCID parameter but I recommended to keep it and add this into some module:
    Code:
    Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
    Public Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
    Sub LCID_init()
    
       Dim sys_LCID
       sys_LCID = GetSystemDefaultLCID()
       
       Dim usr_LCID
       usr_LCID = GetUserDefaultLCID()
       
       If sys_LCID <> usr_LCID Then
          Stop
        ' Well that case is a little special so maybe
        ' ask user how to proceed
        ' well mostly it seems the best to use SystemDefaultLCID
          LCID = sys_LCID
       Else
          LCID = usr_LCID
       End If
       
       
    End Sub
    Public Property Get LCID() As Variant
     ' ensure that mLocaleID  is initialised
       Debug.Assert mLocaleID <> 0
       
       LCID = mLocaleID
    End Property
    
    Public Property Let LCID(ByVal vNewValue As Variant)
       
       Debug.Assert vNewValue <> 0 'invalid number
       
       mLocaleID = vNewValue
    End Property
    
    
    LCID_init()
    Maybe also move that AToU and UToA into this module for better code organisation ( and for the sake of 'Locality' ).
    Last edited by cw2k; Feb 16th, 2018 at 05:44 PM. Reason: So now the call LCID_init() is there also

  8. #8

    Thread Starter
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,470

    Re: VB6 - Base64 Encoding

    There are major problems using StrConv on systems that are set to use non-latin character sets. You will find lots of evidence on this site to verify that. I personally ran into problems with a handful of characters above 127, that the operating system changes in the background without your knowledge. Once it was pointed out to me that StrConv and non-latin character sets don't get along, I no longer use it.

    J.A. Coutts

  9. #9
    Frenzied Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    1,289

    Re: VB6 - Base64 Encoding

    I am sure that string to byte convertion not needed here. We can make a string as big as to hold data and copy data there. Also we can use string ptr to place data. We have to remove all ByRef and place ByVal, so we pass only pointers as return from StrPtr(). We can pass array to, just passing the right pointer (also by value).
    Private Declare Function CryptStringToBinary Lib "Crypt32.dll" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByVal pcbBinary As Long, ByVal pdwSkip As Long, ByVal pdwFlags As Long) As Long

  10. #10

    Thread Starter
    Frenzied Member
    Join Date
    Dec 2012
    Posts
    1,470

    Re: VB6 - Base64 Encoding

    Converting Unicode characters to byte array is dead simple.
    Code:
    Public Function UniToByte(strInput As String) As Byte()
        UniToByte = strInput
    End Function
    
    Public Function ByteToUni(bArray() As Byte) As String
        ByteToUni = bArray
    End Function
    VB does all the work for you.

    J.A. Coutts

  11. #11
    Member
    Join Date
    Apr 2009
    Posts
    48

    Re: VB6 - Base64 Encoding

    I rewrote this into easier-to-reuse code that can be copy/pasted into a module
    Code:
    Private Declare Function CryptBinaryToString Lib "Crypt32.dll" Alias "CryptBinaryToStringW" (ByRef pbBinary As Byte, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, ByRef pcchString As Long) As Long
    Private Declare Function CryptStringToBinary Lib "Crypt32.dll" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByRef pcbBinary As Long, ByRef pdwSkip As Long, ByRef pdwFlags As Long) As Long
    
    Public Function Base64Decode(sBase64Buf As String) As String
        Const CRYPT_STRING_BASE64 As Long = 1
        Dim bTmp() As Byte, lLen As Long, dwActualUsed As Long
        If CryptStringToBinary(StrPtr(sBase64Buf), Len(sBase64Buf), CRYPT_STRING_BASE64, StrPtr(vbNullString), lLen, 0&, dwActualUsed) = 0 Then Exit Function       'Get output buffer length
        ReDim bTmp(lLen - 1)
        If CryptStringToBinary(StrPtr(sBase64Buf), Len(sBase64Buf), CRYPT_STRING_BASE64, VarPtr(bTmp(0)), lLen, 0&, dwActualUsed) = 0 Then Exit Function 'Convert Base64 to binary.
        Base64Decode = StrConv(bTmp, vbUnicode)
    End Function
    
    Public Function Base64Encode(Text As String) As String
        Const CRYPT_STRING_BASE64 As Long = 1
        Dim lLen As Long, m_bData() As Byte, sBase64Buf As String
        m_bData = StrConv(Text, vbFromUnicode)
        If CryptBinaryToString(m_bData(0), UBound(m_bData) + 1, CRYPT_STRING_BASE64, StrPtr(vbNullString), lLen) = 0 Then Exit Function  'Determine Base64 output String length required.
        sBase64Buf = String$(lLen - 1, Chr$(0)) 'Convert binary to Base64.
        If CryptBinaryToString(m_bData(0), UBound(m_bData) + 1, CRYPT_STRING_BASE64, StrPtr(sBase64Buf), lLen) = 0 Then Exit Function
        Base64Encode = sBase64Buf
    End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width