<form action="Upload.asp" enctype="multipart/form-data" Method="Post">
<input type="text" name="DESC_FILE1">
<input type="File" name="FILE1">
<input type="text" name="DESC_FILE2">
<input type="File" name="FILE2">
<input type="Submit" Value="Invia Files">
</FORM>
il code di cui sopra a video restituisce tutti i pulsanti in italiano (Sfoglia, Invia Files), se volessi cambiare lingua (inglese, francese, tedesco, spagnolo, etc) è possibile?
PS per 'invia files' ok ma per 'sfoglia' ????
... Sono graditi codes, esempi pratici, suggerimenti, consigli e critiche...
"Ai posteri l'ardua sentenza..."
Tante grazie
Saluti
Luis 33
Si.
Dovresti avere qualche fonte dati o qualcosa comunque dovestanno memorizzati le label da mettere dinamicamente a seconda della lingua.
Adesso però ti chiedi, in base a quale criterio cambia la lingua?
esattamente !!!
i file che uso sono tre:
-la form di prima;
-lo script che scrive sul server;
-il file origine dati
sui primi due non ho trovato nulla riguardo al tuo suggerimento...
... Sono graditi codes, esempi pratici, suggerimenti, consigli e critiche...
"Ai posteri l'ardua sentenza..."
Tante grazie
Saluti
Luis 33
Si, però non ho capito come si fa a scegliere la lingua...
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
... Sono graditi codes, esempi pratici, suggerimenti, consigli e critiche...
"Ai posteri l'ardua sentenza..."
Tante grazie
Saluti
Luis 33
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
... Sono graditi codes, esempi pratici, suggerimenti, consigli e critiche...
"Ai posteri l'ardua sentenza..."
Tante grazie
Saluti
Luis 33
Private Function SetPath(StringPath,IsVirtual)
iPath = Replace(StringPath,"/","\")
if Mid(iPath,Len(iPath),1)<>"\" then iPath = iPath & "\"
iPathVirtual = IsVirtual
End function
Public Function SetPathVirtual(StringPath)
SetPath StringPath,True
end function
Public Function SetPathFile(StringPath)
SetPath StringPath,False
end function
Public Function SetServerTimeOut(Minutes)
Server.ScriptTimeout = Minutes * 60
end function
'************************ Funzioni su folder, path, file ************************************************** *******
Private sub Modules_Save(FileName)
Dim TextFile,TestOverWrite
select Case Files("StreamType")
Case 1
Stream.Type = Files("StreamType")
Stream.Open
Stream.Write Files("Content")
If TestError(err) then
exit sub
end if
on error resume next
Stream.SaveToFile FileName,GetOverValue(Files("OverWrite"))
If TestError(err) then
exit sub
end if
Stream.close
on error goto 0
Case 2
on error resume next
Set TextFile = Fso.CreateTextFile(FileName,Files("OverWrite"))
If TestError(err) then
exit sub
end if
TextFile.Write(BinaryToString(Files("Content")))
If TestError(err) then
exit sub
end if
TextFile.close
on error goto 0
end select
end sub
Private function TestError(byRef e)
TestError=False
If E.Number <> 0 then
Files("Error") = e.Description
Files("Saved") = False
TestError=True
else
Files("Saved") = true
end if
Files("ErrorNumber") = e.number
end function
Private function Rename (Name,ext,count)
Dim Dest,tMp
tMp = ""
if Count>-1 then tMp = "_" & cStr(Count)
Dest = Files("DestPath") & Files("Name") & tMp &"." & Files("ext")
If fso.fileExists(Dest) then
Count = Count + 1
Dest = Rename(Files("Name"),Files("Ext"),count)
else
Files("Name") = Name & tMp
Files("ext") = Ext
Files.update
end If
Rename = Dest
end function
Private function CreateFolderDest(FolderDest)
If Not Fso.FolderExists(FolderDest) then
on error resume next
fso.CreateFolder FolderDest
if err.number<>0 then
Files("ErrorNumber") = err.number
Files("Error") = err.Description
Files("Saved") = false
Files.MoveNext
end if
CreateFolderDest = err.number
Exit Function
on error goto 0
End if
CreateFolderDest = 0
End Function
Private Function CreateFolder(f)
If not Fso.FolderExists(f) then Fso.CreateFolder(f)
end function
Public Function GetCurrentPath()
Dim tMp
tMp = Request.ServerVariables("PATH_TRANSLATED")
GetCurrentPath = Mid(tMp,1,InStrRev(tMp,"\"))
End function
Private Function GetPath(Path,Virtual)
If Path<>"" then
If Virtual then
GetPath = WebServerFP & Path
else
GetPath = fso.GetAbsolutePathName(CurrentPath & Path) &"\"
end if
else
GetPath = CurrentPath
end if
end function
Public Function GetPathVirtual(Path)
GetPathVirtual = GetPath(Path,True)
end function
Public Function GetPathFile(Path)
GetPathFile = GetPath(Path,False)
end function
'************************ Conversioni String-Byte Byte-String ************************************************** **
Private Function GetString(StringBin)
getString =""
For intCount = 1 to LenB(StringBin)
getString = getString & chr(AscB(MidB(StringBin,intCount,1)))
Next
End Function
Private Function GetByteString(StringStr)
For i = 1 to Len(StringStr)
char = Mid(StringStr,i,1)
getByteString = getByteString & chrB(AscB(char))
Next
End Function
Private Function BinaryToString(xBinary)
Dim Binary,LBinary
If vartype(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
LBinary = LenB(Binary)
If LBinary>0 Then
RS.AddNew
RS("sBinary").AppendChunk Binary
RS.Update
BinaryToString = RS("sBinary")
Rs.Delete
Rs.Update
Else
BinaryToString = ""
End If
End Function
Private Function MultiByteToBinary(MultiByte)
Dim LMultiByte, Binary
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
RS.AddNew
RS("bBinary").AppendChunk MultiByte &chrB(0)
RS.Update
Binary = RS("bBinary").GetChunk(LMultiByte)
Rs.Delete
RS.Update
End If
MultiByteToBinary = Binary
End Function
'************************ Funzioni su Recodset Files ************************************************** ***************
Public Function MoveFirst()
On error resume next
Files.MoveFirst
on error goto 0
end function
Public Function MoveNext()
on error resume next
Files.MoveNext
on error goto 0
end function
Public Property Get EOF()
EOF = Files.EOF
end property
Public Function Cancel()
If Not Files.EOF then Files("Cancel")=True
end function
Public Function Delete()
If Not Files.EOF then
Files.Delete
Files.Update
end if
end function
Public Property Get Count
count = Files.RecordCount
end property
public Function Close()
on error resume next
Files.close
Rs.Close
on error goto 0
end function
'************************ Filtri Preimpostati ************************************************** ****************************
Public Property Let Filter(sFilter)
Files.Filter = sFilter
end Property
public sub FilterContentType(sMime,sType)
Files.Filter = "[ContentType] like '"& sMime & "/" & sType &"'"
end sub
Public sub FilterImage()
FilterContentType "image","*"
end sub
Public sub FilterAudio()
FilterContentType "audio","*"
end sub
Public sub FilterApplication()
FilterContentType "application","*"
end sub
Public sub FilterText()
FilterContentType "text","*"
end sub
Public sub FilterVideo()
FilterContentType "video","*"
end sub
'************************ Funzioni Varie ************************************************** ****************************
private Function SetNewName(NewName)
Dim Pos
Pos = InStrRev(NewName,".")
If Pos>0 then
Files("ext")=Mid(NewName,Pos+1,Len(NewName)-Pos)
Files("Name")=Left(NewName,Pos-1)
else
Files("Name")=NewName
Files("ext")=""
end if
End function
private Function GetOverValue(t)
Dim v
v=1:If t=True then v=2
GetOverValue=v
end function
'************************ Funzioni Print ************************************************** ****************************
Public Function GetTextFile(PathFile)
Dim f
If fso.FileExists(PathFile) then
Set f=Fso.OpenTextFile(PathFile,1)
GetTextFile = f.ReadAll
f.close
Set f= Nothing
else
GetTextFile = ""
Response.Write("<p style=""font-size:11;font-family:verdana"">File richiesto non trovato [" & PathFile &"]</p>")
end if
end function
Private Function WriteRecordset(byRef rRs,Title)
Dim f,StrTmp,nCol
nCol=1
nCol = rRs.Fields.count
Response.Write("<Table border=0 cellspacing=1 cellpadding=2 style=""background-color:silver;font-size:11;font-Family:verdana;width:100%""><tr><td style=""background-color:#B0C4DE;color:navy"" colSpan="""& nCol & """>" & Title &"</td></tr><tr>")
For each f in rRs.Fields
Response.Write("<td style="" background-color:#E0EEF8;color:navy;"">" & f.name & "</td>")
next
Response.Write("</tr>")
on error resume next
rRs.MoveFirst
on error goto 0
While Not rRs.EOF
Response.Write("<tr>")
For each f in rRs.Fields
If f.Name<>"Content" then
strTmp = Files(f.name)
else
strTmp=""
'strTmp = Server.HTMLEncode(BinaryToString(Files(f.name)))
end if
if StrTmp="" then strTmp =""
Response.Write("<td style="" background-color: #FFFFE0;"">" & strTmp & "</td>")
next
Response.Write("</tr>")
rRs.MoveNext
WEnd
Response.Write("<tr><td colspan=""" & nCol &""" style=""font-size:10;background-color:#E0EEF8;color:gray""><u>Altre Informazioni</u> Time:"& GetExecuteTime()&" sec. - Log Attivo:"& EnabledLog &"["&LogName &"] - OverWrite:" & OverWrite & " - AutoRename:" & AutoRename & " - Filtri:" & Files.Filter &" - iTotalBytes:" & iTotalBytes&"</td></tr>")
Response.Write("</Table>
")
'on error goto 0
end function
public sub Credits()
Buffer = GetTextFile(CurrentPath & "credits.htm")
Response.Write(Buffer)
end sub
public sub PrintMimeTypes()
Dim Buffer
Buffer = GetTextFile(PathInclude & "mimetypes.htm")
Response.Write(Buffer)
end sub
Public Function PrintForm()
dim i,n,arK,arI
arK = form.Keys
arI = form.items
Response.Write("<Table border=0 cellspacing=1 cellpadding=2 style=""background-color:silver;font-size:11;font-Family:verdana""><tr><td style=""background-color:#B0C4DE;color:navy"" colSpan=""2"">.: Contenuto dell'oggetto FORM :.</td></tr><tr>")
Response.Write("<td style="" background-color:#E0EEF8;color:navy;"">Name</td><td style="" background-color:#E0EEF8;color:navy;"">Value</td></tr>")
for i=0 to Form.Count -1
Response.Write("<td style="" background-color: #FFFFE0;"">" &arK(i) &"</td><td style="" background-color: #FFFFE0;"">" & arI(i) &"</td></tr>")
next
Response.Write("</Table>
")
end function
Public Function GetExecuteTime()
GetExecuteTime = Timer() - InitTime
end function
Public Function PrintStatus(Title)
WriteRecordset Files,Title
end function
'************************ Terminate *************
Private Sub Class_Terminate()
Close()
Set Stream = nothing
Set Files = nothing
Set Fso = nothing
Set Rs = nothing
Set Form = nothing
end sub
End Class
%>
... Sono graditi codes, esempi pratici, suggerimenti, consigli e critiche...
"Ai posteri l'ardua sentenza..."
Tante grazie
Saluti
Luis 33
Non credo si possa modificare "Sfoglia". Tieni conto però che come a un utente che ha un browser in lingua italiana viene scritto "Sfoglia" ad utente con un browser in lingua inglese uscirà un pulsante con scritto "Browse", etc...
I don't wanna have to shout it out / I don't want my hair to fall out
I don't wanna be filled with doubt / I don't wanna be a good boy scout
I don't wanna have to learn to count / I don't wanna have the biggest amount
I don't wanna grow up
Giustissimo!Non credo si possa modificare "Sfoglia". Tieni conto però che come a un utente che ha un browser in lingua italiana viene scritto "Sfoglia" ad utente con un browser in lingua inglese uscirà un pulsante con scritto "Browse", etc...
Sono legati alla lingua del browser.
Ciao
Lele
Emanuele Boccaletti
_____________________________________
www.i23.eu
emanuele@i23.eu
Permessi di invio
Rispondi quotando