Decoding Base64 and Saving to a file - HELP!

[plank]

Hey Peeps,

Ok here is my situation.. I have a Java applet which allows the user to select files and upload them to the server. The
applet converts the file to Base64 and then POSTS the data to an ASP page.

The ASP code I have is:

<%
Base64Chars = "ABCDEFGHIJKLMN OPQRSTUVWXYZabc defghijklmnopqr stuvwxyz0123456 789+/"

Public Function Base64Decode(sB ase64)
For i = 1 To Len(sBase64) Step 4
w1 = FindPos(Mid(sBa se64, i, 1))
w2 = FindPos(Mid(sBa se64, i + 1, 1))
w3 = FindPos(Mid(sBa se64, i + 2, 1))
w4 = FindPos(Mid(sBa se64, i + 3, 1))
If (w2 >= 0) Then ByteArray = ByteArray & chrB((w1 * 4 + Int(w2 / 16)) And 255)
If (w3 >= 0) Then ByteArray = ByteArray & chrB((w2 * 16 + Int(w3 / 4)) And 255)
If (w4 >= 0) Then ByteArray = ByteArray & chrB((w3 * 64 + w4) And 255)
Next
Base64Decode = ByteArray
End Function

Private Function FindPos(sChar)
If (Len(sChar) = 0) Then
FindPos = -1
Else
FindPos = InStr(Base64Cha rs, sChar) - 1
End If
End Function
Set oStream = Server.CreateOb ject("ADODB.Str eam")
oStream.Type = 1
oStream.Open
oStream.Write Base64Decode(Re quest.Form("fil e"))
oStream .SaveToFile "c:\file.da t"
oStream.Close()
Set oStream = Nothing
%>

I am receving the following error:

ADODB.Stream error '800a0bb9'

Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.

/upload/upload.asp, line 29

Any ideas?? This is all new to me.. any help would be much appreciated!!

Thanks in advance!

AJB

[McKirahan]

<pl***@plank.co m> wrote in message
news:ui******** *************** *********@4ax.c om...

Hey Peeps,

Ok here is my situation.. I have a Java applet which allows the user to select files and upload them to the server. The applet converts the file to Base64 and then POSTS the data to an ASP page.

The ASP code I have is:

<%
Base64Chars = "ABCDEFGHIJKLMN OPQRSTUVWXYZabc defghijklmnopqr stuvwxyz0123456 789+/"
Public Function Base64Decode(sB ase64)
For i = 1 To Len(sBase64) Step 4
w1 = FindPos(Mid(sBa se64, i, 1))
w2 = FindPos(Mid(sBa se64, i + 1, 1))
w3 = FindPos(Mid(sBa se64, i + 2, 1))
w4 = FindPos(Mid(sBa se64, i + 3, 1))
If (w2 >= 0) Then ByteArray = ByteArray & chrB((w1 * 4 + Int(w2 / 16)) And 255) If (w3 >= 0) Then ByteArray = ByteArray & chrB((w2 * 16 + Int(w3 / 4)) And 255) If (w4 >= 0) Then ByteArray = ByteArray & chrB((w3 * 64 + w4) And 255)
Next
Base64Decode = ByteArray
End Function

Private Function FindPos(sChar)
If (Len(sChar) = 0) Then
FindPos = -1
Else
FindPos = InStr(Base64Cha rs, sChar) - 1
End If
End Function
Set oStream = Server.CreateOb ject("ADODB.Str eam")
oStream.Type = 1
oStream.Open
oStream.Write Base64Decode(Re quest.Form("fil e"))
oStream .SaveToFile "c:\file.da t"
oStream.Close()
Set oStream = Nothing
%>

I am receving the following error:

ADODB.Stream error '800a0bb9'

Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.
/upload/upload.asp, line 29

Any ideas?? This is all new to me.. any help would be much appreciated!!

Thanks in advance!

AJB

Try it without oStream to see what you get:

WScript.Echo Base64Decode(Re quest.Form("fil e"))

Here's an alternative:

Encode and Decode Base64 Files
http://www.fourmilab.ch/webtools/base64/

Option Explicit
Dim objWSS
Set objWSS = WScript.CreateO bject("WScript. Shell")
objWSS.Run "%comspec% /C base64.exe -d encoded.txt decoded.txt", 1, True
Set objWSS = Nothing

[Egbert Nierop \(MVP for IIS\)]

<pl***@plank.co m> wrote in message
news:ui******** *************** *********@4ax.c om...

Hey Peeps,

Ok here is my situation.. I have a Java applet which allows the user to
select files and upload them to the server. The
applet converts the file to Base64 and then POSTS the data to an ASP page.

