101 lines
3.7 KiB
HTML
101 lines
3.7 KiB
HTML
<% /*
|
||
$Revision$
|
||
$Id$
|
||
*/ %>
|
||
<script language="VBScript" runat="Server">
|
||
Sub BuildUploadRequest(RequestBin)
|
||
'Get the boundary
|
||
PosBeg = 1
|
||
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
|
||
boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
|
||
boundaryPos = InstrB(1,RequestBin,boundary)
|
||
img_nr = 1
|
||
'Get all data inside the boundaries
|
||
Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
|
||
'Members variable of objects are put in a dictionary object
|
||
Dim UploadControl
|
||
Set UploadControl = CreateObject("Scripting.Dictionary")
|
||
'Get an object name
|
||
Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
|
||
Pos = InstrB(Pos,RequestBin,getByteString("name="))
|
||
PosBeg = Pos+6
|
||
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
|
||
Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
|
||
PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
|
||
PosBound = InstrB(PosEnd,RequestBin,boundary)
|
||
'Test if object is of file type
|
||
If PosFile<>0 AND (PosFile<PosBound) Then
|
||
'Get Filename, content-type and content of file
|
||
PosBeg = PosFile + 10
|
||
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
|
||
FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
|
||
'Add filename to dictionary object
|
||
UploadControl.Add "FileName", FileName
|
||
Name = Name & img_nr
|
||
img_nr = img_nr + 1
|
||
Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
|
||
PosBeg = Pos+14
|
||
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
|
||
'Add content-type to dictionary object
|
||
ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
|
||
UploadControl.Add "ContentType",ContentType
|
||
'Get content of object
|
||
PosBeg = PosEnd+4
|
||
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
|
||
Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
|
||
Else
|
||
'Get content of object
|
||
Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
|
||
PosBeg = Pos+4
|
||
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
|
||
Value = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
|
||
End If
|
||
'Add content to dictionary object
|
||
UploadControl.Add "Value" , Value
|
||
'Add dictionary object to main dictionary
|
||
UploadRequest.Add Name, UploadControl
|
||
'Loop to next object
|
||
BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
|
||
Loop
|
||
|
||
End Sub
|
||
|
||
'String to byte string conversion
|
||
Function getByteString(StringStr)
|
||
dim i
|
||
For i = 1 to Len(StringStr)
|
||
char = Mid(StringStr,i,1)
|
||
getByteString = getByteString & chrB(AscB(char))
|
||
Next
|
||
End Function
|
||
|
||
'Byte string to string conversion
|
||
Function getString(StringBin)
|
||
getString =""
|
||
For intCount = 1 to LenB(StringBin)
|
||
getString = getString & chr(AscB(MidB(StringBin,intCount,1)))
|
||
Next
|
||
End Function
|
||
|
||
Function MultiByteToBinary(MultiByte)
|
||
'<EFBFBD> 2000 Antonin Foller, http://www.motobit.com
|
||
' MultiByteToBinary 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
|
||
|
||
</script>
|
||
|