<!--
 * 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)
-->
<%@ LANGUAGE=VBScript ENABLESESSIONSTATE=True %>
<%
Option Explicit

Rem -----------------------------------------------------------------------------------------
Rem - ************************************** IMPORTANT **************************************
Rem -
Rem - If you are having problems getting this or other Web Services to work, the most likely
Rem - cause is security settings.  This Web Service runs in the security context of IIS - in
Rem - other words, it does not have many rights.  Make sure file permissions on this ASP file,
Rem - XLibrary.dll and MSXML2.dll are set to Everyone.
Rem -
Rem - ************************************** IMPORTANT **************************************
Rem -----------------------------------------------------------------------------------------


Dim strLibraryFolder 'The root folder where uploaded attachments should be saved.
Dim strBaseURL 'Base URL to create for files. Relative URLs are okay, for example: "docs/"
Dim strLogFile 'Log file for errors or debug information.  Can be a template like "%Y-%m-%d.log" where %Y is 4 digit year, %m is 2 digit month and %d is 2 digit day.  This will produce a log file like "2003-12-29.log".
Dim strConfigFile 'Path to config file
Dim strTempFolder 'Temp folder to stored received packets.
Dim strAcceptedFileTypes 'A list of accepted file extensions.
Dim lngMaxUploadSize 'Maximum file upload size
Dim boolGetDateLastModified 'Provide the last modified date for files.  For large libraries, turning this off can improve performance.
Dim boolGetFileSize 'Provide file size. For large libraries, turning this off can improve performance.
Dim boolLibraryBrowseEnabled 'Enable the ablity to browse this library
Dim boolLibrarySearchEnabled 'Enabled the ability to search this library. You'll need to customize the search feature to meet your CMS needs.
Dim boolLibraryUploadToRootContainerEnabled 'Enable the ability to upload files to root folder.
Dim boolLibraryUploadToSubContainerEnabled 'Enable the ability to upload files to a sub folder.
Dim boolLibraryUploadReplaceEnabled 'Enable the ability to replace file when uploading.
Dim boolDebug 'Used to turn debuging on or off.  This is a boolean value.
Dim strAuthorizationCode 'An authorization code used to restrict access to this Web Service. You get this code from your account on the xstandard.com Web site.


Rem -----------------------------------------------------------------------------------------
Rem - ************************* OPTIONAL - CHANGE THESE SETTINGS ****************************
Rem -----------------------------------------------------------------------------------------
strLibraryFolder = Server.MapPath("\files") & "\" & Session("OfficePath") & "\" & Session("USER_ID") & "\"
strBaseURL = "/files/" & Session("OfficePath") & "/" & Session("USER_ID") & "/"
strLogFile = Server.MapPath("\files") & "\" & Session("OfficePath") & "\" & Session("USER_ID") & "\x%Y-%m-%d.log"
strConfigFile = Server.MapPath("attachmentlibrary.config")
strTempFolder = Server.MapPath("\files") & "\temp\"
strAcceptedFileTypes = "txt zip pdf doc rtf tar ppt xls xml xsl xslt swf gif jpeg jpg png bmp"
lngMaxUploadSize = 2048000
boolGetDateLastModified = True
boolGetFileSize = True
boolLibraryBrowseEnabled = True
boolLibrarySearchEnabled = False
boolLibraryUploadToRootContainerEnabled = True
boolLibraryUploadToSubContainerEnabled = True
boolLibraryUploadReplaceEnabled = True
boolDebug = False
strAuthorizationCode = ""
Rem -----------------------------------------------------------------------------------------
Rem - ************************* OPTIONAL - CHANGE THESE SETTINGS ****************************
Rem -----------------------------------------------------------------------------------------


Rem -----------------------------------------------------------------------------------------
Rem - Purpose:	Library Web Service
Rem - 
Rem - Input:	SOAP
Rem - Output:	SOAP
Rem -
Rem - Note:		This script requires the following dll's to be registered on the server:
Rem -			- XDirectory.dll  - use for processing the SOAP message
Rem -			- MSXML4.dll - XML parser
Rem -
Rem -
Rem - Copyright (c) 2004 Belus Technology Inc.  All rights reserved.
Rem -----------------------------------------------------------------------------------------

