如何获取服务器Data目录下指定目录的数据库信息-优快云博客

'获取指定目录下的文件信息GetFolderDbList:

Option Public
Option Declare

Sub Initialize
On Error Goto ErrHandle
Dim arrTitle As Variant
Dim arrPath As Variant
Dim arrSize As Variant

'分别获取help目录下的数据库标题、路径、大小
'arrTitle=GetFileTitle("help")
'arrPath=GetFilePath("help")
'arrSize=GetFileSize("help")

'统一获取help目录下的数据库标题、路径、大小
GetFileInfo "help",arrTitle,arrPath,arrSize

Dim i As Integer
Dim intLen As Integer
intLen=Ubound(arrTitle)
For i=1 To intLen
Msgbox "Title:" & arrTitle(i) & ", Path:" & arrPath(i) & ", Size:" & arrSize(i)
Next

Exit Sub
ErrHandle:
Msgbox "Error:" & Err & " Erl:" & Erl
End Sub

Function GetFileTitle(strFolder As String) As Variant
'获取指定目录下的数据库标题
On Error Goto ErrHandle
Dim dbdir As NotesDbDirectory
Dim db As NotesDatabase
Dim arrNSF() As String
Dim intCount As Integer
Dim strPath As String

Set dbdir=New NotesDbDirectory("")
Set db = dbdir.GetFirstDatabase(DATABASE)
intCount=0
While Not(db Is Nothing)
If (Strleft(Lcase$(db.FilePath),"/")=strFolder) Then
intCount=intCount+1
Redim Preserve arrNSF(intCount)
arrNSF(intCount) = db.Title
End If
Set db=dbdir.GetNextDatabase
Wend
GetFileTitle=arrNSF
Exit Function
ErrHandle:
Msgbox "Error:" & Err & " Erl:" & Erl
End Function

Function GetFilePath(strFolder As String) As Variant
'获取指定目录下的数据库路径
On Error Goto ErrHandle
Dim dbdir As NotesDbDirectory
Dim db As NotesDatabase
Dim arrNSF() As String
Dim intCount As Integer
Dim strPath As String

Set dbdir=New NotesDbDirectory("")
Set db = dbdir.GetFirstDatabase(DATABASE)
intCount=0
While Not(db Is Nothing)
If (Strleft(Lcase$(db.FilePath),"/")=strFolder) Then
intCount=intCount+1
Redim Preserve arrNSF(intCount)
arrNSF(intCount) = db.FilePath
End If
Set db=dbdir.GetNextDatabase
Wend
GetFilePath=arrNSF
Exit Function
ErrHandle:
Msgbox "Error:" & Err & " Erl:" & Erl
End Function

Function GetFileSize(strFolder As String) As Variant
'获取指定目录下的数据库大小
On Error Goto ErrHandle
Dim dbdir As NotesDbDirectory
Dim db As NotesDatabase
Dim arrNSF() As String
Dim intCount As Integer
Dim strPath As String

Set dbdir=New NotesDbDirectory("")
Set db = dbdir.GetFirstDatabase(DATABASE)
intCount=0
While Not(db Is Nothing)
If (Strleft(Lcase$(db.FilePath),"/")=strFolder) Then
intCount=intCount+1
Redim Preserve arrNSF(intCount)
arrNSF(intCount) = db.Size/1024/1024
End If
Set db=dbdir.GetNextDatabase
Wend
GetFileSize=arrNSF
Exit Function
ErrHandle:
Msgbox "Error:" & Err & " Erl:" & Erl
End Function

Sub GetFileInfo(strFolder As String,varTitle,varPath,varSize)
'获取指定目录下的数据库标题、路径、大小
On Error Goto ErrHandle
Dim dbdir As NotesDbDirectory
Dim db As NotesDatabase
Dim arrTitle() As String
Dim arrPath() As String
Dim arrSize() As String
Dim intCount As Integer
Dim strPath As String

Set dbdir=New NotesDbDirectory("")
Set db = dbdir.GetFirstDatabase(DATABASE)
intCount=0
While Not(db Is Nothing)
If (Strleft(Lcase$(db.FilePath),"/")=strFolder) Then
intCount=intCount+1
Redim Preserve arrTitle(intCount)
Redim Preserve arrPath(intCount)
Redim Preserve arrSize(intCount)
arrTitle(intCount) = db.Title
arrPath(intCount) = db.FilePath
arrSize(intCount) = db.Size/1024/1024
End If
Set db=dbdir.GetNextDatabase
Wend
varTitle=arrTitle
varPath=arrPath
varSize=arrSize
Exit Sub
ErrHandle:
Msgbox "Error:" & Err & " Erl:" & Erl
End Sub