Monday, August 13, 2012 effengud software RSS Feed

A Faster VBScript Base64 Encode

A Faster VBScript Base64 Encode

The RC4 encryption article has always been a popular one on our website. In fact, several commercial software packages have utilized the routines in that article over the past few years. However, often when individual developers try to implement those routines, there is a question that crops up, and that question is invariably related to the same thing…

When passing this encrypted data over the wire, it is BINARY data, which means that you can’t really pass it as part of a querystring. So many developers try saucing it up with a Server.URLEncode function, but what they don’t always realize is that Microsoft’s URLEncode function does NOT play well with embedded ASCII NULs. In fact, it assumes that the ASCII 0 (zero) signifies the end-of-string marker, and will stop as soon as the first NUL is encountered.

So how do we pass binary information?

The solution I have recommended (and used myself) is to further ENCODE the data with Base64 encoding. And the solution I have often recommended is the one found at Motobits.com (found here: . It is a proven solution and I have personally used it in many of my own projects. Recently, however, one of our own applications seemed to be getting bottle-necked at the Base64 encode and decode functions. The application in question had to encode blocks of data that were 64K-bytes in size, and it sometimes had to do several thousand of those blocks.

So I started looking at the old MotoBits code, with an eye toward optimizing it. And what I ended up with is new version that is much faster (over 40 times faster in most cases!). Interested? Well, if you’re currently doing Base64 encoding with VBScript, you should be.

As an example (rough and unscientific, but useful for comparison), to encode 10 blocks of 64K Bytes each, the original Motobits version takes 13.94 seconds on a dual-core system. On that same system, the new version takes about 0.31 seconds. So, whereas the former version managed around 47,000 bytes per second, the new one does over 2,097,000 in that same time period.

Here is the new, optimized code:

Function FasterBase64Encode(inData)
  'rfc1521
  ' Notice: This routine is based on:
  '2001 Antonin Foller, Motobit Software, http://Motobit.cz

  'Speed enhancements by Mike Shaffer

  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim arybase64(64)
  For intX = 1 To 64
     aryBase64(intX) = Mid(Base64,intX,1)
  Next

  Dim cOut, sOut, I, L2
  Dim nGroup, pOut, sGroup
  Dim ary1(), aryCTR

  aryCTR = -1

  L2 = Len(inData)
  ReDim ary1(Int(L2*1.5))

  'For each group of 3 bytes
  For I = 1 To L2 Step 3    

    nGroup = Oct(&H10000 * Asc(Mid(inData, I, 1)) + &H100 * _
                 MyASC(Mid(inData, I + 1, 1)) + _
                 MyASC(Mid(inData, I + 2, 1)))

    'Add leading zeros
    nGroup = Right("00000000" & nGroup, 8)

    'Convert To base64
    aryCTR = aryCTR + 1
    ary1(aryCTR) = arybase64(CLng("&o" & Mid(nGroup, 1, 2)) + 1)
    aryCTR = aryCTR + 1
    ary1(aryCTR) = arybase64(CLng("&o" & Mid(nGroup, 3, 2)) + 1)
    aryCTR = aryCTR + 1
    ary1(aryCTR) = arybase64(CLng("&o" & Mid(nGroup, 5, 2)) + 1)
    aryCTR = aryCTR + 1
    ary1(aryCTR) = arybase64(CLng("&o" & Mid(nGroup, 7, 2)) + 1)

  Next
  ReDim preserve ary1(aryCTR)
  sOut = Join(ary1,"")

  ' Perform fixup
  Select Case L2 Mod 3
    Case 1: '8 bit final
      sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2: '16 bit final
      sOut = Left(sOut, Len(sOut) - 1) + "="
  End Select

  FasterBase64Encode = sOut

End Function

Function MyASC(OneChar)
  If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function

Tags: , , , , ,