The ASP code I have is:

<%
Base64Chars =
"ABCDEFGHIJKLMN OPQRSTUVWXYZabc defghijklmnopqr stuvwxyz0123456 789+/"

Public Function Base64Decode(sB ase64)
For i = 1 To Len(sBase64) Step 4
w1 = FindPos(Mid(sBa se64, i, 1))
w2 = FindPos(Mid(sBa se64, i + 1, 1))
w3 = FindPos(Mid(sBa se64, i + 2, 1))
w4 = FindPos(Mid(sBa se64, i + 3, 1))
If (w2 >= 0) Then ByteArray = ByteArray & chrB((w1 * 4 + Int(w2 / 16)) And
255)
If (w3 >= 0) Then ByteArray = ByteArray & chrB((w2 * 16 + Int(w3 / 4)) And
255)
If (w4 >= 0) Then ByteArray = ByteArray & chrB((w3 * 64 + w4) And 255)
Next
Base64Decode = ByteArray
End Function

Private Function FindPos(sChar)
If (Len(sChar) = 0) Then
FindPos = -1
Else
FindPos = InStr(Base64Cha rs, sChar) - 1
End If
End Function
Set oStream = Server.CreateOb ject("ADODB.Str eam")
oStream.Type = 1
oStream.Open
oStream.Write Base64Decode(Re quest.Form("fil e"))
oStream .SaveToFile "c:\file.da t"
oStream.Close()
Set oStream = Nothing
%>

I am receving the following error:

ADODB.Stream error '800a0bb9'

Arguments are of the wrong type, are out of acceptable range, or are in
conflict with one another.

/upload/upload.asp, line 29

Any ideas?? This is all new to me.. any help would be much appreciated!!
Put this code in a COM object in VB6.
Compile with 'ignore integer overflow'.

Private Enum baseFlag
ATL_BASE64_FLAG _NONE = 0
ATL_BASE64_FLAG _NOPAD
ATL_BASE64_FLAG _NOCRLF
End Enum

' based on atlenc.h
' Warning! You cannot run this function in debug mode
' it only works in compiled mode
' we got stunning speed in VB6, in compare with the
' 'other' sucking Chr() and Asc() routines which might be 100x slower than
' this version. The drawback is that we must compile with
' -ignore integer overflow- which is not a drawback for me anyway.
PUblic Function btFromBase64(By Ref sBaseEncodedBLO B As String) As Byte()
'// walk the source buffer
'// each four character sequence is converted to 3 bytes
'// CRLFs and =, and any characters not in the encoding table
'// are skiped

Dim dx As Long
Dim cx As Long
Dim dwCurr As Long
Dim i As Long
Dim nSrcLen As Long

nSrcLen = LenB(sBaseEncod edBLOB)
If nSrcLen = 0 Then Exit Function

Dim nBits As Long
Dim nch As Byte
Dim pbDest() As Byte
' copy our string to a fast loopable byte array
' this array is also our target array
' it is possible because the read pointer goes 'faster' than the write
pointer
pbDest() = sBaseEncodedBLO B
' no need for this memory waste anymore
sBaseEncodedBLO B = vbNullString

Do
dwCurr = 0
nBits = 0
For i = 3 To 0 Step -1
If cx >= nSrcLen Then Exit For
nch = pbDest(cx)
cx = cx + 2
If nch >= 65 And nch <= 90 Then
nch = nch - 65 ' // 0 range starts at 'A'
ElseIf nch >= 97 And nch <= 122 Then
nch = nch - 71 '(97 - 26) ' - 'a' + 26, Byte) ' // 26
range starts at 'a'
ElseIf nch >= 48 And nch <= 57 Then
nch = nch + 4 '- '0' + 52; // 52 range starts at '0'
ElseIf nch = 43 Then
nch = 62
ElseIf nch = 47 Then
nch = 63
Else
nch = &HFF
'// skip this char
i = i + 1
End If
If nch <> &HFF Then
dwCurr = dwCurr * &H40 Or nch
nBits = nBits + 6
End If
Next
'// dwCurr has the 3 bytes to write to the output buffer
'// left to right
dwCurr = dwCurr * IntPower(24 - nBits)
For i = nBits \ 8 - 1 To 0 Step -1
pbDest(dx) = (dwCurr And &HFF0000) \ &H10000
dx = dx + 1
dwCurr = dwCurr * &H100
Next
Loop While cx < nSrcLen
ReDim Preserve pbDest(dx - 1)
btFromBase64 = pbDest

End Function

