Option Explicit

Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long

Private Sub Command1_Click()
    Create_Schedule
End Sub
Private Sub cmbTab7_Change(Index As Integer)
    Me.cmbTab7(Index).Locked = True
    Me.txtOver.SetFocus
End Sub
Private Sub cmbTab7_DropDown(Index As Integer)
    Me.cmbTab7(Index).Locked = False
End Sub

Private Sub cmbTab7_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    Me.cmbTab7(Index).Locked = True
    Me.txtOver.SetFocus
End Sub

Private Sub cmbTab7_KeyPress(Index As Integer, KeyAscii As Integer)

    Me.cmbTab7(Index).Locked = True
    Me.txtOver.SetFocus
End Sub

Private Sub cmbTab7_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)

    Me.cmbTab7(Index).Locked = True
    Me.txtOver.SetFocus
End Sub

Private Sub Command2_Click()
    Delete_Schedules
End Sub

Private Sub Form_Load()
    optTab7(1).Enabled = True
    optTab7(2).Enabled = True
    optTab7(3).Enabled = True
    dtpFreqTime.Enabled = True
    dtpDate.Enabled = True
    dtpDate.BackColor = &HFFFFFF
    cmbTab7(1).Enabled = True
    cmbTab7(1).BackColor = &HFFFFFF
    chkTab7(2).Enabled = True
    chkDay(0).Enabled = True
    chkDay(1).Enabled = True
    chkDay(2).Enabled = True
    chkDay(3).Enabled = True
    chkDay(4).Enabled = True
    chkDay(5).Enabled = True
    chkDay(6).Enabled = True
End Sub
Private Sub optTab7_Click(Index As Integer)
'/* time format options
Dim i As Integer
Dim mCnt As Integer
Dim Lastofmonth
    Hide_Controls Index
    Select Case Index
    
    'daily
    Case 1
        With dtpFreqTime
            .Width = 1200
            .Format = dtpCustom
            .UpDown = True
            .CustomFormat = "hh:mm tt"
        End With
        
    'weekly
    Case 2
        With dtpFreqTime
            .Width = 1200
            .Format = dtpCustom
            .UpDown = True
            .CustomFormat = "hh:mm tt"
        End With
        
    'monthly
    Case 3
        With dtpFreqTime
            .Width = 1200
            .Format = dtpCustom
            .UpDown = True
            .CustomFormat = "hh:mm tt"
        End With
        Lastofmonth = DateAdd("m", 1, Date - Day(Date))
        mCnt = Format$(Lastofmonth, "d")
        dtpDate.Clear
        For i = 1 To mCnt
            dtpDate.AddItem i
        Next i
        dtpDate = "1"
    End Select

End Sub
Private Sub Hide_Controls(ByVal iIndex As Integer)
'/* controls arrangement

Dim mPic As PictureBox

    For Each mPic In picType
        mPic.Visible = False
        mPic.BorderStyle = 0
    Next mPic
    cmbTab7(1).Visible = False
    chkTab7(2).Visible = False
    chkDay(0).Visible = False
    chkDay(1).Visible = False
    chkDay(2).Visible = False
    chkDay(3).Visible = False
    chkDay(4).Visible = False
    chkDay(5).Visible = False
    chkDay(6).Visible = False
    dtpDate.Visible = False
    dtpFreqTime.Visible = False
    
    Select Case iIndex

    'daily
    Case 1
        picType(0).Left = 1200
        picType(0).Visible = True
        cmbTab7(1).Visible = True
        chkTab7(2).Visible = True
        cmbTab7(1).Left = 1240
        chkTab7(2).Left = 1240
        dtpFreqTime.ToolTipText = "Start Task at this Time"
  
    'weekly
    Case 2
        picType(0).Left = 2640
        picType(0).Visible = True
        picType(1).Visible = True
        cmbTab7(1).Visible = True
        chkTab7(2).Visible = True
        chkDay(0).Visible = True
        chkDay(1).Visible = True
        chkDay(2).Visible = True
        chkDay(3).Visible = True
        chkDay(4).Visible = True
        chkDay(5).Visible = True
        chkDay(6).Visible = True
        cmbTab7(1).Left = 2680
        chkTab7(2).Left = 2680
        dtpFreqTime.ToolTipText = "Start Task at this Time"
        
    'monthly
    Case 3
        picType(0).Left = 2640
        picType(0).Visible = True
        picType(2).Left = 1200
        picType(2).Visible = True
        cmbTab7(1).Visible = True
        chkTab7(2).Visible = True
        dtpDate.Visible = True
        cmbTab7(1).Left = 2680
        chkTab7(2).Left = 2680
        dtpDate.ToolTipText = "Start Task on this Date"
        dtpFreqTime.ToolTipText = "Start Task at this Time"
        
    End Select

