Source code:
CLASS MODULE : Name = 'clsBuffer'
Public BUFFER As String
Public Sub AddToBuffer(Idata As String)
BUFFER = BUFFER & Idata
End Sub
Public Function Get_Next_Line() As String
Dim temp As String
Dim Oput As String
Dim N As Integer
temp = BUFFER
If Len(temp) > 0 Then
Do
N = N + 1
Oput = Oput & Mid(temp, N, 1)
Loop Until Mid(temp, N, 1) = ";" Or N = Len(temp)
If Right(Oput, 1) = ";" Then
temp = Right(temp, (Len(temp) - Len(Oput)))
BUFFER = temp
Get_Next_Line = Left(Oput, (Len(Oput) - 1))
Else
Get_Next_Line = ""
End If
Else
Get_Next_Line = ""
End If
End Function
Public Function BufferEmpty() As Boolean
If BUFFER = "" Then
BufferEmpty = True
Exit Function
End If
Dim N As Double
Do
N = N + 1
Loop Until N = Len(BUFFER) Or Mid(BUFFER, N, 1) = ";"
If Mid(BUFFER, N, 1) = ";" Then
BufferEmpty = False
Else
BufferEmpty = True
End If
End Function
USER CONTROL FORM :: Name 'whatever you like'
Option Explicit
Private WsOk As Boolean
Private InBuffer As New clsBuffer
'Default Property Values:
Const m_def_RemoteIP = "0.0.0.0"
'Property Variables:
Dim m_RemoteIP As String
Event MessageArrived(message As String)
Event Connected()
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=WsIn,WsIn,-1,LocalPort
Public Property Get LocalInPort() As Long
LocalInPort = WsIn.LocalPort
End Property
Public Property Let LocalInPort(ByVal New_LocalInPort As Long)
WsIn.LocalPort() = New_LocalInPort
PropertyChanged "LocalInPort"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=WsOut,WsOut,-1,LocalPort
Public Property Get LocalOutPort() As Long
LocalOutPort = WsOut.LocalPort
End Property
Public Property Let LocalOutPort(ByVal New_LocalOutPort As Long)
WsOut.LocalPort() = New_LocalOutPort
PropertyChanged "LocalOutPort"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=WsIn,WsIn,-1,RemotePort
Public Property Get RemoteInPort() As Long
RemoteInPort = WsIn.RemotePort
End Property
Public Property Let RemoteInPort(ByVal New_RemoteInPort As Long)
WsIn.RemotePort() = New_RemoteInPort
PropertyChanged "RemoteInPort"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=WsOut,WsOut,-1,RemotePort
Public Property Get RemoteOutPort() As Long
RemoteOutPort = WsOut.RemotePort
End Property
Public Property Let RemoteOutPort(ByVal New_RemoteOutPort As Long)
WsOut.RemotePort() = New_RemoteOutPort
PropertyChanged "RemoteOutPort"
End Property
Private Sub UserControl_Initialize()
UserControl.Width = 2895
UserControl.Height = 1080
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
WsIn.LocalPort = PropBag.ReadProperty("LocalInPort", 0)
WsOut.LocalPort = PropBag.ReadProperty("LocalOutPort", 0)
WsIn.RemotePort = PropBag.ReadProperty("RemoteInPort", 0)
WsOut.RemotePort = PropBag.ReadProperty("RemoteOutPort", 0)
m_RemoteIP = PropBag.ReadProperty("RemoteIP", m_def_RemoteIP)
End Sub
Private Sub UserControl_Resize()
UserControl.Width = 2895
UserControl.Height = 1080
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("LocalInPort", WsIn.LocalPort, 0)
Call PropBag.WriteProperty("LocalOutPort", WsOut.LocalPort, 0)
Call PropBag.WriteProperty("RemoteInPort", WsIn.RemotePort, 0)
Call PropBag.WriteProperty("RemoteOutPort", WsOut.RemotePort, 0)
Call PropBag.WriteProperty("RemoteIP", m_RemoteIP, m_def_RemoteIP)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,0.0.0.0
Public Property Get RemoteIP() As String
RemoteIP = m_RemoteIP
End Property
Public Property Let RemoteIP(ByVal New_RemoteIP As String)
m_RemoteIP = New_RemoteIP
PropertyChanged "RemoteIP"
End Property
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
m_RemoteIP = m_def_RemoteIP
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=5
Public Sub Listen()
WsIn.Listen
WsOut.Listen
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=5
Public Sub Connect()
WsOk = False
WsIn.Connect m_RemoteIP
WaitForWsOk
WsOk = False
WsOut.Connect m_RemoteIP
WaitForWsOk
RaiseEvent Connected
End Sub
Private Sub WaitForWsOk()
Do
DoEvents
Loop While WsOk = False
End Sub
Private Sub WsIn_ConnectionRequest(ByVal requestID As Long)
WsIn.Close
WsIn.Accept requestID
WsIn.SendData "CONFIRM"
End Sub
Private Sub WsIn_DataArrival(ByVal bytesTotal As Long)
Dim wsData As String
WsIn.GetData wsData, bytesTotal
If wsData = "CONFIRM" Then
WsOk = True
Else
InBuffer.AddToBuffer wsData
Do While InBuffer.BufferEmpty = False
RaiseEvent MessageArrived(InBuffer.Get_Next_Line)
Loop
End If
End Sub
Private Sub WsOut_ConnectionRequest(ByVal requestID As Long)
WsOut.Close
WsOut.Accept requestID
WsOut.SendData "CONFIRM"
RaiseEvent Connected
End Sub
Private Sub WsOut_DataArrival(ByVal bytesTotal As Long)
Dim wsData As String
WsOut.GetData wsData, bytesTotal
If wsData = "CONFIRM" Then
WsOk = True
Else
End If
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=5
Public Sub Send(SendData As String)
WsOut.SendData SendData & ";"
End Sub
Now add 2 winsock controls named WsIn and WsOut to the form or usercontrol.
Comments