在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 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 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
%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 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
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)
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
forms = dbDesign.formDocuments
3.打印出表单的标题
If Not IsEmpty( forms) Then
Forall formdoc In forms
print formdoc.getItemValue( "$Title")(0)
end Forall
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
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
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
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就变了。