XProfan

; English forum:
; Author: Richard Eikeland
; Date: 12. April 2003
; angepaßt an 3.93 ts-soft
; Apr. 12, 2003
; Converted to PB by Richard Eikeland
; This code is posted as is with out any waranties.
;
#SERVICE_WIN32_OWN_PROCESS = $10
#SERVICE_WIN32_SHARE_PROCESS = $20
#SERVICE_WIN32 = #SERVICE_WIN32_OWN_PROCESS + #SERVICE_WIN32_SHARE_PROCESS
#SERVICE_ACCEPT_STOP = $1
#SERVICE_ACCEPT_PAUSE_CONTINUE = $2
#SERVICE_ACCEPT_SHUTDOWN = $4
#SC_MANAGER_CONNECT = $1
#SC_MANAGER_CREATE_SERVICE = $2
#SC_MANAGER_ENUMERATE_SERVICE = $4
#SC_MANAGER_LOCK = $8
#SC_MANAGER_QUERY_LOCK_STATUS = $10
#SC_MANAGER_MODIFY_BOOT_CONFIG = $20
#STANDARD_RIGHTS_REQUIRED = $F0000
#SERVICE_QUERY_CONFIG = $1
#SERVICE_CHANGE_CONFIG = $2
#SERVICE_QUERY_STATUS = $4
#SERVICE_ENUMERATE_DEPENDENTS = $8
#SERVICE_START = $10
#SERVICE_STOP = $20
#SERVICE_PAUSE_CONTINUE = $40
#SERVICE_INTERROGATE = $80
#SERVICE_USER_DEFINED_CONTROL = $100
;#SERVICE_ALL_ACCESS = #STANDARD_RIGHTS_REQUIRED | #SERVICE_QUERY_CONFIG | #SERVICE_CHANGE_CONFIG | #SERVICE_QUERY_STATUS | #SERVICE_ENUMERATE_DEPENDENTS | #SERVICE_START | #SERVICE_STOP | #SERVICE_PAUSE_CONTINUE | #SERVICE_INTERROGATE |#SERVICE_USER_DEFINED_CONTROL
#SERVICE_DEMAND_START = $3
#SERVICE_ERROR_NORMAL = $1
;- SERVICE_CONTROL
#SERVICE_CONTROL_STOP = $1
#SERVICE_CONTROL_PAUSE = $2
#SERVICE_CONTROL_CONTINUE = $3
#SERVICE_CONTROL_INTERROGATE = $4
#SERVICE_CONTROL_SHUTDOWN = $5
;-SERVICE_STATE
#SERVICE_STOPPED = $1
#SERVICE_START_PENDING = $2
#SERVICE_STOP_PENDING = $3
#SERVICE_RUNNING = $4
#SERVICE_CONTINUE_PENDING = $5
#SERVICE_PAUSE_PENDING = $6
#SERVICE_PAUSED = $7
Global ServiceStatus.SERVICE_STATUS, hServiceStatus.l, SERVICE_NAME.s, Finish.l
Declare Handler(fdwControl.l)
Declare ServiceMain(dwArgc.l, lpszArgv.l)
Declare WriteLog(Value.s)
Procedure Main()
hSCManager.l
hService.l
ServiceTableEntry.SERVICE_TABLE_ENTRY
b.l
cmd.s
;Change SERVICE_NAME and app name as needed
AppPath.s = "C:DevPureBasicworkdirNTServiceMyService.exe"
SERVICE_NAME = "MyService"
cmd = Trim(LCase(ProgramParameter()))

