操作Domino数据库的设计元素

在Domino的数据库中有数据文档和设计文档两种文档。设计文档包括单，视图，代理等，这些组成了
一个数据库设计。标准的Notes类库能够很容易的访问数据文档，但是却没有提供任何方法来访问设计
文档。下面的这个DatabaseDesign类可以让我们使用LotusScript来访问设计文档，返回的是NotesDocument
对象。

要使用这个类，我们把DBDesign这个script库拷贝到数据库中。
下面是这个类的代码：

%REM
****************************************************************************************************************
This library was originally created by Damien Katz of Iris Associates, Aug. 1999

This library may be freely distributed, modified and used only if this header is kept intact, 
unchanged and is distributed with the contents of the library.

Please share any fixes or enhancements and send them to [e-mail] so I can add
it the library.

If you find this library useful, send me a mail message and let me know what you're using it for.

Thanks.

****************************************************************************************************************

NOTE: 
To instantiate a new DatabaseDesign object, do not attempt to instantiate it directly,
instead call the createDatabaseDesign method, it will return a new instantiated object.

%END REM

'Set this flag to true to always use the platform independent method
Const FLAG_NEVER_USE_NATIVE_API_CALLS =False

Const DESIGN_NOTE_NAME_ITEM = "$TITLE"

Const NOTE_CLASS_DOCUMENT = &H0001        ' document note 
Const NOTE_CLASS_DATA = NOTE_CLASS_DOCUMENT    ' old name for document note 
Const NOTE_CLASS_INFO = &H0002        ' notefile info (help-about) note 
Const NOTE_CLASS_FORM = &H0004        ' form note 
Const NOTE_CLASS_VIEW = &H0008        ' view note 
Const NOTE_CLASS_ICON = &H0010        ' icon note 
Const NOTE_CLASS_DESIGN = &H0020        ' design note collection 
Const NOTE_CLASS_ACL = &H0040        ' acl note 
Const NOTE_CLASS_HELP_INDEX = &H0080        ' Notes product help index note 
Const NOTE_CLASS_HELP = &H0100        ' designer's help note 
Const NOTE_CLASS_FILTER = &H0200        ' filter note 
Const NOTE_CLASS_FIELD = &H0400        ' field note 
Const NOTE_CLASS_REPLFORMULA = &H0800        ' replication formula 
Const NOTE_CLASS_PRIVATE = &H1000        

Const NOTE_CLASS_ALLNONDATA = &H7FFE

Const DESIGN_FLAG_ADD =    "A"
Const DESIGN_FLAG_ANTIFOLDER        =    "a"    '    VIEW: Indicates that a view is an antifolder view 
Const DESIGN_FLAG_BACKGROUND_FILTER = "B"    '    FILTER: Indicates FILTER_TYPE_BACKGROUND is asserted 
Const DESIGN_FLAG_INITBYDESIGNONLY="b"    '    VIEW: Indicates view can be initially built only by designer and above 
Const DESIGN_FLAG_NO_COMPOSE = "C"    '    FORM: Indicates a form that is used only for 
                                            '        query by form (not on compose menu). 
Const DESIGN_FLAG_CALENDAR_VIEW = "c"    '    VIEW: Indicates a form is a calendar style view. 
Const DESIGN_FLAG_NO_QUERY  = "D"    '     FORM: Indicates a form that should not be used in query by form 
Const DESIGN_FLAG_DEFAULT_DESIGN = "d"    '     ALL: Indicates the default design note for it"s class (used for VIEW) 
Const DESIGN_FLAG_MAIL_FILTER = "E"    '    FILTER: Indicates FILTER_TYPE_MAIL is asserted 
Const DESIGN_FLAG_PUBLICANTIFOLDER = "e"    '    VIEW: Indicates that a view is a public antifolder view 
Const DESIGN_FLAG_FOLDER_VIEW = "F"    '    VIEW: This is a V4 folder view. 
Const DESIGN_FLAG_V4AGENT = "f"    '    FILTER: This is a V4 agent 
Const DESIGN_FLAG_VIEWMAP = "G"    '    VIEW: This is ViewMap/GraphicView/Navigator 
Const DESIGN_FLAG_OTHER_DLG = "H"    '    ALL: Indicates a form that is placed in Other dialog 
Const DESIGN_FLAG_V4PASTE_AGENT = "I"    '    FILTER: This is a V4 paste agent 
Const DESIGN_FLAG_IMAGE_RESOURCE = "i"    '    FORM: Note is a shared image resource 
Const DESIGN_FLAG_JAVA_AGENT = "J" '  FILTER: If its Java 
Const DESIGN_FLAG_JAVA_AGENT_WITH_SOURCE = "j" ' FILTER: If it is a java agent with java source code. 
Const DESIGN_FLAG_LOTUSSCRIPT_AGENT = "L" '  FILTER: If its LOTUSSCRIPT 
Const DESIGN_FLAG_DELETED_DOCS = "l" '  VIEW: Indicates that a view is a deleted documents view 
Const DESIGN_FLAG_QUERY_MACRO_FILTER = "M"    '    FILTER: Stored FT query AND macro 
Const DESIGN_FLAG_SITEMAP = "m" '  FILTER: This is a site(m)ap. 
Const DESIGN_FLAG_NEW = "N"    '  FORM: Indicates that a subform is listed when making a new form.
Const DESIGN_FLAG_HIDE_FROM_NOTES = "n" '  ALL: notes stamped with this flag 
                                                    'will be hidden from Notes clients 
                                                    'We need a separate value here 
                                                    'because it Is possible To be
                                                    'hidden from V4 AND to be hidden
                                                    'from Notes, and clearing one 
                                                    'should not clear the other 
