Base64 Encode String in VBScript

Question

I have a web service load driver that's a Windows Script File (WSF), that includes some VBScript and JavaScript files. My web service requires that the incoming message is base64 encoded. I currently have a VBScript function that does this, but it's very inefficient (memory intensive, mostly due to VBScripts awful string concatenation)

[Aside; Yes, I've seen Jeff's latest blog post. The concatenation is happening in a loop across messages that are 1,000's to 10,000's bytes in size.]

I've tried using some custom string concatenation routines; one using an array and one using ADODB.Stream. These help, a little, but I think it would help more if I had some other way of encoding the message rather than via my own VBS function.

Is there some other way of encoding my message, preferebly using native Windows methods?

Answer 1

This question has some interesting stuff. You can, apparently, use MSXML to base64-encode things.

how-do-i-base64-encode-a-string-efficiently-using-excel-vba

Answer 2

The code proposed on VB Tec is extremely efficient. It uses VB6 but should be easily translated to VBS (if translation is at all necessary)

Answer 3

I was originally using some VBScript code from Antonin Foller: Base64 Encode VBS Function and Base64 Decode VBS Function.

Searching Antonin's site, I saw he had some code for quoted printable encoding, using the CDO.Message object, so I tried that.

Finally, I ported the code mentioned in Mark's answer to VBScript (also used some code from this SO question), and used the Stream___StringToBinary and Stream_BinaryToString functions from Antonin's site to get functions that used MSXML encoding.

I ran a quick test to measure the encoding time for a 1,500 character message (the average message size I need to send to my web service) across all four methods:

• Native VBScript (VBScript)
• Quoted Printable, using CDO.Message (QP)
• Quoted Printable Binary, using CDO.Message (QP Binary)
• MSXML/ADODB.Stream (MSXML)

Here are the results:

Iterations   : 10,000
Message Size :  1,500

+-------------+-----------+
+ Method      | Time (ms) + 
+-------------+-----------+
| VBScript    |   301,391 |
+-------------+-----------+
| QP          |    12,922 |
+-------------+-----------+
| QP (Binary) |    13,953 |
+-------------+-----------+
| MSXML       |     3,312 |
+-------------+-----------+

I also monitored the memory utilization (Mem Usage for the cscript.exe process in the Windows Task Manager) while the test was running. I don't have any raw numbers, but the memory utilization for both the quoted printable and MSXML solutions were below the VBScript solution (7,000K for the former, around 16,000K for VBScript).

I decided to go with the MSXML solution for my driver. For those interested, here's the code I'm using:

base64.vbs
Function Base64Encode(sText)
    Dim oXML, oNode

    Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
    Set oNode = oXML.CreateElement("base64")
    oNode.dataType = "bin.base64"
    oNode.nodeTypedValue =Stream_StringToBinary(sText)
    Base64Encode = oNode.text
    Set oNode = Nothing
    Set oXML = Nothing
End Function

Function Base64Decode(ByVal vCode)
    Dim oXML, oNode

    Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
    Set oNode = oXML.CreateElement("base64")
    oNode.dataType = "bin.base64"
    oNode.text = vCode
    Base64Decode = Stream_BinaryToString(oNode.nodeTypedValue)
    Set oNode = Nothing
    Set oXML = Nothing
End Function

'Stream_StringToBinary Function
'2003 Antonin Foller, http://www.motobit.com
'Text - string parameter To convert To binary data
Function Stream_StringToBinary(Text)
  Const adTypeText = 2
  Const adTypeBinary = 1

  'Create Stream object
  Dim BinaryStream 'As New Stream
  Set BinaryStream = CreateObject("ADODB.Stream")

  'Specify stream type - we want To save text/string data.
  BinaryStream.Type = adTypeText

  'Specify charset For the source text (unicode) data.
  BinaryStream.CharSet = "us-ascii"

  'Open the stream And write text/string data To the object
  BinaryStream.Open
  BinaryStream.WriteText Text

  'Change stream type To binary
  BinaryStream.Position = 0
  BinaryStream.Type = adTypeBinary

  'Ignore first two bytes - sign of
  BinaryStream.Position = 0

  'Open the stream And get binary data from the object
  Stream_StringToBinary = BinaryStream.Read

  Set BinaryStream = Nothing
End Function

