Ce petit logiciel est le premier que je fais en VB alors soyer indulgent SVP. Cependant il permet d'éteindre windows XP au bout d'un certain délai fixer par l'utilisateur.
Si vous voulez, envoyer vos commentaire : critiques (et appréciations s'il y en a ;-)
Source / Exemple :
Dim TpsS, TpsM, TpsH As Integer
Option Explicit
Private Type IconeTray
cbSize As Long 'Taille de l'icône (en octets)
hwnd As Long 'Handle de la fenêtre chargée de recevoir les messages envoyés lors des évènements sur l'icône (clics, doubles-clics...)
uID As Long 'Identificateur de l'icône
uFlags As Long
uCallbackMessage As Long 'Messages à renvoyer
hIcon As Long 'Handle de l'icône
szTip As String * 64 'Texte à mettre dans la bulle d'aide
End Type
Private IconeT As IconeTray
Private Const AJOUT = &H0
Private Const MODIF = &H1
Private Const SUPPRIME = &H2
Private Const MOUSEMOVE = &H200
Private Const MESSAGE = &H1
Private Const Icone = &H2
Private Const TIP = &H4
Dim Limage As Integer
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As IconeTray) As Boolean
'Déclarations
Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const EWX_POWEROFF As Long = 8
Private Const EWX_RESET = EWX_LOGOFF + EWX_FORCE + EWX_REBOOT
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Sub cmdDebut_Click()
If txtHeure.Text <> 0 Or txtMinute.Text <> 0 Or txtSeconde.Text <> 0 Then 'Teste si les compteurs sont différents de 0
If txtHeure.Text < 24 And txtMinute.Text < 60 And txtSeconde.Text < 60 Then 'Teste que les valeurs des compteurs n'excédent pas un jour
If Timer1.Enabled = True Then 'Désactive les Timer, réinitialise les compteurs à 0 et modifie le caption du bouton txtDebut
Timer1.Enabled = False
Timer2.Enabled = False
txtSeconde.Text = 0
txtMinute.Text = 0
txtHeure.Text = 0
cmdDebut.Caption = "Activer"
If Arret.Value = True Then 'Affiche une boite d'information pour confirmer l'annulation
MsgBox "Extinction de l'ordinateur annulé", vbInformation, "Annulation"
ElseIf FSession.Value = True Then
MsgBox "Fermeture de Session annulée", vbInformation, "Annulation"
ElseIf Reboot.Value = True Then
MsgBox "Redémarrage de l'ordinateur annulé", vbInformation, "Annulation"
End If
Else
'active les Timer, attribution des variables de temps et modifie le caption du bouton txtDebut
TpsS = txtSeconde.Text
TpsM = txtMinute.Text
TpsH = txtHeure.Text
Timer1.Enabled = True
Timer2.Enabled = True
cmdDebut.Caption = "Désactiver"
End If
Else
'Affiche une boite d'information pour signaler un dépassement de temps de 24 Heures ou 60 Mn ou 60 Scd
MsgBox "Erreur dans le délai", vbExclamation, "Information"
txtSeconde.Text = 0
txtMinute.Text = 0
txtHeure.Text = 0
End If
Else
MsgBox "Vous n'avez pas défini de délai !!!", vbInformation, "Info Temps"
End If
End Sub
Private Sub cmdInfo_Click()
MsgBox "Dévellopé par SeeN@pse", vbInformation, "Information"
End Sub
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub Timer1_Timer()
If TpsS > 0 Then 'Décrémente la variable TPSS de 1 chaque seconde
TpsS = TpsS - 1
txtSeconde.Text = TpsS
End If
If TpsM > 0 And TpsS = 0 Then 'Décrémente la variable TPSM si TPSS=0
If TpsM > 0 Then
TpsM = TpsM - 1
Else
TpsM = 0
End If
TpsS = 59
txtSeconde.Text = TpsS
txtMinute = TpsM
End If
If TpsH > 0 And TpsM = 0 And TpsS = 0 Then 'Décrémente la variable TPSH si TPSS=0 et TPSM=0
If TpsH > 0 Then
TpsH = TpsH - 1
Else
TpsH = 0
End If
txtHeure.Text = TpsH
TpsM = 59
txtMinute.Text = TpsM
TpsS = 59
txtSeconde.Text = TpsS
End If
Timer1.Interval = 1000
End Sub
Private Sub Timer2_Timer()
If txtHeure.Text = 0 And txtMinute.Text = 0 And txtSeconde.Text = 0 Then 'Teste toute les secondes si le délai est écoulé
If Arret.Value = True Then
Call Arretordi 'Appel de la fonction Arretordi
ElseIf FSession.Value = True Then
Call FermerSession 'Appel de la fonction FermerSession
ElseIf Reboot.Value = True Then
Call Rebootordi 'Appel de la fonction Rebootordi
End If
End If
Timer1.Interval = 1000
End Sub
Function Arretordi()
Dim X As Long
X = ExitWindowsEx(EWX_SHUTDOWN, 0)
End Function
Function FermerSession()
Dim X As Long
X = ExitWindowsEx(EWX_LOGOFF, 0)
End Function
Function Rebootordi()
Dim X As Long
X = ExitWindowsEx(EWX_RESET, 0)
End Function
Private Sub Form_Unload(Cancel As Integer)
Shell_NotifyIcon SUPPRIME, IconeT 'Ca supprime l'icone de la barre Systray à la fin du programme sinon elle y reste.
End Sub
Private Sub cmdReduire_Click()
IconeT.cbSize = Len(IconeT)
IconeT.hwnd = Me.hwnd
IconeT.uID = 1&
IconeT.uFlags = Icone Or TIP Or MESSAGE
IconeT.uCallbackMessage = MOUSEMOVE
IconeT.hIcon = Me.Icon
IconeT.szTip = "Arrêt automatique" 'sa c'est le text que sa affiche kan tu mè la souri dessus"
Shell_NotifyIcon AJOUT, IconeT
Limage = 0
Form1.Visible = False
End Sub
Private Sub Form_MOUSEMOVE(Button As Integer, Shift As Integer, X As Single, Y As Single) 'AUCUN COMMENTAIRE ICI CAR J'AI EMPRUNTE LE CODE SUR VBFRANCE.COM
Static rec As Boolean, Msg As Long 'MERCI A SON AUTEUR ;-)
Msg = X / Screen.TwipsPerPixelX
If rec = False Then
Form1.Visible = True
End If
End Sub
Conclusion :
Remerciement à ceux qui m'ont aidé en participant au site VBFrance.com
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.