Const DESIGN_FLAG_QUERY_V4_OBJECT = "O"    '    FILTER: Indicates V4 search bar query object - used in addition to "Q" 
Const DESIGN_FLAG_PRIVATE_STOREDESK = "o" '  VIEW: If Private_1stUse, store the private view in desktop 
Const DESIGN_FLAG_PRESERVE = "P"    '    ALL: related to data dictionary 
Const DESIGN_FLAG_PRIVATE_1STUSE = "p"    '     VIEW: This is a private copy of a private on first use view. 
Const DESIGN_FLAG_QUERY_FILTER = "Q"    '    FILTER: Indicates full text query ONLY, no filter macro 
Const DESIGN_FLAG_AGENT_SHOWINSEARCH = "q"    '    FILTER: Search part of this agent should be shown in search bar 
Const DESIGN_FLAG_REPLACE_SPECIAL = "R"    '    SPECIAL: this flag is the opposite of DESIGN_FLAG_PRESERVE, used
                                                'only for the "About" and "Using" notes + the icon bitmap in the icon note 
Const DESIGN_FLAG_PROPAGATE_NOCHANGE = "r" '  DESIGN: this flag is used to propagate the prohibition of design change 
Const DESIGN_FLAG_V4BACKGROUND_MACRO = "S"    '    FILTER: This is a V4 background agent 
Const DESIGN_FLAG_SCRIPTLIB = "s"    '    FILTER: A database global script library note 
Const DESIGN_FLAG_VIEW_CATEGORIZED = "T"    '     VIEW: Indicates a view that is categorized on the categories field 
Const DESIGN_FLAG_DATABASESCRIPT = "t"    '    FILTER: A database script note 
Const DESIGN_FLAG_SUBFORM = "U"    '    FORM: Indicates that a form is a subform.
Const DESIGN_FLAG_AGENT_RUNASWEBUSER = "u"    '    FILTER: Indicates agent should run as effective user on web 

Const DESIGN_FLAG_PRIVATE_IN_DB = "V"    '     ALL: This is a private element stored in the database 
Const DESIGN_FLAG_WEBPAGE = "W"    '    FORM: Note is a WEBPAGE    
Const DESIGN_FLAG_HIDE_FROM_WEB = "w" '  ALL: notes stamped with this flag 
                                                    'will be hidden from WEB clients 
' WARNING: A formula that build Design Collecion relies on the fact that Agent Data"s
            '$Flags is the only Desing Collection element whose $Flags="X" 
Const DESIGN_FLAG_V4AGENT_DATA = "X" '  FILTER: This is a V4 agent data note 
Const DESIGN_FLAG_SUBFORM_NORENDER = "x"    '    SUBFORM: indicates whether
                                                'we should render a subform in
                                                'the parent form                    
Const DESIGN_FLAG_NO_MENU = "Y"    '    ALL: Indicates that folder/view/etc. should be hidden from menu. 
Const DESIGN_FLAG_SACTIONS = "y"    '    Shared actions note    
Const DESIGN_FLAG_MULTILINGUAL_PRESERVE_HIDDEN = "Z" ' ALL: Used to indicate design element was hidden 
                                            '    before the "Notes Global Designer" modified it. 
                                            '    (used with the "!" flag) 
Const DESIGN_FLAG_FRAMESET = "#"    '    FORM: Indicates that this is a frameset note  
Const DESIGN_FLAG_MULTILINGUAL_ELEMENT = "!"'    ALL: Indicates this design element supports the 
                                            '    "Notes Global Designer" multilingual addin 
Const DESIGN_FLAG_JAVA_RESOURCE = "@"    '    FORM: Note is a shared Java resource 
Const DESIGN_FLAG_HIDE_FROM_V3 = "3"    '    ALL: notes stamped with this flag 
                                            '        will be hidden from V3 client 
Const DESIGN_FLAG_HIDE_FROM_V4 = "4"    '    ALL: notes stamped with this flag 
                                                '    will be hidden from V4 client 
Const DESIGN_FLAG_HIDE_FROM_V5 = "5"    '     FILTER: "Q5"= hide from V4.5 search list 
                                            '    ALL OTHER: notes stamped with this flag 
                                            '        will be hidden from V5 client 
Const DESIGN_FLAG_HIDE_FROM_V6 = "6"    '    ALL: notes stamped with this flag 
                                                    'will be hidden from V6 client 
Const DESIGN_FLAG_HIDE_FROM_V7 = "7"    '    ALL: notes stamped with this flag 
                                                    'will be hidden from V7 client 
Const DESIGN_FLAG_HIDE_FROM_V8 = "8"    '    ALL: notes stamped with this flag 
                                                    'will be hidden from V8 client 
Const DESIGN_FLAG_HIDE_FROM_V9 = "9"    '    ALL: notes stamped with this flag 
                                                    'will be hidden from V9 client 
Const DESIGN_FLAG_MUTILINGUAL_HIDE = "0"    '    ALL: notes stamped with this flag 
                                                    'will be hidden from the client 
                                                    'usage is for different language
                                                    'versions of the design list to be
                                                    'hidden completely                


