PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

[Rückfrage] Dienst unter Windows starten

https://www.purebasic.fr/german/viewtopic.php?t=31600

Seite 3 von 3

Re: [Rückfrage] Dienst unter Windows starten

Verfasst: 02.08.2019 19:03
von mk-soft
Beispiel mit zwei Threads wobei der Data Thread etwas langsamer reagiert (5000ms im zyklischen Programm)

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
; ----

Re: [Rückfrage] Dienst unter Windows starten

Verfasst: 02.08.2019 19:36
von MenschMarkus
mk-soft hat geschrieben:Schmeiß mal alles wieder weg und nimmt den aktuellen Code für Dienste.
:freak: :roll:

Was tut man nicht alles für Bits und Bytes

Werde den neuen Code testen und Berichten.


Nachtrag: 02.08.19 22:43h

Hab jetzt die Version 2.01 vom 02.08.2019 eingebunden.
Folgende Änderungen waren notwendig.

1. Declare des zweiten Threads auskommentiert
2. in den Prozeduren svInit(), svContinue(), svStop(), svShutDown() und svPause() die Anweisungen für den zweiten Thread auskommentier
3. Die Prozeduren thMain() und thMyData() am Ende des Codes komplett auskommentiert und die thMain() in meinen Haupt Code eingesetzt und mit Anweisungen gefüllt
4. Den Prozeduraufrun svMain() aus dem Dienstcode auskommentiert und als einzigen Aufruf einer Prozedur im Startcode eingefügt

Der Aufruf der mit angeforderten Adminrechten compilierten Datei mit dem Programmparameter "/i" installiert bzw deinstalliert mit dem Programmparameter "/u" den Dienst erfolgreich, wird aber nicht ausgeführt. Eine Anwahl zum starten des Dienstes ist nicht möglich, da alle Menüpunkte ausgegraut sind. Der Dienst ist als Autostarter registriert. Die Statusspalte ist leer.

Soweit der Status Quo.
Alle Zeiten sind UTC+02:00
Seite 3 von 3

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de