Pierre
Code: Select all
'***************************************************************************************
'* Windows service (32 bit or 64 bit) *
'* *
'* Asuming you named this compiled code "MyService.exe" *
'* *
'* To install, from a command prompt with admin right, *
'* type "MyService.exe install". The service will install and auto start. *
'* *
'* To uninstall the service, you have to stop it in service manager first, so... *
'* Do "Start"/"Run": "services.msc", this will start the service manager. *
'* or get to it via the Control Panel if you prefer. *
'* Select your service, press "F5" to refresh if your service is non visible. *
'* Double click on your service listview item, A property box will appear. *
'* Click "Stop", and close the dialog box. *
'* Then at the Admin command prompt type "MyService.exe uninstall" *
'* *
'* In order to keep the Windows booting process as light as possible *
'* you may delay the start of the service by selecting the *
'* ServiceDelayed.fDelayedAutostart option in code. *
'* *
'* Now, in the service dialog box, other than "Stop", *
'* you may also play with "Suspend", Start" and "Restart". *
'* *
'* Since a service does not usually interact with the desktop, *
'* if "Debug" constant is set to TRUE in code, *
'* a message will be sent via the OutputDebugString api. *
'* You will get a message for start, stop, pause, and resume. *
'* Plus a "thread is running" message every two seconds. *
'* *
'* To capture such message, use a debug viewer with the "global mode" option enabled. *
'* *
'* OutputDebugString DebugView++ is a Windows Debug Message Viewer... *
'* https://debugviewpp.wordpress.com/2014/01/04/7/ *
'* *
'* Windows Sysinternals DebugView is another one... *
'* https://technet.microsoft.com/en-us/sysinternals/debugview *
'* *
'* Microsoft info: Service Control Manager *
'* https://msdn.microsoft.com/en-us/library/ms685150(VS.85).aspx *
'* *
'* Have fun, *
'* Pierre *
'* *
'***************************************************************************************
#Define JumpCompiler "<D:\Free\64\fbc.exe>"
#Define JumpCompilerCmd "<-s console "D:\Free\bas\~~Default.rc">"
#Lang "fb"
#Define Unicode
#Define _WIN32_WINNT &h0602
#Include Once "Windows.bi"
#Include Once "win\winsvc.bi"
#include once "crt\string.bi" '
Const Debug = TRUE
Const AppName = "MyService"
Const MAX_SERVICE_NAME_LEN = 256
TYPE GlobalType
wsComputerName AS wSTRING * MAX_COMPUTERNAME_LENGTH + 1 '15
wsServiceName AS wSTRING * MAX_SERVICE_NAME_LEN '256
wsServiceDisplayName AS wSTRING * MAX_SERVICE_NAME_LEN '256
wsExeName AS wSTRING * MAX_PATH '260
hServiceStatus AS HANDLE
hInstance AS HINSTANCE
hEvent AS HANDLE
hThread AS HANDLE
CurrentServiceStatus AS DWORD
ServiceIsRunning AS LONG
ServiceIsPaused AS LONG
END TYPE
Dim Shared pg AS GlobalType POINTER
'_____________________________________________________________________________
SUB ServiceStop()
IF Debug THEN OutputDebugString("Service thread stopping at " & TIME$) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
pg->ServiceIsRunning = FALSE 'Set the global flag indicating that the service is not running
SetEvent(pg->hEvent) 'Set the event so the service will stop
END SUB
'_____________________________________________________________________________
FUNCTION ServiceStatusSet(BYVAL CurrentStatus AS DWORD, BYVAL ExitCode AS DWORD, ServiceSpecificExitCode AS LONG, _
BYVAL Checkpoint AS DWORD, BYVAL WaitHint AS DWORD) AS LONG
Dim ServiceStatus AS SERVICE_STATUS
ServiceStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS 'Setup the UDT.
ServiceStatus.dwCurrentState = CurrentStatus
IF CurrentStatus = SERVICE_START_PENDING THEN
ServiceStatus.dwControlsAccepted = 0
ELSE
ServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP OR SERVICE_ACCEPT_PAUSE_CONTINUE OR SERVICE_ACCEPT_SHUTDOWN
END IF
IF ServiceSpecificExitCode = 0 THEN
ServiceStatus.dwWin32ExitCode = ExitCode
ELSE
ServiceStatus.dwWin32ExitCode = ERROR_SERVICE_SPECIFIC_ERROR
END IF
ServiceStatus.dwServiceSpecificExitCode = ServiceSpecificExitCode 'Specific Exit Code
ServiceStatus.dwCheckPoint = Checkpoint
ServiceStatus.dwWaitHint = WaitHint
IF SetServiceStatus(pg->hServiceStatus, @ServiceStatus) THEN
FUNCTION = TRUE
ELSE 'Something went wrong so stop the service
ServiceStop
END IF
END FUNCTION
'_____________________________________________________________________________
SUB ServiceTerminate(ErrorCode AS DWORD)
IF pg->hEvent THEN
CloseHandle(pg->hEvent)
END IF
IF pg->hServiceStatus THEN
ServiceStatusSet(SERVICE_STOPPED, ErrorCode, 0, 0, 0)
END IF
IF pg->hThread THEN
CloseHandle(pg->hThread)
END IF
END SUB
'_____________________________________________________________________________
SUB ServicePause()
IF Debug THEN OutputDebugString("Service thread paused at " & TIME$ ) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
pg->ServiceIsPaused = TRUE 'Set the global indicating that we are paused
SuspendThread(pg->hThread)
END SUB
'_____________________________________________________________________________
SUB ServiceResume()
IF Debug THEN OutputDebugString("Service thread resuming at " & TIME$ ) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
pg->ServiceIsPaused = FALSE 'Set the global indicating that we are not paused
ResumeThread(pg->hThread)
END SUB
'_____________________________________________________________________________
SUB ServiceStopRaw() 'Use when a service have to end by itself
Dim ServiceStat AS SERVICE_STATUS
Dim hServiceControlManager AS HANDLE
Dim hService AS HANDLE
hServiceControlManager = OpenSCManager(pg->wsComputerName, BYVAL NULL, SC_MANAGER_CREATE_SERVICE)
IF hServiceControlManager THEN 'OK, we have a handle to the SCM. Now open our service.
hService = OpenService(hServiceControlManager, pg->wsServiceName, SERVICE_ALL_ACCESS)
IF hService THEN
ControlService(hService, SERVICE_CONTROL_STOP, @ServiceStat) 'hService = OpenService(hSCManager, BYVAL STRPTR(sService), SERVICE_ALL_ACCESS)
END IF
CloseServiceHandle(hServiceControlManager)
END IF
END SUB
'_____________________________________________________________________________
FUNCTION ServiceThread(idThread AS DWORD) AS LONG
'Here goes the service's job...
DO
SLEEP 2000
IF Debug THEN OutputDebugString("Service thread is running at " & TIME$ ) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
LOOP
FUNCTION = TRUE
'*** ServiceStopRaw 'Used when a service end by itself after a job
END FUNCTION
'_____________________________________________________________________________
SUB ServiceHandler(BYVAL ControlValue AS DWORD) 'Handles service requests
SELECT CASE ControlValue
CASE SERVICE_CONTROL_PAUSE
IF (pg->ServiceIsRunning <> FALSE) AND (pg->ServiceIsPaused = FALSE) THEN 'Running and not paused
ServiceStatusSet(SERVICE_PAUSE_PENDING, NO_ERROR, 0, 1, 1000) 'Tell the SCM that we are pausing
ServicePause 'Pause it
pg->CurrentServiceStatus = SERVICE_PAUSED 'Set the current state
END IF
CASE SERVICE_CONTROL_CONTINUE
IF (pg->ServiceIsRunning <> FALSE) AND (pg->ServiceIsPaused <> FALSE) THEN 'Running and paused
ServiceStatusSet(SERVICE_CONTINUE_PENDING, NO_ERROR, 0, 1, 1000) 'Tell the SCM that we are un pausing
ServiceResume 'Resume the service
pg->CurrentServiceStatus = SERVICE_RUNNING 'Set the current state
END IF
CASE SERVICE_CONTROL_STOP
IF pg->ServiceIsPaused Then
'Is the service paused?
End If
pg->CurrentServiceStatus = SERVICE_STOP_PENDING 'Set global status
ServiceStatusSet(SERVICE_STOP_PENDING, NO_ERROR, 0, 1, 5000)
ServiceStop
CASE SERVICE_CONTROL_INTERROGATE
CASE CTRL_SHUTDOWN_EVENT
CASE SERVICE_CONTROL_SHUTDOWN
'To do on shutdown
END SELECT
ServiceStatusSet(pg->CurrentServiceStatus, NO_ERROR, 0, 0, 0)
END SUB
'_____________________________________________________________________________
FUNCTION ServiceInit() AS LONG
Dim SecurityAttribute AS SECURITY_ATTRIBUTES
Dim idThread AS DWORD
pg->hThread = CreateThread(@SecurityAttribute, 0, _
Cast(LPTHREAD_START_ROUTINE, _
ProcPtr(ServiceThread)), ByVal 0, ByVal 0, @idThread)
IF pg->hThread THEN 'The thread start OK
pg->ServiceIsRunning = TRUE 'Set the global to running
FUNCTION = TRUE
END IF
END FUNCTION
'_____________________________________________________________________________
SUB ServiceMain(BYVAL dwArgs AS DWORD, BYVAL lpszArgv AS DWORD)
'dwArgc The number of arguments in the lpszArgv array.
'lpszArgv The null-terminated argument strings passed to the service by the call to the StartService function
' that started the service. If there are no arguments, this parameter can be NULL.
' Otherwise, the first argument (lpszArgv[0]) is the name of the service, followed
' by any additional arguments (lpszArgv[1] through lpszArgv[dwArgc-1]).
' If the user starts a manual service using the Services snap-in from the Control Panel,
' the strings for the lpszArgv parameter come from the properties dialog box
' for the service (from the Services snap-in, right-click the service entry, click Properties,
' and enter the parameters in Start parameters.)
Dim SecurityAttribute AS SECURITY_ATTRIBUTES
Dim RetVal AS LONG
pg->hServiceStatus = RegisterServiceCtrlHandler(pg->wsServiceName, @ServiceHandler)
IF pg->hServiceStatus THEN 'Did not work
IF ServiceStatusSet(SERVICE_START_PENDING, NO_ERROR, 0, 1, 5000) THEN 'Startup is pending
pg->hEvent = CreateEvent(@SecurityAttribute, TRUE, FALSE, "") 'Create the termination event
IF pg->hEvent THEN
IF ServiceStatusSet(SERVICE_START_PENDING, NO_ERROR, 0, 2, 1000) THEN 'Service startup is still pending
RetVal = ServiceInit() 'Start the service
IF RetVal THEN 'Service did start
IF ServiceStatusSet(SERVICE_RUNNING, NO_ERROR, 0, 0, 0) THEN 'Service is now running
'Wait for the signal to end
IF Debug THEN OutputDebugString("Service thread started at " & TIME$ ) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
WaitForSingleObject(pg->hEvent, INFINITE)
END IF
END IF
END IF
END IF
END IF
END IF
ServiceTerminate(GetLastError())
END SUB
'_____________________________________________________________________________
FUNCTION ServiceUninstall() AS LONG
Dim hServiceControlManager AS HANDLE
Dim hService AS HANDLE
hServiceControlManager = OpenSCManager(pg->wsComputerName, BYVAL NULL, SC_MANAGER_CREATE_SERVICE)
IF hServiceControlManager THEN
hService = OpenService(hServiceControlManager, pg->wsServiceName, SERVICE_ALL_ACCESS)
IF hService THEN
IF DeleteService(hService) THEN
Print "Uninstall successfull"
FUNCTION = TRUE
ELSE
Print "Uninstall - DeleteService : Error"
END IF
CloseServiceHandle(hService)
ELSE
Print "Uninstall - OpenService : Error"
END IF
CloseServiceHandle(hServiceControlManager)
ELSE
Print "Uninstall - OpenSCManager : Error"
END IF
END FUNCTION
'_____________________________________________________________________________
FUNCTION ServiceInstall() AS LONG
Dim ServiceDelayed AS SERVICE_DELAYED_AUTO_START_INFO
Dim ServiceDesc AS SERVICE_DESCRIPTION
Dim wsServiceDescription AS WSTRING * MAX_PATH
Dim hServiceControlManager AS HANDLE
Dim hService AS HANDLE
hServiceControlManager = OpenSCManager(pg->wsComputerName, BYVAL NULL, SC_MANAGER_CREATE_SERVICE)
IF hServiceControlManager THEN
hService = CreateService(hServiceControlManager, pg->wsServiceName, pg->wsServiceDisplayName, _
SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS OR _
SERVICE_INTERACTIVE_PROCESS, _
SERVICE_AUTO_START, SERVICE_ERROR_NORMAL, _
pg->wsExeName, BYVAL NULL, BYVAL NULL, _
BYVAL NULL, BYVAL NULL, BYVAL NULL) 'SERVICE_DEMAND_START SERVICE_ERROR_IGNORE
IF hService THEN
ChangeServiceConfig(hService, SERVICE_NO_CHANGE, SERVICE_AUTO_START, _
SERVICE_ERROR_NORMAL, NULL, NULL, 0, NULL, NULL, NULL, NULL)
wsServiceDescription = AppName & " is a BASIC template to write a service." '1024 bytes
ServiceDesc.lpDescription = @wsServiceDescription
ChangeServiceConfig2(hService, SERVICE_CONFIG_DESCRIPTION, BYVAL VARPTR(ServiceDesc))
'SERVICE_CONFIG_DELAYED_AUTO_START_INFO SERVICE_CONFIG_PRESHUTDOWN_INFO
'SERVICE_CONFIG_REQUIRED_PRIVILEGES_INFO SERVICE_CONFIG_DESCRIPTION
'*** Unrem next 2 lines to have a delayed service start
'*** ServiceDelayed.fDelayedAutostart = TRUE
'*** ChangeServiceConfig2(hService, SERVICE_CONFIG_DELAYED_AUTO_START_INFO, VARPTR(ServiceDelayed))
IF StartService(hService, 0, 0) THEN
Print " Install successfull"
ELSE
Print "Install - StartService : Error"
END IF
FUNCTION = TRUE
CloseServiceHandle(hService)
ELSE
Print "Install - CreateService : Error"
END IF
CloseServiceHandle(hServiceControlManager)
ELSE
Print "Install - OpenSCManager : Error"
Print "Need to be run as admin."
END IF
END FUNCTION
'_____________________________________________________________________________
DIM ServiceTable(0 TO 1) AS SERVICE_TABLE_ENTRY 'Last entry must be blank
Dim sCommand AS STRING
Dim RetVal AS LONG
Dim ComputerNameLen AS LONG
Dim g AS GlobalType
pg = VARPTR(g)
ComputerNameLen = SizeOf(pg->wsComputerName)
GetComputerName(pg->wsComputerName, Cast(LPDWORD, @ComputerNameLen)) 'Use "" for default local service
pg->wsServiceName = AppName 'Set the service name and display name
pg->wsServiceDisplayName = AppName & " BASIC template" 'Viewed in service manager, 256 char
pg->hInstance = GetModuleHandle(NULL)
GetModuleFileName(0, pg->wsExeName, MAX_PATH) 'Get exe full name
sCommand = LCASE$(Command$)
If INSTR(sCommand, "uninstall") THEN
RetVal = ServiceUninstall()
ELSEIF INSTR(sCommand, "install") THEN
RetVal = ServiceInstall()
ELSE
ServiceTable(0).lpServiceName = Cast(LPTSTR, VARPTR(pg->wsServiceName))
ServiceTable(0).lpServiceProc = Cast(LPSERVICE_MAIN_FUNCTION, ProcPtr(ServiceMain))
IF Debug THEN OutputDebugString("Service thread is starting at " & TIME$ ) 'Viewer must be in CAPTURE GLOBAL DEBUG MESSAGES mode, started AS ADMIN
IF StartServiceCtrlDispatcher(@ServiceTable(0)) = 0 THEN
ExitProcess(GetLastError())
END IF
END IF
'_____________________________________________________________________________
'