'    These are the flags that help determine the type of a design element.
'    These flags are used to sub-class the note classes, and cannot be
'    changed once they are created (for example, there is no way to change
'    a form into a subform). 

Const DESIGN_FLAGS_SUBCLASS = "UW#yi@GFXstm"

'    These are the flags that can be used to distinguish between two
'    design elements that have the same class, subclass (see DESIGN_FLAGS_SUBCLASS),
'    and name. 

Const DESIGN_FLAGS_DISTINGUISH = "nw3456789"

Const ERR_BASE_CLASS_INSTANTIATED = 10452
Const ERR_BASE_CLASS_INSTANTIATED_MESSAGE = "You cannot instantiate this class directly"

Public Class DatabaseDesignClass DatabaseDesign
    'PUBLIC MEMBERS
    Public cacheDocuments As Integer
    
    'PRIVATE MEMBERS    
    Private db As NotesDatabase
    Private forms As Variant
    Private views As Variant
    Private filters As Variant
    Private fields As Variant
    
    Sub new()Sub new( database As NotesDatabase)
        If isAbstractClass Then
            'this prevents the base class from being instantiated directly
            Error ERR_BASE_CLASS_INSTANTIATED, ERR_BASE_CLASS_INSTANTIATED_MESSAGE
        End If
        Set db = database
        cacheDocuments = True
    End Sub
    
    Private Function isAbstractClass()Function isAbstractClass As Integer
        'this must be overridden and return false
        'this prevents the base class from being instantiated directly
        isAbstractClass = True
    End Function
    
    'PUBLIC PROCEDURES
    
    Property Get()Property Get formDocuments As Variant
        FormDocuments = getDesignDocuments( NOTE_CLASS_FORM,  "*[" & DESIGN_FLAGS_SUBCLASS & "]*", True)
    End Property
    
    Property Get()Property Get subformDocuments As Variant
        subformDocuments = getDesignDocuments( NOTE_CLASS_FORM, "*[" & DESIGN_FLAG_SUBFORM & "]*", False)
    End Property
    
    Property Get()Property Get pageDocuments As Variant
        pageDocuments = getDesignDocuments( NOTE_CLASS_FORM, "*[" & DESIGN_FLAG_WEBPAGE & "]*", False)
    End Property
    
    Property Get()Property Get imageDocuments As Variant
        imageDocuments = getDesignDocuments( NOTE_CLASS_FORM, "*[" & DESIGN_FLAG_IMAGE_RESOURCE & "]*", False)
    End Property
    
    Property Get()Property Get javaResourceDocuments As Variant
        javaResourceDocuments = getDesignDocuments( NOTE_CLASS_FORM,     "*[" & DESIGN_FLAG_JAVA_RESOURCE &"]*", False)
    End Property
    
    Property Get()Property Get allDesignDocuments As Variant
        allDesignDocuments = getDesignDocuments( _
        NOTE_CLASS_FORM Or _
        NOTE_CLASS_VIEW Or _
        NOTE_CLASS_ICON Or _
        NOTE_CLASS_HELP Or _
        NOTE_CLASS_FILTER  Or _
        NOTE_CLASS_FIELD Or _
        NOTE_CLASS_REPLFORMULA Or _
        NOTE_CLASS_INFO Or _
        NOTE_CLASS_HELP _  
        ,"*[X]*", True )
    End Property
    
    Property Get()Property Get viewDocuments As Variant
        viewDocuments = getDesignDocuments( NOTE_CLASS_VIEW,  "*["&DESIGN_FLAGS_SUBCLASS & "]*", True )        
    End Property
    
    Property Get()Property Get folderDocuments As Variant
        folderDocuments = getDesignDocuments( NOTE_CLASS_VIEW,  "*["& DESIGN_FLAG_FOLDER_VIEW & "]*", False )
    End Property
    
    Property Get()Property Get navigatorDocuments As Variant
        navigatorDocuments = getDesignDocuments( NOTE_CLASS_VIEW,  "*["& DESIGN_FLAG_VIEWMAP & "]*", False )
    End Property
    
    Property Get()Property Get framesetDocuments As Variant
        FramesetDocuments = getDesignDocuments( NOTE_CLASS_FORM,     "*[" & DESIGN_FLAG_FRAMESET & "]*", False )
    End Property
    
    Property Get()Property Get scriptLibraryDocuments As Variant
        scriptLibraryDocuments = getDesignDocuments( NOTE_CLASS_FILTER, "*[" & DESIGN_FLAG_SCRIPTLIB & "]*", False )        
    End Property
    
    Property Get()Property Get agentDocuments As Variant
        agentDocuments = getDesignDocuments( NOTE_CLASS_FILTER, "*[" & DESIGN_FLAGS_SUBCLASS & "]*", True)
    End Property
    
    Property Get()Property Get databaseScriptDocuments As Variant
        databaseScriptDocuments = getDesignDocuments( NOTE_CLASS_FILTER, "*[" & DESIGN_FLAG_DATABASESCRIPT & "]*", False)
    End Property
    
    Property Get()Property Get outlineDocuments As Variant
        outlineDocuments = getDesignDocuments( NOTE_CLASS_FILTER, "*[" & DESIGN_FLAG_SITEMAP & "]*", False)
    End Property
    
    Property Get()Property Get sharedFieldDocuments As Variant
        sharedFieldDocuments = getDesignDocuments( NOTE_CLASS_FIELD, "*", False)
    End Property
    
    Property Get()Property Get replicationSettingsDocuments As Variant
        replicationSettingsDocuments = getDesignDocuments(NOTE_CLASS_REPLFORMULA, "*", False)
    End Property
    
    Property Get()Property Get sharedActionDocuments As Variant
        sharedActionDocuments = getDesignDocuments(NOTE_CLASS_FORM , "*[" & DESIGN_FLAG_SACTIONS & "]*", False)
    End Property
    
    Property Get()Property Get iconDocuments As Variant
        iconDocuments = getDesignDocuments(NOTE_CLASS_ICON , "*", False)        
    End Property
    
    Property Get()Property Get helpAboutDocuments As Variant
        helpAboutDocuments = getDesignDocuments(NOTE_CLASS_INFO , "*", False)    
    End Property
    
    Property Get()Property Get helpUsingDocuments As Variant
        helpUsingDocuments = getDesignDocuments(NOTE_CLASS_HELP , "*", False)    
    End Property
    
    'PUBLIC METHODS
    Public Function getFormByName()Function getFormByName( formname As String) As NotesDocument
        Set getFormByName = findElementByTitle( formname, Me.formDocuments)
    End Function
    
    Public Function getViewByName()Function getViewByName( formname As String) As NotesDocument
        Set getViewByName = findElementByTitle( formname, Me.viewDocuments)
    End Function
    
    Public Function getFramesetByName()Function getFramesetByName( formname As String) As NotesDocument
        Set getFramesetByName = findElementByTitle( formname, Me.framesetDocuments)
    End Function
    
    Public Function getFolderByName()Function getFolderByName( formname As String) As NotesDocument
        Set getFolderByName = findElementByTitle( formname, Me.folderDocuments)
    End Function
    
    Public Function getScriptLibraryByName()Function getScriptLibraryByName( formname As String) As NotesDocument
        Set getScriptLibraryByName = findElementByTitle( formname, Me.scriptLibraryDocuments)
    End Function
    
    Public Function getImageByName()Function getImageByName( formname As String) As NotesDocument
        Set getImageByName = findElementByTitle( formname, Me.imageDocuments)
    End Function
    
    Public Function getNavigatorByName()Function getNavigatorByName( formname As String) As NotesDocument
        Set getNavigatorByName = findElementByTitle( formname, Me.navigatorDocuments)
    End Function
    
    Public Function getJavaResourceByName()Function getJavaResourceByName( formname As String) As NotesDocument
        Set getJavaResourceByName = findElementByTitle( formname, Me.javaResourceDocuments)
    End Function
    
    Public Function getOutlineByName()Function getOutlineByName( formname As String) As NotesDocument
        Set getOutlineByName = findElementByTitle( formname, Me.outlineDocuments)
    End Function
    
    Public Function getAgentByName()Function getAgentByName( formname As String) As NotesDocument
        Set getAgentByName = findElementByTitle( formname, Me.agentDocuments)
    End Function
    
    Public Function getPageByName()Function getPageByName( formname As String) As NotesDocument
        Set getPageByName = findElementByTitle( formname, Me.pageDocuments)
    End Function
    
    Public Function getSubformByName()Function getSubformByName( formname As String) As NotesDocument
        Set getSubformByName = findElementByTitle( formname, Me.subformDocuments)
    End Function
    
    Public Function getSharedFieldByName()Function getSharedFieldByName( formname As String) As NotesDocument
        Set getSharedFieldByName = findElementByTitle( formname, Me.sharedFieldDocuments)
    End Function
    
    Public Function designDocumentAliases()Function designDocumentAliases( doc As NotesDocument) As Variant
        'some design element aliases are stored as a mulivalue item
        'others are stored as a pipe delimited single value item
        'if the item is a multi value, then don't worry about exploding it
        'otherwise, explode the single item
        Dim aliases As Variant
        aliases = doc.getItemValue( DESIGN_NOTE_NAME_ITEM)
        If Ubound( aliases) = 0 Then
            aliases = strExplode( aliases(0), "|", False)
        End If
        designDocumentAliases = aliases
    End Function
    
    
    'PRIVATE METHODS
    Private Function getDocuments()Function getDocuments( classtype As Integer) As Variant
        'this must be overridden
    End Function
    
    Private Function getDesignDocuments()Function getDesignDocuments( classtype As Integer, flagslike As String, invertlike As Integer ) As Variant
        Dim unfilteredResults As Variant
        If cacheDocuments Then
            Select Case classtype
            Case NOTE_CLASS_FORM:
                If Isempty( forms) Then
                    forms = getDocuments( classtype )
                End If
                unfilteredResults = forms
            Case NOTE_CLASS_VIEW:
                If Isempty( views) Then
                    views = getDocuments( classtype )
                End If
                unfilteredResults = views
            Case NOTE_CLASS_FILTER:
                If Isempty( filters) Then
                    filters = getDocuments( classtype )
                End If
                unfilteredResults = filters
            Case NOTE_CLASS_FIELD:
                If Isempty( fields) Then
                    fields = getDocuments( classtype )
                End If
                unfilteredResults = fields
            Case Else:
                unfilteredResults = getDocuments( classtype )
            End Select
        Else
            unfilteredResults = getDocuments( classtype )
        End If
        
        If Not Isempty(unfilteredResults) Then
            Dim count As Integer
            Redim results(Ubound(unfilteredResults)) As Variant
            Forall note In unfilteredResults
                If Not note Is Nothing Then
                    If note.getItemValue( "$Flags")(0) Like flagslike Xor invertlike Then
                        Set results(count) = note
                        count = count + 1
                    End If
                End If
            End Forall
            If Ubound(results) > count - 1And count > 0 Then
                Redim Preserve results( count - 1) As Variant
            End If
            If count > 0 Then
                getDesignDocuments = results
            End If
        End If
    End Function
    
    Private Function findElementByTitle()Function findElementByTitle(Byval title As String, elements As Variant) As NotesDocument
        If Not Isempty( elements) Then
            title= Trim(Lcase( replaceSubstring( title , "_", "")))
            Forall elementdoc In elements
                Dim doc As notesdocument
                Set doc = elementdoc
                If doesMatchTitle( title, doc) Then
                    Set findElementByTitle = elementdoc
                    Exit Function
                End If
            End Forall
        End If
    End Function
    
    Private Function doesMatchTitle()Function doesMatchTitle( Byval titletoMatch As String, doc As notesdocument) As Integer
        'titletomatch must be all lowercase
        Dim aliases As Variant
        aliases = designDocumentAliases( doc )
        
        Forall analias In aliases
            If replaceSubstring(Lcase(Trim(analias)), "_", "") = titleToMatch Then
                doesMatchTitle = True
                Exit Function
            End If
        End Forall
        
    End Function
    
    Private Function replaceSubstring()Function replaceSubstring( Byval astring As String, substring As String, newsubstring As String) As String
        Dim index As Integer
        index = Instr( astring, substring)
        Do While index > 0
            replaceSubstring = Left$( astring, index - 1) & newsubstring
            astring = Right$( astring, Len(astring) - index - Len( substring) + 1 )
            index = Instr( astring, substring)            
        Loop
        replaceSubstring = replaceSubstring & astring
    End Function
    
    Private Function strExplode()Function strExplode( Byval strValue As String, strDelimiter As String, bBlanks As Variant) As Variant