Rem -----------------------------------------------------------------------------------------
Rem - Declare
Rem -----------------------------------------------------------------------------------------
Dim objSOAPServer, objConfig, objNode, dictFolderIndex, dictFileIndex, objFS, _
	objAttributes, objProperties, strRootFilePath, strRootFolderPath, strLang, strPath, _
	boolUsingNewBaseURL, strTemp, boolAdd, strLabel, boolEmpty, strIcon, strURL, _
	varFolder, varFile, strName, strCSSClass, boolNewWindow, strTitle, _
	varAcceptedFileTypes, strSearchFor, strFilterBy

Rem -----------------------------------------------------------------------------------------
Rem - Initialize
Rem -----------------------------------------------------------------------------------------
Set objSOAPServer = Server.CreateObject("XLibrary.SOAPServer")
objSOAPServer.LogFile = strLogfile
objSOAPServer.TempFolder = strTempFolder
objSOAPServer.LibraryFolder = strLibraryFolder
objSOAPServer.LibraryBaseURL = strBaseURL
objSOAPServer.MaxUploadSize = lngMaxUploadSize
objSOAPServer.LibraryBrowseEnabled = boolLibraryBrowseEnabled
objSOAPServer.LibrarySearchEnabled = boolLibrarySearchEnabled
objSOAPServer.LibraryUploadToRootContainerEnabled = boolLibraryUploadToRootContainerEnabled
objSOAPServer.LibraryUploadToSubContainerEnabled = boolLibraryUploadToSubContainerEnabled
objSOAPServer.LibraryUploadReplaceEnabled = boolLibraryUploadReplaceEnabled
objSOAPServer.AddAcceptedObjectType "file", False, Split(strAcceptedFileTypes, " ")
objSOAPServer.AddAcceptedObjectType "folder", True, Array()
objSOAPServer.Debug = boolDebug

strRootFilePath = strLibraryFolder
strRootFolderPath = strLibraryFolder

varAcceptedFileTypes = Split(LCase(strAcceptedFileTypes), " ")


Private Function BuildPath(ByVal sPath1, ByVal sPath2)
	Dim strPath1, strPath2
	
	strPath1 = Trim(sPath1)
	strPath2 = Trim(sPath2)

	If Len(strPath2) = 0 Then
		BuildPath = sPath1
		Exit Function
	End If

	If Right(strPath1, 1) = "/" Or Right(strPath1, 1) = "\" Then
		sPath1 = Left(strPath1, Len(strPath1) - 1)
	End If
	
	If Left(strPath2, 1) = "/" Or Left(strPath2, 1) = "\" Then
		sPath2 = Mid(strPath2, 2)
	End If
	
	BuildPath = strPath1 & "/" & strPath2
End Function

Private Function XSURLEncode(ByVal sText)
	Dim varParts, strTemp, i
	varParts = Split(sText, ".")
	For i = 0 To UBound(varParts)
		strTemp = Server.URLEncode(varParts(i))
		strTemp = Replace(strTemp, "+", "%20")
		strTemp = Replace(strTemp, "%2D", "-")
		strTemp = Replace(strTemp, "%5F", "_")
		varParts(i) = strTemp
	Next
	XSURLEncode = Join(varParts, ".")
End Function

Private Function IsAcceptedFileType(ByVal sName)
	Dim i, varItem, strExt, boolAccepted
	
	boolAccepted = False
	varAcceptedFileTypes = Split(strAcceptedFileTypes, " ")
	i = InStrRev(strName, ".")
	
	If i > 0 Then
		strExt = LCase(Mid(strName, i + 1))
	Else
		strExt = ""
	End If
	
	For Each varItem In varAcceptedFileTypes
		If strExt = varItem Or varItem = "*" Then
			boolAccepted = True
			Exit For
		End If
	Next
	
	IsAcceptedFileType = boolAccepted
End Function

Private Function ISODateTime(ByVal dtDate)
    ISODateTime = ISODate(dtDate) & " " & ISOTime(dtDate)
End Function

Private Function ISODate(ByVal dtDate)
    Dim strYear, strMonth, strDay
    
    strYear = DatePart("yyyy", dtDate)
    strMonth = DatePart("m", dtDate)
    strDay = DatePart("d", dtDate)
    If Len(strMonth) = 1 Then
        strMonth = "0" & strMonth
    End If
    If Len(strDay) = 1 Then
        strDay = "0" & strDay
    End If
    ISODate = strYear & "-" & strMonth & "-" & strDay
End Function

