ServiceApp/TestWcronService/FormMain.frm

VERSION 5.00
Object = "{E7BC34A0-BA86-11CF-84B1-CBC2DA68BF6C}#1.0#0"; "NTSVC.ocx"
Begin VB.Form FormMain 
   Caption         =   "FormMain"
   ClientHeight    =   3645
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7275
   LinkTopic       =   "Form1"
   ScaleHeight     =   3645
   ScaleWidth      =   7275
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton Command_UninstallService 
      Caption         =   "Uninstall Service"
      Height          =   345
      Left            =   5550
      TabIndex        =   3
      Top             =   450
      Width           =   1695
   End
   Begin VB.CommandButton Command_InstallService 
      Caption         =   "Install Service"
      Height          =   345
      Left            =   5550
      TabIndex        =   2
      Top             =   90
      Width           =   1695
   End
   Begin VB.Timer TimerMain 
      Interval        =   250
      Left            =   6810
      Top             =   840
   End
   Begin VB.TextBox Text_Now 
      Height          =   285
      Left            =   90
      TabIndex        =   1
      Top             =   2580
      Width           =   1485
   End
   Begin NTService.NTService NTService1 
      Left            =   30
      Top             =   3210
      _Version        =   65536
      _ExtentX        =   741
      _ExtentY        =   741
      _StockProps     =   0
      ServiceName     =   "Simple"
      StartMode       =   3
   End
   Begin VB.TextBox Text_Status 
      Height          =   2445
      Left            =   90
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   120
      Width           =   5385
   End
   Begin VB.Timer Timer1 
      Left            =   360
      Top             =   3210
   End
End
Attribute VB_Name = "FormMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


' =================================================================
'               main
' =================================================================

' --------------------------------------------------------------------
' variable-declarations

    ' cfg's, to ini-file...?
    Dim glbl_cfg_ServiceName As String
    Dim glbl_cfg_ServiceDisplayname As String
    Dim glbl_cfg_ServiceLoopInterval As Long
    Dim glbl_cfg_DebugEnabled As Boolean
    Dim glbl_cfg_InteractiveMode As Boolean

    ' the "ServiceControl"-Object
    Dim serviceCtrl As ServiceControl
    Dim applicationMode As svcApplicationMode

' --------------------------------------------------------------------
' event triggered by win32 on application-startup
Private Sub Form_Load()
    
    ' 1. WCron-GUI-Setup
    setupForm
    
    ' - - - - - - - - - - - - - -
    ' 1.5. "NT Service"-Initialization
    initVars
    
    ' configure the "ApplicationMode" which is either "appMode_Standalone" or "appMode_NTService"
    applicationMode = configureApplicationStartup()
    
    ' if we are installed as a service, try to start like a service!
    If applicationMode = appMode_NTService Then
        serviceCtrl.startService
    End If
    ' - - - - - - - - - - - - - -
    
    ' 2. continue with WCron-Actions ;)
    ' ....
    
End Sub

' --------------------------------------------------------------------
' event triggered by win32 on application-shutdown
Private Sub Form_Unload(Cancel As Integer)
    ' if we are installed as a service, try to stop like a service!
    If applicationMode = appMode_NTService Then
        serviceCtrl.stopService
    End If
End Sub

' --------------------------------------------------------------------
' initialize "NT Service" - Variables
Private Sub initVars()
    setCurrentStatus "initVars:"
    glbl_cfg_ServiceName = "WCron"
    glbl_cfg_ServiceDisplayname = "WCron"
    glbl_cfg_ServiceLoopInterval = 2000
    glbl_cfg_DebugEnabled = False
    glbl_cfg_InteractiveMode = True
End Sub

' --------------------------------------------------------------------
' do own (gui-)stuff to setup the form right here
Private Sub setupForm()
    
    ' dummy function:
    setCurrentStatus "setupForm:"
    
End Sub

Private Sub TimerMain_Timer()
    Dim curData As String
    curData = Format(Now(), "hh:mm:ss")
    Text_Now.Text = curData
    If serviceCtrl.getDebugMode = True Then
        'writeToEventLog SvcEventType.svcEventInformation, 0, "running: " & curData
    End If
End Sub

Private Sub Command_InstallService_Click()
    serviceCtrl.installService
End Sub

Private Sub Command_UninstallService_Click()
    serviceCtrl.uninstallService
End Sub


' =================================================================
'       "NT Service" - functionality / EVENTS!
' =================================================================

