VB and VBA Users Source Code: Querying and modifying the NT scheduler
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Querying and modifying the NT scheduler
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, January 19, 2001
Hits:
2388
Category:
Networks
Article:
It is often useful to schedule applications to run a specific days/times. The NT scheduler allows you to specify a command line and a time at which to run the command line. The code listed below can be used to query and modified the NT scheduler. A demonstration routine can be found at the bottom of this post. 'Copyright www.vbusers.com by Andrew Baker Option Explicit Option Compare Text Private Const SC_MANAGER_CONNECT = &H1, SC_MANAGER_CREATE_SERVICE = &H2 Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4, SC_MANAGER_LOCK = &H8 Private Const SC_MANAGER_QUERY_LOCK_STATUS = &H10, SC_MANAGER_MODIFY_BOOT_CONFIG = &H20 Private Const SC_MANAGER_ALL_ACCESS = SC_MANAGER_CONNECT + SC_MANAGER_CREATE_SERVICE + SC_MANAGER_ENUMERATE_SERVICE + SC_MANAGER_LOCK + SC_MANAGER_QUERY_LOCK_STATUS + SC_MANAGER_MODIFY_BOOT_CONFIG Private Const SERVICE_QUERY_CONFIG = &H1, SERVICE_CHANGE_CONFIG = &H2 Private Const SERVICE_QUERY_STATUS = &H4, SERVICE_ENUMERATE_DEPENDENTS = &H8 Private Const SERVICE_START = &H10, SERVICE_STOP = &H20, SERVICE_USER_DEFINED_CONTROL = &H100 Private Const SERVICE_PAUSE_CONTINUE = &H40, SERVICE_INTERROGATE = &H80 Private Const SERVICE_ALL_ACCESS = SERVICE_QUERY_CONFIG + SERVICE_CHANGE_CONFIG + SERVICE_QUERY_STATUS + SERVICE_ENUMERATE_DEPENDENTS + SERVICE_STOP + SERVICE_START + SERVICE_PAUSE_CONTINUE + SERVICE_INTERROGATE + SERVICE_USER_DEFINED_CONTROL Private Const SERVICE_STOPPED = 1, SERVICE_START_PENDING = 2 Private Const SERVICE_STOP_PENDING = 3, SERVICE_RUNNING = 4, SERVICE_PAUSED = 7 Private Const SERVICE_CONTINUE_PENDING = 5, SERVICE_PAUSE_PENDING = 6 Private Const SERVICE_BOOT_START = 0, SERVICE_SYSTEM_START = 1 Private Const SERVICE_AUTO_START = 2, SERVICE_DEMAND_START = 3, SERVICE_DISABLED = 4 Private Const SERVICE_CONTROL_STOP = 1, SERVICE_CONTROL_PAUSE = 2, SERVICE_CONTROL_SHUTDOWN = 5 Private Const SERVICE_CONTROL_CONTINUE = 3, SERVICE_CONTROL_INTERROGATE = 4 Private Const ERROR_MORE_DATA = 234, ERROR_ACCESS_DENIED = 5 Private Const ERROR_INVALID_HANDLE = 6, ERROR_PATH_NOT_FOUND = 3 Private Const ERROR_SERVICE_ALREADY_RUNNING = 1056, ERROR_DATABASE_LOCKED = 1055 Private Const ERROR_SERVICE_DEPENDENCY_DELETED = 1075, ERROR_SERVICE_DEPENDENCY_FAIL = 1068 Private Const ERROR_SERVICE_DISABLED = 1058, ERROR_SERVICE_LOGON_FAILED = 1069 Private Const ERROR_SERVICE_MARKED_FOR_DELETE = 1072, ERROR_SERVICE_NO_THREAD = 1054 Private Const ERROR_SERVICE_REQUEST_TIMEOUT = 1053, ERROR_SERVICE_DOES_NOT_EXIST = 1060 Private Const ERROR_SERVICE_CANNOT_ACCEPT_CONTROL = 1061, ERROR_SERVICE_NOT_ACTIVE = 1062 Private Const ERROR_SERVICE_SPECIFIC_ERROR = 1066, ERROR_SERVICE_START_HANG = 1070 Private Const ERROR_SERVICE_EXISTS = 1073, ERROR_SERVICE_NEVER_STARTED = 1077 Private Const ERROR_SERVICE_NOT_FOUND = 1243, ERROR_INSUFFICIENT_BUFFER = 122 Private Const ERROR_DATABASE_DOES_NOT_EXIST = 1065, ERROR_INVALID_PARAMETER = 87 Private Const ERROR_INVALID_NAME = 123 Private Const SERVICE_ACTIVE = &H1, SERVICE_INACTIVE = &H2 Private Const SERVICE_WIN32_OWN_PROCESS As Long = &H10, SERVICE_WIN32_SHARE_PROCESS As Long = &H20 Private Const SERVICE_WIN32 As Long = SERVICE_WIN32_OWN_PROCESS + SERVICE_WIN32_SHARE_PROCESS Private Const JOB_RUN_PERIODICALLY = &H1, JOB_EXEC_ERROR = &H2 Private Const JOB_RUNS_TODAY = &H4, JOB_ADD_CURRENT_DATE = &H8, JOB_NONINTERACTIVE = &H10 Public Enum eDayOfWeek dowMonday = 1 dowTuesday = 2 dowWednesday = 4 dowThursday = 8 dowFriday = 16 dowSaturday = 32 dowSunday = 64 End Enum Private Type AT_ENUM dwJobId As Long dwJobTime As Long dwDaysOfMonth As Long dwDaysOfWeek As Byte dwFlags As Byte dwdummy As Integer lptCommand As Long End Type Private Type AT_INFO dwJobTime As Long dwDaysOfMonth As Long dwDaysOfWeek As Byte dwFlags As Byte dwdummy As Integer lptCommand As Long End Type Private Type SERVICE_STATUS dwServiceType As Long dwCurrentState As Long dwControlsAccepted As Long dwWin32ExitCode As Long dwServiceSpecificExitCode As Long dwCheckPoint As Long dwWaitHint As Long End Type Private Type QUERY_SERVICE_CONFIG dwServiceType As Long dwStartType As Long dwErrorControl As Long lpBinaryPathName As Long lpLoadOrderGroup As Long dwTagId As Long lpDependencies As Long lpServiceStartName As Long lpDisplayName As Long End Type Private Type ENUM_SERVICE_STATUS lpServiceName As Long lpDisplayName As Long ServiceStatus As SERVICE_STATUS End Type Private Declare Function OpenSCManager Lib "advapi32.dll" Alias "OpenSCManagerA" (ByVal lpMachineName As String, ByVal lpDatabaseName As String, ByVal dwDesiredAccess As Long) As Long Private Declare Function CloseServiceHandle Lib "advapi32.dll" (ByVal hSCObject As Long) As Long Private Declare Function OpenService Lib "advapi32.dll" Alias "OpenServiceA" (ByVal hSCManager As Long, ByVal lpServiceName As String, ByVal dwDesiredAccess As Long) As Long Private Declare Function PtrToStr Lib "KERNEL32" Alias "lstrcpyW" (RetVal As Byte, ByVal Ptr As Long) As Long Private Declare Function StrToPtr Lib "KERNEL32" Alias "lstrcpyW" (ByVal Ptr As Long, Source As Byte) As Long Private Declare Function PtrToInt Lib "KERNEL32" Alias "lstrcpynW" (RetVal As Any, ByVal Ptr As Long, ByVal nCharCount As Long) As Long Private Declare Function StrLen Lib "KERNEL32" Alias "lstrlenW" (ByVal Ptr As Long) As Long Private Declare Function QueryServiceStatus Lib "advapi32.dll" (ByVal hService As Long, lpServiceStatus As Any) As Long Private Declare Function StartService Lib "advapi32.dll" Alias "StartServiceA" (ByVal hService As Long, ByVal dwNumServiceArgs As Long, ByVal lpServiceArgVectors As Long) As Long Private Declare Function QueryServiceConfig Lib "advapi32.dll" Alias "QueryServiceConfigA" (ByVal hService As Long, lpServiceConfig As Any, ByVal cbBufSize As Long, pcbBytesNeeded As Long) As Long Private Declare Function ControlService Lib "advapi32.dll" (ByVal hService As Long, ByVal dwControl As Long, lpServiceStatus As Any) As Long Private Declare Function EnumServicesStatus Lib "advapi32.dll" Alias "EnumServicesStatusA" (ByVal hSCManager As Long, ByVal dwServiceType As Long, ByVal dwServiceState As Long, lpServices As Any, ByVal cbBufSize As Long, pcbBytesNeeded As Long, lpServicesReturned As Long, lpResumeHandle As Long) As Long Private Declare Sub CopyMem Lib "KERNEL32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long) Private Declare Function NetScheduleJobGetInfo Lib "netapi32" (Servername As Byte, ByVal JobId As Long, PointerToBuffer As Any) As Long Private Declare Function NetScheduleJobEnum Lib "netapi32" (Servername As Byte, PointerToBuffer As Any, PrefMaxLength As Long, EntriesRead As Long, TotalEntries As Long, ResumeHandle As Long) As Long Private Declare Function NetScheduleJobDel Lib "netapi32" (Servername As Byte, ByVal MinJobId As Long, ByVal MaxJobId As Long) As Long Private Declare Function NetScheduleJobAdd Lib "netapi32" (Servername As Byte, PointerToBuffer As AT_INFO, JobInfo As Long) As Long Private Declare Function NetApiBufferFree Lib "NETAPI32.DLL" (ByVal Ptr As Long) As Long Private Declare Function NetAPIBufferAllocate Lib "NETAPI32.DLL" Alias "NetApiBufferAllocate" (ByVal ByteCount As Long, Ptr As Long) As Long Private Declare Function GetLastError Lib "kernel32.dll" () As Long 'Purpose : Returns the state of the Service Control Manager 'Inputs : [sComputer] The name of the computer to test. If not specified uses local machine. 'Outputs : Returns 0 If the SCM is running ' 1 If the SCM is stopped ' 2 If unable to open/connect to the SCM ' 3 If unable to determine the state of the SCM 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Function ScheduleState(Optional ByVal sComputer As String) As Long Dim lhSCM As Long, lhService As Long, sState As String, lReturn As Long If Left$(sComputer, 2) <> "\\" And Len(sComputer) > 0 Then sComputer = "\\" & sComputer End If 'Connect to Service Control Manager lhSCM = OpenSCManager(sComputer & vbNullString, vbNullString, SC_MANAGER_CONNECT) If lhSCM = 0 Then ScheduleState = 2 Exit Function End If 'Connect to Schedule service lhService = zServiceConnect(lhSCM, "Schedule") If lhService = 0 Then ScheduleState = 2 Exit Function End If 'Get the service state sState = ServiceGetState(lhService) If Len(sState) = 0 Then 'Failed to determine the state of Schedule service ScheduleState = 3 Exit Function End If If UCase$(sState) = "STARTED" Then ScheduleState = 0 'Schedule Service is running Else ScheduleState = 1 'Schedule Service is Stopped End If End Function 'Purpose : Starts the Schedule Service 'Inputs : [sComputer] The name of the computer to test. If not specified uses local machine. 'Outputs : Returns A descriptive string (see function) 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Function ScheduleServiceStart(Optional ByVal sComputer As String) As String Dim lhSCM As Long, lhService As Long If Left$(sComputer, 2) <> "\\" And Len(sComputer) > 0 Then sComputer = "\\" & sComputer End If 'Connect to SCM and Schedule Service lhSCM = OpenSCManager(sComputer & vbNullString, vbNullString, SC_MANAGER_ALL_ACCESS) If lhSCM = 0 Then ScheduleServiceStart = "Failed to connect" Exit Function End If lhService = zServiceConnect(lhSCM, "Schedule") If lhService = 0 Then ScheduleServiceStart = "Failed to connect" Exit Function End If 'Start the service If StartService(lhService, 0, 0) = 0 Then ScheduleServiceStart = "Error " & GetLastError Else 'Wait for service to start Do DoEvents ScheduleServiceStart = ServiceGetState(lhService) If ScheduleServiceStart = "Unknown" Then Exit Do End If Loop Until ScheduleServiceStart = "Started" End If End Function 'Purpose : Returns the StartUp state of a Service 'Inputs : lhSCM A handle to a service 'Outputs : Returns A descriptive string (see code in function) 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Private Function zServiceStartState(lhSCM As Long) As String Dim pState() As QUERY_SERVICE_CONFIG Dim lReturn As Long, lBuffer As Long Dim lBytesNeeded As Long, lStructNeeded As Long lReturn = QueryServiceConfig(lhSCM, ByVal &H0, &H0, lBytesNeeded) If GetLastError <> ERROR_INSUFFICIENT_BUFFER Then zServiceStartState = "Unknown" Exit Function End If 'Calculate the buffer sizes lStructNeeded = lBytesNeeded / Len(pState(0)) + 1 ReDim pState(lStructNeeded - 1) lBuffer = lStructNeeded * Len(pState(0)) lReturn = QueryServiceConfig(lhSCM, pState(0), lBuffer, lBytesNeeded) Select Case pState(0).dwStartType Case SERVICE_BOOT_START zServiceStartState = "Boot" Case SERVICE_SYSTEM_START zServiceStartState = "System" Case SERVICE_AUTO_START zServiceStartState = "Automatic" Case SERVICE_DISABLED zServiceStartState = "Disabled" Case SERVICE_DEMAND_START zServiceStartState = "Manual" Case Else zServiceStartState = "Unknown" End Select End Function 'Purpose : Connects to the specified service 'Inputs : lhSCM Handle to the SCM ' sServiceName The name of the service to connect to 'Outputs : Returns Handle to the service OR zero if not able to open service 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Private Function zServiceConnect(lhSCM As Long, sServiceName As String) As Long 'Open the Service Name zServiceConnect = OpenService(lhSCM, sServiceName, SERVICE_ALL_ACCESS) If zServiceConnect = 0 Then Call CloseServiceHandle(lhSCM) End If End Function 'Purpose : Returns the state of the specified service 'Inputs : lhService Handle to the Service 'Outputs : Returns Descriptive text (See Function Code) 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Function ServiceGetState(lhService As Long) As String Dim pstatus As SERVICE_STATUS Dim lReturn As Long lReturn = QueryServiceStatus(lhService, pstatus) If lReturn <> 1 Then lReturn = CloseServiceHandle(lhService) ServiceGetState = "" End If Select Case pstatus.dwCurrentState Case SERVICE_STOPPED ServiceGetState = "Stopped" Case SERVICE_START_PENDING ServiceGetState = "Start Pending" Case SERVICE_STOP_PENDING ServiceGetState = "Stop Pending" Case SERVICE_RUNNING ServiceGetState = "Started" Case SERVICE_CONTINUE_PENDING ServiceGetState = "Continue Pending" Case SERVICE_PAUSE_PENDING ServiceGetState = "Pause Pending" Case SERVICE_PAUSED ServiceGetState = "Paused" Case Else ServiceGetState = "Unknown" End Select End Function 'Purpose : Enumerates the pending jobs on the specified machine 'Inputs : [sComputer] The name of the computer to test. If not specified uses local machine. 'Outputs : asJobs A string array (1 to 3, 1 to Number of Jobs) ' Where asJobs(1,1) Job 1. Command string ' asJobs(2,1) Job 1. Time string ' asJobs(3,1) Job 1. Date string ' asJobs(4,1) Job 1. Job ID ' Returns The number of jobs 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Function ServiceEnumJobs(asJobs() As String, Optional ByVal sComputer As String) As Long Dim tJobDetails As AT_ENUM Dim abytServer() As Byte, abytCommand(0 To 99) As Byte Dim sCommand As String, sTemp As String Dim sTime As String, sDayInfo As String Dim lResume As Long, lEntriesRead As Long, lBuffer As Long Dim lTotalEntries As Long, lThisJob As Long, lLenStruct As Long Dim lptr As Long, lStartBuffer As Long, lBufferLen As Long Const clMaxBufferLen As Long = 255 If Left$(sComputer, 2) <> "\\" And Len(sComputer) > 0 Then sComputer = "\\" & sComputer End If abytServer() = sComputer & vbNullChar lBufferLen = clMaxBufferLen Call NetScheduleJobEnum(abytServer(0), lStartBuffer, lBufferLen, lEntriesRead, lTotalEntries, lResume) lBuffer = lStartBuffer lLenStruct = Len(tJobDetails) Erase asJobs If lBuffer <> 0 Then ServiceEnumJobs = lTotalEntries ReDim asJobs(1 To 4, 1 To lTotalEntries) For lThisJob = 1 To lTotalEntries 'Copy pointer into structure CopyMem tJobDetails, ByVal lBuffer, lLenStruct 'Get Command Line lptr = tJobDetails.lptCommand Call PtrToStr(abytCommand(0), lptr) sCommand = Left$(abytCommand, StrLen(lptr)) asJobs(1, lThisJob) = sCommand 'Get Time sTime = zServiceConvertTime(tJobDetails.dwJobTime) asJobs(2, lThisJob) = sTime 'Get Day Info sDayInfo = zGetDayInfo(tJobDetails.dwDaysOfMonth, tJobDetails.dwDaysOfWeek, tJobDetails.dwFlags) asJobs(3, lThisJob) = sDayInfo 'Get Job ID asJobs(4, lThisJob) = CStr(tJobDetails.dwJobId) 'Move pointer along by length of structure lBuffer = lBuffer + lLenStruct Next End If Call NetApiBufferFree(lStartBuffer) End Function 'Purpose : Convert a decimal to a binary string 'Inputs : lValue A decimal (long) number 'Outputs : Returns A binary string representation of a numerical value 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Private Function zConvertToBinary(lValue As Long) As String Dim lTestDiv As Long, lNumber As Long, lAbsValue As Long lAbsValue = Abs(lValue) lNumber = 32768 Do lTestDiv = lAbsValue \ lNumber If lTestDiv = 1 Then 'Number divisible, put the bit in the binary string zConvertToBinary = zConvertToBinary & "1" 'Determine the remainder lAbsValue = lAbsValue Mod lNumber Else 'Number not divisible, put 0 in the binary string zConvertToBinary = zConvertToBinary & "0" End If 'Get the next bit lNumber = lNumber / 2 If lNumber < 1 Then 'Finished Exit Do End If Loop End Function 'Purpose : Convert Milliseconds (from midnight) to a real time 'Inputs : lMSec Time in milliseconds 'Outputs : Returns A formated time string of the form "hh:mm:ss" 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Private Function zServiceConvertTime(lMSec As Long) As String Dim lSeconds As Long lSeconds = lMSec \ 1000 zServiceConvertTime = Format$(DateAdd("s", lSeconds, "00:00"), "hh:mm:ss") End Function 'Purpose : Interprets AT_ENUM to return a string representing the schedule days 'Inputs : lMonth Days of month (as a long) ' bDay Days of week (as byte) ' bFlag Flags (as byte) 'Outputs : Returns A formated string representing the scheduled days ' eg "Each Tue Thur" 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : Currently Days of Month NOT interpreted 'Revisions : 'Assumptions : Private Function zGetDayInfo(lMonth As Long, bDay As Byte, bFlag As Byte) As String Dim sMonth As String, sDay As String, sFlag As String Dim lThisDay As Long Dim asDays(1 To 7) As String asDays(1) = "Mon" asDays(2) = "Tue" asDays(3) = "Wed" asDays(4) = "Thu" asDays(5) = "Fri" asDays(6) = "Sat" asDays(7) = "Sun" 'Convert the input data into a binary string sMonth = zConvertToBinary(lMonth) sDay = Right$(zConvertToBinary(Val(bDay)), 7) sFlag = Right$(zConvertToBinary(Val(bFlag)), 8) 'Interpret the binary string for Days For lThisDay = 7 To 1 Step -1 If Mid$(sDay, lThisDay, 1) = "1" Then If Len(zGetDayInfo) = 0 Then zGetDayInfo = asDays((7 - lThisDay) + 1) Else zGetDayInfo = zGetDayInfo & (" " & asDays((7 - lThisDay) + 1)) End If End If Next If Left$(sFlag, 1) = "1" Then zGetDayInfo = "Next: " & zGetDayInfo Else If Right$(sFlag, 1) = "1" Then zGetDayInfo = "Each: " & zGetDayInfo End If End If End Function 'Purpose : Returns information of a specified job for a specified computer 'Inputs : lJob The index of the job to return the details of ' [sComputer] The name of the computer to test. If not specified uses local machine. 'Outputs : Returns A binary string representation of a numerical value 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Function ServiceGetJobInfo(lJob As Long, Optional ByVal sComputer As String) As Variant Dim abytServer() As Byte, abytCommand(0 To 99) As Byte Dim sCommand As String, sTemp As String, avResults As Variant Dim sTime As String, sDayInfo As String Dim lptrCommand As Long Dim lBuffer As Long, lResult As Long Dim tBuffer As AT_INFO On Error Resume Next If Left$(sComputer, 2) <> "\\" And Len(sComputer) > 0 Then sComputer = "\\" & sComputer End If abytServer() = sComputer & vbNullChar Call NetScheduleJobGetInfo(abytServer(0), lJob, lBuffer) CopyMem tBuffer, ByVal lBuffer, Len(tBuffer) lptrCommand = tBuffer.lptCommand lResult = PtrToStr(abytCommand(0), lptrCommand) sCommand = Left(abytCommand, StrLen(lptrCommand)) sTime = zServiceConvertTime(tBuffer.dwJobTime) sDayInfo = zGetDayInfo(tBuffer.dwDaysOfMonth, tBuffer.dwDaysOfWeek, tBuffer.dwFlags) ReDim avResults(1 To 3) avResults(1) = sCommand avResults(2) = sTime avResults(3) = sDayInfo ServiceGetJobInfo = avResults End Function 'Purpose : Delete a job/s from the schedule 'Inputs : lMinID The ID of the first job to delete ' [lMaxID] The ID of the last job to delete. If not specified job lMinID is deleted. ' [sComputer] The name of the computer to test. If not specified uses local machine. 'Outputs : Returns True if the job was deleted 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Function ServiceDeleteJob(lMinID As Long, Optional lMaxID As Long = -1, Optional ByVal sComputer As String) As Boolean Dim abytServer() As Byte If Left$(sComputer, 2) <> "\\" And Len(sComputer) > 0 Then sComputer = "\\" & sComputer End If abytServer = sComputer & vbNullChar If lMaxID = -1 Then 'Delete just lMinID lMaxID = lMinID End If If NetScheduleJobDel(abytServer(0), lMinID, lMaxID) = 0 Then ServiceDeleteJob = True End If End Function 'Purpose : Add a job to the schedule 'Inputs : sTime The time to run the schedule. In the format hh:mm eg. 17:00 (five o'clock) ' eWeekDay Enumerated type. Can be more than one value ' eg. dowWednesday + dowThursday + dowFriday ' sCommadLine The command line eg. "C:\MyApp.exe" ' Note: it may be necessary to use chr$(34) & C:\folder 1\MyApp.exe & chr$(34) ' when the directory contains spaces. ' lFlags 0 The service is run once ' 1 The service is run periodically for the week days specified in eWeekDay ' [sComputer] The name of the computer to test. If not specified uses local machine. 'Outputs : Returns True if the job was added 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Function ServiceAddJob(sTime As String, eWeekDay As eDayOfWeek, sCommadLine As String, Optional lFlags As Long = 1, Optional sComputer As String) As Boolean Dim abytServer() As Byte, abytCmd() As Byte Dim tInfo As AT_INFO Dim lReturn As Long, lJobReturn As Long Dim bytFlags As Byte, bytDoW As Byte Dim lJobid As Long, lptrCmd As Long, lTime As Long If Left$(sComputer, 2) <> "\\" And Len(sComputer) > 0 Then sComputer = "\\" & sComputer End If 'Convert server and command to unicode, and Days of week/Flags to Byte abytServer = sComputer & vbNullChar abytCmd = sCommadLine & vbNullChar bytDoW = eWeekDay bytFlags = lFlags 'Convert Time to a long lTime = zTimeToMilliseconds(Trim$(sTime)) 'Allocate buffer space for command lReturn = NetAPIBufferAllocate(UBound(abytCmd) + 1, lptrCmd) 'Set structure up lReturn = StrToPtr(lptrCmd, abytCmd(0)) tInfo.dwJobTime = lTime tInfo.dwDaysOfWeek = bytDoW tInfo.dwFlags = bytFlags tInfo.lptCommand = lptrCmd 'Add job If NetScheduleJobAdd(abytServer(0), tInfo, lJobid) = 0 Then 'Suceeded in adding job ServiceAddJob = True End If 'Dealloc buffer Call NetApiBufferFree(lptrCmd) End Function 'Purpose : Converts a time to a time in milliseconds, from midnight. 'Inputs : sTime The time to convert, in the format hh:mm eg. 17:00 (five o'clock) 'Outputs : Returns The time in ms from midnight 'Author : Andrew Baker 'Date : 18/01/2001 10:38 'Notes : 'Revisions : 'Assumptions : Function zTimeToMilliseconds(sTime As String) As Long zTimeToMilliseconds = ((Val(Left$(sTime, 2)) * 3600) + (Val(Right$(sTime, 2)) * 60)) * 1000 End Function 'Demonstration routine Sub Test() Dim asJobs() As String, lThisJob As Long If ScheduleState <> 0 Then 'Schedule service not running Debug.Print ScheduleServiceStart End If If ScheduleState = 0 Then 'Schedule service running 'List the jobs currently scheduled ServiceEnumJobs asJobs For lThisJob = 1 To UBound(asJobs, 2) Debug.Print "Command Line: " & asJobs(1, lThisJob) Debug.Print "Time: " & asJobs(2, lThisJob) Debug.Print "Day Info: " & asJobs(3, lThisJob) Debug.Print "ID: " & asJobs(4, lThisJob) Next If ServiceAddJob("16:00", dowFriday + dowThursday, "C:\home.exe") = True Then MsgBox "Added job" Else MsgBox "Failed to add job" End If End If End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
