crear un formInactiveShotDown
Option Compare Database
Option Explicit
' frmInactiveShutDown v2.3 for MS Access from Peter's Software
' v3.0 Access 2010 64-bit compatibility
' v2.3 includes a "On Error GoTo 0" at the bottom of the timer routine
'
' Copyright: Peter's Software 2001-2010 :: http://www.peterssoftware.com
'
' Description:
' A form that monitors user activity and automatically shuts down the application after
' a specified period of inactivity.
'
' This module was created by:
'
' Peter's Software
' info@peterssoftware.com
' http://www.peterssoftware.com
'
' Special thanks to
' Stefano Sarasso
'
' This form and associated code are distributed as freeware
'
' Usage
'
' Import the form frmInactiveShutDown into your application and open it hidden at application startup.
'
' Set the inactivity period by adjusting values in the form OnOpen event procedure.
'
' Optionally include the basISDOptionalModule to take advantage of a global variable that is set
' to True when an Inactive Timeout occurs.
'
'* Set this constant to True if you want the ISD form to pop up in front of other
'* application windows when an Inactive Timeout occurs.
Const conPopUpISDFormForeground = True
Const conSeconndsPerMinute = 60
Dim sngStartTime As Single
Dim ctlSave As Control
Dim intMinutesUntilShutDown As Integer
Dim intMinutesWarningAppears As Integer
Private Const SW_RESTORE = 9
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_SHOWWINDOW = &H40
Private Const HWND_TOP = 0
Private Const HWND_TOPMOST = -1
'v3.0 - Access 2010 64-bit compatibility
#If VBA7 Then
Private Declare PtrSafe Function SetForegroundWindow& Lib "user32" (ByVal hwnd As LongPtr)
Private Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#Else
Private Declare Function SetForegroundWindow& Lib "user32" (ByVal hwnd As Long)
Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#End If
Private Function xg_CallIfPresent(pstrFunctionNameAndParms As String) As Integer
'* Call a function using the Eval function.
'* This method allows us to call a function whether it exists or not.
'*
'* Returns
'* 1 - Function found, executed, and returns True
'* 2 - Function found, executed, and returns False
'* 3 - Function not found
'* 99 - Other error
Dim intRtn As Integer
On Error Resume Next
If Eval(pstrFunctionNameAndParms) Then
If err <> 0 Then
Select Case err
Case 2425, 2426
intRtn = 3 '* The function is not found
Case Else
MsgBox "Error in xg_CallIfPresent when calling '" & pstrFunctionNameAndParms & "': " & err.Number & " - " & err.Description
intRtn = 99 '* Other error
End Select
err.Clear
Else
intRtn = 1 '* Function evaluates to True
End If
Else
intRtn = 2 '* Function evaluates to False
End If
Exit_Section:
On Error Resume Next
xg_CallIfPresent = intRtn
On Error GoTo 0
Exit Function
Err_Section:
Beep
MsgBox "Error in xg_CallIfPresent: " & err.Number & " - " & err.Description
err.Clear
Resume Exit_Section
End Function
Private Sub Form_Close()
On Error Resume Next
ctlSave = Nothing
err.Clear
On Error GoTo 0
End Sub
Private Sub Form_Open(Cancel As Integer)
'* Set this variable to the number of minutes of inactivity
'* allowed before the application automatically shuts down.
intMinutesUntilShutDown = 2
'intMinutesUntilShutDown = 120
'* Set this variable to the number of minutes that the
'* warning form will appear before the application
'* automatically shuts down.
intMinutesWarningAppears = 1
'intMinutesWarningAppears = 2
Me.Visible = False
sngStartTime = Timer
End Sub
Private Sub Form_Timer()
'**********************************************************************
'* This timer event procedure will shut down the application
'* after a specified number of minutes of inactivity. Inactivity
'* is measured based on how long a control remains the ActiveControl.
'**********************************************************************
Dim sngElapsedTime As Single
Dim ctlNew As Control
Dim i As Integer
Dim FN(20) As String
On Error Resume Next
'If Time() > #5:00:00 PM# Then '* Uncomment this to have ISD start at a particular time of day
Set ctlNew = Screen.ActiveControl
If err <> 0 Then
'* No activecontrol
'pddxxx need to use datediff("s" ... here because timer resets at midnight
' find difference in seconds
sngElapsedTime = Timer - sngStartTime
err.Clear
Else
If ctlNew.Name = "InactiveShutDownCancel" Then
'* The warning form has appeared, and the cancel button
'* is the active control
sngElapsedTime = Timer - sngStartTime
Else
If ctlNew.Name = ctlSave.Name Then
'* Still at same control
sngElapsedTime = Timer - sngStartTime
Else
'* Some change has occured, we're at a new control
Set ctlSave = ctlNew
sngStartTime = Timer
End If
If err <> 0 Then
Set ctlSave = Screen.ActiveControl
End If
End If
End If
err.Clear
'Else
' sngElapsedTime = 0
'End If
Set ctlNew = Nothing
Select Case sngElapsedTime
Case Is > ((intMinutesUntilShutDown - intMinutesWarningAppears) * conSeconndsPerMinute)
'* Make the warning form visible if it is not already visible.
If Me.Visible Then
Else
Me.Visible = True
If conPopUpISDFormForeground Then
'* Un-minimize Access application if it is minimized
If IsIconic(Application.hWndAccessApp) Then
ShowWindow Application.hWndAccessApp, SW_RESTORE
End If
'* Make it the foreground window - open it in front of other application windows.
SetForegroundWindow (Me.hwnd)
End If
'* Open it on top of other modal windows.
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW
End If
Case Else
'* The next line can be commented out if the form is opened hidden
'Me.Visible = False
End Select
Exit_Section:
On Error Resume Next
On Error GoTo 0
End Sub
Private Sub InactiveShutDownCancel_Click()
sngStartTime = Timer
Me.Visible = False
End Sub
-------------------------------------------------------------------------------------
crear un modulo llamado basISDOptionalModule
Option Compare Database
Option Explicit
'* This module can be used with the Inactive Shut Down Form. It is optional. Excluding this
'* module will not cause a compile error.
'*
'* The purpose of this module is to allow for all forms in the database to close when an Inactive
'* Timeout occurs. If a form has some prompt for user input in the form BeforeUpdate or Close event procedure
'* then the Inactive Shut Down Form will not be able to shut down the application. By checking the
'* value of the variable below in this situation, code that prompts for user input can be bypassed
'* and the form can be automatically closed. The variable is set to True when an Inactive Timeout
'* occurs.
'*
'* Ex.:
'*
'* Private Sub Form_Close()
'* If gintInactiveTimeout then
'* '* Skip the prompt for user input and close the form
'* Else
'* '* Prompt the user for some information
'* If MsgBox("Some prompt for user input", acYesNo) = acYes Then
'* '* Some code might run here
'* Else
'* '* Some other code might run here
'* End If
'* End If
'* End Sub
'* This is the global variable used by the Inactive Shut Down Form:
Public gintInactiveTimeout As Integer
Function isd_SetInactiveTimeoutVar(blnTrueOrFalse As Boolean) As Integer
'* This routine is used to set the value of the global Inactive Timeout variable
If blnTrueOrFalse = True Then
gintInactiveTimeout = True
Else
gintInactiveTimeout = False
End If
End Function
Option Compare Database
Option Explicit
' frmInactiveShutDown v2.3 for MS Access from Peter's Software
' v3.0 Access 2010 64-bit compatibility
' v2.3 includes a "On Error GoTo 0" at the bottom of the timer routine
'
' Copyright: Peter's Software 2001-2010 :: http://www.peterssoftware.com
'
' Description:
' A form that monitors user activity and automatically shuts down the application after
' a specified period of inactivity.
'
' This module was created by:
'
' Peter's Software
' info@peterssoftware.com
' http://www.peterssoftware.com
'
' Special thanks to
' Stefano Sarasso
'
' This form and associated code are distributed as freeware
'
' Usage
'
' Import the form frmInactiveShutDown into your application and open it hidden at application startup.
'
' Set the inactivity period by adjusting values in the form OnOpen event procedure.
'
' Optionally include the basISDOptionalModule to take advantage of a global variable that is set
' to True when an Inactive Timeout occurs.
'
'* Set this constant to True if you want the ISD form to pop up in front of other
'* application windows when an Inactive Timeout occurs.
Const conPopUpISDFormForeground = True
Const conSeconndsPerMinute = 60
Dim sngStartTime As Single
Dim ctlSave As Control
Dim intMinutesUntilShutDown As Integer
Dim intMinutesWarningAppears As Integer
Private Const SW_RESTORE = 9
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_SHOWWINDOW = &H40
Private Const HWND_TOP = 0
Private Const HWND_TOPMOST = -1
'v3.0 - Access 2010 64-bit compatibility
#If VBA7 Then
Private Declare PtrSafe Function SetForegroundWindow& Lib "user32" (ByVal hwnd As LongPtr)
Private Declare PtrSafe Function IsIconic Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#Else
Private Declare Function SetForegroundWindow& Lib "user32" (ByVal hwnd As Long)
Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#End If
Private Function xg_CallIfPresent(pstrFunctionNameAndParms As String) As Integer
'* Call a function using the Eval function.
'* This method allows us to call a function whether it exists or not.
'*
'* Returns
'* 1 - Function found, executed, and returns True
'* 2 - Function found, executed, and returns False
'* 3 - Function not found
'* 99 - Other error
Dim intRtn As Integer
On Error Resume Next
If Eval(pstrFunctionNameAndParms) Then
If err <> 0 Then
Select Case err
Case 2425, 2426
intRtn = 3 '* The function is not found
Case Else
MsgBox "Error in xg_CallIfPresent when calling '" & pstrFunctionNameAndParms & "': " & err.Number & " - " & err.Description
intRtn = 99 '* Other error
End Select
err.Clear
Else
intRtn = 1 '* Function evaluates to True
End If
Else
intRtn = 2 '* Function evaluates to False
End If
Exit_Section:
On Error Resume Next
xg_CallIfPresent = intRtn
On Error GoTo 0
Exit Function
Err_Section:
Beep
MsgBox "Error in xg_CallIfPresent: " & err.Number & " - " & err.Description
err.Clear
Resume Exit_Section
End Function
Private Sub Form_Close()
On Error Resume Next
ctlSave = Nothing
err.Clear
On Error GoTo 0
End Sub
Private Sub Form_Open(Cancel As Integer)
'* Set this variable to the number of minutes of inactivity
'* allowed before the application automatically shuts down.
intMinutesUntilShutDown = 2
'intMinutesUntilShutDown = 120
'* Set this variable to the number of minutes that the
'* warning form will appear before the application
'* automatically shuts down.
intMinutesWarningAppears = 1
'intMinutesWarningAppears = 2
Me.Visible = False
sngStartTime = Timer
End Sub
Private Sub Form_Timer()
'**********************************************************************
'* This timer event procedure will shut down the application
'* after a specified number of minutes of inactivity. Inactivity
'* is measured based on how long a control remains the ActiveControl.
'**********************************************************************
Dim sngElapsedTime As Single
Dim ctlNew As Control
Dim i As Integer
Dim FN(20) As String
On Error Resume Next
'If Time() > #5:00:00 PM# Then '* Uncomment this to have ISD start at a particular time of day
Set ctlNew = Screen.ActiveControl
If err <> 0 Then
'* No activecontrol
'pddxxx need to use datediff("s" ... here because timer resets at midnight
' find difference in seconds
sngElapsedTime = Timer - sngStartTime
err.Clear
Else
If ctlNew.Name = "InactiveShutDownCancel" Then
'* The warning form has appeared, and the cancel button
'* is the active control
sngElapsedTime = Timer - sngStartTime
Else
If ctlNew.Name = ctlSave.Name Then
'* Still at same control
sngElapsedTime = Timer - sngStartTime
Else
'* Some change has occured, we're at a new control
Set ctlSave = ctlNew
sngStartTime = Timer
End If
If err <> 0 Then
Set ctlSave = Screen.ActiveControl
End If
End If
End If
err.Clear
'Else
' sngElapsedTime = 0
'End If
Set ctlNew = Nothing
Select Case sngElapsedTime
Case Is > ((intMinutesUntilShutDown - intMinutesWarningAppears) * conSeconndsPerMinute)
'* Make the warning form visible if it is not already visible.
If Me.Visible Then
Else
Me.Visible = True
If conPopUpISDFormForeground Then
'* Un-minimize Access application if it is minimized
If IsIconic(Application.hWndAccessApp) Then
ShowWindow Application.hWndAccessApp, SW_RESTORE
End If
'* Make it the foreground window - open it in front of other application windows.
SetForegroundWindow (Me.hwnd)
End If
'* Open it on top of other modal windows.
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW
End If
Case Else
'* The next line can be commented out if the form is opened hidden
'Me.Visible = False
End Select
Exit_Section:
On Error Resume Next
On Error GoTo 0
End Sub
Private Sub InactiveShutDownCancel_Click()
sngStartTime = Timer
Me.Visible = False
End Sub
-------------------------------------------------------------------------------------
crear un modulo llamado basISDOptionalModule
Option Compare Database
Option Explicit
'* This module can be used with the Inactive Shut Down Form. It is optional. Excluding this
'* module will not cause a compile error.
'*
'* The purpose of this module is to allow for all forms in the database to close when an Inactive
'* Timeout occurs. If a form has some prompt for user input in the form BeforeUpdate or Close event procedure
'* then the Inactive Shut Down Form will not be able to shut down the application. By checking the
'* value of the variable below in this situation, code that prompts for user input can be bypassed
'* and the form can be automatically closed. The variable is set to True when an Inactive Timeout
'* occurs.
'*
'* Ex.:
'*
'* Private Sub Form_Close()
'* If gintInactiveTimeout then
'* '* Skip the prompt for user input and close the form
'* Else
'* '* Prompt the user for some information
'* If MsgBox("Some prompt for user input", acYesNo) = acYes Then
'* '* Some code might run here
'* Else
'* '* Some other code might run here
'* End If
'* End If
'* End Sub
'* This is the global variable used by the Inactive Shut Down Form:
Public gintInactiveTimeout As Integer
Function isd_SetInactiveTimeoutVar(blnTrueOrFalse As Boolean) As Integer
'* This routine is used to set the value of the global Inactive Timeout variable
If blnTrueOrFalse = True Then
gintInactiveTimeout = True
Else
gintInactiveTimeout = False
End If
End Function
