Automated Time Tracker

'  Add to a module.bas
 
Option Explicit
 
Private Const STATE_USER_IDLE_BEGIN As Long = 1
Private Const STATE_USER_IDLE_END As Long = 2
 
Private Declare Function BeginIdleDetection Lib "msidle.dll" Alias "#3" (ByVal pfnCallback As Long, ByVal dwIdleMin As Long, ByVal dwReserved As Long) As Long
Private Declare Function EndIdleDetection Lib "msidle.dll" Alias "#4" (ByVal dwReserved As Long) As Long
Private Declare Function GetIdleMinutes Lib "msidle.dll" Alias "#8" (ByVal dwReserved As Long) As Long
 
Public Function IdleDetectionBegin(ByVal dwMinutes As Long) As Boolean
' Begins monitoring inactivity.
  If BeginIdleDetection(AddressOf IDLECALLBACK, dwMinutes, 0) = 0 Then
    IdleDetectionBegin = True
  End If
End Function
 
Public Function IdleMinutes() As Long
  ' Returns the number of minutes since the user's last activity.
  IdleMinutes = GetIdleMinutes(0)
End Function
 
Public Sub IdleDetectionEnd()
  ' Ends monitoring of inactivity.
  Call EndIdleDetection(0)
End Sub
 
Public Function IDLECALLBACK(ByVal dwState As Long) As Long
  ' The function that is called when the idle state changes.
  Select Case dwState
    Case STATE_USER_IDLE_BEGIN
      Debug.Print "User away: " & Time
    Case STATE_USER_IDLE_END
      Debug.Print "User back: " & Time
  End Select
End Function
 
 
 
' Add to a form
 
Option Explicit
 
Private Sub Form_Load()
  
  If IdleDetectionBegin(5) Then
    ' We are monitoring for inactivity.
    ' Wait for callback data.
  Else
    ' Failed to setup monitoring.
  End If
  
End Sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 
  Call IdleDetectionEnd
  
End Sub

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:

' Add to module1.bas
 
 
' Detects if the user has been idle for specified amount of time
' then writes the date and time to user defined log file.
 
Option Explicit
 
Private Const STATE_USER_IDLE_BEGIN As Long = 1
Private Const STATE_USER_IDLE_END As Long = 2
Private Const INVALID_HANDLE_VALUE As Long = (-1)
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_APPEND_DATA As Long = &H4
Private Const OPEN_ALWAYS As Long = 4
 
' LogEvent API.
Private Declare Function CreateFileW Lib "Kernel32.dll" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "Kernel32.dll" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal hObject As Long) As Long
' Idle API.
Private Declare Function BeginIdleDetection Lib "msidle.dll" Alias "#3" (ByVal pfnCallback As Long, ByVal dwIdleMin As Long, ByVal dwReserved As Long) As Long
Private Declare Function EndIdleDetection Lib "msidle.dll" Alias "#4" (ByVal dwReserved As Long) As Long
Private Declare Function GetIdleMinutes Lib "msidle.dll" Alias "#8" (ByVal dwReserved As Long) As Long
 
Public hFile As Long ' The handle to the event log file.
 
Public Function IdleDetectionBegin(ByVal dwMinutes As Long) As Boolean
' Begins monitoring inactivity.
  If BeginIdleDetection(AddressOf IDLECALLBACK, dwMinutes, 0) = 0 Then
    IdleDetectionBegin = True
  End If
End Function
 
Public Sub IdleDetectionEnd()
  ' Ends monitoring of inactivity.
  Call EndIdleDetection(0)
End Sub
 
Public Function IDLECALLBACK(ByVal dwState As Long) As Long
  ' The function that is called when the idle state changes.
  Select Case dwState
    Case STATE_USER_IDLE_BEGIN
    ' Write to the log here.
      Call WriteEventLog(Date & " " & Time & " USER AWAY " & vbNewLine)
    Case STATE_USER_IDLE_END
    ' Write to the log here.
      Call WriteEventLog(Date & " " & Time & " USER BACK " & vbNewLine & vbNewLine)
  End Select
End Function
 
Private Function IsInvalid(ByVal dwArgs As Long) As Boolean
  ' Check if a handle to file is invalid.
  Select Case dwArgs
    Case INVALID_HANDLE_VALUE, 0
      IsInvalid = True
    Case Else
      IsInvalid = False
  End Select
End Function
 
Public Sub OpenEventLog(ByVal szPath As String)
 
  ' Open the handle for append/write operations and restrict other
  ' applications from changing or editing the file give them
  ' only read access. Creates the file if it doesn't exist
  ' otherwise it opens the existing file.
  ' Users must have write access to the location.
  
  hFile = CreateFileW(StrPtr(szPath), FILE_APPEND_DATA, FILE_SHARE_READ, 0, OPEN_ALWAYS, 0, 0)
  
  If IsInvalid(hFile) Then
    MsgBox "Error: Bad file handle. " & Err.LastDllError, vbCritical
  End If
 
End Sub
 
Private Sub WriteEventLog(ByVal szMessage As String)
 
  Dim cbWritten As Long
  Dim cbMessageSize As Long
  
  ' Make sure the handle is valid.
  If IsInvalid(hFile) Then
    MsgBox "Error: Couldn't write handle is bad.", vbCritical
    Exit Sub
  End If
  
  ' The length of the message data.
  cbMessageSize = Len(szMessage)
  
  ' Write/Append message to data to file.
  Call WriteFile(hFile, ByVal szMessage, cbMessageSize, cbWritten, 0)
 
End Sub
 
Public Sub CloseEventLog()
  ' Closes the handle to the file.
  CloseHandle hFile
  hFile = 0
