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: 10/12/2015 20:56
; App/Lib-Name: Win_Services.pbi
; Author: HeX0R
; Version: 1.02
; Compiler: PureBasic 5.41 LTS (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
;
DeclareModule WinService
;Procedures to interact with services
Declare StartService(ServiceName.s)
Declare StopService(ServiceName.s)
Declare PauseService(ServiceName.s)
Declare ResumeService(ServiceName.s)
;Procedures to create/remove services
Declare InstallService(ServiceName.s, DisplayName.s, FileName.s, Description.s = "", StartParameter = #SERVICE_AUTO_START)
Declare RemoveService(ServiceName.s)
Declare StartRunning(ServiceName.s, *MainProcedure, *NotifyProcedure = #Null)
;Procedure to quick-check state of services
Declare GetServiceState(ServiceName.s)
;Procedure to sllow User to Start/Stop/Pause/Resume Service
Declare GrantAccess(ServiceName.s, UserName.s, Rights.i = #SERVICE_START | #SERVICE_STOP | #SERVICE_PAUSE_CONTINUE)
EndDeclareModule
;----- Internal Procedures
Module WinService
#DACL_SECURITY_INFORMATION = $04
#NO_INHERITANCE = $00
#SE_SERVICE = $02
#SET_ACCESS = $02
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
Macro StructureAlign : EndMacro
CompilerElse
Macro StructureAlign : Align 8 : EndMacro
CompilerEndIf
Prototype Notify_Procedure(ServiceStateChanged.i)
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 GlobalVars
ServiceName.s
hStatus.i
Semaphore.i
ThreadID.i
ThreadID2.i
*MainProc
NotifyProc.Notify_Procedure
EndStructure
Global ServiceGlobals.GlobalVars
Declare CtrlHandler(controlCode.l)
Procedure DoService(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 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 ServiceMain(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, @CtrlHandler())
If \hStatus
;Notify SCM of progress
SendStatus(#SERVICE_START_PENDING, #NO_ERROR, 0, 1, 5000)
;create the termination semaphore
\Semaphore = CreateSemaphore()
If \Semaphore
;Notify SCM of progress
SendStatus(#SERVICE_START_PENDING, #NO_ERROR, 0, 2, 1000)
;Notify SCM of progress
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
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
SendStatus(#SERVICE_STOPPED, #NO_ERROR, 0, 0, 0)
\hStatus = #Null
EndIf
EndWith
EndProcedure
;----- Public Procedures
Procedure GrantAccess(ServiceName.s, UserName.s, Rights.i = #SERVICE_START | #SERVICE_STOP | #SERVICE_PAUSE_CONTINUE)
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 StartService(ServiceName.s) ;Start the service ServiceName
ProcedureReturn DoService(ServiceName.s, 0)
EndProcedure
Procedure StopService(ServiceName.s) ;Stop the Service ServiceName
ProcedureReturn DoService(ServiceName.s, #SERVICE_CONTROL_STOP)
EndProcedure
Procedure ResumeService(ServiceName.s) ;Resume the Service ServiceName
ProcedureReturn DoService(ServiceName.s, #SERVICE_CONTROL_CONTINUE)
EndProcedure
Procedure PauseService(ServiceName.s) ;Pause the Service ServiceName
ProcedureReturn DoService(ServiceName.s, #SERVICE_CONTROL_PAUSE)
EndProcedure
Procedure RemoveService(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 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
currentState = GetServiceState(\ServiceName)
Select controlCode
Case #SERVICE_CONTROL_STOP
currentState = #SERVICE_STOP_PENDING
;Tell the SCM what's happening
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
SendStatus(#SERVICE_PAUSE_PENDING, #NO_ERROR, 0, 1, 1000)
PauseThread(\ThreadID)
currentState = #SERVICE_PAUSED
Case #SERVICE_CONTROL_CONTINUE
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
SendStatus(currentState, #NO_ERROR, 0, 0, 0)
If \NotifyProc
\NotifyProc(controlCode)
EndIf
EndWith
EndProcedure
Procedure StartRunning(ServiceName.s, *MainProcedure, *NotifyProcedure = #Null)
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)
With ServiceGlobals
If \hStatus = #Null And *MainProcedure <> #Null
;o.k. now lets go!
\MainProc = *MainProcedure
\NotifyProc = *NotifyProcedure
\ServiceName = ServiceName
Dim sTable.SERVICE_TABLE_ENTRY(1)
sTable(0)\lpServiceProc = @ServiceMain()
sTable(0)\lpServiceName = @ServiceName
Result = StartServiceCtrlDispatcher_(@sTable())
EndIf
EndWith
ProcedureReturn Result
EndProcedure
Procedure InstallService(ServiceName.s, DisplayName.s, FileName.s, Description.s = "", StartParameter = #SERVICE_AUTO_START);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 GetServiceState(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
EndModule
thx for sharing
