Projects

Find all our projects in development below.
All source code is GNU General Public License (GPL)

javaCron

Browsing svcMain.vb (17.26 KB)

Option Explicit On

Imports System.IO
Imports System.ServiceProcess
Imports System.Threading

Public Class svcMain

#Region "clsCronJob"

    ' cron job object
    Public Class clsCronJob

        Public Class clsCronCriteria
            Public cronData As String = ""
            Public cronValue As Integer = 0
            Public cronLast As String = ""
        End Class

        Public cronJob As String = ""
        Public cronShow As AppLauncher.SHOWWINDOW_STYLES
        Public cronCriteria(CRITERIA_COUNT - 1) As clsCronCriteria

        Private sFindText As String = ""
        Private m_DayList() As String = {"sun", "mon", "tue", "wed", "thu", "fri", "sat"}
        Private m_MonthList() As String = {"jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec"}

        Public Function ProcessCronJob(ByVal thisDate As Date) As Boolean

            Dim sData() As String
            Dim sCriteria As String = ""
            Dim sConstraint As String = ""
            Dim bSkip As Boolean = False
            Dim bProcess As Boolean = True

            ' process each of the cron job's criteria
            For i As Integer = 0 To Me.cronCriteria.GetUpperBound(0)

                With Me.cronCriteria(i)

                    sConstraint = GetCurrentConstraint(i, thisDate)

                    If .cronData.IndexOf("/") > 0 AndAlso _
                        .cronLast <> sConstraint Then

                        sData = .cronData.Split("/")
                        sCriteria = sData(0)
                        .cronValue += 1
                        .cronLast = sConstraint

                        If .cronValue < Val(sData(1)) Then
                            bSkip = True
                        Else
                            .cronValue = 0
                        End If

                    Else
                        sCriteria = .cronData
                    End If

                    If Not bSkip And sCriteria <> "" Then
                        bProcess = bProcess And ProcessCriteria(sCriteria, sConstraint)
                    Else
                        bProcess = False
                        Exit For
                    End If

                End With

            Next i

            Return bProcess

        End Function

        Private Function ProcessCriteria(ByVal sCriteria As String, ByVal sCompare As String) As Boolean

            Dim sData() As String = sCriteria.Split(",")

            ' determine if the criteria is equal to the compare
            If sCriteria.IndexOf("-") > 0 Then

                If Val(sCompare) >= Val(EvalCriteria(sData(0))) And _
                    Val(sCompare) <= Val(EvalCriteria(sData(1))) Then _
                        Return True

            ElseIf sCriteria.IndexOf(",") > 0 Then

                For i As Integer = 0 To sData.GetUpperBound(0)
                    If Val(sCompare) = Val(EvalCriteria(sData(i))) Then _
                        Return True
                Next i

            Else
                If sCriteria = "*" Or Val(sCompare) = Val(EvalCriteria(sCriteria)) Then _
                    Return True
            End If

            Return False

        End Function

        Private Function EvalCriteria(ByVal sCriteria As String) As String

            Dim iIndex As Integer = 0

            If sCriteria.Length > 3 Then sCriteria = sCriteria.Substring(0, 3)
            sFindText = sCriteria.ToLower

            iIndex = Array.FindIndex(m_DayList, AddressOf SearchArray)
            If iIndex > 0 Then Return (iIndex - 1).ToString

            iIndex = Array.FindIndex(m_MonthList, AddressOf SearchArray)
            If iIndex > 0 Then
                Return iIndex.ToString
            Else
                Return sCriteria
            End If

        End Function

        Private Function SearchArray(ByVal strText As String) As Boolean

            If strText = sFindText Then
                Return True
            Else
                Return False
            End If

        End Function

    End Class

#End Region

