P.S. Das es so funktioniert weiß ich da ich schon Dienste als ModbusTCP Bridge und Anderes programmiert habe und diese laufen ohne Probleme auch im Hintergrund an.
Code: Alles auswählen
;- TOP
; Comment : MySerive Example wit two threads
; Author1 : ?
; Author2 : mk-soft
; Version : v2.01
; Update : 02.08.2019
; Install Service 'Servicename.exe install or /i'
; Uninstall Service 'Servicename.exe uninstall or /u'
; *****************************************************************************
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Use Compiler-Option ThreadSafe!"
CompilerEndIf
EnableExplicit
#EnableLogging = #True
; *****************************************************************************
;- Konstanten
#SERVICE_USERDATA_128 = 128
#SERVICE_USERDATA_129 = 129
#SERVICE_USERDATA_130 = 130
#SERVICE_USERDATA_131 = 131
;- Structuren
Structure udtThreadControl
; Service Control Data
ThreadID.i
Command.i
EndStructure
;- Global Services Variables
Global ServiceStatus.SERVICE_STATUS
Global hServiceStatus.i
Global AppPath.s
Global AppPathName.s
Global AppPathLog.s
Global ExitService.i
Global SERVICE_NAME.s
Global SERVICE_DESCRIPTION.s
Global SERVICE_STARTNAME.s
Global SERVICE_PASSWORD.s
;- Global Variables
Global MutexLog
Global MainThread.udtThreadControl
Global MyDataThread.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 WriteLog(Text.s)
;- Declare Threads
Declare thMain(id)
Declare thMyData(id)
; ----
Procedure.s FormatMessage(Errorcode)
Protected *Buffer, len, r1.s
len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,Errorcode,0,@*Buffer,0,0)
If len
r1 = PeekS(*Buffer, len)
LocalFree_(*Buffer)
ProcedureReturn r1
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
Macro WriteLog(text)
CompilerIf #EnableLogging
LockMutex(MutexLog) : MyWriteLog(text) : UnlockMutex(MutexLog)
CompilerEndIf
EndMacro
; ----
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
;-! Begin Service Configuration
;-* Service Name
SERVICE_NAME = "MyService"
;-* Service Description
SERVICE_DESCRIPTION = "MyService Main Base Program"
;-* Service Start Type
;--- 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"
;-! End Service Configuration
AppPathName.s = Space(1023)
GetModuleFileName_(0, AppPathName, 1023)
cmd = Trim(LCase(ProgramParameter()))
Select cmd
Case "install", "/i" ;Install service on machine
Repeat
r1 = 0
hSCManager = OpenSCManager_(0, 0, #SC_MANAGER_CREATE_SERVICE)
If hSCManager = #Null
r1 = GetLastError_()
Break
EndIf
If SERVICE_STARTNAME
hService = CreateService_(hSCManager, SERVICE_NAME, SERVICE_NAME, #SERVICE_ALL_ACCESS, #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_ACCESS, #SERVICE_INTERACTIVE_PROCESS | #SERVICE_WIN32_OWN_PROCESS, #SERVICE_AUTO_START, #SERVICE_ERROR_NORMAL, AppPathName, 0, 0, 0, 0, 0)
EndIf
If hService = #Null
r1 = 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 r1
MessageRequester("Error", "Service not installed! " + FormatMessage(r1), #MB_ICONSTOP)
EndIf
ExitService = 1
Case "uninstall", "/u" ;Remove service from machine
Repeat
r1 = 0
hSCManager = OpenSCManager_(0, 0, #SC_MANAGER_CREATE_SERVICE)
If hSCManager = #Null
r1 = GetLastError_()
Break
EndIf
hService = OpenService_(hSCManager, SERVICE_NAME, #SERVICE_ALL_ACCESS)
If hService = #Null
r1 = GetLastError_()
Break
EndIf
If QueryServiceStatus_(hService, lpServiceStatus) = #Null
r1 = GetLastError_()
Break
EndIf
If lpServiceStatus\dwCurrentState <> #SERVICE_STOPPED
r1 = #ERROR_SERVICE_ALREADY_RUNNING
Break
EndIf
If DeleteService_(hService) = #Null
r1 = GetLastError_()
Break
EndIf
Until #True
If hService
CloseServiceHandle_(hService)
EndIf
If hSCManager
CloseServiceHandle_(hSCManager)
EndIf
If r1
MessageRequester("Error", "Service not uninstalled! " + FormatMessage(r1), #MB_ICONSTOP)
EndIf
ExitService = 1
Default
;Start the service
ServiceTableEntry\lpServiceName = @SERVICE_NAME
ServiceTableEntry\lpServiceProc = @svServiceMain()
r1 = StartServiceCtrlDispatcher_(@ServiceTableEntry)
If r1 = 0
ExitService = 1
EndIf
EndSelect
Repeat
Delay(100)
Until ExitService = 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()
ExitService = 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()
ExitService = 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)
ExitService = 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
CompilerIf #EnableLogging
;-* Create folder and name for service logfiles
AppPathLog = CreateLogFolder(SERVICE_NAME)
AppPathLog + "Service.log"
; Create mutex for logs
MutexLog = CreateMutex()
CompilerEndIf
WriteLog("Service Start")
;-* Start MainThread
MainThread\Command = #SERVICE_START
MainThread\ThreadID = CreateThread(@thMain(), 0)
If Not MainThread\ThreadID
WriteLog("Service Start - Error: Start MainThread")
MainThread\Command = 0
EndIf
;-* Start MyDataThread
MyDataThread\Command = #SERVICE_START
MyDataThread\ThreadID = CreateThread(@thMyData(), 0)
If Not MyDataThread\ThreadID
WriteLog("Service Start - Error: Start MyDataThread")
MyDataThread\Command = 0
EndIf
ProcedureReturn 1
EndProcedure
; ----
Procedure svPause()
Protected ctime
WriteLog("Service Pause")
MainThread\Command = #SERVICE_CONTROL_PAUSE
MyDataThread\Command = #SERVICE_CONTROL_PAUSE
If IsThread(MainThread\ThreadID)
If WaitThread(MainThread\ThreadID, 30000) = 0
WriteLog("Service Pause - Error Timeout : Kill MainThread")
KillThread(MainThread\ThreadID)
EndIf
EndIf
MainThread\Command = 0
MainThread\ThreadID = 0
If IsThread(MyDataThread\ThreadID)
If WaitThread(MyDataThread\ThreadID, 30000) = 0
WriteLog("Service Pause - Error Timeout : Kill MyDataThread")
KillThread(MyDataThread\ThreadID)
EndIf
EndIf
MyDataThread\Command = 0
MyDataThread\ThreadID = 0
ProcedureReturn 1
EndProcedure
; ----
Procedure svContinue()
WriteLog("Service Continue")
MainThread\Command = #SERVICE_CONTROL_CONTINUE
MainThread\ThreadID = CreateThread(@thMain(), 0)
If Not MainThread\ThreadID
WriteLog("Service Continue - Error: Start MainThread")
MainThread\Command = 0
EndIf
MyDataThread\Command = #SERVICE_CONTROL_CONTINUE
MyDataThread\ThreadID = CreateThread(@thMyData(), 0)
If Not MyDataThread\ThreadID
WriteLog("Service Continue - Error: Start MyDataThread")
MyDataThread\Command = 0
EndIf
ProcedureReturn 1
EndProcedure
; ----
Procedure svStop()
Protected ctime
WriteLog("Service Stop")
MainThread\Command = #SERVICE_CONTROL_STOP
MyDataThread\Command = #SERVICE_CONTROL_STOP
If IsThread(MainThread\ThreadID)
If WaitThread(MainThread\ThreadID, 30000) = 0
WriteLog("Service Stop - Error Timeout : Kill MainThread")
KillThread(MainThread\ThreadID)
EndIf
EndIf
MainThread\Command = 0
MainThread\ThreadID = 0
If IsThread(MyDataThread\ThreadID)
If WaitThread(MyDataThread\ThreadID, 30000) = 0
WriteLog("Service Stop - Error Timeout : Kill MyDataThread")
KillThread(MyDataThread\ThreadID)
EndIf
EndIf
MyDataThread\Command = 0
MyDataThread\ThreadID = 0
ProcedureReturn 1
EndProcedure
; ----
Procedure svInterrogate()
; WriteLog("Service Interrogate")
ProcedureReturn 1
EndProcedure
; ----
Procedure svShutdown()
Protected ctime
WriteLog("Service Shutdown")
MainThread\Command = #SERVICE_CONTROL_SHUTDOWN
MyDataThread\Command = #SERVICE_CONTROL_STOP
If IsThread(MainThread\ThreadID)
If WaitThread(MainThread\ThreadID, 30000) = 0
WriteLog("Service Shutdown - Error Timeout : Kill MainThread")
KillThread(MainThread\ThreadID)
EndIf
EndIf
MainThread\Command = 0
MainThread\ThreadID = 0
If IsThread(MyDataThread\ThreadID)
If WaitThread(MyDataThread\ThreadID, 30000) = 0
WriteLog("Service Shutdown - Error Timeout : Kill MyDataThread")
KillThread(MyDataThread\ThreadID)
EndIf
EndIf
MyDataThread\Command = 0
MyDataThread\ThreadID = 0
ProcedureReturn 1
EndProcedure
; ----
Procedure svUserdata128()
EndProcedure
; ----
Procedure svUserdata129()
EndProcedure
; ----
Procedure svUserdata130()
EndProcedure
; ----
Procedure svUserdata131()
EndProcedure
; ----
;- Service Main
svMain()
End
; *****************************************************************************
;- Thread Main
Procedure thMain(Id)
; Global code for init
WriteLog("MainThread - Init")
Repeat
Select MainThread\Command
Case #SERVICE_START
MainThread\Command = 0
; Code for start
WriteLog("MainThread - Start")
Case #SERVICE_CONTROL_CONTINUE
MainThread\Command = 0
; Code for contine
WriteLog("MainThread - Continue")
Case #SERVICE_CONTROL_PAUSE
MainThread\Command = 0
; Code for pause before exit
WriteLog("MainThread - Pause")
Break
Case #SERVICE_CONTROL_STOP
MainThread\Command = 0
; Code for stop before exit
WriteLog("MainThread - Stop")
Break
Case #SERVICE_CONTROL_SHUTDOWN
MainThread\Command = 0
; Code for shutdown before exit
WriteLog("MainThread - Shutdown")
Break
Default
; Any cycle code
Delay(100)
EndSelect
ForEver
; Global code for exit
WriteLog("MainThread - Exit")
EndProcedure
;- Thread Main
Procedure thMyData(Id)
; Global code for init
WriteLog("MyDataThread - Init")
Repeat
Select MyDataThread\Command
Case #SERVICE_START
MyDataThread\Command = 0
; Code for start
WriteLog("MyDataThread - Start")
Case #SERVICE_CONTROL_CONTINUE
MyDataThread\Command = 0
; Code for contine
WriteLog("MyDataThread - Continue")
Case #SERVICE_CONTROL_PAUSE
MyDataThread\Command = 0
; Code for pause before exit
WriteLog("MyDataThread - Pause")
Break
Case #SERVICE_CONTROL_STOP
MyDataThread\Command = 0
; Code for stop before exit
WriteLog("MyDataThread - Stop")
Break
Case #SERVICE_CONTROL_SHUTDOWN
MyDataThread\Command = 0
; Code for shutdown before exit
WriteLog("MyDataThread - Shutdown")
Break
Default
; Any long cycle code
Delay(5000)
EndSelect
ForEver
; Global code for exit
WriteLog("MyDataThread - Exit")
EndProcedure
; ----