domino 修改数据库的acl-lotusscript代码

Option Public
Option Declare
					 


Sub Initialize
	On Error GoTo delError
	Dim ss As NotesSession
	Dim db As  NotesDatabase
	Dim tempMaildb As  NotesDatabase
	Dim ans As String
	'Print "Content-Type: text; charset: utf-8"
	 Exit sub
	'代理需要开启最高执行权限
	'不同的环境的路径拼接不同
	'功能：修改各个数据库的ACL用户的类型，或者新增某个用户
	'Print "Content-type=text/html; charset=gb2312;"
	MessageBox "###邮件数据库检测开始"+"-- passwords UpdateMialSomeACL----------beg"
	%rem
	Dim maillist(1 To 6) As String
	
	maillist(1)="mail/aaa4.nsf"

	 
	'Exit sub
	 %end rem
 

	Set ss = New NotesSession
	Set db = ss.Currentdatabase
	Dim filepath As String
	ans=""'记录函数执行结果，保存异常的数据名称
	filepath=ss.GetEnvironmentString("Directory", True)+"/mail"'路径斜杠
	MessageBox"filepath="+filepath
	'filepath="C:\Program Files\IBM\Domino\data\domino\html\\u"
	 
 
	Dim entry As NotesACLEntry
	Dim entryT As NotesACLEntry
	Dim entryNew As NotesACLEntry
	Dim NotesACL As NotesACL
	Dim F1,F2,F3,F4 As Boolean
	 
	F1=False
	F2=False
	F3=False
	F4=False
	Dim high,i As Integer
	high=1
	Dim temphigh As Integer
	Dim x As String
	temphigh=UBound(maillist)
	MessageBox "循环测试="+CStr(temphigh)
	For i=1 To temphigh
		x=maillist(i)
		MessageBox  "########x="+x+" high="+CStr(high)
		
		Set tempMaildb=ss.Getdatabase("",x,"")'不同环境斜杠不同
		
		If Not tempMaildb.isopen Then
			MessageBox" 不存在数据库="+x+" high="+CStr(high)

			
			
			'Set collection = tempMaildb.AllDocuments  
			'collection.Count    
			'MessageBox"异常的邮件数据库#####文件路径 " + temppath +"/" + f+"####异常 ReplicaID="+cstr(tempMaildb.ReplicaID)+" #all="+CStr(collection.Count)
			'Print "<th>false#&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"+"文件路径 " + temppath +"/" + f+" #ReplicaID="+"####异常"+"</th><br>"
		Else
			'MessageBox" 数据库="+x+" high="+CStr(high)
			'给当前数据库 新增2个用户 并同时处理其等级和类型
			Set NotesACL = tempMaildb.ACL
			
		 
			Set entry = NotesACL.GetFirstEntry
			'判断ACL某个用户是否已存在-循环ACL
			While  Not entry Is Nothing 
				Set entryT=NotesACL.Getnextentry(entry)
				'如果执行本句输出， 会影响函数运行。原因未知
				'MessageBox "      数据库="+x+" high="+CStr(high)+"####   Name="+entry.Name+"  Level="+CStr(entry.Level)+" Usertype="+CStr(entry.Usertype)
				
				If  entry.Name="LocalDomainAdmins"  Then
					F1=True
					If entry.Usertype = ACLTYPE_PERSON_GROUP  Then						
						F3=True
						'	MessageBox "    数据库="+x+" high="+CStr(high)+"   set F1=true"
					Else
						'修改用户类型-部分原始数据的类型错误
						entry.Usertype=ACLTYPE_PERSON_GROUP
						Call NotesACL.Save
					End If
					
				
				End If
				
				
				If  entry.Name="LocalDomainServers" Then					
					F2=True
					'MessageBox "    数据库="+x+" high="+CStr(high)+"   set F2=true"
					If entry.Usertype = ACLTYPE_SERVER_GROUP  Then						
						F4=True
						'	MessageBox "    数据库="+x+" high="+CStr(high)+"   set F1=true"
					Else
						'修改用户类型-部分原始数据的类型错误
						entry.Usertype=ACLTYPE_SERVER_GROUP
						Call NotesACL.Save
					End If
				End If
				'当前的ACL
				
				Set  entry=entryT
			Wend
			 '名称如果存在 则无法新增。
			 If Not F1 Then
				Set entryNew = New NotesACLEntry(NotesACL,"LocalDomainAdmins", 6)
				entryNew.Usertype=ACLTYPE_PERSON_GROUP
				Call NotesACL.Save
				MessageBox " 数据库="+x+" 新增 LocalDomainAdmins"
			 End If
			If Not F2 Then
				Set entryNew = New NotesACLEntry(NotesACL,"LocalDomainServers", 6)
				entryNew.Usertype=ACLTYPE_SERVER_GROUP
				Call NotesACL.Save
				MessageBox " 数据库="+x+" 新增 LocalDomainServers"
			End If
			
			
		End If
		F1=False'归零
		F2=False
		high=high+1
	Next i

	MessageBox"###邮件数据库ACL修改完成结束"+"-- passwords UpdateMialSomeACL---end"
 
	Exit Sub
	 
 
	 
	
	Exit Sub
delError:
	MessageBox  Error()+" at line:" +Cstr(Erl())+"    passwords,代理 checkMailSys"		
End Sub