Tweet
An example on how to access Notes Database Documents and its field contents
Hi all,
after I experimented with Notes Databases and accessing them in PB I just found out (with help from one familiar with SafeArrays) ho to handle field contents of Notes databases residing on a Domino server. Plse. find the code example here
after I experimented with Notes Databases and accessing them in PB I just found out (with help from one familiar with SafeArrays) ho to handle field contents of Notes databases residing on a Domino server. Plse. find the code example here
Code:
#DIM ALL
#COMPILE EXE
#INCLUDE "domino.inc"
#INCLUDE "safearray.inc"
#INCLUDE "Win32API.INC"
'------------------------------------------------------------------------------
' Main application entry point...
'
DECLARE SUB ShowDoc(Count AS LONG, Console() AS STRING)
DECLARE SUB Content(vText AS VARIANT, vRes AS VARIANT)
DECLARE SUB GetConsole(Console() AS STRING, hDlg AS LONG)
%USEMACROS = 1
%IDC_LIST1 = 131
%IDC_LIST2 = 132
FUNCTION PBMAIN
GLOBAL oSession AS DISPATCH
GLOBAL oDir AS LotusIDbDirectory
GLOBAL oDatabase AS LotusIDatabase
GLOBAL oCollect AS LotusIDocumentCollection
GLOBAL oDocument AS LotusIDocument
GLOBAL vText AS VARIANT
DIM pUser AS VARIANT
DIM pPassword AS VARIANT
DIM vmFile AS VARIANT
DIM vServer AS VARIANT
DIM Count AS LONG
DIM hDlg AS DWORD
DIM Time AS LONG
DIM sec AS LONG
' Initialize Notes
'----------------------------------------------------
' Replace each of these with the correct information
LET pPassword=<YOUR_PW_OR_PARAM>
LET vmFile=<YOUR_DB_OR_PARAM>
LET vServer=<YOUR_SERVER_OR_PARAM>
LET vtext=""
'----------------------------------------------------
SET oSession = NEW DISPATCH IN "Lotus.NotesSession" 'Define new dispatch interface
OBJECT CALL oSession.Initialize(pPassword) 'Initialize session
OBJECT CALL oSession.GetDbDirectory(vServer) TO vText 'find data directory
oDir = vText
IF ISFALSE ISOBJECT(oSession) OR ERR THEN ' Notes could not be opened
MSGBOX "Notes could not opened Session"
EXIT FUNCTION
END IF
OBJECT CALL oDir.OpenDatabase(vmFile) TO vText 'Open DB within data directory
oDatabase = vText
DIALOG NEW 0,"My Output",,, 415, 315, %WS_CAPTION_
OR %WS_SYSMENU, 0 TO hDlg 'start new dialog
OBJECT GET oDatabase.AllDocuments() TO vText 'Retrieve the document colection from the database
oCollect = vText
OBJECT GET oCollect.Count TO vText 'Retrieve the number of documents
Count = VARIANT#(vText)
REDIM Console(Count) AS STRING
ShowDoc Count, Console() 'Call the worker and hand over the document count
GetConsole Console(), hDlg 'show a console window with DB content
SET oSession = NOTHING 'kill the open notes session
END FUNCTION
SUB ShowDoc(Count AS LONG, Console() AS STRING)
' local dims
DIM vText AS VARIANT 'Buffer for OBJECT CALL/GET results
DIM vRes AS VARIANT 'Buffer for resolved Variant Field Contents
DIM z AS LONG 'loop counter
DIM y AS VARIANT 'converted loop counter
DIM Field1 AS STRING 'field content "Field1"
DIM Field2 AS STRING 'filed content "Field2"
DIM Field3 AS STRING 'filed content "Field3"
DIM Form AS STRING 'field content "Form"
DIM I1 AS VARIANT 'transport for the fieldname to the method
DIM I2 AS VARIANT 'transport for the fieldname to the method
DIM I3 AS VARIANT 'transport for the fieldname to the method
DIM I4 AS VARIANT 'transport for the fieldname to the method
DIM OutString AS STRING 'outcome from field retrieval
DIM cnt AS LONG 'a counter
DIM Modified AS STRING 'content of the document property "LastModified"
LET I1="Form" 'load the transport variant with the Fieldname to be retrieved
LET I2="Field3" 'load the transport variant with the Fieldname to be retrieved
LET I3="Field2" 'load the transport variant with the Fieldname to be retrieved
LET I4="Field1" 'load the transport variant with the Fieldname to be retrieved
cnt=1 'initiate the counter
FOR z=1 TO Count 'loop throutgh all documents
y=z 'convert Long into variant
OBJECT CALL oCollect.GetNthDocument(y) TO vText 'use the variant cunter to receive the nth document
OutString=""
oDocument = vText
OBJECT CALL oDocument.GetItemValue(I1) TO vText 'load the object variable with the result of the method
content vText, vRes 'get the field content of the field "Form"
IF UCASE$(VARIANT$(vRes))="INPUT" THEN 'If form="INPUT"
OBJECT CALL oDocument.GetItemValue(I2) TO vText 'load the object variable with the result of the method
content vText, vRes
Field3=VARIANT$(vRes) 'get field content #3
OBJECT CALL oDocument.GetItemValue(I3) TO vText 'load the object variable with the result of the method
content vText, vRes
Field2=VARIANT$(vRes) 'get filed content #2
OBJECT CALL oDocument.GetItemValue(I4) TO vText 'load the object variable with the result of the method
content vText, vRes
Field1=VARIANT$(vRes) 'get filed content #1
OBJECT GET oDocument.LastModified() TO vText 'get the "LastModified" property of the current document
Modified=STR$(VARIANT#(vText))
OutString=Modified+" :"+Serv+": ["+Prio+"] ==>"+Subj
console(cnt)=OutString
cnt=cnt+1
END IF
NEXT Z
END SUB
SUB Content(vText AS VARIANT, vRes AS VARIANT)
LOCAL pv AS VARIANTAPI PTR 'pointer to the variant field
LOCAL parray AS DWORD 'pointer address of the variant array
LOCAL nDims AS LONG '# dimensions of the variant array
LOCAL lLBound AS LONG 'lower variant array boundary
LOCAL lUBound AS LONG 'upper variant array boundary
LOCAL ix AS LONG
LOCAL i AS LONG
LOCAL Values AS STRING
pv = VARPTR(vText) ' // Address of the variant
parray = @pv.vd.parray ' // Address of the array
nDims = SafeArrayGetDim(parray) ' // Number of dimensions of the array
IF nDims <> 0 THEN ' // Array not dimensioned
SafeArrayGetLBound(parray, 1, lLBound) ' // Lower bound of the first dimension
SafeArrayGetUBound(parray, 1, lUBound) ' // Upper bound of the first dimension
END IF
FOR i = lLbound TO lUbound
ix = i
vRes = EMPTY
SafeArrayGetElement(parray, BYVAL VARPTR(ix), BYVAL VARPTR(vRes)) 'get one element from a safearray at index ix into vRes
NEXT i
END SUB
SUB GetConsole(Console() AS STRING, hDlg AS LONG)
LOCAL c AS LONG
LOCAL i AS LONG
LOCAL j AS LONG
FOR i=0 TO UBOUND(console())
IF Console(i)="" THEN
ARRAY DELETE Console(i)
END IF
NEXT i
CONTROL ENABLE hDlg, %IDC_LIST1
CONTROL ADD LISTBOX, hDlg, %IDC_LIST1, console(), 5, 5, 400, 300
DIALOG SHOW STATE hDlg, %SW_SHOW
DIALOG SHOW MODAL hDlg, CALL DlgProc
END SUB
CALLBACK FUNCTION DlgProc() AS LONG
'--------------------------------------------------------------------
' Callback procedure for the main dialog
'------------------------------------------------------------------
LOCAL ln1, ln2 AS LONG, hList1, hList2 AS DWORD
LOCAL sText1, sText2 AS STRING
STATIC NoUpdate AS LONG 'for preventing eternal update loops
SELECT CASE AS LONG CBMSG
'------------------------------------------------------------------
CASE %WM_CTLCOLORLISTBOX
' The %WM_CTLCOLORLISTBOX message is sent by the system when a ListBox
' is to be redrawn, so it can be used for monitoring visual changes.
IF NoUpdate THEN EXIT FUNCTION ' prevent eternal update loops
NoUpdate = %TRUE
CONTROL HANDLE CBHNDL, %IDC_LIST1 TO hList1
CONTROL HANDLE CBHNDL, %IDC_LIST2 TO hList2
IF CBLPARAM = hList2 THEN SWAP hList1, hList2 'hList is the one with focus..
'SYNCHRONIZE SELECTED LINE (if needed, otherwise rem out)
ln1 = SendMessage(hList1, %LB_GETCURSEL, 0, 0) '<- get seleced line
ln2 = SendMessage(hList2, %LB_GETCURSEL, 0, 0) '<- get seleced line
IF ln1 <> ln2 THEN
CALL SendMessage(hList2, %LB_SETCURSEL, ln1, 0) '<- set selected line
END IF
'SYNCHRONIZE TOP LINE (if needed, otherwise rem out)
ln1 = SendMessage(hList1, %LB_GETTOPINDEX, 0, 0) '<- get first visible line in 1
ln2 = SendMessage(hList2, %LB_GETTOPINDEX, 0, 0) '<- get first visible line in 2
IF ln1 <> ln2 THEN
SendMessage hList2, %LB_SETTOPINDEX, ln1, 0 '<- amount to scroll textbox 1
END IF
NoUpdate = %FALSE
'------------------------------------------------------------------
CASE %WM_COMMAND ' <- a control is calling
SELECT CASE AS LONG CBCTL ' <- look at control's id
CASE %IDC_LIST1, %IDC_LIST2
IF CBCTLMSG = %LBN_DBLCLK THEN ' on double-click in any ListBox
LISTBOX GET TEXT CBHNDL, %IDC_LIST1 TO sText1
LISTBOX GET TEXT CBHNDL, %IDC_LIST2 TO sText2
MSGBOX "List1 text: " + sText1 + $CRLF + _
"List2 text: " + sText2, _
%MB_TASKMODAL, "Selected item's text"
END IF
CASE %IDCANCEL ' <- Cancel or Esc key was pressed
IF CBCTLMSG = %BN_CLICKED THEN
DIALOG END CBHNDL
END IF
END SELECT
END SELECT
END FUNCTION