home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD3867382000.psc / Microsoft / SAMPLE / sample.Frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-03-08  |  5.1 KB  |  137 lines
  1. VERSION 5.00
  2. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#2.0#0"; "Mscomctl.ocx"
  3. Object = "{E7BC34A0-BA86-11CF-84B1-CBC2DA68BF6C}#1.0#0"; "ntsvc.ocx"
  4. Begin VB.Form ServiceMain 
  5.    Caption         =   "Sample NT Service"
  6.    ClientHeight    =   4140
  7.    ClientLeft      =   1395
  8.    ClientTop       =   1620
  9.    ClientWidth     =   6690
  10.    Icon            =   "sample.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    PaletteMode     =   1  'UseZOrder
  13.    ScaleHeight     =   4140
  14.    ScaleWidth      =   6690
  15.    Begin VB.Timer Timer 
  16.       Left            =   960
  17.       Top             =   360
  18.    End
  19.    Begin NTService.NTService NTService1 
  20.       Left            =   240
  21.       Top             =   360
  22.       _Version        =   65536
  23.       _ExtentX        =   741
  24.       _ExtentY        =   741
  25.       _StockProps     =   0
  26.       DisplayName     =   "Sample Service"
  27.       ServiceName     =   "Sample"
  28.       StartMode       =   3
  29.    End
  30.    Begin ComctlLib.StatusBar StatusBar 
  31.       Align           =   2  'Align Bottom
  32.       Height          =   300
  33.       Left            =   0
  34.       TabIndex        =   0
  35.       Top             =   3840
  36.       Width           =   6690
  37.       _ExtentX        =   11800
  38.       _ExtentY        =   529
  39.       _Version        =   393216
  40.       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
  41.          NumPanels       =   2
  42.          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  43.          EndProperty
  44.          BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  45.          EndProperty
  46.       EndProperty
  47.    End
  48. Attribute VB_Name = "ServiceMain"
  49. Attribute VB_GlobalNameSpace = False
  50. Attribute VB_Creatable = False
  51. Attribute VB_PredeclaredId = True
  52. Attribute VB_Exposed = False
  53. Option Explicit
  54. Private Sub Form_Load()
  55. On Error GoTo Err_Load
  56.     Dim strDisplayName As String
  57.     Dim bStarted As Boolean
  58.     strDisplayName = NTService1.DisplayName
  59.     StatusBar.Panels(1).Text = "Loading"
  60.     If Command = "-install" Then
  61.         ' enable interaction with desktop
  62.         NTService1.Interactive = True
  63.         
  64.         If NTService1.Install Then
  65.             Call NTService1.SaveSetting("Parameters", "TimerInterval", "1000")
  66.             MsgBox strDisplayName & " installed successfully"
  67.         Else
  68.             MsgBox strDisplayName & " failed to install"
  69.         End If
  70.         End
  71.     ElseIf Command = "-uninstall" Then
  72.         If NTService1.Uninstall Then
  73.             MsgBox strDisplayName & " uninstalled successfully"
  74.         Else
  75.             MsgBox strDisplayName & " failed to uninstall"
  76.         End If
  77.         End
  78.     ElseIf Command = "-debug" Then
  79.         NTService1.Debug = True
  80.     ElseIf Command <> "" Then
  81.         MsgBox "Invalid command option"
  82.         End
  83.     End If
  84.     Timer.Interval = CInt(NTService1.GetSetting("Parameters", "TimerInterval", "2000"))
  85.     ' enable Pause/Continue. Must be set before StartService
  86.     ' is called or in design mode
  87.     NTService1.ControlsAccepted = svcCtrlPauseContinue
  88.     ' connect service to Windows NT services controller
  89.     NTService1.StartService
  90. Err_Load:
  91.     Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
  92. End Sub
  93. Private Sub NTService1_Continue(Success As Boolean)
  94. On Error GoTo Err_Continue
  95.     Timer.Enabled = True
  96.     StatusBar.Panels(1).Text = "Running"
  97.     Success = True
  98.     Call NTService1.LogEvent(svcEventInformation, svcMessageInfo, "Service continued")
  99. Err_Continue:
  100.     Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
  101. End Sub
  102. Private Sub NTService1_Control(ByVal EventNum As Long)
  103. On Error GoTo Err_Control
  104.     StatusBar.SimpleText = NTService1.DisplayName & " Control signal " & EventNum
  105. Err_Control:
  106.     Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
  107. End Sub
  108. Private Sub NTService1_Pause(Success As Boolean)
  109. On Error GoTo Err_Pause
  110.     Timer.Enabled = False
  111.     StatusBar.Panels(1).Text = "Paused"
  112.     Call NTService1.LogEvent(svcEventError, svcMessageError, "Service paused")
  113.     Success = True
  114. Err_Pause:
  115.     Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
  116. End Sub
  117. Private Sub NTService1_Start(Success As Boolean)
  118. On Error GoTo Err_Start
  119.     StatusBar.Panels(1).Text = "Running"
  120.     Success = True
  121. Err_Start:
  122.     Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
  123. End Sub
  124. Private Sub NTService1_Stop()
  125. On Error GoTo Err_Stop
  126.     StatusBar.Panels(1).Text = "Stopped"
  127.     Unload Me
  128. Err_Stop:
  129.     Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
  130. End Sub
  131. Private Sub Timer_Timer()
  132. On Error GoTo Err_Timer
  133.     StatusBar.Panels(2).Text = Format(Now(), "hh:mm:ss")
  134. Err_Timer:
  135.     Call NTService1.LogEvent(svcMessageError, svcEventError, "[" & Err.Number & "] " & Err.Description)
  136. End Sub
  137.