' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' * ' * Conversion of C API sample code for the use in LotusScript ' * Programmatic creation of About (& Using) documents ' * ' * sample code from ' * LotusScript to Lotus C API Programmer Guide by Normunds Kalnberzins, (c) 2000-2003 ' * ' * http://www.ls2capi.com ' * ' * Author: Normunds Kalnberzins ' * ' * This code has been written as a sample to illustrate aspects of handling of Lotus C API from LotusScript ' * and may be reused and modified on full responsibility of the developer and provided this notice is preserved ' * ' * The author does not guaranty it to fit any particular purpose and it is up to the developer ' * to modify, test it and determine the limits of its applicability ' * ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Option Public Option Declare Const FILE_PATH = {capi\ls2capi-samples.nsf} ' target db Const NOTE_CLASS_DEFAULT= &h8000 ' default of specific type Const NOTE_ID_SPECIAL = &hFFFF0000& Const NOTE_CLASS_HELP = &h0100 Const NOTE_CLASS_INFO = &h0002 ' /* notefile info (help-about) 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 MEMBER_NOTE_CLASS = 3 ' use with NSFNoteInfoSet Const NOTEID_USING = Hex(NOTE_ID_SPECIAL Or NOTE_CLASS_HELP) ' Help Using document Const NOTEID_ABOUT = Hex(NOTE_ID_SPECIAL Or NOTE_CLASS_INFO) ' About or Policy document Const ITEM_BODY = {$Body} Declare Sub W32_OSLoadString Lib "nnotes" Alias "OSLoadString" _ (Byval null1 As Long, Byval sError As Integer, Byval errstr As String, Byval lenstr As Integer) Declare Function W32_NSFNoteUpdate Lib "nnotes" Alias "NSFNoteUpdate" _ (Byval note_handle As Long, Byval update_flags As Integer) As Integer Declare Function W32_NSFNoteClose Lib "nnotes" Alias "NSFNoteClose" (Byval note_handle As Long) As Integer Declare Function W32_NSFNoteCreate Lib "nnotes" Alias "NSFNoteCreate" _ (Byval db_handle As Long, note_handle As Long) As Integer Declare Sub W32_NSFNoteSetInfo Lib "nnotes" Alias "NSFNoteSetInfo" _ (Byval note_handle As Long, Byval note_member As Integer, value_ptr As Any) Declare Sub W32_OSPathNetConstruct Lib "nnotes" Alias "OSPathNetConstruct" _ (Byval portName As Lmbcs String, Byval ServerName As Lmbcs String, _ Byval FileName As Lmbcs String, Byval retPathName As Lmbcs String) Declare Function W32_NSFDbOpen Lib "nnotes" Alias "NSFDbOpen" _ (Byval dbName As Lmbcs String, hdb As Long) As Integer Declare Function W32_NSFDbClose Lib "nnotes" Alias "NSFDbClose" (Byval hdb As Long) As Integer Const POLICY_STRING1 = "DATABASE POLICY STATEMENT" Const HELP_STRING1 = "DATABASE HELP STATEMENT" Const STRING_LENGTH = 256 Const POLICY_STRING2 = "This is a sample policy document (Help-About Database document) for the API sample program, DBPOLICY." Const HELP_STRING2 = "This is a sample help document (Help-Using Database document) for the API sample program, DBPOLICY." Sub Initialize Dim s As New notessession Dim ndb As Notesdatabase Dim ndbTarget As Notesdatabase Dim doc As Notesdocument Set ndb = s.currentDatabase Set ndbTarget = New NotesDatabase (ndb.server, FILE_PATH) ' HELP USING document Set doc = ndbTarget.getDocumentbyID (NOTEID_USING) If doc Is Nothing Then Print "doc Using does not exist!" Dim hdb As Long hdb = openDb (ndbTarget) If hdb<>0 Then Call createSpecialDoc (hdb, NOTE_CLASS_HELP) Set doc = ndbTarget.getDocumentbyID (NOTEID_USING) If doc Is Nothing Then Print "double failure..." Else add_rich_text doc, HELP_STRING1, HELP_STRING2 print_doc doc End If End If Else add_rich_text doc, HELP_STRING1, HELP_STRING2 print_doc doc End If ' ABOUT (Policy/Info) document Set doc = ndbTarget.getDocumentbyID (NOTEID_ABOUT) If doc Is Nothing Then Print "doc About does not exist!" hdb = openDb (ndbTarget) If hdb<>0 Then Call createSpecialDoc (hdb, NOTE_CLASS_INFO) Set doc = ndbTarget.getDocumentbyID (NOTEID_ABOUT) If doc Is Nothing Then Print "double failure..." Else add_rich_text doc, POLICY_STRING1, POLICY_STRING2 print_doc doc End If End If Else add_rich_text doc, POLICY_STRING1, POLICY_STRING2 print_doc doc End If If hdb<>0 Then W32_NSFDbClose hdb End Sub Function openDb (ndb As Notesdatabase) As Long ' returns db handle Dim retPath As String*1024 ' reserve buffer for the returned server!!filepath Dim h As Long ' database handle Dim irc As Integer ' return code W32_OSPathNetConstruct "", ndb.server, ndb.filepath, retPath irc% = W32_NSFDbOpen (retPath, h) If irc%<>0 Then Print getError(irc%) End If openDb = h End Function Function getError (enum As Integer) As String Dim s As String*256 W32_OSLoadString 0, enum And &h03FFFFFFF, s, 256 getError = Strleft(s, Chr(0)) End Function Function createSpecialDoc (hdb As Long, NOTE_CLASS As Integer) ' hDb is database handle ' NOTE_CLASS is either NOTE_CLASS_INFO or NOTE_CLASS_HELP Dim hNote As Long Dim rc As Integer ' return code rc = W32_NSFNoteCreate (hdb, hNote) If rc<>0 Then Print getError(rc) Exit Function End If Call W32_NSFNoteSetInfo (hNote, MEMBER_NOTE_CLASS, NOTE_CLASS Or NOTE_CLASS_DEFAULT) Call W32_NSFNoteUpdate (hNote,0) Call W32_NSFNoteClose (hNote) End Function Sub print_doc (doc As NotesDocument) If doc.HasItem(ITEM_BODY) Then Print doc.getFirstItem(ITEM_BODY).Text, doc.~$UpdatedBy(0) Else Print {(-no body item-)}, doc.~$UpdatedBy(0) End If End Sub Sub add_rich_text (doc As NotesDocument, S1 As String, S2 As String) Dim rt As notesRichTextItem Dim s As New NotesSession Dim rts As NotesRichTextParagraphStyle Dim rtf As NotesRichTextStyle Set rts = s.CreaterichtextParagraphstyle Set rtf = s.Createrichtextstyle If Not doc.hasItem(ITEM_BODY) Then Set rt = New NotesRichTextItem (doc, ITEM_BODY) rts.Alignment = ALIGN_CENTER rt.appendParagraphStyle rts ' TITLE LINE rtf.FontSize = 14 rtf.NotesColor = COLOR_BLUE rtf.Bold = True rt.appendStyle rtf rt.appendText S1 ' COMMENT LINE rt.addnewline 1 rtf.FontSize = 12 rtf.NotesColor = COLOR_RED rtf.Bold = True rtf.Italic = True rt.appendStyle rtf rt.appendText S2 ' DATESTAMP LINE rt.addnewline 1 rtf.FontSize = 12 rtf.NotesColor = COLOR_GRAY rtf.Bold = False rtf.Italic = False rt.appendStyle rtf rt.appendText "Updated: " & Cstr(Now) doc.save True, True End If End Sub