I had a requirement of recording all the activities of the database. By default domino database has user activities entries on the database property. But they get over written when the activity exceeds certain limit.
Option Public
Option Declare
Const MAXALPHATIMEDATE = 80
Type TIMEDATE
Innards(1) As Long
End Type
Type DBACTIVITY
First As TIMEDATE
Last As TIMEDATE
Uses As Long
Reads As Long
Writes As Long
PrevDayUses As Long
PrevDayReads As Long
PrevDayWrites As Long
PrevWeekUses As Long
PrevWeekReads As Long
PrevWeekWrites As Long
PrevMonthUses As Long
PrevMonthReads As Long
PrevMonthWrites As Long
End Type
Type DBACTIVITY_ENTRY
Time As TIMEDATE ' timedate as 2 longs = 8 bytes
Reads As Integer
Writes As Integer
UserNameOffset As Long ' pointer to user name
End Type
' Constants for User Activity
Const SizeOfDBACTIVITY_ENTRY& = 16 '*** Size of the DBACTIVITY_ENTRY structure
Const UNOOffset& = 12 '*** Byte position of the 'UserNameOffset' member within the DBACTIVITY_ENTRY
Const ODS_DWORD% = 1
Declare Function W32_NSFDbGetUserActivity Lib "nnotes.dll" Alias "NSFDbGetUserActivity" ( ByVal hdb As Long, ByVal flags As Long, retDBActivity As DBACTIVITY, rethUserInfo As Integer, retUserCount As Integer) As Integer
Declare Function W32_NSFDbOpen Lib "nnotes.dll" Alias "NSFDbOpen" ( ByVal dbName As String, hdb As Long ) As Integer
Declare Function W32_NSFDbClose Lib "nnotes.dll" Alias "NSFDbClose" ( ByVal hdb As Long ) As Integer
Declare Function W32_OSLockObject Lib "nnotes.dll" Alias "OSLockObject" ( ByVal handle As Any) As Long
Declare Sub W32_OSUnlockObject Lib "nnotes.dll" Alias "OSUnlockObject" ( ByVal handle As Any )
Declare Sub W32_OSMemFree Lib "nnotes.dll" Alias "OSMemFree" ( ByVal handle As Any)
Declare Sub W32_ODSReadMemory Lib "nnotes.dll" Alias "ODSReadMemory" ( pSource As Long, ByVal t As Integer, pDest As Long, ByVal Iterations As Integer )
Declare Sub W32_MemCopyStr Lib "kernel32.dll" Alias "RtlMoveMemory" ( ByVal pDest As String, ByVal pSource As Long, ByVal NumBytes As Long )
Declare Sub ConvertTIMEDATEToText Lib "NNOTES.DLL" Alias "ConvertTIMEDATEToText" (ByVal IntlFormat As Long,ByVal TextFormat As Long, actTIMEDATE As TIMEDATE, ByVal retTextBuffer As String,ByVal TextBufferLength As Integer,retTextLength As Integer)
Dim s As NotesSession
Dim ndb As NotesDatabase
Sub Terminate
End Sub
Function getUserActivity
Dim hdb As Long
Dim rc As Integer
Dim DBSummaryActivity As DBACTIVITY
Dim hDBUserActivity As Integer
Dim UserCount As Integer
Dim pUserActivity As Long
Dim pUserNameOffset As Long
Dim UserNameOffset As Long
Dim pActivityOffset As Long ' these 2 added by me
Dim currentActivity As DBACTIVITY_ENTRY
Dim pUserName As Long
Dim UserName As String
Dim Buff As String
Dim i As Integer
Dim Done As Integer
getUserActivity= False ' initial state
'*** Open a database with some user activity recorded.
Dim LPNDatabase As String
Dim LPNServer As String
LPNDatabase = getKeyWordValue("LPNDatabase" , "Keywords")
LPNServer = getKeyWordValue("LPNServer" , "Keywords")
hdb& = OpenDatabase( LPNServer, LPNDatabase)
If hdb& = 0 Then MessageBox "Error opening db": Exit Function
'*** Get the user activity.
rc% = W32_NSFDbGetUserActivity( hdb&, 0, DBSummaryActivity, hDBUserActivity%, UserCount% )
If rc% <> 0 Then
MessageBox "Error getting user activity"
Call W32_NSFDbClose( hdb& )
Exit Function
End If
'*** Lock down a pointer to the user activity.
pUserActivity& = W32_OSLockObject( hDBUserActivity% )
For i% = 0 To UserCount% - 1
pActivityOffset& = pUserActivity& + CLng( i% ) * SizeOfDBACTIVITY_ENTRY&
'*** Read the value of the current DBACTIVITY_ENTRY
' use some odsType that has the same length as dbactivityEntry structure i.e. =16
Call W32_ODSReadMemory (pActivityOffset& , 11, currentActivity.time.Innards(0), 1 )
'*** Add user name offset to the base pointer.
pUserName& = pUserActivity& + currentActivity.UserNameOffset&
'*** And finally read the actual user name byte by f***n byte.
Done% = False
Buff$ = String$( 1, 0 )
UserName$ = ""
While Not Done%
Call W32_MemCopyStr( Buff$, pUserName&, 1 )
If Buff$ = Chr$( 0 ) Then
Done% = True
Else
UserName$ = UserName$ & Buff$
pUserName& = pUserName& + 1
End If
Wend
'Print UserName$, currentActivity.Reads, currentActivity.Writes
Dim actDoc As NotesDocument
Set actDoc = getExistingDocument( currentActivity.Time , "lkpActivity")
If actDoc Is Nothing Then
Call createDocument("Activity",UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
Else
Call UpdateDocument(actDoc, UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
End If
Next
'*** Clear up and clear out.
Call W32_OSUnlockObject( hDBUserActivity% )
Call W32_OSMemFree( hDBUserActivity% )
Call W32_NSFDbClose( hdb& )
End Function
'*** Lock down a pointer to the user activity.
pUserActivity& = W32_OSLockObject( hDBUserActivity% )
For i% = 0 To UserCount% - 1
pActivityOffset& = pUserActivity& + CLng( i% ) * SizeOfDBACTIVITY_ENTRY&
'*** Read the value of the current DBACTIVITY_ENTRY
' use some odsType that has the same length as dbactivityEntry structure i.e. =16
Call W32_ODSReadMemory (pActivityOffset& , 11, currentActivity.time.Innards(0), 1 )
'*** Add user name offset to the base pointer.
pUserName& = pUserActivity& + currentActivity.UserNameOffset&
'*** And finally read the actual user name byte by f***n byte.
Done% = False
Buff$ = String$( 1, 0 )
UserName$ = ""
While Not Done%
Call W32_MemCopyStr( Buff$, pUserName&, 1 )
If Buff$ = Chr$( 0 ) Then
Done% = True
Else
UserName$ = UserName$ & Buff$
pUserName& = pUserName& + 1
End If
Wend
'Print UserName$, currentActivity.Reads, currentActivity.Writes
Dim actDoc As NotesDocument
Set actDoc = getExistingDocument( currentActivity.Time , "lkpActivity")
If actDoc Is Nothing Then
Call createDocument("Activity",UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
Else
Call UpdateDocument(actDoc, UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
End If
Next
'*** Clear up and clear out.
Call W32_OSUnlockObject( hDBUserActivity% )
Call W32_OSMemFree( hDBUserActivity% )
Call W32_NSFDbClose( hdb& )
End Function
Function UpdateDocument(actDoc As NotesDocument, UserName As String , ActivityReads As Variant , ActivityWrites As Variant, dateTime As TIMEDATE)
actDoc.createdDate = ConvertTIMEtoText(dateTime)
actDoc.UserName = UserName
actDoc.Reads = ActivityReads
actDoc.Writes = ActivityWrites
Call actDoc.save(True , False)
End Function
Function openDatabase (sServer As String, sFileName As String) As Long
' returns handle (or 0 if failure)
Dim fullPath As String
Dim lnghDb As Long
openDatabase = 0
If sServer$ = "" Then
fullPath = sFileName$' local DB
Else
fullPath = sServer$ & "!!" & sFileName$
End If
If W32_NSFDbOpen( fullPath$, lnghDb ) <> 0 Then Print "Could not open a database " &fullPath:Exit Function ' error
openDatabase =lnghDb
End Function
Function getGISUserActivity
Dim hdb As Long
Dim rc As Integer
Dim DBSummaryActivity As DBACTIVITY
Dim hDBUserActivity As Integer
Dim UserCount As Integer
Dim pUserActivity As Long
Dim pUserNameOffset As Long
Dim UserNameOffset As Long
Dim pActivityOffset As Long ' these 2 added by me
Dim currentActivity As DBACTIVITY_ENTRY
Dim pUserName As Long
Dim UserName As String
Dim Buff As String
Dim i As Integer
Dim Done As Integer
getGISUserActivity= False ' initial state
'*** Open a database with some user activity recorded.
Dim Database As String
Dim Server As String
Database = getKeyWordValue("GISDatabase" , "Keywords")
Server = getKeyWordValue("GISServer" , "Keywords")
hdb& = OpenDatabase( Server, Database)
If hdb& = 0 Then MessageBox "Error opening db": Exit Function
'*** Get the user activity.
rc% = W32_NSFDbGetUserActivity( hdb&, 0, DBSummaryActivity, hDBUserActivity%, UserCount% )
If rc% <> 0 Then
MessageBox "Error getting user activity"
Call W32_NSFDbClose( hdb& )
Exit Function
End If
'*** Lock down a pointer to the user activity.
pUserActivity& = W32_OSLockObject( hDBUserActivity% )
For i% = 0 To UserCount% - 1
pActivityOffset& = pUserActivity& + CLng( i% ) * SizeOfDBACTIVITY_ENTRY&
'*** Read the value of the current DBACTIVITY_ENTRY
' use some odsType that has the same length as dbactivityEntry structure i.e. =16
Call W32_ODSReadMemory (pActivityOffset& , 11, currentActivity.time.Innards(0), 1 )
'*** Add user name offset to the base pointer.
pUserName& = pUserActivity& + currentActivity.UserNameOffset&
'*** And finally read the actual user name byte by f***n byte.
Done% = False
Buff$ = String$( 1, 0 )
UserName$ = ""
While Not Done%
Call W32_MemCopyStr( Buff$, pUserName&, 1 )
If Buff$ = Chr$( 0 ) Then
Done% = True
Else
UserName$ = UserName$ & Buff$
pUserName& = pUserName& + 1
End If
Wend
'Print UserName$, currentActivity.Reads, currentActivity.Writes
Dim actDoc As NotesDocument
Set actDoc = getExistingDocument( currentActivity.Time , "lkpGISActivity")
If actDoc Is Nothing Then
Call createDocument("GISActivity",UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
Else
Call UpdateDocument(actDoc, UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
End If
Next
'*** Clear up and clear out.
Call W32_OSUnlockObject( hDBUserActivity% )
Call W32_OSMemFree( hDBUserActivity% )
Call W32_NSFDbClose( hdb& )
End Function
Function createDocument(formName As String ,UserName As String , ActivityReads As Variant , ActivityWrites As Variant, dateTime As TIMEDATE)
Dim actDoc As NotesDocument
Set actDoc = ndb.Createdocument()
actDoc.Form = formName
actDoc.createdDate = ConvertTIMEtoText(dateTime)
actDoc.UserName = UserName
actDoc.Reads = ActivityReads
actDoc.Writes = ActivityWrites
Call actDoc.save(True , False)
End Function
Function ConvertTIMEtoText(TIMESTRUCT As TIMEDATE) As String
Dim spTime As String * MAXALPHATIMEDATE
Dim retLength As Integer
spTime = Space(MAXALPHATIMEDATE)
Call ConvertTIMEDATEToText (&h0,&h0, TIMESTRUCT, spTime,MAXALPHATIMEDATE,retLength)
ConvertTIMEtoText = Left(spTime,retLength)
End Function
Function getExistingDocument(dateTime As TIMEDATE , viewname As string) As NotesDocument
Dim activityLookupView As NotesView
Dim activityLookupDocument As NotesDocument
Dim dateTimeString As String
dateTimeString = ConvertTIMEtoText(dateTime)
Set activityLookupView = ndb.Getview(viewname)
Set activityLookupDocument = activityLookupView.Getdocumentbykey(dateTimeString, True)
Set getExistingDocument = activityLookupDocument
End Function
Function getKeyWordValue(KeywordValue , KeywordViewName) As String
On Error GoTo ErrHandler
Dim KeywordView As NotesView
Dim KeywordDocument As NotesDocument
Set KeywordView = ndb.Getview(KeywordViewName)
Set KeywordDocument = KeywordView.Getdocumentbykey(KeywordValue, True)
If Not (KeywordDocument Is Nothing) Then
getKeyWordValue = KeywordDocument.Value(0)
End If
Exit Function
ErrHandler:
MessageBox "Error in function getKeyWordValue - " & Error$ & " , Line Number - " & Erl
Exit Function
End Function
'*** Lock down a pointer to the user activity.
pUserActivity& = W32_OSLockObject( hDBUserActivity% )
For i% = 0 To UserCount% - 1
pActivityOffset& = pUserActivity& + CLng( i% ) * SizeOfDBACTIVITY_ENTRY&
'*** Read the value of the current DBACTIVITY_ENTRY
' use some odsType that has the same length as dbactivityEntry structure i.e. =16
Call W32_ODSReadMemory (pActivityOffset& , 11, currentActivity.time.Innards(0), 1 )
'*** Add user name offset to the base pointer.
pUserName& = pUserActivity& + currentActivity.UserNameOffset&
'*** And finally read the actual user name byte by f***n byte.
Done% = False
Buff$ = String$( 1, 0 )
UserName$ = ""
While Not Done%
Call W32_MemCopyStr( Buff$, pUserName&, 1 )
If Buff$ = Chr$( 0 ) Then
Done% = True
Else
UserName$ = UserName$ & Buff$
pUserName& = pUserName& + 1
End If
Wend
'Print UserName$, currentActivity.Reads, currentActivity.Writes
Dim actDoc As NotesDocument
Set actDoc = getExistingDocument( currentActivity.Time , "lkpGISActivity")
If actDoc Is Nothing Then
Call createDocument("GISActivity",UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
Else
Call UpdateDocument(actDoc, UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
End If
Next
'*** Clear up and clear out.
Call W32_OSUnlockObject( hDBUserActivity% )
Call W32_OSMemFree( hDBUserActivity% )
Call W32_NSFDbClose( hdb& )
End Function
Function createDocument(formName As String ,UserName As String , ActivityReads As Variant , ActivityWrites As Variant, dateTime As TIMEDATE)
Dim actDoc As NotesDocument
Set actDoc = ndb.Createdocument()
actDoc.Form = formName
actDoc.createdDate = ConvertTIMEtoText(dateTime)
actDoc.UserName = UserName
actDoc.Reads = ActivityReads
actDoc.Writes = ActivityWrites
Call actDoc.save(True , False)
End Function
Function ConvertTIMEtoText(TIMESTRUCT As TIMEDATE) As String
Dim spTime As String * MAXALPHATIMEDATE
Dim retLength As Integer
spTime = Space(MAXALPHATIMEDATE)
Call ConvertTIMEDATEToText (&h0,&h0, TIMESTRUCT, spTime,MAXALPHATIMEDATE,retLength)
ConvertTIMEtoText = Left(spTime,retLength)
End Function
Function getExistingDocument(dateTime As TIMEDATE , viewname As string) As NotesDocument
Dim activityLookupView As NotesView
Dim activityLookupDocument As NotesDocument
Dim dateTimeString As String
dateTimeString = ConvertTIMEtoText(dateTime)
Set activityLookupView = ndb.Getview(viewname)
Set activityLookupDocument = activityLookupView.Getdocumentbykey(dateTimeString, True)
Set getExistingDocument = activityLookupDocument
End Function
Function getKeyWordValue(KeywordValue , KeywordViewName) As String
On Error GoTo ErrHandler
Dim KeywordView As NotesView
Dim KeywordDocument As NotesDocument
Set KeywordView = ndb.Getview(KeywordViewName)
Set KeywordDocument = KeywordView.Getdocumentbykey(KeywordValue, True)
If Not (KeywordDocument Is Nothing) Then
getKeyWordValue = KeywordDocument.Value(0)
End If
Exit Function
ErrHandler:
MessageBox "Error in function getKeyWordValue - " & Error$ & " , Line Number - " & Erl
Exit Function
End Function
So i decided to get all those activities and store in different database as documents. This way it was very easy to monitor the activity. Below is the code for the same.
Option Declare
Const MAXALPHATIMEDATE = 80
Type TIMEDATE
Innards(1) As Long
End Type
Type DBACTIVITY
First As TIMEDATE
Last As TIMEDATE
Uses As Long
Reads As Long
Writes As Long
PrevDayUses As Long
PrevDayReads As Long
PrevDayWrites As Long
PrevWeekUses As Long
PrevWeekReads As Long
PrevWeekWrites As Long
PrevMonthUses As Long
PrevMonthReads As Long
PrevMonthWrites As Long
End Type
Type DBACTIVITY_ENTRY
Time As TIMEDATE ' timedate as 2 longs = 8 bytes
Reads As Integer
Writes As Integer
UserNameOffset As Long ' pointer to user name
End Type
' Constants for User Activity
Const SizeOfDBACTIVITY_ENTRY& = 16 '*** Size of the DBACTIVITY_ENTRY structure
Const UNOOffset& = 12 '*** Byte position of the 'UserNameOffset' member within the DBACTIVITY_ENTRY
Const ODS_DWORD% = 1
Declare Function W32_NSFDbGetUserActivity Lib "nnotes.dll" Alias "NSFDbGetUserActivity" ( ByVal hdb As Long, ByVal flags As Long, retDBActivity As DBACTIVITY, rethUserInfo As Integer, retUserCount As Integer) As Integer
Declare Function W32_NSFDbOpen Lib "nnotes.dll" Alias "NSFDbOpen" ( ByVal dbName As String, hdb As Long ) As Integer
Declare Function W32_NSFDbClose Lib "nnotes.dll" Alias "NSFDbClose" ( ByVal hdb As Long ) As Integer
Declare Function W32_OSLockObject Lib "nnotes.dll" Alias "OSLockObject" ( ByVal handle As Any) As Long
Declare Sub W32_OSUnlockObject Lib "nnotes.dll" Alias "OSUnlockObject" ( ByVal handle As Any )
Declare Sub W32_OSMemFree Lib "nnotes.dll" Alias "OSMemFree" ( ByVal handle As Any)
Declare Sub W32_ODSReadMemory Lib "nnotes.dll" Alias "ODSReadMemory" ( pSource As Long, ByVal t As Integer, pDest As Long, ByVal Iterations As Integer )
Declare Sub W32_MemCopyStr Lib "kernel32.dll" Alias "RtlMoveMemory" ( ByVal pDest As String, ByVal pSource As Long, ByVal NumBytes As Long )
Declare Sub ConvertTIMEDATEToText Lib "NNOTES.DLL" Alias "ConvertTIMEDATEToText" (ByVal IntlFormat As Long,ByVal TextFormat As Long, actTIMEDATE As TIMEDATE, ByVal retTextBuffer As String,ByVal TextBufferLength As Integer,retTextLength As Integer)
Dim s As NotesSession
Dim ndb As NotesDatabase
Sub Terminate
End Sub
Function getUserActivity
Dim hdb As Long
Dim rc As Integer
Dim DBSummaryActivity As DBACTIVITY
Dim hDBUserActivity As Integer
Dim UserCount As Integer
Dim pUserActivity As Long
Dim pUserNameOffset As Long
Dim UserNameOffset As Long
Dim pActivityOffset As Long ' these 2 added by me
Dim currentActivity As DBACTIVITY_ENTRY
Dim pUserName As Long
Dim UserName As String
Dim Buff As String
Dim i As Integer
Dim Done As Integer
getUserActivity= False ' initial state
'*** Open a database with some user activity recorded.
Dim LPNDatabase As String
Dim LPNServer As String
LPNDatabase = getKeyWordValue("LPNDatabase" , "Keywords")
LPNServer = getKeyWordValue("LPNServer" , "Keywords")
hdb& = OpenDatabase( LPNServer, LPNDatabase)
If hdb& = 0 Then MessageBox "Error opening db": Exit Function
'*** Get the user activity.
rc% = W32_NSFDbGetUserActivity( hdb&, 0, DBSummaryActivity, hDBUserActivity%, UserCount% )
If rc% <> 0 Then
MessageBox "Error getting user activity"
Call W32_NSFDbClose( hdb& )
Exit Function
End If
'*** Lock down a pointer to the user activity.
pUserActivity& = W32_OSLockObject( hDBUserActivity% )
For i% = 0 To UserCount% - 1
pActivityOffset& = pUserActivity& + CLng( i% ) * SizeOfDBACTIVITY_ENTRY&
'*** Read the value of the current DBACTIVITY_ENTRY
' use some odsType that has the same length as dbactivityEntry structure i.e. =16
Call W32_ODSReadMemory (pActivityOffset& , 11, currentActivity.time.Innards(0), 1 )
'*** Add user name offset to the base pointer.
pUserName& = pUserActivity& + currentActivity.UserNameOffset&
'*** And finally read the actual user name byte by f***n byte.
Done% = False
Buff$ = String$( 1, 0 )
UserName$ = ""
While Not Done%
Call W32_MemCopyStr( Buff$, pUserName&, 1 )
If Buff$ = Chr$( 0 ) Then
Done% = True
Else
UserName$ = UserName$ & Buff$
pUserName& = pUserName& + 1
End If
Wend
'Print UserName$, currentActivity.Reads, currentActivity.Writes
Dim actDoc As NotesDocument
Set actDoc = getExistingDocument( currentActivity.Time , "lkpActivity")
If actDoc Is Nothing Then
Call createDocument("Activity",UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
Else
Call UpdateDocument(actDoc, UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
End If
Next
'*** Clear up and clear out.
Call W32_OSUnlockObject( hDBUserActivity% )
Call W32_OSMemFree( hDBUserActivity% )
Call W32_NSFDbClose( hdb& )
End Function
'*** Lock down a pointer to the user activity.
pUserActivity& = W32_OSLockObject( hDBUserActivity% )
For i% = 0 To UserCount% - 1
pActivityOffset& = pUserActivity& + CLng( i% ) * SizeOfDBACTIVITY_ENTRY&
'*** Read the value of the current DBACTIVITY_ENTRY
' use some odsType that has the same length as dbactivityEntry structure i.e. =16
Call W32_ODSReadMemory (pActivityOffset& , 11, currentActivity.time.Innards(0), 1 )
'*** Add user name offset to the base pointer.
pUserName& = pUserActivity& + currentActivity.UserNameOffset&
'*** And finally read the actual user name byte by f***n byte.
Done% = False
Buff$ = String$( 1, 0 )
UserName$ = ""
While Not Done%
Call W32_MemCopyStr( Buff$, pUserName&, 1 )
If Buff$ = Chr$( 0 ) Then
Done% = True
Else
UserName$ = UserName$ & Buff$
pUserName& = pUserName& + 1
End If
Wend
'Print UserName$, currentActivity.Reads, currentActivity.Writes
Dim actDoc As NotesDocument
Set actDoc = getExistingDocument( currentActivity.Time , "lkpActivity")
If actDoc Is Nothing Then
Call createDocument("Activity",UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
Else
Call UpdateDocument(actDoc, UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
End If
Next
'*** Clear up and clear out.
Call W32_OSUnlockObject( hDBUserActivity% )
Call W32_OSMemFree( hDBUserActivity% )
Call W32_NSFDbClose( hdb& )
End Function
Function UpdateDocument(actDoc As NotesDocument, UserName As String , ActivityReads As Variant , ActivityWrites As Variant, dateTime As TIMEDATE)
actDoc.createdDate = ConvertTIMEtoText(dateTime)
actDoc.UserName = UserName
actDoc.Reads = ActivityReads
actDoc.Writes = ActivityWrites
Call actDoc.save(True , False)
End Function
Function openDatabase (sServer As String, sFileName As String) As Long
' returns handle (or 0 if failure)
Dim fullPath As String
Dim lnghDb As Long
openDatabase = 0
If sServer$ = "" Then
fullPath = sFileName$' local DB
Else
fullPath = sServer$ & "!!" & sFileName$
End If
If W32_NSFDbOpen( fullPath$, lnghDb ) <> 0 Then Print "Could not open a database " &fullPath:Exit Function ' error
openDatabase =lnghDb
End Function
Function getGISUserActivity
Dim hdb As Long
Dim rc As Integer
Dim DBSummaryActivity As DBACTIVITY
Dim hDBUserActivity As Integer
Dim UserCount As Integer
Dim pUserActivity As Long
Dim pUserNameOffset As Long
Dim UserNameOffset As Long
Dim pActivityOffset As Long ' these 2 added by me
Dim currentActivity As DBACTIVITY_ENTRY
Dim pUserName As Long
Dim UserName As String
Dim Buff As String
Dim i As Integer
Dim Done As Integer
getGISUserActivity= False ' initial state
'*** Open a database with some user activity recorded.
Dim Database As String
Dim Server As String
Database = getKeyWordValue("GISDatabase" , "Keywords")
Server = getKeyWordValue("GISServer" , "Keywords")
hdb& = OpenDatabase( Server, Database)
If hdb& = 0 Then MessageBox "Error opening db": Exit Function
'*** Get the user activity.
rc% = W32_NSFDbGetUserActivity( hdb&, 0, DBSummaryActivity, hDBUserActivity%, UserCount% )
If rc% <> 0 Then
MessageBox "Error getting user activity"
Call W32_NSFDbClose( hdb& )
Exit Function
End If
'*** Lock down a pointer to the user activity.
pUserActivity& = W32_OSLockObject( hDBUserActivity% )
For i% = 0 To UserCount% - 1
pActivityOffset& = pUserActivity& + CLng( i% ) * SizeOfDBACTIVITY_ENTRY&
'*** Read the value of the current DBACTIVITY_ENTRY
' use some odsType that has the same length as dbactivityEntry structure i.e. =16
Call W32_ODSReadMemory (pActivityOffset& , 11, currentActivity.time.Innards(0), 1 )
'*** Add user name offset to the base pointer.
pUserName& = pUserActivity& + currentActivity.UserNameOffset&
'*** And finally read the actual user name byte by f***n byte.
Done% = False
Buff$ = String$( 1, 0 )
UserName$ = ""
While Not Done%
Call W32_MemCopyStr( Buff$, pUserName&, 1 )
If Buff$ = Chr$( 0 ) Then
Done% = True
Else
UserName$ = UserName$ & Buff$
pUserName& = pUserName& + 1
End If
Wend
'Print UserName$, currentActivity.Reads, currentActivity.Writes
Dim actDoc As NotesDocument
Set actDoc = getExistingDocument( currentActivity.Time , "lkpGISActivity")
If actDoc Is Nothing Then
Call createDocument("GISActivity",UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
Else
Call UpdateDocument(actDoc, UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
End If
Next
'*** Clear up and clear out.
Call W32_OSUnlockObject( hDBUserActivity% )
Call W32_OSMemFree( hDBUserActivity% )
Call W32_NSFDbClose( hdb& )
End Function
Function createDocument(formName As String ,UserName As String , ActivityReads As Variant , ActivityWrites As Variant, dateTime As TIMEDATE)
Dim actDoc As NotesDocument
Set actDoc = ndb.Createdocument()
actDoc.Form = formName
actDoc.createdDate = ConvertTIMEtoText(dateTime)
actDoc.UserName = UserName
actDoc.Reads = ActivityReads
actDoc.Writes = ActivityWrites
Call actDoc.save(True , False)
End Function
Function ConvertTIMEtoText(TIMESTRUCT As TIMEDATE) As String
Dim spTime As String * MAXALPHATIMEDATE
Dim retLength As Integer
spTime = Space(MAXALPHATIMEDATE)
Call ConvertTIMEDATEToText (&h0,&h0, TIMESTRUCT, spTime,MAXALPHATIMEDATE,retLength)
ConvertTIMEtoText = Left(spTime,retLength)
End Function
Function getExistingDocument(dateTime As TIMEDATE , viewname As string) As NotesDocument
Dim activityLookupView As NotesView
Dim activityLookupDocument As NotesDocument
Dim dateTimeString As String
dateTimeString = ConvertTIMEtoText(dateTime)
Set activityLookupView = ndb.Getview(viewname)
Set activityLookupDocument = activityLookupView.Getdocumentbykey(dateTimeString, True)
Set getExistingDocument = activityLookupDocument
End Function
Function getKeyWordValue(KeywordValue , KeywordViewName) As String
On Error GoTo ErrHandler
Dim KeywordView As NotesView
Dim KeywordDocument As NotesDocument
Set KeywordView = ndb.Getview(KeywordViewName)
Set KeywordDocument = KeywordView.Getdocumentbykey(KeywordValue, True)
If Not (KeywordDocument Is Nothing) Then
getKeyWordValue = KeywordDocument.Value(0)
End If
Exit Function
ErrHandler:
MessageBox "Error in function getKeyWordValue - " & Error$ & " , Line Number - " & Erl
Exit Function
End Function
'*** Lock down a pointer to the user activity.
pUserActivity& = W32_OSLockObject( hDBUserActivity% )
For i% = 0 To UserCount% - 1
pActivityOffset& = pUserActivity& + CLng( i% ) * SizeOfDBACTIVITY_ENTRY&
'*** Read the value of the current DBACTIVITY_ENTRY
' use some odsType that has the same length as dbactivityEntry structure i.e. =16
Call W32_ODSReadMemory (pActivityOffset& , 11, currentActivity.time.Innards(0), 1 )
'*** Add user name offset to the base pointer.
pUserName& = pUserActivity& + currentActivity.UserNameOffset&
'*** And finally read the actual user name byte by f***n byte.
Done% = False
Buff$ = String$( 1, 0 )
UserName$ = ""
While Not Done%
Call W32_MemCopyStr( Buff$, pUserName&, 1 )
If Buff$ = Chr$( 0 ) Then
Done% = True
Else
UserName$ = UserName$ & Buff$
pUserName& = pUserName& + 1
End If
Wend
'Print UserName$, currentActivity.Reads, currentActivity.Writes
Dim actDoc As NotesDocument
Set actDoc = getExistingDocument( currentActivity.Time , "lkpGISActivity")
If actDoc Is Nothing Then
Call createDocument("GISActivity",UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
Else
Call UpdateDocument(actDoc, UserName , currentActivity.Reads , currentActivity.Writes , currentActivity.Time)
End If
Next
'*** Clear up and clear out.
Call W32_OSUnlockObject( hDBUserActivity% )
Call W32_OSMemFree( hDBUserActivity% )
Call W32_NSFDbClose( hdb& )
End Function
Function createDocument(formName As String ,UserName As String , ActivityReads As Variant , ActivityWrites As Variant, dateTime As TIMEDATE)
Dim actDoc As NotesDocument
Set actDoc = ndb.Createdocument()
actDoc.Form = formName
actDoc.createdDate = ConvertTIMEtoText(dateTime)
actDoc.UserName = UserName
actDoc.Reads = ActivityReads
actDoc.Writes = ActivityWrites
Call actDoc.save(True , False)
End Function
Function ConvertTIMEtoText(TIMESTRUCT As TIMEDATE) As String
Dim spTime As String * MAXALPHATIMEDATE
Dim retLength As Integer
spTime = Space(MAXALPHATIMEDATE)
Call ConvertTIMEDATEToText (&h0,&h0, TIMESTRUCT, spTime,MAXALPHATIMEDATE,retLength)
ConvertTIMEtoText = Left(spTime,retLength)
End Function
Function getExistingDocument(dateTime As TIMEDATE , viewname As string) As NotesDocument
Dim activityLookupView As NotesView
Dim activityLookupDocument As NotesDocument
Dim dateTimeString As String
dateTimeString = ConvertTIMEtoText(dateTime)
Set activityLookupView = ndb.Getview(viewname)
Set activityLookupDocument = activityLookupView.Getdocumentbykey(dateTimeString, True)
Set getExistingDocument = activityLookupDocument
End Function
Function getKeyWordValue(KeywordValue , KeywordViewName) As String
On Error GoTo ErrHandler
Dim KeywordView As NotesView
Dim KeywordDocument As NotesDocument
Set KeywordView = ndb.Getview(KeywordViewName)
Set KeywordDocument = KeywordView.Getdocumentbykey(KeywordValue, True)
If Not (KeywordDocument Is Nothing) Then
getKeyWordValue = KeywordDocument.Value(0)
End If
Exit Function
ErrHandler:
MessageBox "Error in function getKeyWordValue - " & Error$ & " , Line Number - " & Erl
Exit Function
End Function