"AddressOf" workaround for VB4

[BruceG]

Hey team,
I am working on a VB4 (yes 4) legacy project, and I'm trying to use the SetWindowLong API, which takes an "AddressOf WinProc" as a parameter. The code I am trying to implement assumes one is using VB6 (or at least 5). For VB4, AddressOf is a no-go. I attempted to get an answer via Googling, to no avail. The closest I came was a post on the "Xtreme VB Talk" forum, where it looked like there was a promising download, however they only let you download if you are registered, and the registration/activation email has not been forthcoming for hours.

Anyway, following is the the code I am trying to implement with the offending line in bold:

Public Declare Function SetWindowLong& Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
Public 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
Public Const GWL_WNDPROC = (-4)
Public WinProcOld As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Public Function WinProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If wMsg = WM_NCLBUTTONDOWN Then
        Form1.label1.Caption = "mouse down"
    End If
    
    WinProc = CallWindowProc(WinProcOld&, hWnd&, wMsg&, wParam&, lParam&)
End Function
 
Sub SubClassWnd(hWnd As Long)
    WinProcOld& = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WinProc)
End Sub
 
Sub UnSubclassWnd(hWnd As Long)
    SetWindowLong hWnd, GWL_WNDPROC, WinProcOld&
    WinProcOld& = 0
End Sub

Any help to get over this hurdle would be greatly appreciated ...

[LaVolpe]

That link you are talking about may not apply after all. Found this relating to that link

The direct download link has been removed, because it appears that this source code is part of a book by Matt Curland and copyrighted.

Found this on GitHub. Useful?

[BruceG]

Hi LaVolpe,
I appreciate your response - however, I did come across that code on GitHub, and I did in fact play with it, but I couldn't get things working - it appears that this code is designed to get the address of a variable, as opposed to the address of a function as seems to be required by the API. If that code can be molded to work the way I need, I'd be all ears ...
Anyway I also saw the page with the removed link, but there was also this:
http://www.xtremevbtalk.com/general/...essof-vb4.html
(but I could not download due to the registration issue).

[LaVolpe]

I'm a member on that site, have been for over a decade. That callback.zip attachment still exists. Seems like it's well documented on how to get what you need. Regarding the copyright notice this is what it said:

CBack32.Dll and CBack16.Dll can be redistributed freely, as can
derivations of the server. However, the sample code and rights to the
callback server belong to Microsoft Corporation and are copyrighted
with this book. Redistribution of the sample code is prohibited.

Based on who (an Administrator) posted that zip and the site itself, I'm assuming the zip does not contain the original sample code; rather sample code from someone else. May want to be patient for just a bit longer and see if your registration comes in. However, can't upload it here because it does contain binaries and that's against the rules. I've PM'd you should you not get your registration in a timely manner.

[LaVolpe]

If that XTreme project works for you, one recommendation. Move to common controls for subclassing. It can be safer to use both in IDE and compiled.
https://msdn.microsoft.com/en-us/lib...(v=vs.85).aspx

[DEXWERX]

Wanna do me a favor and dump the exports for the VB4 Debug Runtime?

dumpbin /exports "C:\Program Files (x86)\Microsoft Visual Studio\VBxx\VBAx.dll"

or if you're on a 32bit system..

dumpbin /exports "C:\Program Files\Microsoft Visual Studio\VBxx\VBAx.dll"

[The trick]

Try that, only change vba6.dll to yours (IDK how does vb4 work with unicode).

Private Declare Function EbGetExecutingProj Lib "vba6.dll" ( _
                         ByRef hProject As Long) As Long
Private Declare Function TipGetFunctionId Lib "vba6.dll" ( _
                         ByVal hProject As Long, _
                         ByVal strFunctionName As String, _
                         ByRef strFunctionId As String) As Long
Private Declare Function TipGetLpfnOfFunctionId Lib "vba6.dll" ( _
                         ByVal hProject As Long, _
                         ByVal strFunctionId As String, _
                         ByRef lpfn As Long) As Long

Public Function AddrOf( _
                ByRef sFuncName As String) As Long
    Dim hProject    As Long
    Dim lResult     As Long
    Dim sID         As String
    Dim pfn         As Long
    Dim sUnicode    As String

    sUnicode = StrConv(sFuncName, vbUnicode)
    
    EbGetExecutingProj hProject
    
    If hProject <> 0 Then
        If TipGetFunctionId(hProject, sUnicode, sID) = 0 Then
            If TipGetLpfnOfFunctionId(hProject, sID, pfn) = 0 Then
                AddrOf = pfn
            End If
        End If
    End If

End Function

[georgekar]

This AddrOf can't be used for compiled programs in vb6.