VB Scheduler needed

What OS / Service Pack will it run on?  Should it have a User Interface to Add/Modify/Delete scheduled items?  Will the app always run on the same machine?  Same network
account?  

CareyJ,

My project runs on Win98,Win2000,WinMe and NT4.0 SP4.
Im using VB6 SP4 enterprise.

I dont need any UI code Ill take of that, just a scheduler module to pass this data to and wait for events.

i.e. Ill pass in    (Approx format etc.)
   System4 = everday, at 12:00pm
   System6 = online, every 5 minutes
   System1 = Weekly,Monday,12:00pm

'*********************
The scheduler class will then

raise an event every day @12:00 for System4
raise an event every 5 minutes for System6
raise an event once a week, monday,12:00 for System1


 

There are no events in VB that are fired by the real-time clock so you are going to have to take a different approach.  The only way I can see is to periodically pole the system date/time and raise the events you want when the date/time exceeds the desired point.  I would put a timer in the project and pole the date/time each time the timer event fires then raise the events you want based on the current date/time.  The main problem with this approach is that the accuracy of the events will depend on the timer's interval.  If you want it to be very accurate then you would set it to a short interval but this would tie up system resources.  A longer interval would require fewer clock cycles but would be less accurate.

Joe,

The timer essentially would just wake up and look for a match.  If found, it would disable itself, to avoid nesting, and raise its own event( A user defined event for this scheduler object, not the timer)  This can be done.  I have during debugging placed many events in timers to continually ("ping") status to other obects.   The object raises the event, not the timer.

Thank you for your time.

Brent

I have one systray app that wakes up every 15 minutes and reads 2 schedule+ table objects; singleappointments and recurringappointments.  It will launch apps, send Mapi mail, send alpha pages.  The engine alone is overfill in your project.  I did another one <more like what you're trying to do sans the User Interface> using an Access database table of events.  

How much resolution do you need?  In other words, does it matter if it's 12:00:01 one day and 12:00:59 the next day?
Is 12:00:00 one day as good as 12:59:59 the next day?

Does it need to be multiuser?  Will more than one user run it?

The function will return Boolean results for each event name.  

It's call like:
    boolSystem1 = CheckMe(Now)
    boolSystem4 = CheckMe(Now)
    boolSystem6 = CheckMe(Now)

Want me to write it?

I can do this for you, but will need your email address to send the database.  I could post the Access Table Defs with the Source here if you prefer.

I have the code for an OCX that does what I thought You want. First testing when I was changing it for Your needs took some time as well as suport for different time formats.

This is a sample ini file:

;Ini file format:
;starts with ; -> comment
;second = means comment

; let us start one scheduler entry (each thursday at 9:22)
schedule = sc_event1  = starts new scheduler entry
freq = weekly = hourly, daily, weekly, per month, per year    executes once on each period
freq_minute = 22 = start time on given hour (in minutes for daily, weekly, ...)
freq_hour = 9 = start time (in hours for daily, weekly, ...)
freq_weekday = thu = start day of week (mon, tue, wen, thu, fri, sat, sun for weekly only)
;freq_monthday = integer = start day of month (for per month only)
;repeat = integer = time in minutes (it just repeats)
block = 1 = (0 - not active, other - started)


; and one periodic example (every 3 minutes)
schedule = periodic_1
repeat = 3 = time in minutes (it just repeats)
block = 1 = just to start it


End here is the code. Open VB and choose ActiveX Control. Delete controls VB is sugesting by itself and load this .ctl and .bas file. Change name of ocx if You want, otherwise it shall be named somethig like Poject1.

*** ctl file ******

VERSION 5.00
Begin VB.UserControl Sched
   ClientHeight    =   420
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   420
   InvisibleAtRuntime=   -1  'True
   ScaleHeight     =   420
   ScaleWidth      =   420
   Begin VB.Timer Timer1
      Interval        =   10000
      Left            =   0
      Top             =   0
   End
   Begin VB.Label Label1
      Caption         =   "SC"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   238
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   435
   End
End
Attribute VB_Name = "Sched"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Event IniFileError(error_type As String)
Event TaskStart(task_name As String)

Dim last_ini_line As String
Dim last_ini_path As String

Public Property Let ReadIni(ini_file_path As String)
  last_ini_path = ini_file_path
  If Not FileExists(ini_file_path) Then
    RaiseEvent IniFileError("No file")
    Exit Property
  End If
  If read_ini_file(ini_file_path) = False Then
    RaiseEvent IniFileError("Error reading ini file")
  End If
End Property

Public Property Let ReadIniLine(ini_line_str As String)
  last_ini_line = ini_line_str
  If read_ini_line(ini_line_str) = False Then
    RaiseEvent IniFileError("Error reading ini line")
  End If
