ServiceApp/TestWcronService/ServiceControl.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ServiceControl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

' -----------------------------------------------------------------------------------
'  ntsvcSample
'  sample program including a comfortable wrapper-api for "Microsoft NT Service Control" - Component
'
'  usage:
'  - under "Projects/Components" add "Microsoft NT Service Control"
'  - add a "Microsoft NT Service Control" to your main-form
'  - add a "Timer Control" to your main-form
' -----------------------------------------------------------------------------------

Option Explicit

' a reference to a "Microsoft NT Service Control" - Object
Dim ref_NTServiceControl As NTService.NTService

' a reference to a "Timer Control" - Object
Private ref_NTServiceControlTimer As Timer

' name of the service
Private serviceName As String

' displayname of the service
Private serviceDisplayname As String

' the interval of the "Timer Control" - Object used by the NT Service Controller
Private serviceLoopInterval As Long

' the interval of the "Timer Control" - Object used by the NT Service Controller
Private serviceDebugEnabled As Boolean

' the interval of the "Timer Control" - Object used by the NT Service Controller
Private serviceInteractiveMode As Boolean

Private bool_NTServiceControl_isInitialized As Boolean

' -----------------------------------------------------------------------------------
'   methods for setting/getting private properties

    ' - - - - - - - - - - - - - - - - - - - - - - -
    ' sets references to UserControl-Objects (NTService, Timer) in main-form
    Friend Sub setRefs(ByRef rNTService As NTService.NTService, ByRef rTimer As Timer)
        Set ref_NTServiceControl = rNTService
        Set ref_NTServiceControlTimer = rTimer
    End Sub
    
    ' - - - - - - - - - - - - - - - - - - - - - - -
    Friend Sub setName(ByVal name As String)
        serviceName = name
    End Sub
    
    ' - - - - - - - - - - - - - - - - - - - - - - -
    Friend Sub setDisplayname(ByVal displayname As String)
        serviceDisplayname = displayname
    End Sub
    
    ' - - - - - - - - - - - - - - - - - - - - - - -
    ' sets interval for NT Service Controller - Loop
    Friend Sub setInterval(ByVal interval As Long)
        serviceLoopInterval = interval
    End Sub

    ' - - - - - - - - - - - - - - - - - - - - - - -
    ' sets interval for NT Service Controller - Loop
    Friend Sub setDebugMode(ByVal debugMode As Boolean)
        serviceDebugEnabled = debugMode
    End Sub

    ' - - - - - - - - - - - - - - - - - - - - - - -
    ' sets interval for NT Service Controller - Loop
    Friend Function getDebugMode() As Boolean
        getDebugMode = serviceDebugEnabled
    End Function

    ' - - - - - - - - - - - - - - - - - - - - - - -
    ' sets interval for NT Service Controller - Loop
    Friend Sub setInteractiveMode(ByVal interactiveMode As Boolean)
        serviceInteractiveMode = interactiveMode
    End Sub
    
    Friend Sub NTServiceControl_Initialize()
        With ref_NTServiceControl
            .serviceName = serviceName
            .displayname = serviceDisplayname
            .Debug = serviceDebugEnabled
            .Interactive = serviceInteractiveMode
        End With
        bool_NTServiceControl_isInitialized = True
    End Sub


' -----------------------------------------------------------------------------------
'   methods for controlling services

' - - - - - - - - - - - - - - - - - - - - - - -
Friend Function isServiceInstalled(Optional ByVal arg_serviceName As String = "")

    ' initialize "NT Service Control" in main-form, if not yet done
    If Not bool_NTServiceControl_isInitialized Then NTServiceControl_Initialize
    
    Dim testForServiceName As String
    testForServiceName = serviceName
    If Len(arg_serviceName) Then testForServiceName = arg_serviceName
    
    setCurrentStatus "isServiceInstalled(" & testForServiceName & "):"
    
    Dim parmInterval As String
    On Error Resume Next
        parmInterval = ref_NTServiceControl.GetSetting("Parameters", "TimerInterval", 0)
    If Err.Number = 0 Then
        isServiceInstalled = True
    Else
        isServiceInstalled = False
    End If
    On Error GoTo 0

    setCurrentStatus "  isServiceInstalled(" & testForServiceName & ") = " & isServiceInstalled

End Function

' - - - - - - - - - - - - - - - - - - - - - - -
Friend Sub enableDebugMode()
    ref_NTServiceControl.Debug = True
