A bare example of a Win NT Service based on various articles.
Can be started / stopped /paused through the Service Manager
Peter
[This message has been edited by Peter Lameijn (edited March 22, 2001).]
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
[This message has been edited by Peter Lameijn (edited March 22, 2001).]
Comment