Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » System

Windows Service Beispiel

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.Mitgliedstephanbrunker 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 Externer Link!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:

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: Externer Link!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
  • Das Code-Beispiel wurde am 04.08.2017 von Mitgliedstephanbrunker angelegt.
  • Die aktuellste Version wurde am 04.08.2017 von Mitgliedstephanbrunker gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen