- Option Explicit 
-   
- Private Declare Function RegisterShellHook Lib "Shell32" Alias "#181" (ByVal hwnd As Long, ByVal nAction As Long) As Long 'use in 98 
- Private Declare Function RegisterShellHookWindow Lib "user32" (ByVal hwnd As Long) As Long  'use in NT5 
- Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long 
- Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
- Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long 
- Private 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 RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long 
-   
- Private Const HSHELL_WINDOWCREATED = 1 
- Private Const HSHELL_WINDOWDESTROYED = 2 
- Private Const HSHELL_ACTIVATESHELLWINDOW = 3 
- Private Const HSHELL_WINDOWACTIVATED = 4 
- Private Const HSHELL_GETMINRECT = 5 
- Private Const HSHELL_REDRAW = 6 
- Private Const HSHELL_TASKMAN = 7 
- Private Const HSHELL_LANGUAGE = 8 
- Private Const HSHELL_SYSMENU = 9 
- Private Const HSHELL_ENDTASK = 10 
- Private Const HSHELL_ACCESSIBILITYSTATE = 11 
- Private Const HSHELL_APPCOMMAND = 12 
- Private Const HSHELL_WINDOWREPLACED = 13 
- Private Const HSHELL_WINDOWREPLACING = 14 
- Private Const HSHELL_HIGHBIT = &H8000 
- Private Const HSHELL_FLASH = (HSHELL_REDRAW Or HSHELL_HIGHBIT) 
- Private Const HSHELL_RUDEAPPACTIVATED = (HSHELL_WINDOWACTIVATED Or HSHELL_HIGHBIT) 
- Private Const GWL_WNDPROC = -4 
-   
- Private Shell_Hook_Msg_ID As Long 
- Private LogWinOldProc As Long 
-   
- Public Function IniciarHook(ByVal hwnd As Long) As Boolean 
-     On Error Resume Next 
-     Dim tmp As Long 
-     Shell_Hook_Msg_ID = RegisterWindowMessage("SHELLHOOK") 
-     IniciarHook = Shell_Hook_Msg_ID 
-     IniciarHook = IniciarHook And (RegisterShellHook(hwnd, 1) Or RegisterShellHookWindow(hwnd)) 
-     LogWinOldProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc) 
- End Function 
-   
- Public Function DescargarHook(hwnd As Long) 
-     Call RegisterShellHook(hwnd, 0) 
-     Call SetWindowLong(hwnd, GWL_WNDPROC, LogWinOldProc) 
- End Function 
-   
- Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long            ' ???? 
-     Dim i As Long 
-     Dim m_Out_String As String 
-     Dim recTime As String 
-     Dim recParam As String 
-     If uMsg = Shell_Hook_Msg_ID Then 
-         recTime = Format$(Now(), "YY-MM-DD:HH-NN-SS ") & vbTab & " 0x" & Hex$(wParam) & vbTab & " 0x" & Hex$(lParam) & vbTab & " " 
-         Select Case wParam 
-             Case HSHELL_WINDOWCREATED 
-   
-                 m_Out_String = String$(260, vbNullChar) 
-                 i = GetWindowText(lParam, m_Out_String, 260) 
-                 If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed" 
-                 m_Out_String = recTime & "HSHELL_WINDOWCREATED" & vbTab & " " & m_Out_String 
-                 Debug.Print m_Out_String 
-             Case HSHELL_WINDOWDESTROYED 
-                 m_Out_String = String$(260, vbNullChar) 
-                 i = GetWindowText(lParam, m_Out_String, 260) 
-                 If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed" 
-                 m_Out_String = recTime & "HSHELL_WINDOWDESTROYED" & vbTab & " " & m_Out_String 
-                  Debug.Print m_Out_String 
-             Case HSHELL_ACTIVATESHELLWINDOW 
-                 m_Out_String = recTime & "HSHELL_ACTIVATESHELLWINDOW" 
-                  Debug.Print m_Out_String 
-             Case HSHELL_WINDOWACTIVATED 
-                 m_Out_String = String$(260, vbNullChar) 
-                 i = GetWindowText(lParam, m_Out_String, 260) 
-                 If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed" 
-                 m_Out_String = recTime & "HSHELL_WINDOWACTIVATEED" & vbTab & " " & m_Out_String 
-                  Debug.Print m_Out_String 
-             Case HSHELL_GETMINRECT 
-                 m_Out_String = recTime & "HSHELL_GETMINRECT" 
-             Case HSHELL_REDRAW 
-                 m_Out_String = String$(260, vbNullChar) 
-                 i = GetWindowText(lParam, m_Out_String, 260) 
-                 If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed" 
-                 m_Out_String = recTime & "HSHELL_REDRAW" & vbTab & " " & m_Out_String 
-             Case HSHELL_TASKMAN 
-                 m_Out_String = recTime & "HSHELL_TASKMAN" 
-             Case HSHELL_LANGUAGE 
-                 m_Out_String = recTime & "HSHELL_LANGUAGE" 
-             Case HSHELL_SYSMENU 
-                 m_Out_String = recTime & "HSHELL_SYSMENU" 
-             Case HSHELL_ENDTASK 
-                 m_Out_String = String$(260, vbNullChar) 
-                 i = GetWindowText(lParam, m_Out_String, 260) 
-                 If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed" 
-                 m_Out_String = recTime & "HSHELL_ENDTASK" & vbTab & " " & m_Out_String 
-             Case HSHELL_ACCESSIBILITYSTATE 
-                 m_Out_String = recTime & "HSHELL_ACCESSIBILITYSTATE" 
-             Case HSHELL_APPCOMMAND 
-                 m_Out_String = recTime & "HSHELL_APPCOMMAND" 
-             Case HSHELL_WINDOWREPLACED 
-                 m_Out_String = String$(260, vbNullChar) 
-                 i = GetWindowText(lParam, m_Out_String, 260) 
-                 If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed" 
-                 m_Out_String = recTime & "HSHELL_WINDOWREPLACED" & vbTab & " " & m_Out_String 
-             Case HSHELL_WINDOWREPLACING 
-                 m_Out_String = String$(260, vbNullChar) 
-                 i = GetWindowText(lParam, m_Out_String, 260) 
-                 If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed" 
-                 m_Out_String = recTime & "HSHELL_WINDOWREPLACING" & vbTab & " " & m_Out_String 
-             Case HSHELL_FLASH 
-                 m_Out_String = String$(260, vbNullChar) 
-                 i = GetWindowText(lParam, m_Out_String, 260) 
-                 If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed" 
-                 m_Out_String = recTime & "HSHELL_FLASH" & vbTab & " " & m_Out_String 
-             Case HSHELL_RUDEAPPACTIVATED 
-                 m_Out_String = String$(260, vbNullChar) 
-                 i = GetWindowText(lParam, m_Out_String, 260) 
-                 If i > 0 Then m_Out_String = Left$(m_Out_String, i) Else m_Out_String = "UnNamed" 
-                 m_Out_String = recTime & "HSHELL_RUDEAPPACTIVATEED" & vbTab & " " & m_Out_String 
-         End Select 
-   
-     Else 
-         WindowProc = CallWindowProc(LogWinOldProc, hwnd, uMsg, wParam, lParam) 
-     End If 
- End Function 
-   
-