home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Unleashed / Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso / source / chap04 / 04vbu05 / schedule.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-07-24  |  4.5 KB  |  131 lines

  1. VERSION 4.00
  2. Begin VB.Form frmScheduler 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Scheduler"
  5.    ClientHeight    =   1380
  6.    ClientLeft      =   1965
  7.    ClientTop       =   1515
  8.    ClientWidth     =   5295
  9.    BeginProperty Font 
  10.       name            =   "Arial"
  11.       charset         =   1
  12.       weight          =   700
  13.       size            =   12
  14.       underline       =   0   'False
  15.       italic          =   0   'False
  16.       strikethrough   =   0   'False
  17.    EndProperty
  18.    Height          =   1785
  19.    Left            =   1905
  20.    LinkTopic       =   "Form1"
  21.    MaxButton       =   0   'False
  22.    ScaleHeight     =   1380
  23.    ScaleWidth      =   5295
  24.    Top             =   1170
  25.    Width           =   5415
  26.    Begin VB.CommandButton cbClose 
  27.       Cancel          =   -1  'True
  28.       Caption         =   "Close"
  29.       BeginProperty Font 
  30.          name            =   "MS Sans Serif"
  31.          charset         =   1
  32.          weight          =   400
  33.          size            =   8.25
  34.          underline       =   0   'False
  35.          italic          =   0   'False
  36.          strikethrough   =   0   'False
  37.       EndProperty
  38.       Height          =   495
  39.       Left            =   2130
  40.       TabIndex        =   0
  41.       Top             =   825
  42.       Width           =   1110
  43.    End
  44.    Begin VB.Timer timerScheduler 
  45.       Interval        =   1000
  46.       Left            =   4830
  47.       Top             =   45
  48.    End
  49. Attribute VB_Name = "frmScheduler"
  50. Attribute VB_Creatable = False
  51. Attribute VB_Exposed = False
  52. Option Explicit
  53. Const SCHEDULE_DATA_FILE = "schedule.dat"
  54. Private Type SCHEDULE_ITEM_TYPE         ' setup a structure to hold the schedule entries.
  55.     dteTime As Date
  56.     sCommand As String
  57. End Type
  58. Dim strItems() As SCHEDULE_ITEM_TYPE    ' items in the schedule
  59. Dim iCount As Integer
  60. Dim dteLastTimeRun As Date
  61. Private Sub cbClose_Click()
  62.     End     ' end this program
  63. End Sub
  64. Private Sub Form_Load()
  65.     If Not ReadScheduledItems() Then    ' fill the schedule array
  66.         End
  67.     End If
  68.     dteLastTimeRun = Time
  69.     timerScheduler.Enabled = True       ' start the timer
  70. End Sub
  71. Private Sub timerScheduler_Timer()
  72.     PrintTime               ' Print the current time on the window
  73.     IsThereAnythingToDo     ' Check the scheduled list
  74. End Sub
  75. Private Function ReadScheduledItems() As Integer
  76.     Dim sFileName As String
  77.     Dim iFile As Integer
  78.     On Error GoTo Error_ReadScheduledItems
  79.         ' Open the schedule file, assume that it is with the application
  80.     sFileName = App.Path & "\" & SCHEDULE_DATA_FILE
  81.     iFile = FreeFile
  82.     Open sFileName For Input As #iFile
  83.     iCount = 0
  84.     Do While Not EOF(iFile)
  85.         iCount = iCount + 1
  86.         
  87.             ' expand the structure to hold the additional item
  88.         ReDim Preserve strItems(iCount)
  89.             
  90.             ' read it into the structure
  91.         Input #iFile, strItems(iCount).dteTime, strItems(iCount).sCommand
  92.             
  93.     Loop
  94.     Close #iFile
  95.     ReadScheduledItems = True
  96.     Exit Function
  97. Error_ReadScheduledItems:
  98.     ReadScheduledItems = False
  99.     Exit Function
  100. End Function
  101. Private Sub IsThereAnythingToDo()
  102.     Dim i As Integer, iRet As Integer
  103.     Dim dteCurrentTime As Date
  104.     On Error Resume Next
  105.     dteCurrentTime = Time
  106.         ' run through the array of things to do
  107.     For i = 1 To iCount
  108.             ' If the scheduled start time is between the time of the last run
  109.             ' and the current time, then it is time to start the specified
  110.             ' program.
  111.         If strItems(i).dteTime > dteLastTimeRun And strItems(i).dteTime <= dteCurrentTime Then
  112.             iRet = Shell(strItems(i).sCommand, 1)   ' run the program
  113.             If Err <> 0 Then
  114.                 MsgBox "Error running: " & strItems(i).sCommand
  115.             End If
  116.         End If
  117.     Next
  118.     dteLastTimeRun = dteCurrentTime
  119. End Sub
  120. Private Sub PrintTime()
  121.     Dim sTime As String
  122.         ' only print the time if the the window is not minimized
  123.     If WindowState = 0 Then
  124.         Me.Cls
  125.         sTime = Format$(Time, "Long Time")                      ' format the time
  126.         Me.CurrentX = (Me.ScaleWidth - Me.TextWidth(sTime)) / 2    ' center the time
  127.         Me.CurrentY = Me.TextHeight(sTime) / 2
  128.         Me.Print sTime                                             ' and print it.
  129.     End If
  130. End Sub
  131.