Attribute VB_Name = "mIMSG"
Option Explicit

Public Type COPYDATASTRUCT
    dwData As Long   ' Use this to identify your message
    cbData As Long   ' Number of bytes to be transferred
    lpData As Long   ' Address of data
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long

Private 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

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
       (ByVal hwnd As Long, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = -4

Public gRecipentName As String 'this is the name of the recipent we want to send messages to
Public gHooked As Boolean 'provides us with a way to see if we are hooked or not
Private uHwnd As Long 'hWnd in use
Private lPrevWndProc As Long 'original recipent of messages

'this is where we will list any variables we may want to change since
'we are going to change all the variables through the same sub
'NOTE: THESE ARE NOT THE ACTUALLY VARIABLES
'this is just a list so we can map the value to a variable
Public Enum VariableNameConstants
    vnMyString
    vnMyLong
    vnMyBoolean
End Enum

'our custom msg const it can be anything that isn't normally passed to the form
'in this case i am using a normal window message
Public Const WM_COPYDATA = &H4A
Public Const MSG_UPDATE As Long = WM_COPYDATA


Public Sub SendMSG(uVariable As VariableNameConstants, sValue As String)
    Dim cds As COPYDATASTRUCT
    Dim buf(1 To 255) As Byte
    'Dim sValue As String
    Dim hTarget As Long
    
    'find recipent hwnd
    hTarget = FindWindow(vbNullString, gRecipentName)
    Debug.Print "hTarget hWnd: " & hTarget
    
    'if a recipent was found then send msg
    If hTarget <> 0 Then
        'here we will convert the variant to a string
        'this means we only have to pass one type of data between apps
        'and makes life simpler
        'sValue = CStr(uValue)
        
        CopyMemory buf(1), ByVal sValue, Len(sValue)
        With cds
            .dwData = CInt(uVariable)
            .cbData = Len(sValue) + 1
            .lpData = VarPtr(buf(1))
        End With
        
        Call SendMessage(hTarget, MSG_UPDATE, uHwnd, cds)
    End If
End Sub

Public Sub StartCapture(hwnd As Long)
    'this hooks the form so we can catch messages sent to it
    uHwnd = hwnd
    lPrevWndProc = SetWindowLong(uHwnd, GWL_WNDPROC, AddressOf WindowProc)
    gHooked = True
End Sub

Public Sub EndCapture()
    'this unhooks the form so we can close things up without crashing
    Dim lngReturnValue As Long
    lngReturnValue = SetWindowLong(uHwnd, GWL_WNDPROC, lPrevWndProc)
    gHooked = False
    uHwnd = 0&
End Sub

Function WindowProc(ByVal hw As Long, _
                    ByVal uMsg As Long, _
                    ByVal wParam As Long, _
                    ByVal lParam As Long) As Long
                    
    'this function now captures any messages headed for the hooked form
    'here we will check for our custom message and  deal with that
    'or forward all other messages back to the form so it can respond normally

    Debug.Print "MSG: " & uMsg
    Select Case uMsg
    'check for a message we want
    Case MSG_UPDATE
        'If hw = uHwnd Then Exit Function 'this blocks messages sent by myself
        Dim cds As COPYDATASTRUCT
        Dim buf(1 To 255) As Byte
        Dim sParam As String
        
        CopyMemory cds, ByVal lParam, Len(cds)
        CopyMemory buf(1), ByVal cds.lpData, cds.cbData
        
        sParam = StrConv(buf, vbUnicode)
        sParam = Left$(sParam, InStr(1, sParam, Chr$(0)) - 1)
        
        RecdMSG cds.dwData, sParam
    Case Else
        'if the message isn't on we are looking for then pass
        'it on to the original recipent
        WindowProc = CallWindowProc(lPrevWndProc, hw, uMsg, wParam, lParam)
    End Select
End Function

'THIS IS THE ONLY THING YOU'LL NEED TO CHANGE AND THE VARIABLENAMECONSTANT
Public Sub RecdMSG(ByVal uVariable As VariableNameConstants, uValue As String)
    'this we will use basically like an event
    'it will be fired when we receive a custom message
    
    Select Case uValue
    'here we actually map it to the variables in our apps
    Case "exit"
        KillApp
    End Select
    'Debug.Print "VALUE: " & uValue
    
End Sub