home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form frmScheduler
- BorderStyle = 1 'Fixed Single
- Caption = "Scheduler"
- ClientHeight = 1380
- ClientLeft = 1965
- ClientTop = 1515
- ClientWidth = 5295
- BeginProperty Font
- name = "Arial"
- charset = 1
- weight = 700
- size = 12
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- Height = 1785
- Left = 1905
- LinkTopic = "Form1"
- MaxButton = 0 'False
- ScaleHeight = 1380
- ScaleWidth = 5295
- Top = 1170
- Width = 5415
- Begin VB.CommandButton cbClose
- Cancel = -1 'True
- Caption = "Close"
- BeginProperty Font
- name = "MS Sans Serif"
- charset = 1
- weight = 400
- size = 8.25
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- Height = 495
- Left = 2130
- TabIndex = 0
- Top = 825
- Width = 1110
- End
- Begin VB.Timer timerScheduler
- Interval = 1000
- Left = 4830
- Top = 45
- End
- Attribute VB_Name = "frmScheduler"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- Const SCHEDULE_DATA_FILE = "schedule.dat"
- Private Type SCHEDULE_ITEM_TYPE ' setup a structure to hold the schedule entries.
- dteTime As Date
- sCommand As String
- End Type
- Dim strItems() As SCHEDULE_ITEM_TYPE ' items in the schedule
- Dim iCount As Integer
- Dim dteLastTimeRun As Date
- Private Sub cbClose_Click()
- End ' end this program
- End Sub
- Private Sub Form_Load()
- If Not ReadScheduledItems() Then ' fill the schedule array
- End
- End If
- dteLastTimeRun = Time
- timerScheduler.Enabled = True ' start the timer
- End Sub
- Private Sub timerScheduler_Timer()
- PrintTime ' Print the current time on the window
- IsThereAnythingToDo ' Check the scheduled list
- End Sub
- Private Function ReadScheduledItems() As Integer
- Dim sFileName As String
- Dim iFile As Integer
- On Error GoTo Error_ReadScheduledItems
- ' Open the schedule file, assume that it is with the application
- sFileName = App.Path & "\" & SCHEDULE_DATA_FILE
- iFile = FreeFile
- Open sFileName For Input As #iFile
- iCount = 0
- Do While Not EOF(iFile)
- iCount = iCount + 1
-
- ' expand the structure to hold the additional item
- ReDim Preserve strItems(iCount)
-
- ' read it into the structure
- Input #iFile, strItems(iCount).dteTime, strItems(iCount).sCommand
-
- Loop
- Close #iFile
- ReadScheduledItems = True
- Exit Function
- Error_ReadScheduledItems:
- ReadScheduledItems = False
- Exit Function
- End Function
- Private Sub IsThereAnythingToDo()
- Dim i As Integer, iRet As Integer
- Dim dteCurrentTime As Date
- On Error Resume Next
- dteCurrentTime = Time
- ' run through the array of things to do
- For i = 1 To iCount
- ' If the scheduled start time is between the time of the last run
- ' and the current time, then it is time to start the specified
- ' program.
- If strItems(i).dteTime > dteLastTimeRun And strItems(i).dteTime <= dteCurrentTime Then
- iRet = Shell(strItems(i).sCommand, 1) ' run the program
- If Err <> 0 Then
- MsgBox "Error running: " & strItems(i).sCommand
- End If
- End If
- Next
- dteLastTimeRun = dteCurrentTime
- End Sub
- Private Sub PrintTime()
- Dim sTime As String
- ' only print the time if the the window is not minimized
- If WindowState = 0 Then
- Me.Cls
- sTime = Format$(Time, "Long Time") ' format the time
- Me.CurrentX = (Me.ScaleWidth - Me.TextWidth(sTime)) / 2 ' center the time
- Me.CurrentY = Me.TextHeight(sTime) / 2
- Me.Print sTime ' and print it.
- End If
- End Sub
-