'** This function takes a string and converts it to an array, based on a delimiter
        
'** Parameters:
'**strValue- the string to explode
'**strDelimiter- the delimiter
'**bBlanks- a boolean value, pass true to have blanks placed in array when two delimiters have nothing between them
'**                                          pass false to ignore the blanks
        
        Dim strTemp As String
        Dim strValues() As String
        Dim iPlace As Integer
        Dim idelimLen As Integer
        Dim iValueCount As Integer
        
        idelimLen = Len( strDelimiter)
        
        iPlace = Instr( strValue, strDelimiter)
        
        Do While iPlace <> 0
            
            If (iPlace <> 1 Or bBlanks) Then
                Redim Preserve strValues(iValueCount) As String
                strValues(iValueCount) = Left( strValue, iPlace - 1)
                iValueCount = iValueCount + 1
            End If
            
            strValue = Right( strValue, Len( strValue) - iPlace - idelimLen + 1)
            
            iPlace = Instr( strValue, strDelimiter)
            
        Loop 
        
        If Len( strValue ) <> 0 Or bBlanks Then
            Redim Preserve strValues(iValueCount) As String 
            strValues(iValueCount) = strValue
        Elseif iValueCount = 0 Then
            Redim Preserve strValues(iValueCount) As String
        End If
        
        STRExplode = strValues
        
    End Function
