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>
* sBytes is a string to convert.
If you use Textstream.Read to get the string
and pass it directly then you can also
convert binary data from a file.
(ReadAll won't work because it gets fooled by the
first Chr(0) it encounters and thinks it's reached
the end of the string.)
* AddReturns is a Boolean value, whether to insert
a vbCrLf every 76 characters in the Base64 return
string, for use in email.
Function ConvertToBase64(sBytes, AddReturns)
Dim B2(), B76(), ABytes()
Dim i1, i2, i3, LenA, NumReturns, sRet
On Error Resume Next
If Not IsArray(ANums) Then
ANums = Array(65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78,
79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 97, 98, 99, 100, 101, 102,
103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117,
118, 119, 120, 121, 122, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 43, 47)
End If
LenA = Len(sBytes)
ReDim ABytes(LenA - 1)
For i1 = 1 to LenA
ABytes(i1 - 1) = Asc(Mid(sBytes, i1, 1))
Next
ReDim Preserve ABytes(((LenA - 1) \ 3) * 3 + 2)
ReDim Preserve B2((UBound(ABytes) \ 3) * 4 + 3)
i2 = 0
For i1 = 0 To (UBound(ABytes) - 1) Step 3
B2(i2) = ANums(ABytes(i1) \ 4)
i2 = i2 + 1
B2(i2) = ANums((ABytes(i1 + 1) \ 16) Or (ABytes(i1) And 3) * 16)
i2 = i2 + 1
B2(i2) = ANums((ABytes(i1 + 2) \ 64) Or (ABytes(i1 + 1) And 15)
* 4)
i2 = i2 + 1
B2(i2) = ANums(ABytes(i1 + 2) And 63)
i2 = i2 + 1
Next
For i1 = 1 To i1 - LenA
B2(UBound(B2) - i1 + 1) = 61
Next
If (AddReturns = True) And (LenA > 76) Then
NumReturns = ((UBound(B2) + 1) \ 76)
LenA = (UBound(B2) + (NumReturns * 2))
ReDim B76(LenA)
i2 = 0
i3 = 0
For i1 = 0 To UBound(B2)
B76(i2) = B2(i1)
i2 = i2 + 1
i3 = i3 + 1
If (i3 = 76) And (i2 < (LenA - 2)) Then
B76(i2) = 13
B76(i2 + 1) = 10
i2 = i2 + 2
i3 = 0
End If
Next
For i1 = 0 to UBound(B76)
B76(i1) = Chr(B76(i1))
Next
sRet = Join(B76, "")
Else
For i1 = 0 to UBound(B2)
B2(i1) = Chr(B2(i1))
Next
sRet = Join(B2, "")
End If
ConvertToBase64 = sRet
End Function
_____________________________
mayayX...@mindYYspring.com
For return email remove XX and YY.
_____________________________
happyrpg <happ...@discussions.microsoft.com> wrote in message
news:7E8A76C6-3C81-4FB5...@microsoft.com...
<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>
to get the above I used Paul Randall's
StringTo8209() in place of your CreateVBArray
-- search the archives.
"happyrpg" <happ...@discussions.microsoft.com> wrote in message news:7E8A76C6-3C81-4FB5...@microsoft.com...
> 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.
What form do you expect that buffer to be? For your test code below, you
return vartype 8204 from CreateVBArray.
The MsXML object won't like 8204 arrays. You need 8209 arrays, and that's
why you've seen regulars here using the MS Stream object. There is some
code which converts a string into an 8209 that uses the Stream object.
>
> 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.
For now, let's see if we can do this in VBScript, since its complicated
enough as it is.
>
> <SCRIPT LANGUAGE="VBScript">
<snip>
> oB64Node.nodeTypedValue = CreateVBArray( buffer)
oB64Node.nodeTypedValue = StringTo8209( buffer, 1 )
> Set doEncode = oB64Node
' return the Base64 test as string
doEncode = oB64Node.text
> End Function
> </SCRIPT>
hth,
tlviewer
Did do some investigation on some of your points.
Yes the array I'm creating is type 8204,
If the vartype I need is 8209 = (8192+ 17 = vbArray + vbByte), then how does
one create it?
Example: I populated an array of byte.. but the containing array is still
vartype 8204..
a(0) = AscB(midB(buffer,j,1))
vartype(a) == 8204
vartype(a(0)) == 17
I don't see how to create a array of type 8209 without enlisting the aid of
a external obj.