domino 导出特定路径所有数据库的大小和数据量

domino 导出特定路径所有数据库的大小和数据量。服务端执行的代码范例

 

%REM
	Agent (CheckOASysforWeb)
	 
	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 pathFIR As String
Dim pathFIR2 As String	
Dim pathFIR3 As String	
		 
Dim filepathOut As String
Dim ResultXlsPath As String
Dim XlsData As String
Dim sendtoMan As string




Sub Initialize
	On Error GoTo delError
	 
	'检测本服务器特定目录的所有数据库大小并邮件发送管理员
	'代码中已经注释掉删除相对路径的语句
	'代理需要开启最高执行权限
	'不同的环境的路径拼接不同
    
	'Call killFile(temppath+"/"+v)
	'RmDir(temppath+"/"+v) '删除目录！！！！！！
 	'
	
	'Print "Content-type=text/html; charset=gb2312;"
	sendtoMan="admin/***"  '//收件地址
	Print |Content-Type:application/vnd.ms-excel; charset=GB2312| 
	Print |Content-Disposition:Attachment; filename="data.xls"|
	Print |<table  border="1">|	
	Print "<tr>"
	MessageBox "###数据库检测开始"
	
	
	Set ss = New NotesSession
	Set db = ss.Currentdatabase
	Dim filepath As String
	ans=""'记录函数执行结果，保存异常的数据名称
	pathFIR="oa"
	'pathFIR=""
	If  InStr(ss.Platform,"windows")>=1 Then
		pathFIR2="/"'"\"
	Else
		pathFIR2="/"
		
	End If
	MessageBox  "Platform="+ss.Platform
	If pathFIR<>"" Then
		filepath=ss.GetEnvironmentString("Directory", True)+pathFIR2+pathFIR '路径斜杠
		pathFIR3=ss.GetEnvironmentString("Directory", True)+pathFIR2
	Else
		filepath=ss.GetEnvironmentString("Directory", True) '路径斜杠
		pathFIR3=ss.GetEnvironmentString("Directory", True)
	End If
		
	MessageBox "filepath="+filepath
	MessageBox "filepath="+filepath
	MessageBox "filepath="+filepath	
	'filepath="C:\Program Files\IBM\Domino\data\domino\html\\u"
	High=1
	HighAll=4 '递推深度限制，首次为1。递推之前加一判断	
	Call ShowSonPath(filepath,High)'这是自我调用的递推函数	 
	Print |</table>|	
	
	Call dataout()
	MessageBox "###邮件数据库检测结束"+"--  end"
	
	Exit Sub
delError:
	MessageBox  Error()+" at line:" +Cstr(Erl())+" passwords,代理 checkMailSys"		
End Sub
Function dataout()
	On Error GoTo ers
	 
 
	Dim mail_doc As NotesDocument'中间对象 不会保存
	Dim bodyitem As Variant
	Set mail_doc=db.Createdocument()
	Set bodyitem =mail_doc.CreateRichTextItem("body")	 	 
	Call bodyitem.AppendText(XlsData+Chr(10)+Chr(13) )
	
	mail_doc.form = "memo"
	mail_doc.subject ="数据库状态统计。" 	
	
 
	mail_doc.sendto = sendtoMan
	Call mail_doc.Send(False)		
	
 
	MessageBox "dataout----执行完成"
	Exit Function
ers:	
	dataout="false"
 
	MessageBox  Error()+" at line:" +Cstr(Erl())+",fun dataout"
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  high As Integer
	high=1
	If fs <> "" Then
		fs=Split(fs,";")
		ForAll f In fs
			'如果需要删除文件 则在这边进行		 		
			temp3=temppath + pathFIR2+ f
		    temp3=Replace(temp3,pathFIR3,"")
			'MessageBox "temp ="+temp3+" high="+CStr(high)
			
			If InStr(temp3,"nsf")>1 Then
			
				Set tempMaildb=ss.Getdatabase("",temp3,"")'不同环境斜杠不同
				If Not tempMaildb.isopen Then
					If  ans<>"" Then
						ans=ans+"@"+f'保存异常数据库名称
					Else
						ans=f'保存异常数据库名称
					End If					 
				 
					'Print  "<th>false#&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"+"文件路径  " + temppath + "/" + f+" #ReplicaID="+"####异常"+"</th><br>"
					Print  "<tr>"
					Print  "<th>false"+"#文件路径  " + temppath +pathFIR2 + f+" #ReplicaID="+"####异常"+"</th>"
					Print  "</tr>"
					XlsData=XlsData+"false"+"#文件路径  " + temppath +pathFIR2 + f+" #ReplicaID="+"####异常"+Chr(10)+Chr(13)
					
				Else 
					Set collection = tempMaildb.AllDocuments  
					Print  "<tr>"
					'Print  "<th>true#&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"+"文件路径 #" + temppath+ "/" + f+" #ReplicaID="+cstr(tempMaildb.ReplicaID)+" #all="+CStr(collection.Count)+"</th><br>"
					Print  "<th>true#"+"文件路径 #" + temppath+ pathFIR2 + f+" #ReplicaID="+cstr(tempMaildb.ReplicaID)+" #all="+CStr(collection.Count)+" #size="+"#"+CStr(tempMaildb.size/1024/1024)+"MB"+"#数据库标题#"+CStr(tempMaildb.title)+"</th><br>"
					XlsData=XlsData+"true#"+"文件路径 #" + temppath+ pathFIR2 + f+" #all="+CStr(collection.Count)+" #size="+"#"+CStr(tempMaildb.size/1024/1024)+"MB"+"#数据库标题#"+CStr(tempMaildb.title)+Chr(10)+Chr(13)
					Print  "</tr>"
				End If
			End If
			high=high+1
			'If high =10 Then
			'	Exit sub
			'End If
		End ForAll
		 
	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 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+pathFIR2+v,nexhigh)'进行递推
				Else
					Print "超出递推次数------"
				End If
			
			End If	
		End ForAll
	End If

	Exit Sub
ShowSonPathError:
	'Print "Error:-->"+"["+temppath+"]"+Error +"<br>"
	MessageBox  Error()+" at line:" +Cstr(Erl())+",Fun ShowSonPath"
End Sub