Prüfen ob der Benutzer im Directory existiert

[Thomas Schulte]

Entweder bin ich blöd oder das sind die Nachwirkungen des Entwicklercamps.

Ich habe ein Feld in dem ein Benutzername eingetragen werden kann. Rein theoretisch ist es jetzt möglich, das dort kein gültiger Name oder nur Teile eines gültigen Namens eingetragen wird (werden) (über das Web z.B.).

Ein Script Agent soll jetzt die neuen und geänderten Dokumente zusammenstellen und den jeweils in diesem Feld eingetragenen Personen gesammelt als so eine Art Newsletter zur Verfügung stellen. Das Ganze natürlich nur wenn die Person im Directory existiert. Wenn Sie nicht existiert muss das ausgeleitet und einem Anwendugnsadministrator zur Verfügung gestellt werden. Also muss ich irgendwie rauskriegen ob ein Benutzer mit diesem Namen im Adressbuch existiert.

Frage: Gibt es außer der Methode über die Names.nsf und verschiedene getdocumentsbykey mit den Bestandteilen des Namens noch eine Möglichkeit das direkt rauszufinden (LDAP Abfrage?). Ich hab ja erst gedacht über NotesName aber das erzeugt ganz einfach einen Notes Namen, vollkommen wurscht was da jetzt reingeschrieben wird.

[eknori]

habe das hier gefunden ( und nicht getestet )

        Description: *
                          How test a name in an input field without searching into the adress database ....

                          Code: *
                          Sub Querysave(Source As Notesuidocument, Continue As Variant)

                          ' Déclaration
                          Dim session As New NotesSession
                          Dim workspace As New NotesUIWorkspace
                          Dim uidoc As NotesUIDocument
                          Dim texte As String

                          ' Initialisation
                          Set db = session.CurrentDatabase
                          Set uidoc = workspace.CurrentDocument
                          MB_ICONSTOP = 16

                          ' search to know if the name exist
                          texte = uidoc.FieldGetText( "Field_name" )
                          If Not(Trim(texte)="") Then
                          Set tName = New NotesName(texte)
                          If (tName.CANONICAL = tName.COMMON) Then
                          Msgbox "unable to find the name",MB_ICONSTOP,"Erreur"
                          Call uidoc.GotoField( "Field_name" )
                          Continue = False
                          Exit Sub
                          End If
                          Else
                          Msgbox "Please, give a real name",MB_ICONSTOP,"Error"
                          Call uidoc.GotoField( "Field_name" )
                          Continue = False
                          End If
                          End Sub

[Thomas Schulte]

Erst einmal Danke Ullrich für das Teil. Das war genau der Stups in die richtige Richtung. 

Und für alle die es interessiert, hier der fertige Code. Der geht allerdings von ein paar Prämissen aus:
1. da wo der Agent läuft sind Adressbücher verfügbar
2. überprüft wird gegen den FullName und den ShortName, nicht gegen den Lastname (wobei das einfach zu ergänzen wäre aber keinen Sinn macht solange Punkt 3 nicht realisiert ist)
3. doppelte Einträge werden noch nicht unterstützt  (da muss noch ein wenig Logik rein)
4. bei GROSSEN Addressbüchern könnte das etwas Performance kosten, da alle verfügbaren Adressbücher abgeklappert werden.

Code

Option Public
Option Declare
 
 
' dims
Dim formnames List As String
Dim userdclist List As String
Dim alluserslist List As String
Sub Initialize
%REM
This agent Gathers all new and modified documents. 
It sends a summary mail to that user that is declared as responsible in the document
%END REM
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Dim view As NotesView
	Dim chdoccol As notesdocumentcollection
	Dim founddoc As NotesDocument
	
	Set db = session.CurrentDatabase
	
	' fetch all valid users from all addressbooks
	Call fetchvalidusers(Session)
	' build List of Forms not to be added to the newsletter
	Call buildformnameslist
	' use unprocessed as document collection
	Set chdoccol = db.UnprocessedDocuments
	' build a list of the documents that are related to each user	
	Call builduserdocumentlist(chdoccol)
	' send on doucment with all items to each user in the list
	Call sendusermail
	
End Sub
Sub buildformnameslist
	' forms not to be watched
	Formnames("frmConfigExternalDatabase") = "frmConfigExternalDatabase"
	Formnames("frmConfigDatatransfer") = "frmConfigDatatransfer"
	Formnames("frmConfigFieldGovernance") = "frmConfigFieldGovernance"
	Formnames("frmConfigKeywords") = "frmConfigKeywords"
	Formnames("frmConfigKeywordCouples") = "frmConfigKeywordCouples"
	Formnames("frmprofileSequentialNumber") = "frmProfileSequentialNumber"
	Formnames("frmConfigTeams") = "frmConfigTeams"
	Formnames("frmConfigUserAccess") = "frmConfigUserAccess"
	Formnames("frmConfigUserConfiguration") = "frmConfigUserConfiguration"
End Sub
Sub builduserdocumentlist(mydc As NotesDocumentCollection)
	Dim founddoc As NotesDocument
	Dim founditem As notesitem
	Dim username As NotesName
	Dim strusername As String
	Dim i As Integer
	
	Set founddoc = mydc.GetFirstDocument()
	
	Do While Not founddoc Is Nothing
		' check if document is not in the unwanted documents list
		If Iselement(formnames(founddoc.form(0))) = False Then
			If founddoc.HasItem("fldErledigenVerantwortlich") Then
				'get all the values of this item if it is a multivalue field
				Set founditem = founddoc.GetFirstItem("fldErledigenVerantwortlich")
				Forall v In founditem.Values
					' check if v is a valid UserName
					' search to know if the name exist
					If Not(Trim(v)="") Then
						strusername = v
						' reshape the users name if a matching name is found
						If Iselement(alluserslist(strusername)) = True Then
							strusername = alluserslist(strusername)
							' check if there is already an entry in the userdocumentlist
							If Iselement(userdclist(strusername)) = True Then
								userdclist(strusername) = userdclist(strusername) + "~" + founddoc.UniversalID
							Else
								userdclist(strusername) = founddoc.UniversalID
							End If
						Else
							If Iselement(userdclist("User not Found " + strusername)) = True Then
								userdclist("User not Found " + strusername) = userdclist("User not Found " + strusername) + "~" + founddoc.UniversalID
							Else
								userdclist("User not Found " + strusername) = founddoc.UniversalID
							End If
						End If
					End If
				End Forall
			End If
		End If
		Set founddoc = mydc.getnextdocument(founddoc)
	Loop
End Sub
Sub Sendusermail
	' sends the mail to the user. The mail is send as html and as NotesACL mail wich later on will be konfigurable for the type of user (notes or web)
	' each document found is one entry in the list
	Stop
End Sub
Sub fetchvalidusers(mysession As NotesSession)
	Dim mybooks As Variant
	Dim myview As NotesView
	Dim mydoc As NotesDocument
	Dim myitem As NotesItem
	Dim myqualifiedname As String
	Dim myfoundqualified As Integer
	Dim mypersonname As String
	Dim i As Integer
	
	mybooks = mysession.AddressBooks
	Forall b In mybooks
    ' check every Domino Directory,
    ' unless we're already done
		If ( b.IsPublicAddressBook ) Then
			Call b.Open( "", "" )
      ' look up person's last name
      ' in People view of address book
			Set myview = b.GetView( "People" )
			Set mydoc = myview.Getfirstdocument()
			Do While Not mydoc Is Nothing
				' fetch the persons fully qualified name and check if it is a full qualified name
				If mydoc.HasItem("Fullname") Then
					Set myitem = mydoc.GetFirstItem("FullName")
					Forall v In myitem.Values
						mypersonname = v
						If validateuser(mypersonname) = True Then
							myqualifiedname = mypersonname
							myfoundqualified = True
							Exit Forall
						End If
					End Forall
					If myfoundqualified = True Then
					' fetch the full name
						Call fetchnameandadd(mydoc,"FullName", myQualifiedname)
					' fetch the short name entry
						Call fetchnameandadd(mydoc,"ShortName", myQualifiedname)
					End If
				End If
				Set mydoc = myview.GetNextDocument(mydoc)
			Loop
		End If
	End Forall
	
End Sub
Function validateuser(myusername As String) As Integer
	Dim checkusername As NotesName
	Set checkuserName = New NotesName(myusername)
	If (checkuserName.CANONICAL = checkuserName.COMMON) Then
		validateuser = False
	Else
		validateuser = True
	End If
End Function
Sub fetchnameandadd(mydoc As NotesDocument, myitemname As String, myqualifiedname As String)
	Dim myitem As NotesItem
	If mydoc.HasItem(myitemname) Then
		Set myitem = mydoc.GetFirstItem(myitemname)
	' add all entries in this item to the list
		Forall v In myitem.Values
			If Iselement(alluserslist(v)) = False Then
				alluserslist(v) = myqualifiedname
			End If
		End Forall
	End If
End Sub
 
 

Und wenn jemand das bis hierhin gelesen und nicht verstanden hat dann kann ich ihm das gerne noch erklären. 

[koehlerbv]

Meine Erfahrung ist, dass (zumindest in bestimmten Versionen)
NotesSession.Addressbooks.IsPublicAddressBook
nicht zuverlässig funktioniert und auch PersNames als solches deklariert.
Ich prüfe daher sicherheitshalber noch auf das Vorhandensein der Ansicht  "($Networks)".
Weiterhin: Das Verfahren ist alles andere als performant. Aber eben besser als nix ...

Bernhard