How Do I Kick the selected one out of a database. MSAccess 2016 (1 Viewer)

isladogs

MVP / VIP
Local time
Today, 17:44
Joined
Jan 14, 2017
Messages
18,186
Many thanks for the kind words in the last two posts...🤣🙄
 

Solo712

Registered User.
Local time
Today, 13:44
Joined
Oct 19, 2012
Messages
828
Hi,
you can prevent the machine from going to sleep during the program execution by this API function:
Code:
 Enum Execution_State
        ES_SYSTEM_REQUIRED = &H1
        ES_DISPLAY_REQUIRED = &H2
        ES_USER_PRESENT = &H4
        ES_CONTINUOUS = &H80000000

    End Enum
    Declare Sub SetThreadExecutionState Lib "kernel32" (ByRef esFlags As EXECUTION_STATE)
    Public Sub DoNotSleep()
        SetThreadExecutionState(esFlags:=Execution_State.ES_SYSTEM_REQUIRED Or Execution_State.ES_DISPLAY_REQUIRED Or Execution_State.ES_CONTINUOUS)
    End Sub

Best,
Jiri
 

isladogs

MVP / VIP
Local time
Today, 17:44
Joined
Jan 14, 2017
Messages
18,186
Thanks Jiri
 

Solo712

Registered User.
Local time
Today, 13:44
Joined
Oct 19, 2012
Messages
828
What would be the code in that case which I can use behind Disconnect user.
frmTimeOut.png
Here is a code sample. There are some externals to this but the methodology of a timed-out session should be hopefully clear. The code is class module to a timer form that runs in the background. The splash screen with a counter becomes visible two minutes before shutdown (this splash screen is kept on top of all windows). The setting of UserLevel = 0 when run through a timer loop in the Main form will cause the application to shut down when the counter hits 0. When an admin wants to shut down all the workstations, he sets a zShutDown flag in the Z-table (back-end) which then makes the shutdown mandatory for all stations, i.e. the countdown cannot be reversed by a key hit.
Code:
'--------------------
' 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
 

Users who are viewing this thread

Top Bottom