I tested upload image by asp upload in IE6
There is some error in VB script - invalid procedure call or argument. To fix this error i had to modify class_upload.asp.
Note : i used free asp. script utils from : http://www.pstruh.cz/help/scptutl/upload.asp
Changes in class_upload.asp :
Class UploadedFile
Public ContentType
Public FileName
Public FileData
Public Property Get FileSize()
FileSize = LenB(FileData)
End Property
Public Sub SaveToDisk(sFilePath)
Dim oFS, oFile
Dim nIndex
'Set oFS = Server.CreateObject("Scripting.FileSystemObject")
'Set oFile = oFS.CreateTextFile(sFilePath, True)
'For nIndex = 1 to LenB(FileData)
' oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
'Next
'oFile.Close
Call SaveBinaryData(sFilePath, FileData)
End Sub
Public Sub SaveToDatabase(ByRef oField)
If LenB(FileData) = 0 Then Exit Sub
If IsObject(oField) Then
oField.AppendChunk FileData
End If
End Sub
End Class
'Upload utils from http://www.pstruh.cz/help/scptutl/uploa ... ==========
'************** Binary+MultiByte <-> String conversion fuctions
Function BinaryToString(Binary)
'2001 Antonin Foller, PSTRUH Software
'Optimized version of PureASP conversion function
'Selects the best algorithm to convert binary data to String data
Dim TempString
On Error Resume Next
'Recordset conversion has a best functionality
TempString = RSBinaryToString(Binary)
If Len(TempString) <> LenB(Binary) then'Conversion error
'We have to use multibyte version of BinaryToString
TempString = MBBinaryToString(Binary)
end if
BinaryToString = TempString
End Function
Function MBBinaryToString(Binary)
'1999 Antonin Foller, PSTRUH Software
'MultiByte version of BinaryToString function
'Optimized version of simple BinaryToString algorithm.
dim cl1, cl2, cl3, pl1, pl2, pl3
Dim L', nullchar
cl1 = 1
cl2 = 1
cl3 = 1
L = LenB(Binary)
Do While cl1<=L
pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
cl1 = cl1 + 1
cl3 = cl3 + 1
if cl3>300 then
pl2 = pl2 & pl3
pl3 = ""
cl3 = 1
cl2 = cl2 + 1
if cl2>200 then
pl1 = pl1 & pl2
pl2 = ""
cl2 = 1
End If
End If
Loop
MBBinaryToString = pl1 & pl2 & pl3
End Function
Function RSBinaryToString(xBinary)
'1999 Antonin Foller, PSTRUH Software
'This function converts binary data (VT_UI1 | VT_ARRAY or MultiByte string)
'to string (BSTR) using ADO recordset
'The fastest way - requires ADODB.Recordset
'Use this function instead of MBBinaryToString if you have ADODB.Recordset installed
'to eliminate problem with PureASP performance
Dim Binary
'MultiByte data must be converted to VT_UI1 | VT_ARRAY first.
if vartype(xBinary) = 8 then Binary = MultiByteToBinary(xBinary) else Binary = xBinary
Dim RS, LBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)
if LBinary>0 then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
RSBinaryToString = RS("mBinary")
Else
RSBinaryToString = ""
End If
End Function
Function MultiByteToBinary(MultiByte)
' This function converts multibyte string to real binary data (VT_UI1 | VT_ARRAY)
' Using recordset
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
if LMultiByte>0 then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function
Function StringToBinary(String)
Dim I, B
For I=1 to len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Next
StringToBinary = B
End Function
Function BinaryToStringSimple(Binary)
'Multibyte conversion idea.
'not used.
Dim I, S
For I = 1 To LenB(Binary)
S = S & Chr(AscB(MidB(Binary, I, 1)))
Next
BinaryToStringSimple = S
End Function
'************** Binary+MultiByte <-> String conversion fuctions - end
'The function simulates save of binary data using conversion to a string and filesystemobject
Function SaveBinaryData(FileName, ByteArray)
Dim FS : Set FS = CreateObject("Scripting.FileSystemObject")
Dim TextStream : Set TextStream = FS.CreateTextFile(FileName)
TextStream.Write BinaryToString(ByteArray) 'BinaryToString is in upload.asp.
TextStream.Close
End Function
'************** ScriptUtilities ByteArray class emaulation
'ByteArray class is native implemented by ScriptUtilities library
'This is simple VBS code which simulates some of ScriptUtilities ByteArray functionality
'required for file upload
Class clByteArray
'Stored bytearray.
public ByteArray
Public Default Property Get ba
ba = ByteArray
End Property
'Returns length of source binary data
public Property Get Length
Length = LenB(ByteArray)
End Property
'Returns length of source binary data
public Property Get String
String = BinaryToString(ByteArray)
End Property
'Stores the binary data to a file.
Public Function SaveAs(FileName)
SaveBinaryData FileName, ByteArray
End Function
End Class
'One upload form field contains next properties.
Class clField
Public Name, ContentDisposition, FileName, FilePath, ContentType, Value, Length
Public Default Property Get n
n = Name
End Property
End Class
'************** ScriptUtilities ByteArray class emaulation - end
'************** Special utilities
'Checks if all of required objects are installed
Function CheckRequirements()
Dim Msg
Msg = "<br><b>This script requires some default VBS objects installed to run properly.</b><br>" & vbCrLf
Msg = Msg & CheckOneObject("ADODB.Recordset")
Msg = Msg & CheckOneObject("Scripting.FileSystemObject")
Msg = Msg & CheckOneObject("Scripting.Dictionary")
CheckRequirements = Msg
' MsgBox Msg
End Function
'Checks if the one object is installed.
Function CheckOneObject(oClass)
Dim Msg
On Error Resume Next
CreateObject oClass
If Err = 0 Then Msg = "OK" Else Msg = "Error:" & Err.Description
CheckOneObject = oClass & " - " & Msg & "<br>" & vbCrLf
End Function
'************** Special utilities - end
'=============================================================================================================
Sun, 02/15/2004 - 00:00
#1