GFLRC/Receiver/GFLRC_Receiverfrm.frm
VERSION 5.00
Begin VB.Form GFLRC_Receiverfrm
BorderStyle = 0 'Kein
Caption = "GFLRC_Receiverfrm"
ClientHeight = 90
ClientLeft = 0
ClientTop = 0
ClientWidth = 90
LinkTopic = "Form1"
ScaleHeight = 90
ScaleWidth = 90
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows‑Standard
End
Attribute VB_Name = "GFLRC_Receiverfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2002 by Louis. Created out of (god bless it) NN99 code.
'Use the GFLRC code to exchange strings between two applications.
'
'Any target form should own the following sub:
'Public Sub GFLRC_ReceiveMessage(ByVal Message As String)
' 'on error resume next
'End Sub
'
'GFSubClassWindowProc
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
'GFSubClassWindowProc
Const WM_COPYDATA = &H4A
'GFSubClassWindowProc
Private Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
'GFLRCStruct ‑ stores target form references
Private Type GFLRCStruct
TargetForm As Object
End Type
Dim GFLRCStructNumber As Integer
Dim GFLRCStructArray() As GFLRCStruct
'[Open/Close]LRCPort
Dim LRCPortOpenedFlag As Boolean
Dim LRCPortGFLRC_ReceiverfrmhWndOld As Long
Dim LRCPortGFLRC_ReceiverfrmhWndUnchanged As Long
Public Sub GFLRC_AddCallBackForm(ByRef CallBackForm As Object)
'on error resume next
If Not (GFLRCStructNumber = 32766) Then 'verify
GFLRCStructNumber = GFLRCStructNumber + 1
ReDim Preserve GFLRCStructArray(1 To GFLRCStructNumber) As GFLRCStruct
Set GFLRCStructArray(GFLRCStructNumber).TargetForm = CallBackForm
Else
MsgBox "internal error in GFLRC_ReceiveCallBackForm(): overflow !", vbOKOnly + vbExclamation
End If
End Sub
Public Sub GFLRC_RemoveCallBackForm(ByRef CallBackForm As Object)
'on error resume next
Dim StructIndex As Integer
Dim StructLoop As Integer
'begin
For StructLoop = 1 To GFLRCStructNumber
If GFLRCStructArray(StructLoop).TargetForm Is CallBackForm Then
StructIndex = StructLoop
End If
Next StructLoop
If StructIndex = 0 Then Exit Sub 'verify
For StructLoop = StructIndex To GFLRCStructNumber
If Not (StructLoop = GFLRCStructNumber) Then
Set GFLRCStructArray(StructLoop).TargetForm = GFLRCStructArray(StructLoop + 1).TargetForm
Else
GFLRCStructNumber = GFLRCStructNumber ‑ 1
StructLoop = GFLRCStructNumber
If StructLoop < 1 Then StructLoop = 1 'verify
ReDim Preserve GFLRCStructArray(1 To StructLoop) As GFLRCStruct
Exit For 'important
End If
Next StructLoop
Exit Sub
End Sub
Public Sub OpenLRCPort(ByVal LRCLocalPortNamePassed As String) 'enables bypassing GFLRC_Receiverfrm messages to LRCHookProcSub()
'On Error Resume Next 'LRCLocalPortNamePassed will be caption of GFLRC_Receiverfrm (should not be nothing)
If LRCPortOpenedFlag = False Then
LRCPortOpenedFlag = True
'
Call GFSubClass(Me, "GFLRC_Receiverfrm", Me, True)
GFLRC_Receiverfrm.Caption = LRCLocalPortNamePassed
GFLRC_Receiverfrm.Refresh 'verify caption is changed
'
End If
End Sub
Public Sub CloseLRCPort() 'disables bypassing GFLRC_Receiverfrm messages to LRCHookProcSub()
'On Error Resume Next
Dim Temp As Long
If LRCPortOpenedFlag = True Then
LRCPortOpenedFlag = False
'
Call GFSubClass_UnSubclass("GFLRC_Receiverfrm", Me)
GFLRC_Receiverfrm.Caption = "" 'reset (important)
GFLRC_Receiverfrm.Refresh 'verify caption is changed
'
End If
End Sub
Public Sub GFSubClassWindowProc(ByVal SourceDescription As String, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'On Error Resume Next
Dim TargetFormLoop As Integer
Dim Tempstr$
Dim TempArrayByte() As Byte
Dim COPYDATASTRUCTVar As COPYDATASTRUCT
'begin
Select Case Msg
Case WM_COPYDATA
If Not ((wParam = 0) Or (lParam = 0)) Then 'verify valid values arrived
'STOLEN CODE ('PassString' from VBNet)
'stolen annotations: copy the data sent to this application into a local structure
Call CopyMemory(COPYDATASTRUCTVar, ByVal lParam, Len(COPYDATASTRUCTVar))
ReDim TempArrayByte(1 To COPYDATASTRUCTVar.cbData) As Byte 'length of msg line passed by .cdData
'copy the string that was passed into a byte array
Call CopyMemory(TempArrayByte(1), ByVal COPYDATASTRUCTVar.lpData, COPYDATASTRUCTVar.cbData)
'convert the ASCII byte array back to a Unicode string
Tempstr$ = StrConv(TempArrayByte(), vbUnicode)
'END OF STOLEN CODE
'***SUB RECEIVING LRC DATA***
For TargetFormLoop = 1 To GFLRCStructNumber
Call GFLRCStructArray(TargetFormLoop).TargetForm.GFLRC_ReceiveMessage(Tempstr$)
Next TargetFormLoop
'***END***
End If
End Select
End Sub
[END OF FILE]