Even we are in 2015 and vb6 is old, it’s still great. As I had been in difficult to find a simple and efficient method to do hooking system wide, so I share my source code, here in zip attachment.
This project allow you to do global hook, system wide in Windows. The principle is to put the hook with a DLL, then get the message by subclassing our program. This hook system wide work only with 32 bits applications.
The DLL in attachment was compiled in C++. Which allow you to put hook system wide in Windows, then send to our program, with SendMessage, the message WM_USER and the hook code (nCode). With subclassing of our program, we can get the hook code by subtract WM_USER.
The hook provided from the DLL is not specific to our program but global in all Windows (system wide).
This project provide a demo of these hooks system wide :
CBT / CreateWnd : get the name of the handle parent of the window to be created.
Keyboard = get the code of the keystroke.
Mouse = get the name of the handle pointed by the left click.
I’m not the author of the DLL, neither hooking and subclassing methods.
I took these three elements and make a simple project.
The DLL was coded in C++ by Renfield – 2007
Source code of subclassing by Renfield – 2010
Hooking routines by vbAccelerator – 2003
The DLL can be downloaded elsewhere, MD5 hash : df8a28ea62016e29128832f6cbc3246a
ZIP re-uploaded without DLL.
Have fun ;-)
Last edited by philippe734; Jun 24th, 2015 at 11:48 AM.
Reason: ZIP re-uploaded without DLL + add hash MD5 of DLL
Here, the routine to subclass and get the hook message code :
Code:
Private Function ISubclasser_WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim HookCode As Long
Select Case hWnd
Case mtWin1.hWnd
' The hook'DLL send the message WM_USER with the Hook code, it's why we need to substract WM_USER
HookCode = (uMsg - WM_USER)
Select Case HookType
Case WH_CALLWNDPROC: Call procWH_CALLWNDPROC(HookCode, wParam, lParam)
Case WH_CALLWNDPROCRET: Call procWH_CALLWNDPROCRET(HookCode, wParam, lParam)
Case WH_CBT: Call procWH_CBT(HookCode, wParam, lParam)
Case WH_FOREGROUNDIDLE: Call procWH_FOREGROUNDIDLE(HookCode, wParam, lParam)
Case WH_GETMESSAGE: Call procWH_GETMESSAGE(HookCode, wParam, lParam)
Case WH_KEYBOARD: Call procWH_KEYBOARD(HookCode, wParam, lParam)
Case WH_MOUSE: Call procWH_MOUSE(HookCode, wParam, lParam)
Case WH_MSGFILTER: Call procWH_MSGFILTER(HookCode, wParam, lParam)
Case WH_SHELL: Call procWH_SHELL(HookCode, wParam, lParam)
End Select
If bSkipWindowProc = False Then
' Here, we need to allow the standard message of our program,
' because we don't subclass the target hooked.
ISubclasser_WindowProc = CallOldProc(mtWin1, hWnd, uMsg, wParam, lParam)
Else
' Not allow the standard message
End If
bSkipWindowProc = False
End Select
End Function
Private Sub procWH_CBT(nCode As eHookConstants, wParam As Long, lParam As Long)
Dim lCBT_CREATEWND As tCBT_CREATEWND
Dim lCreateStruc As tCREATESTRUCT
Dim hNewWnd As Long
If nCode = HCBT_CREATEWND Then
' Handle of the window to be created
hNewWnd = wParam
' Get informations from pointers
CopyMemory ByVal VarPtr(lCBT_CREATEWND), ByVal lParam, LenB(lCBT_CREATEWND) ' OK
CopyMemory ByVal VarPtr(lCreateStruc), ByVal lCBT_CREATEWND.lpcs, LenB(lCreateStruc) ' OK
Me.Text1 = Me.Text1 & vbNewLine & Now & " Name of the handle parent : " & GetHandleName(lCreateStruc.hWndParent)
End If
End Sub
I don't see a question... so I'm guessing this was meant to share? If so, it should be in the code bank. I've notified the mods, so it may get moved.
Also, it's against the forum rules to post compiled binary bits, as there's no way to verify what's really in it. Best bet is to just supply the code and let people compile it on their own. So you may want to remove the HookLIB.dll from your zip and re-upload the zip w/o the DLL.
I re-upload the zip without the DLL compiled, just the source of my project and the source in C++ of the DLL.
The DLL will be compiled with MS studio C++ 6 or downloaded elsewhere.
@The trick : This DLL is the only one that I found which allow vb6 to do hook system wide (global in Windows). With vb6, to do hook system wide, we need a DLL in C++ (or asm or C), not written in vb6. A DLL written in vb6 allow to do hook local only (our program, not external program).
Wrong. Vb6 can create any dll. In example i set hook in another process. But you can create dll that will do global hook support. No matter which dll you using (written by vb6 or c++). In vb6 even you can create kernel mode driver, and hook dll it is simpler too. Sorry my english.
I’m really suprise of your position. Because I searched a lot since several months to make hook system wide with vb6. I really appreciate if you could provide any link to a source code of any DLL written in vb6 to do hook system wide. But, be aware, there are two scopes of hook : local or system wide. Local hook allow us to put hook on our program. Hook system wide allow us to put hook on any external program in Windows, managed from our program. On the web site vbAccelerator, they said :
“VB on its own cannot be used to create a system-wide hook. This is because the hook procedure must reside within a Windows DLL, and VB cannot create these beasts (because you cannot specify to export the HookProc function). […] If you have some C/C++ knowledge, however, there are various samples of creating system-wide hooks at MSDN and CodeGuru.” Source : http://www.vbaccelerator.com/home/VB...ry/article.asp
Hi. I create small example (dll and exe) which show the possible installing the global WH_CBT hook.
Explain few:
Dll project is very simple programm, which only take a message from system into the callback function - "HookProc":
Code:
Option Explicit
Dim hWndMain As Long ' // Window handle of main application
Public Sub Main()
End Sub
' // Callback function
Public Function HookProc( _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim data As COPYDATASTRUCT
If hWndMain = 0 Then
hWndMain = FindWindowEx(0, 0, vbNullString, "Test HookDll by The trick")
End If
data.cbData = &HC
data.dwData = GetCurrentProcessId()
data.lpData = VarPtr(nCode)
SendMessage hWndMain, WM_COPYDATA, ByVal 0, data
' // Call next hook chain
HookProc = CallNextHookEx(0, nCode, wParam, lParam)
End Function
' // Entry point
Public Function DllMain(ByVal hInstDll As Long, ByVal fdwReason As Long, ByVal lpvReserved As Long) As Long
DllMain = 1
End Function
As you see it just take messages and send its to window that is a main application window. It use a WM_COPYDATA message. You must compile dll into 'DLL' folder, because client application load dll from it. For a compilation we using a additional linker switches in .vbp file.
Client application is simpler too:
Code:
Option Explicit
Dim WithEvents subclass As clsTrickSubclass2
Dim hHook As Long
Dim hLib As Long
Dim lpHook As Long
Private Sub cmdPush_Click()
If hHook Then
' // Remove hook
UnhookWindowsHookEx hHook
hHook = 0
cmdPush.Caption = "Set CBT hook"
Else
' // Install CBT hook
hHook = SetWindowsHookEx(WH_CBT, lpHook, hLib, 0)
If hHook = 0 Then
MsgBox "Error"
End If
cmdPush.Caption = "Remove hook"
End If
End Sub
Private Sub Form_Load()
' // Load dll
hLib = LoadLibrary(App.Path & "\..\Dll\VBHook.dll")
If hLib = 0 Then
MsgBox "Dll not found"
End
End If
' // Get address of HookProc function
lpHook = GetProcAddress(hLib, "HookProc")
If lpHook = 0 Then
MsgBox "'HookProc' not found"
End
End If
' // Set listview style
SendMessage lvwLog.hWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ByVal LVS_EX_FULLROWSELECT Or LVS_EX_GRIDLINES
' // Subclass main window
Set subclass = New clsTrickSubclass2
subclass.Hook Me.hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
' // Remove hook
If hHook Then Call cmdPush_Click
' // Unload library
FreeLibrary hLib
End Sub
' // Window proc of main window
Private Sub subclass_WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, Ret As Long, DefCall As Boolean)
Select Case Msg
Case WM_COPYDATA
Dim data As COPYDATASTRUCT
Dim param() As Long
Dim hProc As Long
Dim sName As String
Dim pos As Long
ReDim param(2)
' // Copy parameters
CopyMemory data, ByVal lParam, Len(data)
CopyMemory param(0), ByVal data.lpData, data.cbData
' // Get process name from PID
sName = Space(260)
hProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, data.dwData)
If hProc Then
GetModuleBaseName hProc, 0, sName, Len(sName)
CloseHandle hProc
pos = InStr(1, sName, vbNullChar)
If pos Then sName = Left$(sName, pos - 1)
Else
sName = "PID " & data.dwData
End If
With lvwLog.ListItems.Add(, , sName)
.SubItems(1) = GetTextCode(param(0))
.SubItems(2) = param(1)
.SubItems(3) = param(2)
End With
Set lvwLog.SelectedItem = lvwLog.ListItems(lvwLog.ListItems.Count)
Ret = 1
Case Else
DefCall = True
End Select
End Sub
' // Get text representation of nCode
Private Function GetTextCode(ByVal nCode As Long) As String
Select Case nCode
Case 5: GetTextCode = "HCBT_ACTIVATE"
Case 6: GetTextCode = "HCBT_CLICKSKIPPED"
Case 3: GetTextCode = "HCBT_CREATEWND"
Case 4: GetTextCode = "HCBT_DESTROYWND"
Case 7: GetTextCode = "HCBT_KEYSKIPPED"
Case 1: GetTextCode = "HCBT_MINMAX"
Case 0: GetTextCode = "HCBT_MOVESIZE"
Case 2: GetTextCode = "HCBT_QS"
Case 9: GetTextCode = "HCBT_SETFOCUS"
Case 8: GetTextCode = "HCBT_SYSCOMMAND"
Case Else
GetTextCode = CStr(nCode)
End Select
End Function
It just set the WH_CBT hook and catch the WM_COPYDATA message from main window. I used my class for the subclassing, but you can use any method - it no matter.
Hi. I create small example (dll and exe) which show the possible installing the global WH_CBT hook.
My apologize, you're right ! I tested your project "proof for philippe734" with any external apps with succesfull. I think that I bad understand every technicals books on the subject...
To do hook system wide with vb6, we need a hook process in a DLL of course, but not only in C, written in vb6 did the trick too ;-)
Out of curiosity, either of you test your hooks on a 64 bit system? Per MSDN
SetWindowsHookEx can be used to inject a DLL into another process. A 32-bit DLL cannot be injected into a 64-bit process, and a 64-bit DLL cannot be injected into a 32-bit process. If an application requires the use of hooks in other processes, it is required that a 32-bit application call SetWindowsHookEx to inject a 32-bit DLL into 32-bit processes, and a 64-bit application call SetWindowsHookEx to inject a 64-bit DLL into 64-bit processes. The 32-bit and 64-bit DLLs must have different names.
Insomnia is just a byproduct of, "It can't be done"
Maybe I should've reworded it. Anyone try to hook a 64 bit process and verify values were passed correctly? VB will run in a 32bit environment. The video is way too fuzzy to see what's going on.
Edited: When viewed on youtube, clarity is far better. I noticed you added a caption saying Win64 Explorer not captured. So I am assuming, VB is limited to subclassing/hooking 32 bit applications only
Last edited by LaVolpe; Jun 26th, 2015 at 04:17 PM.
Insomnia is just a byproduct of, "It can't be done"
Maybe I should've reworded it. Anyone try to hook a 64 bit process and verify values were passed correctly? VB will run in a 32bit environment
No. On 64-bit process work only hook installed by 64-bit application. Same for 32-bits, it work only hooks installed by 32-bit application (in video - system windows (explorer, desktop) don't send notification on my application, because they are generated by 64-bit process). I think that theoretically you can install 64-bit hook from 32-bit application using "Heaven's Gate" technique. Anyway you should have a 64-bit dll.
That's the way I understood it. Global hooking with VB will become extinct before VB becomes extinct it seems. Eventually in the near future, most applications, I would think, installed on a 64 bit system will likely be written for 64 bit. VB will find fewer and fewer windows it can subclass globally. Maybe some sort of bridge/repeater might be designed by some that want to extend VB for 64 bit subclassing? hacks like Heaven's Gate ? etc
Last edited by LaVolpe; Jun 26th, 2015 at 04:36 PM.
Reason: removed link to heaven's gate
Insomnia is just a byproduct of, "It can't be done"
LaVolpe, for subclassing you can use other way (i mean no hook). I think it will work in 64-bit process too. Maybe i create this example. Anyway it used raw-assembly code for this trick. VB6 not allow create 64-bit application, but restriction of hook (and many other things) work in both direction. 64-bit application also not allow install hook (and many other things) to 32-bit process. Someday i think it will be also between 128 bit and 64 bit processes. Heaven's gate only allow switch between 32/64 bit code in same process. For example, i often work in debugger and most of api function has like this code:
Code:
JMP FAR 0033:73C3271E
It switch to 64 bit mode. Also each process (in 64 bit system) have a 64-bit ntdll (no matter 32/64 application). Theoretically you can find a needed function (RtlCreateUserThread) and run code into victim-process (before you must inject your 64-bit code there). There you can set subclassing and send parameters to 32-bit VB6-application, and process it there.
Subclassing may work, but unless the pointers/data are being marshalled between the target 64 bit process and the 32 bit dll, I would think subclassing would be pretty limited. Would like to see a working example that can return/set data, i.e., text, structures (like LVITEM), etc.
Insomnia is just a byproduct of, "It can't be done"
@The trick : I wish to test your small DLL with my project = receive the hook code, by sendmessage and subclassing, as in post #2. But, with the following code, in your DLL in vb6, I modify sendmessage to send the wparam and lparam of the hook. But, the wParam and lParam are wrong, while nCode is good sent. Watch the picture in attachment. This the same process : sendmessage of the hook code, wparam and lparam to my main window in order to subclass. On the left, with my DLL in C, of the right with the DLL in vb6 with the code below. As you can see, the wparam and lparam are different between the two. So here my question, how to use sendmessage in the HookProc to send the right wParam and lParam of the hook ?
' Callback function
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const WM_USER = &H400
If hWndMain = 0 Then
hWndMain = FindWindowEx(0, 0, vbNullString, "Hook global")
End If
SendMessage hWndMain, WM_USER + nCode, wParam, lParam
' Call next hook chain
HookProc = CallNextHookEx(0, nCode, wParam, lParam)
End Function
Last edited by philippe734; Jun 27th, 2015 at 04:08 AM.
Reason: wsa
Subclassing may work, but unless the pointers/data are being marshalled between the target 64 bit process and the 32 bit dll, I would think subclassing would be pretty limited. Would like to see a working example that can return/set data, i.e., text, structures (like LVITEM), etc.
No. Subclassing no limited. Just 64-bit process have a 64 bits pointers, and you also should use 64 bit pointers. And read process memory using 64 bit pointers. See this, there i create subclassing in another 32-bit process (for example WM_GETMINMAXINFO).
@The trick : I wish to test your small DLL with my project = receive the hook code, by sendmessage and subclassing, as in post #2. But, with the following code, in your DLL in vb6, I modify sendmessage to send the wparam and lparam of the hook. But, the wParam and lParam are wrong, while nCode is good sent. Watch the picture in attachment. This the same process : sendmessage of the hook code, wparam and lparam to my main window in order to subclass. On the left, with my DLL in C, of the right with the DLL in vb6 with the code below. As you can see, the wparam and lparam are different between the two. So here my question, how to use sendmessage in the HookProc to send the right wParam and lParam of the hook ?
' Callback function
Public Function HookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const WM_USER = &H400
If hWndMain = 0 Then
hWndMain = FindWindowEx(0, 0, vbNullString, "Hook global")
End If
SendMessage hWndMain, WM_USER + nCode, wParam, lParam
' Call next hook chain
HookProc = CallNextHookEx(0, nCode, wParam, lParam)
End Function
It bad approach (i mean WM_USER + nCode), per MSDN:
These values cannot be used to define messages that are meaningful throughout an application because some predefined window classes already define values in this range. For example, predefined control classes such as BUTTON, EDIT, LISTBOX, and COMBOBOX may use these values. Messages in this range should not be sent to other applications unless the applications have been designed to exchange messages and to attach the same meaning to the message numbers.
It bad approach (i mean WM_USER + nCode), per MSDN:
Ok, So I used your method with copystruct.
From my tests, I think there is a problem to get the wParam and lParam of the hook with your following method. Because, when I get the data in the structure in lParam, there is no data found. Here the code I talked about, with two exemples, the CREATESTRUCT in CBT and MOUSEHOOKSTRUCT in procMouse. In each exemple, the name of the handle pointed is empty. Instead of with my DLL in C, the same routine of following, the name of the handle pointed are right. I wish to understand, because I wish to use your method of DLL vb6.
Code:
Private Function ISubclasser_WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' [...]
' Get data from message + copy parameters
CopyMemory Data, ByVal lParam, Len(Data)
CopyMemory param(0), ByVal Data.lpData, Data.cbData
' [...]
' Get hook code
HookCode = param(0)
' param(1) is wParam from hook
' param(2) is lParam from hook
Call procWH_CBT(HookCode, param(1), param(2))
' [...]
End Function
Private Sub procWH_CBT(nCode As eHookConstants, wParam As Long, lParam As Long)
Dim lCBT_CREATEWND As tCBT_CREATEWND
Dim lCreateStruc As tCREATESTRUCT
If nCode = HCBT_CREATEWND Then
' [...]
' Get informations from pointers
CopyMemory ByVal VarPtr(lCBT_CREATEWND), ByVal lParam, LenB(lCBT_CREATEWND)
CopyMemory ByVal VarPtr(lCreateStruc), ByVal lCBT_CREATEWND.lpcs, LenB(lCreateStruc)
Me.Text1 = "Name of the handle parent : " & GetHandleName(lCreateStruc.hWndParent)
' [...]
End Sub
Private Sub procWH_MOUSE(nCode As eHookConstants, wParam As Long, lParam As Long)
Dim lMOUSEHOOKSTRUCT As tMOUSEHOOKSTRUCT
If nCode = HC_ACTION Then
If wParam = WM_LBUTTONUP Then ' left button up
CopyMemory ByVal VarPtr(lMOUSEHOOKSTRUCT), ByVal lParam, LenB(lMOUSEHOOKSTRUCT)
Me.Text1 = "Name of the handle pointed by your left click : " & GetHandleName(lMOUSEHOOKSTRUCT.hWnd)
' [...]
End Sub
Public Function GetHandleName(ByVal hWnd As Long) As String
Dim TextLen As Long ' receives length of text of title bar
Dim sCaption As String ' receives the text of the title bar
Dim iLength As Long ' receives the length of the returned string
TextLen = GetWindowTextLength(hWnd)
sCaption = Space$(TextLen + 1)
iLength = GetWindowText(hWnd, sCaption, TextLen + 1)
GetHandleName = Left(sCaption, iLength)
End Function