domino 根据DB.Sizequota批量修改Sizequota

林中随行
于 2021-06-22 23:16:27 发布
阅读量132
点赞数
本文链接：https://blog.csdn.net/oyiqing1/article/details/118121579
版权
tempMaildb.SizeWarning=0
tempMaildb.Sizequota=0
%REM
	Agent MailGetxianzhi
 
	Description: Comments for Agent
%END REM
Option Public
Option Declare



 

Dim ss As NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim note As NotesDocument
Dim doc As NotesDocument
Dim  High As Integer
Dim  HighAll As Integer
 Dim ans  As String
Dim tempMaildb As NotesDatabase

Dim collection As NotesDocumentCollection  
Dim names_db As NotesDatabase



					 


Sub Initialize
	On Error GoTo delError
	'Print "Content-Type: text; charset: utf-8"
	'ShowSonPath注释掉了-归零查询数据库的限额大小
	'本代理是一个一次性的部署数据操作工具，执行完成之后，需要注释掉执行逻辑部分
	'
	
	Exit Sub
	
	Print "Content-type=text/html; charset=gb2312;"
	MessageBox "###邮件数据库检测开始"+"-- passwords checkMailSys"
	
	
	Set ss = New NotesSession
	Set db = ss.Currentdatabase
	Dim filepath As String
	ans=""'记录函数执行结果，保存异常的数据名称
	filepath=ss.GetEnvironmentString("Directory", True)+"/mail"'路径斜杠
	Set names_db = ss.Getdatabase("", "names.nsf",False)'环境
	
	MessageBox "filepath="+filepath
	'filepath="C:\Program Files\IBM\Domino\data\domino\html\\u"
	High=1
	HighAll=4 '递推深度限制，首次为1。递推之前加一判断
	
	Call ShowSonPath(filepath,High)'这是自我调用的递推函数



	MessageBox "###邮件数据库检测结束"+"-- passwords checkMailSys"
	
	Exit Sub
delError:
	MessageBox  Error()+" at line:" +Cstr(Erl())+" passwords,代理 MailGetxianzhi"		
End Sub
Function SetInfoLog(getdb As NotesDatabase,temp3 As String,temp4 As String)
	On Error GoTo ers

	'Set ms_db = session.Getdatabase(db.Server, "/message.nsf",False)
	Dim session As NotesSession
	Dim searchstr As String
	Set session = New NotesSession
	Dim Firdoc As NotesDocument
	Dim ms_doc As NotesDocument

	Dim MailFile As String
	MailFile=getdb.Filepath
	'MessageBox  " "
	'MessageBox  " "
	MessageBox "Filepath="+getdb.Filepath+" Filename="+ getdb.Filename+"  temp3="+temp3+"  temp4="+temp4
	'ndoc.MailFile(0)
	MailFile = Replace(MailFile,".nsf","",,,1)
	'MessageBox "  原始文件="+MailFile
	If names_db.IsOpen Then		
		'searchstr="Form="+{"Person"}+"&"+"MailFile="+MailFile	
		
		temp4 = Replace(temp4,".nsf","",,,1)
		searchstr="Form="+{"Person"}+"&"+"(@Contains(MailFile;'"+temp4+"'))" 
		
		
		
		'searchstr="Form="+{"Person"}+"&"+"MailFile="+"mail\lbs10295"
		'searchstr=formatSearch(searchstr)
		
		Dim docs As NotesDocumentCollection
		'MessageBox "  searchstr="+searchstr
		Set docs=names_db.Search(searchstr,Nothing,1000)   'names.nsf执行搜索		"Person"
		Set Firdoc=docs.Getfirstdocument()
		'LastName
		'FullName
		If Firdoc Is Nothing  Then
			MessageBox "  searchstr检索结果为空没有找到"
		
			Set ms_doc=SearchSIZEQUOTAByPath(getdb.Filepath)
			If ms_doc Is Nothing Then
				Set ms_doc = db.Createdocument()
				MessageBox "  searchstr检索结果为空没有找到"
			Else
				MessageBox "  searchstr 找到已存在配置 不再新增"
			End If
			
			ms_doc.Form="SizequotaForm"			
			ms_doc.YsMailFile=getdb.Filepath '数据库中记录
			ms_doc.Sizequota=getdb.Sizequota	 
			ms_doc.Ans="Names中没有对应人员"
			Call ms_doc.Save(True,True)
			
			SetInfoLog=False
			
		Else
			'MessageBox "  LastName="+Firdoc.LastName(0)+" FullName="+Firdoc.FullName(0)+" File="+Firdoc.MailFile(0)	
			Dim itemt As NotesItem
			Set itemt =Firdoc.Getfirstitem("MailFile")
			'MessageBox "  Text="+itemt.Text
			
			'MessageBox "  MailFile="+Firdoc.MailFile(0)
			Set ms_doc=SearchSIZEQUOTAByPath(getdb.Filepath)
			If ms_doc Is Nothing Then
				Set ms_doc = db.Createdocument()
				MessageBox "  配置数据库没有找到记录，新增配置记录"
			Else
				MessageBox "  配置记录已存在 db="+ms_doc.MailFile(0)
			End If
			
		
		
			ms_doc.Form="SizequotaForm"			
			ms_doc.YsMailFile=getdb.Filepath '数据库中记录
			ms_doc.Sizequota=getdb.Sizequota	 
			ms_doc.MailFile=Firdoc.MailFile(0) 'names中记录的
			ms_doc.LastName = Firdoc.LastName(0)'names中记录的
			ms_doc.FullName = Firdoc.FullName(0)	'names中记录的	
			ms_doc.ShortName = Firdoc.ShortName(0)'names中记录的	
			Call ms_doc.Save(True,True)
			SetInfoLog=True
		End If		
	End If
	
	
	Exit Function
	'在当前数据库创建相应的日志

	Exit Function