End Class

Class API_DBDesignClass API_DBDesign As DatabaseDesign
    Private dbhandle As Long
    
    Private Function checkerror()Function checkerror( returncode As Integer)  As Integer
        'this returns zero unless returncode is non-zero
        'in which case it throws an error
        If returncode <> 0 Then
            Error returncode, Hex$( returncode)
        End If
    End Function
    
    Private Function apiNSFDbOpen()Function apiNSFDbOpen ( Byval dbname As String, dbhandle As Long ) As Integer        
    End Function
    Private Function apiNSFDbGetModifiedNoteTable()Function apiNSFDbGetModifiedNoteTable( Byval dbhandle As Long, Byval classmask As Integer, Byval startdate As Double, endate As Double, returntablehandle As Long ) As Integer
    End Function
    Private Function apiIDEntries()Function apiIDEntries ( Byval tablehandle As Long ) As Long        
    End Function
    Private Function apiIDScan()Function apiIDScan( Byval tablehandle As Long, Byval firstbool As Integer, returnid As Long) As Integer
    End Function
    Private Function apiOSMemFree()Function apiOSMemFree (Byval handle As Long) As Integer
    End Function
    Private Function apiNSFDbClose()Function apiNSFDbClose( Byval dbhandle As Long) As Integer        
    End Function
    Private Sub apiTimeConstruct()Sub apiTimeConstruct( Byval adate As Long, Byval atime As Long, datetime As Double)
    End Sub    
    
    Sub new()Sub new( db As NotesDatabase)
        Dim netpath As String
        If Len(db.server) > 0 Then
            netpath = db.server & "!!" & db.filepath
        Else
            netpath = db.filepath
        End If
        
        Call checkerror(apiNSFDBOpen(netpath, dbhandle ))
    End Sub
    
    Sub delete()Sub delete        
        If dbhandle <> 0 Then
            Call apiNSFDbClose( dbhandle)
        End If
    End Sub
    
    Private Function getDocuments()Function getDocuments( classtype As Integer) As Variant
        Dim begindate As Double
        Dim enddate As Double
        Dim idtablehandle As Long
        Dim noteid As Long
        Call apiTimeConstruct( &hFFFFFFFF, &hFFFFFFFF, begindate )
        On Error Goto errhandle
        Call checkerror(apiNSFDbGetModifiedNoteTable( dbhandle, classtype, begindate , enddate , idtablehandle ))
        If apiIDEntries( idtablehandle) <>0 Then
            Redim returnval (apiIDEntries( idtablehandle)-1) As NotesDocument
            
            Dim count As Long
            If apiIDScan( idtablehandle, True,  noteid ) Then
                Set returnval( count) = db.getDocumentByID(Hex$( noteId))
                Do While apiIDScan( idtablehandle, False,  noteid )
                    count = count + 1
                    Set returnval( count) = db.getDocumentByID(Hex$( noteId))
                Loop
            End If
            getDocuments = returnval
        End If