' --------------------------------------------------------------------
' here is determined and handled if the application should run "standalone" or as an "nt-service"
Private Function configureApplicationStartup() As svcApplicationMode
    
    setCurrentStatus "configureApplicationStartup:"
    
    Set serviceCtrl = New ServiceControl
    With serviceCtrl
        .setRefs NTService1, Timer1
        .setName glbl_cfg_ServiceName
        .setDisplayname glbl_cfg_ServiceDisplayname
        .setInterval glbl_cfg_ServiceLoopInterval
        .setDebugMode glbl_cfg_DebugEnabled
        If IsIDE Then .setDebugMode True
        .setInteractiveMode glbl_cfg_InteractiveMode
    End With
    
    ' just try if we can startup as nt-service (requires that the service was previously installed in system) ...
    If serviceCtrl.isServiceInstalled() And Not serviceCtrl.getDebugMode = True Then
        ' ... if we can, run us as a "nt-service" ...
        configureApplicationStartup = appMode_NTService
        setCurrentStatus "configureApplicationStartup = appMode_NTService"
    Else
        ' ... if not, run us as "standalone"
        configureApplicationStartup = appMode_Standalone
        setCurrentStatus "configureApplicationStartup = appMode_Standalone"
    End If

End Function


' here are the events triggered if a service recieves ...

' --------------------------------------------------------------------
' ... a control-event (most actually from the NT Service Controller (-API))
Private Sub NTService1_Control(ByVal e As Long)

    MsgBox "control"

On Error GoTo Err_Control
    
    'StatusBar.SimpleText = NTService1.DisplayName & " Control signal " & e
    Exit Sub

Err_Control:
    Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub

' --------------------------------------------------------------------
' ... a start-event
Private Sub NTService1_Start(Success As Boolean)
On Error GoTo Err_Start
    
    setCurrentStatus "Running"
    Success = True
    Call NTService1.LogEvent(SvcEventType.svcEventSuccess, 0, "Service started successfully")
    'Unload Me
    'Exit Sub
    
Err_Start:
    Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub

' --------------------------------------------------------------------
' ... a stop-event
Private Sub NTService1_Stop()

    On Error GoTo Err_Stop
    
    writeToEventLog SvcEventType.svcEventInformation, 0, "Service recieved stop-request"
    
    setCurrentStatus "Stopped"
    Unload Me
    End
    Exit Sub
    
Err_Stop:
    Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub

' --------------------------------------------------------------------
' ... a pause-event
Private Sub NTService1_Pause(Success As Boolean)
On Error GoTo Err_Pause
    
    Timer1.Enabled = False
    setCurrentStatus "Paused"
    Call NTService1.LogEvent(SvcEventType.svcEventInformation, svcMessageInfo, "Service paused")
    Success = True
    Exit Sub
    
Err_Pause:
    Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub

' --------------------------------------------------------------------
' ... a continue-event
Private Sub NTService1_Continue(Success As Boolean)
On Error GoTo Err_Continue
    
    Timer1.Enabled = True
    setCurrentStatus "Running"
    Success = True
    Call NTService1.LogEvent(SvcEventType.svcEventInformation, svcMessageInfo, "Service continued")
    Exit Sub
    
Err_Continue:
    Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
End Sub

' --------------------------------------------------------------------
' the main timer-event
Private Sub Timer1_Timer()

    On Error GoTo Err_Timer
    
    serviceCtrl.doMainLoop
    Exit Sub
    
Err_Timer:
    Call NTService1.LogEvent(svcEventError, svcMessageError, "An error occoured in the main loop of the service")

End Sub


Private Function writeToEventLog(EventType As Integer, ID As Long, Message As String) As Boolean
    
    Dim msg As String
    
    msg = _
        vbCrLf & _
        String(10, "-") & vbCrLf & _
        Message & vbCrLf
        
    If EventType = SvcEventType.svcEventError Then
        msg = msg & _
            String(10, "-") & vbCrLf & _
            "[#" & Err.Number & "] " & Err.Description
    End If
    
    Call NTService1.LogEvent(EventType, ID, msg)
    
