Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

NT Service

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • NT Service

    A bare example of a Win NT Service based on various articles.
    Can be started / stopped /paused through the Service Manager
    Code:
    '==================================================================================================
    ' NT Service Skeleton frame. Can only be used without direct user interface. (GUI or character)
    ' Initial date  :   25 October 1999
    '--------------------------------------------------------------------------------------------------
    #Compile Exe
    #Include "WIN32API.INC"
    
    '==================================================================================================
    ' FUNCTION DECLARATIONS
    '--------------------------------------------------------------------------------------------------
    Declare Function Install() As Long
    Declare Function Start() As Long
    Declare Function Uninstall() As Long
    Declare Sub Handler(ByVal Dword)
    Declare Sub ServiceMain(ByVal Dword, ByVal Dword)
    
    '==================================================================================================
    ' GLOBAL VARIABLES
    '--------------------------------------------------------------------------------------------------
    Global ServName         As Asciiz * 64
    Global ServDispName     As Asciiz * 256
    Global hHandlerEvent    As Dword
    Global hServiceStatus   As Dword
    Global hInstance        As Long
    Global SS               As Service_Status
    Global STE              As Service_Table_Entry
    Global gControl         As Long
    Global gShutDown        As Long
    Global SecAtt           As SECURITY_ATTRIBUTES
    
    '==================================================================================================
    ' WinMain   -   Main system function
    '--------------------------------------------------------------------------------------------------
    Function WinMain(ByVal hCurInst As Long, _
                     ByVal hPrvInst As Long, _
                     CmdLine As Asciiz Ptr, _
                     ByVal CmdShow As Long) Export As Long
    
      On Error GoTo WinMain_Error
      Dim LRet As Long, LCommand As String
      LRet = GetCurrentProcess
      LRet = SetPriorityClass (LRet,%Idle_Priority_Class)
      ServName          = "NTService"                                               'Service name.
      ServDispName      = "NTService"                                               'Displayed servicename.
      hInstance         = hCurInst
      LCommand          = LCase$(Command$)
    
      If Instr(LCommand,"uninstall") Then
        LRet = Uninstall                                                            'Uninstall the service.
        If LRet = %True Then MsgBox "Service is uninstalled",%MB_ICONINFORMATION Or %MB_OK,ServDispName
      ElseIf Instr(LCommand,"install") Then
        LRet = Install                                                              'Install the service.
        If LRet = %True Then MsgBox "Service is installed",%MB_ICONINFORMATION Or %MB_OK,ServDispName
      ElseIf Instr(LCommand,"?") Then
        MsgBox "Help on "+ ServDispName + ", usage:"+Chr$(13,13) + _
               "-install or /install (installs this service)" + Chr$(13) + _
               "-uninstall or /uninstall (uninstalls this service)" + Chr$(13) + _
               "-? or /? shows this helpscreen" + Chr$(13) + _
               "No parameters starts the service (if installed)",%MB_ICONQUESTION Or %MB_OK,ServDispName
    
      Else
       Start
      End If
      ExitProcess 0                                                                 'Exit with returncode.
      Exit Function
    
      WinMain_Error:
      ExitProcess  Err                                                              'Error occurred, exit.
    End Function
    
    '==================================================================================================
    ' Install:  Installs service. %TRUE on success, %FALSE on failure, negative on unanticipated error.
    '--------------------------------------------------------------------------------------------------
    Function Install() As Long
      On Error GoTo Error_Install
      Dim LRet As Long, hSCManager As Long, hService As Long, SvcExe As Asciiz * %MAX_PATH
    
      hSCManager = OpenSCManager(ByVal 0, ByVal 0, %SC_MANAGER_CREATE_SERVICE)  'Open the SC Manager
      If hSCManager Then                                                        'Got a handle to SCM.
        LRet = GetModuleFileName(hInstance, SvcExe, %MAX_PATH)                  'Get full EXE filepath.
        If LRet Then                                                            'Install the service.
          hService = CreateService(hSCManager, ServName, ServDispName, _
                       %SERVICE_ALL_ACCESS Or %SERVICE_USER_DEFINED_CONTROL, %SERVICE_WIN32_OWN_PROCESS, _
                       %SERVICE_DEMAND_START, %SERVICE_ERROR_NORMAL, _
                       SvcExe, ByVal %NULL, ByVal %NULL, _
                       ByVal %NULL, ByVal %NULL, ByVal %NULL)
          If hService Then
            Function = %TRUE
            CloseServiceHandle hService
          End If
          CloseServiceHandle hSCManager
        End If
      End If
      Exit Function
    
      Error_Install:
      Function = Err
      On Error Resume Next
      If hService Then CloseServiceHandle hService                              'Close all open service
      If hSCManager Then CloseServiceHandle hSCManager                          'handles before exiting
    End Function
    
    '==================================================================================================
    ' Uninstall:    This function will uninstall the service. Returns %TRUE (-1) on success.
    '--------------------------------------------------------------------------------------------------
    Function Uninstall() As Long
      On Error GoTo Error_Uninstall
      Dim hSCManager As Long, hService As Long
    
      hSCManager = OpenSCManager(ByVal %NULL, ByVal %NULL, %SC_MANAGER_CREATE_SERVICE)
      If hSCManager Then                                                        'Got SCM handle.
        hService = OpenService(hSCManager, ServName, %SERVICE_ALL_ACCESS)
        If DeleteService (hService) Then
          Function = %True
          CloseServiceHandle hService
          CloseServiceHandle hSCManager
        End If
      End If
      Exit Function
    
      Error_Uninstall:
      Function = -1& * Err
      On Error Resume Next
      If hService Then CloseServiceHandle hService                              'If any handles open,
      If hSCManager Then CloseServiceHandle hSCManager                          'close them now
    End Function
    
    '==================================================================================================
    ' Start:    This function will start the service. Returns %TRUE on success.
    '--------------------------------------------------------------------------------------------------
    Function Start() As Long
      On Error GoTo Error_Start
      Dim LRet As Long
      STE.lpServiceName = VarPtr(ServName)
      STE.lpServiceProc = CodePtr(ServiceMain)
      LRet = StartServiceCtrlDispatcher (STE)
      Exit Function
      Error_Start:
    End Function
    
    '==================================================================================================
    ' ServiceMain:      Main code of service, the entry point of the service
    '                   All service processing takes place here
    '--------------------------------------------------------------------------------------------------
    Sub ServiceMain(ByVal dwArgs As Dword, ByVal lpszArgv As Dword)
      On Error Resume Next              'GoTo Error_ServiceMain
      Local lRet As Long, llong As Long
      SS.dwServiceType              = %SERVICE_WIN32_OWN_PROCESS
      SS.dwCurrentState             = %SERVICE_START_PENDING
      SS.dwControlsAccepted         = %SERVICE_ACCEPT_STOP Or %SERVICE_ACCEPT_PAUSE_CONTINUE Or %SERVICE_ACCEPT_SHUTDOWN
      SS.dwWin32ExitCode            = 0
      SS.dwServiceSpecificExitCode  = 0
      SS.dwCheckPoint               = 0
      SS.dwWaitHint                 = 0
      hServiceStatus = RegisterServiceCtrlHandler (ServName, CodePtr(Handler))
      SS.dwCurrentState             = %SERVICE_START_PENDING
      SetServiceStatus hServiceStatus, SS
    '--------------------< Initializationcode goes here >----------------------------------------------
      hHandlerEvent = CreateEvent (ByVal %Null, ByVal 0, ByVal 0, "HandlerEvent"+Chr$(0))
    
    '--------------------< Notify SCM that we're in business... >--------------------------------------
      SS.dwCurrentState             = %SERVICE_RUNNING
      SetServiceStatus hServiceStatus, SS
    '--------------------< Main servicecode. Also HandlerEvents are handled here >---------------------
      While IsFalse gShutDown
        lRet = WaitForSingleObject(ByVal hHandlerEvent, 50)
        Select Case lRet
          Case %WAIT_FAILED
            gShutDown = %True
          Case %WAIT_OBJECT_0
            Select Case gControl
              Case %SERVICE_CONTROL_STOP, %SERVICE_CONTROL_SHUTDOWN
                gShutDown = %True
              Case %SERVICE_CONTROL_PAUSE
                SS.dwCurrentState = %SERVICE_PAUSED
                SetServiceStatus hServiceStatus, SS
              Case %SERVICE_CONTROL_CONTINUE
                SS.dwCurrentState = %SERVICE_RUNNING
                SetServiceStatus hServiceStatus, SS
              Case %SERVICE_CONTROL_INTERROGATE
                SetServiceStatus hServiceStatus, SS
              Case Else
            End Select
          Case %WAIT_TIMEOUT
          Case Else
        End Select
      Wend
      SS.dwCurrentState = %SERVICE_STOP_PENDING
      SetServiceStatus hServiceStatus, SS
      CloseHandle hHandlerEvent
      SS.dwCurrentState = %SERVICE_STOPPED
      SetServiceStatus hServiceStatus, SS
      Exit Sub
      Error_ServiceMain:
    End Sub
    
    '==================================================================================================
    ' Handler: Handles all service requests
    '--------------------------------------------------------------------------------------------------
    Sub Handler(ByVal pControl As Dword)
      On Error GoTo Handler_Error
      gControl = pControl
      SetEvent hHandlerEvent                                                   'Set IPC event.
      Exit Sub
      Handler_Error:
    End Sub
    Peter



    [This message has been edited by Peter Lameijn (edited March 22, 2001).]
    Regards,
    Peter

  • #2
    Code:
    '------------------------------------------------------------------------------
    ' These were AWOL from Win32Api....
    '------------------------------------------------------------------------------
    %PAGE_READONLY                              =  &h2
    %PAGE_READWRITE                             =  &h4
    %PAGE_WRITECOPY                             =  &h8
    %WAIT_FAILED                                = &HFFFFFFFF&
    ------------------
    Kind regards,
    Peter.
    Regards,
    Peter

    Comment


    • #3
      Hello Peter,

      Thanks for the code.

      I took your code and ran it with th install option, everything worked fine.

      But when I go into services and try to start it, i get an error: "0018 Ther are no more files."

      What do i need to do and where do i put my code for this to work?

      Thanks
      Jason

      ------------------

      Comment


      • #4
        Jason,

        Never seen that error before...
        What OS are you using? (I use NT4). The executable must always be installed on a local
        harddisk. Installing it on a networked drive can give unpredictable results.
        Please answer in programming forum.


        ------------------
        Peter.
        mailto[email protected][email protected]</A>

        [This message has been edited by Peter Lameijn (edited April 02, 2001).]
        Regards,
        Peter

        Comment


        • #5
          Peter,

          Thanks for this,

          I ran it on Win2k and all was fine, at first it didn't compile till I added your %WAIT_FAILED = &HFFFFFFFF& code.

          Question: No discription is displayed for the service and I was wondering how to add it, there is nowhere in the CreateService structure for a description. I checked the registry and other services have a string key called description but your doesn't. Any ideas?

          Cheers


          ------------------
          Paul Dwyer
          Network Engineer
          Aussie in Tokyo

          Comment


          • #6
            Please continue these discussions in the Programming or PowerBASIC for WIndows forum.

            Thanks!

            ------------------
            Lance
            PowerBASIC Support
            mailto:[email protected][email protected]</A>
            Lance
            mailto:[email protected]

            Comment

            Working...
            X