OVH Cloud OVH Cloud

NTSVC and Windows NT4

1 réponse
Avatar
ThunderMusic
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

NTService.LogEvent svcEventInformation, _
svcMessageInfo, _
strError

End Sub

Public Sub StopLogOff()
Unload frmAlert

m_bStopLogOff = True
End Sub

Private Sub LoadSettings()
Dim LogOffDate As Date
Dim AlertDelay As Integer
Dim AllowToStop As Boolean

LogOffDate = NTService.GetSetting("AutomaticLogOff", "LogOffTime",
"2:00")
TXTLogOffTime.Text = FormatDateTime(LogOffDate, vbShortTime)

AlertDelay = NTService.GetSetting("AutomaticLogOff", "LogOffAlertDelay",
"2")
TXTAlertDelay.Text = AlertDelay

AllowToStop = NTService.GetSetting("AutomaticLogOff",
"AllowToStopLogOff", "False")
If AllowToStop Then
CHKAllowToStop.Value = vbChecked
End If

End Sub

Private Sub SaveSettings()
Dim LogOffTime As Date
Dim iAlertDelay As Integer
Dim bAllowToStop As Boolean

LogOffTime = TXTLogOffTime.Text
iAlertDelay = Val(TXTAlertDelay.Text)
bAllowToStop = (CHKAllowToStop.Value = vbChecked)

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

LogOffTime = CDate(NTService.GetSetting("AutomaticLogOff", "LogOffTime",
"02:00"))
LogOffAlertDelay = Val(NTService.GetSetting("AutomaticLogOff",
"LogOffAlertDelay", "2"))

LogOffTime = FormatDateTime(LogOffTime, vbShortTime)
NowTime = FormatDateTime(Now, vbShortTime)

' 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

1 réponse

Avatar
Zoury
: Est-ce que quelqu'un pourrait me dire ce que je fais incorrectement (le
code suit) ?

utilisé VB pour faire ton service? :O)

--
Cordialement
Yanick Lefebvre - MVP pour Visual Basic
http://faq.vb.free.fr/?rubrique=0 - http://www.mvps.org/vbnet/
http://www.mentalis.org/agnet/apiguide.shtml - http://www.mztools.com/

Merci de poster les réponses au groupe afin d'en faire profiter à tous