End Property

Public Property Get ReadIni() As String
  ReadIni = last_ini_path
End Property

Public Property Get ReadIniLine() As String
  ReadIniLine = last_ini_line
End Property

Private Sub Timer1_Timer()
Dim i As Integer
Dim mint As Long
 
  mint = get_minute_time
  For i = 1 To last_sched
    If sched_table(i).sc_started = True Then
      Select Case sched_table(i).sc_freq
        Case 1
          If get_hour_count(CDbl(Now)) > get_hour_count(sched_table(i).sc_last_freq) Then
            RaiseEvent TaskStart(sched_table(i).sc_event_name)
            sched_table(i).sc_last_freq = CDbl(Now)
          End If
        Case 2
          If get_day_count(CDbl(Now)) > get_day_count(sched_table(i).sc_last_freq) Then
            If Format(Now, "hh") >= sched_table(i).sc_f_hour Then
              If get_minute(Now) >= sched_table(i).sc_f_minute Then
                RaiseEvent TaskStart(sched_table(i).sc_event_name)
                sched_table(i).sc_last_freq = CDbl(Now)
              End If
            End If
          End If
        Case 3
          If get_week_count(CDbl(Now)) > get_week_count(sched_table(i).sc_last_freq) Then
            If Format(Now, "hh") >= sched_table(i).sc_f_hour Then
              If get_minute(Now) >= sched_table(i).sc_f_minute Then
                If get_day_in_week_count(Now) = sched_table(i).sc_f_weekday Then
                  RaiseEvent TaskStart(sched_table(i).sc_event_name)
                  sched_table(i).sc_last_freq = CDbl(Now)
                End If
              End If
            End If
          End If
        Case 4
          If get_month_count(CDbl(Now)) > get_month_count(sched_table(i).sc_last_freq) Then
            If Format(Now, "hh") >= sched_table(i).sc_f_hour Then
              If get_minute(Now) >= sched_table(i).sc_f_minute Then
                If Val(Format(Now, "dd")) = sched_table(i).sc_f_monthday Then
                  RaiseEvent TaskStart(sched_table(i).sc_event_name)
                  sched_table(i).sc_last_freq = CDbl(Now)
                End If
              End If
            End If
          End If
        Case 5
          If get_year_count(CDbl(Now)) > get_year_count(sched_table(i).sc_last_freq) Then
            If Format(Now, "hh") >= sched_table(i).sc_f_hour Then
              If get_minute(Now) >= sched_table(i).sc_f_minute Then
                RaiseEvent TaskStart(sched_table(i).sc_event_name)
                sched_table(i).sc_last_freq = CDbl(Now)
              End If
            End If
          End If
      End Select
      If sched_table(i).sc_repeat <> 0 Then
        If sched_table(i).sc_repeat + sched_table(i).sc_last_repeat <= mint Then
          RaiseEvent TaskStart(sched_table(i).sc_event_name)
          sched_table(i).sc_last_repeat = mint
        End If
      End If
    End If
  Next i
End Sub


**** bas file **********

Attribute VB_Name = "sched_mod"
Type sched_descriptor_type
  sc_started As Boolean
  sc_event_name As String
  sc_freq As Integer
  sc_f_minute As Integer
  sc_f_hour As Integer
  sc_f_weekday As Integer
  sc_f_monthday As Integer
  sc_repeat As Long
  sc_last_freq As Double
  sc_last_repeat As Long
End Type

Public sched_table(0 To 1024) As sched_descriptor_type
Public last_sched As Integer

'****************************
' ;Ini file format:
' ;starts with ; -> comment
' ;second = means comment after

' schedule = eventname     = starts new scheduler entry)
' freq = string = hourly, daily, weekly, per month, per year    executes once on each period)
' freq_minute = integer = start time on given hour (in minutes for daily, weekly, ...)
' freq_hour = integer = start time (in hours for daily, weekly, ...)
' freq_weekday = string = start day of week (mon, tue, wen, thu, fri, sat, sun for weekly only)
' freq_monthday = integer = start day of month (for per month only)
' block = 0, anythyng else (0 - not active, other - started)
' repeat = integer = time in minutes (it just repeats)
'***************************

Function read_ini_file(ini_file_path As String) As Boolean
Dim interm As String
Dim cntinitfile As Integer
 
  On Error GoTo err_h
  cntinitfile = FreeFile
  Open ini_file_path For Input As cntinitfile
  Do While Not EOF(cntinitfile)
    Line Input #cntinitfile, interm
    interm = Trim(interm)
    If Left(interm, 1) <> ";" Then
      If read_ini_line(interm) = False Then
        'log error
      End If
    End If
  Loop
  Close #cntinitfile
  read_ini_file = True
