JFord
Tue Jan 25 14:47:07 CST 2005
Here is a vbscript examply that I pulled off of the web a while back which
seems to work and can easily be put into ASP. The comments also include the
website were I got it from.
<code sample>
wscript.echo Base64Encode("Jeremy")
wscript.Echo Base64Decode("SmVyZW15")
' Decodes a base-64 encoded string (BSTR type).
' 1999 - 2004 Antonin Foller,
http://www.motobit.com
' 1.01 - solves problem with Access And 'Compare Database' (InStr)
Function Base64Decode(ByVal base64String)
'rfc1521
'1999 Antonin Foller, Motobit Software,
http://Motobit.cz
Const Base64 =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, sOut, groupBegin
'remove white spaces, If any
base64String = Replace(base64String, vbCrLf, "")
base64String = Replace(base64String, vbTab, "")
base64String = Replace(base64String, " ", "")
'The source must consists from groups with Len of 4 chars
dataLength = Len(base64String)
If dataLength Mod 4 <> 0 Then
Err.Raise 1, "Base64Decode", "Bad Base64 string."
Exit Function
End If
' Now decode each group:
For groupBegin = 1 To dataLength 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, And add it To
' an integer For temporary storage. If a character is a '=', there
' is one fewer data byte. (There can only be a maximum of 2 '=' In
' the whole string.)
thisChar = Mid(base64String, groupBegin + CharCounter, 1)
If thisChar = "=" Then
numDataBytes = numDataBytes - 1
thisData = 0
Else
thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
End If
If thisData = -1 Then
Err.Raise 2, "Base64Decode", "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
Base64Decode = sOut
End Function
Function Base64Encode(inData)
'rfc1521
'2001 Antonin Foller, Motobit Software,
http://Motobit.cz
Const Base64 =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, I
'For each group of 3 bytes
For I = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
&H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)
'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup
'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
'Add the part To OutPut string
sOut = sOut + pOut
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next
Select Case Len(inData) 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
Base64Encode = sOut
End Function
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
</code sample>
"happyrpg" wrote:
> Hello
>
> I'm trying to Base64 encode a buffer that I have in memory. So this means
> that I don't want to use the MS Stream object to read a file from disk.
>
> Originally I tried to do this same task in JavaScript but failed... I
> assumed it was because the oB64Node.nodeTypedValue takes a VT_Array.
>
> The following throws a type mismatch.. the CreateVBArray routine returns a
> VB Array of bytes.
> oB64Node.nodeTypedValue = CreateVBArray( buffer )
>
> Any help would be greatly appreciated. If possible I would luv to be able
> to accomplish this same task in javascript.
>
> <SCRIPT LANGUAGE="VBScript">
>
> doEncode( "Hi how are you" )
>
> Function CreateVBArray( buffer )
> Dim i, j, imax, chr
> Dim a
>
> imax = len(buffer)
> redim a (imax)
> i = 0
> For j = 0 To imax
> chr = mid(buffer, j+1, 1)
> if( chr <> "" ) then
> a(i) = CByte(Asc(chr))
> i=i+1
> end if
> Next
>
> 'Shrink it...
> ReDim Preserve a(i-1)
> CreateVBArray = a
> End Function
>
> Function doEncode( buffer )
> Dim oXML
> Dim oB64Node
>
> Set oXML = CreateObject( "Msxml2.DOMDocument.4.0" )
> oXML.loadXML( "<?xml version='1.0' ?> <root/>")
> call oXML.documentElement.setAttribute("xmlns:dt",
> "urn:schemas-microsoft-com:datatypes")
> Set oB64Node = oXML.createElement("F")
> oB64Node.dataType = "bin.base64"
>
> ' This throws a type mismatch
> oB64Node.nodeTypedValue = CreateVBArray( buffer )
>
> Set doEncode = oB64Node
> End Function
> </SCRIPT>
>
>