?
Solved

Extract Scheduled Task Info

Posted on 2009-12-21
24
Medium Priority
?
1,206 Views
Last Modified: 2012-05-08
How would I go about extracting my Scheduled Task information?
Preferably with Excel VBA

I have tried SCHTASKS and it doesn't work because my Tasks' Command lines are longer than 255 Characters.

If possible i'd like it to be able to Import/Export from Excel.
0
Comment
Question by:bromy2004
  • 13
  • 9
  • 2
24 Comments
 
LVL 17

Expert Comment

by:CSecurity
ID: 26102688
There is 2 API you need: NetScheduleJobEnum and NetScheduleGetInfo, here is sample for each, combine them and use them as you like:


Private Const MAX_PREFERRED_LENGTH = -1&
Private Const ERROR_MORE_DATA = 234&
Private Const NERR_Success = 0

Private Sub EnumCmd_Click()
Dim lngWin32apiResultCode As Long
Dim strServerName         As String
Dim lngBufPtr             As Long
Dim lngEntriesRead        As Long
Dim lngTotalEntries       As Long
Dim lngResumeHandle       As Long

Dim i As Long, j As Long

    lngBufPtr = 0
    lngEntriesRead = 0
    lngTotalEntries = 0
    lngResumeHandle = 0

    strServerName = Space$(50)
    j = 50
    i = GetComputerName(strServerName, j)
    strServerName = StrConv(strServerName, vbUnicode)
    strServerName = Trim(strServerName)
   
    'strServerName = Null
   
    lngWin32apiResultCode = NetScheduleJobEnum(strServerName, lngBufPtr, _
                            MAX_PREFERRED_LENGTH, lngEntriesRead, _
                            lngTotalEntries, lngResumeHandle)
                           
    MsgBox "Total Entries : " & lngTotalEntries & vbLf & _
            "Entries Read : " & lngEntriesRead

End Sub



and see this:
http://www.vbforums.com/showthread.php?t=215109



For JobGetInfo API

Private Declare Function NetScheduleJobGetInfo Lib "NETAPI32.dll" (ByVal servername As String, ByVal JobId As Long, ByVal PointerToBuffer As String) As Long


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


http://www.pcreview.co.uk/forums/thread-1149229.php





Also you can try WMI:

    Dim wmgts As Object
    Dim SchedJobs As Object
    Dim AJob As Object

   
    Set wmgts = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\localhost\root\cimv2")
    For Each AJob In wmgts.instancesof("Win32_ScheduledJob")
        Debug.Print AJob.Caption;
        Debug.Print AJob.Status;
        Debug.Print AJob.jobid
    Next
0
 
LVL 17

Expert Comment

by:CSecurity
ID: 26102693
0
 
LVL 10

Author Comment

by:bromy2004
ID: 26102736
@CSecurity
What am i meant to do with this?
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 10

Author Comment

by:bromy2004
ID: 26102928
CSecurity, the WMI failed.
After line
For Each AJob In wmgts.instancesof("Win32_ScheduledJob")
it went straight to End Sub.

i found the Code that you referred to.
It is attached.

This also failed.
Sub Test
On For lThisJob = 1 To UBound(asJobs, 2)

When ive stepped through it, the "asJobs" Variable contains nothing.

Why is that?
Option Explicit
Option Compare Text

Private Const SC_MANAGER_CONNECT = &H1, SC_MANAGER_CREATE_SERVICE = 2
Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4, SC_MANAGER_LOCK = 8
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 = 2
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 = 128
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

Open in new window

0
 
LVL 17

Expert Comment

by:CSecurity
ID: 26103143
Are you sure you have some scheduled tasks?
0
 
LVL 10

Author Comment

by:bromy2004
ID: 26126405
I am 100% sure I have scheduled tasks.
I manage our companies complete daily reports and these are started with Scheduler.
0
 
LVL 10

Author Comment

by:bromy2004
ID: 26206256
Any Progress?
0
 
LVL 17

Expert Comment

by:CSecurity
ID: 26207455
I was looking at it, needs a simple fix, here you go:
Add this in top of form:

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

In here:
If ScheduleState = 0 Then
ServiceEnumJobs asJobs

Replace to


If ScheduleState = 0 Then
Dim CompName As String
CompName = Space(256)
Call GetComputerName(CompName, 256)
CompName = Trim(CompName)
CompName = Replace(CompName, Chr(0), "")
ServiceEnumJobs asJobs, CompName


Now it will work, that's all
0
 
LVL 10

Author Comment

by:bromy2004
ID: 26207969
Still Errored at the same point

