操作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 Damien_katz@iris.com 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 objectdo 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 StringAs NotesDocument
        
Set getFormByName = findElementByTitle( formname, Me.formDocuments)
    
End Function

    
    
Public Function getViewByName()Function getViewByName( formname As StringAs NotesDocument
        
Set getViewByName = findElementByTitle( formname, Me.viewDocuments)
    
End Function

    
    
Public Function getFramesetByName()Function getFramesetByName( formname As StringAs NotesDocument
        
Set getFramesetByName = findElementByTitle( formname, Me.framesetDocuments)
    
End Function

    
    
Public Function getFolderByName()Function getFolderByName( formname As StringAs NotesDocument
        
Set getFolderByName = findElementByTitle( formname, Me.folderDocuments)
    
End Function

    
    
Public Function getScriptLibraryByName()Function getScriptLibraryByName( formname As StringAs NotesDocument
        
Set getScriptLibraryByName = findElementByTitle( formname, Me.scriptLibraryDocuments)
    
End Function

    
    
Public Function getImageByName()Function getImageByName( formname As StringAs NotesDocument
        
Set getImageByName = findElementByTitle( formname, Me.imageDocuments)
    
End Function

    
    
Public Function getNavigatorByName()Function getNavigatorByName( formname As StringAs NotesDocument
        
Set getNavigatorByName = findElementByTitle( formname, Me.navigatorDocuments)
    
End Function

    
    
Public Function getJavaResourceByName()Function getJavaResourceByName( formname As StringAs NotesDocument
        
Set getJavaResourceByName = findElementByTitle( formname, Me.javaResourceDocuments)
    
End Function

    
    
Public Function getOutlineByName()Function getOutlineByName( formname As StringAs NotesDocument
        
Set getOutlineByName = findElementByTitle( formname, Me.outlineDocuments)
    
End Function

    
    
Public Function getAgentByName()Function getAgentByName( formname As StringAs NotesDocument
        
Set getAgentByName = findElementByTitle( formname, Me.agentDocuments)
    
End Function

    
    
Public Function getPageByName()Function getPageByName( formname As StringAs NotesDocument
        
Set getPageByName = findElementByTitle( formname, Me.pageDocuments)
    
End Function

    
    
Public Function getSubformByName()Function getSubformByName( formname As StringAs NotesDocument
        
Set getSubformByName = findElementByTitle( formname, Me.subformDocuments)
    
End Function

    
    
Public Function getSharedFieldByName()Function getSharedFieldByName( formname As StringAs 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 IntegerAs 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 - 1As 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 StringAs 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 LongByval classmask As IntegerByval 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 LongByval firstbool As Integer, returnid As LongAs Integer
    
End Function

    
Private Function apiOSMemFree()Function apiOSMemFree (Byval handle As LongAs Integer
    
End Function

    
Private Function apiNSFDbClose()Function apiNSFDbClose( Byval dbhandle As LongAs Integer        
    
End Function

    
Private Sub apiTimeConstruct()Sub apiTimeConstruct( Byval adate As LongByval 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 IntegerAs 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)-1As 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 LongByval 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 LongByval firstbool As Integer, returnid As LongAs Integer
Declare Private Function WinOSMemFree()Function WinOSMemFree Lib "nnotes" Alias "OSMemFree" (Byval handle As LongAs Integer
Declare Private Function WinNSFDbClose()Function WinNSFDbClose Lib "nnotes" Alias "NSFDbClose" ( Byval dbhandle As LongAs Integer
Declare Private Sub WinTimeConstruct()Sub WinTimeConstruct Lib "nnotes" Alias "TimeConstruct" ( Byval adate As LongByval 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 LongByval classmask As IntegerByval 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 LongByval firstbool As Integer, returnid As LongAs Integer
        apiIDScan 
= winIDScan( tablehandle , firstbool, returnid)
    
End Function

    
Private Function apiOSMemFree()Function apiOSMemFree (Byval handle As LongAs Integer
        apiOSMemFree 
= winOSMemFree (handle)
    
End Function

    
Private Function apiNSFDbClose()Function apiNSFDbClose( Byval dbhandle As LongAs Integer
        apiNSFDbClose 
= winNSFDbClose(dbhandle)
    
End Function

    
Private Sub apiTimeConstruct()Sub apiTimeConstruct( Byval adate As LongByval 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 LongByval 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 LongByval firstbool As Integer, returnid As LongAs Integer
Declare Private Function macOSMemFree()Function macOSMemFree Lib "noteslib" Alias "OSMemFree" (Byval handle As LongAs Integer
Declare Private Function macNSFDbClose()Function macNSFDbClose Lib "noteslib" Alias "NSFDbClose" ( Byval dbhandle As LongAs Integer
Declare Private Sub macTimeConstruct()Sub macTimeConstruct Lib "noteslib" Alias "TimeConstruct" ( Byval adate As LongByval 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 LongByval classmask As IntegerByval 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 LongByval firstbool As Integer, returnid As LongAs Integer
        apiIDScan 
= macIDScan( tablehandle , firstbool, returnid)
    
End Function

    
Private Function apiOSMemFree()Function apiOSMemFree (Byval handle As LongAs Integer
        apiOSMemFree 
= macOSMemFree (handle)
    
End Function

    
Private Function apiNSFDbClose()Function apiNSFDbClose( Byval dbhandle As LongAs Integer
        apiNSFDbClose 
= macNSFDbClose(dbhandle)
    
End Function

    
Private Sub apiTimeConstruct()Sub apiTimeConstruct( Byval adate As LongByval 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 IntegerAs 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 
TrueTrue
        
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就变了。

作者: 生鱼片
    

 

 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值