<% ' For examples, documentation, and your own free copy, go to: ' http://www.freeaspupload.net ' Note: You can copy and use this script for free and you can make changes ' to the code, but you cannot remove the above comment.
Class FreeASPUpload Public UploadedFiles Public FormElements
Private VarArrayBinRequest Private StreamRequest Private uploadedYet
Private Sub Class_Initialize() Set UploadedFiles = Server.CreateObject("Scripting.Dictionary") Set FormElements = Server.CreateObject("Scripting.Dictionary") Set StreamRequest = Server.CreateObject("ADODB.Stream") StreamRequest.Type = 1 'adTypeBinary StreamRequest.Open uploadedYet = false End Sub
Private Sub Class_Terminate() If IsObject(UploadedFiles) Then UploadedFiles.RemoveAll() Set UploadedFiles = Nothing End If If IsObject(FormElements) Then FormElements.RemoveAll() Set FormElements = Nothing End If StreamRequest.Close Set StreamRequest = Nothing End Sub
Public Property Get Form(sIndex) Form = "" If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex)) End Property
Public Property Get Files() Files = UploadedFiles.Items End Property
'Calls Upload to extract the data from the binary request and then saves the uploaded files Public Sub Save(path) Dim streamFile, fileItem
if Right(path, 1) <> "\" then path = path & "\"
if not uploadedYet then Upload
For Each fileItem In UploadedFiles.Items Set streamFile = Server.CreateObject("ADODB.Stream") streamFile.Type = 1 streamFile.Open StreamRequest.Position=fileItem.Start StreamRequest.CopyTo streamFile, fileItem.Length streamFile.SaveToFile path & fileItem.FileName, 2 streamFile.close Set streamFile = Nothing fileItem.Path = path & fileItem.FileName Next End Sub
Public Sub DumpData() 'only works if files are plain text Dim i, aKeys, f response.write "Form Items:<br>" aKeys = FormElements.Keys For i = 0 To FormElements.Count -1 ' Iterate the array response.write aKeys(i) & " = " & FormElements.Item(aKeys(i)) & "<BR>" Next response.write "Uploaded Files:<br>" For Each f In UploadedFiles.Items response.write "Name: " & f.FileName & "<br>" response.write "Type: " & f.ContentType & "<br>" response.write "Start: " & f.Start & "<br>" response.write "Size: " & f.Length & "<br>" Next End Sub
Private Sub Upload() Dim nCurPos, nDataBoundPos, nLastSepPos Dim nPosFile, nPosBound Dim sFieldName
'RFC1867 Tokens Dim vDataSep Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType tNewLine = Byte2String(Chr(13)) tDoubleQuotes = Byte2String(Chr(34)) tTerm = Byte2String("--") tFilename = Byte2String("filename=""") tName = Byte2String("name=""") tContentDisp = Byte2String("Content-Disposition") tContentType = Byte2String("Content-Type:")
uploadedYet = true
VarArrayBinRequest = Request.BinaryRead(Request.TotalBytes)
nCurPos = FindToken(tNewLine,1) 'Note: nCurPos is 1-based (and so is InstrB, MidB, etc)
If nCurPos <= 1 Then Exit Sub
'vDataSep is a separator like -----------------------------21763138716045 vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1)
'Start of current separator nDataBoundPos = 1
'Beginning of last line nLastSepPos = FindToken(vDataSep & tTerm, 1)
Do Until nDataBoundPos = nLastSepPos
nCurPos = SkipToken(tContentDisp, nDataBoundPos) nCurPos = SkipToken(tName, nCurPos) sFieldName = ExtractField(tDoubleQuotes, nCurPos)
nPosFile = FindToken(tFilename, nCurPos) nPosBound = FindToken(vDataSep, nCurPos)
If nPosFile <> 0 And nPosFile < nPosBound Then Dim oUploadFile, sFileName Set oUploadFile = New UploadedFile
nCurPos = SkipToken(tFilename, nCurPos) sFileName = ExtractField(tDoubleQuotes, nCurPos) oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))
if (Len(oUploadFile.FileName) > 0) then 'File field not left empy nCurPos = SkipToken(tContentType, nCurPos)
oUploadFile.ContentType = ExtractField(tNewLine, nCurPos) nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
oUploadFile.Start = nCurPos-1 oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos
If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile End If Else Dim nEndOfData nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line nEndOfData = FindToken(vDataSep, nCurPos) - 2 If Not FormElements.Exists(LCase(sFieldName)) Then FormElements.Add LCase(sFieldName), String2Byte(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos)) End If
'Advance to next separator nDataBoundPos = FindToken(vDataSep, nCurPos) Loop StreamRequest.Write(VarArrayBinRequest) End Sub
Private Function SkipToken(sToken, nStart) SkipToken = InstrB(nStart, VarArrayBinRequest, sToken) If SkipToken = 0 then Response.write "Error in parsing uploaded binary request." Response.End end if SkipToken = SkipToken + LenB(sToken) End Function
Private Function FindToken(sToken, nStart) FindToken = InstrB(nStart, VarArrayBinRequest, sToken) End Function
Private Function ExtractField(sToken, nStart) Dim nEnd nEnd = InstrB(nStart, VarArrayBinRequest, sToken) If nEnd = 0 then Response.write "Error in parsing uploaded binary request." Response.End end if ExtractField = String2Byte(MidB(VarArrayBinRequest, nStart, nEnd-nStart)) End Function
Public Function SaveBinRequest(path) ' For debugging purposes StreamRequest.SaveToFile path & "debugStream.bin", 2 End Function
'String to byte string conversion Private Function Byte2String(sString) Dim i For i = 1 to Len(sString) Byte2String = Byte2String & ChrB(AscB(Mid(sString,i,1))) Next End Function
'Byte string to string conversion Private Function String2Byte(bsString) Dim i String2Byte ="" For i = 1 to LenB(bsString) String2Byte = String2Byte & Chr(AscB(MidB(bsString,i,1))) Next End Function End Class
Class UploadedFile Public ContentType Public FileName Public Start Public Length Public Path End Class %>
|