Bonjour,
J'ai essayé d'utiliser NTSVC dans mon application afin de la
faire executer comme un service de Windows. Si je fais rouler mon
application sur un ordinateur où il y a VB, ça fonctionne bien. Si par
contre je la met sur un ordinateur avec Windows NT4 SP6a fraichement
installé, ca ne fonctionne pas. Est-ce que quelqu'un pourrait me dire ce que
je fais incorrectement (le code suit) ?
En fait, on dirait que l'événement NTService_Start ne remonte jamais et je
ne sais pas pourquoi.
Merci
ThunderMusic
Voilà le Code:
Option Explicit
Private m_bAlerted As Boolean
Private m_bStopLogOff As Boolean
Private Sub ResetService()
m_bAlerted = False
End Sub
Public Sub WriteError(ByVal strError As String)
' Write the error to the event log
NTService.LogEvent svcEventError, _
svcMessageError, _
Err.Description
Call NTService.SaveSetting("AutomaticLogOff", "LogOffTime", LogOffTime)
Call NTService.SaveSetting("AutomaticLogOff", "LogOffAlertDelay",
iAlertDelay)
Call NTService.SaveSetting("AutomaticLogOff", "AllowToStopLogOff",
bAllowToStop)
End Sub
Private Sub CMDCancel_Click()
Unload Me
End Sub
Private Sub CMDOK_Click()
SaveSettings
Unload Me
End Sub
Private Sub Form_Load()
Select Case UCase(Command)
Case "-I", "/I"
If NTService.Install Then
MsgBox NTService.DisplayName & _
" installed successfully."
Else
MsgBox NTService.DisplayName & _
" did not install successfully."
End If
End
Case "-U", "/U"
If NTService.Uninstall Then
MsgBox NTService.DisplayName & _
" uninstalled successfully."
Else
MsgBox NTService.DisplayName & _
" did not uninstall successfully."
End If
End
Case ""
'-- This code should only run when the
' application is started without parameters
If App.PrevInstance Then
End
End If
NTService.StartService
TimerHeure.Enabled = True
Case "-C", "/C"
'-- This code should only run when the
' Application must be configured.
TimerHeure.Enabled = False
LoadSettings
frmMain.Visible = True
Case Else
'-- This code should only run when the
' application is started with invalid
' Parameters
MsgBox "The parameter: " & Command & _
" was is not understood. Try -I " & _
" (install) or -U (uninstall)."
End
End Select
End Sub
Private Sub NTService_Continue(success As Boolean)
TimerHeure.Enabled = True
success = True
End Sub
Private Sub NTService_Pause(success As Boolean)
TimerHeure.Enabled = False
success = True
End Sub
Private Sub NTService_Start(success As Boolean)
TimerHeure.Enabled = True
success = True
End Sub
Private Sub NTService_Stop()
TimerHeure.Enabled = False
ResetService
End Sub
Private Sub TimerHeure_Timer()
Dim LogOffTime As Date
Dim LogOffAlertDelay As Integer
Dim NowTime As Date
On Error GoTo errHandler
' If the user must be disconnected now
If LogOffTime = NowTime Then
If IsLoggedOn Then
'If the user did not stop the log off process
If Not m_bStopLogOff Then
'Log the user off
m_bAlerted = False
m_bStopLogOff = False
Unload frmAlert
LogOffCurrentSession
Else
m_bAlerted = False
m_bStopLogOff = False
End If
End If
' If the user must disconnected in x minutes
ElseIf Minute(LogOffTime - NowTime) <= LogOffAlertDelay _
And Not m_bAlerted Then
If IsLoggedOn Then
'Alert the user
m_bAlerted = True
Load frmAlert
Call frmAlert.InitData(LogOffTime)
frmAlert.Show
End If
End If
Sortie:
Exit Sub
errHandler:
Call WriteError("Une erreur s'est produit lors de l'appel du timer
principal du service")
Resume Sortie
End Sub
Private Sub TXTAlertDelay_KeyPress(KeyAscii As Integer)
'Allow only numeric keys
If (KeyAscii < &H30 Or KeyAscii > &H39) And KeyAscii <> 8 Then
KeyAscii = 0
End If
End Sub
Private Sub TXTLogOffTime_Change()
Dim iDeuxPoints As Integer
iDeuxPoints = InStr(1, TXTLogOffTime, ":")
If TXTLogOffTime.SelStart < iDeuxPoints Then
TXTLogOffTime.SelStart = 0
TXTLogOffTime.SelLength = iDeuxPoints - 1
Else
TXTLogOffTime.SelStart = iDeuxPoints
TXTLogOffTime.SelLength = Len(TXTLogOffTime.Text) - (iDeuxPoints)
End If
End Sub
Private Sub TXTLogOffTime_Click()
Dim iDeuxPoints As Integer
iDeuxPoints = InStr(1, TXTLogOffTime, ":")
If TXTLogOffTime.SelStart < iDeuxPoints Then
TXTLogOffTime.SelStart = 0
TXTLogOffTime.SelLength = iDeuxPoints - 1
Else
TXTLogOffTime.SelStart = iDeuxPoints
TXTLogOffTime.SelLength = Len(TXTLogOffTime.Text) - (iDeuxPoints)
End If
End Sub
Private Sub TXTLogOffTime_KeyPress(KeyAscii As Integer)
'Allow only numeric keys
If (KeyAscii < &H30 Or KeyAscii > &H39) And KeyAscii <> 8 Then
KeyAscii = 0
End If
If TXTLogOffTime.SelStart = 0 Then
If Val(TXTLogOffTime.SelText) > 23 Then
TXTLogOffTime.SelText = "23"
ElseIf Val(TXTLogOffTime.SelText) < 0 Then
TXTLogOffTime.SelText = "0"
End If
Else
If Val(TXTLogOffTime.SelText) > 59 Then
TXTLogOffTime.SelText = "59"
ElseIf Val(TXTLogOffTime.SelText) < 0 Then
TXTLogOffTime.SelText = "00"
End If
End If
End Sub