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.
'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
Mira este ejemplo, utiliza un modulo hecho por Paul Caton para instalar hooks globales
http://www.uploadsourcecode.com.ar/d/gT4O9xhOYguVS6IGuRDWvT3qT9B1rcH5