Imports System.Threading
Imports System.Timers
' Example creation of this singleton class:
' Dim MyScheduler As Scheduler = Scheduler.GetScheduler
Public NotInheritable Class Scheduler
Inherits System.Timers.Timer
Private Class Job
' Class for adding items to the schedule
Public Sub New(period As TimeSpan, contextKey As UInteger)
If period > TimeSpan.Zero Then
JobKey = contextKey
Start = Now
Finish = Start + period
Else
Throw New ArgumentOutOfRangeException
End If
End Sub
Public Period As TimeSpan
Public Start As DateTime
Public Finish As DateTime
Public JobKey As UInteger
Public ThreadId As Integer
End Class
' Dictionary to hold the scheduled jobs
Private Shared _schedule As New Dictionary(Of UInteger, Job)
' List to hold references to the working threads
Private Shared _threads As New List(Of Threading.Thread)
' The reference to the single scheduler instance
Private Shared _singleInstance As Scheduler
' SyncLock objects
Private Shared _scheduleLock As New Object
Private Shared _threadsLock As New Object
Private Shared _instanceLock As New Object
Private Sub New()
' Setup and start the timer with an interval of 3 seconds
MyBase.New()
AddHandler MyBase.Elapsed, AddressOf Scheduler_Elapsed
MyBase.Interval = 3000
MyBase.Enabled = True
MyBase.Start()
End Sub
Public Sub AddJob(period As TimeSpan, contextKey As UInteger)
SyncLock (_scheduleLock)
Dim count As UInteger = _schedule.Count
If Not count = 0 Then
' Adjust for zero-base
count -= 1
' Create copy of keys
Dim keys(count) As UInteger
_schedule.Keys.CopyTo(keys, 0)
' Step through jobKeys on schedule
For index As Integer = count To 0
If _schedule.Item(keys(index)).JobKey = contextKey Then
' Remove any obsolete jobs
_schedule.Remove(keys(index))
End If
Next
End If
' Add new job
_schedule.Add(_schedule.Count, New Job(period, contextKey))
End SyncLock
End Sub
Private Sub Scheduler_Elapsed(source As Object, e As ElapsedEventArgs) Handles MyBase.Elapsed
Dim check As DateTime = Now
Dim count As UInteger = _schedule.Count
If count > 0 Then
SyncLock (_scheduleLock)
' Adjust for zero-base
count -= 1
Dim keys(count) As UInteger
' Copy all the keys from the shcdule to an array
' as the keys may not be in order and For...Each
' cannot be used when removing items
_schedule.Keys.CopyTo(keys, 0)
' Step through each of the keys in the keys array
For index As Integer = count To 0 '<----- EXECUTION SKIPS FROM HERE TO END SYNCLOCK
' Check if any of the jobs on the schedule are due
If DateTime.Compare(check, _schedule.Item(keys(index)).Finish) > 0 Then
' Create and start a new thread
Dim jobThread As New Thread(AddressOf DoJob)
' Save the thread ID to the job object - this allows the job to know which thread is handling it
_schedule.Item(keys(index)).ThreadId = jobThread.ManagedThreadId
' Add the new thread to the list of threads - to keep track of all the threads
SyncLock (_threadsLock)
_threads.Add(jobThread)
End SyncLock
' Start the work thread, passing the job object - so that it knows which DUT context to use
jobThread.Start(_schedule.Item(keys(index)))
' Remove the job from the schedule - to prevent the job from being started on subsequent elapsed events
_schedule.Remove(keys(index))
End If
Next
End SyncLock
End If
End Sub
Private Sub DoJob(ByVal job As Object)
' Use the JobKey to get the context object for the relevant DUT
Dim dutContext As New DeviceUnderTest
dutContext = Form1.currentDuts.Item(job.JobKey)
' Get and run the next step in the program
' NextProgramStep() just shows a message box at the moment
dutContext.NextProgramStep()
' After work, remove thread from list of threads
SyncLock (_threadsLock)
Dim count As UInteger = _threads.Count
If count > 0 Then
' Step through job threadIds of current threads
For index As UInteger = count - 1 To 0
' Check if any threads have the same id as the current job
If _threads(index).ManagedThreadId = job.ThreadId Then
' Remove any thread working on this job
_threads.Remove(_threads.Item(index))
End If
Next
End If
End SyncLock
End Sub
Public Shared ReadOnly Property GetScheduler As Scheduler
' Ensures only one instance of the scheduler is created
Get
If _singleInstance Is Nothing Then
SyncLock (_instanceLock)
If _singleInstance Is Nothing Then
_singleInstance = New Scheduler
End If
End SyncLock
End If
Return _singleInstance
End Get
End Property
Overloads ReadOnly Property Interval As Double
' Reads the timer interval property (set in Scheduler.New())
Get
Return MyBase.Interval
End Get
End Property
End Class