End Sub

' - - - - - - - - - - - - - - - - - - - - - - -
Friend Sub startService()
    
    ' initialize "NT Service Control" in main-form, if not yet done
    If Not bool_NTServiceControl_isInitialized Then NTServiceControl_Initialize
    
    ' some debug-breakpoint we don't know anything about (from example-code)
    'Call DebugBreak

    On Error GoTo Err_Load
    
    ' initialize timer
    setCurrentStatus "startService: loading configuration from Service"
    Dim parmInterval As String
    setCurrentStatus "startService: .GetSetting"
    parmInterval = ref_NTServiceControl.GetSetting("Parameters", "TimerInterval", serviceLoopInterval)
    setCurrentStatus "startService: .interval=" & CInt(parmInterval)
    ref_NTServiceControlTimer.interval = CInt(parmInterval)
    
    ' enable Pause/Continue. Must be set before StartService is called or in design mode
    setCurrentStatus "Enabling control mode"
    ref_NTServiceControl.ControlsAccepted = svcCtrlPauseContinue
    
    ' connect service to Windows NT services controller
    setCurrentStatus "Starting"
    ref_NTServiceControl.startService
    
    Call ref_NTServiceControl.LogEvent(svcEventError, svcMessageError, "started service")
    Exit Sub
    
Err_Load:
    If ref_NTServiceControl.Interactive Then
        MsgBox "[" & Err.Number & "] " & Err.Description
        End
    Else
        Call ref_NTServiceControl.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
    End If

End Sub

' - - - - - - - - - - - - - - - - - - - - - - -
Friend Function stopService()
    ref_NTServiceControl.stopService
End Function

' - - - - - - - - - - - - - - - - - - - - - - -
Friend Function doMainLoop()
    DoEvents
End Function


