本 示例使用设备介绍：
Imports System.Threading
Imports System.Net
Imports System.Net.Sockets
Public Class Form1
Dim ListenSocket As Socket
Dim Dict As New Dictionary(Of String, Socket) '用于保存连接的客户的套接字的键值对集合
Dim DictThre As New Dictionary(Of String, Thread) '用于保存通信线程的键值对集合
Dim LocalIp As String
Dim SendBuff() As Byte
Public Sub getIp() '获取本机所有网卡的IP
Dim Address() As System.Net.IPAddress
Dim i As Integer
Address = Dns.GetHostByName(Dns.GetHostName()).AddressList
If UBound(Address) < 0 Then
MsgBox("未能查找到本台电脑安装的网卡，暂不能启动本软件。", MsgBoxStyle.Critical + vbOKOnly, "注意")
End
Else
For i = 0 To UBound(Address)
comboBox4.Items.Add(Address(i).ToString())
Next
comboBox4.SelectedIndex = 0
LocalIp = comboBox4.Text.Trim()
End If
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
getIp()
comboBox4.SelectedIndex = 0
End Sub
Private Sub btn_conn_Click(sender As Object, e As EventArgs) Handles btn_conn.Click
If btn_conn.Text = "开启TCP服务，允许新客户端接入" Then
TextBox.CheckForIllegalCrossThreadCalls = False '取消文本框的跨线程检查
Dim localAddress As IPAddress = IPAddress.Parse(comboBox4.Text.Trim())
Dim EndPoint As New IPEndPoint(localAddress, txb_port.Text) '创建一个网络节点对象
ListenSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
ListenSocket.Bind(EndPoint) '给负责监听的套接字绑定一个网络节点
ListenSocket.Listen(100) '侦听，最多接受100个连接
Dim thre = New Thread(AddressOf Connect) '创建一个新的线程用于处理客户端发来的连接请求
thre.IsBackground = True '设为后台线程
thre.Start() '开启线程
btn_conn.Text = "停止新客户端连接"
listBox2.Items.Add("TCP端口监听服务已开启，新客户端设备可以连接并上传数据......")
listBox2.Items.Add("")
listBox2.SelectedIndex = listBox2.Items.Count - 1
Else
ListenSocket.Close()
ListenSocket = Nothing
btn_conn.Text = "开启TCP服务，允许新客户端接入"
listBox2.Items.Add("TCP服务端已禁止新客户端连接，已连接的客户端设备可继续上传数据......")
listBox2.Items.Add("")
listBox2.SelectedIndex = listBox2.Items.Count - 1
End If
End Sub
Sub Connect() '处理客户端的连接请求的过程
While True
Try
Dim SockConect As Socket = listenSocket.Accept
Dict.Add(SockConect.RemoteEndPoint.ToString, SockConect) '将连接成功的套接字添加到键值对集合
listBox1.Items.Add(SockConect.RemoteEndPoint.ToString) '添加到列表
Dim Thre As New Thread(AddressOf RecClient) '创建一个新的线程用于和链接成功的套接字通信
Thre.IsBackground = True '设为后台线程
Thre.Start(SockConect)
DictThre.Add(SockConect.RemoteEndPoint.ToString, Thre) '将创建的通信线程添加到键值对集合
Catch
End Try
End While
End Sub
Sub RecClient(ByVal SockTelNet As Socket) '处理客户端发来的数据
While True
Try
Dim getdata(1024) As Byte
Dim RecLen As Int32
Dim HexStr As String
Try '捕获异常
RecLen = SockTelNet.Receive(getdata) '接受客户端发来得信息
Catch ss As SocketException
listBox2.Items.Add(ss.NativeErrorCode & vbCrLf & ss.Message) '显示错误信息
Dict.Remove(SockTelNet.RemoteEndPoint.ToString) '移除断开连接的套接字
Return
Catch s As Exception
listBox2.Items.Add(s.Message)
Return
End Try
If RecLen > 0 Then
Dim StrMsg As String
StrMsg = DateTime.Now.ToLongTimeString() + " Get From " + SockTelNet.RemoteEndPoint.ToString + " : "
For i = 0 To RecLen - 1
StrMsg = StrMsg + getdata(i).ToString("X2") + " "
Next
If listBox2.Items.Count() > 100 Then listBox2.Items.Clear()
listBox2.Items.Add(StrMsg)
Select Case getdata(0)
Case &HC1, &HCF
If getdata(0) = &HC1 Then
StrMsg = "数据解析：IC读卡器上传卡号，"
Else
StrMsg = "数据解析：IC卡离开读卡器，"
End If
StrMsg = StrMsg + "IP[" + getdata(1).ToString("D") + "." + getdata(2).ToString("D") + "." + getdata(3).ToString("D") + "." + getdata(4).ToString("D") + "]，"
StrMsg = StrMsg + "机号[" + (getdata(5) + getdata(6) * 256).ToString("D") + "]，"
StrMsg = StrMsg + "数据包号[" + (getdata(7) + getdata(8) * 256).ToString("D") + "]，"
StrMsg = StrMsg + "卡号长度[" + getdata(9).ToString("D") + "]，"
HexStr = ""
For i = 10 To 10 + getdata(9) - 1
HexStr = HexStr + getdata(i).ToString("X2")
Next
StrMsg = StrMsg + "16进制卡号[" + HexStr + "]，"
HexStr = ""
For i = 10 + getdata(9) To RecLen - 1
HexStr = HexStr + getdata(i).ToString("X2")
Next
StrMsg = StrMsg + "唯一硬件序号[" + HexStr + "]"
listBox2.Items.Add(StrMsg)
listBox2.Items.Add("")
listBox2.SelectedIndex = listBox2.Items.Count - 1
If CheckBox1.Checked Then
GetRespData()
SockTelNet.Send(SendBuff)
StrMsg = DateTime.Now.ToLongTimeString() + " Send To " + SockTelNet.RemoteEndPoint.ToString + " : "
For i = 0 To SendBuff.Length - 1
StrMsg = StrMsg + SendBuff(i).ToString("X2") + " "
Next
listBox2.Items.Add(StrMsg)
listBox2.Items.Add("")
listBox2.SelectedIndex = listBox2.Items.Count - 1
End If
Case &HD1, &HDF
If getdata(0) = &HD1 Then
StrMsg = "数据解析：ID读卡器上传卡号，"
Else
StrMsg = "数据解析：ID卡离开读卡器，"
End If
StrMsg = StrMsg + "IP[" + getdata(1).ToString("D") + "." + getdata(2).ToString("D") + "." + getdata(3).ToString("D") + "." + getdata(4).ToString("D") + "]，"
StrMsg = StrMsg + "机号[" + (getdata(5) + getdata(6) * 256).ToString("D") + "]，"
StrMsg = StrMsg + "数据包号[" + (getdata(7) + getdata(8) * 256).ToString("D") + "]，"
StrMsg = StrMsg + "16进制卡号[" + getdata(9).ToString("X2") + getdata(10).ToString("X2") + getdata(11).ToString("X2") + getdata(12).ToString("X2") + getdata(13).ToString("X2") + "]，"
HexStr = ""
For i = 14 To RecLen - 1
HexStr = HexStr + getdata(i).ToString("X2")
Next
StrMsg = StrMsg + "唯一硬件序号[" + HexStr + "]"
listBox2.Items.Add(StrMsg)
listBox2.Items.Add("")
listBox2.SelectedIndex = listBox2.Items.Count - 1
Case &HF3
StrMsg = "数据解析：读卡器心跳数据包，"
StrMsg = StrMsg + "IP[" + getdata(1).ToString("D") + "." + getdata(2).ToString("D") + "." + getdata(3).ToString("D") + "." + getdata(4).ToString("D") + "]，"
StrMsg = StrMsg + "机号[" + (getdata(5) + getdata(6) * 256).ToString("D") + "]，"
StrMsg = StrMsg + "数据包号[" + (getdata(7) + getdata(8) * 256).ToString("D") + "]，"
StrMsg = StrMsg + "心跳类型[" + getdata(9).ToString("X2") + "]，"
StrMsg = StrMsg + "长度[" + getdata(10).ToString("D") + "]，"
StrMsg = StrMsg + "继电器状态[" + getdata(11).ToString("X2") + "]，"
StrMsg = StrMsg + "外部输入状态[" + getdata(12).ToString("X2") + "]，"
StrMsg = StrMsg + "随机动态码[" + getdata(13).ToString("X2") + getdata(14).ToString("X2") + getdata(15).ToString("X2") + getdata(17).ToString("X2") + "]，"
HexStr = ""
For i = 17 To RecLen - 1
HexStr = HexStr + getdata(i).ToString("X2")
Next
StrMsg = StrMsg + "唯一硬件序号[" + HexStr + "]"
listBox2.Items.Add(StrMsg)
listBox2.Items.Add("")
listBox2.SelectedIndex = listBox2.Items.Count - 1
End Select
End If
Catch
End Try
End While
End Sub
'选择在线设备向其发送指令
Sub ButtoSend(ByVal sendcode As Integer)
Dim seleid As String
Dim dispstr As String
Dim i As Integer
If listBox1.SelectedIndex >= 0 Then
seleid = listBox1.Text
GetSenddata(sendcode)
Dict.Item(seleid).Send(SendBuff)
dispstr = DateTime.Now.ToLongTimeString() + " Send To " + seleid + " : "
For i = 0 To SendBuff.Length - 1
dispstr = dispstr + SendBuff(i).ToString("X2") + " "
Next
listBox2.Items.Add(dispstr)
listBox2.Items.Add("")
listBox2.SelectedIndex = listBox2.Items.Count - 1
Else
MsgBox("请先在客户端列表中选择要发送指令的在线客户端！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
End If
End Sub
'按回应需要生成发送缓冲数据
Sub GetRespData()
If RadioButton3.Checked Then
GetSenddata(0)
ElseIf RadioButton4.Checked Then
GetSenddata(1)
ElseIf RadioButton5.Checked Then
GetSenddata(2)
Else
GetSenddata(3)
End If
End Sub
'按发送需要生成发送缓冲数据
Sub GetSenddata(ByVal sendcode As Integer)
Dim i As Long
Dim strs As String
Dim textbyte() As Byte
Select Case sendcode
Case 0
ReDim SendBuff(38)
SendBuff(0) = &H5A '驱动显示文字+蜂鸣响声的功能码
SendBuff(1) = 0 '机号低位
SendBuff(2) = 0 '机号高位，高低位为0表示任意机号
If checkBox2.Checked Then '蜂鸣响声
SendBuff(3) = comboBox3.SelectedIndex '蜂鸣响声代码
If radioButton2.Checked Then '背光灯状态不变
SendBuff(3) = SendBuff(3) Or 128
End If
Else
SendBuff(3) = &HFF '不响蜂鸣声
If radioButton2.Checked Then '背光灯状态不变
SendBuff(3) = SendBuff(3) And 127
End If
End If
SendBuff(4) = dispdelay.Value
strs = textBox12.Text + " "
textbyte = System.Text.Encoding.GetEncoding(936).GetBytes(strs)
For i = 0 To 33
SendBuff(5 + i) = textbyte(i)
Next
Case 1
strs = "[v" + SYDX.Value.ToString() + "]" '设置语音大小，在需要发送的语音字符串中任何位置加入[v10],表示将音量调到10级(范围0~16，0表示静音，16最大，每次重开机后，音量重置为10级)！
strs = strs + textBox1.Text.Trim()
textbyte = System.Text.Encoding.GetEncoding(936).GetBytes(strs)
Dim displen As Integer
Dim voiclen As Integer
Dim commlen As Integer
displen = 34
voiclen = textbyte.Length
commlen = 10 + displen + voiclen + 4
ReDim SendBuff(commlen)
SendBuff(0) = &H5C '驱动显示文字+蜂鸣响声的功能码+开继电器+播报TTS语音
SendBuff(1) = 0 '机号低位
SendBuff(2) = 0 '机号高位，高低位为0表示任意机号
If checkBox2.Checked Then '蜂鸣响声
SendBuff(3) = comboBox3.SelectedIndex '蜂鸣响声代码
If radioButton2.Checked Then '背光灯状态不变
SendBuff(3) = SendBuff(3) Or 128
End If
Else
SendBuff(3) = &HFF '不响蜂鸣声
If radioButton2.Checked Then '背光灯状态不变
SendBuff(3) = SendBuff(3) And 127
End If
End If
Select Case comboBox2.SelectedIndex '根据选择开启对应的继电器
Case 1
SendBuff(4) = &HF1
Case 2
SendBuff(4) = &HF2
Case 3
SendBuff(4) = &HF3
Case 4
SendBuff(4) = &HF4
Case 5
SendBuff(4) = &HF5
Case 6
SendBuff(4) = &HF6
Case 7
SendBuff(4) = &HF7
Case 8
SendBuff(4) = &HF8
Case Else
SendBuff(4) = &HF0
End Select
i = CLng(textBox11.Text) '继电器开启时长
SendBuff(5) = i Mod 256
SendBuff(6) = Int(i / 256) Mod 256
SendBuff(7) = dispdelay.Value '显示时长
SendBuff(8) = 0 '显示起始位
SendBuff(9) = displen '显示长度
SendBuff(10) = voiclen 'TTS语音长度
strs = textBox12.Text + " "
Dim dispbyte() As Byte
dispbyte = System.Text.Encoding.GetEncoding(936).GetBytes(strs)
For i = 0 To displen - 1 '显示文字
SendBuff(11 + i) = dispbyte(i)
Next
For i = 0 To voiclen - 1 'TTS语音
SendBuff(11 + displen + i) = textbyte(i)
Next
SendBuff(11 + displen + voiclen + 0) = &H55 '防干扰后缀
SendBuff(11 + displen + voiclen + 1) = &HAA
SendBuff(11 + displen + voiclen + 2) = &H66
SendBuff(11 + displen + voiclen + 3) = &H99
Case 2
ReDim SendBuff(3)
SendBuff(0) = &H96 '驱动蜂鸣响声的功能码
SendBuff(1) = 0 '机号低位
SendBuff(2) = 0 '机号高位，高低位为0表示任意机号
SendBuff(3) = comboBox3.SelectedIndex
Case 3
ReDim SendBuff(5)
SendBuff(0) = &H78 '驱动开关继电器的功能码
SendBuff(1) = 0 '机号低位
SendBuff(2) = 0 '机号高位，高低位为0表示任意机号
Select Case comboBox2.SelectedIndex '根据选择开启对应的继电器
Case 1
SendBuff(3) = &HF1
Case 2
SendBuff(3) = &HF2
Case 3
SendBuff(3) = &HF3
Case 4
SendBuff(3) = &HF4
Case 5
SendBuff(3) = &HF5
Case 6
SendBuff(3) = &HF6
Case 7
SendBuff(3) = &HF7
Case 8
SendBuff(3) = &HF8
Case Else
SendBuff(3) = &HF0
End Select
i = CLng(textBox11.Text) '开启时长
SendBuff(4) = i Mod 256
SendBuff(5) = Int(i / 256) Mod 256
Case 4
ReDim SendBuff(5)
SendBuff(0) = &H78 '驱动开关继电器的功能码
SendBuff(1) = 0 '机号低位
SendBuff(2) = 0 '机号高位，高低位为0表示任意机号
Select Case comboBox2.SelectedIndex '根据选择关闭对应的继电器
Case 1
SendBuff(3) = &HE1
Case 2
SendBuff(3) = &HE2
Case 3
SendBuff(3) = &HE3
Case 4
SendBuff(3) = &HE4
Case 5
SendBuff(3) = &HE5
Case 6
SendBuff(3) = &HE6
Case 7
SendBuff(3) = &HE7
Case 8
SendBuff(3) = &HE8
Case Else
SendBuff(3) = &HE0
End Select
i = CLng(textBox11.Text) '开启时长
SendBuff(4) = i Mod 256
SendBuff(5) = Int(i / 256) Mod 256
End Select
End Sub
Private Sub button6_Click(sender As Object, e As EventArgs) Handles button6.Click
ButtoSend(2)
End Sub
Private Sub button7_Click(sender As Object, e As EventArgs) Handles button7.Click
ButtoSend(3)
End Sub
Private Sub button8_Click(sender As Object, e As EventArgs) Handles button8.Click
ButtoSend(4)
End Sub
Private Sub button10_Click(sender As Object, e As EventArgs) Handles button10.Click
ButtoSend(0)
End Sub
Private Sub button9_Click(sender As Object, e As EventArgs) Handles button9.Click
ButtoSend(1)
End Sub
Private Sub button3_Click(sender As Object, e As EventArgs) Handles button3.Click
Dim copstr As String
Dim I As Long
Clipboard.Clear()
copstr = ""
For I = 0 To listBox2.Items.Count - 1
copstr = copstr & listBox2.Items(I)
copstr = copstr & vbCrLf
Next
Clipboard.SetText(copstr)
MsgBox("TCP通讯日志报文已拷贝！", MsgBoxStyle.Information + MsgBoxStyle.OkOnly, "提示")
End Sub
Private Sub button2_Click(sender As Object, e As EventArgs) Handles button2.Click
listBox2.Items.Clear()
End Sub
End Class