VB Quicktakes - Pass Data Using Subclassing

This code uses subclassing to capture window messages and allows two visual basic programs to communicate with one another.

***************Send Program*********************************************

----form--------
contains

cmdQuit - command button
cmdSend - command button
txtString - txtbox
------------------

Option Explicit

Private Const WM_COPYDATA = &H4A

Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type

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
'
'Copies a block of memory from one location to another.
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)


Private Sub cmdQuit_Click()
Unload Me
End Sub


Private Sub cmdSend_Click()
Dim sString As String
Dim lHwnd   As Long
Dim cds     As COPYDATASTRUCT
Dim buf(1 To 255) As Byte

sString = Trim$(txtString)
If sString = "" Then Exit Sub
'
' Get the handle of the target application.
'
lHwnd = FindWindow(vbNullString, "Receive")
'
' Copy the string into a byte array,
' converting it to ASCII. Assign lpData
' the address of the byte array.
'
Call CopyMemory(buf(1), ByVal sString, Len(sString))
With cds
    .dwData = 3
    .cbData = Len(sString) + 1
    .lpData = VarPtr(buf(1))
End With
'
' Send the string.
'
Call SendMessage(lHwnd, WM_COPYDATA, Me.hwnd, cds)
End Sub

**************Receive program******************************************

Name of Receive program = "Receive"

----module----------------------

Option Explicit

Public lpPrevWndProc As Long
Public lHwnd         As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_COPYDATA = &H4A

Public Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type
'
'Copies a block of memory from one location to another.
'
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

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

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
   (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As _
   Long) As Long
Public Sub pHook()
'
' Sub class the form to trap for Windows messages.
'
lpPrevWndProc = SetWindowLong(lHwnd, GWL_WNDPROC, AddressOf fWindowProc)
Debug.Print lpPrevWndProc
End Sub

Sub pReceiveMsg(lParam As Long)
Dim sString As String
Dim cds     As COPYDATASTRUCT
Dim buf(1 To 255) As Byte
'
' Copy the data sent to this application
' into a local structure.
'
Call CopyMemory(cds, ByVal lParam, Len(cds))
'
' Copy the string that was passed into a byte array.
'
Call CopyMemory(buf(1), ByVal cds.lpData, cds.cbData)
'
' Convert the ASCII byte array back to a Unicode string.
'
sString = StrConv(buf, vbUnicode)
sString = Left$(sString, InStr(1, sString, Chr$(0)) - 1)
'
' Display the received string.
'
frmReceive.lblString = sString
End Sub
Public Sub pUnhook()
'
' Remove the subclassing.
'
Call SetWindowLong(lHwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function fWindowProc(ByVal hw As Long, ByVal uMsg As Long, _
         ByVal wParam As Long, ByVal lParam As Long) As Long
'
' This callback routine is called by Windows whenever
' a message is sent to this form.  If it is the copy
' message call our procedure to receive the message.
'
If uMsg = WM_COPYDATA Then Call pReceiveMsg(lParam)
'
' Call the original window procedure associated with this form.
'
fWindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function


-----form-------
name:
frmReceive

contains
cmdQuit - command button
lblString
------------------

Option Explicit

Private Sub cmdQuit_Click()
Unload Me
End Sub

Private Sub Form_Load()
'
' Get this form's handle.
' Subclass this form to trap Windows messages.
'
lHwnd = Me.hwnd
Call pHook
End Sub

Private Sub Form_Unload(Cancel As Integer)
'
' Un-subclass the form.
'
Call pUnhook
End Sub