' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' * ' * Importing RTF File ' * ' * 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, 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 ' * ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ' * * * * * * * * START (Function library) [IMPORTRTF] ' * * * * * * * * ' * ' * imports MS RTF file (W32 only) ' * %INCLUDE "c:\lss\capis\samples\memoryManagerExt" ' include memory manager class ' * * * * * * * * START (Const) [MISC] ' * * * * * * * * ' * Const IXFLAG_FIRST = 1 Const ODS_WORD = 0 Const ODS_DWORD = 1 Const ODS_BYTE = 3 Const SIG_CD_FONTTABLE = &h0FF8b& Const ITEM_BODY = {Body} Const ITEM_FONTS = {$Fonts} Const rtfName = {test.rtf} Const tmpFile = "nrtf.cd" Const OLDMAXPATH = 100 ' * * * * * * * * END (Const) [MISC] ' * * * * * * * * ' * * * * * * * * START (Type) [BLOCKID] ' * * * * * * * * ' * Public Type BLOCKID pool As Long block As Long End Type ' * * * * * * * * END (Type) [BLOCKID] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_OSLOADSTRING] ' * * * * * * * * ' * Declare Sub W32_OSLoadString Lib "nnotes" Alias "OSLoadString" (Byval null1 As Long, Byval sError As Integer, Byval errstr As String, Byval lenstr As Integer) ' * * * * * * * * END (Declaration) [W32_OSLOADSTRING] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_OSMEMORYALLOC ' * * * * * * * * ' * Declare Function W32_OSMemoryAllocate Lib "nnotes" Alias "OSMemoryAllocate" (Byval dwtype As Long, Byval size As Long, rethandle As Long) As Integer ' * * * * * * * * END (Declaration) [W32_OSMEMORYALLOCAT ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_OSMEMORYLOCK] ' * * * * * * * * ' * Declare Function W32_OSMemoryLock Lib "nnotes" Alias "OSMemoryLock" (Byval handle As Long) As Long ' * * * * * * * * END (Declaration) [W32_OSMEMORYLOCK] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_OSMEMORYUNLOC ' * * * * * * * * ' * Declare Sub W32_OSMemoryUnLock Lib "nnotes" Alias "OSMemoryUnlock" (Byval handle As Long) ' * * * * * * * * END (Declaration) [W32_OSMEMORYUNLOCK] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_OSMEMORYFREE] ' * * * * * * * * ' * Declare Sub W32_OSMemoryFree Lib "nnotes" Alias "OSMemoryFree"( Byval handle As Long) ' * * * * * * * * END (Declaration) [W32_OSMEMORYFREE] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_OSUNLOCKOBJEC ' * * * * * * * * ' * ' * unlock handle ' * Declare Sub W32_OSUnlockObject Lib "nnotes" Alias "OSUnlockObject" ( Byval handle As Long) ' * * * * * * * * END (Declaration) [W32_OSUNLOCKOBJECT] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_OSLOCKOBJECT] ' * * * * * * * * ' * Declare Function W32_OSLockObject Lib "nnotes.dll" Alias "OSLockObject" ( Byval handle As Long) As Long ' * * * * * * * * END (Declaration) [W32_OSLOCKOBJECT] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_ODSWRITEMEMOR ' * * * * * * * * ' * Declare Sub W32_ODSWriteMemory Lib "nnotes" Alias "ODSWriteMemory" (pSource As Long, Byval typeODS As Integer, pDest As Any, Byval Iterations As Integer ) ' * * * * * * * * END (Declaration) [W32_ODSWRITEMEMORY] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_NSFITEMAPPEND ' * * * * * * * * ' * Declare Function W32_NSFItemAppend Lib "nnotes" Alias "NSFItemAppend" (Byval hNote As Long, Byval flags As Integer, Byval ItemName As String, Byval ItemNameLength As Integer, Byval itemType As Integer, Byval Buff As Long, Byval BuffLength As Long) As Integer ' * * * * * * * * END (Declaration) [W32_NSFITEMAPPEND] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_NSFNOTEUPDATE ' * * * * * * * * ' * Declare Function W32_NSFNoteUpdate Lib "nnotes" Alias "NSFNoteUpdate" (Byval note_handle As Long, Byval update_flags As Integer) As Integer ' * * * * * * * * END (Declaration) [W32_NSFNOTEUPDATE] ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_ODSWRITEMEMOR ' * * * * * * * * ' * Declare Sub W32_ODSWriteMemoryStr Lib "nnotes" Alias "ODSWriteMemory" (pSource As Long, Byval typeODS As Integer, Byval pDest As Lmbcs String, Byval Iterations As Integer ) ' * * * * * * * * END (Declaration) [W32_ODSWRITEMEMORYS ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_ODSWRITEMEMOR ' * * * * * * * * ' * Declare Sub W32_ODSWriteMemoryNativeStr Lib "nnotes" Alias "ODSWriteMemory" _ (pSource As Long, Byval typeODS As Integer, Byval pDest As String, Byval Iterations As Integer ) ' * * * * * * * * END (Declaration) [W32_ODSWRITEMEMORYN ' * * * * * * * * ' * * * * * * * * START (Declaration) [W32_IMPORTRTF] ' * * * * * * * * ' * Declare Function W32_ImportRTF Lib "NIRTF.dll" Alias "#1" (Byval pBuffEditorData As Long, Byval Flags As Integer, Byval hModule As Integer, Byval AltLibraryName As String, Byval FileName As String) As Integer ' * * * * * * * * END (Declaration) [W32_IMPORTRTF] ' * * * * * * * * ' * * * * * * * * START (Method) [OSUNLOCKOBJECT] ' * * * * * * * * ' * ' * unlock handle ' * Public Sub OSUnlockObject (handle) Call W32_OSUnlockObject (handle) ' just one OS for this sample End Sub ' * * * * * * * * END (Method) [OSUNLOCKOBJECT] ' * * * * * * * * ' * * * * * * * * START (Method) [INITIALIZE] ' * * * * * * * * ' * Sub Initialize Dim ses As New NotesSession Dim doc As NotesDocument Dim rc As Integer Dim irc As Integer, h As Long, status As Integer Dim p As Long, p0 As Long Dim tmpDir As String, tempFile As String Dim fName As String If Environ("TEMP")<>"" Then tmpDir = Environ("TEMP") +"\" Elseif Environ("TMP")<>"" Then tmpDir = Environ("TMP") +"\" Else tmpDir = "c:\temp\" End If tempFile = tmpDir + tmpFile fName = "c:\temp\" +rtfName Print tempFile, fName Dim tmpFld As String Dim iLen As Long Dim memman As New memoryManagerExt p = memman.newBuffer (OLDMAXPATH + 4) p0=p Call W32_ODSWriteMemoryStr (p, ODS_BYTE, tempFile + String$(52 , Chr$(0)), OLDMAXPATH + 4) ' write filename padded with enough zeros? irc = W32_ImportRTF(p0, IXFLAG_FIRST%, 0, "", fName) ' create a temporary file containing CD Records If irc<>0 Then Print getError(irc) Else Dim importedRTF As String, fonts As String Call readTmpFile (tempFile, importedRTF, fonts) Set doc = ses.documentContext If replaceRTItem (doc, ITEM_BODY, importedRTF) And replaceRTItem (doc, ITEM_FONTS, fonts) Then irc% = W32_NSFNoteUpdate (doc.handle, 0) If rc%<>0 Then Print getError(rc) Else Print "Import OK..." End If Else Print "import failed" End If End If End Sub ' * * * * * * * * END (Method) [INITIALIZE] ' * * * * * * * * ' * * * * * * * * START (Method) [LOCKBLOCK] ' * * * * * * * * ' * Public Function LockBlock (BlockID As Blockid) As Long LockBlock = W32_OSLockObject (BlockID.pool&) + BlockID.block End Function ' * * * * * * * * END (Method) [LOCKBLOCK] ' * * * * * * * * ' * * * * * * * * START (Method) [GETERROR] ' * * * * * * * * ' * ' * Get Notes error ' * Public 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 ' * * * * * * * * END (Method) [GETERROR] ' * * * * * * * * ' * * * * * * * * START (Method) [OSLOCKOBJECT] ' * * * * * * * * ' * Public Function OSLockObject (handle) As Long OSLockObject = W32_OSLockObject (handle) ' use only one OS in this sample End Function ' * * * * * * * * END (Method) [OSLOCKOBJECT] ' * * * * * * * * ' * * * * * * * * START (Method) [READTMPFILE] ' * * * * * * * * ' * ' * input: fname - file containing imported CD records; output: fonts - string for $Fonts item and s - regular CD records ' * Public Function readTmpFile (fname As String, s As String, fonts As String) Dim f As Integer ' file handle Dim sig As Long ' in reality signature is either byte or unsigned integer Dim sig1 As Integer ' 1st byte of signature Dim sig2 As Integer ' 2nd byte of signature Dim pos As Integer ' position to import CD records from Dim cnt As Long Dim tmp f = Freefile() Print "reading...", fname Open fname For Input As #f Print "file length=", Lof(f) Seek #f, 3 ' skip data type word pos = Seek(f) ' preserve the last position tmp = Input$ (2, f) ' get signature word (it should be fonts) sig1 = Asc(Left(tmp,1)) sig2 = Asc(Right(tmp,1)) Sig& = Val("&h0" + Hex (sig2) + Hex (sig1) + "&") If sig& = SIG_CD_FONTTABLE& Then Print "SIG_CD_FONTTABLE: SIG=" + Hex (sig1) + Hex (sig2) Dim fontLen As Long, fontLenStr As String fontLenStr = Input$ (2, f) fontLen& = Val("&h0" + Hex (Asc(Right(fontLenStr,1))) + Hex (Asc(Left(fontLenStr,1))) + "&") Print "font length=" fontLen& Seek f, Seek(f)-4 ' step back 4 bytes for signature and length word fonts = Input$ (fontLen, f) pos = Seek(f) ' here begin the regular records Else Print "Unknown Record: SIG=" + Hex (sig1) + Hex (sig2) End If Seek #f, pos s = Input$ (Lof(f) - pos + 1, f) End Function ' * * * * * * * * END (Method) [READTMPFILE] ' * * * * * * * * ' * * * * * * * * START (Method) [REPLACERTITEM] ' * * * * * * * * ' * Public Function replaceRTItem (doc As Notesdocument, ITEM_NAME As String, imported As String) Dim memman As New memoryManagerExt Dim iLen As Long Dim rc As Integer ' API call returned code Dim p As Long, p0 As Long ' buffer pointers If doc.hasItem(ITEM_NAME) Then doc.removeItem(ITEM_NAME) iLen = Len(imported) If iLen Mod 2=1 Then Print "padding", ITEM_NAME: iLen = iLen + 1 ' padding to even boundary p = memman.newBuffer (iLen) p0 = p ' here we have a bit unordinary situation with a string containing binary string converted to platform native characters ' hence we use the declaration that converts them back before writting to buffer W32_ODSWriteMemoryNativeStr p, ODS_BYTE, imported + Chr(0), Cint(iLen) rc% = W32_NSFItemAppend (doc.handle, 0, ITEM_NAME, Len(ITEM_NAME), RICHTEXT, p0, iLen) If rc%<>0 Then Print getError(rc) Else replaceRTItem = True End If End Function ' * * * * * * * * END (Method) [REPLACERTITEM] ' * * * * * * * * ' * * * * * * * * END (Function library) [IMPORTRTF] ' * * * * * * * *