%REM
	Skriptbibliothek fr die Ressourcenverwaltung in Notes
	Created 08.10.2014 by LANCOM Systems GmbH
%END REM

Option Public

'# Deklaration von Konstanten
Private Const ROOMIDAACHEN = "D1001BF6"
Private Const ROOMNAMEAACHEN = "Aachen B2.100"
Private Const ROOMNRAACHEN = "B2100"
Private Const ROOMVIEWAACHEN = "CurResForB2100"
Private Const UPDATEURLEPAPERSERVER = "http://epaper-server:8001/service/task"
Private Const DEBUGEMAIL = "debugging@yourcompany.com"
Private Const PROFILEDOC = yourProfileDoc
Private Const NOMOREMEETINGS = keine weiteren Reservierungen
Private Const TEMPLATE = "lcsconference_landscape.xsl"


'# Erzeugen einer Unique-ID
Function createGuid()
	Dim object
	Set object = CreateObject("Scriptlet.TypeLib")
	guid = object.Guid
	Set object = Nothing

	createGuid = Left(guid, Len(guid)-2)
End Function


'# Behandlung von XML-Steuerzeichen in Strings
Function EscapeXML(newStr As String) As String

	Dim replaceFrom (1 To 5) As String
	Dim replaceTo (1 To 5) As String
	Dim escapedString As String

	replaceFrom(1) = |&|
	replaceFrom(2) = |"|
	replaceFrom(3) = |'|
	replaceFrom(4) = |<|
	replaceFrom(5) = |>|

	replaceTo(1) = |&amp;|
	replaceTo(2) = |&quot;|
	replaceTo(3) = |&apos;|
	replaceTo(4) = |&lt;|
	replaceTo(5) = |&gt;|

	EscapeXML = Replace(newStr,replaceFrom,replaceTo)

End Function


