base64_stringencode.vbs

Introduction

The example Microsoft VBS program below shows how to encode and decode a string using the Base64 algorithm. Base64 encoding is used to convert binary data into a text-like format to be transported in environments that handle only text safely. For example, encoding UID's for use in HTTP URL's or to encode encryption keys to make them safely portable through e-mail, display them in HTML pages and use them with copy and paste.

Microsoft VBS has no build-in functions to encode and decode base64, therefore we need to program the details.

' ====================================================================== '
' file:        base64_stringencode.vbs v1.0                              '
' purpose:     tests encoding/decoding strings with base64               '
' author:      07/22/2012 Frank4DD                                       '
'                                                                        '
' This program encodes and decodes a sample string with base64 format.   '
'                                                                        '
' Function credits to Richard L. Mueller - http://www.rlmueller.net      '
' This program comes with ABSOLUTELY NO WARRANTY. You may redistribute   '
' copies of it under the terms of the GNU General Public License.        '
' ====================================================================== '

' ---- Base64 Encoding/Decoding Table ----
Const b64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

Function encode(strText)
  Dim lngValue, lngTemp, lngChar, intLen, k, j, strWord, str64, intTerm
  Dim strChar, strHex

  strHex = ""
  For k=1 To Len(strText)
    strChar = Mid(strText, k, 1)
    strHex = strHex & Right("00" & Hex(Asc(strChar)), 2)
  Next

  intLen = Len(strhex)

  ' Pad with zeros to multiple of 3 bytes.
  intTerm = intLen Mod 6
  If (intTerm = 4) Then
    strHex = strHex & "00"
    intLen = intLen + 2
  End If

  If (intTerm = 2) Then
    strHex = strHex & "0000"
    intLen = intLen + 4
  End If

  ' Parse into groups of 3 hex bytes.
  j = 0
  strWord = ""
  encode = ""
  For k = 1 To intLen Step 2
    j = j + 1
    strWord = strWord & Mid(strHex, k, 2)
    If (j = 3) Then
      ' Convert 3 8-bit bytes into 4 6-bit characters.
      lngValue = CCur("&H" & strWord)

      lngTemp = Fix(lngValue / 64)
      lngChar = lngValue - (64 * lngTemp)
      str64 = Mid(b64, lngChar + 1, 1)
      lngValue = lngTemp

      lngTemp = Fix(lngValue / 64)
      lngChar = lngValue - (64 * lngTemp)
      str64 = Mid(b64, lngChar + 1, 1) & str64
      lngValue = lngTemp

      lngTemp = Fix(lngValue / 64)
      lngChar = lngValue - (64 * lngTemp)
      str64 = Mid(b64, lngChar + 1, 1) & str64

      str64 = Mid(b64, lngTemp + 1, 1) & str64

      encode = encode & str64
      j = 0
      strWord = ""
    End If
  Next

  ' Account for padding.
  If (intTerm = 4) Then
    encode = Left(encode, Len(encode) - 1) & "="
  End If

  If (intTerm = 2) Then
    encode = Left(encode, Len(encode) - 2) & "=="
  End If
End function

Function decode(b64String)
  Dim intLen, sOut, groupBegin

  'remove white spaces, If any
  b64String = Replace(b64String, vbCrLf, "")
  b64String = Replace(b64String, vbTab, "")
  b64String = Replace(b64String, " ", "")

  'The source must have a len multiples of 4
  intLen = Len(b64String)
  If intLen Mod 4 <> 0 Then
    Err.Raise 1, "decode", "Bad Base64 string."
    Exit Function
  End If

  ' Now decode each group:
  For groupBegin = 1 To intLen Step 4
    Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
    ' Each data group encodes up To 3 actual bytes.
    numDataBytes = 3
    nGroup = 0

    For CharCounter = 0 To 3
      ' Convert each character into 6 bits of data, add it an integer
      ' If a char = '=', there is one fewer data byte. (max is 2 '=')

      thisChar = Mid(b64String, groupBegin + CharCounter, 1)

      If thisChar = "=" Then
        numDataBytes = numDataBytes - 1
        thisData = 0
      Else
        thisData = InStr(1, b64, thisChar, vbBinaryCompare) - 1
      End If

      If thisData = -1 Then
       Err.Raise 2, "decode", "Bad character In Base64 string."
       Exit Function
      End If

      nGroup = 64 * nGroup + thisData
    Next

    'Hex splits the long To 6 groups with 4 bits
    nGroup = Hex(nGroup)

    'Add leading zeros
    nGroup = String(6 - Len(nGroup), "0") & nGroup

    'Convert the 3 byte hex integer (6 chars) To 3 characters
    pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 5, 2)))

    'add numDataBytes characters To out string
    sOut = sOut & Left(pOut, numDataBytes)
  Next

  decode = sOut
End Function

' ====================================================================== '
' End Function Defs, Start Main                                          '
' ====================================================================== '
Const mysrc = "My bonnie is over the          "
dim myb64
dim mydst

myb64 = encode(mysrc)
Wscript.Echo "The string" & vbNewline & "[" & mysrc & "]" & vbNewline &_
"encodes into base64 as:" & vbNewline & "[" & myb64 & "]"

mydst = decode(myb64)
Wscript.Echo "The string " & vbNewline & "[" & myb64 & "]" & vbNewline &_
"decodes from base64 as:" & vbNewline & "[" & mydst & "]"

Wscript.Quit(intOK)
' ====================================================================== '
' End Main                                                               '
' ====================================================================== '

A run of this test program returns the following output:

base64_stringencode.vbs - tests encoding/decoding strings with base64 in VBS

Introduction

Sample Code:

See Also: