操作Domino数据库的设计元素

在Domino的数据库中有数据文档和设计文档两种文档。设计文档包括单，视图，代理等，这些组成了

一个数据库设计。标准的Notes类库能够很容易的访问数据文档，但是却没有提供任何方法来访问设计

文档。下面的这个DatabaseDesign类可以让我们使用LotusScript来访问设计文档，返回的是NotesDocument

对象。

要使用这个类，我们把DBDesign这个script库拷贝到数据库中。

下面是这个类的代码：

DatabaseDesign类代码

%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对象的方法

createDatabaseDesign方法

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就变了。