Shutdown windowsxp

Soyez le premier à donner votre avis sur cette source.

Vue 5 511 fois - Téléchargée 326 fois

Description

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

VBbigineure
Messages postés
169
Date d'inscription
vendredi 27 septembre 2002
Statut
Membre
Dernière intervention
27 février 2009
1 -
Vu de loin je pense que l'idée est bonne, bien que le send key appelle souvent quelques surprises (du genre y se passe qq chose t'avais pas du tout prévu).
J'ai l'impression que tu as 3 timers qui tournent en même temps, c'est à éviter car fatalement un jour y'en a un qui déclenche alors que l'autre n'a pas fini sa routine, et là, au mieux rien, au pire blue screen.
Enfin, a pas pu tester, because tu nous a pas glissé la form (index) dans ton zip.
cs_BadNews
Messages postés
98
Date d'inscription
samedi 30 novembre 2002
Statut
Membre
Dernière intervention
10 septembre 2007
-
Vbbigineure a bien raison .
Le sendkey n'est pas la meilleur facon ... Utilise plutot la fonction
ExitWindowsEx ... Comme ce-ci


'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

'Commandes
Private Sub FermerSession_Click()
Dim X As Long
X = ExitWindowsEx(EWX_LOGOFF, 0)
End Sub

Private Sub Redemarrer_Click()
Dim X As Long
X = ExitWindowsEx(EWX_RESET, 0)
End Sub

Private Sub Eteindre_Click()
Dim X As Long
X = ExitWindowsEx(EWX_SHUTDOWN, 0)
End Sub



Tu n'as qu'a faire 3 commandes (boutons) avec les noms suivants ..

1) FermerSession

2) Redemarrer

3) Eteindre

C'est tout ....


Et pour les Timers ... il a aussi raison .. :)

Bon courage et surtout , bonne programmation !!!!!


Bad*News
cs_BadNews
Messages postés
98
Date d'inscription
samedi 30 novembre 2002
Statut
Membre
Dernière intervention
10 septembre 2007
-
Excuse moi , c'est vrai que je t'ai compliquer la vie avec
mon code mal foutu !!.. lol Je t'explique ..

Voici la bonne déclaration ...

Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

En plus , est ne marche pas complètement sur XP .
Tu ne peux que fermer la session de cette facon (je crois)
Donc , les déclarations que tu ne comprends pas , elle ne sont pas
necessaire. La seul déclaration (pas oubligatoir) que tu peux utiliser
est:

Private Const LOGOFF = 0

Maitenant , comment l'utiliser .

Imaginons que ta form posède un bouton nommé LOGOFF ...

Private Sub LOGOFF_Click()

'Déclaration qui en réalité ne sers à rien mais qui est oubligatoir
Dim X As Long

'Tu écrit LOGOFF si tu l'as déclarer sinon tu écrit 0 (sa valeur)
X = ExitWindowsEx(LOGOFF, 0)

End Sub


Aussi simple que ca , mais pour le reste , je ne peu pas vraiment t'aider . :)
Excuse moi encore de t'avoir compliquer la vie ... :P
GenSystem
Messages postés
3
Date d'inscription
dimanche 23 mars 2003
Statut
Membre
Dernière intervention
22 juin 2003
-
Voilà ce que c'est devenu : http://gen.system.free.fr/ShutDownXP.exe ...
SeeNapse
Messages postés
33
Date d'inscription
vendredi 24 janvier 2003
Statut
Membre
Dernière intervention
18 mai 2004
-
C'est sûr que ça en jete par rapport au mien mais c'était mon premier prog et je n'ai pas tout inventé. Je dis bravo au mec qui l'a amélioré.
@++

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.

Du même auteur (SeeNapse)