Bonjour,
Je ne sais pas si c'est faisable, mais je tente tout de même la question.
Voilà, j'ai créé un petit programme en vb. J'aimerais que ce programme
puisse se lancer après que mon ordi soit sortie de la mise en veille.
Une idée de comment procéder ?
Merci
Bonjour,
Je ne sais pas si c'est faisable, mais je tente tout de même la question.
Voilà, j'ai créé un petit programme en vb. J'aimerais que ce programme
puisse se lancer après que mon ordi soit sortie de la mise en veille.
Une idée de comment procéder ?
Merci
Bonjour,
Je ne sais pas si c'est faisable, mais je tente tout de même la question.
Voilà, j'ai créé un petit programme en vb. J'aimerais que ce programme
puisse se lancer après que mon ordi soit sortie de la mise en veille.
Une idée de comment procéder ?
Merci
Hello,
Il y a plusieurs moyens d'effectuer cette opération:
- créer un exe avec une extension .scr qui lui apellera le scr d'origine (ce
qui permet de déterminer la fin de son exécution).
Voir à ce sujet:
http://support.microsoft.com/?kbid9796
- enregistrer un hook global sur le shell.
Ceci ce fait typiquement dans une dll standard à l'aide de SetWindowsHookEx
avec WH_SHELL(pas faisable directement en VB - du moins, c'est ce qu'on en
disait... il faudrait revérifier -, mais avec un peu de C++ on s'en tire).
Par chance, pour le shell, on peut aussi passer par RegisterShellHookWindow
(uniquement sous Win 2k+) et sous-classer une fenêtre. (bien que cette
méthode ne soit pas conseillée dans les nouveaux programmes parce que la
pérennité de RegisterShellHookWindow n'est pas assurée).
Si l'application doit être windowless, on pourra utiliser une fenêtre
"Message Only" avec les createwindow appropriés.
Avec ceci on détecte les HSHELL_WINDOWDESTROYED, on récupère un hWnd et donc
virtuellement l'application (et plus particulièrement son chemin) qui a
détruit une fenêtre. Si ce chemin se termine en .scr, c'est l'écran de
veille. Ceci permet de détecter la fermeture de l'écran de veille même si
celui-ci n'a pas été démarré pas windows.
- Il est aussi possible de détecter un WM_SYSCOMMAND / SC_SCREENSAVE et
ensuite de vérifier à interval régulier si un process nommé .scr a été
démarré.
Le problème de ces méthode est que si un .scr apelle un .exe puis se ferme,
on aura déterminé la fin du screensaver à tort (c'est un cas spécial, le
tout est de savoir si c'est acceptable - à noter que l'état
SPI_GETSCREENSAVERRUNNING derait aussi être fausser -?)
Voici un exemple basé sur la seconde méthode:
'-----------------------------------------------------------------------
'Dans un module de code
'-----------------------------------------------------------------------
Option Explicit
' Déclaration des API
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" _
( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long _
) _
As Long
Public Declare Function CallWindowProc _
Lib "user32" _
Alias "CallWindowProcA" _
( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) _
As Long
Private Declare Function RegisterWindowMessage _
Lib "user32" _
Alias "RegisterWindowMessageA" _
( _
ByVal lpString As String _
) _
As Long
Private Declare Function RegisterShellHookWindow _
Lib "user32" _
( _
ByVal hWnd As Long _
) _
As Long
Private Declare Function GetWindowText _
Lib "user32" _
Alias "GetWindowTextA" _
( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal nMaxCount As Long _
) _
As Long
Private Declare Function GetWindowTextLength _
Lib "user32" _
Alias "GetWindowTextLengthA" _
( _
ByVal hWnd As Long _
) _
As Long
Private Declare Function GetWindowThreadProcessId _
Lib "user32" _
( _
ByVal hWnd As Long, _
lpdwProcessId As Long _
) _
As Long
Private Declare Function SystemParametersInfo _
Lib "user32" _
Alias "SystemParametersInfoA" _
( _
ByVal uiAction As Long, _
ByVal uiParam As Long, _
pvParam As Any, _
ByVal fWinIni As Long _
) _
As Long
Private Declare Function OpenProcess _
Lib "Kernel32" _
( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long _
) _
As Long
Private Declare Function CloseHandle _
Lib "Kernel32" _
( _
ByVal hObject As Long _
) _
As Long
Private Declare Function GetModuleFileNameEx _
Lib "Psapi" _
Alias "GetModuleFileNameExA" _
( _
ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal lpFilename As String, _
ByVal nSize As Long _
) _
As Long
Private Const HSHELL_WINDOWCREATED = 1
Private Const HSHELL_WINDOWDESTROYED = 2
Private Const HSHELL_ACTIVATESHELLWINDOW = 3
Private Const PROCESS_QUERY_INFORMATION = (&H400)
Private Const PROCESS_VM_READ = (&H10)
Private Const GWL_WNDPROC = (-4)
Private Const SPI_GETSCREENSAVERRUNNING = &H72
' Variables utilisée par le programme
Private mOldWndProc As Long
Private mHwnd As Long
Private mShellMsg As Long
Public Function InitShellHook(hWnd As Long) As Boolean
Const mShellMsgName As String = "SHELLHOOK"
'Enregistre le message associé au shell
mShellMsg = RegisterWindowMessage(mShellMsgName)
If (mShellMsg) Then
'Tente d'initialiser le hook
InitShellHook = RegisterShellHookWindow(hWnd)
Else
Err.Raise Err.LastDllError, , "Unable to find SHELLHOOK message in
InitShellHook"
End If
End Function
Public Sub UnSubclass()
If (mHwnd) Then
' Redéfinit la procédure à laquelle les messages doivent être
envoyés
SetWindowLong mHwnd, GWL_WNDPROC, mOldWndProc
End If
End Sub
Public Sub Subclass(hWnd As Long)
UnSubclass
mHwnd = hWnd
mOldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
' Procédure appelé lorsqu'un nouveau message est à traiter
Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long
On Error GoTo errhandler
If (uMsg = mShellMsg) Then
Select Case wParam
Case HSHELL_WINDOWDESTROYED
If GetFileExt(GetModuleWinFile(lParam)) = "scr" Then
Debug.Print "Window about to be destroyed: ",
GetWinTitle(lParam)
'Si on a une réponse True, le screensaver a été démarré
par windows.
'Sinon, il a été démarré par l'utilisateur (soit en
preview, soit par
'double-click sur le .scr)
Debug.Print "Is screensaver running: ",
IsScreenSaverRunning
End If
End Select
WndProc = 0
Else
WndProc = CallWindowProc(mOldWndProc, mHwnd, uMsg, wParam, lParam)
End If
On Error GoTo 0
errhandler:
If Err.Number Then
Debug.Print "Subclassing error : " & Err.Number & vbCrLf &
Err.Description
'On tente de désousclasser la fenêtre posant problème
UnSubclass
End If
End Function
Private Function GetWinTitle(hWnd As Long) As String
Dim lngTitleLength As Long
'Récupère la longueur du titre
lngTitleLength = GetWindowTextLength(hWnd)
'Si un titre est présent
If lngTitleLength Then
'Détermine le titre
GetWinTitle = String$(lngTitleLength, vbNullChar)
GetWindowText hWnd, GetWinTitle, lngTitleLength + 1
End If
End Function
Public Function GetModuleWinFile(hWnd As Long) As String
Dim PiD As Long, hProcess As Long
Dim BufferLength As Long, Result As Long
GetWindowThreadProcessId hWnd, PiD
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0,
PiD)
If (hProcess) Then
Do
'Vérifie s'il n'y a pas plus de place nécessaire
BufferLength = BufferLength + 64
GetModuleWinFile = String$(BufferLength, vbNullChar)
Result = GetModuleFileNameEx(hProcess, 0, GetModuleWinFile,
BufferLength)
Loop While Err.LastDllError = 0 And Result = BufferLength
CloseHandle hProcess
GetModuleWinFile = Left$(GetModuleWinFile, Result)
End If
End Function
Private Function GetFileExt(FilePath As String) As String
GetFileExt = LCase$(Mid$(FilePath, InStrRev(FilePath, ".") + 1))
End Function
Public Function IsScreenSaverRunning() As Boolean
Dim SSA As Long
If SystemParametersInfo(SPI_GETSCREENSAVERRUNNING, 0, SSA, 0) Then
IsScreenSaverRunning = CBool(SSA)
Else
Err.Raise Err.LastDllError, , "Unable to find screensaver state in
IsScreenSaverRunning"
End If
End Function
'---------------------------------------------------------------
'Dans une form
'---------------------------------------------------------------
Option Explicit
Private Sub Form_Load()
Subclass Me.hWnd
InitShellHook Me.hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnSubclass
End Sub
Hello,
Il y a plusieurs moyens d'effectuer cette opération:
- créer un exe avec une extension .scr qui lui apellera le scr d'origine (ce
qui permet de déterminer la fin de son exécution).
Voir à ce sujet:
http://support.microsoft.com/?kbid9796
- enregistrer un hook global sur le shell.
Ceci ce fait typiquement dans une dll standard à l'aide de SetWindowsHookEx
avec WH_SHELL(pas faisable directement en VB - du moins, c'est ce qu'on en
disait... il faudrait revérifier -, mais avec un peu de C++ on s'en tire).
Par chance, pour le shell, on peut aussi passer par RegisterShellHookWindow
(uniquement sous Win 2k+) et sous-classer une fenêtre. (bien que cette
méthode ne soit pas conseillée dans les nouveaux programmes parce que la
pérennité de RegisterShellHookWindow n'est pas assurée).
Si l'application doit être windowless, on pourra utiliser une fenêtre
"Message Only" avec les createwindow appropriés.
Avec ceci on détecte les HSHELL_WINDOWDESTROYED, on récupère un hWnd et donc
virtuellement l'application (et plus particulièrement son chemin) qui a
détruit une fenêtre. Si ce chemin se termine en .scr, c'est l'écran de
veille. Ceci permet de détecter la fermeture de l'écran de veille même si
celui-ci n'a pas été démarré pas windows.
- Il est aussi possible de détecter un WM_SYSCOMMAND / SC_SCREENSAVE et
ensuite de vérifier à interval régulier si un process nommé .scr a été
démarré.
Le problème de ces méthode est que si un .scr apelle un .exe puis se ferme,
on aura déterminé la fin du screensaver à tort (c'est un cas spécial, le
tout est de savoir si c'est acceptable - à noter que l'état
SPI_GETSCREENSAVERRUNNING derait aussi être fausser -?)
Voici un exemple basé sur la seconde méthode:
'-----------------------------------------------------------------------
'Dans un module de code
'-----------------------------------------------------------------------
Option Explicit
' Déclaration des API
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" _
( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long _
) _
As Long
Public Declare Function CallWindowProc _
Lib "user32" _
Alias "CallWindowProcA" _
( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) _
As Long
Private Declare Function RegisterWindowMessage _
Lib "user32" _
Alias "RegisterWindowMessageA" _
( _
ByVal lpString As String _
) _
As Long
Private Declare Function RegisterShellHookWindow _
Lib "user32" _
( _
ByVal hWnd As Long _
) _
As Long
Private Declare Function GetWindowText _
Lib "user32" _
Alias "GetWindowTextA" _
( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal nMaxCount As Long _
) _
As Long
Private Declare Function GetWindowTextLength _
Lib "user32" _
Alias "GetWindowTextLengthA" _
( _
ByVal hWnd As Long _
) _
As Long
Private Declare Function GetWindowThreadProcessId _
Lib "user32" _
( _
ByVal hWnd As Long, _
lpdwProcessId As Long _
) _
As Long
Private Declare Function SystemParametersInfo _
Lib "user32" _
Alias "SystemParametersInfoA" _
( _
ByVal uiAction As Long, _
ByVal uiParam As Long, _
pvParam As Any, _
ByVal fWinIni As Long _
) _
As Long
Private Declare Function OpenProcess _
Lib "Kernel32" _
( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long _
) _
As Long
Private Declare Function CloseHandle _
Lib "Kernel32" _
( _
ByVal hObject As Long _
) _
As Long
Private Declare Function GetModuleFileNameEx _
Lib "Psapi" _
Alias "GetModuleFileNameExA" _
( _
ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal lpFilename As String, _
ByVal nSize As Long _
) _
As Long
Private Const HSHELL_WINDOWCREATED = 1
Private Const HSHELL_WINDOWDESTROYED = 2
Private Const HSHELL_ACTIVATESHELLWINDOW = 3
Private Const PROCESS_QUERY_INFORMATION = (&H400)
Private Const PROCESS_VM_READ = (&H10)
Private Const GWL_WNDPROC = (-4)
Private Const SPI_GETSCREENSAVERRUNNING = &H72
' Variables utilisée par le programme
Private mOldWndProc As Long
Private mHwnd As Long
Private mShellMsg As Long
Public Function InitShellHook(hWnd As Long) As Boolean
Const mShellMsgName As String = "SHELLHOOK"
'Enregistre le message associé au shell
mShellMsg = RegisterWindowMessage(mShellMsgName)
If (mShellMsg) Then
'Tente d'initialiser le hook
InitShellHook = RegisterShellHookWindow(hWnd)
Else
Err.Raise Err.LastDllError, , "Unable to find SHELLHOOK message in
InitShellHook"
End If
End Function
Public Sub UnSubclass()
If (mHwnd) Then
' Redéfinit la procédure à laquelle les messages doivent être
envoyés
SetWindowLong mHwnd, GWL_WNDPROC, mOldWndProc
End If
End Sub
Public Sub Subclass(hWnd As Long)
UnSubclass
mHwnd = hWnd
mOldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
' Procédure appelé lorsqu'un nouveau message est à traiter
Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long
On Error GoTo errhandler
If (uMsg = mShellMsg) Then
Select Case wParam
Case HSHELL_WINDOWDESTROYED
If GetFileExt(GetModuleWinFile(lParam)) = "scr" Then
Debug.Print "Window about to be destroyed: ",
GetWinTitle(lParam)
'Si on a une réponse True, le screensaver a été démarré
par windows.
'Sinon, il a été démarré par l'utilisateur (soit en
preview, soit par
'double-click sur le .scr)
Debug.Print "Is screensaver running: ",
IsScreenSaverRunning
End If
End Select
WndProc = 0
Else
WndProc = CallWindowProc(mOldWndProc, mHwnd, uMsg, wParam, lParam)
End If
On Error GoTo 0
errhandler:
If Err.Number Then
Debug.Print "Subclassing error : " & Err.Number & vbCrLf &
Err.Description
'On tente de désousclasser la fenêtre posant problème
UnSubclass
End If
End Function
Private Function GetWinTitle(hWnd As Long) As String
Dim lngTitleLength As Long
'Récupère la longueur du titre
lngTitleLength = GetWindowTextLength(hWnd)
'Si un titre est présent
If lngTitleLength Then
'Détermine le titre
GetWinTitle = String$(lngTitleLength, vbNullChar)
GetWindowText hWnd, GetWinTitle, lngTitleLength + 1
End If
End Function
Public Function GetModuleWinFile(hWnd As Long) As String
Dim PiD As Long, hProcess As Long
Dim BufferLength As Long, Result As Long
GetWindowThreadProcessId hWnd, PiD
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0,
PiD)
If (hProcess) Then
Do
'Vérifie s'il n'y a pas plus de place nécessaire
BufferLength = BufferLength + 64
GetModuleWinFile = String$(BufferLength, vbNullChar)
Result = GetModuleFileNameEx(hProcess, 0, GetModuleWinFile,
BufferLength)
Loop While Err.LastDllError = 0 And Result = BufferLength
CloseHandle hProcess
GetModuleWinFile = Left$(GetModuleWinFile, Result)
End If
End Function
Private Function GetFileExt(FilePath As String) As String
GetFileExt = LCase$(Mid$(FilePath, InStrRev(FilePath, ".") + 1))
End Function
Public Function IsScreenSaverRunning() As Boolean
Dim SSA As Long
If SystemParametersInfo(SPI_GETSCREENSAVERRUNNING, 0, SSA, 0) Then
IsScreenSaverRunning = CBool(SSA)
Else
Err.Raise Err.LastDllError, , "Unable to find screensaver state in
IsScreenSaverRunning"
End If
End Function
'---------------------------------------------------------------
'Dans une form
'---------------------------------------------------------------
Option Explicit
Private Sub Form_Load()
Subclass Me.hWnd
InitShellHook Me.hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnSubclass
End Sub
Hello,
Il y a plusieurs moyens d'effectuer cette opération:
- créer un exe avec une extension .scr qui lui apellera le scr d'origine (ce
qui permet de déterminer la fin de son exécution).
Voir à ce sujet:
http://support.microsoft.com/?kbid9796
- enregistrer un hook global sur le shell.
Ceci ce fait typiquement dans une dll standard à l'aide de SetWindowsHookEx
avec WH_SHELL(pas faisable directement en VB - du moins, c'est ce qu'on en
disait... il faudrait revérifier -, mais avec un peu de C++ on s'en tire).
Par chance, pour le shell, on peut aussi passer par RegisterShellHookWindow
(uniquement sous Win 2k+) et sous-classer une fenêtre. (bien que cette
méthode ne soit pas conseillée dans les nouveaux programmes parce que la
pérennité de RegisterShellHookWindow n'est pas assurée).
Si l'application doit être windowless, on pourra utiliser une fenêtre
"Message Only" avec les createwindow appropriés.
Avec ceci on détecte les HSHELL_WINDOWDESTROYED, on récupère un hWnd et donc
virtuellement l'application (et plus particulièrement son chemin) qui a
détruit une fenêtre. Si ce chemin se termine en .scr, c'est l'écran de
veille. Ceci permet de détecter la fermeture de l'écran de veille même si
celui-ci n'a pas été démarré pas windows.
- Il est aussi possible de détecter un WM_SYSCOMMAND / SC_SCREENSAVE et
ensuite de vérifier à interval régulier si un process nommé .scr a été
démarré.
Le problème de ces méthode est que si un .scr apelle un .exe puis se ferme,
on aura déterminé la fin du screensaver à tort (c'est un cas spécial, le
tout est de savoir si c'est acceptable - à noter que l'état
SPI_GETSCREENSAVERRUNNING derait aussi être fausser -?)
Voici un exemple basé sur la seconde méthode:
'-----------------------------------------------------------------------
'Dans un module de code
'-----------------------------------------------------------------------
Option Explicit
' Déclaration des API
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" _
( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long _
) _
As Long
Public Declare Function CallWindowProc _
Lib "user32" _
Alias "CallWindowProcA" _
( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) _
As Long
Private Declare Function RegisterWindowMessage _
Lib "user32" _
Alias "RegisterWindowMessageA" _
( _
ByVal lpString As String _
) _
As Long
Private Declare Function RegisterShellHookWindow _
Lib "user32" _
( _
ByVal hWnd As Long _
) _
As Long
Private Declare Function GetWindowText _
Lib "user32" _
Alias "GetWindowTextA" _
( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal nMaxCount As Long _
) _
As Long
Private Declare Function GetWindowTextLength _
Lib "user32" _
Alias "GetWindowTextLengthA" _
( _
ByVal hWnd As Long _
) _
As Long
Private Declare Function GetWindowThreadProcessId _
Lib "user32" _
( _
ByVal hWnd As Long, _
lpdwProcessId As Long _
) _
As Long
Private Declare Function SystemParametersInfo _
Lib "user32" _
Alias "SystemParametersInfoA" _
( _
ByVal uiAction As Long, _
ByVal uiParam As Long, _
pvParam As Any, _
ByVal fWinIni As Long _
) _
As Long
Private Declare Function OpenProcess _
Lib "Kernel32" _
( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long _
) _
As Long
Private Declare Function CloseHandle _
Lib "Kernel32" _
( _
ByVal hObject As Long _
) _
As Long
Private Declare Function GetModuleFileNameEx _
Lib "Psapi" _
Alias "GetModuleFileNameExA" _
( _
ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal lpFilename As String, _
ByVal nSize As Long _
) _
As Long
Private Const HSHELL_WINDOWCREATED = 1
Private Const HSHELL_WINDOWDESTROYED = 2
Private Const HSHELL_ACTIVATESHELLWINDOW = 3
Private Const PROCESS_QUERY_INFORMATION = (&H400)
Private Const PROCESS_VM_READ = (&H10)
Private Const GWL_WNDPROC = (-4)
Private Const SPI_GETSCREENSAVERRUNNING = &H72
' Variables utilisée par le programme
Private mOldWndProc As Long
Private mHwnd As Long
Private mShellMsg As Long
Public Function InitShellHook(hWnd As Long) As Boolean
Const mShellMsgName As String = "SHELLHOOK"
'Enregistre le message associé au shell
mShellMsg = RegisterWindowMessage(mShellMsgName)
If (mShellMsg) Then
'Tente d'initialiser le hook
InitShellHook = RegisterShellHookWindow(hWnd)
Else
Err.Raise Err.LastDllError, , "Unable to find SHELLHOOK message in
InitShellHook"
End If
End Function
Public Sub UnSubclass()
If (mHwnd) Then
' Redéfinit la procédure à laquelle les messages doivent être
envoyés
SetWindowLong mHwnd, GWL_WNDPROC, mOldWndProc
End If
End Sub
Public Sub Subclass(hWnd As Long)
UnSubclass
mHwnd = hWnd
mOldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
' Procédure appelé lorsqu'un nouveau message est à traiter
Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long
On Error GoTo errhandler
If (uMsg = mShellMsg) Then
Select Case wParam
Case HSHELL_WINDOWDESTROYED
If GetFileExt(GetModuleWinFile(lParam)) = "scr" Then
Debug.Print "Window about to be destroyed: ",
GetWinTitle(lParam)
'Si on a une réponse True, le screensaver a été démarré
par windows.
'Sinon, il a été démarré par l'utilisateur (soit en
preview, soit par
'double-click sur le .scr)
Debug.Print "Is screensaver running: ",
IsScreenSaverRunning
End If
End Select
WndProc = 0
Else
WndProc = CallWindowProc(mOldWndProc, mHwnd, uMsg, wParam, lParam)
End If
On Error GoTo 0
errhandler:
If Err.Number Then
Debug.Print "Subclassing error : " & Err.Number & vbCrLf &
Err.Description
'On tente de désousclasser la fenêtre posant problème
UnSubclass
End If
End Function
Private Function GetWinTitle(hWnd As Long) As String
Dim lngTitleLength As Long
'Récupère la longueur du titre
lngTitleLength = GetWindowTextLength(hWnd)
'Si un titre est présent
If lngTitleLength Then
'Détermine le titre
GetWinTitle = String$(lngTitleLength, vbNullChar)
GetWindowText hWnd, GetWinTitle, lngTitleLength + 1
End If
End Function
Public Function GetModuleWinFile(hWnd As Long) As String
Dim PiD As Long, hProcess As Long
Dim BufferLength As Long, Result As Long
GetWindowThreadProcessId hWnd, PiD
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0,
PiD)
If (hProcess) Then
Do
'Vérifie s'il n'y a pas plus de place nécessaire
BufferLength = BufferLength + 64
GetModuleWinFile = String$(BufferLength, vbNullChar)
Result = GetModuleFileNameEx(hProcess, 0, GetModuleWinFile,
BufferLength)
Loop While Err.LastDllError = 0 And Result = BufferLength
CloseHandle hProcess
GetModuleWinFile = Left$(GetModuleWinFile, Result)
End If
End Function
Private Function GetFileExt(FilePath As String) As String
GetFileExt = LCase$(Mid$(FilePath, InStrRev(FilePath, ".") + 1))
End Function
Public Function IsScreenSaverRunning() As Boolean
Dim SSA As Long
If SystemParametersInfo(SPI_GETSCREENSAVERRUNNING, 0, SSA, 0) Then
IsScreenSaverRunning = CBool(SSA)
Else
Err.Raise Err.LastDllError, , "Unable to find screensaver state in
IsScreenSaverRunning"
End If
End Function
'---------------------------------------------------------------
'Dans une form
'---------------------------------------------------------------
Option Explicit
Private Sub Form_Load()
Subclass Me.hWnd
InitShellHook Me.hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnSubclass
End Sub