'Stream_BinaryToString Function
'2003 Antonin Foller, http://www.motobit.com
'Binary - VT_UI1 | VT_ARRAY data To convert To a string 
Function Stream_BinaryToString(Binary)
  Const adTypeText = 2
  Const adTypeBinary = 1

  'Create Stream object
  Dim BinaryStream 'As New Stream
  Set BinaryStream = CreateObject("ADODB.Stream")

  'Specify stream type - we want To save text/string data.
  BinaryStream.Type = adTypeBinary

  'Open the stream And write text/string data To the object
  BinaryStream.Open
  BinaryStream.Write Binary

  'Change stream type To binary
  BinaryStream.Position = 0
  BinaryStream.Type = adTypeText

  'Specify charset For the source text (unicode) data.
  BinaryStream.CharSet = "us-ascii"

  'Open the stream And get binary data from the object
  Stream_BinaryToString = BinaryStream.ReadText
  Set BinaryStream = Nothing
End Function

Answer 4

I was reading your code and came up with a simple and effective way for me personaly localy to decode a string , i was woundering would it be possible to tell me what i am doing wrong ?

Dim oXML, oNode  
vcode="aGk=" 
Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
Set oNode = oXML.CreateElement("base64") 
oNode.dataType = "bin.base64" 
oNode.text = vCode
Base64Decode = oNode.nodeTypedValue 
Set oNode = nothing  
Set oXML = Nothing
MsgBox(base64decode)

With this code , i can only seem to get chinese character returns , which is quite odd. Could someone fix this atall?

Answer 5

So I have some other full example of encoder and decoder:

Encoder:

' This script reads jpg picture named SuperPicture.jpg, converts it to base64
' code using encoding abilities of MSXml2.DOMDocument object and saves
' the resulting data to encoded.txt file

Option Explicit

Const fsDoOverwrite     = true  ' Overwrite file with base64 code
Const fsAsASCII         = false ' Create base64 code file as ASCII file
Const adTypeBinary      = 1     ' Binary file is encoded

' Variables for writing base64 code to file
Dim objFSO
Dim objFileOut

' Variables for encoding
Dim objXML
Dim objDocElem

' Variable for reading binary picture
Dim objStream

' Open data stream from picture
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary
objStream.Open()
objStream.LoadFromFile("SuperPicture.jpg")

' Create XML Document object and root node
' that will contain the data
Set objXML = CreateObject("MSXml2.DOMDocument")
Set objDocElem = objXML.createElement("Base64Data")
objDocElem.dataType = "bin.base64"

' Set binary value
objDocElem.nodeTypedValue = objStream.Read()

' Open data stream to base64 code file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFileOut = objFSO.CreateTextFile("encoded.txt", fsDoOverwrite, fsAsASCII)

' Get base64 value and write to file
objFileOut.Write objDocElem.text
objFileOut.Close()

' Clean all
Set objFSO = Nothing
Set objFileOut = Nothing
Set objXML = Nothing
Set objDocElem = Nothing
Set objStream = Nothing

Decoder:

' This script reads base64 encoded picture from file named encoded.txt,
' converts it in to back to binary reprisentation using encoding abilities
' of MSXml2.DOMDocument object and saves data to SuperPicture.jpg file

Option Explicit

Const foForReading          = 1 ' Open base 64 code file for reading
Const foAsASCII             = 0 ' Open base 64 code file as ASCII file
Const adSaveCreateOverWrite = 2 ' Mode for ADODB.Stream
Const adTypeBinary          = 1 ' Binary file is encoded

' Variables for reading base64 code from file
Dim objFSO
Dim objFileIn
Dim objStreamIn

' Variables for decoding
Dim objXML
Dim objDocElem

' Variable for write binary picture
Dim objStream

' Open data stream from base64 code filr
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFileIn   = objFSO.GetFile("encoded.txt")
Set objStreamIn = objFileIn.OpenAsTextStream(foForReading, foAsASCII)

' Create XML Document object and root node
' that will contain the data
Set objXML = CreateObject("MSXml2.DOMDocument")
Set objDocElem = objXML.createElement("Base64Data")
objDocElem.DataType = "bin.base64"

' Set text value
objDocElem.text = objStreamIn.ReadAll()

' Open data stream to picture file
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary
objStream.Open()

' Get binary value and write to file
objStream.Write objDocElem.NodeTypedValue
objStream.SaveToFile "SuperPicture.jpg", adSaveCreateOverWrite

' Clean all
Set objFSO = Nothing
Set objFileIn = Nothing
Set objStreamIn = Nothing
Set objXML = Nothing
Set objDocElem = Nothing
Set objStream = Nothing