Win Service

EnableExplicit
 
DeclareModule Service
  
  Enumeration
    #RUNNING
    #PAUSED
    #STOPPED
  EndEnumeration  
  
  Declare.b Initialize(ServiceName.s, DisplayName.s, Description.s)
  Declare.b Install()
  Declare.b Uninstall()
  Declare.b Run(*lpMainProc)
  Declare.l Event()
  Declare Logs(Message.s)
  
EndDeclareModule
 
Module Service
  
  Structure SERVICE
    ServiceName.s
    DisplayName.s
    Description.s
    Initialize.b
    CtrlHandler.l
    *MainProc
  EndStructure 
 
  ;- Глобальные переменные
  
  Global App.s = ProgramFilename()
  
  Global service.SERVICE
  Global status.SERVICE_STATUS
  
  Procedure ControlHandler(Control.l)
    Select Control
      Case #SERVICE_CONTROL_INTERROGATE
      Case #SERVICE_CONTROL_CONTINUE
        With status
          \dwWin32ExitCode = 0
          \dwCurrentState = #SERVICE_RUNNING
        EndWith    
      Case #SERVICE_CONTROL_PAUSE
        With status
          \dwWin32ExitCode = 0
          \dwCurrentState = #SERVICE_PAUSED
        EndWith  
      Case #SERVICE_CONTROL_STOP
        With status
          \dwWin32ExitCode = 0
          \dwCurrentState = #SERVICE_STOPPED
        EndWith
      Case #SERVICE_CONTROL_SHUTDOWN
        With status
          \dwWin32ExitCode = 0
          \dwCurrentState = #SERVICE_STOPPED
        EndWith
    EndSelect
    SetServiceStatus_(service\CtrlHandler, @status)
  EndProcedure
  
  Procedure MainHandler()
    
    service\CtrlHandler = RegisterServiceCtrlHandler_(@service\ServiceName, @ControlHandler())
    If (service\CtrlHandler)
      status\dwCurrentState = #SERVICE_START_PENDING
      SetServiceStatus_(service\CtrlHandler, @status)
      status\dwCurrentState = #SERVICE_RUNNING
      SetServiceStatus_(service\CtrlHandler, @status)
      If service\MainProc
        CallFunctionFast(service\MainProc)
      EndIf  
      status\dwCurrentState = #SERVICE_STOP_PENDING
      SetServiceStatus_(service\CtrlHandler, @status)
      status\dwCurrentState = #SERVICE_STOPPED
      SetServiceStatus_(service\CtrlHandler, @status)
    EndIf 
    
  EndProcedure  
  
  Procedure.b Initialize(ServiceName.s, DisplayName.s, Description.s)
    If (Len(ServiceName) And Len(DisplayName) And Len(Description))
      With service
        \ServiceName = ServiceName
        \DisplayName = DisplayName
        \Description = Description
        \Initialize = #True
      EndWith 
    EndIf
    ProcedureReturn service\Initialize
  EndProcedure  
  
  Procedure.b Install()
    
    Protected bResult.b, hManager.l, hService.l, description.SERVICE_DESCRIPTION, Bytes.l
    
    If (service\Initialize)
      hManager = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
      If hManager
        hService = CreateService_(hManager, @service\ServiceName, @service\DisplayName, #SERVICE_ALL_ACCESS, #SERVICE_WIN32_OWN_PROCESS|#SERVICE_INTERACTIVE_PROCESS, #SERVICE_AUTO_START, #SERVICE_ERROR_NORMAL, @App, #Null, #Null, #Null, #Null, #Null)
        If hService
          description\lpDescription = @service\Description
          If ChangeServiceConfig2_(hService, #SERVICE_CONFIG_DESCRIPTION, @description)
            bResult = StartService_(hService, #Null, #Null)
            If (bResult Or (GetLastError_() = #ERROR_SERVICE_ALREADY_RUNNING))
              bResult = #True
            Else
              
              ;~ Удаление
              QueryServiceConfig_(hService, #Null, 0, @Bytes)
              If (GetLastError_() = #ERROR_INSUFFICIENT_BUFFER)
                Define *config.QUERY_SERVICE_CONFIG = AllocateMemory(Bytes)
                If *config
                  If QueryServiceConfig_(hService, *config, Bytes, @Bytes)
                    Select *config\dwStartType
                      Case #SERVICE_AUTO_START, #SERVICE_DEMAND_START, #SERVICE_DISABLED
                        If ChangeServiceConfig_(hService, #SERVICE_NO_CHANGE, #SERVICE_DISABLED, #SERVICE_NO_CHANGE, #Null, #Null, #Null, #Null, #Null, #Null, #Null)
                          DeleteService_(hService)
                        EndIf  
                    EndSelect    
                  EndIf  
                  FreeMemory(*config)
                EndIf  
              EndIf  
              
            EndIf
          EndIf  
          CloseServiceHandle_(hService)
        EndIf  
        CloseServiceHandle_(hManager)
      EndIf  
    EndIf
    ProcedureReturn bResult
    
  EndProcedure  
  
  Procedure.b Uninstall()
    
    Protected bResult.b, hManager.l, hService.l, status.SERVICE_STATUS, Bytes.l, Returned.l, hOpen.l
    
    If service\Initialize
      hManager = OpenSCManager_(#Null, #Null, #SC_MANAGER_ALL_ACCESS)
      If hManager
        hService = OpenService_(hManager, @service\ServiceName, #SERVICE_ALL_ACCESS)
        If hService
          
          ;~ Остановка сервиса перед удалением, если он запущен
          ControlService_(hService, #SERVICE_CONTROL_STOP, @status)
          Select GetLastError_()
            Case #ERROR_DEPENDENT_SERVICES_RUNNING
              EnumDependentServices_(hService, #SERVICE_ACTIVE, #Null, 0, @Bytes, @Returned)
              If (GetLastError_() = #ERROR_MORE_DATA)
                Dim services.ENUM_SERVICE_STATUS((Bytes / SizeOf(ENUM_SERVICE_STATUS)) + 1)
                If EnumDependentServices_(hService, #SERVICE_ACTIVE, @services(0), (SizeOf(ENUM_SERVICE_STATUS) * ArraySize(Services())), @Bytes, @Returned)
                  While Returned
                    If services(Returned - 1)\lpServiceName
                      hOpen = OpenService_(hManager, Services(Returned - 1)\lpServiceName, #SERVICE_ALL_ACCESS)
                      If hOpen
                        ControlService_(hOpen, #SERVICE_CONTROL_STOP, @status)
                        CloseServiceHandle_(hOpen)
                      EndIf
                    EndIf  
                  Wend
                EndIf
                FreeArray(services())
              EndIf  
          EndSelect
          
          ;~ Удаление из автозагрузки
          QueryServiceConfig_(hService, #Null, 0, @Bytes)
          If (GetLastError_() = #ERROR_INSUFFICIENT_BUFFER)
            Define *config.QUERY_SERVICE_CONFIG = AllocateMemory(Bytes)
            If *config
              If QueryServiceConfig_(hService, *config, Bytes, @Bytes)
                Select *config\dwStartType
                  Case #SERVICE_AUTO_START, #SERVICE_DEMAND_START, #SERVICE_DISABLED
                    bResult = ChangeServiceConfig_(hService, #SERVICE_NO_CHANGE, #SERVICE_DISABLED, #SERVICE_NO_CHANGE, #Null, #Null, #Null, #Null, #Null, #Null, #Null) 
                EndSelect    
              EndIf
              FreeMemory(*config)
            EndIf  
          EndIf  
          
          bResult = DeleteService_(hService)
          
          CloseServiceHandle_(hService)
        EndIf  
        CloseServiceHandle_(hManager)
      EndIf  
    EndIf  
    ProcedureReturn bResult
    
  EndProcedure  
  
  Procedure.b Run(*lpMainProc)
    
    Protected bResult.b, table.SERVICE_TABLE_ENTRY
    
    If (service\Initialize)
      
      service\MainProc = *lpMainProc
      
      With table
        \lpServiceName = @service\ServiceName
        \lpServiceProc = @MainHandler()
      EndWith
      
      With status
        \dwServiceType = #SERVICE_WIN32_OWN_PROCESS|#SERVICE_INTERACTIVE_PROCESS
        \dwControlsAccepted = #SERVICE_ACCEPT_PAUSE_CONTINUE|#SERVICE_ACCEPT_STOP|#SERVICE_ACCEPT_SHUTDOWN
        \dwWin32ExitCode = 0
        \dwServiceSpecificExitCode = 0
        \dwCheckPoint = 0
        \dwWaitHint = 0
      EndWith
      
      bResult = StartServiceCtrlDispatcher_(@table)
      
    EndIf  
    
    ProcedureReturn bResult
    
  EndProcedure  
 
  Procedure.l Event()
    
    Protected Result.l
    
    Select status\dwCurrentState
      Case #SERVICE_RUNNING
        Result = #RUNNING
      Case #SERVICE_PAUSED
        Result = #PAUSED
      Case #SERVICE_STOPPED
        Result = #STOPPED
      Default
        Result = status\dwCurrentState
    EndSelect    
    
    ProcedureReturn Result
    
  EndProcedure  
  
  Procedure Logs(Message.s)
    
    Protected hFile.l = OpenFile(#PB_Any, App + ".log")
    
    If hFile
      FileSeek(hFile, Lof(hFile))
      WriteStringN(hFile, FormatDate("%yyyy/%mm/%dd %hh:%ii:%ss", Date()) + " [" + Str(GetCurrentProcessId_()) + "] >> " + Message)
      CloseFile(hFile)
    EndIf
  EndProcedure
  
EndModule
 
 
Procedure ServiceMain()
  
  Define flag = #True
  
  Repeat
    Select Service::Event()
      Case Service::#RUNNING
        If (flag)
          Service::Logs("Service start")
          flag = #False
        EndIf  
      Case Service::#PAUSED
        Service::Logs("Service pause")
      Case Service::#STOPPED
        Service::Logs("Service stop")
        Break
    EndSelect
  ForEver
 
EndProcedure  
 
If Service::Initialize("pbService", "pbService", "Тестирование службы на PureBasic")
  Select ProgramParameter(0)
    Case "-i"
      If (Not Service::Install())
        Service::Logs("Service error install")
      EndIf  
    Case "-d"
      If (Not Service::Uninstall())
        Service::Logs("Service error removed")
      EndIf
    Default
      If (Not Service::Run(@ServiceMain()))
        Service::Logs("Service error started")
      EndIf
  EndSelect    
EndIf