--- experimental/host/vb_net_test/nettest.frm 2001/02/22 17:04:22 1.1 +++ experimental/host/vb_net_test/nettest.frm 2001/02/23 11:42:06 1.10 @@ -1,11 +1,11 @@ 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" + BorderStyle = 4 'Fixed ToolWindow + Caption = "i-scream Winhost" ClientHeight = 5655 ClientLeft = 45 - ClientTop = 330 + ClientTop = 285 ClientWidth = 5670 LinkTopic = "Form1" MaxButton = 0 'False @@ -14,176 +14,316 @@ Begin VB.Form Form1 ScaleWidth = 5670 ShowInTaskbar = 0 'False StartUpPosition = 3 'Windows Default - Begin VB.CommandButton Command3 - Caption = "TCP to Filter" - Height = 375 - Left = 3720 - TabIndex = 9 - Top = 2520 - Width = 1575 + Begin VB.Timer Timer1 + Left = 4200 + Top = 1200 End Begin VB.TextBox Text4 - Height = 2535 + Height = 1575 Left = 240 MultiLine = -1 'True ScrollBars = 2 'Vertical - TabIndex = 8 + TabIndex = 1 Text = "nettest.frx":0000 Top = 3000 Width = 5055 End - Begin VB.CommandButton Command2 - Caption = "TCP to FilterManager" - Height = 375 - Left = 3360 - TabIndex = 7 - Top = 2040 - Width = 1935 - End - Begin MSWinsockLib.Winsock Winsock2 - Left = 4920 + Begin VB.CommandButton Reconfigure + Caption = "Reconfigure with FilterManager" + Height = 495 + Left = 120 + TabIndex = 0 Top = 120 + Width = 2895 + End + Begin MSWinsockLib.Winsock TCPSock + Left = 5160 + Top = 1200 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End - Begin VB.TextBox Text3 - Height = 285 - Left = 1680 - TabIndex = 5 - Text = "killigrew.ukc.ac.uk" - Top = 1560 - Width = 2535 - End - Begin VB.TextBox Text2 - Height = 285 - Left = 1680 - TabIndex = 3 - Text = "4567" - Top = 1920 - Width = 855 - 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 = "" - Top = 600 - Width = 4935 - End - Begin MSWinsockLib.Winsock Winsock1 - Left = 4320 - Top = 120 + Begin MSWinsockLib.Winsock UDPSock + Left = 4680 + Top = 1200 _ExtentX = 741 _ExtentY = 741 _Version = 393216 Protocol = 1 End - Begin VB.Label Label3 + Begin VB.Label Label2 Alignment = 1 'Right Justify - Caption = "Destination:" + Caption = "Next heartbeat:" Height = 255 - Left = 360 + Left = 3360 TabIndex = 6 - Top = 1560 - Width = 1215 + Top = 480 + Width = 1455 End - Begin VB.Label Label2 + Begin VB.Label Label1 Alignment = 1 'Right Justify - Caption = "Port:" + Caption = "Next UDP packet:" Height = 255 - Left = 360 + Left = 3360 + TabIndex = 5 + Top = 120 + Width = 1455 + End + Begin VB.Label Label4 + BorderStyle = 1 'Fixed Single + Caption = "0" + Height = 255 + Left = 4920 TabIndex = 4 - Top = 1920 - Width = 1215 + Top = 480 + Width = 615 End - Begin VB.Label Label1 - Caption = "Packet contents" + Begin VB.Label Label3 + BorderStyle = 1 'Fixed Single + Caption = "0" Height = 255 - Left = 360 - TabIndex = 1 - Top = 360 - Width = 2895 + Left = 4920 + TabIndex = 3 + Top = 120 + Width = 615 End + Begin VB.Label Status + Caption = "Status:" + Height = 255 + Left = 120 + TabIndex = 2 + Top = 840 + 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() - ' Use the first winsock control to send - ' a UDP packet. - Winsock1.RemoteHost = Text3.Text - Winsock1.RemotePort = Text2.Text - Winsock1.SendData Text1.Text + ' build the contents of the XML packet. + xml = "" + ' 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() + +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 = "Loading" + Form1.Caption = "i-scream Winhost " & protocolVersion - ' establish a TCP connection to a machine - Winsock2.Close - Winsock2.Connect Text3.Text, Text2.Text + ''''TEMP + filterManagerHostname = "killigrew.ukc.ac.uk" + filterManagerTCPPort = 4567 + Reconfigure_Click + Exit Sub + ''' ENDTEMP + + On Error GoTo iniError + Dim buf As String * 256 + Dim length As Long + length = GetPrivateProfileString("i-scream Winhost", "FilterManager", "", buf, Len(buf), App.Path & "winhost.ini") + filterManagerHostname = Left$(buf, length) + length = GetPrivateProfileString("i-scream Winhost", "FilterManagerPort", "", buf, Len(buf), App.Path & "winhost.ini") + filterManagerTCPPort = Left$(buf, length) + + Status.Caption = "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 Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) + x = MsgBox("Are you sure you want to shut down the Winhost?", vbYesNo, "i-scream Winhost") + If x = 7 Then + Cancel = True + End If + End Sub -Private Sub Command3_Click() - x = MsgBox("not implemented..") +Private Sub Reconfigure_Click() + ' establish a TCP connection to a filtermanager + connected = False + TCPSock.Close + TCPSock.Connect filterManagerHostname, filterManagerTCPPort End Sub -Private Sub Winsock2_Connect() - - responseNumber = 0 +Private Sub TCPSock_Connect() + + responseNumber = 0 - ' As soon as we are connected to the server, send this. - Winsock2.SendData "STARTCONFIG" & vbCrLf + ' 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 Winsock2_DataArrival(ByVal bytesTotal As Long) +Private Sub TCPSock_DataArrival(ByVal bytesTotal As Long) responseNumber = responseNumber + 1 ' Get the line from the server. - Winsock2.GetData response, vbString, bytesTotal + 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 - ' Decide what to send back to the server. - Select Case responseNumber - Case 1: - Winsock2.SendData "LASTMODIFIED" & vbCrLf - Case 2: - Winsock2.SendData "FILELIST" & vbCrLf - Case 3: - Winsock2.SendData "UDPUpdateTime" & vbCrLf - Case 4: - Winsock2.SendData "TCPUpdateTime" & vbCrLf - Case 5: - Winsock2.SendData "ENDCONFIG" & vbCrLf - Case 6: - Winsock2.SendData "FILTER" & vbCrLf - Case 7: - Winsock2.SendData "END" & vbCrLf - Case 8: - Winsock2.Close - Text4.Text = Text4.Text & vbCrLf & " " - End Select + 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 & " " + Status.Caption = "Configuration successful" + Label3.Caption = UDPUpdateTime + Label4.Caption = TCPUpdateTime + Timer1.Interval = 1000 + 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 = "Heartbeat sent successfully." + End Select + End If + + + Exit Sub + +configError: + Status.Caption = "FAILED to get configuration" + Exit Sub +heartbeatError: + Status.Caption = "Heatbeat FAILED" + Exit Sub +End Sub + +Private Sub Timer1_Timer() + + Label3.Caption = Label3.Caption - 1 + Label4.Caption = Label4.Caption - 1 + + Status.Caption = "" + + If Label3.Caption < 1 Then + ' build the contents of the XML packet. + xml = "" + + ' Use the first winsock control to send a UDP packet. + UDPSock.RemoteHost = filterHostname + UDPSock.RemotePort = filterUDPPort + UDPSock.SendData xml + Status.Caption = "UDP packet sent" + Label3.Caption = UDPUpdateTime + End If + + If Label4.Caption < 1 Then + ' establish a TCP connection to a filter + TCPSock.Close + TCPSock.Connect filterHostname, filterTCPPort + Label4.Caption = TCPUpdateTime + End If + End Sub