Adressbuch-Verteilung (DA Einbindung, Mailrouting, Aut. Replizierung)

[0xse]

Da ich ab einer gewissen Anzahl Dominos zu faul war alle Adressbuch-Repliken manuell anzulegen und einzurichten, hab ich ein kleines Script dafür geschrieben. Die meisten Dinge lassen sich über die Maske einstellen, ein paar Unternehmens-spezifische Dinge sind aber im Code untergebracht. Die müßte man dann anpassen.

Viel Spass damit


Edit:
08.03.2010 Der Fehler, welcher das Quell-Adressbuch unter Umständen gewiped hat, ist raus. Allerdings müssen die Replikrümpfe auf den Ziel Servern jetzt von Hand angelegt werden, bevor das Script gestartet wird. Wenn mir jemand ein Codesegment schicken kann, womit sich per LS Replikrümpfe anlegen lassen, das wäre top =)

Code

Option Explicit



Dim ifdoc As notesuidocument



Sub logit(msg As String)
	Call ifdoc.FieldSetText("log",ifdoc.FieldGetText("log") & msg & Chr(10))
End Sub



Sub logitbr(msg As String)
	Call ifdoc.FieldSetText("log",ifdoc.FieldGetText("log") & msg)
End Sub



Sub Click(Source As Button)
	On Error Goto fehler
	Dim ws As New notesuiworkspace
	Dim ses As New notessession
	Dim uidoc As notesuidocument
	Set ifdoc = ws.CurrentDocument
	ifdoc.EditMode = True
	Call ifdoc.FieldSetText("log","")
	Call logit("Start")
	' Programm Start
	
	'Deklaration
	Dim masterServer As String, masterFile As String
	Dim targetServer As String, targetFile As String, targetServers As Variant
	Dim template As Boolean, replication As Boolean, directory As Boolean, mailing As Boolean
	Dim templateServer As String, templateFile As String, gefunden As Boolean
	Dim aclname As NotesName, gefunden2 As Boolean 
	Dim srcServerAdr As notesdatabase, targetServerAdr As notesdatabase
	Dim srcServerView As notesview, targetServerView As notesview
	Dim srcServerDoc As notesdocument, targetServerDoc As notesdocument
	Dim srcDomain As String, targetDomain As String
	Dim srcIP As String, targetIP As String, port As String
	Dim filenames As Variant, temp As Variant
	Dim networkSuffix As String, interval As Long, schedule As String
	Dim dafile As String, dadb As notesdatabase, daview As notesview, daentry As notesdocument, daorder As Long
	Dim tmpSrcDoc As notesdocument, tmpSrcDocs As notesdocumentcollection
	Dim dbdir As NotesDbDirectory 
	
	
	'Initialisierung
	If ifdoc.FieldGetText("directory") <> "" Then directory = True
	If ifdoc.FieldGetText("replication") <> "" Then replication = True
	If ifdoc.FieldGetText("template") <> "" Then template = True
	If ifdoc.FieldGetText("mailing") <> "" Then mailing = True
	If template Then
		templateServer = Trim(ifdoc.FieldGetText("templateServer"))
		If templateServer = "" Then
			logit("Kein Template Server angegeben.")
			Goto ende
		End If
		templateFile = Trim(ifdoc.FieldGetText("templateFile"))
		If templateFile = "" Then
			logit("Keine Template Datei angegeben.")
			Goto ende
		End If
	End If
	targetServer = Trim(ifdoc.FieldGetText("targetServer"))
	If targetServer = "" Then
		logit("Keine Ziel-Server angegeben.")
		Goto ende
	End If
	networkSuffix = Trim(ifdoc.FieldGetText("networkSuffix"))
	If networkSuffix = "" Then
		logit("Kein Netzwerk-Suffix angegeben.")
		Goto ende
	End If
	port = Trim(ifdoc.FieldGetText("port"))
	If port = "" Then
		logit("Kein Port angegeben.")
		Goto ende
	End If
	targetFile = Trim(ifdoc.FieldGetText("filename"))
	If targetfile = "" Then
		logit("Kein Ziel-Dateinamen angegeben.")
		Goto ende
	End If
	masterServer = Trim(ifdoc.FieldGetText("masterServer"))
	If masterServer = "" Then
		logit("Kein Master-Server angegeben.")
		Goto ende
	End If
	masterFile = Trim(ifdoc.FieldGetText("masterFile"))
	If masterFile = "" Then
		logit("Keine Master-Datei angegeben.")
		Goto ende
	End If	
	If replication Then
		schedule = Trim(ifdoc.FieldGetText("Schedule"))
		If schedule = "" Then
			logit("Keinen Zeitraum angegeben.")
			Goto ende
		End If	
		interval = Clng(ifdoc.FieldGetText("Interval"))
		If interval = 0 Then
			logit("Kein Intervall angegeben.")
			Goto ende
		End If
	End If
	
	
	'Quellen laden
	Dim srcAdr As notesdatabase, destAdr As notesdatabase
	Dim destServer As String
	Dim acl As NotesACL, aclentry As notesaclentry, todelete As Boolean
	Dim repl As NotesReplication, replentry As NotesReplicationEntry, replentries As Variant 
	Dim templateDB As notesdatabase, deletecollection As notesdocumentcollection
	
	logitbr("Öffne " & masterServer & "!!" & masterFile & "... ")
	Set srcAdr = ses.GetDatabase(masterServer, masterFile, False)
	If srcAdr Is Nothing Then
		logit("Fehlgeschlagen")
		Goto ende
	Else
		logit("Erfolgreich")
	End If
	
	targetServers = Split(targetServer,",")
	Forall preDestServer In targetServers
		
		'Prüfe Existenz Ziel-Adr
		logit("")
		Set destAdr = Nothing
		destServer = Trim(Cstr(preDestServer))
		
		While destAdr Is Nothing
			logitbr("Finger " & destServer & "!!" & targetFile & "...")
			Set destAdr = ses.getDatabase(destServer, targetFile, False)
			
			If destAdr Is Nothing Then
				logit("Nicht vorhanden")
				logitbr("Erstelle Ziel-Adressbuch...")
				'Set destAdr = srcAdr.CreateReplica(destServer, targetFile)
				'Messagebox "Bitte legen Sie die folgende Replik an." & Chr(10) & _
				'"Name: " & srcAdr.Title & Chr(10) & _
				'"Quell-Server: " & srcAdr.Server & Chr(10) & _
				'"Ziel-Server: " & destServer & Chr(10) & _
				'"Ziel-Dateiname: " & targetFile & Chr(10) & _ 
				'"Auswahlformel: " & "SELECT Form = ""Person"" : ""Group"" : ""Database"" : ""Resource""" & Chr(10) & _ 
				'"Die Ziel-DB soll ausschließlich Dokumente und deren Löschungen empfangen." & Chr(10) & _ 
				'"und keine Gestaltungselemente, ACL Änderungen oder ähnliches."
				
				Call logitbr("+")
				Set tmpSrcDocs = srcAdr.Search("SELECT @All",Nothing,0)
				Call logitbr("+")
				Set tmpSrcDoc = tmpSrcDocs.GetFirstDocument 
				If tmpSrcDoc Is Nothing Then
					Call logit("Fehlgeschlagen (SrcDoc)")
				Else
					Call logitbr("+")
					Evaluate "@Command([FileNewReplica])", tmpSrcDoc
					Call logitbr("+ ")
					If destAdr Is Nothing Then
						logit("Fehlgeschlagen")
						Goto ende
					Else
						logit("Erfolgreich")
					End If
				End If
			Else
				logit("Vorhanden")
			End If
		Wend
		
		
		'Passe ACL an
		logit("Passe Ziel ACL an:")
		Set acl = destAdr.ACL 
		Do 
			todelete = False
			Set aclentry = acl.GetFirstEntry 
			While Not aclentry Is Nothing
				If Lcase(aclentry.Name) <> "default" And Lcase(aclentry.Name) <> "-default-" And Lcase(aclentry.Name) <> "anonymous" Then
					logit("Eintrag gelöscht: " & aclentry.Name)
					Call aclentry.Remove
					todelete = True
					Set aclentry = acl.GetFirstEntry 
				Else
					If Lcase(aclentry.Name) = "default" Or Lcase(aclentry.Name) = "-default-" Then
						aclentry.Level = 2
						aclentry.cancreatepersonalagent = False
						aclentry.CanCreatePersonalFolder = False
						aclentry.CanReplicateOrCopyDocuments = False
					End If
					If Lcase(aclentry.Name) = "anonymous" Then
						aclentry.Level = 0
						aclentry.CanReplicateOrCopyDocuments = False
					End If
					Set aclentry = acl.GetNextEntry(aclentry)
				End If
			Wend
		Loop While todelete
		
		Set aclentry = acl.CreateACLEntry(masterServer, 6)
		aclentry.CanDeleteDocuments = True
		aclentry.UserType = 2
		Forall r In acl.Roles
			Call aclentry.EnableRole(r)
		End Forall
		logit("Eintrag hinzugefügt: " & masterServer)
		
		Set aclentry = acl.CreateACLEntry(destServer, 6)
		aclentry.CanDeleteDocuments = True
		aclentry.UserType = 2
		Forall r In acl.Roles
			Call aclentry.EnableRole(r)
		End Forall
		logit("Eintrag hinzugefügt: " & destServer)
		
		Set aclentry = acl.CreateACLEntry("Globale Voll-Administratoren", 6)
		aclentry.CanDeleteDocuments = True
		aclentry.UserType = 4
		Forall r In acl.Roles
			Call aclentry.EnableRole(r)
		End Forall
		logit("Eintrag hinzugefügt: Globale Voll-Administratoren")
		
		Set aclentry = acl.CreateACLEntry("Globale Administratoren", 6)
		aclentry.CanDeleteDocuments = True
		aclentry.UserType = 4
		Forall r In acl.Roles
			Call aclentry.EnableRole(r)
		End Forall
		logit("Eintrag hinzugefügt: Globale Administratoren")
		
		logitbr("Speichere ACL-Änderungen... ")
		Call acl.Save
		logit("Erfolgreich")
		
		
		'Quell ACL
		logit("Passe Quell ACL an:")
		Set acl = srcAdr.ACL
		Set aclentry = acl.GetFirstEntry 
		gefunden = False
		
		While Not aclentry Is Nothing
			Set aclname = ses.CreateName(aclentry.Name)
			If aclname.Abbreviated = destServer Then 
				If aclentry.Level = 6 Then
					gefunden = True
				Else
					aclentry.Level = 6
					aclentry.CanDeleteDocuments = True
					aclentry.UserType = 2				
					Forall r In acl.Roles
						Call aclentry.EnableRole(r)
					End Forall
				End If
			End If
			Set aclentry = acl.GetNextEntry(aclentry)
		Wend
		
		If Not gefunden Then
			logit("Eintrag hinzufügen (" & destServer & ")... ")
			Set aclentry = acl.CreateACLEntry(destServer,2)
			aclentry.CanDeleteDocuments = True
			aclentry.UserType = 2
			Forall r In acl.Roles
				Call aclentry.EnableRole(r)
			End Forall
			logitbr("Erfolgreich")
		End If
		
		logitbr("Speichere ACL-Änderungen... ")
		Call acl.Save
		logit("Erfolgreich")
		
		
		'Schablone
		If template Then
			logitbr("Finger Schablone " & templateServer & "!!" & templateFile & "... ")
			Set templateDB = ses.GetDatabase(templateServer, templateFile, False)
			If templateDB Is Nothing Then
				logit("Fehlgeschlagen")
				Goto ende
			Else
				logit("Erfolgreich")
			End If
			
			logit("Ersetze Schablone...")
			logit(">> " & destServer & " >> " & "load convert " & targetFile & " * " & templateServer & "!!" & templateFile)
			logit(ses.SendConsoleCommand(destServer,"load convert " & targetFile & " * " & templateServer & "!!" & templateFile))
		Else
			logit("Schablone deaktiviert.")
		End If
		
		
		'Passe Replizierparameter an
		logitbr("Passe Allgemeine Replizierparameter an... ")
		Set repl = destAdr.ReplicationInfo
		repl.Disabled = False
		repl.Abstract = False
		repl.DontSendLocalSecurityUpdates = True
		repl.IgnoreDeletes = False
		repl.IgnoreDestDeletes = False
		Call repl.save
		logit("Erfolgreich")
		
		logit("Passe spezifische Replizierparameter an:")
		Set replentry = repl.GetEntry("-",destServer,True)
		If replentry Is Nothing Then
			logit("Anlage fehlgeschlagen")
			Goto ende
		Else
			logitbr("Von " & replentry.Source & " an " & replentry.Destination & "... ")
			replentry.IsIncludeACL = False
			replentry.IsIncludeAgents = False
			replentry.IsIncludeDocuments = True
			replentry.IsIncludeForms = False
			replentry.IsIncludeFormulas = False
			replentry.Views = False
			replentry.Formula = "SELECT Form = ""Person"" : ""Group"" : ""Database"" : ""Resource"""			
			Call replentry.Save
			logit("Erfolgreich")
		End If
		
		
		'Automatische Replizierung
		If replication Or mailing Then
			logitbr("Öffne " & masterServer & "!!names.nsf... ")
			Set srcServerAdr = ses.GetDatabase(masterServer, "names.nsf", False)
			If srcServerAdr Is Nothing Then
				logit("Fehlgeschlagen")
				Goto ende
			Else
				logit("Erfolgreich")
			End If
			
			logitbr("Öffne " & destServer & "!!names.nsf... ")
			Set targetServerAdr = ses.GetDatabase(destServer, "names.nsf", False)
			If targetServerAdr Is Nothing Then
				logit("Fehlgeschlagen")
				Goto ende
			Else
				logit("Erfolgreich")
			End If
			
			logitbr("Ermittle Quell-Domain... ")
			srcDomain = Trim(Right(masterServer, Len(masterServer) - Instr(masterServer,"/")))
			logit(srcDomain)
			
			logitbr("Ermittle Ziel-Domain... ")
			targetDomain = Trim(Right(destServer, Len(destServer) - Instr(destServer,"/")))
			logit(targetDomain)
			
			If mailing Then
				logitbr("Öffne ($Domains)... ")
				Set srcServerView = srcServerAdr.GetView("($Domains)")
				If srcServerView Is Nothing Then
					logit("Fehlgeschlagen")
					Goto ende
				Else
					logit("Erfolgreich")
					logitbr("Finger Domain " & targetDomain & "... ")
					Set srcServerDoc = srcServerView.GetDocumentByKey(targetDomain,False)
					If srcServerDoc Is Nothing Then
						logit("Nicht vorhanden")
						logitbr("Erstelle Domain-Dokument... ")
						Set srcServerDoc = srcServerAdr.CreateDocument
						Call srcServerDoc.ReplaceItemValue("Form","Domain")
						Call srcServerDoc.ComputeWithForm(False,False)						
						Call srcServerDoc.ReplaceItemValue("Type","Domain")
						Call srcServerDoc.ReplaceItemValue("DomainType","AdjacentDomain")
						Call srcServerDoc.ReplaceItemValue("OtherDomainName", targetDomain)
						Call srcServerDoc.ComputeWithForm(False,False)
						Call srcServerDoc.Save(True,False,True)
						temp = Evaluate("@Command([ToolsRefreshSelectedDocs])",srcServerDoc)
						
						Set uidoc = ws.EditDocument(True,srcServerDoc)
						Call uidoc.Refresh(True,True)
						Call uidoc.Save
						Call uidoc.Close
						
						logit("Erfolgreich")
					Else
						logit("Vorhanden")
					End If
				End If		
			End If
			
			logitbr("Öffne ($Connections)... ")
			Set srcServerView = srcServerAdr.GetView("($Connections)")
			If srcServerView Is Nothing Then
				logit("Fehlgeschlagen")
				Goto ende
			Else
				logit("Erfolgreich")
				gefunden = False
				logitbr("Suche " & destServer & "... ")
				Set srcServerDoc = srcServerView.GetFirstDocument 
				While Not srcServerDoc Is Nothing
					Set aclname = ses.CreateName(srcServerDoc.GetItemValue("Destination")(0))
					If aclname.Abbreviated = destServer Then
						logit("Verbindung zu " & destServer & " gefunden")
						gefunden = True
						logit("Achtung: Es wird kein Verbindungsdokument angelegt!")
					End If
					Set srcServerDoc = srcServerView.GetNextDocument(srcServerDoc)
				Wend
				
				If Not gefunden Then
					logit("Nicht vorhanden")
					logitbr("Erstelle Verbindung zu " & destServer & " (" & Left(destServer, Instr(destServer,"/") - 1) & networkSuffix & ")... ")
					
					Set srcServerDoc = srcServerAdr.CreateDocument
					Call srcServerDoc.ReplaceItemValue("Form","Connection")
					Call srcServerDoc.ReplaceItemValue("Type","Connection")
					Call srcServerDoc.ComputeWithForm(False,False)
					
					Call srcServerDoc.ReplaceItemValue("SourceDomain", srcDomain)
					Call srcServerDoc.ReplaceItemValue("ConnectionType", 0)
					Call srcServerDoc.ReplaceItemValue("PortName",port)
					Call srcServerDoc.ReplaceItemValue("Destination",destServer)
					Call srcServerDoc.ReplaceItemValue("DestinationDomain", targetDomain)
					Call srcServerDoc.ReplaceItemValue("OptionalNetworkAddress", Left(destServer, Instr(destServer,"/") - 1) & networkSuffix)
					
					If replication Then
						Call srcServerDoc.ReplaceItemValue("RepTask","1")
						Call srcServerDoc.ReplaceItemValue("Schedule",schedule)
						Call srcServerDoc.ReplaceItemValue("Interval",interval)
						Call srcServerDoc.ReplaceItemValue("RepType","Push Only")
						Call srcServerDoc.ReplaceItemValue("Filenames",masterFile)
					Else
						Call srcServerDoc.ReplaceItemValue("RepTask",0)						
					End If
					
					If mailing Then
						Call srcServerDoc.ReplaceItemValue("RoutingTask","Mail Routing")
						Call srcServerDoc.ReplaceItemValue("MailThreshold",1)
						Call srcServerDoc.ReplaceItemValue("Cost",1)
						Call srcServerDoc.ReplaceItemValue("RouterType","Push Only")
					Else
						Call srcServerDoc.ReplaceItemValue("RoutingTask","0")
					End If					
					
					Call srcServerDoc.Save(True,False,True)					
					Call srcServerDoc.ComputeWithForm(False,False)
					Call srcServerDoc.Save(True,False,True)
					temp = Evaluate("@Command([ToolsRefreshSelectedDocs])",srcServerDoc)
					
					Set uidoc = ws.EditDocument(True,srcServerDoc)
					Call uidoc.Refresh(True,True)
					Call uidoc.Save
					Call uidoc.Close
					
					logit("Erfolgreich")
				End If
			End If
		Else
			logit("Automatische Replizierung und Mailing deaktiviert.")
		End If
		
		
		'DA Einbindung
		If directory Then
			logitbr("Öffne ($Servers)... ")
			Set targetServerView = targetServerAdr.GetView("($Servers)")
			If targetServerView Is Nothing Then
				logit("Fehlgeschlagen")
				Goto ende
			Else
				gefunden = False
				logit("Erfolgreich")
				logitbr("Lese DirectoryAssistance (" & destServer & ") aus... ")
				Set targetServerDoc = targetServerView.GetFirstDocument 
				gefunden2 = False
				While Not targetServerDoc Is Nothing 
					Set aclname = ses.CreateName(Cstr(targetServerDoc.GetItemValue("ServerName")(0)))
					If aclname.Abbreviated = destServer Then
						logit("Server gefunden (" & aclname.Abbreviated & " = " & destServer & ")")
						gefunden2 = True
						dafile = Trim(targetServerDoc.GetItemValue("MasterAddressBook")(0))
						If dafile <> "" Then
							logitbr("Öffne DA DB (" & destServer & "!!" & dafile  & ")... ")
							Set dadb = ses.GetDatabase(destServer,dafile)
							If dadb Is Nothing Then
								logit("Konnte " & destserver & "!!" & dafile & " nicht öffnen")
								Goto ende
							Else
								logit("Erfolgreich") 
								
								logitbr("Öffne ($DirectoryAssistance)... ")
								Set daview = dadb.getview("($DirectoryAssistance)")
								If daview Is Nothing Then
									logit("Konnte ($DirectoryAssistance) nicht öffnen")
								Else
									logit("Erfolgreich")
									
									gefunden = False
									daorder = 1
									
									Set daentry = daview.getfirstdocument
									While Not daentry Is Nothing
										If Trim(Cstr(daentry.GetItemValue("DomainName")(0))) = srcDomain Then
											logit(srcDomain & " bereits vorhanden")
											gefunden = True
										End If
										If Clng(Cstr(daentry.GetItemValue("DomainSearchOrder")(0))) > daorder Then
											daorder = Clng(daentry.GetItemValue("DomainSearchOrder")(0))
										End If
										
										Set daentry = daview.getnextdocument(daentry)
									Wend
									
									If Not gefunden Then
										logit("Domain " & srcDomain & " noch nicht vorhanden")
										logitbr("Erstelle DirectoryAssitance Eintrag... ")
										
										Set daentry = dadb.CreateDocument
										Call daentry.ReplaceItemValue("Form","DirectoryAssistance")
										Call daentry.ReplaceItemValue("Type","DirectoryAssistance")
										
										Call daentry.ReplaceItemValue("DomainType","Notes")
										Call daentry.ReplaceItemValue("DomainName",srcDomain)
										Call daentry.ReplaceItemValue("DomainSearchOrder",daorder + 1)
										Call daentry.ReplaceItemValue("ClientProtocolType","0")
										Call daentry.ReplaceItemValue("GroupExpansion","0")
										Call daentry.ReplaceItemValue("AuthenticationOrAuthorization","0")
										Call daentry.ReplaceItemValue("DomainEnabled","1")
										
										Call daentry.ReplaceItemValue("Trusted_0","1")
										
										Call daentry.ReplaceItemValue("ServerName_0",destServer)
										Call daentry.ReplaceItemValue("AddressBook_0",targetFile)
										Call daentry.ReplaceItemValue("Enabled_0","1")
										
										Call daentry.Save(True,False,True)					
										Call daentry.ComputeWithForm(False,False)
										Call daentry.Save(True,False,True)
										temp = Evaluate("@Command([ToolsRefreshSelectedDocs])",daentry)
										
										Set uidoc = ws.EditDocument(True,daentry)
										Call uidoc.Refresh(True,True)
										Call uidoc.Save
										Call uidoc.Close
										logit("Erstellt")
									End If
									
								End If
							End If
						End If						
					End If
					
					Set targetserverdoc = targetserverview.GetNextDocument(targetserverdoc)
				Wend					
				If Not gefunden2 Then
					logit("Kein Serverdokument zu " & destServer & " gefunden.")
					Goto ende
				End If	
			End If
		Else
			logit("DA Einbindung deaktiviert.")
		End If		
		
		
		'Abschließende Replizierung
		logitbr("Replizierhistorie für " & destServer & "!!" & targetFile & " zurücksetzen... ")
		Call repl.ClearHistory
		Call repl.Save
		logit("Erfolgreich")
		
		
		logit("Repliziere... ")
		logit(">> " & masterServer & " >> " & "push " & destServer & " " & masterFile)
		logit(ses.SendConsoleCommand(masterServer,"push " & destServer & " " & masterFile))
		
		
	End Forall
	
	
	
	' Programm Ende
	Goto ende
fehler:
	Call logit("Fehler (Zeile " & Erl() & "): " & Err() & " - " & Error(Err()))
	Resume fehlerende
ende:
	Call logit("Ende")	
	Call ifdoc.Save()
	ifdoc.EditMode = False	
fehlerende:	
End Sub