<%
' Fruibile - L'elemento CMS Open Source che mancava
' Copyright (C) 2002-2006 Roberto Scano
'
' Licensed under the terms of the GNU Lesser General Public License:
' http://www.opensource.org/licenses/lgpl-license.php
'
' For further information visit:
' http://www.fruibile.it/
'
' File Author:
' Roberto Scano (mail@robertoscano.info)
%>
<%
'' This code is absolute freeware. you can do with it as you please.
'' There are no restrictions what so ever, but the code is AS IS, no warrenty or liabilty
'' Please leave these commentlines intact
'' Netherlands, February 2004
'' M.Blokdijk
'' maarten@blokdijk.com
'' V 1.0
'controllo sicurezza --------------
if Session("WEBGODLogin") <> "W3C_VALIDATOR" then
If session("argomenti")<> 1 Then
response.Redirect "/backoffice/noentry.asp"
end if
end if
'----------------------------------
'Prevent your website from cross website attacks ---------
refererUrl = Cstr(Request.ServerVariables("HTTP_REFERER"))
serverName = Cstr(Request.ServerVariables("SERVER_NAME"))
refererName = mid(refererUrl,8,len(serverName))
if refererName <> serverName then
response.Redirect "/backoffice/noentry.asp"
response.end
end if
'---------------------------------------------------------
if Request("Back") <> "" then
response.redirect Session("lastpage")
end if
Sub EditDb
'On error resume next
If fs.FileExists(server.mappath(dbfile)) Then
Response.Redirect dbfile & "?db=" & sFile
Else
Response.Write "" & DICLanguage(276) & DICLanguage(0) & "
" &vbCrLf
End If
End Sub
Sub CreateNewFolder
'CREAZIONE NUOVA CARTELLA
%>
<%=DICLanguage(270)%>
<%
End Sub
Sub EditFile
'MODIFICA DOCUMENTO
response.write "" & DICLanguage(104) & "
"
Session("lastpage") = Request.ServerVariables("HTTP_REFERER")
Set ReadStream = fs.OpenTextFile(server.mappath(sFile))
filename=request.querystring("file")
Response.write "" & DICLanguage(278) & ": "
response.write ""&filename&"
"
If ucase(sFileType) = "JPG" OR ucase(sFileType) = "GIF" OR ucase(sFileType) = "PNG" or ucase(sFileType)="JPEG" Then
Response.Write "![]()
"
end if
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath(request("path")) & "\Description.xml"
If Not objDoc.load(descpath) Then
objDoc.loadXML ""
else
For Each objNode In objDoc.selectNodes("/Folder/File")
if lcase(objNode.attributes.getNamedItem("name").Text) = lcase(filename) then
contenuto = objNode.attributes.getNamedItem("description").Text
end if
next
End If
Set objDoc = Nothing
Set objNode = Nothing
Response.Write "" &vbCrLf
End Sub
Sub UploadFiles
'TRASFERISCI DOCUMENTI
Session("lastpage") = Request.ServerVariables("HTTP_REFERER")
%>
<%=DicLanguage(271)%>
<%=DICLanguage(281)%>: <%=spath%>
<%=DICLanguage(282)%><%=DICLanguage(0)%>
<%
End Sub
Sub CreateFile
'CREA DOCUMENTO
' response.write "" & DICLanguage(128) & "
"
' Session("lastpage") = Request.ServerVariables("HTTP_REFERER")
' Response.Write "" &vbCrLf
End Sub
Sub SaveFile
'SALVA DOCUMENTO
response.write "" & DICLanguage(383) & "
"
Dim objDoc
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath(spath) & "\Description.xml"
If Not objDoc.load(descpath) Then
objDoc.loadXML ""
Set objElt = objDoc.createElement("File")
Set objAttr = objDoc.createAttribute("name")
objAttr.Text = request("file")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'create attribute: description
Set objAttr = objDoc.createAttribute("description")
objAttr.Text = Request("Description")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'add this element to root node
objDoc.documentElement.appendChild objElt
objDoc.save descpath
set objElt = nothing
set objAttr = nothing
else
Set objNode = objDoc.selectSingleNode("/Folder/File[@name = '" & request("file") & "']")
If Not objNode Is Nothing Then
objNode.attributes.getNamedItem("description").text = Request("Description").Item
objDoc.save descpath
else
Set objElt = objDoc.createElement("File")
Set objAttr = objDoc.createAttribute("name")
objAttr.Text = request("file")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'create attribute: description
Set objAttr = objDoc.createAttribute("description")
objAttr.Text = Request("Description")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'add this element to root node
objDoc.documentElement.appendChild objElt
objDoc.save descpath
set objElt = nothing
set objAttr = nothing
End If
end if
Set objDoc = Nothing
Set objNode = Nothing
Response.Redirect("" & Session("lastpage") & "")
End Sub
Sub CreateFolder
'CREAZIONE CARTELLA
response.write "" & DICLanguage(270) & "
"
Session("lastpage") = request.querystring("path")
If fs.FolderExists(server.mappath(sFolder)) Then
response.write "" & replace(DICLanguage(287),"[CARTELLA]","" & sFolder & "") & DICLanguage(0) & "
"
Else
fs.CreateFolder(server.mappath(sFolder))
Dim objDoc
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath(session("lastpage")) & "\Description.xml"
If Not objDoc.load(descpath) Then
objDoc.loadXML ""
Set objElt = objDoc.createElement("File")
Set objAttr = objDoc.createAttribute("name")
objAttr.Text = request("folder")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'create attribute: description
Set objAttr = objDoc.createAttribute("description")
objAttr.Text = Request("Description")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'add this element to root node
objDoc.documentElement.appendChild objElt
objDoc.save descpath
set objElt = nothing
set objAttr = nothing
else
Set objNode = objDoc.selectSingleNode("/Folder/File[@name = '" & request("folder") & "']")
If Not objNode Is Nothing Then
objNode.attributes.getNamedItem("description").text = Request("Description").Item
objDoc.save descpath
else
Set objElt = objDoc.createElement("File")
Set objAttr = objDoc.createAttribute("name")
objAttr.Text = request("folder")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'create attribute: description
Set objAttr = objDoc.createAttribute("description")
objAttr.Text = Request("Description")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'add this element to root node
objDoc.documentElement.appendChild objElt
objDoc.save descpath
set objElt = nothing
set objAttr = nothing
End If
end if
Set objDoc = Nothing
Set objNode = Nothing
response.redirect("default.asp?action=viewfolder&path="&session("lastpage")& "&mnu=" & request("mnu") & "&submnu=" & request("submnu"))
End If
End Sub
Sub DeleteFile
'ELIMINAZIONE FILE
response.write "" & DICLanguage(384) & "
"
If Request.Querystring("commit") <> "yes" Then
Session("lastpage") = Request.ServerVariables("HTTP_REFERER")
Session("sFile") = sFile
Response.Write "" & replace(DICLanguage(288),"[NOMEDOC]","" & sFile & "") & DICLanguage(0) & "
"
If ucase(sFileType) = "JPG" OR ucase(sFileType) = "GIF" OR ucase(sFileType) = "PNG" OR ucase(sFileType) = "JPEG" Then
Response.Write "![]()
"
End If
Response.Write ""& DICLanguage(290) & "
"
Response.Write ""
Else
fs.DeleteFile(server.mappath(Session("sFile")))
Dim objDoc
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath(request("path")) & "\Description.xml"
If Not objDoc.load(descpath) Then
objDoc.loadXML ""
else
Set objNode = objDoc.selectSingleNode("/Folder/File[@name = '" & request("filex") & "']")
If Not objNode Is Nothing Then
objNode.parentNode.removeChild objNode
objDoc.save descpath
End If
end if
Set objDoc = Nothing
Set objNode = Nothing
Response.Redirect("" & Session("lastpage") & "")
End If
End Sub
Sub DeleteFolder
'ELIMINAZIONE CARTELLA
response.write "" & DICLanguage(385) & "
"
If Request.Querystring("commit") <> "yes" Then
Session("lastpage") = Request.ServerVariables("HTTP_REFERER")
Session("sFolder") = sFolder
Response.Write "" & replace(DICLanguage(291),"[CARTELLA]","" & sFolder & "") & DICLanguage(0) & "
"
Response.Write ""& DICLanguage(290) & "
"
Response.Write ""
Else
fs.DeleteFolder(server.mappath(Session("sFolder")))
Dim objDoc
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath(spath) & "\Description.xml"
If Not objDoc.load(descpath) Then
objDoc.loadXML ""
else
Set objNode = objDoc.selectSingleNode("/Folder/File[@name = '" & request("folderx") & "']")
If Not objNode Is Nothing Then
objNode.parentNode.removeChild objNode
objDoc.save descpath
End If
end if
Set objDoc = Nothing
Set objNode = Nothing
Response.Redirect("" & Session("lastpage") & "")
End If
End Sub
Sub RenameFolder
'RINOMINARE CARTELLA
response.write "" & DICLanguage(292) & "
"
If Request.querystring("commit") <> "yes" Then
Session("lastpage") = Request.ServerVariables("HTTP_REFERER")
Response.Write "" & replace(DICLanguage(293),"[CARTELLA]","" & request.querystring("folder") & "") & DICLanguage(0) & "
"
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath(request("path")) & "\Description.xml"
If Not objDoc.load(descpath) Then
objDoc.loadXML ""
else
For Each objNode In objDoc.selectNodes("/Folder/File")
if lcase(objNode.attributes.getNamedItem("name").Text) = lcase(request("folder")) then
contenuto = objNode.attributes.getNamedItem("description").Text
end if
next
End If
Set objDoc = Nothing
Set objNode = Nothing
%>
<%
Else
NewFolderName=request.form("NewFolderName")
sFolder=request.form("folder")
if spath="/" then slashvalue="" else slashvalue="/" end if
if right(spath,1) = "/" then slashvalue="" end if
if len(NewFolderName) > 0 then
Set fso = CreateObject("Scripting.FileSystemObject")
Set folderObject = fso.GetFolder(Server.MapPath(spath&slashvalue&sFolder))
FolderObject.Name=NewFolderName
Set folderObject = Nothing
Set fso = Nothing
end if
Dim objDoc
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath(request("path")) & "\Description.xml"
If Not objDoc.load(descpath) Then
objDoc.loadXML ""
Set objElt = objDoc.createElement("File")
Set objAttr = objDoc.createAttribute("name")
objAttr.Text = request("NewFolderName")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'create attribute: description
Set objAttr = objDoc.createAttribute("description")
objAttr.Text = Request("Description")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'add this element to root node
objDoc.documentElement.appendChild objElt
objDoc.save descpath
set objElt = nothing
set objAttr = nothing
else
Set objNode = objDoc.selectSingleNode("/Folder/File[@name = '" & request("folder") & "']")
If Not objNode Is Nothing Then
objNode.attributes.getNamedItem("description").text = Request("Description").Item
objNode.attributes.getNamedItem("name").text = request("NewFolderName").Item
objDoc.save descpath
else
Set objElt = objDoc.createElement("File")
Set objAttr = objDoc.createAttribute("name")
objAttr.Text = request("NewFolderName")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'create attribute: description
Set objAttr = objDoc.createAttribute("description")
objAttr.Text = Request("Description")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'add this element to root node
objDoc.documentElement.appendChild objElt
objDoc.save descpath
set objElt = nothing
set objAttr = nothing
End If
end if
Set objDoc = Nothing
Set objNode = Nothing
Response.Redirect("" & Session("lastpage") & "")
End If
End Sub
Sub RenameFile
'RINOMINA FILE
response.write "" & DICLanguage(295) & "
"
If Request("commit") <> "yes" Then
Session("lastpage") = Request.ServerVariables("HTTP_REFERER")
Response.Write "" & replace(DICLanguage(296),"[NOMEDOC]","" & request.querystring("file") & "") & DICLanguage(0) & "
"
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath(request("path")) & "\Description.xml"
If Not objDoc.load(descpath) Then
objDoc.loadXML ""
else
For Each objNode In objDoc.selectNodes("/Folder/File")
if lcase(objNode.attributes.getNamedItem("name").Text) = lcase(request("file")) then
contenuto = objNode.attributes.getNamedItem("description").Text
end if
next
End If
Set objDoc = Nothing
Set objNode = Nothing
%>
<%
Else
NewFileName=request.form("NewFileName")
Sfile=request.form("filename")
if spath="/" then slashvalue="" else slashvalue="/"
if right(spath,1) = "/" then slashvalue="" end if
Set fso = CreateObject("Scripting.FileSystemObject")
Set FileObject = fso.GetFile(Server.MapPath(spath&slashvalue&sfile))
FileObject.Name = NewFileName
Dim objDoc
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath(request("path")) & "\Description.xml"
If Not objDoc.load(descpath) Then
objDoc.loadXML ""
Set objElt = objDoc.createElement("File")
Set objAttr = objDoc.createAttribute("name")
objAttr.Text = request("NewFileName")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'create attribute: description
Set objAttr = objDoc.createAttribute("description")
objAttr.Text = Request("Description")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'add this element to root node
objDoc.documentElement.appendChild objElt
objDoc.save descpath
set objElt = nothing
set objAttr = nothing
else
Set objNode = objDoc.selectSingleNode("/Folder/File[@name = '" & request("filename") & "']")
If Not objNode Is Nothing Then
objNode.attributes.getNamedItem("description").text = Request("Description").Item
objNode.attributes.getNamedItem("name").text = request("NewFileName").Item
objDoc.save descpath
else
Set objElt = objDoc.createElement("File")
Set objAttr = objDoc.createAttribute("name")
objAttr.Text = request("NewFileName")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'create attribute: description
Set objAttr = objDoc.createAttribute("description")
objAttr.Text = Request("Description")
'add attribute to element
objElt.Attributes.setNamedItem (objAttr)
'add this element to root node
objDoc.documentElement.appendChild objElt
objDoc.save descpath
set objElt = nothing
set objAttr = nothing
End If
end if
Set objDoc = Nothing
Set objNode = Nothing
Set FilObject = Nothing
Set fso = Nothing
Response.Redirect("" & Session("lastpage") & "")
End If
End Sub
Sub FileTypeUnsupported
'TIPO FILE NON SUPPORTATO
response.write "" & DICLanguage(386) & "
"
Session("lastpage") = Request.ServerVariables("HTTP_REFERER")
filename=request.querystring("file")
Response.write "" & DICLanguage(298) & ": "
response.write ""&filename&"
"
If ucase(sFileType) = "JPG" OR ucase(sFileType) = "GIF" OR ucase(sFileType) = "PNG" or ucase(sFileType)="JPEG" Then
Response.Write "![]()
"
else
Response.Write "" & replace(DICLanguage(299),"[TIPODOC]", sfiletype) & " " & DICLanguage(300) & "" & DICLanguage(0) & "
"
End If
Response.Write "" & DICLanguage(2) & "" & DICLanguage(0) & "
"
End Sub
Sub Size(itemsize)
Response.Write "" &vbCrLf
Select case Len(itemsize)
Case "1"
if itemsize <= 1 then
Response.Write "1 "
if ucase(Session("Language")) <> "EN" then
response.write "byte"
else
response.write "byte"
end if
else
if ucase(Session("Language")) <> "EN" then
Response.Write itemsize & " bytes"
else
Response.write itemsize & " bytes"
end if
end if
Case "2", "3"
if ucase(Session("Language")) <> "EN" then
Response.Write itemsize & " bytes"
else
Response.write itemsize & " bytes"
end if
Case "4", "5", "6"
if ucase(Session("Language")) <> "EN" then
if firstkb <> 1 then
Response.Write Round(itemsize/1000) & " Kb"
firstkb = 1
else
Response.write Round(itemsize/1000) & " Kb"
end if
else
if firstkb <> 1 then
response.write Round(itemsize/1000) & " Kb"
firstkb = 1
else
Response.write Round(itemsize/1000) & " Kb"
end if
end if
Case "7", "8", "9"
if ucase(Session("Language")) <> "EN" then
if firstmb <> 1 then
Response.Write Round(itemsize/1000000) & " Mb"
firstmb = 1
else
Response.write round(itemsize/1000000) & " Mb"
end if
else
if firstmb <> 1 then
Response.write Round(itemsize/1000000) & " Mb"
firstmb = 1
else
Response.write Round(itemsize/1000000) & " Mb"
end if
end if
End Select
Response.Write " | " &vbCrLf
End Sub
Sub ShowList
'INIZIA VISUALIZZAZIONE
'------------------------------------
response.write "" & DICLanguage(388) & "
"
%>
| <%=DICLanguage(32)%> |
<%=DICLanguage(303)%> |
<%=DICLanguage(124)%> |
<%=DICLanguage(233)%> |
<%=DICLanguage(304)%> |
<%
' Use the GetFolder method of the filesystemobject to get the contents of the directory specified in sPath
Set fileobject = fs.GetFolder(server.mappath(sPath))
' Use the SubFolders property to get the folders contained in the directory specified in sPath
Set foldercollection = fileobject.SubFolders
' Start the code to alternate line colors - just to make the display a little less visually confusing.
lineid=0
bgcolor = ""
bgcolor_off = "colore1" '"#FFFFFF"
bgcolor_on = "colore2" '"#f0f0f0"
' Loop through the folders contained in the foldercollection and display their information on the page
For Each folder in foldercollection
if UCase(Right(folder.name,10)) <> "THUMBNAILS" then
' Apply our alternating line coloring
If lineid = 0 Then
bgcolor = bgcolor_off
lineid = 1
Else
bgcolor = bgcolor_on
lineid = 0
End if
Response.Write "" &vbCrLf
If Right(sPath,1)="/" Then
'NOME DEL FILE
Response.Write "![]() " & folder.name & " | " & vbCrLf
Else
Response.Write "![]() " & folder.name & " | " & vbCrLf
End If
'TIPO FILE
'Response.Write "" & DICLanguage(305) & " | "
'DIMENSIONI FILE
Call Size(folder.size)
'ULTIMO ACCESSO FILE
Response.Write "" & day(folder.datelastmodified) & "/" & month(folder.datelastmodified) & "/" & year(folder.datelastmodified) & " - " & formatdatetime(folder.datelastmodified,3) & " | " &vbCrLf
'DESCRIZIONE ALTERNATIVA
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath(spath) & "\Description.xml"
If Not objDoc.load(descpath) Then
objDoc.loadXML ""
Response.Write "Nessuna | " &vbCrLf
else
Response.Write ""
For Each objNode In objDoc.selectNodes("/Folder/File")
if lcase(objNode.attributes.getNamedItem("name").Text) = lcase(folder.name) then
response.write objNode.attributes.getNamedItem("description").Text
end if
next
response.write " | " &vbCrLf
End If
Set objDoc = Nothing
Set objNode = Nothing
'OPZIONI
Response.Write "" & DICLanguage(292) & " | " & DICLanguage(267) & " | " &vbCrLf
Response.Write "
" &vbCrLf
end if
Next
Set foldercollection=nothing
' Use the Files property to get the files contained in the directory specified in sPath
Set filecollection = fileobject.Files
' Loop through the files contained in the filescollection and dislay their information on the page
For Each file in filecollection
Select Case UCase(fs.GetExtensionName(file.name))
Case "GIF","JPG", "PNG", "JPEG"
' Apply our alternating line coloring
If lineid = 0 Then
bgcolor = bgcolor_off
lineid = 1
Else
bgcolor = bgcolor_on
lineid = 0
End if
Response.Write "" &vbCrLf
%>
<%
if lcase(fs.GetExtensionName(file.name))="gif" then image="![]()
"
if lcase(fs.GetExtensionName(file.name))="jpg" then image="![]()
"
if lcase(fs.GetExtensionName(file.name))="png" then image="![]()
"
if lcase(fs.GetExtensionName(file.name))="jpeg" then image="![]()
"
if image="" then image= "![]()
"
'NOME FILE
Response.Write ""&image&" " & file.name & " | " &vbCrLf
image=""
'TIPO
'Response.Write "" & fs.GetExtensionName(file.name) & " | " &vbCrLf
'DIMENSIONI
Call Size(file.size)
'ULTIMO ACCESSO
Response.Write "" & day(file.datelastmodified) & "/" & month(file.datelastmodified) & "/" & year(file.datelastmodified) & " - " & formatdatetime(file.datelastmodified,3) & " | " &vbCrLf
'DESCRIZIONE ALTERNATIVA
Set objDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
objDoc.async = False
descpath = Server.mapPath(spath) & "\Description.xml"
If Not objDoc.load(descpath) Then
objDoc.loadXML ""
Response.Write "Nessuna | " &vbCrLf
else
Response.Write ""
For Each objNode In objDoc.selectNodes("/Folder/File")
if lcase(objNode.attributes.getNamedItem("name").Text) = lcase(file.name) then
response.write objNode.attributes.getNamedItem("description").Text
end if
next
response.write " | " &vbCrLf
End If
Set objDoc = Nothing
Set objNode = Nothing
'AZIONI
Response.Write "" & DICLanguage(295) & " | " & DICLanguage(267) & " | " &vbCrLf
Response.Write "
" &vbCrLf
case else
end select
Next
' We are done displaying information about files and folders in this directory, so close the table.
Response.Write "" &vbCrLf
Response.Write "
" &vbCrLf
End Sub
Sub DisplayErrors
Response.Write "![]()
" & vbcrlf
Response.Write "" & errorcode & DICLanguage(0) & "