[AccessD] C2DbWakeup

Per Michaels suggestion I added the ability of clsWakeup to actually execute
the process name as a program.  I also added a boolean to the init
parameters to allow telling clsWakeup whether or not to execute this as a
windows command (program).  This required also adding a boolean parameter to
the Supervisor function that creates the clsWakeup instance.  And finally, I
added a checkbox to the form to allow the user to select whether the process
name being added is a windows program or not.

The modified demo can be found on my site.

The new code now looks like:

Option Compare Database
Option Explicit
'
'This class holds information about a single wakeup
'
Private mdteLastRan As Date     'The last date a wakeup was done
Private mdteTimeToRun As Date   'The time to say wakeup
Private mstrProcessName As String   'The process name needing woken up
Private mblnRunCommand As Boolean 'True means class instance will run the
process as a command (windows program)

Private Declare Function WinExec Lib "kernel32" _
                (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long

'
'The class_Initialize is similar to Form_Open in that it always runs ONE
time as a class opens
'Use this to initialize the LastDateRan variable
'
Private Sub Class_Initialize()
    mdteLastRan = Date - 1
End Sub
'
'Each instance of this class will hold a time to run (wakeup)
'And a process to wakeup
'
Function Init(ldteTimeToRun As Date, lstrProcessName As String, _
                Optional lblnRunCommand As Boolean = False)
    mdteTimeToRun = ldteTimeToRun
    mstrProcessName = lstrProcessName
    mblnRunCommand = lblnRunCommand
End Function
'
'This function checks whether the process has run in the last 24 hours
'If so it returns true and passes back the process name in a string variable
'passed in
'
Function Run(lstrProcessName) As Boolean
Dim lngProc As Long
    'Hasn't run today so check if the time is > mdetTimeToRun
    If Time() > mdteTimeToRun Then
        If Date > mdteLastRan Then
            'Mark mdteLastRun = Now()
            mdteLastRan = Date
            '
            If mblnRunCommand Then
                lngProc = WinExec(mstrProcessName, 1)
            End If
            'and return true
            lstrProcessName = mstrProcessName
            Run = True
        End If
    End If
End Function

*********

Option Compare Database
Option Explicit

'A collection to hold instances of clsWakeup
Private colClsWakeup As Collection

'An event to raise if a clsWakeup instance says its time to wakeup
Public Event ProcessTime(lstrProcessName As String)

'
'The class_Initialize is similar to Form_Open in that it always runs ONE
time as a class opens
'Use this to create the collection to hold the wakeup classes
'
Private Sub Class_Initialize()
    Set colClsWakeup = New Collection
End Sub
'
'Class_Terminate is similar to Form_Close and always runs ONCE as the class
terminates
'Use it to unload all the clsWakeup instances in the collection
'
Private Sub Class_Terminate()
    term
End Sub

'
'As the supervisor class closes, it must unload all the clsWakeup instances
in its collection
'
Function term()
    On Error Resume Next
    While colClsWakeup.Count > 0
        colClsWakeup.Remove (1)
    Wend
End Function
'
'This function is responsible for creating one instance of clsWakeup every
time it is called
'
Function NewWakeup(ldteTimeToRun As Date, lstrProcessName As String, _
                    Optional blnRunAsCommand As Boolean = False)
Dim lclsWakeup As clsWakeup
    Set lclsWakeup = New clsWakeup
    'It then initializes that instance with the TimeToRun and the
ProcessName
    lclsWakeup.Init ldteTimeToRun, lstrProcessName, blnRunAsCommand
    'And finally, it saves a pointer to the clsWakeup instance just created
in the collection
    colClsWakeup.Add lclsWakeup, lstrProcessName
End Function
'
'CheckWakeup is called by a timer tick on a form.  It cycles through all the
instances of clsWakeup
'in its collection asking each instance if it's time for that instance to
run.
'
Function CheckWakeup()
Dim lclsWakeup As clsWakeup
Dim lstrProcessName As String

    For Each lclsWakeup In colClsWakeup 'Check each instance of clsWakeup
        If lclsWakeup.Run(lstrProcessName) Then 'If time to run then
            RaiseEvent ProcessTime(lstrProcessName) 'Raise an event telling
the world
        End If
    Next lclsWakeup
End Function

******

Option Compare Database
Option Explicit

'
'Dimension a supervisor class Withevents
'
Private WithEvents fclsWakeupSupervisor As clsWakeupSupervisor
'
'When the form closes we need to unload the supervisor class
'
Private Sub Form_Close()
    Set fclsWakeupSupervisor = Nothing
End Sub
'
'When the form opens we need to create an instance of the supervisor class
'
Private Sub Form_Open(Cancel As Integer)
    Set fclsWakeupSupervisor = New clsWakeupSupervisor
End Sub
'
'The close button (standard stuff)
'
Private Sub Command6_Click()
On Error GoTo Err_Command6_Click


    DoCmd.Close

Exit_Command6_Click:
    Exit Sub

Err_Command6_Click:
    MsgBox Err.Description
    Resume Exit_Command6_Click

End Sub
'
'The form's timer event will be used to call the supervisor class'
CheckWakeup method
'
Private Sub Form_Timer()
    'Erase the last value to make clear that it only was set once / 24 hours
    txtWakingUp.Value = ""
    'And write a status to the status box to make clear that we are calling
this every 10 seconds
    txtStatus.Value = "Checked wakeup list at: " & Now
    'Then call the supervisor's CheckWakup method
    fclsWakeupSupervisor.CheckWakeup
End Sub
'
'This is a very simple way of programming the processes that need to be
wakened every day
'
Private Sub txtProcessName_AfterUpdate()
    'pass in the time to do the wakeup and the process name of the process
to wake up
    '!!!!notice no error handling such as was anything entered in time!!!!
    fclsWakeupSupervisor.NewWakeup txtNewTime.Value, txtProcessName.Value,
chkRunAsCommand.Value
    'if the form timer is not initialized, then set the interval to 10
seconds
    If Me.TimerInterval = 0 Then
        Me.TimerInterval = 10000
    End If
End Sub
'
'This is the event from the supervisor that will be raised if any process
needs to be awakened.
'
Private Sub fclsWakeupSupervisor_ProcessTime(lstrProcessName As String)
    txtWakingUp.Value = lstrProcessName
End Sub

John W. Colby
www.ColbyConsulting.com

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com]On Behalf Of Michael R
Mattys
Sent: Saturday, January 17, 2004 2:23 PM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] C2DbWakeup


John,

I just had a look at your demo and just wanted to offer
that you could put in something like the following

'Module
Public Declare Function WinExec Lib "kernel32" _
(ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long

'clsWakeUp
Function Run(lstrProcessName) As Boolean
    'Hasn't run today so check if the time is > mdetTimeToRun
    If time() > mdteTimeToRun Then
        If Date > mdteLastRan Then
            Dim lngProc As Long
            lngProc = WinExec(mstrProcessName, 1)
            'Mark mdteLastRun = Now()
            mdteLastRan = Date
            'and return true
            lstrProcessName = mstrProcessName
            Run = True
        End If
    End If
End Function

Michael R. Mattys
Try MattysMapLib for MapPoint at
www.mattysconsulting.com