Private Function ISOTime(ByVal dtDate)
    Dim strHours, strMinutes, strSeconds
    
    strHours = DatePart("h", dtDate)
    strMinutes = DatePart("n", dtDate)
    strSeconds = DatePart("s", dtDate)
    If Len(strHours) = 1 Then
        strHours = "0" & strHours
    End If
    If Len(strMinutes) = 1 Then
        strMinutes = "0" & strMinutes
    End If
    If Len(strSeconds) = 1 Then
        strSeconds = "0" & strSeconds
    End If
    ISOTime = strHours & ":" & strMinutes & ":" & strSeconds
End Function

Rem -----------------------------------------------------------------------------------------
Rem - Process SOAP message
Rem -----------------------------------------------------------------------------------------
If Request.ServerVariables("REQUEST_METHOD").Item = "POST" Then
	'Check authorization code
	If Len(strAuthorizationCode) > 0 Then
		If Len(Request.ServerVariables("HTTP_X_LICENSE_ID").Item) = 0 Then
			objSOAPServer.RaiseError "No authorization code set. Please contact your System Administrator."
		Else
			If Request.ServerVariables("HTTP_X_LICENSE_ID").Item <> strAuthorizationCode Then
				objSOAPServer.RaiseError "Invalid authorization code. Please contact your System Administrator."
			End If
		End If
	End If
	

	'Process Request
	objSOAPServer.ProcessRequest Request
	
	If Len(CStr(Session("WEBGODLogin"))) = 0 Then
		If objSOAPServer.GetProperty("lang") = "it" Then
			objSOAPServer.RaiseError "Non possiedi le autorizzazioni necessarie per utilizzare il servizio."
		Else
			objSOAPServer.RaiseError "Please login to use this service."
		End If
	End If
	
	'Depending on the request, pass data to the SOAP server
	If objSOAPServer.Action = "doLibraryDescribe" Then
		'Get the library name from config file
		Set objConfig = Server.CreateObject("MSXML2.DOMDocument.4.0")
		objConfig.async = False
		strLang = "en"
		If objConfig.Load(strConfigFile) Then
			Set objNode = objConfig.SelectSingleNode("/library/name[lang('" & strLang & "') or string(@xml:lang) = '']")
			If Not objNode Is Nothing Then
				objSOAPServer.LibraryName = objNode.Text
			End If
		Else
			objSOAPServer.RaiseError "Failed to load config file."
			objSOAPServer.LogToFile "Failed to load config file: " & strConfigFile
			objSOAPServer.ProcessResponse Response
			Response.End
		End If
		
		If boolLibrarySearchEnabled Then
			Rem -----------------------------------------------------------------------------------------
			Rem - ADD CUSTOM CODE HERE
			Rem - 
			Rem - Use method like:
			Rem - objSOAPServer.AddSearchFilter sID As String, sLabel As String
			Rem -----------------------------------------------------------------------------------------
			objSOAPServer.AddSearchFilter "", "(nessun filtro)"
			objSOAPServer.AddSearchFilter "doc", "Microsoft Word"
			objSOAPServer.AddSearchFilter "xls", "Microsoft Excel"
			objSOAPServer.AddSearchFilter "pdf", "Adobe PDF"
		End If
		
		'Clean up
		Set objConfig = Nothing
	ElseIf objSOAPServer.Action = "doLibraryBrowse" Then
		'Get the current path
		strPath = Trim(objSOAPServer.GetProperty("path"))
		strLang = Trim(objSOAPServer.GetProperty("lang"))
		boolUsingNewBaseURL = False

		'Process config file
		Set objConfig = Server.CreateObject("MSXML2.DOMDocument.4.0")
		objConfig.async = False
		If Not objConfig.Load(strConfigFile) Then
			objSOAPServer.RaiseError "Failed to load config file."
			objSOAPServer.LogToFile "Failed to load config file: " & strConfigFile
			objSOAPServer.ProcessResponse Response
			Response.End
		End If
		
		'Build folder index
		Set dictFolderIndex = Server.CreateObject("Scripting.Dictionary")
		For Each objNode In objConfig.SelectNodes("/library/folder")
			strTemp = LCase(Replace(Trim(objNode.SelectSingleNode("path").Text), "\", "/"))
			
			If Right(strTemp, 1) = "/" Then
				strTemp = Mid(strTemp, 1, Len(strTemp) - 1)
			End If
			
			If Left(strTemp, 1) = "/" Then
				strTemp = Mid(strTemp, 2)
			End If

			If objSOAPServer.IsValidRelativePath(strTemp) Then
				dictFolderIndex.Add strTemp, objNode
			End If
		Next

		'Build file index
		Set dictFileIndex = Server.CreateObject("Scripting.Dictionary")
		For Each objNode In objConfig.SelectNodes("/library/attachment")
			strTemp = LCase(Replace(Trim(objNode.SelectSingleNode("path").Text), "\", "/"))
			
			If Right(strTemp, 1) = "/" Then
				strTemp = Mid(strTemp, 1, Len(strTemp) - 1)
			End If
			
			If Left(strTemp, 1) = "/" Then
				strTemp = Mid(strTemp, 2)
			End If

			If objSOAPServer.IsValidRelativePath(strTemp) Then
				dictFileIndex.Add strTemp, objNode
			End If
		Next

		'Get the base URL for the current folder
		If dictFolderIndex.Exists(LCase(strPath)) Then
			Set objNode = dictFolderIndex(LCase(strPath))
			If Not objNode.SelectSingleNode("baseURL") Is Nothing Then
				If Len(Trim(objNode.SelectSingleNode("baseURL").Text)) > 0 Then
					strBaseURL = Trim(objNode.SelectSingleNode("baseURL").Text)
					boolUsingNewBaseURL = True
				End If
			End If
		End If
		
		'Check if path is valid
		If Not objSOAPServer.IsValidRelativePath(strPath) Then
			objSOAPServer.RaiseError "Invalid path."
			objSOAPServer.LogToFile "Invalid path: " & strPath
			objSOAPServer.ProcessResponse Response
			Response.End
		End If
		
		'Get sub-folder to browse
		If Len(strPath) = 0 Then
			strRootFilePath = strLibraryFolder
			strRootFolderPath = strLibraryFolder
		Else
			strRootFilePath = BuildPath(strLibraryFolder, strPath)
			strRootFolderPath = BuildPath(strLibraryFolder, strPath)
		End If

		Set objFS = Server.CreateObject("XLibrary.FileSystem")
		If objFS.FolderExists(strRootFolderPath) Then
			'Get folders

			For Each varFolder In objFS.SubFolders(strRootFolderPath, False)
				boolAdd = False
				strTemp = varFolder
				strLabel = varFolder
				boolEmpty = False
				strIcon = ""

				If Len(strPath) > 0 Then
					strTemp = strPath & "/" & strTemp
				End If
				
				strURL = strBaseURL
				
				If Right(strURL, 1) <> "/" Then
					strURL = strURL & "/"
				End If

				strURL = strURL & XSURLEncode(strTemp) & "/"
				
				If dictFolderIndex.Exists(LCase(strTemp)) Then
					Set objNode = dictFolderIndex(LCase(strTemp))
					If objNode.SelectSingleNode("hidden[text() = 'yes']") Is Nothing Then
						boolAdd = True
						
						If Not objNode.SelectSingleNode("label") Is Nothing Then
							strLabel = Trim(objNode.SelectSingleNode("label").Text)
						End If
						
						If Not objNode.SelectSingleNode("icon") Is Nothing Then
							strIcon = Trim(objNode.SelectSingleNode("icon").Text)
						End If
						
						If Not objNode.SelectSingleNode("baseURL") Is Nothing Then
							If Len(Trim(objNode.SelectSingleNode("baseURL").Text)) > 0 Then
								strURL = Trim(objNode.SelectSingleNode("baseURL").Text)
							End If
						End If
					End If
				Else
					boolAdd = True
				End If
	
				If boolAdd Then
					objSOAPServer.AddContainer varFolder, strPath, strLabel, strURL, boolEmpty, strIcon, "", 0
				End If
			Next
		End If
		
		If objFS.FolderExists(strRootFilePath) Then
			Set objAttributes = Server.CreateObject("XLibrary.Attributes")
			Set objProperties = Server.CreateObject("XLibrary.Properties")
		
			For Each varFile In objFS.Files(strRootFilePath)
				boolAdd = False
				strTemp = varFile
				strName = varFile
				strTitle = ""
				boolNewWindow = False
				strCSSClass = ""
				strIcon = ""
				strLabel = varFile
				
				If Len(strPath) > 0 Then
					strTemp = strPath & "/" & strTemp
				End If
				
				If IsAcceptedFileType(varFile) Then
					If dictFileIndex.Exists(LCase(strTemp)) Then
						Set objNode = dictFileIndex(strTemp)
						If objNode.SelectSingleNode("hidden[text() = 'yes']") Is Nothing Then
							boolAdd = True
							
							If Not objNode.SelectSingleNode("title") Is Nothing Then
								strTitle = Trim(objNode.SelectSingleNode("title").Text)
							End If
							
							If Not objNode.SelectSingleNode("newWindow") Is Nothing then
								If Trim(LCase(objNode.SelectSingleNode("newWindow").Text)) = "yes" Then
									boolNewWindow = True
								End If
							End If
							
							If Not objNode.SelectSingleNode("label") Is Nothing Then
								If Len(Trim(objNode.SelectSingleNode("label").Text)) > 0 Then
									strLabel = Trim(objNode.SelectSingleNode("label").Text)
								End If
							End If
							
							If Not objNode.SelectSingleNode("class") Is Nothing Then
								strCSSClass = Trim(objNode.SelectSingleNode("class").Text)
							End If
							
							If Not objNode.SelectSingleNode("icon") Is Nothing Then
								strIcon = Trim(objNode.SelectSingleNode("icon").Text)
							End If
						End If
					Else
						boolAdd = True
					End If
	
					If boolAdd Then
						strURL = ""
						
						If Len(strBaseURL) > 0 Then
							If Right(strBaseURL, 1) = "/" Then
								strURL = strBaseURL
							Else
								strURL = strBaseURL & "/"
							End If	
						End If
							
						If boolUsingNewBaseURL = False Then
							strURL = strURL & XSURLEncode(strPath)
						End If
							
						If Right(strURL, 1) = "/" Then
							strURL = strURL & XSURLEncode(varFile)
						Else
							strURL = strURL & "/" & XSURLEncode(varFile)
						End If
						
						objAttributes.RemoveAll
						objProperties.RemoveAll

						
						objAttributes.Add "href", strURL
						
						If Len(strCSSClass) > 0 Then
							objAttributes.Add "class", strCSSClass
						End If
						
						If Len(strTitle) > 0 Then
							objAttributes.Add "title", strTitle
						End If
						
						If boolNewWindow Then
							objProperties.Add "newWindow", "true"
						End If
							
						If boolGetFileSize Then
							objProperties.Add "size", CStr(objFS.GetFileSize(BuildPath(strRootFilePath, varFile)))
						End If
						
						If boolGetDateLastModified Then
							objProperties.Add "date", ISODateTime(objFS.GetFileDateLastModified(BuildPath(strRootFilePath, varFile)))
						End If
						
						objSOAPServer.AddObject varFile, strPath, strLabel, objAttributes, objProperties, strIcon, "", 0
					End If
				End If
			Next
		End If
		
		Set objConfig = Nothing
		Set objAttributes = Nothing
		Set objProperties = Nothing
		Set objFS = Nothing
		Set dictFolderIndex = Nothing
		Set dictFileIndex = Nothing
		Set objNode = Nothing
	ElseIf objSOAPServer.Action = "doLibrarySearch" Then
		Set objAttributes = Server.CreateObject("XLibrary.Attributes")
		Set objProperties = Server.CreateObject("XLibrary.Properties")
		
		strSearchFor = objSOAPServer.GetProperty("searchFor")
		strFilterBy = objSOAPServer.GetProperty("filterBy")
		
		Rem -----------------------------------------------------------------------------------------
		Rem - ADD CUSTOM CODE HERE
		Rem - 
		Rem - Use methods like:
		Rem - objSOAPServer.AddObject sObjectName As String, sPath As String, sLabel As String, oAttributes As XLibrary.Attributes, oProperties As XLibrary.Properties, sIcon As String, sMetadata As String, lOptions As Long
		Rem -----------------------------------------------------------------------------------------
		objAttributes.RemoveAll
		objProperties.RemoveAll
		objAttributes.Add "href", "http://xstandard.com/images/logo.gif"
		objSOAPServer.AddObject "logo.gif", "", "XStandard Web Site Logo", objAttributes, objProperties, "image", "", 0
		
		Set objAttributes = Nothing
		Set objProperties = Nothing
	End If

	'Process Response
	objSOAPServer.ProcessResponse Response
Else
	Response.ContentType = "text/plain"
	Response.AddHeader "content-disposition", "inline; filename=xstandard.txt"
	If objSOAPServer.Test() Then
		Response.Write "Status: Ready"
	Else
		Response.Write "Status: Error - " & objSOAPServer.ErrorMessage
	End If
End If

Rem -----------------------------------------------------------------------------------------
Rem - Clean up
Rem -----------------------------------------------------------------------------------------
Set objSOAPServer = Nothing
%>