VB6 - Program Communication

[Elroy]

Here's my ComCtl32.dll version of the same thing. I didn't give of an example of how to find the hWnd of some receiving program, but others who may want to use this can work that out.

The piece to subclass the receiving window. This needs to be in a BAS module. The only thing Public about it is the SubclassFormToReceiveStringMsg procedure. Just call it, and your set. No need to worry about un-subclassing.

Option Explicit
'
Private Const WM_DESTROY As Long = &H2&
'
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Dim bSetWhenSubclassing_UsedByIdeStop As Boolean ' Never goes false once set by first subclassing, unless IDE Stop button is clicked.
'
Private Type POINTAPI
    x As Long
    y As Long
End Type
'
Private Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
'
Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type
'
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
Private Declare Function GetMem4 Lib "msvbvm60.dll" (ByRef Source As Any, ByRef Dest As Any) As Long
'

Public Sub SubclassFormToReceiveStringMsg(frm As VB.Form)
    ' See SendStringToAnotherWindow for sending a message (which doesn't require subclassing).
    SubclassSomeWindow frm.hWnd, AddressOf StringMessage_Proc, ObjPtr(frm)
End Sub

Private Function StringMessage_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    If uMsg = WM_DESTROY Then
        UnSubclassSomeWindow hWnd, AddressOf_StringMessage_Proc
        StringMessage_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    If IdeStopButtonClicked Then ' Protect the IDE.  Don't execute any specific stuff if we're stopping.  We may run into COM objects or other variables that no longer exist.
        StringMessage_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If
    '
    ' On this one, we use dwRefData to save the ObjPtr(SomeForm) of the form that is to receive the message.
    '
    ' Called as follows:
    '       SubclassSomeWindow Me.hWnd, AddressOf StringMessage_Proc, ObjPtr(Me)
    '
    ' NOTE: Best done in the Form_Load event, but doesn't really matter so long as it's done before the message is sent.
    '
    ' This can simultaneously be used by as many forms as will need it,
    ' but it can only be done once per form.
    '
    ' See SendStringToAnotherWindow for sending a message (which doesn't require subclassing).
    '
    Dim cds As COPYDATASTRUCT
    Dim Buf() As Byte
    Dim sMsg As String
    Dim frmStolen As VB.Form
    Dim frm As VB.Form
    Const WM_COPYDATA As Long = &H4A&
    '
    If uMsg = WM_COPYDATA Then
        Call CopyMemory(cds, ByVal lParam, Len(cds))
        ReDim Buf(1 To cds.cbData)
        Call CopyMemory(Buf(1), ByVal cds.lpData, cds.cbData)
        sMsg = StrConv(Buf, vbUnicode)
        sMsg = RTrimNull(sMsg)
        '
        ' Now, we can do something with the message.
        ' First, we've got to "steal" a reference to our form, using it's ObjPtr (in dwRefData).
        ' We'll create a "good" reference just to be safe.
        '
        GetMem4 dwRefData, frmStolen    ' Steal reference.
        Set frm = frmStolen             ' Make good reference.
        GetMem4 0&, frmStolen           ' Un-steal reference.
        frm.HereIsYourMessage sMsg  ' HereIsYourMessage MUST be public, or we can't find it this way.
    End If
    '
    ' Give control to other hooks, if they exist.
    StringMessage_Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

Private Function AddressOf_StringMessage_Proc() As Long
    AddressOf_StringMessage_Proc = ProcedureAddress(AddressOf StringMessage_Proc)
End Function

Private Function RTrimNull(s As String) As String
    Dim i As Integer
    i = InStr(s, vbNullChar)
    If i Then
        RTrimNull = Left$(s, i - 1)
    Else
        RTrimNull = s
    End If
End Function

Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToHook As Long, Optional dwRefData As Long)
    ' This just always uses hWnd for uIdSubclass, as we never have a need to subclass the same window to the same proc.
    ' The uniqueness is pfnSubclass and uIdSubclass (second and third argument below).
    '
    ' This can be called AFTER the initial subclassing to update dwRefData.
    '
    bSetWhenSubclassing_UsedByIdeStop = True
    Call SetWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd, dwRefData)
End Sub

Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToHook As Long)
    ' Only needed if we specifically want to un-subclass before we're closing the form (or control),
    ' otherwise, it's automatically taken care of when the window closes.
    '
    ' Be careful, some subclassing may require additional cleanup that's not done here.
    Call RemoveWindowSubclass(hWnd, AddressOf_ProcToHook, hWnd)
End Sub

Private Function ProcedureAddress(AddressOf_TheProc As Long)
    ' A private "helper" function for writing the AddressOf_... functions (see above notes).
    ProcedureAddress = AddressOf_TheProc
End Function

Private Function IdeStopButtonClicked() As Boolean
    ' The following works because all variables are cleared when the STOP button is clicked,
    ' even though other code may still execute such as Windows calling some of the subclassing procedures below.
    IdeStopButtonClicked = Not bSetWhenSubclassing_UsedByIdeStop
End Function

And here's the piece to send messages. It can be in a BAS module or a FRM module, doesn't matter:

Option Explicit
'
Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type
'
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
'

Public Sub SendStringToAnotherWindow(hWndSender As Long, hWndTarget As Long, sMsg As String)
    ' This can be used to send a message (string) to another window, possibly in another VB6 program.
    ' The other VB6 program MUST be expecting the message.  And it will need to be subclassed (i.e., hooked).
    ' See the StringMessageHook, StringMessageUnhook, and StringMessageWindowProc for details on how
    ' the receiving program must be set up.
    '
    Dim cds As COPYDATASTRUCT
    Dim lpdwResult As Long
    Dim Buf() As Byte
    Const WM_COPYDATA = &H4A
    '
    If hWndTarget Then
        ReDim Buf(1 To Len(sMsg) + 1)
        Call CopyMemory(Buf(1), ByVal sMsg, Len(sMsg)) ' Copy the string into a byte array, converting it to ASCII.
        cds.dwData = 3
        cds.cbData = Len(sMsg) + 1
        cds.lpData = VarPtr(Buf(1))
        'Call SendMessage(hWndTarget, WM_COPYDATA, Me.hwnd, cds)
        SendMessageTimeout hWndTarget, WM_COPYDATA, hWndSender, cds, 0, 5000, lpdwResult ' Return after 5 seconds even if receiver didn't acknowledge.
    End If
End Sub

Enjoy,
Elroy

EDIT1: LaVolpe's caveats probably apply to my code as well, as he's the one who gave me the original ideas on how to do this.

EDIT2: Also, the receiving form must have a public "HereIsYourMessage" method. That's how it'll actually receive the message.