getUserActivity

[Stephane Maillard]

Code : Tout sélectionner

Option Public
Option Declare

'(declarations)
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 )



Dim s As notesSession
Dim ndb As notesdatabase

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.
hdb& = OpenDatabase(ndb.Server, ndb.FilePath)
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
Print "DB SUMMARY ACTIVITY: ", DBSummaryActivity.Uses, DBSummaryActivity.Reads, DBSummaryActivity.Writes
'*** 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
Next

'*** Clear up and clear out.
Call W32_OSUnlockObject( hDBUserActivity% )
Call W32_OSMemFree( hDBUserActivity% )
Call W32_NSFDbClose( hdb& )

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

Sub Initialize
Set s = New NotesSession
Set ndb = s.currentDatabase
Call getUserActivity
End Sub