global hooks??????

[leo17]

pues amigos sigo con el problema que me ha dado dolores de cabeza esto de los hooks aqui un nuevo code que todavia no puedo hacer que funcione.

Código [Seleccionar] Expandir

'form
Private Sub Command1_Click()
Hook
End Sub

Private Sub Form_Unload(Cancel As Integer)
NonHook
End Sub

'module
Option Explicit
Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long

Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long

Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
(ByVal lpLibFileName As String) As Long

Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long
Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Const WH_CBT = 5
Public Const WH_SHELL As Long = 10
Public hHook As Long

Public Sub Hook()
Dim hHookDLL As Long
Dim pHookFunction As Long
hHookDLL = LoadLibrary("hk.dll")
If hHookDLL = 0 Then
End
End If
pHookFunction = GetProcAddress(hHookDLL, "HookFunction")
hHook = SetWindowsHookEx(WH_CBT, pHookFunction, hHookDLL, 0)
FreeLibrary (hHookDLL)
End Sub

Public Sub NonHook()
Dim suc As Long
If hHook <> 0 Then
suc = UnhookWindowsHookEx(hHook)
  hHook = 0
  End If

End Sub

'dll
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Const HCBT_ACTIVATE = 1
Private Const HCBT_DESTROYWND As Long = 1
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Const HC_ACTION As Long = 0
Private Const HCBT_CREATEWND As Long = 3
Private Const WH_SHELL As Long = 10
Private Const HSHELL_WINDOWCREATED& = 1
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Type CWPSTRUCT
    lParam As Long
    wParam As Long
    message As Long
    hwnd As Long
End Type
Private Const WM_CREATE As Long = &H1


Public Function HookFunction(ByVal iCode As Long, ByVal wParam As Long, lParam As CWPSTRUCT) As Long

Dim FrmHandle As Long, lcaption As String


  If iCode < 0 Then
  HookFunction = CallNextHookEx(hHook, iCode, wParam, ByVal lParam)
  Exit Function
  End If
 
  Dim Class As String, cl As Long
  Class = Space(64)
  cl = GetClassName(lParam.hwnd, Class, 64)
  If StrComp(Class, "MSBLWindowClass") = 0 Then
  MsgBox ("siii")
  End If
 
 
  HookFunction = CallNextHookEx(hHook, iCode, wParam, ByVal lParam)
End Function


[cobein]

Mira este ejemplo, utiliza un modulo hecho por Paul Caton para instalar hooks globales

http://www.uploadsourcecode.com.ar/d/gT4O9xhOYguVS6IGuRDWvT3qT9B1rcH5