'--------------------
' frmTimeOut
'--------------------
' monitors usage of program and shuts
' down application after a period of inactivity
'
' Notes: (1) This form is not visible until the timeout
' limit is reached or a sysadmin initiated
' administration shutdown
'----------------
' Editing History
'----------------
'
' 14-Sep-2016 Initial Build
' 03-Oct-2016 Added sysadmin shutdown
' 04-Nov-2016 Added parametrized minutes of inactivity allowed (TOmins).
'
Option Compare Database
Option Explicit
Dim CountDown As Long, Mdlo As Long, CountdownStarted As Boolean, lR As Long, GoDownFlag As Boolean, StationExcepted As Boolean
Dim TOmins As Long
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If GoDownFlag Then Exit Sub
KeyCode = 0
CountdownStarted = False
glbTOMinutes = 0
Me.Visible = False
lR = SetTopMostWindow(Me.Form.hwnd, False)
[Forms]![frmMain].Label223.Caption = ""
End Sub
Private Sub Form_Load()
Me.Move Top:=3200, Left:=5200
Me.TimerInterval = 10000
End Sub
Private Sub Form_Timer()
Mdlo = Mdlo + 1
GoDownFlag = Nz(DLookup("zShutDown", "tblZ", "zID=1"))
TOmins = Nz(DLookup("zTOMins", "tblZ", "zID=1"), 30)
If Mdlo Mod 6 = 0 Then
glbTOMinutes = glbTOMinutes + 1
If glbTOMinutes > 14 Then
[Forms]![frmMain].Label223.Caption = "Inactive for " & CStr(glbTOMinutes) & " minutes"
End If
ElseIf Mdlo = 19 Then
[Forms]![frmMain].TimerInterval = 300
Mdlo = 0
SendKeys "{F15}"
End If
If Not GoDownFlag Then
If glbTOMinutes = 0 And CountdownStarted Then 'Counter was reset by some user action in other form
CountdownStarted = False
Me.Visible = False
lR = SetTopMostWindow(Me.Form.hwnd, False)
[Forms]![frmMain].Label223.Caption = ""
Exit Sub
End If
End If
If GoDownFlag Or glbTOMinutes >= TOmins Or CountdownStarted Then
DoCountDown
ElseIf glbTOMinutes < 14 Then
If Len([Forms]![frmMain].Label223.Caption) > 0 Then Forms![frmMain].Label223.Caption = ""
End If
End Sub
Private Sub DoCountDown()
Dim mins As Integer, secs As Integer
If Not CountdownStarted Then
CountDown = 120
If GoDownFlag Then
Label2.Caption = " Sysadmin is closing down Application:"
Label5.Caption = " it will shut down automatically"
Label8.Caption = ""
Else
Label2.Caption = "Warning: Application has been inactive"
Label5.Caption = "and will shut down automatically"
Label8.Caption = " ....press any key to reset inactivity timer! "
End If
Me.Visible = True
lR = SetTopMostWindow(Me.Form.hwnd, True)
CountdownStarted = True
Mdlo = 0
End If
CountDown = 120 - Mdlo * 20
mins = CountDown \ 60
secs = CountDown - mins * 60
If mins = 1 Then
Label6.Caption = " in " & CStr(mins) & " minute and " & CStr(secs) & " seconds"
Else
Label6.Caption = "in " & CStr(mins) & " minutes and " & CStr(secs) & " seconds"
End If
If CountDown = 0 Then ShutDowntheDamnThing
End Sub
Private Sub ShutDowntheDamnThing()
'
CurrentDb.Execute "UPDATE tblZ SET zShutDown = FALSE"
'
ToErrLog True, "frmTimeOut - ShutDown"
If GoDownFlag Then
ToErrLog False, "Administrative shutdown: SSWM session was terminated by sysadmin."
Else
ToErrLog False, "SSWM session run by user '" & glbUser & "' timed out and was terminated."
End If
If Not (glbComputer = Nz(DLookup("zComputer", "tblZ", "zID=1"))) Then
Forms("frmMain").LogoffUser
glbUserLevel = 0
[Forms]![frmMain].TimerInterval = 300
DoCmd.Close acForm, "frmTimeOut", acSaveNo
End If
End Sub