done:
        If idtablehandle <>0 Then
            Call apiOsMemFree( idtablehandle)
        End If
        Exit Function
errhandle:
        Resume done
    End Function
    
End Class

'Windows only calls.
Declare Private Function WinNSFDbOpen()Function WinNSFDbOpen Lib "nnotes" Alias "NSFDbOpen" ( Byval dbname As Lmbcs String, dbhandle As Long ) As Integer
Declare Private Function WinNSFDbGetModifiedNoteTable()Function WinNSFDbGetModifiedNoteTable Lib "nnotes" Alias "NSFDbGetModifiedNoteTable"( Byval dbhandle As Long, Byval classmask As Integer, _
Byval startdate As Double, endate As Double, returntablehandle As Long ) As Integer
Declare Private Function WinIDEntries()Function WinIDEntries Lib "nnotes"Alias "IDEntries"( Byval tablehandle As Long ) As Long
Declare Private Function WinIDScan()Function WinIDScan Lib "nnotes" Alias "IDScan"( Byval tablehandle As Long, Byval firstbool As Integer, returnid As Long) As Integer
Declare Private Function WinOSMemFree()Function WinOSMemFree Lib "nnotes" Alias "OSMemFree" (Byval handle As Long) As Integer
Declare Private Function WinNSFDbClose()Function WinNSFDbClose Lib "nnotes" Alias "NSFDbClose" ( Byval dbhandle As Long) As Integer
Declare Private Sub WinTimeConstruct()Sub WinTimeConstruct Lib "nnotes" Alias "TimeConstruct" ( Byval adate As Long, Byval atime As Long, datetime As Double)

Class Win32DatabaseDesignClass Win32DatabaseDesign As API_DBDesign
    Sub new()Sub new( db As NotesDatabase)
    End Sub
    
    Private Function apiNSFDbOpen()Function apiNSFDbOpen ( Byval dbname As String, dbhandle As Long ) As Integer        
        apiNSFDbOpen = winNSFDbOpen ( dbname, dbhandle ) 
    End Function
    Private Function apiNSFDbGetModifiedNoteTable()Function apiNSFDbGetModifiedNoteTable( Byval dbhandle As Long, Byval classmask As Integer, Byval startdate As Double, endate As Double, returntablehandle As Long ) As Integer
        apiNSFDbGetModifiedNoteTable = winNSFDbGetModifiedNoteTable(dbhandle, classmask,startdate , endate , returntablehandle )
    End Function
    Private Function apiIDEntries()Function apiIDEntries ( Byval tablehandle As Long ) As Long
        apiIDEntries = winIDEntries(tablehandle)
    End Function
    Private Function apiIDScan()Function apiIDScan( Byval tablehandle As Long, Byval firstbool As Integer, returnid As Long) As Integer
        apiIDScan = winIDScan( tablehandle , firstbool, returnid)
    End Function
    Private Function apiOSMemFree()Function apiOSMemFree (Byval handle As Long) As Integer
        apiOSMemFree = winOSMemFree (handle)
    End Function
    Private Function apiNSFDbClose()Function apiNSFDbClose( Byval dbhandle As Long) As Integer
        apiNSFDbClose = winNSFDbClose(dbhandle)
    End Function
    Private Sub apiTimeConstruct()Sub apiTimeConstruct( Byval adate As Long, Byval atime As Long, datetime As Double)
        Call winTimeConstruct( adate ,atime, datetime)
    End Sub    
    
    Private Function isAbstractClass()Function isAbstractClass As Integer
        isAbstractClass = False
    End Function
End Class

%REM
This is commented out because I had trouble getting it to work on the mac
The code is here in case someone wants to try and make it work