End Sub

Private Sub Create_Schedule()

    'LOCAL DECLARATIONS
    Dim sTimeStr As Long, sTime As String
    Dim iZone As Integer, sZone As String
    Dim sCount As Integer, cDay As CheckBox
    
    Dim errJobCreated As Long
    Dim JobID As Long, strComputer As String
    Dim objService As Object, objNewJob As Object
    
    Dim sUid As String, sDte As String, sTme As String
    
    Dim MonID As Integer
    Dim TueID As Integer
    Dim WedID As Integer
    Dim ThurID As Integer
    Dim FriID As Integer
    Dim SatID As Integer
    Dim SunID As Integer

On Error GoTo err:
    sDte = Day(Date) & Month(Date) & Year(Date)
    sTme = Hour(Time) & Minute(Time) & Second(Time)
    sUid = sDte & sTme
    
    sZone = Replace(cmbTab7(1).Text, "GMT-", "")
    iZone = sZone * 60
    If chkTab7(2).Value = vbChecked Then
        iZone = iZone + 60
    End If
    iZone = iZone - 60
    sZone = Replace(iZone, "-", "")
    
        Select Case True

        'daily
        Case optTab7(1).Value
            
            Enabled = False                               'DISABLE FORM WHILE UPDATE
            
            sTime = Replace(Format$(dtpFreqTime.Value, "hh:mm"), ":", "") & "00"
            strComputer = "."                                       'LOCAL COMPUTER
            Set objService = GetObject("winmgmts:\\" & strComputer) 'CREATE OBJECT
            Set objNewJob = objService.Get("Win32_ScheduledJob")
            
        
            errJobCreated = objNewJob.Create _
                (GetShortPath(App.Path) & "\Scheduler.exe " & sUid, "********" & sTime & ".000000-" & sZone, _
                True, 1 Or 2 Or 4 Or 8 Or 16 Or 32 Or 64, , , JobID)
                
                Text1 = JobID
                
            Set objNewJob = Nothing
            Set objService = Nothing
            
            Enabled = True
            
        'weekly
        Case optTab7(2).Value
        
            Enabled = False
            sTime = Replace(Format$(dtpFreqTime.Value, "hh:mm"), ":", "") & "00"
            strComputer = "."                                       'LOCAL COMPUTER
            Set objService = GetObject("winmgmts:\\" & strComputer) 'CREATE OBJECT
            Set objNewJob = objService.Get("Win32_ScheduledJob")
            
            For Each cDay In chkDay
                If cDay.Value = 1 Then
                    sTimeStr = sTimeStr & cDay.Caption & " Or "
                    Select Case cDay.Caption
                        Case "Monday"
                            errJobCreated = objNewJob.Create _
                                (GetShortPath(App.Path) & "\Scheduler.exe " & sUid, "********" & sTime & ".000000-" & sZone, _
                                True, 1, , , MonID)
                        Case "Tuesday"
                            errJobCreated = objNewJob.Create _
                                (GetShortPath(App.Path) & "\Scheduler.exe " & sUid, "********" & sTime & ".000000-" & sZone, _
                                True, 2, , , TueID)
                        Case "Wednesday"
                            errJobCreated = objNewJob.Create _
                                (GetShortPath(App.Path) & "\Scheduler.exe " & sUid, "********" & sTime & ".000000-" & sZone, _
                                True, 4, , , WedID)
                        Case "Thursday"
                            errJobCreated = objNewJob.Create _
                                (GetShortPath(App.Path) & "\Scheduler.exe " & sUid, "********" & sTime & ".000000-" & sZone, _
                                True, 8, , , ThurID)
                        Case "Friday"
                            errJobCreated = objNewJob.Create _
                                (GetShortPath(App.Path) & "\Scheduler.exe " & sUid, "********" & sTime & ".000000-" & sZone, _
                                True, 16, , , FriID)
                        Case "Saturday"
                            errJobCreated = objNewJob.Create _
                                (GetShortPath(App.Path) & "\Scheduler.exe " & sUid, "********" & sTime & ".000000-" & sZone, _
                                True, 32, , , SatID)
                        Case "Sunday"
                            errJobCreated = objNewJob.Create _
                                (GetShortPath(App.Path) & "\Scheduler.exe " & sUid, "********" & sTime & ".000000-" & sZone, _
                                True, 64, , , SunID)
                    End Select
                End If
            Next cDay
            
            Set objNewJob = Nothing
            Set objService = Nothing
            
            Enabled = True
            
        '/*monthly
        Case optTab7(3).Value
                     
            sTimeStr = dtpDate
            Select Case sTimeStr
            Case 1
                sTimeStr = 1
            Case 2
                sTimeStr = 2
            Case 3
                sTimeStr = 4
            Case 4
                sTimeStr = 8
            Case 5
                sTimeStr = 16
            Case 6
                sTimeStr = 32
            Case 7
                sTimeStr = 64
            Case 8
                sTimeStr = 128
            Case 9
                sTimeStr = 256
            Case 10
                sTimeStr = 512
            Case 11
                sTimeStr = 1024
            Case 12
                sTimeStr = 2048
            Case 13
                sTimeStr = 4096
            Case 14
                sTimeStr = 8192
            Case 15
                sTimeStr = 16384
            Case 16
                sTimeStr = 32768
            Case 17
                sTimeStr = 65536
            Case 18
                sTimeStr = 131072
            Case 19
                sTimeStr = 262144
            Case 20
                sTimeStr = 524288
            Case 21
                sTimeStr = 1048576
            Case 22
                sTimeStr = 2097152
            Case 23
                sTimeStr = 4194304
            Case 24
                sTimeStr = 8388608
            Case 25
                sTimeStr = 16777216
            Case 26
                sTimeStr = 33554432
            Case 27
                sTimeStr = 67108864
            Case 28
                sTimeStr = 134217728
            Case 29
                sTimeStr = 268435456
            Case 30
                sTimeStr = 536870912
            Case 31
                sTimeStr = 1073741824
            End Select
            
            Enabled = False
            sTime = Replace(Format$(dtpFreqTime.Value, "hh:mm"), ":", "") & "00"
            strComputer = "."                                       'LOCAL COMPUTER
            Set objService = GetObject("winmgmts:\\" & strComputer) 'CREATE OBJECT
            Set objNewJob = objService.Get("Win32_ScheduledJob")
            
            'RECURRING
            errJobCreated = objNewJob.Create _
                (GetShortPath(App.Path) & "\Scheduler.exe " & sUid, "********" & sTime & ".000000-" & sZone, _
                True, , sTimeStr, , JobID)
            
            Set objNewJob = Nothing
            Set objService = Nothing
            
            Enabled = True
            
        End Select

        Exit Sub
