An example is on the second post.
Thanks to Danilo for opening my eyes with the Grant_Access-Procedure.
Remember not to use APPDATA, when storing your preferences, as this doesn't exist for a service.
Better use COMMON_APPDATA
Have fun!
Go here for the >=PB5.20 module-powered version.
Code: Select all
; ==============================================================
; COMPILER OPTIONS:
; [ ] Enable inline ASM support
; [ ] Create unicode executable
; [ ] Create threadsafe executable
; [ ] Enable OnError lines support
; [x] Enable XP skin support
; [ ] Request Administrator mode for Windows Vista
; [x] Request User mode for Windows Vista (no virtualization)
; Library Subsystem:
; File Format: UTF-8
; Executable Format: Windows
;
; Created on: 28/01/2013 23:07
; App/Lib-Name: Win_Services.pbi
; Author: HeX0R
; Version: 1.00
; Compiler: PureBasic 5.10 Beta 5 (Windows - x86)
; ==============================================================
;
; This little include is a rewrite of Rings' PBOSL_NTService
; You can give your app the possibility to work as service.
; You also can start/stop/pause/resume/install/uninstall services
;
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
Macro StructureAlign : EndMacro
CompilerElse
Macro StructureAlign : Align 8 : EndMacro
CompilerEndIf
Prototype __Service_Notify_Procedure__(ServiceStateChanged.i)
Declare __Service_CtrlHandler(controlCode.l)
#DACL_SECURITY_INFORMATION = $04
#NO_INHERITANCE = $00
#SE_SERVICE = $02
#SET_ACCESS = $02
Structure _TRUSTEE StructureAlign
*pMultipleTrustee
MultipleTrusteeOperation.l
TrusteeForm.l
TrusteeType.l
*ptstrName
EndStructure
Structure EXPLICIT_ACCESS StructureAlign
grfAccessPermissions.l
grfAccessMode.l
grfInheritance.l
Trustee._TRUSTEE
EndStructure
Structure __Service_Main_Structure_
VTable.i
EndStructure
Structure __Service_GlobalVars__
ServiceName.s
hStatus.i
Semaphore.i
ThreadID.i
ThreadID2.i
*MainProc
NotifyProc.__Service_Notify_Procedure__
EndStructure
Global __ServiceGlobals__.__Service_GlobalVars__
;----- Interface
Interface __Service_Interface_
;Procedures to interact with services
StartService(ServiceName.s)
StopService(ServiceName.s)
PauseService(ServiceName.s)
ResumeService(ServiceName.s)
;Procedures to create/remove services
InstallService(ServiceName.s, DisplayName.s, FileName.s, Description.s = "", StartParameter = #SERVICE_AUTO_START)
RemoveService(ServiceName.s)
StartRunning(ServiceName.s, *MainProcedure, *NotifyProcedure = #Null)
;Procedure to quick-check state of services
GetServiceState(ServiceName.s)
;Procedure to sllow User to Start/Stop/Pause/Resume Service
GrantAccess(ServiceName.s, UserName.s, Rights.i = #SERVICE_START | #SERVICE_STOP | #SERVICE_PAUSE_CONTINUE)
EndInterface
;----- Internal Procedures
Procedure __Service_Internal_DoService(*THIS.__Service_Main_Structure_, ServiceName.s, DoWhat.i)
Protected sStatus.SERVICE_STATUS
Protected Result, schSCManager, schService
;Internal procedure to change the status of a service.
schSCManager = OpenSCManager_(0, 0, #SC_MANAGER_CONNECT)
If schSCManager
schService = OpenService_(schSCManager, @ServiceName, #GENERIC_EXECUTE)
If schService
If DoWhat <> 0
Result = ControlService_(schService, DoWhat, sStatus)
Else
Result = StartService_(schService, 0, 0)
EndIf
CloseServiceHandle_(schService)
EndIf
CloseServiceHandle_(schSCManager)
EndIf
ProcedureReturn Result
EndProcedure
Procedure __Service_Internal_SendStatus(dwCurrentState, dwWin32ExitCode, dwServiceSpecificExitCode, dwCheckPoint, dwWaitHint)
Protected sStatus.SERVICE_STATUS
;Internal procedure to set the SERVICE_STATUS-structure of a Service.
sStatus\dwServiceType = #SERVICE_WIN32_OWN_PROCESS
sStatus\dwCurrentState = dwCurrentState
If dwCurrentState = #SERVICE_START_PENDING
sStatus\dwControlsAccepted = 0
Else
sStatus\dwControlsAccepted = #SERVICE_ACCEPT_STOP | #SERVICE_ACCEPT_PAUSE_CONTINUE | #SERVICE_ACCEPT_SHUTDOWN
EndIf
;
If dwServiceSpecificExitCode = 0
sStatus\dwWin32ExitCode = dwWin32ExitCode
Else
sStatus\dwWin32ExitCode = #ERROR_SERVICE_SPECIFIC_ERROR
EndIf
sStatus\dwServiceSpecificExitCode = dwServiceSpecificExitCode
sStatus\dwCheckPoint = dwCheckPoint
sStatus\dwWaitHint = dwWaitHint
;Pass the status record to the SCM
SetServiceStatus_(__ServiceGlobals__\hStatus, sStatus)
EndProcedure
Procedure __Service_Internal_Main(argc.l, *argv)
Protected dwNull
;Internal Procedure to start the service and initialize the main procedure.
With __ServiceGlobals__
;immediately call Registration function
\hStatus = RegisterServiceCtrlHandler_(@\ServiceName, @__Service_CtrlHandler())
If \hStatus
;Notify SCM of progress
__Service_Internal_SendStatus(#SERVICE_START_PENDING, #NO_ERROR, 0, 1, 5000)
;create the termination semaphore
\Semaphore = CreateSemaphore()
If \Semaphore
;Notify SCM of progress
__Service_Internal_SendStatus(#SERVICE_START_PENDING, #NO_ERROR, 0, 2, 1000)
;Notify SCM of progress
__Service_Internal_SendStatus(#SERVICE_START_PENDING, #NO_ERROR, 0, 3, 5000)
;Start the service itself
\ThreadID = CreateThread(\MainProc, #True)
;\ThreadID = CreateThread(@__Service_Internal_DummyThread(), #True)
If \ThreadID
;Notify SCM of progress
__Service_Internal_SendStatus(#SERVICE_RUNNING, #NO_ERROR, 0, 0, 0)
;Wait for stop signal, and then terminate
WaitSemaphore(\Semaphore)
If IsThread(\ThreadID) And WaitThread(\ThreadID, 1000) = 0
KillThread(\ThreadID)
EndIf
\ThreadID = 0
EndIf
FreeSemaphore(\Semaphore)
\Semaphore = 0
EndIf
__Service_Internal_SendStatus(#SERVICE_STOPPED, #NO_ERROR, 0, 0, 0)
\hStatus = #Null
EndIf
EndWith
EndProcedure
;----- Public Procedures
Procedure __Service_Grant_Access(*THIS.__Service_Main_Structure_, ServiceName.s, UserName.s, Rights.i)
Protected *psd.SECURITY_DESCRIPTOR, *pacl, *pNewAcl
Protected ea.EXPLICIT_ACCESS, Result
;Procedure to grant a user access to pause/resume/start/stop the service.
;(normaly not needed for WinXP)
If GetNamedSecurityInfo_(ServiceName, #SE_SERVICE, #DACL_SECURITY_INFORMATION, #Null, #Null, @*pacl, 0, @*psd) = #ERROR_SUCCESS
BuildExplicitAccessWithName_(@ea, @UserName, Rights, #SET_ACCESS, #NO_INHERITANCE)
If SetEntriesInAcl_(1, @ea, *pacl, @*pNewAcl) = #ERROR_SUCCESS
If SetNamedSecurityInfo_(ServiceName, #SE_SERVICE, #DACL_SECURITY_INFORMATION, #Null, #Null, *pNewAcl, 0) = #ERROR_SUCCESS
Result = #True
EndIf
EndIf
EndIf
If *psd
LocalFree_(*psd)
EndIf
If *pNewAcl
LocalFree_(*pNewAcl)
EndIf
ProcedureReturn Result
EndProcedure
Procedure __Service_StartService(*THIS.__Service_Main_Structure_, ServiceName.s) ;Start the service ServiceName
ProcedureReturn __Service_Internal_DoService(*THIS, ServiceName.s, 0)
EndProcedure
Procedure __Service_StopService(*THIS.__Service_Main_Structure_, ServiceName.s) ;Stop the Service ServiceName
ProcedureReturn __Service_Internal_DoService(*THIS, ServiceName.s, #SERVICE_CONTROL_STOP)
EndProcedure
Procedure __Service_ResumeService(*THIS.__Service_Main_Structure_, ServiceName.s) ;Resume the Service ServiceName
ProcedureReturn __Service_Internal_DoService(*THIS, ServiceName.s, #SERVICE_CONTROL_CONTINUE)
EndProcedure
Procedure __Service_PauseService(*THIS.__Service_Main_Structure_, ServiceName.s) ;Pause the Service ServiceName
ProcedureReturn __Service_Internal_DoService(*THIS, ServiceName.s, #SERVICE_CONTROL_PAUSE)
EndProcedure
Procedure __Service_RemoveService(*THIS.__Service_Main_Structure_, ServiceName.s) ;Remove the service ServiceName
Protected sStatus.SERVICE_STATUS
Protected Result, schSCManager, schService
schSCManager = OpenSCManager_(0, 0, #SC_MANAGER_ALL_ACCESS)
If schSCManager
schService = OpenService_(schSCManager, @ServiceName, #SERVICE_ALL_ACCESS)
If schService
If ControlService_(schService, #SERVICE_CONTROL_STOP, sStatus) = 0
Result = DeleteService_(schService)
Else
;Loop until its stopped, then delete it. It only deletes the SCM entry, not the executable.
Repeat
If QueryServiceStatus_(schService, sStatus ) = 0
Break
EndIf
If sStatus\dwCurrentState = #SERVICE_STOPPED
Result = DeleteService_(schService)
Break
EndIf
ForEver
EndIf
CloseServiceHandle_(schService)
EndIf
CloseServiceHandle_(schSCManager)
EndIf
ProcedureReturn Result
EndProcedure
Procedure __Service_CtrlHandler(controlCode.l)
Protected currentState, success, nopThread
;Controlhandler, which gets called, whenever a service state has been changed.
;If an optional notify-procedure has been set, it will also be called
With __ServiceGlobals__
Select controlCode
Case #SERVICE_CONTROL_STOP
currentState = #SERVICE_STOP_PENDING
;Tell the SCM what's happening
__Service_Internal_SendStatus(#SERVICE_STOP_PENDING, #NO_ERROR, 0, 1, 5000)
; Changed on 27.09.2005 by Peter Tübben (aka Kiffi)
;First notify, otherwise it will be to late...
If \NotifyProc
\NotifyProc(controlCode)
EndIf
SignalSemaphore(\Semaphore)
ProcedureReturn
Case #SERVICE_CONTROL_PAUSE
__Service_Internal_SendStatus(#SERVICE_PAUSE_PENDING, #NO_ERROR, 0, 1, 1000)
If \NotifyProc
\NotifyProc(controlCode)
EndIf
PauseThread(\ThreadID)
currentState = #SERVICE_PAUSED
Case #SERVICE_CONTROL_CONTINUE
__Service_Internal_SendStatus(#SERVICE_CONTINUE_PENDING, #NO_ERROR, 0, 1, 1000)
ResumeThread(\ThreadID)
currentState = #SERVICE_RUNNING
Case #SERVICE_CONTROL_INTERROGATE
; it will fall to bottom and send status
;Could do cleanup here but it must be very quick.
Case #SERVICE_CONTROL_SHUTDOWN
;The service is notified when system
;shutdown occurs.
;Do nothing on shutdown.
EndSelect
__Service_Internal_SendStatus(currentState, #NO_ERROR, 0, 0, 0)
If \NotifyProc And currentState <> #SERVICE_PAUSED
\NotifyProc(controlCode)
EndIf
EndWith
EndProcedure
Procedure __Service_StartRunning(*THIS.__Service_Main_Structure_, ServiceName.s, *MainProcedure, *NotifyProcedure)
Protected Result
;Call this procedure, do start the service (when it is trying to start with a state of #SERVICE_START_PENDING)
;MainProcedure should look like this: MyMainProcedure(IsService.i)
;NotifyProcedure (optional) should look like this: MyNotifyProcedure(NewServiceState.i)
If __ServiceGlobals__\hStatus = #Null And *MainProcedure <> #Null
;o.k. now lets go!
__ServiceGlobals__\MainProc = *MainProcedure
__ServiceGlobals__\NotifyProc = *NotifyProcedure
__ServiceGlobals__\ServiceName = ServiceName
Dim sTable.SERVICE_TABLE_ENTRY(1)
sTable(0)\lpServiceProc = @__Service_Internal_Main()
sTable(0)\lpServiceName = @ServiceName
Result = StartServiceCtrlDispatcher_(@sTable())
EndIf
ProcedureReturn Result
EndProcedure
Procedure __Service_InstallService(*THIS.__Service_Main_Structure_, ServiceName.s, DisplayName.s, FileName.s, Description.s, StartParameter);Installs a service and starts it
Protected sStatus.SERVICE_STATUS
Protected dwDesiredAccess = #SERVICE_ALL_ACCESS
Protected dwServiceType = #SERVICE_WIN32_OWN_PROCESS; | #SERVICE_INTERACTIVE_PROCESS ;<- this flag won't work that perfect on Win7, so better don't use it
Protected dwErrorControl = #SERVICE_ERROR_NORMAL
Protected schSCManager, schService
Protected Result, hKey, sTopKey, sKeyName.s, GetHandle
schSCManager = OpenSCManager_(0, 0, #SC_MANAGER_CREATE_SERVICE | #SC_MANAGER_CONNECT)
If schSCManager
schService = CreateService_(schSCManager, @ServiceName, @DisplayName, dwDesiredAccess, dwServiceType, StartParameter, dwErrorControl, @FileName, 0, 0, 0, 0, 0)
If schService
Result = #True
If QueryServiceStatus_(schService, @sStatus)
If sStatus\dwCurrentState = #SERVICE_STOPPED
If StartParameter = #SERVICE_AUTO_START Or StartParameter = #SERVICE_DEMAND_START
Result = StartService_(schService, 0, 0)
EndIf
EndIf
EndIf
CloseServiceHandle_(schService)
EndIf
CloseServiceHandle_(schSCManager)
EndIf
If schSCManager And schService And Result And Description
sTopKey = #HKEY_LOCAL_MACHINE
sKeyName = "SYSTEM\CurrentControlSet\Services\" + Servicename
GetHandle = RegOpenKeyEx_(stopKey, sKeyName, 0, #KEY_WRITE, @hKey)
If GetHandle = #ERROR_SUCCESS
GetHandle = RegSetValueEx_(hkey, "Description", 0, #REG_SZ, @Description, StringByteLength(Description) + SizeOf(CHARACTER))
EndIf
RegCloseKey_(hkey)
EndIf
ProcedureReturn Result
EndProcedure
Procedure __Service_GetServiceState(*THIS.__Service_Main_Structure_, ServiceName.s)
Protected schSCManager, schService
Protected sStatus.SERVICE_STATUS
Protected Result
;Get the State of the Service ServiceName
schSCManager = OpenSCManager_(0, 0, #SC_MANAGER_CONNECT)
If schSCManager
schService = OpenService_(schSCManager, @ServiceName, #GENERIC_READ)
If schService
If QueryServiceStatus_(schService, @sStatus)
Result = sStatus\dwCurrentState
EndIf
CloseServiceHandle_(schService)
EndIf
CloseServiceHandle_(schSCManager)
EndIf
ProcedureReturn Result
EndProcedure
;----- Create Interface
Procedure CreateServiceObject()
Protected *THIS.__Service_Main_Structure_
;Create the interface
*THIS = AllocateMemory(SizeOf(__Service_Main_Structure_))
If *THIS
*THIS\VTable = ?__Service_Procedures_
InitializeStructure(*THIS, __Service_Main_Structure_)
EndIf
ProcedureReturn *THIS
EndProcedure
;----- Data
DataSection
__Service_Procedures_:
Data.i @__Service_StartService()
Data.i @__Service_StopService()
Data.i @__Service_PauseService()
Data.i @__Service_ResumeService()
Data.i @__Service_InstallService()
Data.i @__Service_RemoveService()
Data.i @__Service_StartRunning()
Data.i @__Service_GetServiceState()
Data.i @__Service_Grant_Access()
EndDataSection