Exit Function
err_h:
  If cntinitfile <> 0 Then Close #cntinitfile
  read_ini_file = False
End Function

Function read_ini_line(ini_line_str As String) As Boolean
Dim interarr As Variant
Dim keyword As String
Dim argum As String
 
  On Error GoTo err_h
  read_ini_line = True
  interarr = Split(ini_line_str, "=")
  keyword = Trim(CStr(interarr(0)))
  argum = Trim(CStr(interarr(1)))
  Select Case keyword
    Case "schedule"
      last_sched = last_sched + 1
      sched_table(last_sched).sc_event_name = argum
    Case "freq_weekday"
      Select Case UCase(argum)
        Case "MON"
          sched_table(last_sched).sc_f_weekday = 1
        Case "TUE"
          sched_table(last_sched).sc_f_weekday = 2
        Case "WEN"
          sched_table(last_sched).sc_f_weekday = 3
        Case "THU"
          sched_table(last_sched).sc_f_weekday = 4
        Case "FRI"
          sched_table(last_sched).sc_f_weekday = 5
        Case "SAT"
          sched_table(last_sched).sc_f_weekday = 6
        Case "SUN"
          sched_table(last_sched).sc_f_weekday = 0
      End Select
    Case "block"
      If argum = "0" Then
        sched_table(last_sched).sc_started = False
      Else
        sched_table(last_sched).sc_started = True
      End If
    Case "freq_minute"
      sched_table(last_sched).sc_f_minute = Val(argum)
    Case "freq_hour"
      sched_table(last_sched).sc_f_hour = Val(argum)
    Case "freq"
      Select Case argum
        Case "hourly"
          sched_table(last_sched).sc_freq = 1
        Case "daily"
          sched_table(last_sched).sc_freq = 2
        Case "weekly"
          sched_table(last_sched).sc_freq = 3
        Case "per month"
          sched_table(last_sched).sc_freq = 4
        Case "per year"
          sched_table(last_sched).sc_freq = 5
      End Select
    Case "freq_monthday"
      sched_table(last_sched).sc_f_monthday = Val(argum)
    Case "repeat"
      sched_table(last_sched).sc_repeat = Val(argum)
    Case Else
      read_ini_line = False
  End Select
Exit Function
err_h:
  read_ini_line = False
End Function

Function FileExists(path As String) As Boolean
  Dim dolz As Integer
  On Error Resume Next
  dolz = Len(Dir$(path))
  If Err Or dolz = 0 Then
    FileExists = False
  Else
    FileExists = True
  End If
End Function

Function get_minute_time() As Long
  get_minute_time = Now * 24 * 60
End Function

Function get_minute(moment As Double) As Long
Dim intertim As Variant
 
  intertim = Split(Format(CDate(moment), "hh:mm"), ":")
  get_minute = Val(intertim(1))
End Function

Function get_hour_count(moment As Double) As Long
  get_hour_count = moment * 24
End Function

Function get_day_count(moment As Double) As Long
  get_day_count = moment
End Function

Function get_week_count(moment As Double) As Long
  get_week_count = (moment - 36800) \ 7
End Function

Function get_month_count(moment As Double) As Long
  get_month_count = 12 * CInt(Format(CDate(moment), "yyyy")) + CInt(Format(CDate(moment), "MM"))
End Function

Function get_year_count(moment As Double) As Long
  get_year_count = CInt(Format(CDate(moment), "yyyy"))
End Function

Function get_day_in_week_count(moment As Double) As Long
  get_day_in_week_count = (moment - 36800) Mod 7
End Function

CareyJ,
I am going to evaluate HDE22..s reponce first.   I have enough ADO db connections and would like to make due without any more.   I apprecciate your time and effort though.



HDE226868,
I will try to proto-type your code today and will post any questions I may have.   At first glance I believe this is what I need.    Thanks for your efforts in advance.   Please stand by...... :)

There is some time difference between us, so I am still on line for 2 or 3 hours then off for 14 hours, I guess if there is anything You need.

HDE226868

No problem, it will give me more time to absorb your module.   Im in USA CT (est)   Where are you?  

Slovenia (CET). It is obvious that scheduler operates through larger timespan. So take the time to evaluate.

HDE226868,

Can you give me an example (Application side) that sets up  and strarts the control. I have the ini example, the ocx is compiled and added to my test application.




Sched1.ReadIni = ("C:\SchedulerControl\test.ini")

etc.......

HDE226868,
I have it up and running now.   Its exactly what I needed.  Many, Many thanks.   I have tried to Accept your answer, but the site keeps generating an internal errors.  You earned the points!!!!!  Ill keep trying.  

Thank you!
Brent