'ERROR HANDLING
err:
    MsgBox "Error"
        Exit Sub
End Sub

'CONVERT WINDOWS PATH TO DOS SHORT PATHS
Private Function GetShortPath(longPath As String) As String
    Dim chars As Long
    Dim shortPath As String
    shortPath = String$(Len(longPath), 0)
    chars = GetShortPathName(longPath, shortPath, Len(shortPath))
    GetShortPath = Left$(shortPath, chars)
End Function

'/* DELETE SITES DATA
Public Sub Delete_Schedules()
    'LOCAL DECLARATIONS
    Dim SchedulesID   As Integer
    Dim strComputer
    Dim objService
    Dim objInstance
On Error GoTo err:                                  'DELETE DATABASE ERROR
    'START SUB
    Enabled = False                                 'DISABLE FORM WHILE UPDATE
    If IsNumeric(Text1) Then
        SchedulesID = Text1
    Else
        GoTo err:
    End If
    
    'DELETE WINDOWS TASK SCHEDULE
    strComputer = "."
    Set objService = GetObject("winmgmts:\\" & strComputer)
    'GENERAL
    If SchedulesID > 0 Then
        Set objInstance = objService.Get("Win32_ScheduledJob.JobID=" & SchedulesID)
        objInstance.Delete
    End If
    
    Enabled = True                                'RE-ENABLE FORM
        Exit Sub
'ERROR HANDLING
err:
    MsgBox "Invalid ID"
    Enabled = True                                'RE-ENABLE FORM
        Exit Sub
End Sub