host/vb_net_test/nettest.frm

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "TCP/UDP Test program"
   ClientHeight    =   5655
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5670
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5655
   ScaleWidth      =   5670
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command3 
      Caption         =   "TCP to Filter"
      Height          =   375
      Left            =   3720
      TabIndex        =   5
      Top             =   2520
      Width           =   1575
   End
   Begin VB.TextBox Text4 
      Height          =   2535
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Text            =   "nettest.frx":0000
      Top             =   3000
      Width           =   5055
   End
   Begin VB.CommandButton Command2 
      Caption         =   "TCP to FilterManager"
      Height          =   375
      Left            =   3360
      TabIndex        =   3
      Top             =   2040
      Width           =   1935
   End
   Begin MSWinsockLib.Winsock TCPSock 
      Left            =   4920
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Send UDP"
      Height          =   375
      Left            =   4320
      TabIndex        =   2
      Top             =   1560
      Width           =   975
   End
   Begin VB.TextBox Text1 
      Height          =   855
      Left            =   360
      TabIndex        =   0
      Text            =   "<packet></packet>"
      Top             =   600
      Width           =   4935
   End
   Begin MSWinsockLib.Winsock UDPSock 
      Left            =   4320
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin VB.Label Label1 
      Caption         =   "Packet contents"
      Height          =   255
      Left            =   360
      TabIndex        =   1
      Top             =   360
      Width           =   2895
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long

Dim filterManagerHostname As String
Dim filterManagerTCPPort As Integer

Dim filterHostname As String
Dim filterTCPPort As Integer
Dim filterUDPPort As Integer
Dim fileList As String
Dim lastModified As String

Dim protocolVersion As String
Dim connected As Boolean
Dim responseNumber As Integer


Private Sub Command1_Click()

    ' build the contents of the XML packet.
    xml = "<packet></packet>"

    ' Use the first winsock control to send a UDP packet.
    UDPSock.RemoteHost = filterHostname
    UDPSock.RemotePort = filterUDPPort
    UDPSock.SendData xml

End Sub

Private Sub Command2_Click()
    
    ' establish a TCP connection to a filtermanager
    TCPSock.Close
    TCPSock.Connect filterManagerHostname, filterManagerTCPPort

End Sub

Private Sub Command3_Click()
    ' establish a TCP connection to a filter
    TCPSock.Close
    TCPSock.Connect filterHostname, filterTCPPort
End Sub

Private Sub Form_Load()
    protocolVersion = "1.1"
    
    ''''TEMP
    filterManagerHostname = "killigrew.ukc.ac.uk"
    filterManagerTCPPort = 4567
    Exit Sub
    ''' ENDTEMP
    
    On Error GoTo iniError
    Dim buf As String * 256
    Dim length As Long
    length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
    filterManagerHostname = Left$(buf, length)
    length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
    filterManagerTCPPort = Left$(buf, length)
    
    Exit Sub
    
iniError:
    x = MsgBox("The i-scream Winhost could not read the correct settings from the winhost.ini file.  Please correct these and try again.", 48, "Configuration not found")
    End
    
End Sub

Private Sub TCPSock_Connect()
      
   responseNumber = 0
   
    ' Send something as soon as we connect to the server.
    If connected = False Then
        ' contact the FilterManager
        TCPSock.SendData "STARTCONFIG" & vbCrLf
    Else
       ' Contact the Filter
       TCPSock.SendData "HEARTBEAT" & vbCrLf
    End If
   
