Using the File System and Dictionary Object to Upload Files

Code:

Save as default.asp Save as upload_submit.asp

<%@Language=VBScript%>

<%option explicit
server.ScriptTimeout = 300

Dim UploadRequest
Dim byteCount
Dim RequestBin
Dim UploadPAth

UploadPath = (server.MapPath("./") & "\")
byteCount = Request.TotalBytes
RequestBin = Request.BinaryRead(byteCount)
set UploadRequest = CreateObject("Scripting.Dictionary")

BuildUploadRequest RequestBin

'filter here for file types
'if UploadRequest.Item("file").item("ContentType") = "image/gif" then
	WriteFiletoFile UploadPath & GetShortFilename(UploadRequest.Item("file").item("FileName")), UploadRequest.Item("file").item("Value")
'end if

set uploadrequest = nothing

response.redirect "default.asp?FileUpload=True"

Sub WriteFileToFile(FullFileName, FileBinaryData)

Dim FSO
	Dim MyFile
	Dim i

set fso = server.CreateObject ("Scripting.filesystemobject")
	
	'Create and Write to a File
	Set MyFile = FSO.CreateTextFile(FullFileName, true)
	For i = 1 to LenB(FileBinaryData)   
		MyFile.Write chr(AscB(MidB(FileBinaryData, i, 1)))
	Next
	MyFile.Close

set myfile=nothing
	set fso=nothing

End Sub

Sub BuildUploadRequest(RequestBin)
	
	dim Pos
	dim PosBeg
	dim PosEnd
	Dim Boundary
	Dim BoundaryPos
	Dim UploadControl
	Dim Name
	Dim PosFile
	Dim PosBound
	Dim FileName
	Dim ContentType
	Dim Value	
	
	'Get the boundary
    PosBeg = 1
    PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
    boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
    boundaryPos = InstrB(1,RequestBin,boundary)

'Get all data inside the boundaries
    Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))

'Members variable of objects are put in a dictionary object
	    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
	        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    
	     set UploadControl = nothing
	        
	     'Loop to next object
	     BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
    Loop

End Sub
 
 
 'Byte string to string conversion
Function getString(StringBin)
	
	dim intCount

getString =""
    For intCount = 1 to LenB(StringBin)
        getString = getString & chr(AscB(MidB(StringBin,intCount,1))) 
    Next
End Function

'String to byte string conversion
Function getByteString(StringStr)

dim char
	dim i

For i = 1 to Len(StringStr)    
        char = Mid(StringStr,i,1)
        getByteString = getByteString & chrB(AscB(char))
    Next
End Function

Function GetShortFilename(Filename)

dim strtemp

strtemp = filename

do until instr(1, strTemp, "\") = 0
		strTEmp = right(strTEmp, len(strTEmp) - instr(1, strTemp, "\"))
	loop
	
	GetShortFilename = strtemp

end function 
%>