#Region "AppLauncher"

    ' child class used to launch new application
    Public Class AppLauncher

        Private Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hWnd As Integer, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Integer) As Integer

        Public Enum SHOWWINDOW_STYLES
            SW_SHOWHIDDEN = 0
            SW_SHOWNORMAL = 1
            SW_SHOWMINIMIZED = 2
            SW_SHOWMAXIMIZED = 3
        End Enum

        Private appPath As String = ""
        Private appArgs As String = ""
        Private appShow As Integer = 0

        Public Sub New(ByVal sPath As String, ByVal sArgs As String, ByVal iShow As SHOWWINDOW_STYLES)
            appPath = sPath
            appArgs = sArgs
            appShow = iShow
        End Sub

        Public Sub runApp()

            ' use ShellExecute api to run app
            ShellExecute(0&, vbNullString, appPath, appArgs, Me.getPath(), appShow)

        End Sub

        Private Function getPath() As String
            If appPath.IndexOf("\") >= 0 Then
                Return appPath.Substring(0, appPath.LastIndexOf("\"))
            Else
                Return appPath
            End If
        End Function

    End Class

#End Region

#Region "svcMain Declarations"

    ' class-level variables
    Private m_RunDate As Date = Now()
    Private m_cronJobs As New Collection
    Private m_iHourRunCount As Integer = 0
    Private m_iHourFailCount As Integer = 0
    Private m_iHourReportCount As Integer = 0
    Private sFindText As String = ""

    ' log level constants
    Private Enum LOGLEVEL_CONSTS
        LOGLEVEL_NONE = 0
        LOGLEVEL_SOME = 1
        LOGLEVEL_ALL = 99
    End Enum

    Private m_iLogLevel As LOGLEVEL_CONSTS = LOGLEVEL_CONSTS.LOGLEVEL_SOME

    ' class-level constants
    Private Const LOGALL_ARG = "/logall"
    Private Const LOGNONE_ARG = "/lognone"
    Private Const DEFAULT_LOGFILE = "crontab.txt"
    Private Const TIMER_INTERVAL = 60000
    Public Const CRITERIA_COUNT = 5

#End Region

#Region "svcMain Public"

    Public Shared Function GetCurrentConstraint(ByVal iLevel As Integer, ByVal objDate As Date) As String

        ' get the current level of constraint based on the Date object
        Select Case iLevel
            Case 0
                Return objDate.Minute.ToString
            Case 1
                Return objDate.Hour.ToString
            Case 2
                Return objDate.Day.ToString
            Case 3
                Return objDate.Month.ToString
            Case 4
                Return objDate.DayOfWeek
            Case Else
                Return ""
        End Select

    End Function

#End Region

#Region "svcMain Private"

    Private Function LoadCronJobs(ByVal strCronFile As String, Optional ByRef strErrOut As String = "") As Boolean

        ' load cronjobs from text file, catch any errors
        Try

            ' open the text file
            Dim objFS As New FileStream(strCronFile, FileMode.Open, FileAccess.Read)
            Dim objSR As New StreamReader(objFS)
            Dim sLine As String = ""
            Dim sLineArray() As String
            Dim i As Integer = 0

            ' seek to the beginning
            objSR.BaseStream.Seek(0, SeekOrigin.Begin)
            While objSR.Peek() > -1

                sLine = objSR.ReadLine().Trim
                If sLine.Length > 0 AndAlso _
                    (Not sLine.StartsWith("#") And sLine.IndexOf(" ") > 0) Then

                    ' check for a line-feed character
                    If sLine.IndexOf(Strings.Chr(10)) > 0 Then

                        sLineArray = sLine.Split(Strings.Chr(10))
                        For i = 0 To sLineArray.GetUpperBound(0)
                            If sLineArray(i).Length > 0 AndAlso _
                                (Not sLineArray(i).StartsWith("#") And _
                                sLineArray(i).IndexOf(" ") > 0) Then _
                                    LoadCrobJob(sLineArray(i))
                        Next i

                    ElseIf sLine.IndexOf(" ") > 0 Then
                        LoadCrobJob(sLine)
                    End If

                End If

            End While
            objSR.Close()
            objFS.Close()

            Return True

        Catch ex As Exception
            strErrOut = ex.Message
            Return False
        End Try

    End Function

    Private Sub LoadCrobJob(ByVal thisLine As String)

        Dim x As Integer = 0
        Dim xOffset As Integer = 0
        Dim sData() As String = thisLine.Split(" ")

        ' instantiate a new cron job class
        Dim newCron As New clsCronJob

        ' configure the cronjob
        With newCron

            For x = 0 To CRITERIA_COUNT - 1
                .cronCriteria(x) = New clsCronJob.clsCronCriteria
                .cronCriteria(x).cronData = InitCriteria(sData(x), x).Trim
                .cronCriteria(x).cronValue = 0
                .cronCriteria(x).cronLast = GetCurrentConstraint(x, m_RunDate)
            Next x

            If sData(CRITERIA_COUNT).ToLower.StartsWith("s:") And _
                sData(CRITERIA_COUNT).Length > 2 Then

                xOffset = CRITERIA_COUNT + 1
                .cronShow = Val(sData(CRITERIA_COUNT).Substring(2))

                If .cronShow < AppLauncher.SHOWWINDOW_STYLES.SW_SHOWHIDDEN Or _
                    .cronShow > AppLauncher.SHOWWINDOW_STYLES.SW_SHOWMAXIMIZED Then _
                    .cronShow = AppLauncher.SHOWWINDOW_STYLES.SW_SHOWNORMAL

            Else
                .cronShow = AppLauncher.SHOWWINDOW_STYLES.SW_SHOWNORMAL
                xOffset = CRITERIA_COUNT
            End If

            For x = xOffset To sData.GetUpperBound(0)
                .cronJob = .cronJob + sData(x) + " "
            Next x

            .cronJob = .cronJob.TrimEnd

        End With

        ' add the cron job to the collection
        m_cronJobs.Add(newCron)

    End Sub

    Private Function InitCriteria(ByVal sCriteria As String, ByVal iLevel As Integer) As String

        Return sCriteria.Replace("?", GetCurrentConstraint(iLevel, m_RunDate))

    End Function

    Private Function SearchArray(ByVal strText As String) As Boolean

        If strText = sFindText Then
            Return True
        Else
            Return False
        End If

    End Function

#End Region

#Region "svcMain Protected"

    Protected Overrides Sub OnStart(ByVal args() As String)

        Dim strCronFile As String = System.AppDomain.CurrentDomain.BaseDirectory() + DEFAULT_LOGFILE
        Dim strErrOut As String = ""

        ' get a handle to this service process
        Dim srvcController As New ServiceController(ServiceName)

        Try

            ' check the command line
            If args.GetUpperBound(0) >= 0 Then

                sFindText = LOGNONE_ARG
                m_iLogLevel = IIf(Array.Exists(args, AddressOf SearchArray), _
                    LOGLEVEL_CONSTS.LOGLEVEL_NONE, _
                    m_iLogLevel)

                sFindText = LOGALL_ARG
                m_iLogLevel = IIf(Array.Exists(args, AddressOf SearchArray), _
                    LOGLEVEL_CONSTS.LOGLEVEL_ALL, _
                    m_iLogLevel)

                If args(0) <> LOGNONE_ARG And args(0) <> LOGALL_ARG Then
                    If System.IO.File.Exists(args(0)) Then
                        strCronFile = args(0)
                    Else
                        EventLog.WriteEntry(ServiceName, "Error: File not found: """ + args(0) + """" + _
                            vbCrLf + vbCrLf + "Defaulting to file: """ + strCronFile + """", _
                            EventLogEntryType.Error)
                    End If
                End If

            End If

            ' load the cron jobs from the text file
            If LoadCronJobs(strCronFile, strErrOut) Then

                EventLog.WriteEntry(ServiceName, "Starting up (using """ + strCronFile + _
                    """; loaded " + m_cronJobs.Count.ToString + " job(s) )", _
                    EventLogEntryType.Information)

                ' start the main loop
                timerMain.Start()

                If m_iLogLevel > LOGLEVEL_CONSTS.LOGLEVEL_NONE Then _
                    timerReport.Start()

            Else
                Throw New Exception(strErrOut)
            End If

        Catch ex As Exception
            EventLog.WriteEntry(ServiceName, "Problem occurred while loading cron jobs." + _
                vbCrLf + vbCrLf + "Error: " + ex.Message, _
                EventLogEntryType.Error)
            srvcController.Stop()
        End Try

    End Sub

    Protected Overrides Sub OnStop()

        ' service is stopping, stop our timers
        timerReport.Stop()
        timerMain.Stop()

    End Sub

#End Region

#Region "svcMain Timer Handlers"

    Private Sub timerMain_Elapsed(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles timerMain.Elapsed

        Dim i As Integer = 0
        Dim x As Integer = 0
        Dim sJob As String = ""
        Dim sArgs As String = ""
        Dim sData() As String
        Dim thisDate As Date = Now()

        If timerMain.Interval < TIMER_INTERVAL Then timerMain.Interval = TIMER_INTERVAL

        ' enumerate the cron jobs and process each one
        For Each thisCron As clsCronJob In m_cronJobs

            i += 1

            ' process the cron job to determine if it's ready
            If thisCron.ProcessCronJob(thisDate) Then

                sJob = thisCron.cronJob
                sArgs = ""
                If sJob.IndexOf("""") >= 0 AndAlso _
                    (sJob.IndexOf("""") <> sJob.LastIndexOf("""")) Then
                    sArgs = sJob.Substring(sJob.IndexOf("""", sJob.IndexOf("""") + 1) + 1)
                    sJob = sJob.Substring(1, sJob.IndexOf("""", sJob.IndexOf("""") + 1) - 1)
                ElseIf sJob.IndexOf(" ") > 0 Then
                    sData = sJob.Split(" ")
                    sJob = sData(0)
                    For x = 1 To sData.GetUpperBound(0)
                        sArgs = sArgs + sData(x) + " "
                    Next x
                    sArgs = sArgs.TrimEnd
                End If

                Try

                    ' declare a new applauncher class
                    ' and launch the app in a new thread
                    Dim appLauncher As New AppLauncher(sJob, sArgs, thisCron.cronShow)
                    With New Thread(AddressOf appLauncher.runApp)
                        .Start()
                    End With
                    appLauncher = Nothing

                    If m_iLogLevel >= LOGLEVEL_CONSTS.LOGLEVEL_ALL Then _
                        EventLog.WriteEntry(ServiceName, "Executed Job #" + i.ToString + _
                            vbCrLf + vbCrLf + "Details:" + vbCrLf + vbCrLf + _
                            "Minute: " + thisCron.cronCriteria(0).cronData + _
                            " (" + GetCurrentConstraint(0, thisDate) + ")" + vbCrLf + _
                            "Hour: " + thisCron.cronCriteria(1).cronData + _
                            " (" + GetCurrentConstraint(1, thisDate) + ")" + vbCrLf + _
                            "Day: " + thisCron.cronCriteria(2).cronData + _
                            " (" + GetCurrentConstraint(2, thisDate) + ")" + vbCrLf + _
                            "Month: " + thisCron.cronCriteria(3).cronData + _
                             " (" + GetCurrentConstraint(3, thisDate) + ")" + vbCrLf + _
                           "DayOfWeek: " + thisCron.cronCriteria(4).cronData + _
                            " (" + GetCurrentConstraint(4, thisDate) + ")" + vbCrLf + _
                            "Job: " + sJob, _
                            EventLogEntryType.Information)

                    If m_iLogLevel >= LOGLEVEL_CONSTS.LOGLEVEL_SOME Then _
                        m_iHourRunCount += 1

                Catch ex As Exception

                    If m_iLogLevel >= LOGLEVEL_CONSTS.LOGLEVEL_ALL Then _
                        EventLog.WriteEntry(ServiceName, "Could not execute file (" + sJob + ")" + _
                            vbCrLf + vbCrLf + "Error: " + ex.Message, _
                            EventLogEntryType.Error)

                    If m_iLogLevel >= LOGLEVEL_CONSTS.LOGLEVEL_SOME Then _
                        m_iHourFailCount += 1

                End Try

            End If

        Next

    End Sub

    Private Sub timerReport_Elapsed(ByVal sender As System.Object, ByVal e As System.Timers.ElapsedEventArgs) Handles timerReport.Elapsed

        ' process the hourly report
        m_iHourReportCount += 1

        EventLog.WriteEntry(ServiceName, "Hourly Report (#" + m_iHourReportCount.ToString + ") :" + vbCrLf + vbCrLf + _
            "Total Jobs Executed: " + m_iHourRunCount.ToString + vbCrLf + _
            "Total Jobs Failed: " + m_iHourFailCount.ToString, _
            EventLogEntryType.Information)

        m_iHourRunCount = 0
        m_iHourFailCount = 0

    End Sub

#End Region

End Class

Download svcMain.vb

Back to file list


Back to project page