End Sub
 
 
' Add to form1.frm
 
Option Explicit
 
Private Sub Form_Load()
  
  ' Hide form from the user?
  'Me.Hide
  ' Hide from the task bar?
  'App.TaskVisible = False
  
  ' Begin the idle callback. [using 1 minute for debugging]
  If IdleDetectionBegin(1) Then  ' change to 5 min later.
  ' Prepare log file here.
    Call OpenEventLog("d:\test.txt")
  Else
    MsgBox "Error: IdleDetectionBegin failed", vbCritical
  End If
  
End Sub
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  
  ' End the idle callback.
  Call IdleDetectionEnd
  
  ' Close handle to file.
  Call CloseEventLog
  
End Sub
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:

Option Explicit
 
Private Const ERROR_SUCCESS As Long = 0
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const KEY_SET_VALUE As Long = &H2
Private Const REG_SZ As Long = 1
 
Private Declare Function RegOpenKeyExA Lib "Advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegSetValueExA Lib "Advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "Advapi32.dll" (ByVal hKey As Long) As Long
 
Public Sub WriteRegistryEntry(ByVal szSubKey As String, ByVal szName As String, ByVal szData As String)
  
  Dim cbData As Long
  Dim lpKey As Long
 
  If RegOpenKeyExA(HKEY_LOCAL_MACHINE, szSubKey, 0, KEY_SET_VALUE, lpKey) = ERROR_SUCCESS Then
    szData = (szData & vbNullChar)
    cbData = LenB(szData)
    If RegSetValueExA(lpKey, szName, 0, REG_SZ, szData, cbData) = ERROR_SUCCESS Then
      Debug.Print "Success!"
    Else
      Debug.Print "Failed to write value"
    End If
    Call RegCloseKey(lpKey)
  Else
    Debug.Print "Failed to open key"
  End If
  
End Sub
 
Private Sub Command1_Click()
 
  Call WriteRegistryEntry("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "appname", "c:\windows\myapp.exe")
 
End Sub

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:

' Add to module1.bas
 
 
' Detects if the user has been idle for specified amount of time
' then writes the date and time to user defined log file.
 
Option Explicit
 
Private Const STATE_USER_IDLE_BEGIN As Long = 1
Private Const STATE_USER_IDLE_END As Long = 2
Private Const INVALID_HANDLE_VALUE As Long = (-1)
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_APPEND_DATA As Long = &H4
Private Const OPEN_ALWAYS As Long = 4
 
' LogEvent API.
Private Declare Function CreateFileW Lib "Kernel32.dll" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "Kernel32.dll" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal hObject As Long) As Long
' Idle API.
Private Declare Function BeginIdleDetection Lib "msidle.dll" Alias "#3" (ByVal pfnCallback As Long, ByVal dwIdleMin As Long, ByVal dwReserved As Long) As Long
Private Declare Function EndIdleDetection Lib "msidle.dll" Alias "#4" (ByVal dwReserved As Long) As Long
Private Declare Function GetIdleMinutes Lib "msidle.dll" Alias "#8" (ByVal dwReserved As Long) As Long
 
Public hFile As Long ' The handle to the event log file.
 
Public Function IdleDetectionBegin(ByVal dwMinutes As Long) As Boolean
' Begins monitoring inactivity.
  If BeginIdleDetection(AddressOf IDLECALLBACK, dwMinutes, 0) = 0 Then
    IdleDetectionBegin = True
  End If
End Function
 
Public Sub IdleDetectionEnd()
  ' Ends monitoring of inactivity.
  Call EndIdleDetection(0)
End Sub
 
Public Function IDLECALLBACK(ByVal dwState As Long) As Long
  ' The function that is called when the idle state changes.
  Select Case dwState
    Case STATE_USER_IDLE_BEGIN
    ' Write to the log here.
      Call WriteEventLog(Date & " " & Time & " USER AWAY " & vbNewLine)
    Case STATE_USER_IDLE_END
    ' Write to the log here.
      Call WriteEventLog(Date & " " & Time & " USER BACK " & vbNewLine & vbNewLine)
  End Select
End Function
 
Private Function IsInvalid(ByVal dwArgs As Long) As Boolean
  ' Check if a handle to file is invalid.
  Select Case dwArgs
    Case INVALID_HANDLE_VALUE, 0
      IsInvalid = True
    Case Else
      IsInvalid = False
  End Select
End Function
 
Public Sub OpenEventLog(ByVal szPath As String)
 
  ' Open the handle for append/write operations and restrict other
  ' applications from changing or editing the file give them
  ' only read access. Creates the file if it doesn't exist
  ' otherwise it opens the existing file.
  ' Users must have write access to the location.
  
  hFile = CreateFileW(StrPtr(szPath), FILE_APPEND_DATA, FILE_SHARE_READ, 0, OPEN_ALWAYS, 0, 0)
  
  If IsInvalid(hFile) Then
    MsgBox "Error: Bad file handle. " & Err.LastDllError, vbCritical
  End If
 
End Sub
 
Private Sub WriteEventLog(ByVal szMessage As String)
 
  Dim cbWritten As Long
  Dim cbMessageSize As Long
  
  ' Make sure the handle is valid.
  If IsInvalid(hFile) Then
    MsgBox "Error: Couldn't write handle is bad.", vbCritical
    Exit Sub
  End If
  
  ' The length of the message data.
  cbMessageSize = Len(szMessage)
  
  ' Write/Append message to data to file.
  Call WriteFile(hFile, ByVal szMessage, cbMessageSize, cbWritten, 0)
 
End Sub
 
Public Sub CloseEventLog()
  ' Closes the handle to the file.
  CloseHandle hFile
  hFile = 0
End Sub
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100: