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

%>