VB and VBA Users Source Code: Start,stop check status and list NT Server services
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Start,stop check status and list NT Server services
By:
G Stevens
Email (spam proof):
Email the originator of this post
Date:
Monday, August 20, 2001
Hits:
1891
Category:
Networks
Article:
Andrew, I really liked you article on starting/stopping services: http://www.vbusers.com/code/codeget.asp?ThreadID=135&PostID=1&NumReplies=0 Below is my version which has some slight differences which may be of interest to you: Option Explicit 'our own constant Private Const SIZEOF_SERVICE_STATUS As Long = 36 'windows constants Private Const LB_SETTABSTOPS As Long = &H192 Private Const ERROR_MORE_DATA = 234 Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4 Private Const SC_MANAGER_ALL_ACCESS = &H1 Private Const SC_MANAGER_CONNECT = &H1 Private Const GENERIC_READ = &H80000000 'Service State for Enum Requests (Bit Mask) Private Const SERVICE_ACTIVE = &H1 Private Const SERVICE_INACTIVE = &H2 Private Const SERVICE_STATE_ALL = SERVICE_ACTIVE Or SERVICE_INACTIVE 'Constants for controlling service Private Const SERVICES_ACTIVE_DATABASE = "ServicesActive" Private Const SERVICE_CONTROL_STOP = &H1 Private Const SERVICE_CONTROL_PAUSE = &H2 Private Const STANDARD_RIGHTS_REQUIRED = &HF0000 Private Const SERVICE_QUERY_CONFIG = &H1 Private Const SERVICE_CHANGE_CONFIG = &H2 Private Const SERVICE_QUERY_STATUS = &H4 Private Const SERVICE_ENUMERATE_DEPENDENTS = &H8 Private Const SERVICE_START = &H10 Private Const SERVICE_STOP = &H20 Private Const SERVICE_PAUSE_CONTINUE = &H40 Private Const SERVICE_INTERROGATE = &H80 Private Const SERVICE_USER_DEFINED_CONTROL = &H100 Private Const SERVICE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SERVICE_QUERY_CONFIG Or SERVICE_CHANGE_CONFIG Or SERVICE_QUERY_STATUS Or SERVICE_ENUMERATE_DEPENDENTS Or SERVICE_START Or SERVICE_STOP Or SERVICE_PAUSE_CONTINUE Or SERVICE_INTERROGATE Or SERVICE_USER_DEFINED_CONTROL) 'Service Types (Bit Mask) 'corresponds to SERVICE_STATUS.dwServiceType Private Const SERVICE_KERNEL_DRIVER As Long = &H1 Private Const SERVICE_FILE_SYSTEM_DRIVER As Long = &H2 Private Const SERVICE_ADAPTER As Long = &H4 Private Const SERVICE_RECOGNIZER_DRIVER As Long = &H8 Private Const SERVICE_WIN32_OWN_PROCESS As Long = &H10 Private Const SERVICE_WIN32_SHARE_PROCESS As Long = &H20 Private Const SERVICE_INTERACTIVE_PROCESS As Long = &H100 Private Const SERVICE_WIN32 As Long = SERVICE_WIN32_OWN_PROCESS Or _ SERVICE_WIN32_SHARE_PROCESS Private Const SERVICE_DRIVER As Long = SERVICE_KERNEL_DRIVER Or _ SERVICE_FILE_SYSTEM_DRIVER Or _ SERVICE_RECOGNIZER_DRIVER Private Const SERVICE_TYPE_ALL As Long = SERVICE_WIN32 Or _ SERVICE_ADAPTER Or _ SERVICE_DRIVER Or _ SERVICE_INTERACTIVE_PROCESS 'Service State 'corresponds to SERVICE_STATUS.dwCurrentState Private Const SERVICE_STOPPED As Long = &H1 Private Const SERVICE_START_PENDING As Long = &H2 Private Const SERVICE_STOP_PENDING As Long = &H3 Private Const SERVICE_RUNNING As Long = &H4 Private Const SERVICE_CONTINUE_PENDING As Long = &H5 Private Const SERVICE_PAUSE_PENDING As Long = &H6 Private Const SERVICE_PAUSED As Long = &H7 'Controls Accepted (Bit Mask) 'corresponds to SERVICE_STATUS.dwControlsAccepted Private Const SERVICE_ACCEPT_STOP As Long = &H1 Private Const SERVICE_ACCEPT_PAUSE_CONTINUE As Long = &H2 Private Const SERVICE_ACCEPT_SHUTDOWN As Long = &H4 'Windows type used to call the Net API Private Const MAX_PREFERRED_LENGTH As Long = -1 Private Const NERR_SUCCESS As Long = 0& Private Const SV_TYPE_WORKSTATION As Long = &H1 Private Const SV_TYPE_SERVER As Long = &H2 Private Const SV_TYPE_SQLSERVER As Long = &H4 Private Const SV_TYPE_DOMAIN_CTRL As Long = &H8 Private Const SV_TYPE_DOMAIN_BAKCTRL As Long = &H10 Private Const SV_TYPE_TIME_SOURCE As Long = &H20 Private Const SV_TYPE_AFP As Long = &H40 Private Const SV_TYPE_NOVELL As Long = &H80 Private Const SV_TYPE_DOMAIN_MEMBER As Long = &H100 Private Const SV_TYPE_PRINTQ_SERVER As Long = &H200 Private Const SV_TYPE_DIALIN_SERVER As Long = &H400 Private Const SV_TYPE_XENIX_SERVER As Long = &H800 Private Const SV_TYPE_SERVER_UNIX As Long = SV_TYPE_XENIX_SERVER Private Const SV_TYPE_NT As Long = &H1000 Private Const SV_TYPE_WFW As Long = &H2000 Private Const SV_TYPE_SERVER_MFPN As Long = &H4000 Private Const SV_TYPE_SERVER_NT As Long = &H8000 Private Const SV_TYPE_POTENTIAL_BROWSER As Long = &H10000 Private Const SV_TYPE_BACKUP_BROWSER As Long = &H20000 Private Const SV_TYPE_MASTER_BROWSER As Long = &H40000 Private Const SV_TYPE_DOMAIN_MASTER As Long = &H80000 Private Const SV_TYPE_SERVER_OSF As Long = &H100000 Private Const SV_TYPE_SERVER_VMS As Long = &H200000 Private Const SV_TYPE_WINDOWS As Long = &H400000 'Win95 and above Private Const SV_TYPE_DFS As Long = &H800000 'Root of DFS tree Private Const SV_TYPE_CLUSTER_NT As Long = &H1000000 'NT Cluster Private Const SV_TYPE_TERMINALSERVER As Long = &H2000000 'Terminal Server Private Const SV_TYPE_DCE As Long = &H10000000 'IBM DSS Private Const SV_TYPE_ALTERNATE_XPORT As Long = &H20000000 'rtn alternate transport Private Const SV_TYPE_LOCAL_LIST_ONLY As Long = &H40000000 'rtn local only Private Const SV_TYPE_DOMAIN_ENUM As Long = &H80000000 Private Const SV_TYPE_ALL As Long = &HFFFFFFFF Private Const SV_PLATFORM_ID_OS2 As Long = 400 Private Const SV_PLATFORM_ID_NT As Long = 500 'Mask applied to svX_version_major in 'order to obtain the major version number. Private Const MAJOR_VERSION_MASK As Long = &HF 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 ENUM_SERVICE_STATUS lpServiceName As Long lpDisplayName As Long ServiceStatus As SERVICE_STATUS End Type Private Type SERVER_INFO_100 sv100_platform_id As Long sv100_name As Long End Type '--------------------WIN32 APIs-------------------------------------------------- 'gain access to the service manager Private Declare Function OpenSCManager Lib "advapi32.dll" _ Alias "OpenSCManagerA" _ (ByVal lpMachineName As String, _ ByVal lpDatabaseName As String, _ ByVal dwDesiredAccess As Long) As Long 'gain access to a service Private Declare Function OpenService Lib "advapi32.dll" _ Alias "OpenServiceA" _ (ByVal hSCManager As Long, _ ByVal lpServiceName As String, _ ByVal dwDesiredAccess As Long) As Long 'query status of a service Private Declare Function QueryServiceStatus Lib "advapi32.dll" _ (ByVal hService As Long, lpServiceStatus As SERVICE_STATUS) As Long 'get list of all services on a server 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 'stop or pause a service Private Declare Function ControlService Lib "advapi32.dll" _ (ByVal lHwndService As Long, _ ByVal dwControl As Long, _ lpServiceStatus As SERVICE_STATUS) As Long 'start a service Private Declare Function StartService Lib "advapi32.dll" _ Alias "StartServiceA" _ (ByVal lHwndService As Long, _ ByVal dwNumServiceArgs As Long, _ ByVal lpServiceArgVectors As Long) As Long 'release handle acquired by OpenSCManager or OpenService Private Declare Function CloseServiceHandle Lib "advapi32.dll" _ (ByVal hSCObject As Long) As Long 'gets list of all servers on a particular domain Private Declare Function NetServerEnum Lib "Netapi32" _ (ByVal servername As Long, _ ByVal level As Long, _ buf As Any, _ ByVal prefmaxlen As Long, _ entriesread As Long, _ totalentries As Long, _ ByVal servertype As Long, _ ByVal domain As Long, _ resume_handle As Long) As Long Private Declare Function NetApiBufferFree Lib "netapi32.dll" _ (ByVal Buffer As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" _ (pTo As Any, uFrom As Any, _ ByVal lSize As Long) Private Declare Function lstrlenW Lib "kernel32" _ (ByVal lpString As Long) As Long Private Declare Function lstrcpyA Lib "kernel32" _ (ByVal RetVal As String, ByVal Ptr As Long) As Long Private Declare Function lstrlenA Lib "kernel32" _ (ByVal Ptr As Any) As Long Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long '-------------Delcare property variables----------------------------------------- Private msServerFocus As String Private msErrorMessage As String Private msServicesArray() As String Private msServerArray() As String Public Property Get ServerArray() As String() ServerArray = msServerArray End Property Public Property Get ServerFocus() As String ServerFocus = msServerFocus End Property Public Property Get ServicesArray() As String() ServicesArray = msServerArray End Property Public Property Get ErrorMessage() As String ErrorMessage = msErrorMessage End Property Private Function GetPointerToByteStringW(ByVal dwData As Long) As String Dim tmp() As Byte Dim tmplen As Long If dwData <> 0 Then tmplen = lstrlenW(dwData) * 2 If tmplen <> 0 Then ReDim tmp(0 To (tmplen - 1)) As Byte CopyMemory tmp(0), ByVal dwData, tmplen GetPointerToByteStringW = tmp End If End If End Function Private Function GetServiceType(dwType As Long) As String Dim sType As String If (dwType And SERVICE_WIN32_OWN_PROCESS) Then sType = sType & "own proc, " If (dwType And SERVICE_WIN32_SHARE_PROCESS) Then sType = sType & "share, " If (dwType And SERVICE_KERNEL_DRIVER) Then sType = sType & "kernel, " If (dwType And SERVICE_FILE_SYSTEM_DRIVER) Then sType = sType & "filesys, " If (dwType And SERVICE_INTERACTIVE_PROCESS) Then sType = sType & "interactive" GetServiceType = sType End Function Private Function GetServiceState(dwstate As Long) As String Select Case dwstate Case SERVICE_STOPPED: GetServiceState = "stopped" Case SERVICE_START_PENDING: GetServiceState = "startpend" Case SERVICE_STOP_PENDING: GetServiceState = "stoppend" Case SERVICE_RUNNING: GetServiceState = "running" Case SERVICE_CONTINUE_PENDING: GetServiceState = "contpend" Case SERVICE_PAUSE_PENDING: GetServiceState = "pausepend" Case SERVICE_PAUSED: GetServiceState = "paused" End Select End Function Private Function GetServiceControl(dwControl As Long) As String Dim tmp As String If dwControl Then If (dwControl And SERVICE_ACCEPT_STOP) Then tmp = tmp & "stop, " If (dwControl And SERVICE_ACCEPT_PAUSE_CONTINUE) Then tmp = tmp & "pause, " If (dwControl And SERVICE_ACCEPT_SHUTDOWN) Then tmp = tmp & "shutdown" 'Else: tmp = vbTab End If GetServiceControl = tmp End Function Private Function GetStrFromPtrA(ByVal lpszA As Long) As String GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0) Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA) End Function Public Function EnumSystemServices(SERVICE_TYPE As Long, _ sMachine As String) As Long Dim hSCManager As Long Dim pntr() As ENUM_SERVICE_STATUS Dim cbBuffSize As Long Dim cbRequired As Long Dim dwReturned As Long Dim hEnumResume As Long Dim cbBuffer As Long Dim success As Long Dim i As Long 'these five just help keep the 'code lines from becoming too long 'for html display Dim sSvcName As String Dim sDispName As String Dim dwstate As Long Dim dwType As Long Dim dwCtrls As Long 'update label to show what we're trying to view msServerFocus = "Viewing services on " & sMachine hSCManager = contactSCMHandle(sMachine, SC_MANAGER_ENUMERATE_SERVICE) If hSCManager <> 0 Then 'Get buffer size by calling EnumServicesStatus. 'To determine the required buffer size, call EnumServicesStatus 'with cbBuffer and hEnumResume set to zero. EnumServicesStatus 'fails (returns 0), and Err.LastDLLError returns ERROR_MORE_DATA, 'filling cbRequired with the size, in bytes, of the buffer 'required to hold the array of structures and their data. success = EnumServicesStatus(hSCManager, _ SERVICE_WIN32, _ SERVICE_TYPE, _ ByVal &H0, _ &H0, _ cbRequired, _ dwReturned, _ hEnumResume) 'If success is 0 and the LastDllError is 'ERROR_MORE_DATA, use returned info to create 'the required data buffer If success = 0 And Err.LastDllError = ERROR_MORE_DATA Then 'Calculate number of structures needed and redimension the array cbBuffer = (cbRequired \ SIZEOF_SERVICE_STATUS) + 1 ReDim pntr(0 To cbBuffer) 'Set cbBuffSize equal to the size of the buffer cbBuffSize = cbBuffer * SIZEOF_SERVICE_STATUS 'Enumerate the services. If the function succeeds, 'the return value is nonzero. In addition, hEnumResume 'must be set to 0. hEnumResume = 0 If EnumServicesStatus(hSCManager, _ SERVICE_WIN32, _ SERVICE_TYPE, _ pntr(0), _ cbBuffSize, _ cbRequired, _ dwReturned, _ hEnumResume) Then 'pntr() array is now filled with service data ReDim msServerArray(dwReturned, 3) For i = 0 To dwReturned - 1 sDispName = GetStrFromPtrA(ByVal pntr(i).lpDisplayName) sSvcName = GetStrFromPtrA(ByVal pntr(i).lpServiceName) dwstate = pntr(i).ServiceStatus.dwCurrentState dwType = pntr(i).ServiceStatus.dwServiceType dwCtrls = pntr(i).ServiceStatus.dwControlsAccepted msServerArray(i, 0) = sDispName msServerArray(i, 1) = sSvcName msServerArray(i, 2) = GetServiceState(dwstate) Next Else: MsgBox "EnumServicesStatus; error " & CStr(Err.LastDllError) End If 'If EnumServicesStatus Else: MsgBox "ERROR_MORE_DATA not returned; error " & CStr(Err.LastDllError) End If 'If success = 0 And Err.LastDllError Else: MsgBox "OpenSCManager failed; error = " & CStr(Err.LastDllError) End If 'If hSCManager <> 0 'Clean up Call CloseServiceHandle(hSCManager) 'return the number of services 'returned as a sign of success EnumSystemServices = dwReturned End Function Public Function GetServers(sDomain As String) As Long 'lists all servers of the specified type 'that are visible in a domain. Dim bufptr As Long Dim dwEntriesread As Long Dim dwTotalentries As Long Dim dwResumehandle As Long Dim se100 As SERVER_INFO_100 Dim success As Long Dim nStructSize As Long Dim cnt As Long nStructSize = LenB(se100) 'Call passing MAX_PREFERRED_LENGTH to have the 'API allocate required memory for the return values. ' 'The call is enumerating all machines on the 'network (SV_TYPE_ALL); however, by Or'ing 'specific bit masks for defined types you can 'customize the returned data. For example, a 'value of 0x00000003 combines the bit masks for 'SV_TYPE_WORKSTATION (0x00000001) and 'SV_TYPE_SERVER (0x00000002). ' 'dwServerName must be Null. The level parameter '(100 here) specifies the data structure being 'used (in this case a SERVER_INFO_100 structure). ' 'The domain member is passed as Null, indicating 'machines on the primary domain are to be retrieved. 'If you decide to use this member, pass 'StrPtr("domain name"), not the string itself. success = NetServerEnum(0&, _ 100, _ bufptr, _ MAX_PREFERRED_LENGTH, _ dwEntriesread, _ dwTotalentries, _ SV_TYPE_SERVER, _ 0&, _ dwResumehandle) 'if all goes well If success = NERR_SUCCESS And _ success <> ERROR_MORE_DATA Then 'loop through the returned data, adding each 'machine to the list ReDim msServerArray(dwEntriesread - 1) For cnt = 0 To dwEntriesread - 1 'get one chunk of data and cast 'into an LOCALGROUP_INFO_1 type 'in order to add the name to a list CopyMemory se100, ByVal bufptr + (nStructSize * cnt), nStructSize msServerArray(cnt) = GetPointerToByteStringW(se100.sv100_name) Next End If 'clean up, regardless of success Call NetApiBufferFree(bufptr) End Function Private Function contactSCMHandle(ByVal sMachine As String, ByVal lAction As Long) As Long Dim hSCManager As Long Dim sError As String On Error GoTo errorhandler 'establish a connection to the service control 'manager on the local computer and open 'the service control manager database. hSCManager = OpenSCManager("\\" & sMachine, _ vbNullString, _ lAction) If hSCManager = 0 Then sError = "Unable to get Service Control Manager Handle" GoTo errorhandler End If contactSCMHandle = hSCManager Exit Function errorhandler: msErrorMessage = sError contactSCMHandle = 0 End Function Private Function openServiceHandle(ByVal sServerName As String, ByVal lAction As Long, ByVal sServiceName As String, ByVal lAccessLevel As Long) As Long() Dim lHandles(2) As Long Dim sError As String On Error GoTo errorhandler lHandles(0) = contactSCMHandle(sServerName, lAction) If Len(msErrorMessage) > 0 Then GoTo errorhandler 'establishes a connection to the service and returns a handle 'which must be used when requesting information from the service lHandles(1) = OpenService(lHandles(0), sServiceName, lAccessLevel) If lHandles(1) = 0 Then sError = "Unable to get Service State" GoTo errorhandler End If openServiceHandle = lHandles errorhandler: msErrorMessage = sError openServiceHandle = lHandles End Function Private Function getServiceStatus(lServiceHandle As Long) As String Dim pntr As SERVICE_STATUS Dim lSuccess As Long Dim sServiceStatus As String On Error GoTo errorhandler lSuccess = QueryServiceStatus(lServiceHandle, pntr) sServiceStatus = GetServiceState(pntr.dwCurrentState) If Len(sServiceStatus) > 0 Then getServiceStatus = sServiceStatus Else GoTo errorhandler End If Exit Function errorhandler: msErrorMessage = "Unable to get service status" getServiceStatus = "" End Function Public Function retrieveServiceStatus(ByVal sService As String, ByVal sServer As String) As String Dim lscManagerHandle As Long Dim lHandle() As Long Dim sServiceState As String Dim sError As String 'get access to service control manager and specific service (read only) lHandle = openServiceHandle(sServer, SC_MANAGER_ALL_ACCESS, sService, GENERIC_READ) 'get service status sServiceState = getServiceStatus(lHandle(1)) Call ReleaseServiceHandles(lHandle(0), lHandle(1)) If Len(msErrorMessage) > 0 Then sServiceState = "" End If retrieveServiceStatus = sServiceState End Function Private Function ServiceControl(sServiceName As String, sServerName As String, lAction As Long) As Boolean Dim ServiceStatus As SERVICE_STATUS Dim lHandle() As Long Dim lSuccess As Long Dim bSuccess As Boolean bSuccess = False lHandle = openServiceHandle(sServerName, SC_MANAGER_ALL_ACCESS, sServiceName, SERVICE_ALL_ACCESS) If Len(msErrorMessage) = 0 Then lSuccess = ControlService(lHandle(1), lAction, ServiceStatus) If lSuccess > 0 Then bSuccess = True End If End If Call ReleaseServiceHandles(lHandle(0), lHandle(1)) ServiceControl = True End Function Public Function ServiceStart(sServiceName As String, sServerName As String) As Boolean Dim ServiceStatus As SERVICE_STATUS Dim lHandles() As Long Dim lSuccess As Long Dim bSuccess As Boolean bSuccess = False lHandles = openServiceHandle(sServerName, SC_MANAGER_ALL_ACCESS, sServiceName, SERVICE_ALL_ACCESS) If Len(msErrorMessage) = 0 Then lSuccess = StartService(lHandles(1), 0, 0) If lSuccess > 0 Then bSuccess = True End If End If ServiceStart = bSuccess End Function Public Function ServiceStop(sServiceName As String, sServerName As String) As Boolean Dim bSuccess As Boolean bSuccess = ServiceControl(sServiceName, sServerName, SERVICE_CONTROL_STOP) ServiceStop = bSuccess End Function Public Function ServicePause(sServiceName As String, sServerName As String) As Boolean Dim bSuccess As Boolean bSuccess = ServiceControl(sServiceName, sServerName, SERVICE_CONTROL_PAUSE) ServicePause = bSuccess End Function Private Sub ReleaseServiceHandles(lSCMHandle As Long, lServiceHandle As Long) Dim lSuccess As Long If lSCMHandle > 0 Then lSuccess = CloseServiceHandle(lServiceHandle) End If If lServiceHandle > 0 Then lSuccess = CloseServiceHandle(lSCMHandle) End If End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
