Base64.WSC -A Windows Script Component to Encode/Decode Binary Data

Here's a Windows Script Component to Encode/Decode Binary Data. It should be useful for those who have to deal with LDAP queries in Active Directory. It is ASP compatible as well as usable in any script to be ran locally. Use the comments to send me your email address, if you do not know how to use WSCs and want to use it.


Here's an example of how easy this is to use:

Option Explicit
Dim base
Set base = CreateObject ("base64.WSC")
Dim cleartxt                    'testing code
cleartxt = "Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure."
MsgBox base.encode(cleartxt)
MsgBox base.decode(base.encode(cleartxt))
MsgBox base.decode("TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0" & vbcrlf & _
"aGlzIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1" & vbcrlf & _
"c3Qgb2YgdGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0" & vbcrlf & _
"aGUgY29udGludWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdl" & vbcrlf & _
"LCBleGNlZWRzIHRoZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=")    'end testing code                'end testing code
'Save the above as example.vbs & the code below as "base64.WSC".
'Right-click the file "base64.WSC", and choose "Register".
'You may now use the component, from the above or your own programs.
'You may want to add the line 'remotable="true"' to the registration section if you need to run a script remotely.

<?xml version="1.0"?>
<component>

<?component error="true" debug="true"?>

<registration
description="base64"
progid="base64.WSC"
version="1.00"
classid="{0555ecd7-0d91-40a5-8265-ae3784082f25}"
>
</registration>

<public>
<method name="Encode">
<PARAMETER name="strUnencoded"/>
</method>
<method name="Decode">
<PARAMETER name="strEncoded"/>
</method>
</public>

<implements type="ASP" id="ASP"/>

<script language="VBScript">
<![CDATA[
Dim arrVals, cnt, vals
Dim dictTable, entry
On Error Resume Next
Const pad = "="
vals = "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,0,1,2,3,4,5,6,7,8,9,+,/"
arrVals = Split(vals,",")
vals = ""
Set dictTable = CreateObject("Scripting.Dictionary")
For Each entry In arrVals
dictTable.add entry, cnt
cnt = cnt + 1
Next                                                                                        'end initialization code

Function Encode(strUnencoded)
Dim stepper, strGrp, bitfield, intchrsLeft
'Split into 3 character pieces
For stepper = 1 To Len (strUnencoded) Step 3
If Len (strUnencoded) >= stepper + 2 Then                                            'check for "remainders"
  strgrp = Mid (strUnencoded, stepper, 3)                                            'groups of 3 chars into 24 bit field
  bitfield = Asc (Mid (strGrp, 1, 1))                                                'convert to number
  bitfield = 256 * bitfield + Asc (Mid (strGrp, 2, 1))                            '& "shift left"
  bitfield = 256 * bitfield + Asc (Mid (strGrp, 3, 1))                            'until full.
  'extract 6 bits & convert to predefined characters
  encode = encode & _
      arrvals(CInt ((16515072 And bitfield) / 262144) And 63) & _
      arrvals(CInt ((258048 And bitfield) / 4096) And 63) & _
      arrvals(CLng ((4032 And bitfield) / 64) And 63) & _
      arrvals(CLng (bitfield And 63))
Else                                                                                'if we have remainders
  strgrp = Mid (strUnencoded, stepper, 3)
  intchrsLeft = Len (strUnencoded) + 1 - stepper                                    'figure out how many
'             MsgBox intchrsLeft & " Left - " & strGrp
  bitfield = Asc (Mid (strGrp,1,1))
  If intchrsLeft = 2 Then                                                            'there's only 2 cases of remainder
      bitfield = 256 * bitfield + Asc (Mid (strGrp, 2, 1))
      bitfield = 256 * bitfield
  Else
      bitfield = 65536 * bitfield
  End If
  'pad the results
  encode = encode & _
      arrvals(CInt ((16515072 And bitfield) / 262144) And 63) & _
      arrvals(CInt ((258048 And bitfield) / 4096) And 63) & _
      arrvals(CLng ((4032 And bitfield) / 64) And 63) & pad
End If
Next
encode = LineLimit (encode)
End Function

Private Function LineLimit (Txt)                                                            'RFCs say limit to 72 characters per line
Dim stepper, strTemp
For stepper = 1 To Len (Txt) Step 72                                                    'Split it to the limit
strtemp = strTemp & Mid (Txt,stepper,72) & vbCrLf                                    'add carriage-return/linefeed
Next
LineLimit = strTemp
End Function

Function Decode(strEncoded)
Dim stepper, strGrp, bitfield, intchrsLeft
'first strip the CrLfs
strEncoded = Replace (strEncoded,vbCrLf,"")
'split into groups of 4 chars
For stepper = 1 To Len (strEncoded) Step 4
strgrp = Mid (strEncoded, stepper, 4)                                                'groups of 4 chars into 24 bit field
bitfield = dictTable.Item (Mid (strGrp, 1, 1))                                        'convert to number
bitfield = 64 * bitfield + dictTable.Item (Mid (strGrp, 2, 1))                        '& "shift left"
bitfield = 64 * bitfield + dictTable.Item (Mid (strGrp, 3, 1))
bitfield = 64 * bitfield + dictTable.Item (Mid (strGrp, 4, 1))                        'until full.
'extract 6 bits & convert to predefined characters
decode = decode & _
  Chr (CInt ((16711680 And bitfield) / 65536) And 255) & _
  Chr (CInt ((65280 And bitfield) / 256) And 255) & _
  Chr (CInt (bitfield And 255))
Next
End Function

Private Sub Class_Terminate()
On Error Resume Next
Set dictTable = Nothing
End Sub

]]>
</script>

</component>