End Sub

Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
    
    responseNumber = responseNumber + 1
    
    ' Get the line from the server.
    TCPSock.GetData response, vbString, bytesTotal
    
    ' Remove linefeeds and returns from the line.
    response = Replace(response, Chr(13), "")
    response = Replace(response, Chr(10), "")
    Text4.Text = Text4.Text & vbCrLf & response
    
    If connected = False Then
        ' Perform TCP configuration (1.1)
        On Error GoTo configError
        Select Case responseNumber
            Case 1:
                If Not response = "OK" Then GoTo configError
                TCPSock.SendData "LASTMODIFIED" & vbCrLf
            Case 2:
                If response = "ERROR" Then GoTo configError
                lastModified = response
                TCPSock.SendData "FILELIST" & vbCrLf
            Case 3:
                If response = "ERROR" Then GoTo configError
                fileList = response
                TCPSock.SendData "UDPUpdateTime" & vbCrLf
            Case 4:
                If response = "ERROR" Then GoTo configError
                TCPSock.SendData "TCPUpdateTime" & vbCrLf
            Case 5:
                If response = "ERROR" Then GoTo configError
                TCPSock.SendData "ENDCONFIG" & vbCrLf
            Case 6:
                If Not response = "OK" Then GoTo configError
                TCPSock.SendData "FILTER" & vbCrLf
            Case 7:
                'we got a filter list here.
                readTo = 0
                ' get hostname
                readTo = InStr(1, response, ";", vbBinaryCompare)
                filterHostname = Mid(response, 1, readTo - 1)
                response = Mid(response, readTo + 1, Len(response))
                ' get UDP Port number
                readTo = InStr(1, response, ";")
                filterUDPPort = Mid(response, 1, readTo - 1)
                response = Mid(response, readTo + 1, Len(response))
                ' get TCP Port number
                filterTCPPort = response
                TCPSock.SendData "END" & vbCrLf
            Case 8:
                If Not response = "OK" Then GoTo configError
                connected = True
                responseNumber = 0
                TCPSock.Close
                Text4.Text = Text4.Text & vbCrLf & "  <closed>"
                x = MsgBox("got config okay")
        End Select
    Else
        ' Perform a heartbeat (1.1)
        On Error GoTo heartbeatError
        Select Case responseNumber
            Case 1:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData "CONFIG" & vbCrLf
            Case 2:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData fileList & vbCrLf
            Case 3:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData lastModified & vbCrLf
            Case 4:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
            Case 5:
                If Not response = "OK" Then GoTo heartbeatError
                TCPSock.Close
                x = MsgBox("heartbeat sent okay.")
        End Select
    
    End If
    
    
    Exit Sub
    
configError:
    x = MsgBox("error doing configuration")
heartbeatError:
    x = MsgBox("error doing configuration")
End Sub

