Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!Code-Beispiel
Windows Service Beispiel
| Lizenz: | Erster Autor: | Letzte Bearbeitung: |
| k. A. |  stephanbrunker |  04.08.2017 |
Nicht alle Programme unter Windows laufen als Desktopanwendung unter dem angemeldeten Benutzer, viele Programme laufen im Hintergrund als Dienst / Service auf dem Systemkonto. Microsoft hat hierzu 
ein Beispiel in die MSDN gestellt, das mit C geschrieben ist. Es ist jedoch problemlos möglich, dieses Beispiel auch nach FreeBasic zu übersetzen und es damit als Grundgerüst für die Entwicklung eigener Dienste zu verwenden.
Das Beispiel besteht aus vier Dateien, die in drei ausführbare Dateien und eine Resourcen-DLL kompiliert werden:
- service.bas - enthält den eigentlichen ausführbaren Code des Dienstes und mit der Startoption install wird der Dienst installiert
- servicecontrol.bas - enthält den Code um einen Dienst zu starten, zu beenden und die Berechtigungen zu ändern
- serviceconfig.bas - enthält den Code um einen Dienst zu deaktivieren, aktivieren, löschen, die Beschreibung zu ändern oder den Status abzufragen
- sample.mc - Dieser Punkt geht leider nicht mit Freebasic: Um multilinguale Einträge im Eventlog erzeugen zu können, kann eine Rescourcen-DLL hinterlegt werden, auf die ReportEvent zurückgreift. Diese muss aber mit den Tools aus dem Windows SDK bzw. VisualStudio kompiliert werden.
Ich habe die Beispiele von C nach Freebasic übersetzt. Dabei habe ich lediglich die _tmain Funktion umgeschrieben, da ein FreeBasic-Programm ja keine main()-Routine braucht und für die Auswertung der Kommandozeilenbefehle Command() benutzt. Außerdem habe ich ein klein wenig an den String-Datentypen herumgebastelt und die TSTR durch FB-Strings ersetzt.
Da die sample.mc nicht übersetzbar ist, ist sie hier nicht aufgeführt. Wie man die DLL erzeugt und einbindet, findet man ausführlich z.B. unter: https://www.eventsentry.com/blog/2010/11/creating-your-very-own-event-m.html
Service.bas
'Includes
#Include "windows.bi"
'Global Variables
Const SvcName As String = "myservice"
#Include "event.bi"
Dim Shared As SERVICE_STATUS gSvcStatus
Dim Shared As SERVICE_STATUS_HANDLE gSvcStatusHandle
Dim Shared As HANDLE ghSvcStopEvent = NULL
Declare Sub svcInstall
Declare Sub SvcMain( dwArgc As DWORD, lpszArgv As LPTSTR )
Declare Sub SvcInit( dwArgc As DWORD, lpszArgv As LPTSTR )
Declare Sub ReportSvcStatus( dwCurrentState As DWORD, dwWin32ExitCode As DWORD, dwWaitHint As DWORD )
Declare Sub SvcCtrlHandler( dwCtrl As DWORD )
Declare Sub SvcReportEvent( szFunction As String )
'installs the service
Sub svcInstall
Dim As SC_HANDLE schSCManager
Dim As SC_HANDLE schService
Dim As ZString * MAX_PATH szPath
'get path of the current executable
If GetModuleFilename(NULL, szPath, MAX_PATH) = 0 Then Print "Cannot install Service" : Exit Sub
'connect to the service manager
schSCManager = OpenSCManager( _
NULL, _ ' local computer
NULL, _ ' ServicesActive database
SC_MANAGER_ALL_ACCESS) ' full access rights
If schSCManager = 0 Then Print "Open SCManager failed" : Exit Sub
'Create the service
schService = CreateService( _
schSCManager, _ 'SCM database
SvcName, _ 'name of service
SvcName, _ 'service name to display
SERVICE_ALL_ACCESS, _ 'desired access
SERVICE_WIN32_OWN_PROCESS, _ 'service type
SERVICE_DEMAND_START, _ 'start type
SERVICE_ERROR_NORMAL, _ 'error control type
szPath, _ 'path to service's binary
NULL, _ 'no load ordering group
NULL, _ 'no tag identifier
NULL, _ 'no dependencies
NULL, _ 'LocalSystem account
NULL) 'no password
If schService = 0 Then
Print "CreateService failed"
CloseServiceHandle(schSCManager)
End
Else
Print "Service installed successfully"
EndIf
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
End Sub
'
' Purpose:
' Entry point for the service
'
' Parameters:
' dwArgc - Number of arguments in the lpszArgv array
' lpszArgv - Array of strings. The first string is the name of
' the service and subsequent strings are passed by the process
' that called the StartService function to start the service.
'
' Return value:
' None.
Sub SvcMain( dwArgc As DWORD, lpszArgv As LPTSTR )
'Register the handler function for the service
gSvcStatusHandle = RegisterServiceCtrlHandler( SvcName, @SvcCtrlHandler)
If gSvcStatusHandle = 0 Then
SvcReportEvent("RegisterServiceCtrlHandler")
Exit Sub
EndIf
'These SERVICE_STATUS members remain as set here
gSvcStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS
gSvcStatus.dwServiceSpecificExitCode = 0
'Report initial status to the SCM
ReportSvcStatus( SERVICE_START_PENDING, NO_ERROR, 3000 )
'Perform service-specific initialization and work.
SvcInit( dwArgc, lpszArgv )
End Sub
'
' Purpose:
' The service code
'
' Parameters:
' dwArgc - Number of arguments in the lpszArgv array
' lpszArgv - Array of strings. The first string is the name of
' the service and subsequent strings are passed by the process
' that called the StartService function to start the service.
'
' Return value:
' None
'
Sub SvcInit( dwArgc As DWORD, lpszArgv As LPTSTR )
' TO_DO: Declare and set any required variables.
' Be sure to periodically call ReportSvcStatus() with
' SERVICE_START_PENDING. If initialization fails, call
' ReportSvcStatus with SERVICE_STOPPED.
' Create an event. The control handler function, SvcCtrlHandler,
' signals this event when it receives the stop control code.
ghSvcStopEvent = CreateEvent( _
NULL, _ ' default security attributes
TRUE, _ ' manual reset event
FALSE, _ ' not signaled
NULL) ' no Name
If ghSvcStopEvent = NULL Then ReportSvcStatus( SERVICE_STOPPED, NO_ERROR, 0 ) : Exit Sub
' Report running status when initialization is complete.
ReportSvcStatus( SERVICE_RUNNING, NO_ERROR, 0 )
' TO_DO: Perform work until service stops.
Do
' Check whether to stop the service.
WaitForSingleObject(ghSvcStopEvent, INFINITE)
ReportSvcStatus( SERVICE_STOPPED, NO_ERROR, 0 )
Exit Sub
Loop
End Sub
'
' Purpose:
' Sets the current service status and reports it to the SCM.
'
' Parameters:
' dwCurrentState - The current state (see SERVICE_STATUS)
' dwWin32ExitCode - The system error code
' dwWaitHint - Estimated time for pending operation,
' in milliseconds
'
' Return value:
' None
'
Sub ReportSvcStatus( dwCurrentState As DWORD, dwWin32ExitCode As DWORD, dwWaitHint As DWORD )
Const dwCheckPoint As DWORD = 1
' Fill in the SERVICE_STATUS structure.
With gSvcStatus
.dwCurrentState = dwCurrentState
.dwWin32ExitCode = dwWin32ExitCode
.dwWaitHint = dwWaitHint
End With
If dwCurrentState = SERVICE_START_PENDING Then
gSvcStatus.dwControlsAccepted = 0
Else
gSvcStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP
EndIf
If dwCurrentState = SERVICE_RUNNING Or dwCurrentState = SERVICE_STOPPED Then
gSvcStatus.dwCheckPoint = 0
Else
gSvcStatus.dwCheckPoint = dwCheckPoint + 1
EndIf
' Report the status of the service to the SCM.
SetServiceStatus( gSvcStatusHandle, @gSvcStatus )
End Sub
'
' Purpose:
' Called by SCM whenever a control code is sent to the service
' using the ControlService function.
'
' Parameters:
' dwCtrl - control code
'
' Return value:
' None
'
Sub SvcCtrlHandler( dwCtrl As DWORD )
' Handle the requested control code.
Select Case dwCtrl
Case SERVICE_CONTROL_STOP
ReportSvcStatus(SERVICE_STOP_PENDING, NO_ERROR, 0)
' Signal the service to stop.
SetEvent(ghSvcStopEvent)
ReportSvcStatus(gSvcStatus.dwCurrentState, NO_ERROR, 0)
Exit Sub
Case SERVICE_CONTROL_INTERROGATE
Case Else
End Select
End Sub
'
' Purpose:
' Logs messages to the event log
'
' Parameters:
' szFunction - name of function that failed
'
' Return value:
' None
'
' Remarks:
' The service must have an entry in the Application event log.
'
Sub SvcReportEvent( szFunction As String )
Dim hEventSource As HANDLE
Dim szStrings(0 to 1) as ZString * 80
Dim lpszStrings As LPCTSTR Ptr = Cast(LPCTSTR Ptr,@szStrings(0))
'hEventSource = RegisterEventSource(NULL, SvcName)
If hEventSource <> 0 Then
szStrings(1) = szFunction & " failed with " & GetLastError()
szStrings(0) = SvcName
ReportEvent(hEventSource, _ ' event log handle
EVENTLOG_ERROR_TYPE, _ ' event type
0, _ ' event category
SVC_ERROR, _ ' event identifier
NULL, _ ' no security identifier
2, _ ' size of lpszStrings array
0, _ ' no binary data
lpszStrings, _ ' array of strings
NULL) ' no binary data
DeregisterEventSource(hEventSource)
EndIf
End Sub
'================================================
' ENTRY POINT
'================================================
'
' Purpose:
' Entry point for the process
'
' Parameters:
' None
'
' Return value:
' None
'
'Check for commandline options
If InStr(Command(1),"install") Then svcInstall
'Add any additional services for the process to this table
ReDim DispatchTable ( 0 To 1 ) As SERVICE_TABLE_ENTRY
With DispatchTable(0)
.lpServiceName = @SvcName
.lpServiceProc = Cast(LPSERVICE_MAIN_FUNCTION,@SvcMain)
End With
With DispatchTable(1)
.lpServiceName = NULL
.lpServiceProc = NULL
End With
If StartServiceCtrlDispatcher(@DispatchTable(0)) = 0 Then
SvcReportEvent("StartServiceCtrlDispatcher")
EndIf
End
servicecontrol.bas
'Includes
#Include "windows.bi"
#Include "win\aclapi.bi"
'Global Variables
Dim Shared SvcName As String
Declare Sub DisplayUsage
Declare Sub DoStartSvc
Declare Sub DoUpdateSvcDacl
Declare Sub DoStopSvc
Declare Function StopDependentServices() As BOOL
Sub DisplayUsage
Print "Description:"
Print " Command-Line tool that controls a service"
Print ""
Print "Usage:"
Print " svccontrol [command] [service_name]"
Print ""
Print " [command]"
Print " start"
Print " dacl"
Print " stop"
End Sub
'
' Purpose:
' Starts the service if possible.
'
' Parameters:
' None
'
' Return value:
' None
'
Sub DoStartSvc
Dim As SC_HANDLE schSCManager
Dim As SC_HANDLE schService
Dim As SERVICE_STATUS_PROCESS ssStatus
Dim As DWORD dwOldCheckPoint
Dim As DWORD dwStartTickCount
Dim As DWORD dwWaitTime
Dim As DWORD dwBytesNeeded
'Get a handle to the SCM database
schSCManager = OpenSCManager( _
NULL, _ ' local computer
NULL, _ ' ServicesActive database
SC_MANAGER_ALL_ACCESS) ' full access rights
If schSCManager = 0 Then
Print "Open schSCManager failed (" & GetLastError() & ")" : Exit Sub
EndIf
'Get a handle to the service
schService = OpenService( _
schSCManager, _ ' SCM database
SvcName, _ ' name of Service
SERVICE_ALL_ACCESS) ' full access
If schService = 0 Then
Print "OpenService failed (" & GetLastError() & ")"
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
' Check the status in case the service is not stopped.
If QueryServiceStatusEx( _
schService, _ ' handle to service
SC_STATUS_PROCESS_INFO, _ ' information level
CPtr(Byte Ptr, @ssStatus), _ ' address of structure
SizeOf(SERVICE_STATUS_PROCESS), _ ' size of structure
@dwBytesNeeded ) _ ' size needed if buffer is too small
= FALSE Then
Print "QueryServiceStatusEx failed (" & GetLastError() & ")"
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
' Check if the service is already running. It would be possible
' to stop the service here, but for simplicity this example just returns.
If ssStatus.dwCurrentState <> SERVICE_STOPPED And ssStatus.dwCurrentState <> SERVICE_STOP_PENDING Then
Print "Cannot start the service because it is already running"
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
' Save the tick count and initial checkpoint.
dwStartTickCount = GetTickCount()
dwOldCheckPoint = ssStatus.dwCheckPoint
' Wait for the service to stop before attempting to start it.
While ssStatus.dwCurrentState = SERVICE_STOP_PENDING
' Do not wait longer than the wait hint. A good interval is
' one-tenth of the wait hint but not less than 1 second
' and not more than 10 seconds.
dwWaitTime = ssStatus.dwWaitHint / 10
If dwWaitTime < 1000 Then
dwWaitTime = 1000
ElseIf dwWaitTime > 10000 Then
dwWaitTime = 10000
EndIf
Sleep dwWaitTime
' Check the status until the service is no longer stop pending.
If QueryServiceStatusEx( _
schService, _ ' handle to service
SC_STATUS_PROCESS_INFO, _ ' information level
CPtr (Byte Ptr, @ssStatus), _ ' address of structure
SizeOf(SERVICE_STATUS_PROCESS), _ ' size of structure
@dwBytesNeeded ) _ ' size needed if buffer is too small
= FALSE Then
Print "QueryServiceStatusEx failed (" & GetLastError() & ")"
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
If ssStatus.dwCheckPoint > dwOldCheckPoint Then
' Continue to wait and check.
dwStartTickCount = GetTickCount()
dwOldCheckPoint = ssStatus.dwCheckPoint
Else
If GetTickCount() - dwStartTickCount > ssStatus.dwWaitHint Then
Print "Timeout waiting for service to stop"
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
EndIf
Wend
' Attempt to start the service.
If StartService( _
schService, _ ' handle to service
0, _ ' number of arguments
NULL) _ ' no arguments
= FALSE Then
Print "StartService failed (" & GetLastError() & ")"
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
Exit Sub
Else
Print "Service start pending..."
EndIf
' Check the status until the service is no longer start pending.
If QueryServiceStatusEx( _
schService, _ ' handle to service
SC_STATUS_PROCESS_INFO, _ ' info level
CPtr (Byte Ptr, @ssStatus), _ ' address of structure
SizeOf(SERVICE_STATUS_PROCESS), _ ' size of structure
@dwBytesNeeded ) _ ' if buffer too small
= FALSE Then
Print "QueryServiceStatusEx failed (" & GetLastError() & ")"
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
' Save the tick count and initial checkpoint.
dwStartTickCount = GetTickCount()
dwOldCheckPoint = ssStatus.dwCheckPoint
While ssStatus.dwCurrentState = SERVICE_START_PENDING
' Do not wait longer than the wait hint. A good interval is
' one-tenth the wait hint, but no less than 1 second and no
' more than 10 seconds.
dwWaitTime = ssStatus.dwWaitHint / 10
If dwWaitTime < 1000 Then
dwWaitTime = 1000
ElseIf dwWaitTime > 10000 Then
dwWaitTime = 10000
EndIf
Sleep( dwWaitTime )
' Check the status again.
If QueryServiceStatusEx( _
schService, _ ' handle to service
SC_STATUS_PROCESS_INFO, _ ' info level
CPtr (Byte Ptr, @ssStatus), _ ' address of structure
SizeOf(SERVICE_STATUS_PROCESS), _ ' size of structure
@dwBytesNeeded ) _ ' if buffer too small
= FALSE Then
Print "QueryServiceStatusEx failed (" & GetLastError() & ")"
Exit While
EndIf
If ssStatus.dwCheckPoint > dwOldCheckPoint Then
' Continue to wait and check.
dwStartTickCount = GetTickCount()
dwOldCheckPoint = ssStatus.dwCheckPoint
Else
If GetTickCount() - dwStartTickCount > ssStatus.dwWaitHint Then
' No progress made within the wait hint.
Exit While
EndIf
EndIf
Wend
' Determine whether the service is running.
If ssStatus.dwCurrentState = SERVICE_RUNNING Then
Print "Service started successfully."
Else
Print "Service not started."
Print " Current State: " & ssStatus.dwCurrentState
Print " Exit Code: " & ssStatus.dwWin32ExitCode
Print " Check Point: " & ssStatus.dwCheckPoint
Print " Wait Hint: " & ssStatus.dwWaitHint
EndIf
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
End Sub
'
' Purpose:
' Updates the service DACL to grant start, stop, delete, and read
' control access to the Guest account.
'
' Parameters:
' None
'
' Return value:
' None
'
Sub DoUpdateSvcDacl
Dim As SC_HANDLE schSCManager
Dim As SC_HANDLE schService
Dim As EXPLICIT_ACCESS ea
Dim As SECURITY_DESCRIPTOR sd
Dim As PSECURITY_DESCRIPTOR psd = NULL
Dim As PACL pacl = NULL
Dim As PACL pNewAcl = NULL
Dim As BOOL bDaclPresent = FALSE
Dim As BOOL bDaclDefaulted = FALSE
Dim As DWORD dwError = 0
Dim As DWORD dwSize = 0
Dim As DWORD dwBytesNeeded = 0
' Get a handle to the SCM database.
schSCManager = OpenSCManager( _
NULL, _ ' local computer
NULL, _ ' ServicesActive database
SC_MANAGER_ALL_ACCESS) ' full access rights
If schSCManager = NULL Then
Print "OpenSCManager failed (" & GetLastError() & ")"
Exit Sub
EndIf
' Get a handle to the service
schService = OpenService( _
schSCManager, _ ' SCManager database
SvcName, _ ' name of service
READ_CONTROL Or WRITE_DAC) ' access
If schService = NULL Then
Print "OpenService failed (" & GetLastError() & ")"
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
' Get the current security descriptor.
If QueryServiceObjectSecurity( _
schService, _
DACL_SECURITY_INFORMATION, _
@psd, _ ' using NULL does not work on all versions
0, _
@dwBytesNeeded ) = FALSE Then
If GetLastError() = ERROR_INSUFFICIENT_BUFFER Then
dwSize = dwBytesNeeded
psd = Cast (PSECURITY_DESCRIPTOR, HeapAlloc( _
GetProcessHeap(), HEAP_ZERO_MEMORY, dwSize) )
If psd = NULL Then
' Note: HeapAlloc does not support GetLastError.
Print "HeapAlloc failed"
GoTo dacl_cleanup
EndIf
If QueryServiceObjectSecurity(schService, _
DACL_SECURITY_INFORMATION, _
psd, _
dwSize, _
@dwBytesNeeded)= FALSE Then
Print "QueryServiceObjectSecurity failed (" & GetLastError() & ")"
GoTo dacl_cleanup
EndIf
Else
Print "QueryServiceObjectSecurity failed (" & GetLastError() & ")"
GoTo dacl_cleanup
EndIf
EndIf
' Get the DACL.
If GetSecurityDescriptorDacl( _
psd, _
@bDaclPresent, _
@pacl, _
@bDaclDefaulted) = FALSE Then
Print "GetSecurityDescriptorDacl failed(" & GetLastError() & ")"
GoTo dacl_cleanup
EndIf
' Build the ACE.
BuildExplicitAccessWithName( _
@ea, _
@"GUEST", _ 'insert a valid Windows User name here
SERVICE_START Or SERVICE_STOP Or READ_CONTROL Or DELETE__, _
SET_ACCESS, _
NO_INHERITANCE)
dwError = SetEntriesInAcl(1, @ea, pacl, @pNewAcl)
If dwError <> ERROR_SUCCESS Then
Print "SetEntriesInAcl failed (" & dwError & ")"
GoTo dacl_cleanup
EndIf
' Initialize a new security descriptor.
If InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION) = FALSE Then
Print "InitializeSecurityDescriptor failed(" & GetLastError() & ")"
GoTo dacl_cleanup
EndIf
' Set the new DACL in the security descriptor.
If SetSecurityDescriptorDacl(@sd, TRUE, pNewAcl, FALSE) = FALSE Then
Print "SetSecurityDescriptorDacl failed(" & GetLastError() & ")"
GoTo dacl_cleanup
EndIf
' Set the new DACL for the service object.
If SetServiceObjectSecurity( schService, DACL_SECURITY_INFORMATION, @sd ) = FALSE Then
Print "SetServiceObjectSecurity failed(" & GetLastError() & ")"
GoTo dacl_cleanup
Else
Print "Service DACL updated successfully"
EndIf
dacl_cleanup:
CloseServiceHandle(schSCManager)
CloseServiceHandle(schService)
If pNewAcl <> NULL Then LocalFree( Cast(HLOCAL,pNewAcl))
If psd <> NULL Then HeapFree(GetProcessHeap(), 0, Cast(LPVOID,psd) )
End Sub
'
' Purpose:
' Stops the service.
'
' Parameters:
' None
'
' Return value:
' None
'
Sub DoStopSvc
Dim As SC_HANDLE schSCManager
Dim As SC_HANDLE schService
Dim As SERVICE_STATUS_PROCESS ssp
Dim As DWORD dwStartTime = GetTickCount()
Dim As DWORD dwBytesNeeded
Dim As DWORD dwTimeout = 30000 ' 30-second time-out
Dim As DWORD dwWaitTime
' Get a handle to the SCM database.
schSCManager = OpenSCManager( _
NULL, _ ' local computer
NULL, _ ' ServicesActive database
SC_MANAGER_ALL_ACCESS) ' full access rights
If schSCManager = NULL Then
Print "OpenSCManager failed (" & GetLastError() & ")"
Exit Sub
EndIf
' Get a handle to the service.
schService = OpenService( _
schSCManager, _ ' SCM database
SvcName, _ ' name of service
SERVICE_STOP Or SERVICE_QUERY_STATUS Or SERVICE_ENUMERATE_DEPENDENTS)
If schService = NULL Then
Print "OpenService failed (" & GetLastError() & ")"
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
' Make sure the service is not already stopped.
If QueryServiceStatusEx( _
schService, _
SC_STATUS_PROCESS_INFO, _
CPtr(Byte Ptr, @ssp), _
SizeOf(SERVICE_STATUS_PROCESS), _
@dwBytesNeeded ) = FALSE Then
Print "QueryServiceStatusEx failed (" & GetLastError() & ")"
GoTo stop_cleanup
EndIf
If ssp.dwCurrentState = SERVICE_STOPPED Then
Print "Service is already stopped."
GoTo stop_cleanup
EndIf
' If a stop is pending, wait for it.
While ssp.dwCurrentState = SERVICE_STOP_PENDING
Print "Service stop pending..."
' Do not wait longer than the wait hint. A good interval is
' one-tenth of the wait hint but not less than 1 second
' and not more than 10 seconds.
dwWaitTime = ssp.dwWaitHint / 10
If dwWaitTime < 1000 Then
dwWaitTime = 1000
ElseIf dwWaitTime > 10000 Then
dwWaitTime = 10000
EndIf
Sleep ( dwWaitTime )
If QueryServiceStatusEx( _
schService, _
SC_STATUS_PROCESS_INFO, _
CPtr(Byte Ptr, @ssp), _
SizeOf(SERVICE_STATUS_PROCESS), _
@dwBytesNeeded ) = FALSE Then
Print "QueryServiceStatusEx failed (" & GetLastError() & ")"
GoTo stop_cleanup
EndIf
If ssp.dwCurrentState = SERVICE_STOPPED Then
Print "Service stopped successfully."
GoTo stop_cleanup
EndIf
If GetTickCount() - dwStartTime > dwTimeout Then
Print "Service stop timed out."
GoTo stop_cleanup
EndIf
Wend
' If the service is running, dependencies must be stopped first.
StopDependentServices()
' Send a stop code to the service.
If ControlService( _
schService, _
SERVICE_CONTROL_STOP, _
Cast(LPSERVICE_STATUS, @ssp )) = FALSE Then
Print "ControlService failed (" & GetLastError() & ")"
GoTo stop_cleanup
EndIf
' Wait for the service to stop.
While ssp.dwCurrentState <> SERVICE_STOPPED
Sleep( ssp.dwWaitHint )
If QueryServiceStatusEx( _
schService, _
SC_STATUS_PROCESS_INFO, _
CPtr(Byte Ptr,@ssp), _
SizeOf(SERVICE_STATUS_PROCESS), _
@dwBytesNeeded ) = FALSE Then
Print "QueryServiceStatusEx failed (" & GetLastError() & ")"
GoTo stop_cleanup
EndIf
If ssp.dwCurrentState = SERVICE_STOPPED Then GoTo stop_cleanup
If GetTickCount() - dwStartTime > dwTimeout Then
Print "Wait timed out"
GoTo stop_cleanup
EndIf
Wend
Print "Service stopped successfully"
stop_cleanup:
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
End Sub
Function StopDependentServices() As BOOL
Dim As SC_HANDLE schSCManager
Dim As SC_HANDLE schService
Dim As ULong i
Dim As DWORD dwBytesNeeded
Dim As DWORD dwCount
Dim As LPENUM_SERVICE_STATUS lpDependencies = NULL
Dim As ENUM_SERVICE_STATUS ess
Dim As SC_HANDLE hDepService
Dim As SERVICE_STATUS_PROCESS ssp
Dim As DWORD dwStartTime = GetTickCount()
Dim As DWORD dwTimeout = 30000 ' 30-second time-out
Dim result As BOOL = TRUE
' Pass a zero-length buffer to get the required buffer size.
If EnumDependentServices( _
schService, _
SERVICE_ACTIVE, _
lpDependencies, _
0, _
@dwBytesNeeded, _
@dwCount ) Then
' If the Enum call succeeds, then there are no dependent
' services, so do nothing.
Return TRUE
Else
If GetLastError() <> ERROR_MORE_DATA Then Return FALSE ' Unexpected error
' Allocate a buffer for the dependencies.
lpDependencies = Cast(LPENUM_SERVICE_STATUS, _
HeapAlloc( GetProcessHeap(), HEAP_ZERO_MEMORY, dwBytesNeeded ))
If lpDependencies = 0 Then Return FALSE
' Enumerate the dependencies.
If EnumDependentServices( _
schService, SERVICE_ACTIVE, _
lpDependencies, dwBytesNeeded, @dwBytesNeeded, @dwCount ) Then
For i = 0 To dwCount
ess = *(lpDependencies + i)
' Open the service.
hDepService = OpenService( _
schSCManager, ess.lpServiceName, SERVICE_STOP Or SERVICE_QUERY_STATUS )
If hDepService Then
' Send a stop code.
If ControlService( hDepService, _
SERVICE_CONTROL_STOP, _
Cast(LPSERVICE_STATUS, @ssp ) ) Then
' Wait for the service to stop.
While ssp.dwCurrentState <> SERVICE_STOPPED
Sleep( ssp.dwWaitHint )
If QueryServiceStatusEx( _
hDepService, _
SC_STATUS_PROCESS_INFO, _
CPtr( Byte Ptr, @ssp), _
SizeOf(SERVICE_STATUS_PROCESS), _
@dwBytesNeeded ) = FALSE Then result = FALSE : Exit While
If ssp.dwCurrentState = SERVICE_STOPPED Then Exit While
If GetTickCount() - dwStartTime > dwTimeout Then result = FALSE : Exit While
Wend
Else
result = FALSE
End If
' Always release the service handle.
CloseServiceHandle( hDepService )
Else
result = FALSE
End If
If result = FALSE Then Exit For
Next i
Else
result = FALSE
EndIf
' Always free the enumeration buffer.
HeapFree( GetProcessHeap(), 0, lpDependencies )
EndIf
If result = FALSE Then
Return FALSE
Else
Return TRUE
EndIf
End Function
'================================================
' ENTRY POINT
'================================================
'
' Purpose:
' Entry point function. Executes specified command from user.
'
' Parameters:
' Command-line syntax is: svccontrol [command] [service_name]
'
' Return value:
' None
'
Print ""
'Check for commandline options
If Command(1) = "" Or Command(2) = "" Or Command(3) <> "" Then
Print "Error:", "Incorrect number of arguments"
Print ""
Print ""
DisplayUsage
EndIf
SvcName = Command(2)
If InStr(Command(1),"start") Then
DoStartSvc()
ElseIf InStr(Command(1),"dacl") Then
DoUpdateSvcDacl()
ElseIf InStr(Command(1),"stop") Then
DoStopSvc()
Else
Print "Unknown command (" & Command(1) & ")"
Print ""
Print ""
DisplayUsage
EndIf
End
serviceconfig.bas
'Includes
#Include "windows.bi"
'Global Variables
Dim Shared SvcName As String
Declare Sub DisplayUsage
Declare Sub DoQuerySvc
Declare Sub DoDisableSvc
Declare Sub DoEnableSvc
Declare Sub DoUpdateSvc
Declare Sub DoDeleteSvc
Sub DisplayUsage
Print "Description:"
Print " Command-Line tool that configures a service"
Print ""
Print "Usage:"
Print " svcconfig [command] [service_name]"
Print ""
Print " [command]"
Print " query"
Print " describe"
Print " disable"
Print " enable"
Print " delete"
End Sub
'
' Purpose:
' Retrieves and displays the current service configuration.
'
' Parameters:
' None
'
' Return value:
' None
'
Sub DoQuerySvc
Dim As SC_HANDLE schSCManager
Dim As SC_HANDLE schService
Dim As LPQUERY_SERVICE_CONFIG lpsc
Dim As LPSERVICE_DESCRIPTION lpsd
Dim As DWORD dwBytesNeeded, cbBufSize, dwError
'Get a handle to the SCM database
schSCManager = OpenSCManager( _
NULL, _ ' local computer
NULL, _ ' ServicesActive database
SC_MANAGER_ALL_ACCESS) ' full access rights
If schSCManager = 0 Then
Print "Open schSCManager failed (" & GetLastError() & ")" : Exit Sub
EndIf
'Get a handle to the service
schService = OpenService( _
schSCManager, _ ' SCM database
SvcName, _ ' name of Service
SERVICE_QUERY_CONFIG) ' need query config access
If schService = 0 Then
Print "OpenService failed " & GetLastError()
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
'Get the configuration information
If QueryServiceConfig( schService, NULL, 0, @dwBytesNeeded) = FALSE Then
dwError = GetLastError()
If ERROR_INSUFFICIENT_BUFFER = dwError Then
cbBufSize = dwBytesNeeded
lpsc = Cast(LPQUERY_SERVICE_CONFIG, LocalAlloc(LMEM_FIXED, cbBufSize))
Else
Print "QueryServiceConfig failed " & dwError
GoTo cleanup
EndIf
EndIf
If QueryServiceConfig( schService, lpsc, cbBufSize, @dwBytesNeeded) = FALSE Then
Print "QueryServiceConfig failed (" & GetLastError() & ")"
GoTo cleanup
EndIf
If QueryServiceConfig2(schService, SERVICE_CONFIG_DESCRIPTION, NULL, 0, @dwBytesNeeded) = FALSE Then
dwError = GetLastError()
If ERROR_INSUFFICIENT_BUFFER = dwError Then
cbBufSize = dwBytesNeeded
lpsd = Cast(LPSERVICE_DESCRIPTION, LocalAlloc(LMEM_FIXED, cbBufSize))
Else
Print "QueryServiceConfig2 failed " & dwError
GoTo cleanup
EndIf
EndIf
If QueryServiceConfig2(schService, SERVICE_CONFIG_DESCRIPTION, CPtr(LPBYTE, lpsd), cbBufSize, @dwBytesNeeded) = FALSE Then
Print "QueryServiceConfig2 failed (" & GetLastError() & ")"
GoTo cleanup
EndIf
'Print the configuration information
Print ServiceName & " configuration: "
Print " Type: 0x" & Hex(lpsc->dwServiceType)
Print " StartType: 0x" & Hex(lpsc->dwStartType)
Print " ErrorControl: 0x" & Hex(lpsc->dwErrorControl)
Print " Binary Path: " & *lpsc->lpBinaryPathName
Print " Account:" & *lpsc->lpServiceStartName
If lpsd->lpDescription <> NULL And *lpsd->lpDescription <> "" Then
Print " Description: " & *lpsd->lpDescription
EndIf
If lpsc->lpLoadOrderGroup <> NULL And *lpsc->lpLoadOrderGroup <> "" Then
Print " Load order group: " & *lpsc->lpLoadOrderGroup
EndIf
If lpsc->dwTagId <> 0 Then
Print " Tag ID: " & lpsc->dwTagId
EndIf
If lpsc->lpDependencies <> NULL And *lpsc->lpDependencies <> "" Then
Print " Dependencies: " & *lpsc->lpDependencies
EndIf
cleanup:
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
End Sub
'
' Purpose
' Disables the service
'
' Parameters:
' None
'
' Return value:
' None
'
Sub DoDisableSvc
Dim As SC_HANDLE schSCManager
Dim As SC_HANDLE schService
'Get a handle to the SCM database
schSCManager = OpenSCManager( _
NULL, _ ' local computer
NULL, _ ' ServicesActive database
SC_MANAGER_ALL_ACCESS) ' full access rights
If schSCManager = 0 Then
Print "Open schSCManager failed (" & GetLastError() & ")" : Exit Sub
EndIf
'Get a handle to the service
schService = OpenService( _
schSCManager, _ ' SCM database
SvcName, _ ' name of Service
SERVICE_CHANGE_CONFIG) ' need query config access
If schService = 0 Then
Print "OpenService failed (" & GetLastError() & ")"
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
' Change the service start type.
If ChangeServiceConfig( _
schService, _ ' handle of service
SERVICE_NO_CHANGE, _' service type: no change
SERVICE_DISABLED, _ ' service start type
SERVICE_NO_CHANGE, _' error control: no change
NULL, _ ' binary path: no change
NULL, _ ' load order group: no change
NULL, _ ' tag ID: no change
NULL, _ ' dependencies: no change
NULL, _ ' account name: no change
NULL, _ ' password: no change
NULL) = FALSE Then ' display name: no change
Print "ChangeServiceConfig failed (" & GetLastError() & ")"
Else
Print "Service disabled successfully."
EndIf
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
End Sub
'
' Purpose:
' Enables the service.
'
' Parameters:
' None
'
' Return value:
' None
'
Sub DoEnableSvc
Dim As SC_HANDLE schSCManager
Dim As SC_HANDLE schService
'Get a handle to the SCM database
schSCManager = OpenSCManager( _
NULL, _ ' local computer
NULL, _ ' ServicesActive database
SC_MANAGER_ALL_ACCESS) ' full access rights
If schSCManager = 0 Then
Print "Open schSCManager failed (" & GetLastError() & ")" : Exit Sub
EndIf
'Get a handle to the service
schService = OpenService( _
schSCManager, _ ' SCM database
SvcName, _ ' name of Service
SERVICE_CHANGE_CONFIG) ' need query config access
If schService = 0 Then
Print "OpenService failed (" & GetLastError() & ")"
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
' Change the service start type.
If ChangeServiceConfig( _
schService, _ ' handle of service
SERVICE_NO_CHANGE, _ ' service type: no change
SERVICE_DEMAND_START, _ ' service start type
SERVICE_NO_CHANGE, _ ' error control: no change
NULL, _ ' binary path: no change
NULL, _ ' load order group: no change
NULL, _ ' tag ID: no change
NULL, _ ' dependencies: no change
NULL, _ ' account name: no change
NULL, _ ' password: no change
NULL) _ ' display name: no change
= FALSE Then
Print "ChangeServiceConfig failed (" & GetLastError() & ")"
Else
Print "Service enabled successfully."
EndIf
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
End Sub
'
' Purpose:
' Updates the service description to "This is a test description".
'
' Parameters:
' None
'
' Return value:
' None
'
Sub DoUpdateSvcDesc
Dim As SC_HANDLE schSCManager
Dim As SC_HANDLE schService
Dim As SERVICE_DESCRIPTION sd
Dim As LPTSTR szDesc = @"This is a test description"
'Get a handle to the SCM database
schSCManager = OpenSCManager( _
NULL, _ ' local computer
NULL, _ ' ServicesActive database
SC_MANAGER_ALL_ACCESS) ' full access rights
If schSCManager = 0 Then
Print "Open schSCManager failed (" & GetLastError() & ")" : Exit Sub
EndIf
'Get a handle to the service
schService = OpenService( _
schSCManager, _ ' SCM database
SvcName, _ ' name of Service
SERVICE_CHANGE_CONFIG) ' need query config access
If schService = 0 Then
Print "OpenService failed (" & GetLastError() & ")"
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
' Change the service description.
sd.lpDescription = szDesc
If ChangeServiceConfig2( _
schService, _ ' handle to service
SERVICE_CONFIG_DESCRIPTION, _ ' change: description
@sd) _ ' new description
= FALSE Then
Print "ChangeServiceConfig2 failed"
Else
Print "Service description updated successfully."
EndIf
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
End Sub
'
' Purpose:
' Deletes a service from the SCM database
'
' Parameters:
' None
'
' Return value:
' None
'
Sub DoDeleteSvc
Dim As SC_HANDLE schSCManager
Dim As SC_HANDLE schService
'Get a handle to the SCM database
schSCManager = OpenSCManager( _
NULL, _ ' local computer
NULL, _ ' ServicesActive database
SC_MANAGER_ALL_ACCESS) ' full access rights
If schSCManager = 0 Then
Print "Open schSCManager failed (" & GetLastError() & ")" : Exit Sub
EndIf
'Get a handle to the service
schService = OpenService( _
schSCManager, _ ' SCM database
SvcName, _ ' name of Service
DELETE__) ' need query config access
If schService = 0 Then
Print "OpenService failed (" & GetLastError() & ")"
CloseServiceHandle(schSCManager)
Exit Sub
EndIf
' Delete the service.
If DeleteService(schService) = FALSE Then
Print "DeleteService failed (" & GetLastError() & ")"
Else
Print "Service deleted successfully"
EndIf
CloseServiceHandle(schService)
CloseServiceHandle(schSCManager)
End Sub
'================================================
' ENTRY POINT
'================================================
'
' Purpose:
' Entry point function. Executes specified command from user.
'
' Parameters:
' Command-line syntax is: svcconfig [command] [service_path]
'
' Return value:
' None
'
Print ""
'Check for commandline options
If Command(1) = "" Or Command(2) = "" Or Command(3) <> "" Then
Print "Error: " & "Incorrect number of arguments"
Print ""
Print ""
DisplayUsage
EndIf
SvcName = Command(2)
If InStr(Command(1),"query") Then
DoQuerySvc()
ElseIf InStr(Command(1),"describe") Then
DoUpdateSvcDesc()
ElseIf InStr(Command(1),"disable") Then
DoDisableSvc()
ElseIf InStr(Command(1),"enable") Then
DoEnableSvc()
ElseIf InStr(Command(1),"delete") Then
DoDeleteSvc()
Else
Print "Unknown command (" & Command(1) & ")"
Print ""
Print ""
DisplayUsage
EndIf
End
| Zusätzliche Informationen und Funktionen | |||||||
|---|---|---|---|---|---|---|---|
|
|
||||||
Bearbeiten
Versionen