| Server IP : 79.136.114.73 / Your IP : 18.217.150.104 Web Server : Apache/2.4.7 (Ubuntu) PHP/5.5.9-1ubuntu4.29 OpenSSL/1.0.1f System : Linux b8009 3.13.0-170-generic #220-Ubuntu SMP Thu May 9 12:40:49 UTC 2019 x86_64 User : www-data ( 33) PHP Version : 5.5.9-1ubuntu4.29 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority, MySQL : ON | cURL : ON | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : ON Directory : /var/www/icad.astacus.se/project/universal_old/FileProcessingScripts/ASP/ |
Upload File : |
<%
option explicit
Response.Expires = -1
Server.ScriptTimeout = 60000
' Based on freeaspupload script. Modified by Element-IT to work with universal uploader.
'
' 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.
'Changes:
'Aug 2, 2005: Add support for checkboxes and other input elements with multiple values
'You can't access form fields using regular Request.Form collection .
'You should use Upload.Form collection , but only after call of Upload.Save method.
Public Sub uploadCompleteHandler(fileName, filePath)
'place post upload actions here
End Sub
dim uploadsDirVar, Upload, myfile, postfiles
uploadsDirVar = Server.MapPath(".") & "\UploadedFiles"
Set Upload = New FreeASPUpload
Upload.Save(uploadsDirVar)
'Here you can use Upload.Form collection to get form fields data
if Upload.UploadedFiles.Count > 0 Then
postfiles = Upload.Files
set myfile = postfiles(0)
if Request.QueryString("chunkedUpload") <> "" then
end if
if Upload.Complete then
Upload.WriteResponse("File " & myfile.FileName & " was successfully uploaded.")
Response.Write(Upload.CloseTag)
call uploadCompleteHandler(myfile.FileName, myfile.Path)
end if
End IF
Class FreeASPUpload
Public UploadedFiles
Public FormElements
Public UploaderType
Public Complete
Public OpenTag
Public CloseTag
Public FileSize
Public fid
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
Complete = false
OpenTag = ""
CloseTag = ""
UploaderType = "html5"
FileSize = 0
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, postfiles, chunked, fs, fileName
fid = ""
if Right(path, 1) <> "\" then path = path & "\"
if not uploadedYet then Upload
if GetFieldValue("chunkedUpload") <> "" then chunked = true
if GetFieldValue("FileName") <> "" then fileName = GetFieldValue("FileName")
if GetFieldValue("fileName") <> "" then fileName = GetFieldValue("fileName")
if chunked then
'FileId and fid
fid = GetFieldValue("FileId")
if fid = "" then fid = GetFieldValue("fid")
Set fs = Server.CreateObject("Scripting.FileSystemObject")
Dim f
UploaderType = GetFieldValue("uploaderType")
if UploaderType = "" or UploaderType = "drag-and-drop" then UploaderType = "html5"
FileSize = 0
if GetFieldValue("totalSize") <> "" then FileSize = cLng(GetFieldValue("totalSize"))
if GetFieldValue("FileSize") <> "" then FileSize = cLng(GetFieldValue("FileSize"))
if LCase(GetFieldValue("Complete")) = "true" then Complete = true
'For Java and Flash based uploaders we should return special xml structure in response */
if UploaderType = "java" then
OpenTag = "<javapowupload>"
CloseTag = "</javapowupload>"
End if
if UploaderType = "flash" then
OpenTag = "<multipowupload>"
CloseTag = "</multipowupload>"
End if
Response.Write(OpenTag)
if IsQuerySize then
If fs.FileExists(path & fid & fileName)=True Then
Set f=fs.GetFile(path & fid & fileName)
WriteOk(f.Size)
else
WriteOk("0")
end if
Response.Write(CloseTag)
end if
End IF
if UploadedFiles.Count > 0 Then
postfiles = UploadedFiles.Items
set fileItem = postfiles(0)
if fileName <> "" then fileItem.FileName = fileName
If IsObject(fileItem) Then
Set streamFile = Server.CreateObject("ADODB.Stream")
streamFile.Type = 1
streamFile.Open
if not chunked then
StreamRequest.Position=fileItem.Start
StreamRequest.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile path & fileItem.FileName, 2
streamFile.close
Complete = true
else
UploaderType = GetFieldValue("uploaderType")
if UploaderType = "" or UploaderType = "drag-and-drop" then UploaderType = "html5"
'For Java and Flash based uploaders we should return special xml structure in response */
if UploaderType = "java" then
OpenTag = "<javapowupload>"
CloseTag = "</javapowupload>"
End if
if UploaderType = "flash" then
OpenTag = "<multipowupload>"
CloseTag = "</multipowupload>"
End if
if not IsQuerySize then
If fs.FileExists(path & fid & fileItem.FileName)=True Then
streamFile.LoadFromFile path & fid & fileItem.FileName
end if
StreamRequest.Position=fileItem.Start
streamFile.Position = streamFile.Size
streamFile.Write(StreamRequest.Read(fileItem.Length))
streamFile.SaveToFile path & fid & fileItem.FileName, 2
WriteOk("")
streamFile.close
if UploaderType <> "silverlight" AND UploaderType <> "html5" then
if FileSize > 0 AND not IsQuerySize and fs.FileExists(path & fid & fileName)=True then
Set f=fs.GetFile(path & fid & fileName)
if f.Size >= FileSize then Complete = true
end if
end if
if Complete then
If fs.FileExists(path & fileItem.FileName)=True Then
set f=fs.GetFile(path & fileItem.FileName)
f.Delete
end if
Set f=fs.GetFile(path & fid & fileName)
f.Move path & fileItem.FileName
end if
End If
if not Complete then Response.Write(CloseTag)
end if
Set streamFile = Nothing
fileItem.Path = path & fileItem.FileName
End If
End If
End Sub
Public Function SaveBinRequest(path) ' For debugging purposes
StreamRequest.SaveToFile path & "\debugStream.bin", 2
End Function
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, osPathSep, auxStr
'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
on error resume next
VarArrayBinRequest = Request.BinaryRead(Request.TotalBytes)
if Err.Number <> 0 then
response.write "<br><br><B>System reported this error:</B><p>"
response.write Err.Description & "<p>"
response.write "The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>"
Exit Sub
end if
on error goto 0 'reset error handling
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) OR (nDataBoundPos > (Request.TotalBytes - Len(vDataSep) - 50))
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
Set oUploadFile = New UploadedFile
nCurPos = SkipToken(tFilename, nCurPos)
auxStr = ExtractField(tDoubleQuotes, nCurPos)
' We are interested only in the name of the file, not the whole path
' Path separator is \ in windows, / in UNIX
' While IE seems to put the whole pathname in the stream, Mozilla seem to
' only put the actual file name, so UNIX paths may be rare. But not impossible.
osPathSep = "\"
if InStr(auxStr, osPathSep) = 0 then osPathSep = "/"
oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep))
if (Len(oUploadFile.FileName) > 0) then 'File field not left empty
nCurPos = SkipToken(tContentType, nCurPos)
auxStr = ExtractField(tNewLine, nCurPos)
' NN on UNIX puts things like this in the streaa:
' ?? python py type=?? python application/x-python
oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " "))
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))
else
FormElements.Item(LCase(sFieldName))= String2Byte(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos)) 'FormElements.Item(LCase(sFieldName)) & ", " &
end if
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
'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
Public Function GetFieldValue(fieldName)
GetFieldValue = ""
if FormElements.Exists(LCase(fieldName)) then GetFieldValue = FormElements.Item(LCase(fieldName))
if Request.QueryString(fieldName) <> "" then GetFieldValue = Request.QueryString(fieldName)
'Response.Write(fieldName&" "&GetFieldValue&"\r\n")
End Function
Public Function IsQuerySize()
IsQuerySize = false
if GetFieldValue("QuerySize") <> "" Then
if GetFieldValue("QuerySize") = "true" then IsQuerySize = true
end if
if GetFieldValue("action") = "check" then IsQuerySize = true
End Function
'Write error to response stream
public Sub WriteError(errstr)
if UploaderType = "silverlight" OR UploaderType = "html5" then
Response.Write("Error: "+errstr)
else
Response.Write("<error message='"&errstr&"'/>")
Response.Write(closeTag)
End IF
End Sub
'Write OK to response stream
public Sub WriteOk(size)
if UploaderType = "silverlight" OR UploaderType = "html5" then
Response.Write(size)
else
if size <> "" then
Response.Write("<ok size='"&size&"'/>")
else
Response.Write("<ok/>")
end if
end if
End Sub
'Write response to response stream
public Sub WriteResponse(response)
if UploaderType = "silverlight" OR UploaderType = "html5" then
Response.Write(response)
else
Response.Write("<response> "&response&"</response>")
end if
End Sub
End Class
Class UploadedFile
Public ContentType
Public Start
Public Length
Public Path
Private nameOfFile
' Need to remove characters that are valid in UNIX, but not in Windows
Public Property Let FileName(fN)
nameOfFile = fN
nameOfFile = SubstNoReg(nameOfFile, "\", "_")
nameOfFile = SubstNoReg(nameOfFile, "/", "_")
nameOfFile = SubstNoReg(nameOfFile, ":", "_")
nameOfFile = SubstNoReg(nameOfFile, "*", "_")
nameOfFile = SubstNoReg(nameOfFile, "?", "_")
nameOfFile = SubstNoReg(nameOfFile, """", "_")
nameOfFile = SubstNoReg(nameOfFile, "<", "_")
nameOfFile = SubstNoReg(nameOfFile, ">", "_")
nameOfFile = SubstNoReg(nameOfFile, "|", "_")
End Property
Public Property Get FileName()
FileName = nameOfFile
End Property
'Public Property Get FileN()ame
End Class
' Does not depend on RegEx, which is not available on older VBScript
' Is not recursive, which means it will not run out of stack space
Function SubstNoReg(initialStr, oldStr, newStr)
Dim currentPos, oldStrPos, skip
If IsNull(initialStr) Or Len(initialStr) = 0 Then
SubstNoReg = ""
ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then
SubstNoReg = initialStr
Else
If IsNull(newStr) Then newStr = ""
currentPos = 1
oldStrPos = 0
SubstNoReg = ""
skip = Len(oldStr)
Do While currentPos <= Len(initialStr)
oldStrPos = InStr(currentPos, initialStr, oldStr)
If oldStrPos = 0 Then
SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1)
currentPos = Len(initialStr) + 1
Else
SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr
currentPos = oldStrPos + skip
End If
Loop
End If
End Function
%>