Eccomi qua con la segnalazione dell'errore che appare in diverse fasi
Premetto che funziona perfettamente con file di piccole dimensioni entro tipo 1 mb
comunque
- Ha un tempo di upload in 3600 secondi
- Con i file grandi, sembra che carichi, viene la pagina bianca, e nella barra di stato del browser appare una clessidra e la dicitura "Sito web rilevato in attesa di risposta..."
- Aspetto e dopo diversi minuti appare sempre nella barra di stato
"operazione completata" sempre con pagina bianca e l'indirizzo di pagina sempre quello del form di inserimento
- Aspetto e poco dopo qualche minuti appare pagina classica d'errore Impossibile trovare il server" e in fondo appare la seguente dicitura finale d'errore:
"Impossibile trovare il server o errore DNS
Internet Explorer "
POI clicco AGGIORNA PAGINA
e appare questo errore:
Microsoft vb script:history.back(1)"">try again</a>"
Response.End
End If
End If
End Sub
'Check if version is uptodate
Sub CheckPureUploadVersion(pau_version)
Dim foundPureUploadVersion
foundPureUploadVersion = getPureUploadVersion()
if err or pau_version > foundPureUploadVersion then
Response.Write "<b>You don't have latest version of ScriptLibrary/incPureUpload.asp uploaded on the server.</b><br/>"
Response.Write "This library is required for the current page. It is fully backwards compatible so old pages will work as well.<br/>"
Response.End
end if
End Sub
'Get fieldname
function pau_Name(FormInfo)
Dim PosBeg, PosLen
PosBeg = InStr(FormInfo, "name=")+6
PosLen = InStr(PosBeg, FormInfo, Chr(34))-PosBeg
pau_Name = Mid(FormInfo, PosBeg, PosLen)
end function
'Get filename
function pau_FileName(FormInfo)
Dim PosBeg, PosLen
PosBeg = InStr(FormInfo, "filename=")+10
PosLen = InStr(PosBeg, FormInfo, Chr(34))-PosBeg
pau_FileName = Mid(FormInfo, PosBeg, PosLen)
end function
'Get contentType
function pau_ContentType(FormInfo)
Dim PosBeg
PosBeg = InStr(FormInfo, "Content-Type: ")+14
pau_ContentType = Mid(FormInfo, PosBeg)
end function
'Compatibility with older versions
Sub BuildUploadRequest(RequestBin,UploadDirectory,storeType,sizeLimit,nameConflict)
pau_BuildUploadRequest RequestBin,UploadDirectory,storeType,sizeLimit,nameConflict
End Sub
Sub pau_BuildUploadRequest(RequestBin,UploadDirectory,storeType,sizeLimit,nameConflict)
Dim Boundary, FormInfo, TypeArr, BoundaryArr, BoundaryPos, Pos, PosLen
Dim PosFile, Name, PosBound, FileName, ContentType, Value, ValueBeg, ValueEnd, ValueLen
'Check content type
TypeArr = Split(Request.ServerVariables("HTTP_Content_Type"), ";")
if Trim(TypeArr(0)) <> "multipart/form-data" then riga 134
Response.Write "<b>Form was submitted with no ENCTYPE=""multipart/form-data""</b><br/>"
Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"
Response.End
end if
'Get the boundary
BoundaryArr = Split(Trim(TypeArr(1)), "=")
Boundary = pau_getByteString(Trim(BoundaryArr(1)))
BoundaryPos = InStrB(1, RequestBin, Boundary)
'Get all data inside the boundaries
Do until (BoundaryPos = InStrB(RequestBin, Boundary & pau_getByteString("--")))
'Members variable of objects are put in a dictionary object
Dim UploadControl, CrLf
CrLf = pau_getByteString(chr(13) & chr(10))
Set UploadControl = CreateObject("Scripting.Dictionary")
Pos = InStrB(BoundaryPos, RequestBin, CrLf & CrLf)
PosLen = (InStrB(Pos, RequestBin, boundary)-2)-(pos+4)
if Pos > 0 then
FormInfo = pau_getString(MidB(RequestBin, BoundaryPos, Pos-BoundaryPos))
'Get name
Name = LCase(pau_Name(FormInfo))
'Is it a file?
if InStr(FormInfo, "filename=") > 0 then
'Get filename
FileName = pau_FileName(FormInfo)
FileName = pau_RemoveInvalidChars(Mid(FileName,InStrRev(FileName,"\")+1))
'Add filename to dictionary object
UploadControl.Add "FileName", FileName
'Get contenttype
ContentType = pau_ContentType(FormInfo)
'Add content-type to dictionary object
UploadControl.Add "ContentType", ContentType
'Get content
Value = FileName
ValueBeg = Pos+3
ValueLen = PosLen
else
Value = pau_getString(MidB(RequestBin, Pos+4, PosLen))
ValueBeg = 0
ValueLen = 0
end if
'Add content to dictionary object
UploadControl.Add "Value", Value
UploadControl.Add "ValueBeg", ValueBeg
UploadControl.Add "ValueLen", ValueLen
'Add dictionary object to main dictionary
if UploadRequest.Exists(Name) then
UploadRequest(Name).Item("Value") = UploadRequest(Name).Item("Value") & "," & Value
else
UploadRequest.Add Name, UploadControl
end if
end if
BoundaryPos = InStrB(BoundaryPos+LenB(Boundary), RequestBin, Boundary)
Loop
Dim GP_keys, GP_i, GP_curKey, GP_value, GP_valueBeg, GP_valueLen, GP_curPath, GP_FullPath
Dim GP_CurFileName, GP_FullFileName, fso, GP_BegFolder, GP_RelFolder, GP_FileExist, Begin_Name_Num
Dim orgUploadDirectory
if InStr(UploadDirectory,"""") > 0 then
on error resume next
orgUploadDirectory = UploadDirectory
UploadDirectory = eval(UploadDirectory)
if err then
Response.Write "<b>Upload folder is invalid</b><br/><br/>"
Response.Write "Upload Folder: " & Trim(orgUploadDirectory) & "<br/>"
Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"
err.clear
response.End
end if
on error goto 0
end if
GP_keys = UploadRequest.Keys
for GP_i = 0 to UploadRequest.Count - 1
GP_curKey = GP_keys(GP_i)
'Save all uploaded files
if UploadRequest.Item(GP_curKey).Item("FileName") <> "" then
GP_value = UploadRequest.Item(GP_curKey).Item("Value")
GP_valueBeg = UploadRequest.Item(GP_curKey).Item("ValueBeg")
GP_valueLen = UploadRequest.Item(GP_curKey).Item("ValueLen")
'Get the path
if InStr(UploadDirectory,"\") > 0 then
GP_curPath = UploadDirectory
if Mid(GP_curPath,Len(GP_curPath),1) <> "\" then
GP_curPath = GP_curPath & "\"
end if
GP_FullPath = GP_curPath
else
GP_curPath = Request.ServerVariables("PATH_INFO")
GP_curPath = Trim(Mid(GP_curPath,1,InStrRev(GP_curPath,"/")) & UploadDirectory)
if Mid(GP_curPath,Len(GP_curPath),1) <> "/" then
GP_curPath = GP_curPath & "/"
end if
GP_FullPath = Trim(Server.mappath(GP_curPath))
end if
if GP_valueLen = 0 then
Response.Write "<b>An error has occured saving uploaded file!</b><br/><br/>"
Response.Write "Filename: " & Trim(GP_curPath) & UploadRequest.Item(GP_curKey).Item("FileName") & "<br/>"
Response.Write "File does not exists or is empty.<br/>"
Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"
response.End
end if
'Create a Stream instance
Dim GP_strm1, GP_strm2
Set GP_strm1 = Server.CreateObject("ADODB.Stream")
Set GP_strm2 = Server.CreateObject("ADODB.Stream")
'Open the stream
GP_strm1.Open
GP_strm1.Type = 1 'Binary
GP_strm2.Open
GP_strm2.Type = 1 'Binary
GP_strm1.Write RequestBin
GP_strm1.Position = GP_ValueBeg
GP_strm1.CopyTo GP_strm2,GP_ValueLen
'Create and Write to a File
GP_CurFileName = UploadRequest.Item(GP_curKey).Item("FileName")
GP_FullFileName = GP_FullPath & "\" & GP_CurFileName
Set fso = CreateObject("Scripting.FileSystemObject")
pau_AutoCreatePath GP_FullPath
'Check if the file already exist
GP_FileExist = false
If fso.FileExists(GP_FullFileName) Then
GP_FileExist = true
End If
if nameConflict = "error" and GP_FileExist then
Response.Write "<b>File already exists!</b><br/><br/>"
Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"
GP_strm1.Close
GP_strm2.Close
response.End
end if
if ((nameConflict = "over" or nameConflict = "uniq") and GP_FileExist) or (NOT GP_FileExist) then
if nameConflict = "uniq" and GP_FileExist then
Begin_Name_Num = 0
while GP_FileExist
Begin_Name_Num = Begin_Name_Num + 1
GP_FullFileName = Trim(GP_FullPath)& "\" & fso.GetBaseName(GP_CurFileName) & "_" & Begin_Name_Num & "." & fso.GetExtensionName(GP_CurFileName)
GP_FileExist = fso.FileExists(GP_FullFileName)
wend
UploadRequest.Item(GP_curKey).Item("FileName") = fso.GetBaseName(GP_CurFileName) & "_" & Begin_Name_Num & "." & fso.GetExtensionName(GP_CurFileName)
UploadRequest.Item(GP_curKey).Item("Value") = UploadRequest.Item(GP_curKey).Item("FileName")
end if
on error resume next
GP_strm2.SaveToFile GP_FullFileName,2
if err then
err.clear
Dim txt_stream, file_bin
Set txt_stream = fso.CreateTextFile(GP_FullFileName, True)
file_bin = pau_getString(MidB(RequestBin, GP_ValueBeg+1, GP_ValueLen))
txt_stream.Write file_bin
txt_stream.Close
if err then
GP_strm1.Close
GP_strm2.Close
Response.Write "<b>An error has occured saving uploaded file!</b><br/><br/>"
Response.Write "Filename: " & GP_FullFileName & "<br/><br/>"
if fso.FileExists(GP_FullFileName) then
Dim f
Response.Write "File exists on server!<br/>"
Set f = fso.GetFile(GP_FullFileName)
Response.Write "Attributes(" & f.attributes & "|" & f.parentfolder.attributes & "): "
if f.attributes and 1 then
Response.Write "ReadOnly "
end if
if f.attributes and 2 then
Response.Write "Hidden "
end if
if f.attributes and 4 then
Response.Write "System "
end if
if f.attributes and 16 then
Response.Write "Directory "
end if
Response.Write "<br/><br/>"
end if
Response.Write "Error # " & CStr(Err.Number) & " " & Err.Description & "<br/>"
Response.Write "in " & Err.Source & "(" & GP_strm2.state & ")<br/>"
response.End
end if
end if
GP_strm1.Close
GP_strm2.Close
if storeType = "path" then
UploadRequest.Item(GP_curKey).Item("Value") = GP_curPath & UploadRequest.Item(GP_curKey).Item("Value")
end if
on error goto 0
end if
end if
next
End Sub
'Create folders if they do not exist
Sub pau_AutoCreatePath(PAU_FullPath)
Dim FL_fso, FL_EndPos, PAU_NewPath
Set FL_fso = CreateObject("Scripting.FileSystemObject")
if not FL_fso.FolderExists(PAU_FullPath) then
FL_EndPos = InStrRev(PAU_FullPath,"\")
if FL_EndPos > 0 then
PAU_NewPath = Left(PAU_FullPath,FL_EndPos-1)
pau_AutoCreatePath PAU_NewPath
on error resume next
FL_fso.CreateFolder PAU_FullPath
if err.number <> 0 then
Response.Write "<b>Can not create upload folder path: " & PAU_FullPath & "!</b><br/>"
Response.Write "Maybe you don't have enough permissions<br/><br/>"
Response.Write "Error # " & CStr(Err.Number) & " " & Err.Description & "<br/><br/>"
Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"
Response.End
end if
on error goto 0
end if
end if
Set FL_fso = nothing
End Sub
'String to byte string conversion
Function pau_getByteString(StringStr)
Dim i, char
For i = 1 to Len(StringStr)
char = Mid(StringStr,i,1)
pau_getByteString = pau_getByteString & chrB(AscB(char))
Next
End Function
'Byte string to string conversion (with double-byte support now)
Function pau_getString(StringBin)
Dim intCount,get1Byte
pau_getString = ""
For intCount = 1 to LenB(StringBin)
get1Byte = MidB(StringBin,intCount,1)
pau_getString = pau_getString & chr(AscB(get1Byte))
Next
End Function
'Replacement for the requests
Function UploadFormRequest(name)
Dim keyName
keyName = LCase(name)
if IsObject(UploadRequest) then
if UploadRequest.Exists(keyName) then
if UploadRequest.Item(keyName).Exists("Value") then
UploadFormRequest = UploadRequest.Item(keyName).Item("Value")
end if
end if
end if
End Function
'Invalid characters
'Dollar sign ($)
'At sign (@)
'Angle brackets (< >), brackets ([ ]), braces ({ }), and parentheses (( ))
'Colon ( and semicolon (
'Equal sign (=)
'Caret sign (^)
'Pipe (vertical bar) (|)
'Asterisk (*)
'Exclamation point (!)
'Forward (/) and backward slash (\)
'Percent sign (%)
'Question mark (?)
'Comma (,)
'Quotation mark (single or double) (' ")
'Tab
Function pau_RemoveInvalidChars(str)
Dim newStr, ci, curChar, Invalid
Invalid = "$@<>[]{}():;=^|*!/\%?,'"" "
for ci = 1 to Len(str)
curChar = Mid(str,ci,1)
if InStr(Invalid, curChar) = 0 then
newStr = newStr & curChar
end if
next
pau_RemoveInvalidChars = Trim(newStr)
End Function
'Fix for the update record
Function FixFieldsForUpload(GP_fieldsStr, GP_columnsStr)
Dim GP_counter, GP_Fields, GP_Columns, GP_FieldName, GP_FieldValue, GP_CurFileName, GP_CurContentType
GP_Fields = Split(GP_fieldsStr, "|")
GP_Columns = Split(GP_columnsStr, "|")
GP_fieldsStr = ""
' Get the form values
For GP_counter = LBound(GP_Fields) To UBound(GP_Fields) Step 2
GP_FieldName = LCase(GP_Fields(GP_counter))
GP_FieldValue = GP_Fields(GP_counter+1)
if UploadRequest.Exists(GP_FieldName) then
GP_CurFileName = UploadRequest.Item(GP_FieldName).Item("FileName")
GP_CurContentType = UploadRequest.Item(GP_FieldName).Item("ContentType")
else
GP_CurFileName = ""
GP_CurContentType = ""
end if
if (GP_CurFileName = "" and GP_CurContentType = "") or (GP_CurFileName <> "" and GP_CurContentType <> "") then
GP_fieldsStr = GP_fieldsStr & GP_FieldName & "|" & GP_FieldValue & "|"
end if
Next
if GP_fieldsStr <> "" then
GP_fieldsStr = Mid(GP_fieldsStr,1,Len(GP_fieldsStr)-1)
else
Response.Write "<b>An error has occured during record update!</b><br/><br/>"
Response.Write "There are no fields to update ...<br/>"
Response.Write "If the file upload field is the only field on your form, you should make it required.<br/>"
Response.Write "Please correct and <a href=""java script:history.back(1)"">try again</a>"
Response.End
end if
FixFieldsForUpload = GP_fieldsStr
End Function
'Fix for the update record
Function FixColumnsForUpload(GP_fieldsStr, GP_columnsStr)
Dim GP_counter, GP_Fields, GP_Columns, GP_FieldName, GP_ColumnName, GP_ColumnValue,GP_CurFileName, GP_CurContentType
GP_Fields = Split(GP_fieldsStr, "|")
GP_Columns = Split(GP_columnsStr, "|")
GP_columnsStr = ""
' Get the form values
For GP_counter = LBound(GP_Fields) To UBound(GP_Fields) Step 2
GP_FieldName = LCase(GP_Fields(GP_counter))
GP_ColumnName = GP_Columns(GP_counter)
GP_ColumnValue = GP_Columns(GP_counter+1)
if UploadRequest.Exists(GP_FieldName) then
GP_CurFileName = UploadRequest.Item(GP_FieldName).Item("FileName")
GP_CurContentType = UploadRequest.Item(GP_FieldName).Item("ContentType")
else
GP_CurFileName = ""
GP_CurContentType = ""
end if
if (GP_CurFileName = "" and GP_CurContentType = "") or (GP_CurFileName <> "" and GP_CurContentType <> "") then
GP_columnsStr = GP_columnsStr & GP_ColumnName & "|" & GP_ColumnValue & "|"
end if
Next
if GP_columnsStr <> "" then
GP_columnsStr = Mid(GP_columnsStr,1,Len(GP_columnsStr)-1)
end if
FixColumnsForUpload = GP_columnsStr
End Function
</SCRIPT>
Che cosa devo fare, cosa può servire da modificare nel codice.
Funziona perfettamente con i file piccoli e quelli grandi niente.
Premetto che io carico su aruba.it
errore DNS il tempo l'ho aumentato
mistero per me