' - - - - - - - - - - - - - - - - - - - - - - -
Friend Sub installService()
    
    ' initialize "NT Service Control" in main-form, if not yet done
    If Not bool_NTServiceControl_isInitialized Then NTServiceControl_Initialize
    
    Dim logMsg As String
    Dim evType As Variant
    
    'ref_NTServiceControl.Debug = True
    
    ' enable interaction with desktop
    'ref_NTServiceControl.Interactive = True
    'ref_NTServiceControl.Interactive = False
    'ref_NTServiceControl.Debug = False
    
    ref_NTServiceControl.StartMode = svcStartManual
    
    ' install service
    If ref_NTServiceControl.Install Then
        Call ref_NTServiceControl.SaveSetting("Parameters", "TimerInterval", serviceLoopInterval)
        logMsg = "Service """ & ref_NTServiceControl.displayname & """ installed successfully."
        evType = SvcEventType.svcEventSuccess
    Else
        logMsg = "Installation of service """ & ref_NTServiceControl.displayname & """ failed."
        evType = SvcEventType.svcEventError
    End If
    
    ' log/display success
    'Call ref_NTServiceControl.LogEvent(evType, 0, logMsg)
    If ref_NTServiceControl.Interactive Then
        MsgBox logMsg
    End If
    
    'End
End Sub


' - - - - - - - - - - - - - - - - - - - - - - -
Friend Sub uninstallService()
        
    Dim logMsg As String
    Dim evType As Variant
    
    If ref_NTServiceControl.Uninstall Then
        logMsg = "Service """ & ref_NTServiceControl.displayname & """ successfully removed."
        evType = SvcEventType.svcEventSuccess
    Else
        logMsg = "Removal of service """ & ref_NTServiceControl.displayname & """ failed."
        evType = SvcEventType.svcEventError
    End If
    
    ' log/display success
    'Call ref_NTServiceControl.LogEvent(evType, 0, logMsg)
    If ref_NTServiceControl.Interactive Then
        MsgBox logMsg
    End If
    
    'End

End Sub

1	joko	1.1	VERSION 1.0 CLASS
2			BEGIN
3			MultiUse = -1 'True
4			Persistable = 0 'NotPersistable
5			DataBindingBehavior = 0 'vbNone
6			DataSourceBehavior = 0 'vbNone
7			MTSTransactionMode = 0 'NotAnMTSObject
8			END
9			Attribute VB_Name = "ServiceControl"
10			Attribute VB_GlobalNameSpace = False
11			Attribute VB_Creatable = True
12			Attribute VB_PredeclaredId = False
13			Attribute VB_Exposed = False
14
15			' -----------------------------------------------------------------------------------
16			' ntsvcSample
17			' sample program including a comfortable wrapper-api for "Microsoft NT Service Control" - Component
18			'
19			' usage:
20			' - under "Projects/Components" add "Microsoft NT Service Control"
21			' - add a "Microsoft NT Service Control" to your main-form
22			' - add a "Timer Control" to your main-form
23			' -----------------------------------------------------------------------------------
24
25			Option Explicit
26
27			' a reference to a "Microsoft NT Service Control" - Object
28			Dim ref_NTServiceControl As NTService.NTService
29
30			' a reference to a "Timer Control" - Object
31			Private ref_NTServiceControlTimer As Timer
32
33			' name of the service
34			Private serviceName As String
35
36			' displayname of the service
37			Private serviceDisplayname As String
38
39			' the interval of the "Timer Control" - Object used by the NT Service Controller
40			Private serviceLoopInterval As Long
41
42			' the interval of the "Timer Control" - Object used by the NT Service Controller
43			Private serviceDebugEnabled As Boolean
44
45			' the interval of the "Timer Control" - Object used by the NT Service Controller
46			Private serviceInteractiveMode As Boolean
47
48			Private bool_NTServiceControl_isInitialized As Boolean
49
50			' -----------------------------------------------------------------------------------
51			' methods for setting/getting private properties
52
53			' - - - - - - - - - - - - - - - - - - - - - - -
54			' sets references to UserControl-Objects (NTService, Timer) in main-form
55			Friend Sub setRefs(ByRef rNTService As NTService.NTService, ByRef rTimer As Timer)
56			Set ref_NTServiceControl = rNTService
57			Set ref_NTServiceControlTimer = rTimer
58			End Sub
59
60			' - - - - - - - - - - - - - - - - - - - - - - -
61			Friend Sub setName(ByVal name As String)
62			serviceName = name
63			End Sub
64
65			' - - - - - - - - - - - - - - - - - - - - - - -
66			Friend Sub setDisplayname(ByVal displayname As String)
67			serviceDisplayname = displayname
68			End Sub
69
70			' - - - - - - - - - - - - - - - - - - - - - - -
71			' sets interval for NT Service Controller - Loop
72			Friend Sub setInterval(ByVal interval As Long)
73			serviceLoopInterval = interval
74			End Sub
75
76			' - - - - - - - - - - - - - - - - - - - - - - -
77			' sets interval for NT Service Controller - Loop
78			Friend Sub setDebugMode(ByVal debugMode As Boolean)
79			serviceDebugEnabled = debugMode
80			End Sub
81
82			' - - - - - - - - - - - - - - - - - - - - - - -
83			' sets interval for NT Service Controller - Loop
84			Friend Function getDebugMode() As Boolean
85			getDebugMode = serviceDebugEnabled
86			End Function
87
88			' - - - - - - - - - - - - - - - - - - - - - - -
89			' sets interval for NT Service Controller - Loop
90			Friend Sub setInteractiveMode(ByVal interactiveMode As Boolean)
91			serviceInteractiveMode = interactiveMode
92			End Sub
93
94			Friend Sub NTServiceControl_Initialize()
95			With ref_NTServiceControl
96			.serviceName = serviceName
97			.displayname = serviceDisplayname
98			.Debug = serviceDebugEnabled
99			.Interactive = serviceInteractiveMode
100			End With
101			bool_NTServiceControl_isInitialized = True
102			End Sub
103
104
105			' -----------------------------------------------------------------------------------
106			' methods for controlling services
107
108			' - - - - - - - - - - - - - - - - - - - - - - -
109			Friend Function isServiceInstalled(Optional ByVal arg_serviceName As String = "")
110
111			' initialize "NT Service Control" in main-form, if not yet done
112			If Not bool_NTServiceControl_isInitialized Then NTServiceControl_Initialize
113
114			Dim testForServiceName As String
115			testForServiceName = serviceName
116			If Len(arg_serviceName) Then testForServiceName = arg_serviceName
117
118			setCurrentStatus "isServiceInstalled(" & testForServiceName & "):"
119
120			Dim parmInterval As String
121			On Error Resume Next
122			parmInterval = ref_NTServiceControl.GetSetting("Parameters", "TimerInterval", 0)
123			If Err.Number = 0 Then
124			isServiceInstalled = True
125			Else
126			isServiceInstalled = False
127			End If
128			On Error GoTo 0
129
130			setCurrentStatus " isServiceInstalled(" & testForServiceName & ") = " & isServiceInstalled
131
132			End Function
133
134			' - - - - - - - - - - - - - - - - - - - - - - -
135			Friend Sub enableDebugMode()
136			ref_NTServiceControl.Debug = True
137			End Sub
138
139			' - - - - - - - - - - - - - - - - - - - - - - -
140			Friend Sub startService()
141
142			' initialize "NT Service Control" in main-form, if not yet done
143			If Not bool_NTServiceControl_isInitialized Then NTServiceControl_Initialize
144
145			' some debug-breakpoint we don't know anything about (from example-code)
146			'Call DebugBreak
147
148			On Error GoTo Err_Load
149
150			' initialize timer
151			setCurrentStatus "startService: loading configuration from Service"
152			Dim parmInterval As String
153			setCurrentStatus "startService: .GetSetting"
154			parmInterval = ref_NTServiceControl.GetSetting("Parameters", "TimerInterval", serviceLoopInterval)
155			setCurrentStatus "startService: .interval=" & CInt(parmInterval)
156			ref_NTServiceControlTimer.interval = CInt(parmInterval)
157
158			' enable Pause/Continue. Must be set before StartService is called or in design mode
159			setCurrentStatus "Enabling control mode"
160			ref_NTServiceControl.ControlsAccepted = svcCtrlPauseContinue
161
162			' connect service to Windows NT services controller
163			setCurrentStatus "Starting"
164			ref_NTServiceControl.startService
165
166			Call ref_NTServiceControl.LogEvent(svcEventError, svcMessageError, "started service")
167			Exit Sub
168
169			Err_Load:
170			If ref_NTServiceControl.Interactive Then
171			MsgBox "[" & Err.Number & "] " & Err.Description
172			End
173			Else
174			Call ref_NTServiceControl.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
175			End If
176
177			End Sub
178
179			' - - - - - - - - - - - - - - - - - - - - - - -
180			Friend Function stopService()
181			ref_NTServiceControl.stopService
182			End Function
183
184			' - - - - - - - - - - - - - - - - - - - - - - -
185			Friend Function doMainLoop()
186			DoEvents
187			End Function
188
189
190			' - - - - - - - - - - - - - - - - - - - - - - -
191			Friend Sub installService()
192
193			' initialize "NT Service Control" in main-form, if not yet done
194			If Not bool_NTServiceControl_isInitialized Then NTServiceControl_Initialize
195
196			Dim logMsg As String
197			Dim evType As Variant
198
199			'ref_NTServiceControl.Debug = True
200
201			' enable interaction with desktop
202			'ref_NTServiceControl.Interactive = True
203			'ref_NTServiceControl.Interactive = False
204			'ref_NTServiceControl.Debug = False
205
206			ref_NTServiceControl.StartMode = svcStartManual
207
208			' install service
209			If ref_NTServiceControl.Install Then
210			Call ref_NTServiceControl.SaveSetting("Parameters", "TimerInterval", serviceLoopInterval)
211			logMsg = "Service """ & ref_NTServiceControl.displayname & """ installed successfully."
212			evType = SvcEventType.svcEventSuccess
213			Else
214			logMsg = "Installation of service """ & ref_NTServiceControl.displayname & """ failed."
215			evType = SvcEventType.svcEventError
216			End If
217
218			' log/display success
219			'Call ref_NTServiceControl.LogEvent(evType, 0, logMsg)
220			If ref_NTServiceControl.Interactive Then
221			MsgBox logMsg
222			End If
223
224			'End
225			End Sub
226
227
228			' - - - - - - - - - - - - - - - - - - - - - - -
229			Friend Sub uninstallService()
230
231			Dim logMsg As String
232			Dim evType As Variant
233
234			If ref_NTServiceControl.Uninstall Then
235			logMsg = "Service """ & ref_NTServiceControl.displayname & """ successfully removed."
236			evType = SvcEventType.svcEventSuccess
237			Else
238			logMsg = "Removal of service """ & ref_NTServiceControl.displayname & """ failed."
239			evType = SvcEventType.svcEventError
240			End If
241
242			' log/display success
243			'Call ref_NTServiceControl.LogEvent(evType, 0, logMsg)
244			If ref_NTServiceControl.Interactive Then
245			MsgBox logMsg
246			End If
247
248			'End
249
250			End Sub
251
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26