'# Funktion zum Display Update
Function UpdateDisplay(meetingUNID As String, meetingUNID2 As String, displayID As String, resourceName As String, roomNr As String) As String

	Dim session As New NotesSession
	Dim db As NotesDatabase
	Set db = session.CurrentDatabase

	Dim profDoc As NotesDocument
	Set profDoc = db.Getprofiledocument(PROFILEDOC)
	Dim mailDoc As NotesDocument
	Dim rtItem As NotesRichTextItem

	Dim objHttp As Variant
	Dim reqHttp As String
	Dim url As String
	Dim response As String

	Dim meetingDoc1 As NotesDocument
	Dim meetingDoc2 As NotesDocument
	Dim meetingChair1 As NotesName
	Dim meetingChair2 As NotesName
	Dim roomName As NotesName

	Dim dispDate As String
	Dim dispRoom As String
	Dim dispTime1 As String
	Dim dispPurpose1 As String
	Dim dispChair1 As String
	Dim dispTime2 As String
	Dim dispPurpose2 As String
	Dim dispChair2 As String

	DebugMode = False

	Set roomName = New NotesName(resourceName)
	dispRoom = roomName.Common
	dispDate = Format$(Today,"dd.mm.yyyy")

	'# Abfrage der Meetings
	If meetingUNID <> "" Then
		Set meetingDoc1 = db.Getdocumentbyunid(meetingUNID)
		Set meetingChair1 = New NotesName(meetingDoc1.Chair(0))
		dispTime1 = Format$(meetingDoc1.StartDateTime(0),"hh:mm")+" - " +Format$(meetingDoc1.EndDateTime(0),"hh:mm")
		If meetingDoc1.Hasitem("txtPurpose") Then
			dispPurpose1 = EscapeXML(FullTrim(meetingDoc1.txtPurpose(0)))
		Else
			dispPurpose1 = EscapeXML(Trim(meetingDoc1.Purpose(0)))
		End If

		dispChair1 = meetingChair1.Common

		If meetingUNID2 <> "" Then
			Set meetingDoc2 = db.Getdocumentbyunid(meetingUNID2)
			Set meetingChair2 = New NotesName(meetingDoc2.Chair(0))
			dispTime2 = Format$(meetingDoc2.StartDateTime(0),"hh:mm")+" - " +Format$(meetingDoc2.EndDateTime(0),"hh:mm")
			If meetingDoc2.Hasitem("txtPurpose") Then
				dispPurpose2 = EscapeXML(FullTrim(meetingDoc2.txtPurpose(0)))
			Else
				dispPurpose2 = EscapeXML(Trim(meetingDoc2.Purpose(0)))
			End If

			dispChair2 = meetingChair2.Common
		End If
	Else
		dispPurpose1 = NOMOREMEETINGS
	End If

	Set mailDoc = db.CreateDocument
	mailDoc.Form = "Memo"
	mailDoc.Subject = "Report UpdateDisplay for "+ resourceName +" in Ressource.nsf vom" + Format$(Now)
	mailDoc.SendTo = DEBUGEMAIL
	Set rtItem = mailDoc.CreateRichTextItem("Body")

	'# XML-Erstellung
	reqHttp = 	|<?xml version="1.0" encoding="UTF-8" standalone="yes"?>|+_
				|<TaskOrder title="Refresh label |+displayID +| for room |+dispRoom+|">|+_
					|<TemplateTask labelId="|+displayID +|" externalId="4711" template=|+TEMPLATE|>|+_
						|<room roomName="|+dispRoom+|">|+_
							|<field key="date" value="|+dispDate+|"/>|+_
							|<field key="time1" value="|+dispTime1 +|"/>|+_
							|<field key="purpose1" value="|+dispPurpose1 +|"/>|+_
							|<field key="chair1" value="|+dispChair1 +|"/>|+_
							|<field key="time2" value="|+dispTime2 +|"/>|+_
							|<field key="purpose2" value="|+dispPurpose2 +|"/>|+_
							|<field key="chair2" value="|+dispChair2 +|"/>|+_
						|</room>|+_
					|</TemplateTask>|+_
				|</TaskOrder>|


	Dim oldVal As Variant
	oldval = profDoc.Getitemvalue(roomNr)

	'# Prfung, ob Update notwendig ist.
	If StrComp(reqHttp,oldVal(0)) Then

		Call profdoc.Replaceitemvalue(roomNr, Nothing)
		Call profDoc.Replaceitemvalue(roomNr, reqHttp)
		Call profDoc.Save(True, False)
	
		Set objHttp = CreateObject("Microsoft.XMLHTTP")
		url = UPDATEURLEPAPERSERVER
		objHttp.Open "POST", url, False, "", ""
		objHttp.setRequestHeader "Content-Type:", "application/xml"
		objHttp.setRequestHeader "Content-Lenght:", Len(reqHttp)
		objHttp.setRequestHeader "User-Agent:", "LCS_NTS_AGNT"
		objHttp.Send(reqHttp)

		If (objHttp.readyState <> 4) Or (objHttp.status <> 200) Then
			Call rtItem.AppendText ("Der Request konnte nicht ausgefhrt werden!"+Chr(13)+Chr(10)+_
			"fr Meeting UNID 1: " +meetingUNID +Chr(13)+Chr(10)+_
			"fr Meeting UNID 2: " +meetingUNID2 +Chr(13)+Chr(10)+_
			"readyState: " +Format$(objHttp.readyState)+Chr(13)+Chr(10)+_
			"HTTP Status: " +Format$(objHttp.status)+Chr(13)+Chr(10)+_
			"Request: " +Chr(13)+Chr(10)+ reqHttp +Chr(13)+Chr(10)+Chr(13)+Chr(10)+_
			"Response: " +Chr(13)+Chr(10)+ objHttp.responseText)
			Call mailDoc.Send(False)
		Else
			Call rtItem.AppendText ("works fine! "+Chr(13)+Chr(10)+_
			"fr Meeting UNID 1: " +meetingUNID +Chr(13)+Chr(10)+_
			"fr Meeting UNID 2: " +meetingUNID2 +Chr(13)+Chr(10)+_
			"readyState: " +Format$(objHttp.readyState)+Chr(13)+Chr(10)+_
			"HTTP Status: " +Format$(objHttp.status)+Chr(13)+Chr(10)+_
			"Request: " +Chr(13)+Chr(10)+ reqHttp +Chr(13)+Chr(10)+Chr(13)+Chr(10)+_
			"Response: " +Chr(13)+Chr(10)+ objHttp.responseText)
			Call mailDoc.Send(False)
		End If

		response = objHttp.responseText
		Set objHttp=Nothing

	ElseIf DebugMode Then
		Call rtItem.AppendText ("same Request. No Update! "+Chr(13)+Chr(10) +"Request: " +reqHttp)
		Call mailDoc.Send(False)
		'MsgBox("same as last")
	End If

	UpdateDisplay = response

End Function


'# Funktion zum Auslsen des Update-Prozesses
Sub CheckForUpdate

	Dim session As New NotesSession
	Dim db As NotesDatabase
	Set db = session.Currentdatabase

	Dim meetingView As NotesView

	Dim response As String
	Dim meetingUNID1 As String
	Dim meetingUNID2 As String


	'# Beispiel fr Raum AACHEN, pro Raum notwendig
	Set meetingView = db.Getview(ROOMVIEWAACHEN)

	If meetingView.Allentries.Count > 1 Then
		meetingUNID1 = meetingView.Getfirstdocument().Universalid
		meetingUNID2 = meetingView.Getnthdocument(2).Universalid
	ElseIf meetingView.Allentries.Count = 1 Then
		meetingUNID1 = meetingView.Getfirstdocument().Universalid
		meetingUNID2 = ""
	Else
		meetingUNID1 = ""
		meetingUNID2 = ""
	End If

	response = UpdateDisplay(meetingUNID1, meetingUNID2,ROOMIDAACHEN, ROOMNAMEAACHEN, ROOMNRAACHEN)

End Sub