Declare Function NetScheduleJobAdd Lib "netapi32.dll" _
(ByVal servername As String, Buffer As Any, _
Jobid As Long) As Long
NetScheduleJobAdd добавляет задачу, которая должна быть выполнена в заданные дату и время. Это функция требует наличия службы Планировщик задач на компьютере, на которой добавляется новая задача. Для установки задачи на удаленном компьютере нужно обладать правами администратора.
В успешном случае функция возвращает NERR_Success. В случае ошибки функция возвращает коды ошибок
Private Declare Function GetComputerName Lib "kernel32.dll" _
Alias "GetComputerNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function NetScheduleJobAdd Lib "netapi32.dll" _
(ByVal servername As String, Buffer As Any, _
Jobid As Long) As Long
Private Declare Function NetScheduleJobDel Lib "netapi32.dll" _
(ByVal servername As String, ByVal MinJobId As Long, _
ByVal MaxJobId As Long) As Long
Private Type AT_INFO
JobTime As Long
DaysOfMonth As Long
DaysOfWeek As Byte
Flags As Byte
dummy As Integer
Command As String
End Type
'Schedule constants
'If you set this flag, the job runs, and
'continues to run, on each day for which a
'corresponding bit is set in the DaysOfMonth
'or DaysOfWeek member. The job is not deleted
'after it executes.
'If this flag is clear, the job runs only once
'for each bit set in these members. The job is
'deleted after it executes once.
Const JOB_RUN_PERIODICALLY = &H1
'If you set this flag, the job executes at the
'first occurrence of JobTime at the computer
'where the job is queued.
'Setting this flag is equivalent to setting
'the bit for the current day in the DaysOfMonth
'member.
Const JOB_ADD_CURRENT_DATE = &H8
'If you set this flag, the job does not run interactively.
'If this flag is clear, the job runs interactively.
Const JOB_NONINTERACTIVE = &H10
Const NERR_Success = 0
Public Enum enWeekDays
enMonday = 1
enTuesday = 2
enWednesday = 4
enThursday = 8
enFriday = 16
enSaturday = 32
enSunday = 64
End Enum
Public Function AddScheduleTask(strTime As String, strCommand As String, _
Optional enDaysInWeek As enWeekDays = -1, _
Optional strDaysInMonth As String = "", _
Optional RunInteractive As Boolean = True, _
Optional ReOccuring As Boolean = True) As Long
On Error GoTo Hell
'Default return value (failure)
AddScheduleTask = -1
'Convert the computer name to unicode
Dim strComputerName As String
strComputerName = StrConv(GetCompName, vbUnicode)
'Setup Task Structure
Dim udtAtInfo As AT_INFO
With udtAtInfo
.JobTime = (Hour(CDate(strTime)) * 3600 + Minute(CDate(strTime)) * 60) * 1000
'Set the task period
If enDaysInWeek > -1 Then
'Get the days of the week from the constants
.DaysOfWeek = enDaysInWeek
ElseIf Len(strDaysInMonth) > 0 Then
'Loop through all days of the month passed
' and set the bits
Dim i As Long
Dim strDates() As String
strDates = Split(strDaysInMonth, ",")
For i = 0 To UBound(strDates)
.DaysOfMonth = .DaysOfMonth + 2 ^ (strDates(i) - 1)
Next
End If
'Set Flags
If ReOccuring Then
.Flags = JOB_RUN_PERIODICALLY
End If
If Not RunInteractive Then
.Flags = .Flags Or JOB_NONINTERACTIVE
End If
'Set the command to run
.Command = StrConv(strCommand, vbUnicode)
End With
'Schedule
Dim lngJobID As Long
Dim retVal As Long
retVal = NetScheduleJobAdd(strComputerName, udtAtInfo, lngJobID)
'Check for success
If retVal = NERR_Success Then AddScheduleTask = lngJobID
Exit_For:
On Error GoTo 0
Exit Function
Hell:
GoTo Exit_For
End Function
Public Function DeleteScheduleTask(lngID As Long) As Boolean
On Error GoTo Hell
'Convert the computer name to unicode
Dim strComputerName As String
strComputerName = StrConv(GetCompName, vbUnicode)
'Delete Task
Dim retVal As Long
retVal = NetScheduleJobDel(strComputerName, lngID, lngID)
'Return success
If retVal = NERR_Success Then DeleteScheduleTask = True
Exit_For:
On Error GoTo 0
Exit Function
Hell:
GoTo Exit_For
End Function
Private Function GetCompName() As String
Dim retVal As Long
'Create a string buffer for the computer name
Dim strCompName As String
strCompName = Space(255)
'Retrieve the Computer name
retVal = GetComputerName(strCompName, 255)
'Remove the trailing null character from the string
GetCompName = Left(strCompName, InStr(strCompName, vbNullChar) - 1)
End Function
Private Sub Command1_Click()
AddScheduleTask "28.08.2007", "AlertMe"
End Sub
Private Sub Command2_Click()
DeleteScheduleTask 1
End Sub
NetSheduleJobDel, NetSheduleJobEnum