PureBasic

Forums PureBasic
Nous sommes le Mar 19/Jan/2021 16:59

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 1 message ] 
Auteur Message
 Sujet du message: Service Windows
MessagePosté: Sam 16/Mai/2020 16:16 
Hors ligne

Inscription: Mar 05/Nov/2019 18:40
Messages: 34
Bonjour tout le monde,

J'ai trouvé un code rudement bien foutu pour créer son propre service : https://f-lefevre.developpez.com/tutori ... e-windows/

Il fonctionne plutôt bien sauf pour une chose : stopper le service.
Si l'on passe par le gestionnaire de service de Windows, on a droit à un message d'erreur lors de la tentative d'arrêt. Si l'on réessaye, on a droit à un second message d'erreur (différent du premier) mais le service s'arrête (notre .exe disparait bien des processus). Idem si l'on passe par le paramètre -k de l'exécutable. Il faut lancer la commande 2 fois.

Dans les 2 cas, je suis surpris de ne trouver à aucun moment la ligne "Service_MainLoop() > Stop" dans le fichier de log, qui correspond à la sortie de notre boucle infinie principale.
Je teste ce code sous Windows 7 64bits avec Purebasic 5.72 64bits. Pourriez-vous me confirmer ou infirmer le problème que je rencontre ?

Merci d'avance.

Voici le code :

Code:

#MyService_LogFile = "logservice.txt"
#MyService_Name = "testservice"
#MyService_AppName = "test_service.exe"
#MyService_DisplayName = "test_service"
#MyService_Description = "test_service"

Global ServiceStatus.SERVICE_STATUS


Enumeration SC_ACTION_TYPE 0
  #SC_ACTION_NONE
  #SC_ACTION_RESTART
  #SC_ACTION_REBOOT
  #SC_ACTION_RUN_COMMAND
EndEnumeration

#SERVICE_CONTROL_SESSIONCHANGE = $0000000E

Structure SC_ACTION
   Type.l
   Delay.i
EndStructure

Structure SERVICE_FAILURE_ACTIONS
   dwResetPeriod.i
   *lpRebootMsg
   *lpCommand
   cActions.i
   *lpsaActions.SC_ACTION
EndStructure

Structure SERVICE_FAILURE_ACTIONS_FLAG
   fFailureActionsOnNonCrashFailures.l
EndStructure


