Detecter l'hybernation sous nt\xp\2000 mais aussi l'arret de fonctionnement de votre prog

Contenu du snippet

Mise a jour !!
Pu de bug si la gars laisse le pc en hybernation 1 jour et 1 secondes...
Pu de bug lors du passage de minuit
Detecte maintenant le changement d'heure ou de date...

Voila en fait ce bout de code etait destiner a detecter si l'ordi avait etait mis en hybernation durant l'execution du prog (Quel est l'interet, me direz vous ? frenchement j'en sais rien a vous de voir) et finalement rencontrant des dificultées a trouver comment faire j'ai utilisé une methode qui peut non seulement detecter la mise en hybernation du pc (apres son reveil) mais aussi l'interuption du programme (pause en fait) comme quand vous faites pause sous VB.....
Cela peut donc etre pratique, je sais pas pour quoi mais voila je met sa ici...

A oui j'oubliai il faut
Un label
Un timer (Interval = 1000)

Voila c'est tout

Source / Exemple :


Dim Adate As String, Atime As String, diff As Single
Private Sub Form_Load()
Atime = Time 'la date actuelle pour comparaison
Adate = Date 'la date actuelle pour comparaison
Caption = "NOW = " & Time & " - " & Atime & " - Diff " & diff 'juste pr voir
End Sub
Private Sub Timer1_Timer()
diff = DateDiff("s", Atime, Time) 'fait la difference entre les deux date
If diff <> 1 Then
    If diff < 1 And diff <> 86399 Then diff = DateDiff("s", Time, Atime) 'fait la difference entre les deux date mais dans l'autre sans vu que l'ancienne heure est ici superieure a celle courante
    Label1.Caption = "(Hybernation détéctée !! durée : " & diff & " secondes)" 'si l'ecart de ces deux heure est superieures a 1 (seconde) c'est quil y a forcement eu arret du prog pendant un certain temps...
ElseIf Time <> "00:00:00" And Atime <> "23:59:59" And Date <> Adate Then 'au cas ou le gars alume son pc a la meme heure quil la eteint (+1s) du coup le decalage est 1 mais la date a changée, hors sa sa se produit que a minuit !
    Label1.Caption = "(Hybernation détéctée !! durée : " & DateDiff("s", Adate, Date) & " secondes)" 'si l'ecart de ces deux heure est superieures a 1 (seconde) c'est quil y a forcement eu arret du prog pendant un certain temps...
End If
Caption = "NOW = " & Time & " - " & Atime & " - Diff " & diff   'juste pr voir
Atime = Time 'l'heure actuelle pour la comparaison
Adate = Date 'la date actuelle pour comparaison
End Sub

Conclusion :


voila voila j'espere que se sera utile, autant que la mise en veille prolongée elle même ;-)

@++ tlm et bonne prog

A voir également

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.