ers:	
	SetInfoLog="false"
	Print "{""result"":false,""msg"":""SetInfoLog Err！""}"
	MessageBox  Error()+" at line:" +Cstr(Erl())+",fun SetInfoLog"
End Function


%REM
	Sub killFile
	Description: Comments for Sub
	获取某个路径下的所有文件
	获取某个路径下的所有目录
	thishigh记录函数所在递推的次数。第一次为1，默认为0
%END REM
Sub ShowSonPath(path As String,thishigh As Integer)
	On Error GoTo ShowSonPathError
	'MessageBox "(path=)"+ path+"  thishigh="+CStr(thishigh)
	Dim temppath As String
	Dim filenames As String
	Dim filens As String	
	Dim nexhigh As Integer	
	nexhigh=thishigh	
	temppath = path
	filenames=Dir(temppath+"/*.*", 0)'获取某路径下的所有文件夹和文件		
	Dim fs As Variant'存储某目录下所有文件的名称 不含目录 A;B;C;
	Do While filenames <> ""
		'MessageBox "大循环="+filenames
		If fs ="" Then
			fs=filenames
		Else
			'MessageBox "执行了几次-------filenames="+filenames
			fs=fs+";"+filenames
		End If
		filenames = Dir$()
	Loop
	Dim temp3  As String
	Dim temp4  As String
	Dim  high As Integer
	high=1
	If fs <> "" Then
		fs=Split(fs,";")
		ForAll f In fs
			'Kill temppath+"/"+f  '删除文件！！！！！！！
			
			'Print  "<th>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"+"文件路径  " + temppath + "\" + f+"</th><br>"
			'tempMaildb
			temp3="mail/"+f
			temp4=f			
			If InStr(temp3,"nsf")>1 Then
				MessageBox " "
				MessageBox " "
				MessageBox "  temp3="+temp3+" high="+CStr(high)
				
				'大于10的时候结束循环
				'If high>10 Then					
				'	Exit sub
				'End If
				
				
				Set tempMaildb=ss.Getdatabase("",temp3,"")'不同环境斜杠不同
				If Not tempMaildb.isopen Then
					If  ans<>"" Then
						ans=ans+"@"+f'保存异常数据库名称
					Else
						ans=f'保存异常数据库名称
					End If
					'tempMaildb.ReplicaID					
					'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					
					'计算出来的kb-MB需要除以1024
					'MessageBox "Sizequota"+tempMaildb.Sizequota
					Set collection = tempMaildb.AllDocuments 					
					MessageBox "  #Filepath="+tempMaildb.Filepath+" Filename="+ tempMaildb.Filename+"  temp3="+temp3+"  Sizequota="+CStr(tempMaildb.Sizequota)
					
					If SetInfoLog(tempMaildb,temp3,temp4) Then
						'记录写入成功
						'tempMaildb.Sizequota=153600.
						'MessageBox "  #  Filepath="+tempMaildb.Filepath+" Filename="+ tempMaildb.Filename+"  temp3="+temp3+"  Sizequota="+CStr(tempMaildb.Sizequota)
						
						'######################
						'第一次测试时候不重置数据库的限额大小和警告大小
						'######################
						tempMaildb.SizeWarning=0
						tempMaildb.Sizequota=0					
						MessageBox "  #  Filepath="+tempMaildb.Filepath+" Filename="+ tempMaildb.Filename+"  temp3="+temp3+"  Sizequota="+CStr(tempMaildb.Sizequota)
						
						Print  "<th>true#&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"+"文件路径 #" + temppath+ "/" + f+" #ReplicaID="+cstr(tempMaildb.ReplicaID)+" #all="+CStr(collection.Count)+" #Sizequota="+CStr(tempMaildb.Sizequota)+"</th><br>"
						
					Else
						'写入失败
						tempMaildb.SizeWarning=0
						tempMaildb.Sizequota=0	
						
						MessageBox "  ###异常Filepath="+tempMaildb.Filepath+" Filename="+ tempMaildb.Filename+"  temp3="+temp3+"  Sizequota="+CStr(tempMaildb.Sizequota)
						Print  "<th>true#&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"+"异常文件路径 #" + temppath+ "/" + f+" #ReplicaID="+cstr(tempMaildb.ReplicaID)+" #all="+CStr(collection.Count)+" #Sizequota="+CStr(tempMaildb.Sizequota)+"</th><br>"
						
					End If
					
					'在当前数据库创建对应的人员-账号-邮件数据库路径-限额大小
					'清空这个邮件数据库的限额大小
				
				End If
			End If
			high=high+1
			'If high =10 Then
			'	Exit sub
			'End If
		End ForAll
		'Call outPutFile(temppath, fs)
	End If

	'获取某路径下的所有文件夹
	filenames=Dir(temppath+"\*", 16)
	Dim lastStr As String
	Dim filelist As String
	Do While filenames <> ""
		If Right(filenames, 3) = "doc" Then
			'Print "filenames " + filenames
		End If
		If Right(filenames, 4) = "docx" Then
			'Print "filenames " + filenames
		End If
		
		If InStr(filenames,".") <= 0 And Trim(filenames) <> "" And InStr(filenames, "ATT") <= 0 Then	'有ATT开头的无后缀的文件不要
			'记录文件夹
			If filelist ="" Then
				filelist=filenames
			Else
				filelist=filelist+";"+filenames
			End If
			
		End If
		filenames = Dir$()
	Loop
	
	' 递推文件夹
	Dim temp As String
	
	Dim vlist As Variant
	If filelist <> "" Then
		vlist=Split(filelist,";")
		
		'thishigh=thishigh+1
		nexhigh=nexhigh+1
		ForAll v In vlist
			If Trim(v) <> "" Then
				
				'Print " ============执行递推文件夹="+temppath+"\"+v+"  high="+CStr(nexhigh)
				
				Print "<th>深度#"+CStr(nexhigh)+"#执行递推文件夹#="+temppath+"\"+v+"</th><br>"
				
				If nexhigh<=HighAll  Then'对递推的高度进行限制
					Call ShowSonPath(temppath+"\"+v,nexhigh)'进行递推
				Else
					Print "超出递推次数------"
				End If
				'Call killFile(temppath+"/"+v)
				'RmDir(temppath+"/"+v) '删除目录！！！！！！
			End If	
		End ForAll
	End If

	Exit Sub
ShowSonPathError:
	'Print "Error:-->"+"["+temppath+"]"+Error +"<br>"
	MessageBox  Error()+" at line:" +Cstr(Erl())+",Fun ShowSonPath"
End Sub
Function SearchSIZEQUOTAByPath(temp4 As String)As notesdocument
	On Error GoTo ers
	'在配置数据库 寻找配置文档是否存在
	'Set ms_db = session.Getdatabase(db.Server, "/message.nsf",False)
	Dim session As NotesSession
	Dim searchstr As String
	Dim ms_db As NotesDatabase
	Set session = New NotesSession
	Dim Firdoc As NotesDocument

	Set ms_db = session.Getdatabase("", "resource.nsf",False)'测试环境	
	Dim MailFile As String	 
	MessageBox "  temp4="+temp4
 
	If ms_db.IsOpen Then		
		'searchstr="Form="+{"Person"}+"&"+"MailFile="+MailFile	
		
		temp4 = Replace(temp4,".nsf","",,,1)
		MessageBox "  处理后的temp="+temp4
		temp4=StrRight(temp4,"/")
		MessageBox "  处理后的temp4="+temp4
		searchstr="Form="+{"SizequotaForm"}+"&"+"(@Contains(MAILFILE;'"+temp4+"'))" 	
		
		'searchstr="Form="+{"Person"}+"&"+"MailFile="+"mail\lbs10295"
		'searchstr=formatSearch(searchstr)		
		Dim docs As NotesDocumentCollection
		MessageBox "  searchstr="+searchstr
		Set docs=ms_db.Search(searchstr,Nothing,1000)'names.nsf执行搜索		"Person"
		Set Firdoc=docs.Getfirstdocument()
		'LastName
		'FullName	
		If Firdoc Is Nothing  Then			
			Set SearchSIZEQUOTAByPath=nothing
		Else
			MessageBox "Universalid="+Firdoc.Universalid
			Set SearchSIZEQUOTAByPath=Firdoc
		End If	
	Else
	'配置数据库没有找到
		MessageBox "警告邮件系统-限额配置数据库没有找到!!!" 	 
	 
		Set SearchSIZEQUOTAByPath=Nothing
	End If
	 

	Exit Function
ers:	
	Set SearchSIZEQUOTAByPath=Nothing
	Print "{""result"":false,""msg"":""SearchSIZEQUOTAByPath Err！""}"
	MessageBox  Error()+" at line:" +Cstr(Erl())+",fun SetInfoLog"
End Function
%REM
	Function formatSearch
	Description: Comments for Function
	格式化成可搜索的语句
%END REM
Function formatSearch(keystr As String) As String
	Dim asstr As String
	asstr = Replace(keystr,{(},{"("})
	asstr = Replace(asstr,{)},{")"})
	asstr = Replace(asstr,{*},{"*"})
	asstr = Replace(asstr,{?},{"?"})
	asstr = Replace(asstr,{or},{"or"})
	asstr = Replace(asstr,{and},{"and"})
	asstr = Replace(asstr,{<},{"<"})
	asstr = Replace(asstr,{>},{">"})
	asstr = Replace(asstr,{not},{"not"})
	asstr = Replace(asstr,{|},{"|"})
	asstr = Replace(asstr,{,},{","})
	asstr = Replace(asstr,{&},{"&"})
	asstr = Replace(asstr,{=},{"="})
	formatSearch = asstr
End Function
林中随行
关注
0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
domino 根据DB.Sizequota批量修改Sizequota

tempMaildb.SizeWarning=0 tempMaildb.Sizequota=0 %REM Agent MailGetxianzhi Description: Comments for Agent%END REMOption PublicOption Declare Dim ss As NotesSessionDim db As NotesDatabaseDim view As NotesViewD...
复制链接

扫一扫