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.Timer TCPTimer 
      Left            =   3360
      Top             =   120
   End
   Begin VB.Timer UDPTimer 
      Left            =   3840
      Top             =   120
   End
   Begin VB.CommandButton Command3 
      Caption         =   "TCP to Filter"
      Height          =   375
      Left            =   3720
      TabIndex        =   3
      Top             =   2520
      Width           =   1575
   End
   Begin VB.TextBox Text4 
      Height          =   1575
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Text            =   "nettest.frx":0000
      Top             =   3000
      Width           =   5055
   End
   Begin VB.CommandButton Command2 
      Caption         =   "TCP to FilterManager"
      Height          =   375
      Left            =   3360
      TabIndex        =   1
      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        =   0
      Top             =   1560
      Width           =   975
   End
   Begin MSWinsockLib.Winsock UDPSock 
      Left            =   4320
      Top             =   120
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   600
      Width           =   3375
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   240
      Width           =   3375
   End
   Begin VB.Label Status 
      Caption         =   "Status:"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   5280
      Width           =   5415
   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 UDPUpdateTime As Integer
Dim TCPUpdateTime As Integer

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
    Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."

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"
    
    Status.Caption = "i-scream Winhost " & protocolVersion
    
    ''''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)
    
    Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
    
    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
                UDPUpdateTime = response
                TCPSock.SendData "TCPUpdateTime" & vbCrLf
            Case 5:
                If response = "ERROR" Then GoTo configError
                TCPUpdateTime = response
                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>"
                Label1.Caption = "TCP hearbeat interval: " & UDPUpdateTime
                Label2.Caption = "UDP packet interval: " & TCPUpdateTime
                Status.Caption = "i-scream Winhost " & protocolVersion & " - 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
                Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
        End Select
    
    End If
    
    
    Exit Sub
    
configError:
    Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration"
heartbeatError:
    Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED"
End Sub

Revision:	1.7
Committed:	Fri Feb 23 10:58:00 2001 UTC (23 years, 2 months ago) by pjm2
Branch:	MAIN
Changes since 1.6:	+31 -4 lines
Log Message:	TCP and UDP intervals are now dealt with.
#	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	pjm2	1.7	Begin VB.Timer TCPTimer
18			Left = 3360
19			Top = 120
20			End
21			Begin VB.Timer UDPTimer
22			Left = 3840
23			Top = 120
24			End
25	pjm2	1.1	Begin VB.CommandButton Command3
26			Caption = "TCP to Filter"
27			Height = 375
28			Left = 3720
29	pjm2	1.6	TabIndex = 3
30	pjm2	1.1	Top = 2520
31			Width = 1575
32			End
33			Begin VB.TextBox Text4
34	pjm2	1.6	Height = 1575
35	pjm2	1.1	Left = 240
36			MultiLine = -1 'True
37			ScrollBars = 2 'Vertical
38	pjm2	1.6	TabIndex = 2
39	pjm2	1.1	Text = "nettest.frx":0000
40			Top = 3000
41			Width = 5055
42			End
43			Begin VB.CommandButton Command2
44			Caption = "TCP to FilterManager"
45			Height = 375
46			Left = 3360
47	pjm2	1.6	TabIndex = 1
48	pjm2	1.1	Top = 2040
49			Width = 1935
50			End
51	pjm2	1.5	Begin MSWinsockLib.Winsock TCPSock
52	pjm2	1.1	Left = 4920
53			Top = 120
54			_ExtentX = 741
55			_ExtentY = 741
56			_Version = 393216
57			End
58			Begin VB.CommandButton Command1
59			Caption = "Send UDP"
60			Height = 375
61			Left = 4320
62	pjm2	1.6	TabIndex = 0
63	pjm2	1.1	Top = 1560
64			Width = 975
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	pjm2	1.7	Begin VB.Label Label2
75			Caption = "Label2"
76			Height = 255
77			Left = 120
78			TabIndex = 6
79			Top = 600
80			Width = 3375
81			End
82			Begin VB.Label Label1
83			Caption = "Label1"
84			Height = 255
85			Left = 120
86			TabIndex = 5
87			Top = 240
88			Width = 3375
89			End
90	pjm2	1.6	Begin VB.Label Status
91			Caption = "Status:"
92	pjm2	1.1	Height = 255
93	pjm2	1.6	Left = 120
94			TabIndex = 4
95			Top = 5280
96			Width = 5415
97	pjm2	1.1	End
98			End
99			Attribute VB_Name = "Form1"
100			Attribute VB_GlobalNameSpace = False
101			Attribute VB_Creatable = False
102			Attribute VB_PredeclaredId = True
103			Attribute VB_Exposed = False
104	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
105			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
106
107			Dim filterManagerHostname As String
108			Dim filterManagerTCPPort As Integer
109
110	pjm2	1.2	Dim filterHostname As String
111	pjm2	1.3	Dim filterTCPPort As Integer
112			Dim filterUDPPort As Integer
113			Dim fileList As String
114			Dim lastModified As String
115	pjm2	1.2
116	pjm2	1.7	Dim UDPUpdateTime As Integer
117			Dim TCPUpdateTime As Integer
118
119	pjm2	1.2	Dim protocolVersion As String
120			Dim connected As Boolean
121	pjm2	1.1	Dim responseNumber As Integer
122
123
124			Private Sub Command1_Click()
125
126	pjm2	1.5	' build the contents of the XML packet.
127	pjm2	1.4	xml = "<packet></packet>"
128
129	pjm2	1.2	' Use the first winsock control to send a UDP packet.
130	pjm2	1.5	UDPSock.RemoteHost = filterHostname
131			UDPSock.RemotePort = filterUDPPort
132			UDPSock.SendData xml
133	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " - UDP packet sent."
134	pjm2	1.1
135			End Sub
136
137			Private Sub Command2_Click()
138
139	pjm2	1.3	' establish a TCP connection to a filtermanager
140	pjm2	1.5	TCPSock.Close
141			TCPSock.Connect filterManagerHostname, filterManagerTCPPort
142	pjm2	1.1
143			End Sub
144
145			Private Sub Command3_Click()
146	pjm2	1.3	' establish a TCP connection to a filter
147	pjm2	1.5	TCPSock.Close
148			TCPSock.Connect filterHostname, filterTCPPort
149	pjm2	1.1	End Sub
150
151	pjm2	1.2	Private Sub Form_Load()
152			protocolVersion = "1.1"
153	pjm2	1.4
154	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion
155
156	pjm2	1.4	''''TEMP
157			filterManagerHostname = "killigrew.ukc.ac.uk"
158			filterManagerTCPPort = 4567
159			Exit Sub
160			''' ENDTEMP
161
162			On Error GoTo iniError
163			Dim buf As String * 256
164			Dim length As Long
165			length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
166			filterManagerHostname = Left$(buf, length)
167			length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "<no value>", buf, Len(buf), App.Path & "winhost.ini")
168			filterManagerTCPPort = Left$(buf, length)
169
170	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " connecting to Filter Manager"
171
172	pjm2	1.4	Exit Sub
173
174			iniError:
175			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")
176			End
177
178			End Sub
179
180	pjm2	1.5	Private Sub TCPSock_Connect()
181	pjm2	1.6
182			responseNumber = 0
183	pjm2	1.1
184	pjm2	1.3	' Send something as soon as we connect to the server.
185			If connected = False Then
186			' contact the FilterManager
187	pjm2	1.5	TCPSock.SendData "STARTCONFIG" & vbCrLf
188	pjm2	1.3	Else
189			' Contact the Filter
190	pjm2	1.5	TCPSock.SendData "HEARTBEAT" & vbCrLf
191	pjm2	1.3	End If
192	pjm2	1.1
193			End Sub
194
195	pjm2	1.5	Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long)
196	pjm2	1.1
197			responseNumber = responseNumber + 1
198
199			' Get the line from the server.
200	pjm2	1.5	TCPSock.GetData response, vbString, bytesTotal
201	pjm2	1.1
202			' Remove linefeeds and returns from the line.
203			response = Replace(response, Chr(13), "")
204			response = Replace(response, Chr(10), "")
205			Text4.Text = Text4.Text & vbCrLf & response
206
207	pjm2	1.2	If connected = False Then
208			' Perform TCP configuration (1.1)
209			On Error GoTo configError
210			Select Case responseNumber
211			Case 1:
212			If Not response = "OK" Then GoTo configError
213	pjm2	1.5	TCPSock.SendData "LASTMODIFIED" & vbCrLf
214	pjm2	1.2	Case 2:
215			If response = "ERROR" Then GoTo configError
216	pjm2	1.3	lastModified = response
217	pjm2	1.5	TCPSock.SendData "FILELIST" & vbCrLf
218	pjm2	1.2	Case 3:
219			If response = "ERROR" Then GoTo configError
220	pjm2	1.3	fileList = response
221	pjm2	1.5	TCPSock.SendData "UDPUpdateTime" & vbCrLf
222	pjm2	1.2	Case 4:
223			If response = "ERROR" Then GoTo configError
224	pjm2	1.7	UDPUpdateTime = response
225	pjm2	1.5	TCPSock.SendData "TCPUpdateTime" & vbCrLf
226	pjm2	1.2	Case 5:
227			If response = "ERROR" Then GoTo configError
228	pjm2	1.7	TCPUpdateTime = response
229	pjm2	1.5	TCPSock.SendData "ENDCONFIG" & vbCrLf
230	pjm2	1.2	Case 6:
231			If Not response = "OK" Then GoTo configError
232	pjm2	1.5	TCPSock.SendData "FILTER" & vbCrLf
233	pjm2	1.2	Case 7:
234			'we got a filter list here.
235			readTo = 0
236			' get hostname
237			readTo = InStr(1, response, ";", vbBinaryCompare)
238			filterHostname = Mid(response, 1, readTo - 1)
239			response = Mid(response, readTo + 1, Len(response))
240			' get UDP Port number
241			readTo = InStr(1, response, ";")
242			filterUDPPort = Mid(response, 1, readTo - 1)
243			response = Mid(response, readTo + 1, Len(response))
244			' get TCP Port number
245			filterTCPPort = response
246	pjm2	1.5	TCPSock.SendData "END" & vbCrLf
247	pjm2	1.2	Case 8:
248			If Not response = "OK" Then GoTo configError
249			connected = True
250			responseNumber = 0
251	pjm2	1.5	TCPSock.Close
252	pjm2	1.2	Text4.Text = Text4.Text & vbCrLf & " <closed>"
253	pjm2	1.7	Label1.Caption = "TCP hearbeat interval: " & UDPUpdateTime
254			Label2.Caption = "UDP packet interval: " & TCPUpdateTime
255	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " - got config okay"
256	pjm2	1.2	End Select
257			Else
258			' Perform a heartbeat (1.1)
259			On Error GoTo heartbeatError
260			Select Case responseNumber
261			Case 1:
262	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
263	pjm2	1.5	TCPSock.SendData "CONFIG" & vbCrLf
264	pjm2	1.2	Case 2:
265	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
266	pjm2	1.5	TCPSock.SendData fileList & vbCrLf
267	pjm2	1.2	Case 3:
268	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
269	pjm2	1.5	TCPSock.SendData lastModified & vbCrLf
270	pjm2	1.2	Case 4:
271	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
272	pjm2	1.5	TCPSock.SendData "ENDHEARTBEAT" & vbCrLf
273	pjm2	1.2	Case 5:
274	pjm2	1.3	If Not response = "OK" Then GoTo heartbeatError
275	pjm2	1.5	TCPSock.Close
276	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " - heartbeat sent okay."
277	pjm2	1.2	End Select
278
279			End If
280
281
282			Exit Sub
283
284			configError:
285	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " - FAILED to get configuration"
286	pjm2	1.2	heartbeatError:
287	pjm2	1.6	Status.Caption = "i-scream Winhost " & protocolVersion & " - Heatbeat FAILED"
288	pjm2	1.1	End Sub
289	pjm2	1.5