ServiceApp/FirstSteps/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
Option Explicit

' a reference to a "NTService"-UserControl-Object
Dim refNTServiceCtrl As NTService.NTService
' a reference to a Timer-Object
Dim refTimer As Timer

Dim currentInitStatus As String

Friend Sub setRefs(ByRef rNTService As NTService.NTService, ByRef rTimer As Timer)
    Set refNTServiceCtrl = rNTService
    Set refTimer = rTimer
End Sub

Friend Sub doStart()

    'Call DebugBreak

On Error GoTo Err_Load
    
    currentInitStatus = "Loading"
    refNTServiceCtrl.Debug = True
    
    ' initialize timer
    currentInitStatus = "Loading configuration"
    Dim parmInterval As String
    parmInterval = refNTServiceCtrl.GetSetting("Parameters", "TimerInterval", "2000")
    refTimer.Interval = CInt(parmInterval)
    
    ' enable Pause/Continue. Must be set before StartService is called or in design mode
    currentInitStatus = "Enabling control mode"
    refNTServiceCtrl.ControlsAccepted = svcCtrlPauseContinue
    
    ' connect service to Windows NT services controller
    currentInitStatus = "Starting"
    refNTServiceCtrl.StartService
    
    Exit Sub
    
Err_Load:
    If refNTServiceCtrl.Interactive Then
        MsgBox "[" & Err.Number & "] " & Err.Description
        End
    Else
        Call refNTServiceCtrl.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
    End If


End Sub

Friend Function doStop()
    refNTServiceCtrl.StopService
End Function

Friend Sub doDebugMode()
    refNTServiceCtrl.Debug = True
End Sub

Friend Sub doInstall()
    Dim logMsg As String
    Dim evType As Variant
    
    'refNTServiceCtrl.Debug = True
    
    ' enable interaction with desktop
    'refNTServiceCtrl.Interactive = True
    refNTServiceCtrl.Interactive = False
    
    ' install service
    If refNTServiceCtrl.Install Then
        Call refNTServiceCtrl.SaveSetting("Parameters", "TimerInterval", "2000")
        logMsg = refNTServiceCtrl.DisplayName & " installed successfully"
        evType = SvcEventType.svcEventSuccess
    Else
        logMsg = refNTServiceCtrl.DisplayName & " failed to install"
        evType = SvcEventType.svcEventError
    End If
    
    ' log/display success
    Call refNTServiceCtrl.LogEvent(evType, 0, logMsg)
    If refNTServiceCtrl.Interactive Then
        MsgBox logMsg
    End If
    
    End
End Sub

Friend Sub doUninstall()
        
    Dim logMsg As String
    Dim evType As Variant
    
    If refNTServiceCtrl.Uninstall Then
        logMsg = refNTServiceCtrl.DisplayName & " uninstalled successfully"
        evType = SvcEventType.svcEventSuccess
    Else
        logMsg = refNTServiceCtrl.DisplayName & " failed to uninstall"
        evType = SvcEventType.svcEventError
    End If
    
    ' log/display success
    Call refNTServiceCtrl.LogEvent(evType, 0, logMsg)
    If refNTServiceCtrl.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			Option Explicit
15
16			' a reference to a "NTService"-UserControl-Object
17			Dim refNTServiceCtrl As NTService.NTService
18			' a reference to a Timer-Object
19			Dim refTimer As Timer
20
21			Dim currentInitStatus As String
22
23			Friend Sub setRefs(ByRef rNTService As NTService.NTService, ByRef rTimer As Timer)
24			Set refNTServiceCtrl = rNTService
25			Set refTimer = rTimer
26			End Sub
27
28			Friend Sub doStart()
29
30			'Call DebugBreak
31
32			On Error GoTo Err_Load
33
34			currentInitStatus = "Loading"
35			refNTServiceCtrl.Debug = True
36
37			' initialize timer
38			currentInitStatus = "Loading configuration"
39			Dim parmInterval As String
40			parmInterval = refNTServiceCtrl.GetSetting("Parameters", "TimerInterval", "2000")
41			refTimer.Interval = CInt(parmInterval)
42
43			' enable Pause/Continue. Must be set before StartService is called or in design mode
44			currentInitStatus = "Enabling control mode"
45			refNTServiceCtrl.ControlsAccepted = svcCtrlPauseContinue
46
47			' connect service to Windows NT services controller
48			currentInitStatus = "Starting"
49			refNTServiceCtrl.StartService
50
51			Exit Sub
52
53			Err_Load:
54			If refNTServiceCtrl.Interactive Then
55			MsgBox "[" & Err.Number & "] " & Err.Description
56			End
57			Else
58			Call refNTServiceCtrl.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
59			End If
60
61
62			End Sub
63
64			Friend Function doStop()
65			refNTServiceCtrl.StopService
66			End Function
67
68			Friend Sub doDebugMode()
69			refNTServiceCtrl.Debug = True
70			End Sub
71
72			Friend Sub doInstall()
73			Dim logMsg As String
74			Dim evType As Variant
75
76			'refNTServiceCtrl.Debug = True
77
78			' enable interaction with desktop
79			'refNTServiceCtrl.Interactive = True
80			refNTServiceCtrl.Interactive = False
81
82			' install service
83			If refNTServiceCtrl.Install Then
84			Call refNTServiceCtrl.SaveSetting("Parameters", "TimerInterval", "2000")
85			logMsg = refNTServiceCtrl.DisplayName & " installed successfully"
86			evType = SvcEventType.svcEventSuccess
87			Else
88			logMsg = refNTServiceCtrl.DisplayName & " failed to install"
89			evType = SvcEventType.svcEventError
90			End If
91
92			' log/display success
93			Call refNTServiceCtrl.LogEvent(evType, 0, logMsg)
94			If refNTServiceCtrl.Interactive Then
95			MsgBox logMsg
96			End If
97
98			End
99			End Sub
100
101			Friend Sub doUninstall()
102
103			Dim logMsg As String
104			Dim evType As Variant
105
106			If refNTServiceCtrl.Uninstall Then
107			logMsg = refNTServiceCtrl.DisplayName & " uninstalled successfully"
108			evType = SvcEventType.svcEventSuccess
109			Else
110			logMsg = refNTServiceCtrl.DisplayName & " failed to uninstall"
111			evType = SvcEventType.svcEventError
112			End If
113
114			' log/display success
115			Call refNTServiceCtrl.LogEvent(evType, 0, logMsg)
116			If refNTServiceCtrl.Interactive Then
117			MsgBox logMsg
118			End If
119
120			End
121
122			End Sub
123
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26