Tasks.bmp
asJobs.bmp
0
 
LVL 17

Expert Comment

by:CSecurity
ID: 26207990
This code works perfect for me! Flawless
Option Explicit
Option Compare Text
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Const SC_MANAGER_CONNECT = &H1, SC_MANAGER_CREATE_SERVICE = 2
Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4, SC_MANAGER_LOCK = 8
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 = 2
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 = 128
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
Dim CompName As String
CompName = Space(256)
Call GetComputerName(CompName, 256)
CompName = Trim(CompName)
CompName = Replace(CompName, Chr(0), "")
ServiceEnumJobs asJobs, CompName
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

Private Sub Command1_Click()
Test
End Sub

Open in new window

0
 
LVL 10

Author Comment

by:bromy2004
ID: 26208056
Nope.
Same Error.

I even added a dummy Simple Task (Open Media Player at 9:00AM every morning)
And i still got the error.

Would it make a difference if there is a Command Line with more that 256 Characters?
0
 
LVL 17

Expert Comment

by:CSecurity
ID: 26208129
AFAIK will not make problem. Try in an empty computer without scheduled task, add a new simple task and see if it works. if it works, maybe that's the problem. But I should say it works perfect here.

Debug it, see if it gets computer name properly, debug the EnumJobs function, debug it and see where it fails
0
 
LVL 10

Author Comment

by:bromy2004
ID: 26208156
Nope. Even on the other computer.
How about Domains.
Even though they are local Schedules.
0
 
LVL 17

Expert Comment

by:CSecurity
ID: 26208279
Debug! Only way to get it working... Debug it STEP by STEP and tell me where it fails... I can't help because I don't know where is the problem
0
 
LVL 10

Author Comment

by:bromy2004
ID: 26208365
It is still crashing at the exact same point
On For lThisJob = 1 To UBound(asJobs, 2)
Nothing is getting added to asJobs
0
 
LVL 17

Expert Comment

by:CSecurity
ID: 26208397
No!!!! I mean go with F8. Don't press F5, GO STEP BY STEP, Go to ServiceEnumJobs function and see where it receives nothing. In ServiceEnumJobs see NetScheduleJobEnum, and see it if fails. It mean DEBUGGING! Not pressing F5 and running
0
 
LVL 10

Author Comment

by:bromy2004
ID: 26208417
:) I had pressed F8 until it crashed.
I'll run through the code again when I get home.
0
 
LVL 17

Expert Comment

by:CSecurity
ID: 26208420
Make 100% sure you have proper computername also
0
 
LVL 10

Author Comment

by:bromy2004
ID: 26289612
The computer name that gets used sent to the Function is "SALES010"
The function then adds "\\" to the front of it.

It fails on
Call NetScheduleJobEnum(abytServer(0), lStartBuffer, lBufferLen, lEntriesRead, lTotalEntries, lResume)

Because lBuffer = 0
lBuffer is the value of lStartBuffer
0
 
LVL 10

Author Comment

by:bromy2004
ID: 26337951
Any Progress?
0
 

Expert Comment

by:jkruijt
ID: 26354462
Hi there, Sorry to interrupt, but the code worked fine for me. I'm able to start tasks and monitor services. Just as it should be. I have an additional question though. I want to activate an existing task in the task schedular. How do I do that? Or do I need to start a new Question in this panel?
0
 
LVL 10

Author Comment

by:bromy2004
ID: 26394740
@jkruijt
As i cant get it to work it would be best to ask another question with the Code

@CSecurity
I don't know what i am doing wrong.
I'm not editing anything.
I definitely have Scheduled Tasks.
I am logged on a Domain.
I have 98 Scheduled Tasks
All but 3 Have over 255 characters in their command lines.
They were created by me (Username NATHANB)
I have full Admin access.
Computer Name is generated in the Formula which is correct (SALES010)
0
 
LVL 10

Accepted Solution

by:
bromy2004 earned 0 total points
ID: 26394918
The only point i can see that its not working as it should is the - NetScheduleJobEnum
Call NetScheduleJobEnum(abytServer(0), lStartBuffer, lBufferLen, lEntriesRead, lTotalEntries, lResume)

When it gets to this the values are
NetScheduleJobEnum(92, 0, 255, 0, 0, 0)
0
 

Expert Comment

by:jkruijt
ID: 26493678
You may close this case. I've asked my question on a other level.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This article provides a convenient collection of links to Microsoft provided Security Patches for operating systems that have reached their End of Life support cycle. Included operating systems covered by this article are Windows XP,  Windows Server…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question