session "repliée"

Content que cela t'aide.

Guy

"Bayosky" <pas_la@laposte.net> a écrit dans le message de
news:uIhYHHCOGHA.984@tk2msftngp13.phx.gbl...

Bon [soir/jour],

j'ai mis du temps mais j'ai compris,
du moins assez pour utiliser correctement ce truc.

voilà plus bas le code complet du "Form" nommé FORME
Il y a - un timer nommé Chrono
- un bouton Command1
- un label nommé Temps

L'effet obtenu est exactement ce qui me convient :
_______________________________________________________
Quand on lance l'éxécution, le label indique le temps qui passe
( départ à 00:00:00 )
Quand on "replie" la session sans la fermer le temps cesse d'être décompté

Quand on réouvre la session le décompte du temps reprend...
_______________________________________________________

Bien sûr ( rappel pour ceux qui n'ont pas suivi le fil)
il faut mettre SSubTmr6.dll dans System32
et l'enregistrer avec regsrv32 puis ajouter la référence au projet VB.

Seul défaut :
lors de la sortie ( sub Fin )
la détection d'erreur
provoque l'affichage du message "Opération réussie"
qui provient de MsgBox (GetError(Err.LastDllError))
Cela signifie que le test
If Not WTSUnRegisterSessionNotification(Me.hwnd)
n'est pas fiable :o)
donc pour la suite il faut "affiner" la detection d'erreur en sortie...
en éliminant le N° d'erreur qui correspond à la réussite.

Merci à tous,

Bien cordialement,

HB

------ Code ---------
Option Explicit
' ****************
Private Declare Function WTSRegisterSessionNotification Lib "Wtsapi32"
(ByVal hwnd As Long, ByVal THISSESS As Long) As Long
Private Declare Function WTSUnRegisterSessionNotification Lib "Wtsapi32"
(ByVal hwnd As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function FormatMessage Lib "kernel32" Alias

"FormatMessageA"

(ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal
dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long,
Arguments As Long) As Long

Private Const NOTIFY_FOR_THIS_SESSION As Long = 0
Private Const WM_WTSSESSION_CHANGE As Long = &H2B1
Private Const WTS_SESSION_LOCK As Long = 7
Private Const WTS_SESSION_UNLOCK As Long = 8
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const LANG_NEUTRAL = &H0


Dim DEPART, RESTE As Date
' ****************
Implements ISubclass
' ****************
Private Sub Chrono_Timer()
RESTE = Time - DEPART
Temps.Caption = Format(RESTE, "hh:mm:ss")
End Sub
' ****************
Private Sub Command1_Click()
Fin
End Sub
' ****************
Private Property Let ISubclass_MsgResponse(ByVal RHS As
SSubTimer6.EMsgResponse)
'
End Property
' ****************
Private Property Get ISubclass_MsgResponse() As SSubTimer6.EMsgResponse
'
End Property
' ****************
Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As
Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case iMsg
Case WM_WTSSESSION_CHANGE
Select Case wParam
Case WTS_SESSION_LOCK
Chrono.Enabled = False
Case WTS_SESSION_UNLOCK
Chrono.Enabled = True
DEPART = Time - RESTE
Case Else
'
End Select
Case Else
'
End Select
End Function
' ****************
Private Sub Form_Load()
Dim ret As Boolean
Chrono.Interval = 250
Chrono.Enabled = True
DEPART = Time
ret = WTSRegisterSessionNotification(Me.hwnd, NOTIFY_FOR_THIS_SESSION)
If Not ret Then
Debug.Print GetError(Err.LastDllError)
Else
AttachMessage Me, Me.hwnd, WM_WTSSESSION_CHANGE
End If
End Sub
' ****************
Private Function GetError(ByVal lErrorNumber As Long) As String
Dim Buffer As String
Buffer = Space(200)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, lErrorNumber,
LANG_NEUTRAL, Buffer, 200, ByVal 0&
GetError = Buffer
End Function
' ****************
Sub Fin()
If Not WTSUnRegisterSessionNotification(Me.hwnd) Then
MsgBox (GetError(Err.LastDllError))
End If
DetachMessage Me, Me.hwnd, WM_WTSSESSION_CHANGE
End
End Sub
------------fin ( enfin ) du
code --------------------------------------------

Dans le message eWDSiFHOGHA.1832@TK2MSFTNGP11.phx.gbl,
bayosky <bidonus@pasla.ici> a écrit :

Dans le message ubsHyQEOGHA.2624@TK2MSFTNGP12.phx.gbl,
Clive Lumb <clumb2@Gratuit_in_English.fr.invalid> a écrit :

salut,

Est-ce que l'erreur arrive aussi en version compilée ?
Car le sub-classing et l'IDE...

mais en fait ce n'est pas une erreur.
Le N° d' Err est 0 et correspond à la réussite.
C'est simplement mon prgm de départ qui n'avait pas compris cela...

A+

HB

Dans le message uR4I2bKOGHA.1288@TK2MSFTNGP09.phx.gbl,
Guy DETIENNE <gd@NOSPAM.tchao.be> a écrit :

Content que cela t'aide.

Salut,

Moi aussi ...

Maintenant tout baigne.

En fait pour qu'il n'y ait pas de pb il faut aussi firtrer deux autres
valeurs...

En effet si A replie sa session mais que personne d'autre n'ouvre de
session,
la console reste à A
S'il re-ouvre sa session seuls deux événements ont été transmis
wParam=7 puis wParam =8

Si qqun ouvre une autre session, A perd la console.
Jusqu'à la réouverture complète de sa session il y aura 4 événements
wParam=7 puis wParam =2 puis wParam=8 puis wParam =1

C'est la raison pour laquelle il y a un nouveau booleen Attend_1

Dans la version actuelle, tout ce qui se passe est enregistré dans un
fichier journal et je n'ai pas encore eu de message inattendus...

voici la nouvelle procedure de traduction des messages reçus :

Les entiers Long UN, DEUX SEPT et HUIT ont pour valeurs ... devinez :o)
et j'ai nommé : CHANGEMENT_SESSION As Long = &H2B1
************************************************************

Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As
Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Select Case iMsg
Case CHANGEMENT_SESSION
Select Case wParam

Case UN
If Attend_1 Then
Attend_1 = False
' Session dépliée ( reprise de la console) arrivé
du UN attendu
Timer1.Enabled = True
Else
' UN inattendu -> y'a un pb
End If

Case DEUX
' Session repliée ( console lâchée)
If Not Timer1.Enabled Then
' attente de UN
Attend_1 = True
Else
' DEUX inattendu -> y'a un pb
End If

Case SEPT
Timer1.Enabled = False
' Session repliée

Case HUIT
If Not Attend_1 Then
Session dépliée ( avec console )
Timer1.Enabled = True
Else
' Session dépliée ( mais il manque la console) ->
Attente de UN
End If

Case Else
'
End Select
Case Else
'
End Select
End Function

Bayosky a écrit, le 23/02/2006 21:52 :

mais en fait ce n'est pas une erreur.
Le N° d' Err est 0 et correspond à la réussite.

ça, classiquement, ça correspond à l'oubli de "Exit Sub" juste avant la
procédure d'erreur ...