Procedure WriteToLog(entry.s)
   Protected hFile.l
   hFile = OpenFile(#PB_Any, #MyService_LogFile)
   If hFile = #Null
      ProcedureReturn #False
   EndIf
   FileSeek(hFile, Lof(hFile))
   WriteStringN(hFile, entry)
   CloseFile(hFile)
   ProcedureReturn #True
EndProcedure


Procedure Service_CtrlHandler(CtrlRequest.l)
   WriteToLog("Service_CtrlHandler() > Start")
   Select CtrlRequest
      Case #SERVICE_CONTROL_CONTINUE
         WriteToLog("Monitoring resumed.")
         With ServiceStatus
            \dwCurrentState = #SERVICE_RUNNING
         EndWith

      Case #SERVICE_CONTROL_INTERROGATE
         WriteToLog("Monitoring reported its current status information to the service control manager.")

      Case #SERVICE_CONTROL_PAUSE
         WriteToLog("Monitoring paused.")
         With ServiceStatus
            \dwCurrentState = #SERVICE_PAUSED
         EndWith

      Case #SERVICE_CONTROL_STOP
         ;{
         WriteToLog("Monitoring stopped.")
         
         With ServiceStatus
            \dwCurrentState = #SERVICE_STOP_PENDING
            \dwWin32ExitCode = 0
            \dwServiceSpecificExitCode = 0
            \dwCheckPoint = 0
            \dwWaitHint = 0
         EndWith
         SetServiceStatus_(hStatus, @ServiceStatus)
         ServiceStatus\dwCurrentState = #SERVICE_STOPPED
         SetServiceStatus_(hStatus, @ServiceStatus)
     
     
      Case #SERVICE_CONTROL_SHUTDOWN
         WriteToLog("Monitoring shutdowned.")
         With ServiceStatus
            \dwWin32ExitCode = 0
            \dwCurrentState  = #SERVICE_STOPPED
         EndWith
         
      Case #SERVICE_CONTROL_SESSIONCHANGE
         WriteToLog("Session changed.")
         
      Default
         WriteToLog("CtrlRequest Unknown = "+Str(CtrlRequest))

   EndSelect
   ; Report current status
   SetServiceStatus_(hStatus, @ServiceStatus)
   WriteToLog("Service_CtrlHandler() > End")
EndProcedure


;@desc : Actualiser l'état du service
Procedure Service_UpdateStatus()
   Protected hSCManager.l, hServ.l
   hSCManager  = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
   hServ       = OpenService_(hSCManager, #MyService_Name, #SERVICE_ALL_ACCESS)
   QueryServiceStatus_(hServ, @ServiceStatus)
   CloseServiceHandle_(hServ)
   CloseServiceHandle_(hSCManager)
EndProcedure


Procedure Service_MainLoop()
   Protected hError.l
   Protected memory.MEMORYSTATUS
   
   WriteToLog("Service_MainLoop() > Start")
   With ServiceStatus
      \dwServiceType             = #SERVICE_WIN32_OWN_PROCESS | #SERVICE_INTERACTIVE_PROCESS
      \dwCurrentState            = #SERVICE_START_PENDING
      \dwControlsAccepted        = #SERVICE_ACCEPT_STOP | #SERVICE_ACCEPT_SHUTDOWN | #SERVICE_ACCEPT_PAUSE_CONTINUE | #SERVICE_ACCEPT_SESSIONCHANGE ; SERVICE_CONTROL_SESSIONCHANGE notification
      \dwWin32ExitCode           = 0
      \dwServiceSpecificExitCode = 0
      \dwCheckPoint              = 0
      \dwWaitHint                = 0
   EndWith
   hStatus = RegisterServiceCtrlHandler_(#MyService_Name, @Service_CtrlHandler())
   If hStatus = 0
      WriteToLog("Registering Control Handler failed")
      ProcedureReturn
   EndIf
   SetServiceStatus_(hStatus, @ServiceStatus)
   
   ; Faire l'initialisation ici
   
   ServiceStatus\dwCurrentState = #SERVICE_RUNNING
   SetServiceStatus_(hStatus, @ServiceStatus)
   
   ; La boucle principale
   While ServiceStatus\dwCurrentState = #SERVICE_RUNNING
      
;       Protected buffer.s{16}
;       GlobalMemoryStatus_(@memory)
;       buffer = Str(memory\dwAvailPhys)
;       result = WriteToLog("Mem>"+buffer)
;       If result = #False
;          ServiceStatus\dwCurrentState = #SERVICE_STOPPED
;          ServiceStatus\dwWin32ExitCode= -1
;          SetServiceStatus_(hStatus, @ServiceStatus)
;          ProcedureReturn #False
;       EndIf
      Sleep_(1000)
      Service_UpdateStatus()
      
   Wend
   
   With ServiceStatus
      \dwCurrentState = #SERVICE_STOP_PENDING
      \dwWin32ExitCode = 0
      \dwServiceSpecificExitCode = 0
      \dwCheckPoint = 0
      \dwWaitHint = 0
   EndWith
   SetServiceStatus_(hStatus, @ServiceStatus)
   ServiceStatus\dwCurrentState = #SERVICE_STOPPED
   SetServiceStatus_(hStatus, @ServiceStatus)
   
   WriteToLog("Service_MainLoop() > End")
EndProcedure

; Lance le Service_Mainloop où l'on fera notre traitement
Procedure Service_Default(Name.s)
   Protected Dim ServiceTable.SERVICE_TABLE_ENTRY(1)
   WriteToLog("Service_Default() > Start")
   With ServiceTable(0)
      \lpServiceName = @Name
      \lpServiceProc = @Service_MainLoop()
   EndWith
   With ServiceTable(1)
      \lpServiceName = #Null
      \lpServiceProc = #Null
   EndWith   
   If StartServiceCtrlDispatcher_(@ServiceTable()) = 0
      Protected lnErr.l = GetLastError_()
      Select lnErr
         Case #ERROR_FAILED_SERVICE_CONTROLLER_CONNECT
            WriteToLog("Service_Default() > FAILED_SERVICE_CONTROLLER_CONNECT")
         Case #ERROR_INVALID_DATA
            WriteToLog("Service_Default() > INVALID_DATA")
         Case #ERROR_SERVICE_ALREADY_RUNNING
            WriteToLog("Service_Default() > SERVICE ALREADY_RUNNING")
         Default
            WriteToLog("Service_Default() > " + StrU(lnErr, #PB_Word))
      EndSelect
   EndIf   
   WriteToLog("Service_Default() > End")
EndProcedure

;@desc : Installe le service #MyService_Name dans le ServiceControlManager
Procedure Service_Install()
   Protected sDir.s
   Protected hSCManager.l, hService.l
   Protected SD.SERVICE_DESCRIPTION
   WriteToLog("Service_Install() > Start")
   sDir        = GetCurrentDirectory() + #MyService_AppName
   hSCManager  = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
   ; nous créons le service
   hService    = CreateService_(hSCManager, #MyService_Name, #MyService_DisplayName, #SERVICE_ALL_ACCESS,
                                #SERVICE_WIN32_OWN_PROCESS, #SERVICE_AUTO_START, #SERVICE_ERROR_NORMAL, sDir, #Null, #Null, #Null, #Null, #Null)
   ; nous définissons sa description pour le SCM
   Protected lpDescription$ = #MyService_Description
   SD\lpDescription = @lpDescription$

   If ChangeServiceConfig2_(hService, #SERVICE_CONFIG_DESCRIPTION, @SD)
      Dim sAction.SC_ACTION(3)
      sAction(0)\Type = #SC_ACTION_RESTART
      sAction(0)\Delay = 60000
      sAction(1)\Type = #SC_ACTION_RESTART
      sAction(1)\Delay = 60000
      sAction(2)\Type = #SC_ACTION_NONE
      sAction(2)\Delay = #Null
      
      Protected sFailure.SERVICE_FAILURE_ACTIONS
      With sFailure
         \dwResetPeriod = 86400
         \lpCommand = #Null
         \lpRebootMsg = #Null
         \cActions = 3
         \lpsaActions = sAction()
      EndWith
      
      If ChangeServiceConfig2_(hService, #SERVICE_CONFIG_FAILURE_ACTIONS, @sFailure)
         Protected sFlag.SERVICE_FAILURE_ACTIONS_FLAG
         sFlag\fFailureActionsOnNonCrashFailures = #True
         ChangeServiceConfig2_(hService, #SERVICE_CONFIG_FAILURE_ACTIONS_FLAG, @sFlag)
      EndIf
   EndIf   
      
   CloseServiceHandle_(hService)
   
   WriteToLog("Monitoring installé.")
   WriteToLog("Service_Install() > End")
EndProcedure

;@desc : Désinstalle le service #MyService_Name du ServiceControlManager
Procedure Service_Delete()
   Protected hSCManager.l, hServ.l
   WriteToLog("Service_Delete() > Start")
   hSCManager  = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
   hServ       = OpenService_(hSCManager, #MyService_Name, #SERVICE_ALL_ACCESS)
   DeleteService_(hServ)
   CloseServiceHandle_(hServ)
   CloseServiceHandle_(hSCManager)
   
   WriteToLog("Monitoring désinstallé.")
   WriteToLog("Service_Delete() > End")
EndProcedure

;@desc : Changement d'état : START
Procedure Service_Start()
   Protected hSCManager.l, hServ.l
   WriteToLog("Service_Start() > Start")
   hSCManager  = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
   hServ       = OpenService_(hSCManager, #MyService_Name, #SERVICE_ALL_ACCESS)
   StartService_(hServ, 0, #Null)
   WriteToLog("Monitoring démarré.")
   CloseServiceHandle_(hServ)
   CloseServiceHandle_(hSCManager)
   WriteToLog("Service_Start() > End")
EndProcedure

;@desc : Changement d'état : STOP
Procedure Service_Stop()
   Protected hSCManager.l, hServ.l
   WriteToLog("Service_Stop() > Start")
   hSCManager  = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
   hServ       = OpenService_(hSCManager, #MyService_Name, #SERVICE_ALL_ACCESS)
   ControlService_(hServ, #SERVICE_CONTROL_STOP, @ServiceStatus)
   WriteToLog("Monitoring arrété.")
   CloseServiceHandle_(hServ)
   CloseServiceHandle_(hSCManager)
   WriteToLog("Service_Stop() > End")
EndProcedure

;@desc : Changement d'état : PAUSE > Start
Procedure Service_Pause()
   Protected hSCManager.l, hServ.l
   WriteToLog("Service_Pause() > Start")
   hSCManager  = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
   hServ       = OpenService_(hSCManager, #MyService_Name, #SERVICE_ALL_ACCESS)
   ControlService_(hServ, #SERVICE_CONTROL_PAUSE, @ServiceStatus)
   WriteToLog("Monitoring suspendu.")
   CloseServiceHandle_(hServ)
   CloseServiceHandle_(hSCManager)
   WriteToLog("Service_Pause() > End")
EndProcedure

;@desc : Changement d'état : PAUSE > Stop
Procedure Service_Continue()
   Protected hSCManager.l, hServ.l
   WriteToLog("Service_Continue() > Start")
   hSCManager  = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
   hServ       = OpenService_(hSCManager, #MyService_Name, #SERVICE_ALL_ACCESS)
   ControlService_(hServ, #SERVICE_CONTROL_CONTINUE, @ServiceStatus)
   WriteToLog("Monitoring repris.")
   CloseServiceHandle_(hServ)
   CloseServiceHandle_(hSCManager)
   WriteToLog("Service_Continue() > End")
EndProcedure


Procedure Main()
   Select ProgramParameter(0)
      Case "-i", "install"
         Service_Install()
         Service_Start()
      Case "-d", "delete"
         Service_Stop()
         Service_Delete()
      Case "-s", "start"
         Service_Start()
      Case "-k", "kill", "stop"
         Service_Stop()
      Default
         Service_Default(#MyService_Name)
   EndSelect
EndProcedure


Main()


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 1 message ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 14 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye