'Yels QDDI v1: 
	'Create an Agent 'Action menu selection' Target 'None' or copy the script into a button or 
	'Insert this in Sub Click of a Button
	'inChoose=0 --> Performs on current database
	'inChoose=1 --> Let's a user select a database and get's various information on a database (incl. acl and agent information)
	'inChoose=3 --> Else enter the Info SNAME = Your Server / SNAME = The full Path to the database (also local)
	'
	'Results saved as DRAFT in users mailbox and opened
	Dim nss As New NotesSession
	Dim nws As New NotesUIWorkspace
	Dim db As NotesDatabase, dbMail As New NotesDatabase("","")
	Dim nnm As NotesName
	dim inChoose as Integer
	Dim SNAME As String, FNAME As String, stRights As String
	
	'1 = Let choose, 0= current database else = defined database
	inChoose = 1
	if inChoose = 0 then
		Set db = nss.CurrentDatabase
		SNAME = db.Server
		FNAME = db.FilePath
	ElseIf inChoose = 1 Then
		vDB = nws.Prompt(13,"[Choose Database]","Please select a database")
		SNAME = vDB(0)
		FNAME = vDB(1)
		Set db = nss.GetDatabase(SNAME,FName,False)
		If Not db.IsOpen Then Exit Sub
	Else
		SNAME = "YourServer"
		FNAME = "YourDatabase"
		Set db = nss.GetDatabase(SNAME,FName,False)
		If Not db.IsOpen Then Exit Sub
	End If
	
	Dim dbACL As NotesACL
	Dim dbACLEntry As NotesACLEntry
	Set dbACL = db.ACL
	Dim firsttime, newline, newtab
	Set nnm = New NotesName(SNAME)
	SNAME = nnm.Abbreviated
	
	Print "Checking " + db.Title + " on " + SNAME
	
	firsttime = 0  
	newline = Chr(10)&Chr(13)
	newtab = Chr(9)
	Entrysep = String(60, "*")
	
	Call dbMail.OpenMail
	If Not dbMail.IsOpen Then Exit Sub
  REM Create document with Body rich text item
	Dim doc As New NotesDocument(dbMail)
	Call doc.ReplaceItemValue("Form", "Memo")
	Call doc.ReplaceItemValue("Subject", "DB-Info: '" + db.Title + "'")
	Dim body As New NotesRichTextItem(doc, "Body")
  REM Create table in Body item
	rowCount% = 7
	columnCount% = 2
	
	Dim styles(1 To 2) As NotesRichTextParagraphStyle
	Set styles(1) = nss.CreateRichTextParagraphStyle
	styles(1).LeftMargin = 0
	styles(1).FirstLineLeftMargin = 0
	styles(1).RightMargin = RULER_ONE_CENTIMETER * 4
	Set styles(2) = nss.CreateRichTextParagraphStyle
	styles(2).LeftMargin = RULER_ONE_CENTIMETER*2
	styles(2).FirstLineLeftMargin = 0
	styles(2).RightMargin = RULER_ONE_CENTIMETER * 12
	Call styles(2).SetTab( RULER_ONE_CENTIMETER*2, 2 )
	Call body.AppendTable(rowCount%, columnCount%,,, styles)
	'Call body.AppendTable(rowCount%, columnCount%)
  REM Populate table
	Dim rtnav As NotesRichTextNavigator
	Set rtnav = body.CreateNavigator
	Call rtnav.FindFirstElement(RTELEM_TYPE_TABLECELL) 
	For iRow% = 1 To 7 Step 1
		For iColumn% = 1 To 2 Step 1
			Call body.BeginInsert(rtnav)