End Function
1	joko	1.1	VERSION 5.00
2			Object = "{E7BC34A0-BA86-11CF-84B1-CBC2DA68BF6C}#1.0#0"; "NTSVC.ocx"
3			Begin VB.Form FormMain
4			Caption = "FormMain"
5			ClientHeight = 3645
6			ClientLeft = 60
7			ClientTop = 345
8			ClientWidth = 7275
9			LinkTopic = "Form1"
10			ScaleHeight = 3645
11			ScaleWidth = 7275
12			StartUpPosition = 1 'CenterOwner
13			Begin VB.CommandButton Command_UninstallService
14			Caption = "Uninstall Service"
15			Height = 345
16			Left = 5550
17			TabIndex = 3
18			Top = 450
19			Width = 1695
20			End
21			Begin VB.CommandButton Command_InstallService
22			Caption = "Install Service"
23			Height = 345
24			Left = 5550
25			TabIndex = 2
26			Top = 90
27			Width = 1695
28			End
29			Begin VB.Timer TimerMain
30			Interval = 250
31			Left = 6810
32			Top = 840
33			End
34			Begin VB.TextBox Text_Now
35			Height = 285
36			Left = 90
37			TabIndex = 1
38			Top = 2580
39			Width = 1485
40			End
41			Begin NTService.NTService NTService1
42			Left = 30
43			Top = 3210
44			_Version = 65536
45			_ExtentX = 741
46			_ExtentY = 741
47			_StockProps = 0
48			ServiceName = "Simple"
49			StartMode = 3
50			End
51			Begin VB.TextBox Text_Status
52			Height = 2445
53			Left = 90
54			MultiLine = -1 'True
55			ScrollBars = 2 'Vertical
56			TabIndex = 0
57			Top = 120
58			Width = 5385
59			End
60			Begin VB.Timer Timer1
61			Left = 360
62			Top = 3210
63			End
64			End
65			Attribute VB_Name = "FormMain"
66			Attribute VB_GlobalNameSpace = False
67			Attribute VB_Creatable = False
68			Attribute VB_PredeclaredId = True
69			Attribute VB_Exposed = False
70			Option Explicit
71
72
73			' =================================================================
74			' main
75			' =================================================================
76
77			' --------------------------------------------------------------------
78			' variable-declarations
79
80			' cfg's, to ini-file...?
81			Dim glbl_cfg_ServiceName As String
82			Dim glbl_cfg_ServiceDisplayname As String
83			Dim glbl_cfg_ServiceLoopInterval As Long
84			Dim glbl_cfg_DebugEnabled As Boolean
85			Dim glbl_cfg_InteractiveMode As Boolean
86
87			' the "ServiceControl"-Object
88			Dim serviceCtrl As ServiceControl
89			Dim applicationMode As svcApplicationMode
90
91			' --------------------------------------------------------------------
92			' event triggered by win32 on application-startup
93			Private Sub Form_Load()
94
95			' 1. WCron-GUI-Setup
96			setupForm
97
98			' - - - - - - - - - - - - - -
99			' 1.5. "NT Service"-Initialization
100			initVars
101
102			' configure the "ApplicationMode" which is either "appMode_Standalone" or "appMode_NTService"
103			applicationMode = configureApplicationStartup()
104
105			' if we are installed as a service, try to start like a service!
106			If applicationMode = appMode_NTService Then
107			serviceCtrl.startService
108			End If
109			' - - - - - - - - - - - - - -
110
111			' 2. continue with WCron-Actions ;)
112			' ....
113
114			End Sub
115
116			' --------------------------------------------------------------------
117			' event triggered by win32 on application-shutdown
118			Private Sub Form_Unload(Cancel As Integer)
119			' if we are installed as a service, try to stop like a service!
120			If applicationMode = appMode_NTService Then
121			serviceCtrl.stopService
122			End If
123			End Sub
124
125			' --------------------------------------------------------------------
126			' initialize "NT Service" - Variables
127			Private Sub initVars()
128			setCurrentStatus "initVars:"
129			glbl_cfg_ServiceName = "WCron"
130			glbl_cfg_ServiceDisplayname = "WCron"
131			glbl_cfg_ServiceLoopInterval = 2000
132			glbl_cfg_DebugEnabled = False
133			glbl_cfg_InteractiveMode = True
134			End Sub
135
136			' --------------------------------------------------------------------
137			' do own (gui-)stuff to setup the form right here
138			Private Sub setupForm()
139
140			' dummy function:
141			setCurrentStatus "setupForm:"
142
143			End Sub
144
145			Private Sub TimerMain_Timer()
146			Dim curData As String
147			curData = Format(Now(), "hh:mm:ss")
148			Text_Now.Text = curData
149			If serviceCtrl.getDebugMode = True Then
150			'writeToEventLog SvcEventType.svcEventInformation, 0, "running: " & curData
151			End If
152			End Sub
153
154			Private Sub Command_InstallService_Click()
155			serviceCtrl.installService
156			End Sub
157
158			Private Sub Command_UninstallService_Click()
159			serviceCtrl.uninstallService
160			End Sub
161
162
163
164
165			' =================================================================
166			' "NT Service" - functionality / EVENTS!
167			' =================================================================
168
169			' --------------------------------------------------------------------
170			' here is determined and handled if the application should run "standalone" or as an "nt-service"
171			Private Function configureApplicationStartup() As svcApplicationMode
172
173			setCurrentStatus "configureApplicationStartup:"
174
175			Set serviceCtrl = New ServiceControl
176			With serviceCtrl
177			.setRefs NTService1, Timer1
178			.setName glbl_cfg_ServiceName
179			.setDisplayname glbl_cfg_ServiceDisplayname
180			.setInterval glbl_cfg_ServiceLoopInterval
181			.setDebugMode glbl_cfg_DebugEnabled
182			If IsIDE Then .setDebugMode True
183			.setInteractiveMode glbl_cfg_InteractiveMode
184			End With
185
186			' just try if we can startup as nt-service (requires that the service was previously installed in system) ...
187			If serviceCtrl.isServiceInstalled() And Not serviceCtrl.getDebugMode = True Then
188			' ... if we can, run us as a "nt-service" ...
189			configureApplicationStartup = appMode_NTService
190			setCurrentStatus "configureApplicationStartup = appMode_NTService"
191			Else
192			' ... if not, run us as "standalone"
193			configureApplicationStartup = appMode_Standalone
194			setCurrentStatus "configureApplicationStartup = appMode_Standalone"
195			End If
196
197			End Function
198
199
200			' here are the events triggered if a service recieves ...
201
202			' --------------------------------------------------------------------
203			' ... a control-event (most actually from the NT Service Controller (-API))
204			Private Sub NTService1_Control(ByVal e As Long)
205
206			MsgBox "control"
207
208			On Error GoTo Err_Control
209
210			'StatusBar.SimpleText = NTService1.DisplayName & " Control signal " & e
211			Exit Sub
212
213			Err_Control:
214			Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
215			End Sub
216
217			' --------------------------------------------------------------------
218			' ... a start-event
219			Private Sub NTService1_Start(Success As Boolean)
220			On Error GoTo Err_Start
221
222			setCurrentStatus "Running"
223			Success = True
224			Call NTService1.LogEvent(SvcEventType.svcEventSuccess, 0, "Service started successfully")
225			'Unload Me
226			'Exit Sub
227
228			Err_Start:
229			Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
230			End Sub
231
232			' --------------------------------------------------------------------
233			' ... a stop-event
234			Private Sub NTService1_Stop()
235
236			On Error GoTo Err_Stop
237
238			writeToEventLog SvcEventType.svcEventInformation, 0, "Service recieved stop-request"
239
240			setCurrentStatus "Stopped"
241			Unload Me
242			End
243			Exit Sub
244
245			Err_Stop:
246			Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
247			End Sub
248
249			' --------------------------------------------------------------------
250			' ... a pause-event
251			Private Sub NTService1_Pause(Success As Boolean)
252			On Error GoTo Err_Pause
253
254			Timer1.Enabled = False
255			setCurrentStatus "Paused"
256			Call NTService1.LogEvent(SvcEventType.svcEventInformation, svcMessageInfo, "Service paused")
257			Success = True
258			Exit Sub
259
260			Err_Pause:
261			Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
262			End Sub
263
264			' --------------------------------------------------------------------
265			' ... a continue-event
266			Private Sub NTService1_Continue(Success As Boolean)
267			On Error GoTo Err_Continue
268
269			Timer1.Enabled = True
270			setCurrentStatus "Running"
271			Success = True
272			Call NTService1.LogEvent(SvcEventType.svcEventInformation, svcMessageInfo, "Service continued")
273			Exit Sub
274
275			Err_Continue:
276			Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
277			End Sub
278
279			' --------------------------------------------------------------------
280			' the main timer-event
281			Private Sub Timer1_Timer()
282
283			On Error GoTo Err_Timer
284
285			serviceCtrl.doMainLoop
286			Exit Sub
287
288			Err_Timer:
289			Call NTService1.LogEvent(svcEventError, svcMessageError, "An error occoured in the main loop of the service")
290
291			End Sub
292
293
294			Private Function writeToEventLog(EventType As Integer, ID As Long, Message As String) As Boolean
295
296			Dim msg As String
297
298			msg = _
299			vbCrLf & _
300			String(10, "-") & vbCrLf & _
301			Message & vbCrLf
302
303			If EventType = SvcEventType.svcEventError Then
304			msg = msg & _
305			String(10, "-") & vbCrLf & _
306			"[#" & Err.Number & "] " & Err.Description
307			End If
308
309			Call NTService1.LogEvent(EventType, ID, msg)
310
311			End Function
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26