Select cmd

    Case "install" ;Install service on machine
    hSCManager = OpenSCManager_(0, 0, #SC_MANAGER_CREATE_SERVICE)
    hService = CreateService_(hSCManager, SERVICE_NAME, SERVICE_NAME, #SERVICE_ALL_ACCESS, #SERVICE_WIN32_OWN_PROCESS, #SERVICE_DEMAND_START, #SERVICE_ERROR_NORMAL, AppPath, 0, 0, 0, 0, 0)
    CloseServiceHandle_(hService)
    CloseServiceHandle_(hSCManager)
    Finish = 1
    Case "uninstall" ;Remove service from machine
    hSCManager = OpenSCManager_(0, 0, #SC_MANAGER_CREATE_SERVICE)
    hService = OpenService_(hSCManager, SERVICE_NAME, #SERVICE_ALL_ACCESS)
    DeleteService_(hService)
    CloseServiceHandle_(hService)
    CloseServiceHandle_(hSCManager)
    Finish = 1
    Default
    *sname.s = SERVICE_NAME
    ;Start the service
    ServiceTableEntrylpServiceName = @SERVICE_NAME
    ServiceTableEntrylpServiceProc = @ServiceMain()
    b = StartServiceCtrlDispatcher_(@ServiceTableEntry)
    WriteLog("Starting Service bResult=" + Str(b))

    If b = 0

        Finish = 1

    EndIf

EndSelect

Repeat

Until Finish =1

End
EndProcedure
Procedure Handler(fdwControl.l)
b.l

Select fdwControl

    Case #SERVICE_CONTROL_PAUSE
    ;** Do whatever it takes To pause here.
    ServiceStatusdwCurrentState = #SERVICE_PAUSED
    Case #SERVICE_CONTROL_CONTINUE
    ;** Do whatever it takes To continue here.
    ServiceStatusdwCurrentState = #SERVICE_RUNNING
    Case #SERVICE_CONTROL_STOP
    ServiceStatusdwWin32ExitCode = 0
    ServiceStatusdwCurrentState = #SERVICE_STOP_PENDING
    ServiceStatusdwCheckPoint = 0
    ServiceStatusdwWaitHint = 0 ;Might want a time estimate
    b = SetServiceStatus_(hServiceStatus, ServiceStatus)
    ;** Do whatever it takes to stop here.
    Finish = 1
    ServiceStatusdwCurrentState = #SERVICE_STOPPED
    Case #SERVICE_CONTROL_INTERROGATE
    ;Fall through To send current status.
    Finish = 1
    ;Else

EndSelect

;Send current status.
b = SetServiceStatus_(hServiceStatus, ServiceStatus)
EndProcedure
Procedure ServiceMain(dwArgc.l, lpszArgv.l)
b.l
WriteLog("ServiceMain")
;Set initial state
ServiceStatusdwServiceType = #SERVICE_WIN32_OWN_PROCESS
ServiceStatusdwCurrentState = #SERVICE_START_PENDING
ServiceStatusdwControlsAccepted = #SERVICE_ACCEPT_STOP | #SERVICE_ACCEPT_PAUSE_CONTINUE | #SERVICE_ACCEPT_SHUTDOWN
ServiceStatusdwWin32ExitCode = 0
ServiceStatusdwServiceSpecificExitCode = 0
ServiceStatusdwCheckPoint = 0
ServiceStatusdwWaitHint = 0
hServiceStatus = RegisterServiceCtrlHandler_(SERVICE_NAME, @Handler())
ServiceStatusdwCurrentState = #SERVICE_START_PENDING
b = SetServiceStatus_(hServiceStatus, ServiceStatus)
;** Do Initialization Here
ServiceStatusdwCurrentState = #SERVICE_RUNNING
b = SetServiceStatus_(hServiceStatus, ServiceStatus)
;** Perform tasks -- If none exit
;** If an error occurs the following should be used for shutting
;** down:
; SetServerStatus SERVICE_STOP_PENDING
; Clean up
; SetServerStatus SERVICE_STOPPED
EndProcedure
Procedure WriteLog(Value.s)
sfile.s = "MyServiceLog.txt"

If OpenFile(0, sfile)

    WriteStringN(Value)
    CloseFile(0)

Else

    If CreateFile(0,sfile)

        WriteStringN(Value)
        CloseFile(0)

    EndIf

EndIf

EndProcedure
Main()

 $H windows.ph
 $H Structs.ph
Global ServiceStatus.SERVICE_STATUS, hServiceStatus.l, SERVICE_NAME.s, Finish.l
Declare ServiceStatus# , hServiceStatus&, SERVICE_NAME$, Finish&
Dim ServiceStatus#, ~SERVICE_STATUS
Procedure Handler(fdwControl.l)
b.l

Select fdwControl

    Case #SERVICE_CONTROL_PAUSE
    ;** Do whatever it takes To pause here.
    ServiceStatusdwCurrentState = #SERVICE_PAUSED
    Case #SERVICE_CONTROL_CONTINUE
    ;** Do whatever it takes To continue here.
    ServiceStatusdwCurrentState = #SERVICE_RUNNING
    Case #SERVICE_CONTROL_STOP
    ServiceStatusdwWin32ExitCode = 0
    ServiceStatusdwCurrentState = #SERVICE_STOP_PENDING
    ServiceStatusdwCheckPoint = 0
    ServiceStatusdwWaitHint = 0 ;Might want a time estimate
    b = SetServiceStatus_(hServiceStatus, ServiceStatus)
    ;** Do whatever it takes to stop here.
    Finish = 1
    ServiceStatusdwCurrentState = #SERVICE_STOPPED
    Case #SERVICE_CONTROL_INTERROGATE
    ;Fall through To send current status.
    Finish = 1
    ;Else

EndSelect

;Send current status.
b = SetServiceStatus_(hServiceStatus, ServiceStatus)
EndProcedure

Proc Handler

    Parameters fdwControl&

    If fdwControl& = ~SERVICE_CONTROL_PAUSE

        ** Do whatever it takes To pause here.
        ServiceStatus#.dwCurrentState = ~SERVICE_PAUSED

    ElseIf fdwControl& = ~SERVICE_CONTROL_CONTINUE

        ** Do whatever it takes To continue here.
        ServiceStatus#.dwCurrentState = ~SERVICE_RUNNING

    ElseIf fdwControl& = ~SERVICE_CONTROL_STOP

    ElseIf fdwControl& = ~SERVICE_CONTROL_INTERROGATE

    EndIf

    ~SetServiceStatus(hServiceStatus&, Addr(ServiceStatus#))

EndProc