'----> BEGIN INSERT
			If iRow% = 1 And iColumn% = 1 Then
				Call body.AppendText("Database")
			Elseif iRow% = 1 And iColumn% = 2 Then
				Call body.AppendDocLink(db,"Link to " + db.Title)
				Call body.AppendText(" " + db.Title)
			Elseif  iRow% = 2 And iColumn% = 1 Then
				Call body.AppendText("Location")
			Elseif  iRow% = 2 And iColumn% = 2 Then
				Call body.AppendText(FNAME + " on " + SNAME)
			Elseif  iRow% = 3 And iColumn% = 1 Then
				Call body.AppendText("Replica-ID")
			Elseif  iRow% = 3 And iColumn% = 2 Then
				Call body.AppendText(db.ReplicaID)
			Elseif  iRow% = 4 And iColumn% = 1 Then
				Call body.AppendText("Size")
			Elseif  iRow% = 4 And iColumn% = 2 Then
				Call body.AppendText(Format( Round(db.Size/1024/1024 , 2),"0.00" ) + " MB (" + Cstr(db.Percentused) + "% used)")
			Elseif  iRow% = 5 And iColumn% = 1 Then
				Call body.AppendText("Quota")
			Elseif  iRow% = 5 And iColumn% = 2 Then
				Call body.AppendText(Format( Round(db.SizeQuota/1024 , 2),"0.00") + " MB")
			Elseif  iRow% = 6 And iColumn% = 1 Then
				Call body.AppendText("ACL")
			Elseif  iRow% = 6 And iColumn% = 2 Then
				Set dbACLEntry = dbACL.GetFirstEntry
				
				If DBacl.UniformAccess = True Then 
					Call body.AppendText( "Consistent ACL: " & newtab & "YES")
				Else
					Call body.AppendText("Consistent ACL: " & newtab & "NO")
				End If
				Call body.AddNewline(1)
				Call body.AppendText(EntrySep)
				Call body.AddNewline(1)
				
				While Not ( dbACLEntry Is Nothing )
					If firsttime = 0 Then 
						firsttime = firsttime + 1
					Else
						If dbACL.GetNextEntry ( dbACLEntry ) Is Nothing Then
							Goto NoACLWrite
						Else
							Set dbACLEntry = dbACL.GetNextEntry ( dbACLEntry )
							firsttime = firsttime + 1
						End If
					End If
					
					If dbACLEntry.Isgroup Then 
						Call body.AppendText("Group: ")
					Elseif dbACLEntry.Isperson Then 
						Call body.AppendText("User: ")
					Elseif dbACLEntry.Isadminserver Then 
						Call body.AppendText("AdminS.: ")
					Elseif dbACLEntry.Isserver Then 
						Call body.AppendText("Server: ")
					Else
						Call body.AppendText("Entry: ")
					End If
					Set nnm = New NotesName(dbACLEntry.Name)
					Call body.AppendText(newtab & nnm.Abbreviated)
					Call body.AddNewline(1)
					Select Case dbACLEntry.Level
					Case ACLLEVEL_NOACCESS : level = "No Access"
					Case ACLLEVEL_DEPOSITOR : level = "Depositor"
					Case ACLLEVEL_READER : level = "Reader"
					Case ACLLEVEL_AUTHOR : level = "Author"
					Case ACLLEVEL_EDITOR : level = "Editor"
					Case ACLLEVEL_DESIGNER : level = "Designer"
					Case ACLLEVEL_MANAGER : level = "Manager"
					End Select
					Call body.AppendText("Access: " & newtab & level)
					Call body.AddNewline(1)
					
		'C - Create Documents, D - Delete Documents, PA - Create Personal Agents, PF - Create Personal Folders/Views,
		'SF - Create Shared Folders Views, LS - Create LotusScript/Java Agent, RP - Read Public Documents, WP - Write Public Documents , RoC - Replicate or Copy documents
					stRights = ""
					If dbACLEntry.CanCreateDocuments Then stRights = stRights + ", C"
					If dbACLEntry.CanDeleteDocuments Then stRights = stRights + ", D"
					If dbACLEntry.Cancreatepersonalagent Then stRights = stRights + ", PA"
					If dbACLEntry.Cancreatepersonalfolder Then stRights = stRights + ", PF"
					If dbACLEntry.Cancreatesharedfolder Then stRights = stRights + ", SF"
					If dbACLEntry.Cancreatelsorjavaagent Then stRights = stRights + ", LS"
					If dbACLEntry.Ispublicreader Then stRights = stRights + ", RP"
					If dbACLEntry.Ispublicwriter Then stRights = stRights + ", WP"
					If dbACLEntry.Canreplicateorcopydocuments Then stRights = stRights + ", RoC"
					If stRights<>"" Then 
						Call body.AppendText("Rights:" & newtab & Right(stRights,Len(stRights)-2))
						Call body.AddNewline(1)
					End If
					
					dbRoles = dbACLEntry.Roles
					inRCount=0
					If Not Trim(Cstr(dbRoles(0))) = "" Then
						Forall dbRole In dbRoles
							inRCount = inRCount + 1
							If inRCount=1 Then
								Call body.AppendText("Role/s: " & newtab  &  dbRole)
							Else
								Call body.AppendText(", " & dbRole)
							End If
						End Forall
						Call body.AddNewline(1)
					Else
						Call body.AppendText("Role/s:" & newtab & "-none-")
						Call body.AddNewline(1)
					End If
					Call body.AppendText(Entrysep)
					Call body.AddNewline(1)
					aclentries = aclentries + 1
				Wend