'Mac calls.
Declare Private Function macNSFDbOpen()Function macNSFDbOpen Lib "noteslib" Alias "NSFDbOpen" ( Byval dbname As Lmbcs String, dbhandle As Long ) As Integer
Declare Private Function macNSFDbGetModifiedNoteTable()Function macNSFDbGetModifiedNoteTable Lib "noteslib" Alias "NSFDbGetModifiedNoteTable"( Byval dbhandle As Long, Byval classmask As Integer, _
Byval startdate As Double, endate As Double, returntablehandle As Long ) As Integer
Declare Private Function macIDEntries()Function macIDEntries Lib "noteslib"Alias "IDEntries"( Byval tablehandle As Long ) As Long
Declare Private Function macIDScan()Function macIDScan Lib "noteslib" Alias "IDScan"( Byval tablehandle As Long, Byval firstbool As Integer, returnid As Long) As Integer
Declare Private Function macOSMemFree()Function macOSMemFree Lib "noteslib" Alias "OSMemFree" (Byval handle As Long) As Integer
Declare Private Function macNSFDbClose()Function macNSFDbClose Lib "noteslib" Alias "NSFDbClose" ( Byval dbhandle As Long) As Integer
Declare Private Sub macTimeConstruct()Sub macTimeConstruct Lib "noteslib" Alias "TimeConstruct" ( Byval adate As Long, Byval atime As Long, datetime As Double)

Class MacDatabaseDesignClass MacDatabaseDesign As API_DBDesign
    Sub new()Sub new( db As NotesDatabase)
    End Sub
    
    Private Function apiNSFDbOpen()Function apiNSFDbOpen ( Byval dbname As String, dbhandle As Long ) As Integer        
        apiNSFDbOpen = macNSFDbOpen ( dbname, dbhandle ) 
    End Function
    Private Function apiNSFDbGetModifiedNoteTable()Function apiNSFDbGetModifiedNoteTable( Byval dbhandle As Long, Byval classmask As Integer, Byval startdate As Double, endate As Double, returntablehandle As Long ) As Integer
        apiNSFDbGetModifiedNoteTable = macNSFDbGetModifiedNoteTable(dbhandle, classmask,startdate , endate , returntablehandle )
    End Function
    Private Function apiIDEntries()Function apiIDEntries ( Byval tablehandle As Long ) As Long
        apiIDEntries = macIDEntries(tablehandle)
    End Function
    Private Function apiIDScan()Function apiIDScan( Byval tablehandle As Long, Byval firstbool As Integer, returnid As Long) As Integer
        apiIDScan = macIDScan( tablehandle , firstbool, returnid)
    End Function
    Private Function apiOSMemFree()Function apiOSMemFree (Byval handle As Long) As Integer
        apiOSMemFree = macOSMemFree (handle)
    End Function
    Private Function apiNSFDbClose()Function apiNSFDbClose( Byval dbhandle As Long) As Integer
        apiNSFDbClose = macNSFDbClose(dbhandle)
    End Function
    Private Sub apiTimeConstruct()Sub apiTimeConstruct( Byval adate As Long, Byval atime As Long, datetime As Double)
        Call macTimeConstruct( adate ,atime, datetime)
    End Sub    
    
    Private Function isAbstractClass()Function isAbstractClass As Integer
        isAbstractClass = False
    End Function
End Class
%END REM

Const DB_DESIGN_LOOKUP_VIEW = "($DBDesignLookup)"

Class PlatformIndependentDatabaseDesignClass PlatformIndependentDatabaseDesign As DatabaseDesign
    Private session As NotesSession
    Private currentDB As NotesDatabase
    Private designViewNote As NotesDocument
    
    Sub new()Sub new( db As NotesDatabase)
        Dim designViewTemplateNote As NotesDocument
        Dim tempView As NotesView
        Dim designCollectionNote As NotesDocument
        
        'get a view any view will do
        Set tempView = db.views(0)
        Set designViewTemplateNote = db.getDocumentByUnid( tempView.universalID)
        Set designViewNote = designViewTemplateNote.copyToDatabase(db)
        Set designCollectionNote =  db.getdocumentbyid( "FFFF0020")
        'strip off all the items
        Forall item In designViewNote.items
            item.remove
        End Forall
        designCollectionNote.copyAllItems designViewNote
        designViewNote.replaceItemValue DESIGN_NOTE_NAME_ITEM, "(TemporaryDesignViewNote" & designViewNote.noteID & ")"
        
    End Sub
    
    Sub delete()Sub delete
        If Not designViewNote.isNewNote Then
            designViewNote.remove True
        End If
    End Sub
    
    Private Function isAbstractClass()Function isAbstractClass As Integer
        isAbstractClass = False
    End Function
    
    Private Function getDocuments()Function getDocuments( classtype As Integer) As Variant
        Dim view As NotesView
        Dim note As NotesDocument
        Dim count As Integer
        Dim results() As Variant
        
        'reset the design view note so it refreshs
        designViewNote.removeItem "$Collection"
        designViewNote.replaceItemValue "$Collection", ""
        'set the classtype
        designViewNote.replaceItemValue "$FormulaClass", Cstr(classType)
        designViewNote.save True, True
        Set view = db.getView( designViewNote.getItemValue( DESIGN_NOTE_NAME_ITEM)(0))
        view.refresh
        Set note = view.getFirstDocument
        Do While Not note Is Nothing
            If note.noteID  <> designViewNote.noteID Then  'Don't return the temp design view
                Redim Preserve results(count) As Variant
                Set results(count) = note
                count = count + 1
            End If
            Set note = view.getNextDocument( note)
        Loop
        Delete view
        If count > 0 Then
            getDocuments = results
        End If
    End Function
End Class

创建DatabaseDesign对象的方法

