[AccessD] ISFEMessage Class (talking between applications)

Drew Wutka DWUTKA at Marlow.com
Mon Jul 16 16:55:23 CDT 2007


Option Explicit
Private Declare Function CreateWindowEx Lib "user32" Alias
"CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String,
ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long,
ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal
hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long,
lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long)
As Long
Private Declare Function GetWindowText Lib "user32" Alias
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal
cch As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias
"SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Const HWND_BROADCAST = &HFFFF&
Dim strType As String
Dim DataCollection As Collection
Dim DataNames  As Collection
Public FirstParameter As Long
Public SecondParameter As Long
Property Get DataCount() As Long
DataCount = DataNames.Count
End Property
Property Get DataInfo(strName As String) As String
DataInfo = DataCollection(strName)
End Property
Public Function AddData(ByVal strDataName As String, ByVal strData As
String)
On Error Resume Next
DataCollection.Remove strDataName
DataNames.Remove strDataName
DataCollection.Add strData, strDataName
DataNames.Add strDataName
End Function
Private Function GetStringSegment(ByRef strData As String) As String
Dim intLength As Long
intLength = Asc(Left(strData, 1))
GetStringSegment = Mid(strData, 2, intLength)
strData = Mid(strData, intLength + 2)
End Function
Private Function CreateStringSegment(ByVal strToCreate As String) As
String
If Len(strToCreate) > 255 Then strToCreate = Left(strToCreate, 255)
CreateStringSegment = Chr(Len(strToCreate)) & strToCreate
End Function
Private Function SetDataToWindow() As Long
Dim strDataToSend As String
Dim inthWndOfWindow As Long
Dim i As Long
strDataToSend = CreateStringSegment(Me.MessageType)
strDataToSend = strDataToSend & CreateStringSegment("" &
SecondParameter)
For i = 1 To DataCollection.Count
    strDataToSend = strDataToSend & CreateStringSegment(DataNames(i)) &
CreateStringSegment(DataCollection(i))
Next i
FirstParameter = -3
SecondParameter = CreateWindowEx(0, "STATIC", strDataToSend, 0, 0, 0, 0,
0, 0, 0, App.hInstance, ByVal 0&)
imMessaging.SendISFEMessage imMessaging.ISFE2007hWnd, FirstParameter,
SecondParameter
End Function
Private Sub Class_Initialize()
Set DataCollection = New Collection
Set DataNames = New Collection
End Sub
Private Sub Class_Terminate()
Set DataCollection = Nothing
Set DataNames = Nothing
End Sub
Property Get MessageType() As String
MessageType = strType
End Property
Public Function ProcessIncomingData()
Select Case FirstParameter
    Case -2
        strType = "Handshake"
    Case -1
        strType = "Pulse"
    Case 1
        strType = "NewRequest"
        'This is for the ISFE
    Case -3
        Dim strText As String
        Dim strName As String
        Dim strData As String
        Dim intLen As Long
        intLen = 256 ^ 2
        strText = Space(intLen)
        intLen = GetWindowText(SecondParameter, strText, intLen)
        If intLen > 0 Then
            strText = Left(strText, intLen)
            strType = GetStringSegment(strText)
            SecondParameter = CLng(GetStringSegment(strText))
            Do Until strText = ""
                strName = GetStringSegment(strText)
                strData = GetStringSegment(strText)
                DataCollection.Add strData, strName
                DataNames.Add strName
            Loop
        End If
        DestroyWindow SecondParameter
End Select
End Function
Property Let MessageType(strEnter As String)
strType = strEnter
Select Case strType
    Case "Handshake"
        FirstParameter = -2
    Case "Pulse"
        FirstParameter = -1
    Case "NewRequest"
        FirstParameter = 1
End Select
End Property
Public Function SendData()
If DataCollection.Count = 0 Then
    imMessaging.SendISFEMessage imMessaging.ISFE2007hWnd,
FirstParameter, SecondParameter
Else
    SetDataToWindow
End If
End Function
Public Function BroadcastData()
imMessaging.SendISFEMessage HWND_BROADCAST, FirstParameter,
SecondParameter
End Function



The information contained in this transmission is intended only for the person or entity to which it is addressed and may contain II-VI Proprietary and/or II-VI BusinessSensitve material. If you are not the intended recipient, please contact the sender immediately and destroy the material in its entirety, whether electronic or hard copy. You are notified that any review, retransmission, copying, disclosure, dissemination, or other use of, or taking of any action in reliance upon this information by persons or entities other than the intended recipient is prohibited.





More information about the AccessD mailing list