NoACLWrite:
				'Just type the descr.
				Call body.AppendText("C - Create Documents, D - Delete Documents")
				Call body.AddNewline(1)
				Call body.AppendText("PA - Create Personal Agents, PF - Create Personal Folders/Views")
				Call body.AddNewline(1)
				Call body.AppendText("SF - Create Shared Folders Views, LS - Create LotusScript/Java Agent")
				Call body.AddNewline(1)
				Call body.AppendText("RP - Read Public Documents, WP - Write Public Documents")
				Call body.AddNewline(1)
				Call body.AppendText("RoC - Replicate or Copy documents")
			Elseif  iRow% = 7 And iColumn% = 1 Then
				Call body.AppendText("Agents")
			Elseif  iRow% = 7 And iColumn% = 2 Then
				If Not Isarray(db.Agents) Then 
					Call body.AppendText("No Agents found")
				Else
					Forall nag In db.Agents
						nagTIT = nag.name
						If Not nag.IsPublic Then nagTIT = "PRIVATE " + nagTIT
						Call body.AppendText("Title: " & newtab  &  nagTIT)
						Call body.AddNewline(1)
						nagTr = ""
						nagTA = ""
						Select Case nag.Trigger
						Case TRIGGER_NONE : nagTR = "No Trigger"
						Case TRIGGER_MANUAL : nagTR = "Manual agent"
						Case TRIGGER_SCHEDULED : nagTR = "Scheduled"
						Case TRIGGER_AFTER_MAIL_DELIVERY : nagTR = "After mail delivery"
						Case TRIGGER_BEFORE_MAIL_DELIVERY : nagTR = "Before mail delivery"
						Case TRIGGER_DOC_PASTED : nagTR = "After document has been pasted"
						Case TRIGGER_DOC_UPDATE : nagTR = "After document has been updated"
						End Select
						
						If Not (nag.Trigger = 0 Or nag.Trigger = 4) Then
							If nag.IsEnabled Then nagTR = "ENABLED " + nagTR Else nagTR = "DISABLED " + nagTR
						End If
						
						Select Case nag.Target
						Case TARGET_ALL_DOCS : nagTA = " on all documents"
						Case TARGET_NEW_DOCS : nagTA = " on new documents"
						Case TARGET_NEW_OR_MODIFIED_DOCS : nagTA = " on new or modified documents"
						Case TARGET_SELECTED_DOCS : nagTA = " on selected documents"
						Case TARGET_ALL_DOCS_IN_VIEW : nagTA = " on all documents in view"
						Case TARGET_UNREAD_DOCS_IN_VIEW : nagTA = " on unread documents in view"
						Case TARGET_NONE : nagTA  = ""
						End Select
						
						Call body.AppendText("Schedule:" & newtab  &  nagTR & nagTA)
						
						If Not nag.Servername = "" Then 
							Set nnm = New NotesName(nag.Servername)
							Call body.AppendText(" to run on "  &  nnm.Common)
							Call body.AddNewline(1)
						Else
							Call body.AddNewline(1)
						End If
						
						Set nnm = New NotesName(nag.Owner)
						Call body.appendText("Owner:"  & newtab  &  nnm.Common)
						If Not nag.Comment="" Then 
							Call body.AddNewline(1)
							Call body.AppendText("Descr.:" & newtab & nag.Comment)
						End If
						Call body.AddNewline(1)
						Call body.AppendText(Entrysep)
						Call body.AddNewline(1)
					End Forall
				End If
			End If
'----> END INSERT			
			Call body.EndInsert
			Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
		Next
	Next
  REM Save document and refresh view
	Call doc.Save(True, False)
	Call nws.ViewRefresh
	Call nws.EditDocument(True,doc)