svMain muss so aufgebaut sein wie er ist, sonst funktioniert der Dienst nicht.
Es gibt regeln wie ein Dienst zu programmieren ist und dazu gehört auch der svMain()
Was anderes darf im Hauptprogramm nicht sein.
Es ist ein wenig aufwendiger einen Dienst zu schreiben...
1. Bei start wird ein Dispatcher eingetragen.
2. Dieser starte dann den ServiceProc (svServiceName)
3.1 Dieser ServiceProc trägt dann den Service Control Handler ein (svHandler)
3.2 Und initialisiert das Programm (svInit startet den eigene Thread)
4.1 Der Service Control Handler (svHandler) steuert dann den Dienst (svPause, svContinue, svStop, svShutdown)
4.2 Über svPause, svStop, etc übergebe mit ich der Variable Thread\Command die anfordern an den thMain weiter.
4.3 Reagiert der Thread thMain nicht auf die Anforderung, wird dieser zwangsweise beendet.
Der thMain() ist somit deine Schnittstelle für deine Aufgaben.
Hier mal die Beta-Version als Module.
Code: Alles auswählen
;- TOP
; Comment : Modul Service Base
; Author1 : ?
; Author2 : mk-soft
; Version : v2.01 Beta
; Update : 28.07.2019
; Install Service 'Servicename.exe install or /i'
; Uninstall Service 'Servicename.exe uninstall or /u'
EnableExplicit
;- Begin Module Service
DeclareModule Service
Structure udtThreadControl
ID.i
Command.i
EndStructure
Declare svMain()
Declare svSetServiceName(Name.s)
Declare svSetServiceDescription(Description.s)
Declare svSetThread(*MainThread, *ThreadData)
Declare svWriteLog(Text.s)
EndDeclareModule
Module Service
EnableExplicit
;- Konstanten
#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_ACCESS2 = #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_INTERACTIVE_PROCESS = $100
#SERVICE_AUTO_START = $2
#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
#SERVICE_USERDATA_128 = 128
#SERVICE_USERDATA_129 = 129
#SERVICE_USERDATA_130 = 130
#SERVICE_USERDATA_131 = 131
;- Structuren
;- IncludeFile´s
;- Global Variables
Global ServiceStatus.SERVICE_STATUS
Global hServiceStatus.i
Global AppPath.s
Global AppPathName.s
Global AppPathLog.s
Global Finish.i
Global *UserData
Global SERVICE_NAME.s = "MyService"
Global SERVICE_DESCRIPTION.s = "MyServiceDescription"
Global SERVICE_STARTNAME.s
Global SERVICE_PASSWORD.s
Global MutexLog
Global *thMainThread
Global *ThreadControl.udtThreadControl
;- Declare Function´s
Declare svHandler(fdwControl.i)
Declare svServiceMain(dwArgc.i, lpszArgv.i)
Declare svInit()
Declare svPause()
Declare svContinue()
Declare svInterrogate()
Declare svStop()
Declare svShutdown()
Declare svUserdata128()
Declare svUserdata129()
Declare svUserdata130()
Declare svUserdata131()
Declare MyWriteLog(Text.s)
; *************************************************************************************************
Procedure.s FormatMessage(Errorcode)
Protected *Buffer, len, result.s
len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,Errorcode,0,@*Buffer,0,0)
If len
result = PeekS(*Buffer, len)
LocalFree_(*Buffer)
ProcedureReturn result
Else
ProcedureReturn "Errorcode: " + Hex(Errorcode)
EndIf
EndProcedure
; *************************************************************************************************
Procedure.s GetSpecialFolder(iCSIDL)
Protected sPath.s = Space(#MAX_PATH)
If SHGetSpecialFolderPath_(#Null, @sPath, iCSIDL, 0) = #True
ProcedureReturn sPath
Else
ProcedureReturn ""
EndIf
EndProcedure
; *************************************************************************************************
Procedure.s CreateLogFolder(name.s)
Protected path.s
path = GetSpecialFolder(#CSIDL_COMMON_APPDATA)
If Right(path, 1) <> "\"
path + "\"
EndIf
path + name + "\"
CreateDirectory(path)
;MakeSureDirectoryPathExists_(path)
ProcedureReturn path
EndProcedure
; *************************************************************************************************
Procedure MyWriteLog(Text.s)
If OpenFile(0, AppPathLog)
FileSeek(0, Lof(0))
WriteStringN(0, FormatDate("%YYYY-%MM-%DD %HH:%II:%SS : ",Date()) + Text)
CloseFile(0)
EndIf
EndProcedure
Procedure svWriteLog(text.s)
LockMutex(MutexLog) : MyWriteLog(text) : UnlockMutex(MutexLog)
EndProcedure
Macro WriteLog(text)
LockMutex(MutexLog) : MyWriteLog(text) : UnlockMutex(MutexLog)
EndMacro
; *************************************************************************************************
Procedure svSetServiceName(ServiceName.s)
SERVICE_NAME = ServiceName
EndProcedure
; *************************************************************************************************
Procedure svSetServiceDescription(Description.s)
SERVICE_DESCRIPTION = Description
EndProcedure
; *************************************************************************************************
Procedure svSetThread(*MainThread, *ThreadData)
*thMainThread = *MainThread
*ThreadControl = *ThreadData
EndProcedure
; *************************************************************************************************
Procedure svMain()
Protected hSCManager.i
Protected hService.i
Protected ServiceTableEntry.SERVICE_TABLE_ENTRY
Protected lpServiceStatus.SERVICE_STATUS
Protected lpInfo
Protected r1.i
Protected cmd.s
Protected result
;Change SERVICE_NAME and app name as needed
;-- Service name
; SERVICE_NAME = "MyService"
;-- Service description
; SERVICE_DESCRIPTION = "MyService Test"
;-- Service startname
;--- LocalSystem account (Default)
SERVICE_STARTNAME = "" ; NULL
SERVICE_PASSWORD = "" ; Null
;--- LocalService account
; SERVICE_STARTNAME = "NT AUTHORITY\LocalService"
; SERVICE_PASSWORD = ""
;--- NetworkService account
; SERVICE_STARTNAME = "NT AUTHORITY\NetworkService"
; SERVICE_PASSWORD = ""
;--- DomainName\UserName or .\Username account
; SERVICE_STARTNAME = ".\username"
; SERVICE_PASSWORD = "password"
AppPathName.s = Space(1023)
GetModuleFileName_(0, AppPathName, 1023)
cmd = Trim(LCase(ProgramParameter()))
Select cmd
Case "install", "/i" ;Install service on machine
Repeat
result = 0
hSCManager = OpenSCManager_(0, 0, #SC_MANAGER_CREATE_SERVICE)
If hSCManager = #Null
result = GetLastError_()
Break
EndIf
If SERVICE_STARTNAME
hService = CreateService_(hSCManager, SERVICE_NAME, SERVICE_NAME, #SERVICE_ALL_ACCESS2, #SERVICE_WIN32_OWN_PROCESS, #SERVICE_AUTO_START, #SERVICE_ERROR_NORMAL, AppPathName, 0, 0, 0, SERVICE_STARTNAME, SERVICE_PASSWORD)
Else ; Local service
hService = CreateService_(hSCManager, SERVICE_NAME, SERVICE_NAME, #SERVICE_ALL_ACCESS2, #SERVICE_INTERACTIVE_PROCESS | #SERVICE_WIN32_OWN_PROCESS, #SERVICE_AUTO_START, #SERVICE_ERROR_NORMAL, AppPathName, 0, 0, 0, 0, 0)
EndIf
If hService = #Null
result = GetLastError_()
Break
EndIf
lpInfo = @SERVICE_DESCRIPTION
ChangeServiceConfig2_(hService, #SERVICE_CONFIG_DESCRIPTION, @lpInfo)
Until #True
If hService
CloseServiceHandle_(hService)
EndIf
If hSCManager
CloseServiceHandle_(hSCManager)
EndIf
If result
MessageRequester("Fehler", "Service nicht installiert! " + FormatMessage(result), #MB_ICONSTOP)
EndIf
finish = 1
Case "uninstall", "/u" ;Remove service from machine
Repeat
result = 0
hSCManager = OpenSCManager_(0, 0, #SC_MANAGER_CREATE_SERVICE)
If hSCManager = #Null
result = GetLastError_()
Break
EndIf
hService = OpenService_(hSCManager, SERVICE_NAME, #SERVICE_ALL_ACCESS)
If hService = #Null
result = GetLastError_()
Break
EndIf
If QueryServiceStatus_(hService, lpServiceStatus) = #Null
result = GetLastError_()
Break
EndIf
If lpServiceStatus\dwCurrentState <> #SERVICE_STOPPED
result = #ERROR_SERVICE_ALREADY_RUNNING
Break
EndIf
If DeleteService_(hService) = #Null
result = GetLastError_()
Break
EndIf
Until #True
If hService
CloseServiceHandle_(hService)
EndIf
If hSCManager
CloseServiceHandle_(hSCManager)
EndIf
If result
MessageRequester("Fehler", "Service nicht deinstalliert! " + FormatMessage(result), #MB_ICONSTOP)
EndIf
finish = 1
Default
;Start the service
ServiceTableEntry\lpServiceName = @SERVICE_NAME
ServiceTableEntry\lpServiceProc = @svServiceMain()
r1 = StartServiceCtrlDispatcher_(@ServiceTableEntry)
If r1 = 0
Finish = 1
EndIf
EndSelect
Repeat
Delay(100)
Until Finish = 1
End
EndProcedure
; *************************************************************************************************
Procedure svHandler(fdwControl.i)
Protected r1.i
Select fdwControl
Case #SERVICE_CONTROL_PAUSE
;** Do whatever it takes To pause here.
If svPause()
ServiceStatus\dwCurrentState = #SERVICE_PAUSED
EndIf
Case #SERVICE_CONTROL_CONTINUE
;** Do whatever it takes To continue here.
If svContinue()
ServiceStatus\dwCurrentState = #SERVICE_RUNNING
EndIf
Case #SERVICE_CONTROL_STOP
ServiceStatus\dwWin32ExitCode = 0
ServiceStatus\dwCurrentState = #SERVICE_STOP_PENDING
ServiceStatus\dwCheckPoint = 0
ServiceStatus\dwWaitHint = 0 ;Might want a time estimate
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
;** Do whatever it takes to stop here.
If svStop()
Finish = 1
ServiceStatus\dwCurrentState = #SERVICE_STOPPED
EndIf
Case #SERVICE_CONTROL_INTERROGATE
;Fall through To send current status.
svInterrogate()
Case #SERVICE_CONTROL_SHUTDOWN
ServiceStatus\dwWin32ExitCode = 0
ServiceStatus\dwCurrentState = #SERVICE_STOP_PENDING
ServiceStatus\dwCheckPoint = 0
ServiceStatus\dwWaitHint = 0 ;Might want a time estimate
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
;** Do whatever it takes to stop here.
If svShutdown()
Finish = 1
ServiceStatus\dwCurrentState = #SERVICE_STOPPED
EndIf
Case #SERVICE_USERDATA_128
svUserdata128()
Case #SERVICE_USERDATA_129
svUserdata129()
Case #SERVICE_USERDATA_130
svUserdata130()
Case #SERVICE_USERDATA_131
svUserdata131()
EndSelect
;Send current status.
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
EndProcedure
; *************************************************************************************************
Procedure svServiceMain(dwArgc.i, lpszArgv.i)
Protected r1.i
;Set initial state
ServiceStatus\dwServiceType = #SERVICE_WIN32_OWN_PROCESS
ServiceStatus\dwCurrentState = #SERVICE_START_PENDING
ServiceStatus\dwControlsAccepted = #SERVICE_ACCEPT_STOP | #SERVICE_ACCEPT_PAUSE_CONTINUE | #SERVICE_ACCEPT_SHUTDOWN
ServiceStatus\dwWin32ExitCode = 0
ServiceStatus\dwServiceSpecificExitCode = 0
ServiceStatus\dwCheckPoint = 0
ServiceStatus\dwWaitHint = 0
hServiceStatus = RegisterServiceCtrlHandler_(SERVICE_NAME, @svHandler())
ServiceStatus\dwCurrentState = #SERVICE_START_PENDING
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
;** Do Initialization Here
If svInit()
ServiceStatus\dwCurrentState = #SERVICE_RUNNING
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
Else
ServiceStatus\dwCurrentState = #SERVICE_STOP_PENDING
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
ServiceStatus\dwCurrentState = #SERVICE_STOPPED
r1 = SetServiceStatus_(hServiceStatus, ServiceStatus)
Finish = 1
EndIf
;** 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 svInit()
Protected path.s
; Create folder for logs
AppPathLog = CreateLogFolder(SERVICE_NAME)
AppPathLog + "Service.log"
; Create mutex for logs
MutexLog = CreateMutex()
WriteLog("Service Start")
If *thMainThread
*ThreadControl\Command = #SERVICE_START
*ThreadControl\ID = CreateThread(*thMainThread, *ThreadControl)
If *ThreadControl\ID
ProcedureReturn 1
Else
WriteLog("Service Start - Error: Start Thread")
*ThreadControl\Command = 0
ProcedureReturn 0
EndIf
Else
ProcedureReturn 0
EndIf
EndProcedure
; *************************************************************************************************
Procedure svPause()
WriteLog("Service Pause")
*ThreadControl\Command = #SERVICE_CONTROL_PAUSE
If IsThread(*ThreadControl\ID)
If WaitThread(*ThreadControl\ID, 10000) = 0
WriteLog("Service Pause - Error: Killed Thread")
KillThread(*ThreadControl\ID)
EndIf
EndIf
*ThreadControl\Command = 0
*ThreadControl\ID = 0
ProcedureReturn 1
EndProcedure
; *************************************************************************************************
Procedure svContinue()
WriteLog("Service Continue")
*ThreadControl\Command = #SERVICE_CONTROL_CONTINUE
*ThreadControl\ID = CreateThread(*thMainThread, *ThreadControl)
If *ThreadControl\ID
ProcedureReturn 1
Else
WriteLog("Service Continue - Error: Start Thread")
*ThreadControl\Command = 0
ProcedureReturn 0
EndIf
EndProcedure
; *************************************************************************************************
Procedure svStop()
Protected ctime
WriteLog("Service Stop")
*ThreadControl\Command = #SERVICE_CONTROL_STOP
If IsThread(*ThreadControl\ID)
If WaitThread(*ThreadControl\ID, 10000) = 0
WriteLog("Service Stop - Error: Killed Thread")
KillThread(*ThreadControl\ID)
EndIf
EndIf
*ThreadControl\Command = 0
*ThreadControl\ID = 0
ProcedureReturn 1
EndProcedure
; *************************************************************************************************
Procedure svInterrogate()
WriteLog("Service Interrogate")
ProcedureReturn 1
EndProcedure
; *************************************************************************************************
Procedure svShutdown()
Protected ctime
WriteLog("Service Shutdown")
*ThreadControl\Command = #SERVICE_CONTROL_SHUTDOWN
If IsThread(*ThreadControl\ID)
If WaitThread(*ThreadControl\ID, 10000) = 0
WriteLog("Service Shutdown - Error: Killed Thread")
KillThread(*ThreadControl\ID)
EndIf
EndIf
*ThreadControl\Command = 0
*ThreadControl\ID = 0
ProcedureReturn 1
EndProcedure
; *************************************************************************************************
Procedure svUserdata128()
EndProcedure
; *************************************************************************************************
Procedure svUserdata129()
EndProcedure
; *************************************************************************************************
Procedure svUserdata130()
EndProcedure
; *************************************************************************************************
Procedure svUserdata131()
EndProcedure
; *************************************************************************************************
EndModule
;- End Module Service
; *************************************************************************************************
CompilerIf #PB_Compiler_IsMainFile
;-Example
UseModule Service
;- Thread main
Structure udtThreadData Extends udtThreadControl
Counter.i
EndStructure
Global thData.udtThreadData
Procedure thMain(*Thread.udtThreadData)
; Global code for init
svWriteLog("Thread - Init")
Repeat
Select *Thread\Command
Case #SERVICE_START
*Thread\Command = 0
; Code for start
svWriteLog("Thread - Start")
; End
Case #SERVICE_CONTROL_CONTINUE
*Thread\Command = 0
; Code for contine
svWriteLog("Thread - Continue")
; End
Case #SERVICE_CONTROL_PAUSE
*Thread\Command = 0
; Code for pause before exit
svWriteLog("Thread - Pause")
; end
Break ; Always exit
Case #SERVICE_CONTROL_STOP
*Thread\Command = 0
; Code for stop before exit
svWriteLog("Thread - Stop")
; end
Break ; Always exit
Case #SERVICE_CONTROL_SHUTDOWN
*Thread\Command = 0
; Code for shutdown before exit
svWriteLog("Thread - Shutdown")
; end
Break ; Always exit
Default
; Any cycle code
*Thread\Counter + 1
Delay(100) ; Always Delay
; End
EndSelect
ForEver
; Global code for exit
svWriteLog("Thread - Exit")
EndProcedure
svSetServiceName("MyService")
svSetServiceDescription("Module Test Service")
svSetThread(@thMain(), thData)
svMain()
CompilerEndIf