Public Function createDatabaseDesign()Function createDatabaseDesign( db As NotesDatabase ) As DatabaseDesign
    'This function should be called to instantiate
    On Error Goto errhandle
    Dim session As New notessession
    If  FLAG_NEVER_USE_NATIVE_API_CALLS Then
        Set createDatabaseDesign = New PlatformIndependentDatabaseDesign( db)
    Else
        Select Case session.platform
        Case "Windows/32":
            Set createDatabaseDesign = New Win32DatabaseDesign( db)
%REM  
    This is commented out because getting it to work on the mac was problematic
        Case "Macintosh":
            Set createDatabaseDesign = New MacDatabaseDesign( db)
%END REM
        Case Else:
            On Error Goto 0
            Set createDatabaseDesign = New PlatformIndependentDatabaseDesign( db)
        End Select    
    End If
done:
    Exit Function
errhandle:
    Set createDatabaseDesign = New PlatformIndependentDatabaseDesign( db)
    Resume done
End Function

我们可以通过类中提供的属性和方法来操作数据库中的设计元素，比如：
1.使用createDatabaseDesign方法来获取一个DatabaseDesign对象

 

Dim session as New NotesSession
Dim db as NotesDatabase
Dim dbDesign as DatabaseDesign
Set db = session.currentDatabase
Set dbDesign = createDatabaseDesign( db)

 

2.通过formDocuments属性来获取所有表单

 

Dim forms as variant
forms = dbDesign.formDocuments

 

3.打印出表单的标题

 

If Not IsEmpty( forms) Then
Forall formdoc In forms
print formdoc.getItemValue( "$Title")(0) 
end Forall

 

4.通过方法getFormByName获取到指定的表单

 

Dim form as NotesDocument
set form = dbDesign.getFormByName( "MyForm")
If Not form Is Nothing Then
'do something with form here
End If

 

5.使用 NotesDocument.copyToDatabase 方法可以拷贝设计元素到其他数据库中

 

dim otherdb as new NotesDatabase( "server", "file.nsf")
set form = dbDesign.getFormByName( "FormToCopy")
If Not form Is Nothing Then
dim formcopy as NotesDocument
set formcopy = form.copytodatabase(otherdb)
call formcopy.save(true, true)
End If

 

下面一段代码实现使用服务器上指定邮箱模板来更新本地PersonalMailBox的个人邮箱设计：

 

Sub Click()Sub Click(Source As Button) 
 Dim ss As New NotesSession,ws As New NotesUIWorkspace 
 Dim db As NotesDatabase,doc As NotesDocument 
 Dim docs As Variant 
        '得到personalmailbox的路径 
 Dim   path   As   String   
 path   =   ss.getenvironmentstring("directory",True)   
 path=path+"\PersonalMailBox\" 
 
        '得到当前用户的帐号ID,例如michaelpang 
 namev=ss.UserName 
 namev1=Left(namev,Len(namev)-12) 
 namev2=Right(namev1,Len(namev1)-3) 
 path=path+namev2+".nsf" 
 Msgbox(path) 
 
 Set db = ss.CurrentDatabase 
 Set doc = ws.CurrentDocument.Document         
 If (Messagebox ("你确定要执行取代设计元素吗？",36,"请确认" )  <> 6 ) Then 
  Exit Sub 
 End If 
 
 
        '清空原始系统的设计原色
 Dim TargetDB As NotesDatabase,TargetDBObj As DatabaseDesign 
 Set TargetDB = New NotesDatabase(Local,path) 
 
        'If Not TargetDB.IsOpen Then Messagebox "本地邮箱不能打开!!":UpdateBookmark = False :Goto TheEnd 
 Set TargetDBObj = CreateDatabaseDesign(TargetDB)                 
 docs = TargetDBObj.Alldesigndocuments 
 If Not Isempty( docs)  Then 
  Print "准备删除原始设计文件，共计 " + Cstr(Ubound(docs)+1) " 份文件!!" 
  Forall x In docs 
   x.Remove(True) 
  End Forall         
  Print "完成刪除原系统设计文件!!" 
 Else 
  Print "原系统已无设计文件!!!" 
 End If 
        '取得新系统设计文件         
 Dim SourceDB As NotesDatabase,SourceDBObj As DatabaseDesign 
 Set SourceDB = New NotesDatabase("testmail02/testserver","mail\michaelpang .nsf") 
        'If Not SourceDB.IsOpen Then Print "Source DataBase can't open!!":UpdateBookmark = False :Goto TheEnd 
 Set SourceDBObj = CreateDatabaseDesign(SourceDB)         
 docs = SourceDBObj.Alldesigndocuments 
 Print  "准备更新系统设计文件，共技 " + Cstr(Ubound(docs)+1) " 份文件!!" 
        ' 
        '复制设计到目的系统 
 Forall y In docs 
  Call y.CopyToDatabase(TargetDB) 
 End Forall 
 Messagebox "完成复制设计文件!!" 
TheEnd: 
 Exit Sub 
 
End Sub 

 

注意：1.使用这段代码的时候，需要将服务器上的模板的软删除功能关闭（”数据库---属性---高级---允许软删除“前的复选框勾掉），否则
多人同时运行这段代码的时候会出现“Notes error:someone else modified this document at the same time”的错误提示。
2.上面的方法把原来的设计删除了，又拷贝了新的设计，这样设计的文档ID就变了。

作者：生鱼片

　　　　

出处：http://carysun.cnblogs.com/