posto code file origine dati (1a parte):
<%
Const adLongVarChar = 201
Const adLongVarBinary = 205
Const adBoolean = 11
Const adVarChar = 200
Const adSmallInt = 2
Const adInteger = 3
Const adDate = 7
Class cUpload
'*** Variabili ***
Private WebServerFP
Private CurrentPath
'*** Oggetti ***
Public Stream
Public Fso
Public Form
Public Files
'*** Opzioni Utente ***
Public OverWrite
Public AutoRename
Public EnabledLog
Public LogDelimiter
Public LogName
Public QueryString
'*** Private ****
Private Rs
Private iTotalBytes
Private RequestBin
Private iPath
Private iPathVirtual
Private PathInclude
Private iLogFolder
Private iAddInformationToLog
Private iOnlySave
Private InitTime
Private cContentType
Private cName
Private cFileName
Private cEndBin
Private c13b
Private c34b
Private cVbCrLf
'************************ Initialize() ************************************************** ***************
Private Sub Class_Initialize()
Dim tMp
InitTime = Timer()
'*** Creazione Oggetti ****
Set Stream = Server.CreateObject("ADODB.Stream")
Set Files = Server.CreateObject("ADODB.Recordset")
Set Rs = Server.CreateObject("ADODB.Recordset")
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
Set Form = Server.CreateObject("Scripting.Dictionary")
Form.CompareMode = 1
'*** Impostazione Valori in Byte ****
cContentDisp = getByteString("Content-Disposition")
cContentType = getByteString("Content-Type:")
cName = getByteString("name=")
cFileName = getByteString("filename=")
c13b = getByteString(chr(13))
c34b = getByteString(chr(34))
cEndBin = getByteString("--")
cVbCrLf = getByteString(vbCrLf)
'*** Creazione Dei Recordset Disconnessi ***
QueryString = Request.QueryString
If QueryString<>"" then LoadQueryString
'*** Impostazione Variabili ****
Server.ScriptTimeout = 500
Version = "2.0.3"
Autore = "Lorenzo Abbati - lorenzomail@tiscalinet.it"
WebServerFP = Request.ServerVariables("APPL_PHYSICAL_PATH")
CurrentPath = GetCurrentPath()
iTotalBytes = Request.TotalBytes
LogDelimiter = "|"
iPath = ""
iPathVirtual = True
iLogFolder = CurrentPath & "Logs\"
PathInclude = CurrentPath & "include\"
iAddInformationToLog = ""
LogName = Replace(Date(),"/","-") & ".log"
'*** Impostazione Parametri Utente ****
OverWrite = False
AutoRename = True
EnabledLog = False
BuildRecordset()
end sub
public property get TotalBytes()
TotalBytes = iTotalBytes
end property
private Sub LoadQueryString()
dim ar,elem,name,value
ar = split(QueryString,"&")
for each elem in ar
arV=split(elem,"=")
name = arV(0)
value = ""
if uBound(arV)>0 then value=arV(1)
form.add name,value
next
end sub
private Function BuildRecordset()
Rs.Fields.Append "sBinary" , adLongVarChar, -1
Rs.Fields.Append "bBinary" , adLongVarBinary,-1
Rs.Open
Files.Fields.append "InputName" ,adVarChar,255
Files.Fields.append "FileName" ,adVarChar,255
Files.Fields.append "DestPath" ,adVarChar,255
Files.Fields.append "Name" ,adVarChar,255
Files.Fields.append "Ext" ,adVarChar,255
Files.Fields.append "FileExists" ,adBoolean,1
Files.Fields.append "ContentType" ,adVarChar,255
Files.Fields.append "Size" ,adInteger,-1
Files.Fields.append "StreamType" ,adSmallInt,2
Files.Fields.append "Date" ,adDate,-1
Files.Fields.append "OverWrite" ,adBoolean,1
Files.Fields.append "AutoRename" ,adBoolean,1
Files.Fields.append "Cancel" ,adBoolean,1
Files.Fields.append "Saved" ,adBoolean,1
Files.Fields.append "ErrorNumber" ,adInteger,4
Files.Fields.append "Error" ,adVarChar,255
Files.Fields.append "Content" ,adLongVarBinary,-1
Files.Open
end function
'************************ Funzioni Principali ************************************************** **
Public Function Upload()
Dim PosBeg,PosEnd,PosFile,PosBound,Name,FileName,Conte ntType,StreamType,tmpName,Boundary
If EnabledLog then CreateFolder iLogFolder
If iTotalBytes>0 then
RequestBin = Request.BinaryRead(iTotalBytes)
PosBeg = 1:PosEnd = InstrB(PosBeg,RequestBin,c13b)
boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
boundaryLen = LenB(boundary)
boundaryPos = InstrB(1,RequestBin,boundary)
Do until (boundaryPos=InstrB(RequestBin,boundary & cEndBin)) and (Response.IsClientConnected=true)
Pos = InstrB(BoundaryPos,RequestBin,cContentDisp)
Pos = InstrB(Pos,RequestBin,cName):PosBeg=Pos+6
PosEnd = InstrB(PosBeg,RequestBin,c34b)
Name = GetString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
PosFile = InstrB(BoundaryPos,RequestBin,cFileName)
PosBound = InstrB(PosEnd,RequestBin,boundary)
If PosFile>0 AND (PosFile<PosBound) Then
'**** Estrazione di FileName ****
PosBeg = PosFile + 10
PosEnd = InstrB(PosBeg,RequestBin,c34b)
FileName = GetString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
if FileName<>"" then
'**** Estrazione di ContentType ****
Pos = InstrB(PosEnd,RequestBin,cContentType):PosBeg = Pos+14
PosEnd = InstrB(PosBeg,RequestBin,cVbCrLf)
ContentType = GetString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
'**** Impostazione di ContentType **
StreamType=1 : If InStr(ContentType,"text/")>0 then StreamType=2
tmpName = Right(FileName,Len(FileName)-InstrRev(FileName,"\"))
'**** Setting dell'ultima posizione **
PosBeg = PosEnd+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
Files.AddNew
Files("InputName") = Name
Files("FileName") = lCase(FileName)
Files("ext") = lCase(Right(tmpName,Len(tmpName)-InstrRev(tmpName,".")))
Files("Name") = lCase(Left(tmpName ,InstrRev(tmpName,".")-1))
Files("DestPath") = lCase(GetPath(iPath,iPathVirtual))
Files("ContentType") = ContentType
Files("Date") = Now()
Files("StreamType") = StreamType
Files("Cancel") = False
Files("Saved") = False
Files("OverWrite") = OverWrite
Files("AutoRename") = AutoRename
Files("FileExists") = fso.FileExists(Files("DestPath") & Files("Name") &"." &Files("ext") )
Files("Content").AppendChunk MidB(RequestBin,PosBeg,PosEnd-PosBeg+1)
Files("Size") = Files("Content").ActualSize
Files.Update
end if
else
'**** FORM ***
Pos = InstrB(Pos,RequestBin,c13b):
PosBeg = Pos+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
Form.add Name,GetString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
End if
BoundaryPos=InstrB(BoundaryPos+BoundaryLen,Request Bin,boundary)
Loop
MoveFirst
end if
End function
Public Function SaveAs(NewName)
Dim FolderDest,FileName
if Not Files.EOF then
If Not Files("Cancel") and Not Files("Saved") then
FolderDest = Files("DestPath")
If CreateFolderDest(FolderDest)=0 then
if NewName<>"" then FileName = SetNewName(NewName)
FileName = FolderDest & Files("Name") &"." & Files("ext")
If Files("AutoRename")=True then FileName = Rename(Files("Name"),Files("Ext"),-1)
Modules_Save FileName
If EnabledLog then SaveLog(LogName)
end if
end if
End if
end function
Public Function SaveInDB(byRef Rs,NameFieldBlob)
if Not Files.EOF then
If Not Files("Cancel") and Not Files("Saved") then
On error resume next
If TestError(err) then exit function
Rs(NameFieldBlob).AppendChunk Files("Content")
On error goto 0
end if
End if
End function
Public Function Save()
SaveAs("")
end function
Public Function SaveAll()
MoveFirst
While Not Files.EOF
SaveAs ""
MoveNext
Wend
end function
Public Function UploadAndSave()
Upload
SaveAll
end function
Public Function GetBinary()
if Not Files.EOF then
GetBinary = Files("Content")
else
GetBinary = chrB(0)
end if
end function
Public Function GetHTTPPathFile()
Dim s
GetHTTPPathFile=""
if Not Files.EOF then
s = Files("DestPath") & Files("Name")
s = Mid(s,Len(WebServerFP))
s = Replace(s,"\","/")
if Files("Ext")<>"" then s = s & "." & Files("Ext")
GetHTTPPathFile = s
end if
end function
Public Function GetCompletePathFile()
Dim s
GetCompletePathFile=""
if Not Files.EOF then
s = Files("DestPath") & Files("Name")
if Files("Ext")<>"" then s = s & "." & Files("Ext")
GetCompletePathFile = s
end if
end function
Public Function GetFileName()
GetFileName=""
if Not Files.EOF then
s = Files("Name")
if Files("Ext")<>"" then s = s & "." & Files("Ext")
GetFileName = s
end if
end function
Public Function SaveLog(Name)
dim i,nFields,s,FileName,TextFile
FileName = iLogFolder & Name
s= iAddInformationToLog
if s<>"" then s= s & LogDelimiter
s = Request.ServerVariables("REMOTE_ADDR") & LogDelimiter
nFields = Files.Fields.Count
For i=0 to nFields-2
if Not IsNull(Files(i).Value) then s = s & Files(i).Value
if i <> nFields then s = s & LogDelimiter
next
If Not Fso.FileExists (FileName) then
Set TextFile= Fso.CreateTextFile(FileName,True)
else
Set TextFile = Fso.OpenTextFile(FileName,8)
end if
TextFile.WriteLine s
TextFile.Close
Set TextFile = nothing
End function
Public Function SetLogFile(AddInformationToLog)
EnabledLog=True
iAddInformationToLog=AddInformationToLog
end function
Private Function SetPath(StringPath,IsVirtual)
iPath = Replace(StringPath,"/","\")
if Mid(iPath,Len(iPath),1)<>"\" then iPath = iPath