' this function is much better than using the ^ operator
' since that operator is using slow floating point code ops
Private Function IntPower(ByVal pwr As Long) As Long

IntPower = 1

For pwr = 1 To pwr
IntPower = IntPower * 2
Next

End Function

Public Function Base64EncodeGet RequiredLength( ByVal nSrcLen As Integer,
Optional ByVal dwFlags As baseFlag = baseFlag.ATL_BA SE64_FLAG_NONE) As Long

Dim nRet As Long
nRet = (nSrcLen * 4) \ 3

If ((dwFlags And baseFlag.ATL_BA SE64_FLAG_NOPAD ) = 0) Then
nRet = nRet + nSrcLen Mod 3
End If

Dim nCRLFs As Long
nCRLFs = nRet \ 76 + 1
Dim nOnLastLine As Long
nOnLastLine = nRet Mod 76

If (nOnLastLine > 0) Then

If (nOnLastLine Mod 4) > 0 Then
nRet = nRet + 4 - (nOnLastLine Mod 4)
End If
End If

nCRLFs = nCRLFs * 2

If ((dwFlags And baseFlag.ATL_BA SE64_FLAG_NOCRL F) = 0) Then
nRet = nRet + nCRLFs
End If

Base64EncodeGet RequiredLength = nRet
End Function

Public Function ByteToBase64Arr ay(ByRef pbSrcData() As Byte, ByRef szDest()
As Byte, ByVal nSrcLen As Long, Optional ByVal dwFlags As baseFlag =
baseFlag.ATL_BA SE64_FLAG_NONE) As Long
Static base(63) As Byte
Dim cx As Long, x As Long
For x = 65 To 90
base(cx) = x
cx = cx + 1
Next
For x = 97 To 122
base(cx) = x
cx = cx + 1
Next
For x = 48 To 57
base(cx) = x
cx = cx + 1
Next
base(cx) = 43
cx = cx + 1
base(cx) = 47

Debug.Assert (UBound(szDest) >= Base64EncodeGet RequiredLength( nSrcLen,
dwFlags))
cx = 0
Dim nLen1 As Long
nLen1 = (nSrcLen \ 3) * 4
Dim nLen2 As Long
nLen2 = nLen1 \ 76
Dim nLen3 As Long
nLen3 = 19
Dim i As Long

Dim dx As Long
'Dim b As Long
Dim dwCurr As Long

Dim k As Long
Dim n As Long
Dim j As Long
Dim nDestLen As Long
nDestLen = UBound(szDest)
' for each line of 76 chars
For i = 0 To nLen2
If i = nLen2 Then nLen3 = (nLen1 Mod 76) \ 4

'for this line
For j = 0 To nLen3 - 1
dwCurr = 0
For n = 2 To 0 Step -1
dwCurr = dwCurr Or pbSrcData(cx)
cx = cx + 1
dwCurr = dwCurr * &H100
Next
For k = 3 To 0 Step -1
szDest(dx) = base((dwCurr \ &H4000000) And &H3F)
dx = dx + 1
dwCurr = dwCurr * &H40
Next
Next
If (dwFlags And baseFlag.ATL_BA SE64_FLAG_NOCRL F) = 0 Then
szDest(dx) = 13
dx = dx + 1 ' '\r';
szDest(dx) = 10
dx = dx + 1
End If
Next

If (dx > 0 And (dwFlags And baseFlag.ATL_BA SE64_FLAG_NOCRL F) = 0) Then
dx = dx - 2
End If
Dim nPad As Long
nPad = nSrcLen Mod 3
If nLen2 <> nPad Then
nLen2 = nPad + 1
Else
nLen2 = 0
End If

If nLen2 > 0 Then
dwCurr = 0
For n = 0 To 2
If n < nPad Then
dwCurr = dwCurr Or pbSrcData(cx)
cx = cx + 1
End If
dwCurr = dwCurr * &H100
Next

For k = nLen2 - 1 To 0 Step -1
'&H3F repairs negative signed longs
szDest(dx) = base((dwCurr \ &H4000000) And &H3F)
dx = dx + 1
dwCurr = dwCurr * &H40
Next
If (dwFlags And baseFlag.ATL_BA SE64_FLAG_NOPAD ) = 0 Then
If nLen3 <> nLen2 Then
nLen3 = 4 - nLen2
Else
nLen3 = 0
End If

For j = nLen3 - 1 To 0 Step -1
If dx >= nDestLen Then Exit For
szDest(dx) = 61 ''=';
dx = dx + 1
Next
End If
End If
ByteToBase64Arr ay = dx

End Function
Thanks in advance!

AJB