Solved

Hooking

Posted on 1999-01-17
6
284 Views
Last Modified: 2010-05-03
How would I be able to hook a window to recieve its messages without having to buy and expencive control?
0
Comment
Question by:ViperX
6 Comments
 
LVL 8

Expert Comment

by:MikeP090797
ID: 1469070
Do you want to hook your own form, or another app's window?
0
 
LVL 2

Expert Comment

by:polygon
ID: 1469071
maybe you want to subclass it. Read an example of AddressOf VB operator.
0
 
LVL 4

Expert Comment

by:mcix
ID: 1469072
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 10

Expert Comment

by:viktornet
ID: 1469073
You should use SetWindowsHookEx() and UnhookWindowsEx()
0
 
LVL 2

Accepted Solution

by:
VBDesigns earned 50 total points
ID: 1469074
Here's Sample code on how to do it.  It's pretty basic -- call the hookhWnd function with a 'name':

HookhWnd frmMain.hWnd, "MAIN"

And then when the program exists, unhook it with:

UnhookhWnd frmMain.hWnd, "MAIN"

You'll want to do your manipulating in the WindowProc procedure.  Yes, the code can be cleaned up a bit, but it's what I had laying around.  Good luck!

Public Function HookhWnd(plhWnd As Long, Optional pvItem As Variant) As Long
    Static bNoHook As Boolean
   
    Dim oControlClass As New clsControlClass
    Dim mlAddress As Long
   
    ' Create the hook!
    mlAddress = SetWindowLong(plhWnd, GWL_WNDPROC, AddressOf WindowProc)
   
    oControlClass.hWnd = plhWnd
    oControlClass.SubClassAddress = mlAddress
   
    If IsMissing(pvItem) Then
        oControlClass.Name = CStr(plhWnd)
        mcolHookedhWnds.Add oControlClass, CStr(plhWnd)
    Else
        oControlClass.Name = pvItem
        mcolHookedhWnds.Add oControlClass, CStr(pvItem)
    End If
   
    Debug.Print "Hook hWnd " + CStr(plhWnd)
   
    HookhWnd = True

ErrorHookhWndResume:
    Exit Function

ErrorHookhWnd:
    MsgBox "Error '" + Err.Description + "' occurred in (" _
     + App.Title + ")modMessages:HookhWnd!"
    Resume ErrorHookhWndResume
End Function


Public Function UnhookhWnd(plhWnd As Long, Optional pvItem As Variant) As Long
    ' If they aren't in run mode, exit.
    ' UnHook the passed control!
    Dim sString As String
   
    On Error GoTo ErrorUnhookhWnd
   
    If IsMissing(pvItem) Then
        sString = CStr(plhWnd)
    Else
        sString = CStr(pvItem)
    End If
   
    If mcolHookedhWnds.Count > 0 Then
        If mcolHookedhWnds.Item(sString).SubClassAddress > 0 Then
            UnhookhWnd = SetWindowLong(mcolHookedhWnds.Item(sString).hWnd, _
             GWL_WNDPROC, mcolHookedhWnds.Item(sString).SubClassAddress)
            mcolHookedhWnds.Item(sString).SubClassAddress = 0
            Debug.Print "Unhook hWnd " + sString
            mcolHookedhWnds.Remove sString
        End If
    End If
   
ErrorUnhookhWndResume:
    Exit Function
   
ErrorUnhookhWnd:
    MsgBox "Error '" + Err.Description + "' occurred in (" _
     + App.Title + ")modMessages:UnhookhWnd!"
    Resume ErrorUnhookhWndResume
End Function

Public Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    ' Call the normal window proc for the control!
   
    Dim lTemp As Long
    Dim bEat As Boolean
    Dim sControlName As String
    Dim oClass As clsControlClass
    Dim iLoop As Integer
    Dim lResult As Long
   
    Static bError As Boolean
   
    On Error GoTo ErrorWindowProc
   
    If bError Then Exit Function
   
    For Each oClass In mcolHookedhWnds
        If oClass.hWnd = hw Then
            sControlName = oClass.Name
            Exit For
        End If
    Next
   
    If sControlName = "" Then Exit Function
   
    ' What type of message was sent?
    Select Case UCase(sControlName)
        Case "MAIN"
            Select Case uMsg
                Case WM_TIMECHANGE
                    ' Time has changed!  Update character information!
                bEat=True

                 Case Else
            End Select
   
        Case Else
       
    End Select
   
    ' Eat the message?  If not, pass it on!
    If Not bEat Then
        lResult = CallWindowProc(mcolHookedhWnds.Item(sControlName).SubClassAddress, _
         hw, uMsg, wParam, lParam)
    End If
   
ErrorWindowProcResume:
    Exit Function
   
ErrorWindowProc:
    iwcharEMessage "Error '" + Err.Description + "' occurred in (" + App.Title _
     + ")modMessages:WindowProc!"
    bError = True
    Resume ErrorWindowProcResume
End Function

Here's the Control Class (clsControlClass) code: (priavate single-use instancing)

Option Explicit

Dim mlhWnd As Long
Dim mlSubClassAddress As Long
Dim mlOptions As Long
Dim msName As String
Public Property Get hWnd() As Long
    hWnd = mlhWnd
End Property

Public Property Let hWnd(ByVal plhWnd As Long)
    mlhWnd = plhWnd
End Property

Public Property Get SubClassAddress() As Long
    SubClassAddress = mlSubClassAddress
End Property

Public Property Let SubClassAddress(ByVal plSubClassAddress As Long)
    mlSubClassAddress = plSubClassAddress
End Property

Public Property Get Options() As Long
    Options = mlOptions
End Property

Public Property Let Options(ByVal plOptions As Long)
    mlOptions = plOptions
End Property

Public Property Get Name() As String
    Name = msName
End Property

Public Property Let Name(ByVal psValue As String)
    msName = psValue
End Property





0
 
LVL 1

Expert Comment

by:Johnn
ID: 1469075
email me if you'd like to get my CHOOK dll.  This subclasser hooks every message.  You only need to filter out the ones you want vs. setting the messages you want then filtering thoses ones for each.

here's an example:
dim myHook as new CHook

set myHook=new CHook
myHook.hWnd=yourwindow.hWnd

then you just do this when you form unloads

myHook.hWnd=0
set myHook=nothing

You don't even have form requirement.  So in otherwords if you were building an activex dll you don't nessecarily have to have a form in it to use a subclassing control

jnickle@shaw.wave.ca
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

828 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question