Revision:	1.5
Committed:	Fri Feb 23 10:34:47 2001 UTC (23 years, 8 months ago) by pjm2
Branch:	MAIN
Changes since 1.4:	+29 -31 lines
Log Message:	TCPSock and UDPSock now have their own names
#	User	Rev	Content
1	pjm2	1.1	VERSION 5.00
2			Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
3			Begin VB.Form Form1
4			BorderStyle = 3 'Fixed Dialog
5			Caption = "TCP/UDP Test program"
6			ClientHeight = 5655
7			ClientLeft = 45
8			ClientTop = 330
9			ClientWidth = 5670
10			LinkTopic = "Form1"
11			MaxButton = 0 'False
12			MinButton = 0 'False
13			ScaleHeight = 5655
14			ScaleWidth = 5670
15			ShowInTaskbar = 0 'False
16			StartUpPosition = 3 'Windows Default
17			Begin VB.CommandButton Command3
18			Caption = "TCP to Filter"
19			Height = 375
20			Left = 3720
21	pjm2	1.4	TabIndex = 5
22	pjm2	1.1	Top = 2520
23			Width = 1575
24			End
25			Begin VB.TextBox Text4
26			Height = 2535
27			Left = 240
28			MultiLine = -1 'True
29			ScrollBars = 2 'Vertical
30	pjm2	1.4	TabIndex = 4
31	pjm2	1.1	Text = "nettest.frx":0000
32			Top = 3000
33			Width = 5055
34			End
35			Begin VB.CommandButton Command2
36			Caption = "TCP to FilterManager"
37			Height = 375
38			Left = 3360
39	pjm2	1.4	TabIndex = 3
40	pjm2	1.1	Top = 2040
41			Width = 1935
42			End
43	pjm2	1.5	Begin MSWinsockLib.Winsock TCPSock
44	pjm2	1.1	Left = 4920
45			Top = 120
46			_ExtentX = 741
47			_ExtentY = 741
48			_Version = 393216
49			End
50			Begin VB.CommandButton Command1
51			Caption = "Send UDP"
52			Height = 375
53			Left = 4320
54			TabIndex = 2
55			Top = 1560
56			Width = 975
57			End
58			Begin VB.TextBox Text1
59			Height = 855
60			Left = 360
61			TabIndex = 0
62			Text = "<packet></packet>"
63			Top = 600
64			Width = 4935
65			End
66	pjm2	1.5	Begin MSWinsockLib.Winsock UDPSock
67	pjm2	1.1	Left = 4320
68			Top = 120
69			_ExtentX = 741
70			_ExtentY = 741
71			_Version = 393216
72			Protocol = 1
73			End
74			Begin VB.Label Label1
75			Caption = "Packet contents"
76			Height = 255
77			Left = 360
78			TabIndex = 1
79			Top = 360
80			Width = 2895
81			End
82			End
83			Attribute VB_Name = "Form1"
84			Attribute VB_GlobalNameSpace = False
85			Attribute VB_Creatable = False
86			Attribute VB_PredeclaredId = True
87			Attribute VB_Exposed = False
88	pjm2	1.4	Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
89			Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
90
91			Dim filterManagerHostname As String
92			Dim filterManagerTCPPort As Integer
93
94	pjm2	1.2	Dim filterHostname As String
95	pjm2	1.3	Dim filterTCPPort As Integer
96			Dim filterUDPPort As Integer
97			Dim fileList As String
98			Dim lastModified As String
99	pjm2	1.2
100			Dim protocolVersion As String
101			Dim connected As Boolean
102	pjm2	1.1	Dim responseNumber As Integer
103
104
105			Private Sub Command1_Click()
106
107	pjm2	1.5	' build the contents of the XML packet.
108	pjm2	1.4	xml = "<packet></packet>"
109
110	pjm2	1.2	' Use the first winsock control to send a UDP packet.
111	pjm2	1.5	UDPSock.RemoteHost = filterHostname
112			UDPSock.RemotePort = filterUDPPort
113			UDPSock.SendData xml
114	pjm2	1.1
115			End Sub
116
117			Private Sub Command2_Click()
118
119	pjm2	1.3	' establish a TCP connection to a filtermanager
120	pjm2	1.5	TCPSock.Close
121			TCPSock.Connect filterManagerHostname, filterManagerTCPPort
122	pjm2	1.1
123			End Sub
124
125			Private Sub Command3_Click()
126	pjm2	1.3	' establish a TCP connection to a filter
127	pjm2	1.5	TCPSock.Close
128			TCPSock.Connect filterHostname, filterTCPPort
129	pjm2	1.1	End Sub
130
131	pjm2	1.2	Private Sub Form_Load()
132			protocolVersion = "1.1"
133	pjm2	1.4
134			''''TEMP
135			filterManagerHostname = "killigrew.ukc.ac.uk"
136			filterManagerTCPPort = 4567
137			Exit Sub
138			''' ENDTEMP
139
140			On Error GoTo iniError
141			Dim buf As String * 256
142			Dim length As Long
143			length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
144			filterManagerHostname = Left$(buf, length)
145			length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
146			filterManagerTCPPort = Left$(buf, length)
147
148			Exit Sub
149
150			iniError:
151			x = MsgBox("The i-scream Winhost could not read the correct settings from the winhost.ini file. Please correct these and try again.", 48, "Configuration not found")
152			End
153
154			End Sub
155
156	pjm2	1.5	Private Sub TCPSock_Connect()
157	pjm2	1.1
158			responseNumber = 0
159
160	pjm2	1.3	' Send something as soon as we connect to the server.
161			If connected = False Then
162			' contact the FilterManager
163	pjm2	1.5	TCPSock.SendData "STARTCONFIG" & vbCrLf
164	pjm2	1.3	Else
165			' Contact the Filter
166	pjm2	1.5	TCPSock.SendData "HEARTBEAT" & vbCrLf
167	pjm2	1.3	End If
168	pjm2	1.1
169			End Sub
170
171	pjm2	1.5	Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
172	pjm2	1.1
173			responseNumber = responseNumber + 1
174
175			' Get the line from the server.
176	pjm2	1.5	TCPSock.GetData response, vbString, bytesTotal
177	pjm2	1.1
178			' Remove linefeeds and returns from the line.
179			response = Replace(response, Chr(13), "")
180			response = Replace(response, Chr(10), "")
181			Text4.Text = Text4.Text & vbCrLf & response
182
183	pjm2	1.2	If connected = False Then
184			' Perform TCP configuration (1.1)
185			On Error GoTo configError
186			Select Case responseNumber
187			Case 1:
188			If Not response = "OK" Then GoTo configError
189	pjm2	1.5	TCPSock.SendData "LASTMODIFIED" & vbCrLf
190	pjm2	1.2	Case 2:
191			If response = "ERROR" Then GoTo configError
192	pjm2	1.3	lastModified = response
193	pjm2	1.5	TCPSock.SendData "FILELIST" & vbCrLf
194	pjm2	1.2	Case 3:
195			If response = "ERROR" Then GoTo configError
196	pjm2	1.3	fileList = response
197	pjm2	1.5	TCPSock.SendData "UDPUpdateTime" & vbCrLf
198	pjm2	1.2	Case 4:
199			If response = "ERROR" Then GoTo configError
200	pjm2	1.5	TCPSock.SendData "TCPUpdateTime" & vbCrLf
201	pjm2	1.2	Case 5:
202			If response = "ERROR" Then GoTo configError
203	pjm2	1.5	TCPSock.SendData "ENDCONFIG" & vbCrLf
204	pjm2	1.2	Case 6:
205			If Not response = "OK" Then GoTo configError
206	pjm2	1.5	TCPSock.SendData "FILTER" & vbCrLf
207	pjm2	1.2	Case 7:
208			'we got a filter list here.
209			readTo = 0
210			' get hostname
211			readTo = InStr(1, response, ";", vbBinaryCompare)
212			filterHostname = Mid(response, 1, readTo - 1)
213			response = Mid(response, readTo + 1, Len(response))
214			' get UDP Port number
215			readTo = InStr(1, response, ";")
216			filterUDPPort = Mid(response, 1, readTo - 1)
217			response = Mid(response, readTo + 1, Len(response))
218			' get TCP Port number
219			filterTCPPort = response
220	pjm2	1.5	TCPSock.SendData "END" & vbCrLf
221	pjm2	1.2	Case 8:
222			If Not response = "OK" Then GoTo configError
223			connected = True
224			responseNumber = 0
225	pjm2	1.5	TCPSock.Close
226	pjm2	1.2	Text4.Text = Text4.Text & vbCrLf & " <closed>"
227			x = MsgBox("got config okay")
228			End Select
229			Else
230			' Perform a heartbeat (1.1)
231			On Error GoTo heartbeatError
232			Select Case responseNumber
233			Case 1:
234	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
235	pjm2	1.5	TCPSock.SendData "CONFIG" & vbCrLf
236	pjm2	1.2	Case 2:
237	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
238	pjm2	1.5	TCPSock.SendData fileList & vbCrLf
239	pjm2	1.2	Case 3:
240	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
241	pjm2	1.5	TCPSock.SendData lastModified & vbCrLf
242	pjm2	1.2	Case 4:
243	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
244	pjm2	1.5	TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
245	pjm2	1.2	Case 5:
246	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
247	pjm2	1.5	TCPSock.Close
248	pjm2	1.3	x = MsgBox("heartbeat sent okay.")
249	pjm2	1.2	End Select
250
251			End If
252
253
254			Exit Sub
255
256			configError:
257			x = MsgBox("error doing configuration")
258			heartbeatError:
259	pjm2	1.4	x = MsgBox("error doing configuration")
260	pjm2	1.1	End Sub
261	pjm2	1.5