TCPIP接口读卡器VB例子代码

详细代码如下：

Private Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)

Private Sub Command1_Click()
Dim sendbuf() As Byte
Dim strremoteip As String
Dim i As Integer

If Trim(Text6.Text) = "" Then
MsgBox "机号不能为空"
Text6.SetFocus
Exit Sub
End If

If Not IsNumeric(Trim(Text6.Text)) Then
MsgBox "机号必须为数字"
Text6.SelStart = 0
Text6.SelLength = Len(Trim(Text6.Text))
Text6.SetFocus
Exit Sub
End If

If CLng(Trim(Text6.Text)) > 65535 Then
MsgBox "机号不能大于65535"
Text6.SelStart = 0
Text6.SelLength = Len(Trim(Text6.Text))
Text6.SetFocus
Exit Sub

End If

If Check1.Value = 0 Then
If Trim(Text1.Text) = "" Then
MsgBox "输入不能为空"
Text1.SetFocus
Exit Sub
End If

If Not IsNumeric(Trim(Text1.Text)) Then
MsgBox "输入必须为数字"
Text1.SelStart = 0
Text1.SelLength = Len(Trim(Text1.Text))
Text1.SetFocus
Exit Sub
End If

If CInt(Trim(Text1.Text)) > 255 Then
MsgBox "输入不能大于255"
Text1.SelStart = 0
Text1.SelLength = Len(Trim(Text1.Text))
Text1.SetFocus
Exit Sub
End If

If Trim(Text2.Text) = "" Then
MsgBox "输入不能为空"
Text2.SetFocus
Exit Sub
End If

If Not IsNumeric(Trim(Text2.Text)) Then
MsgBox "输入必须为数字"
Text2.SelStart = 0
Text2.SelLength = Len(Trim(Text2.Text))
Text2.SetFocus
Exit Sub
End If

If CInt(Trim(Text2.Text)) > 255 Then
MsgBox "输入不能大于255"
Text2.SelStart = 0
Text2.SelLength = Len(Trim(Text2.Text))
Text2.SetFocus
Exit Sub
End If

If Trim(Text3.Text) = "" Then
MsgBox "输入不能为空"
Text3.SetFocus
Exit Sub
End If

If Not IsNumeric(Trim(Text3.Text)) Then
MsgBox "输入必须为数字"
Text3.SelStart = 0
Text3.SelLength = Len(Trim(Text3.Text))
Text3.SetFocus
Exit Sub
End If

If CInt(Trim(Text3.Text)) > 255 Then
MsgBox "输入不能大于255"
Text3.SelStart = 0
Text3.SelLength = Len(Trim(Text3.Text))
Text3.SetFocus
Exit Sub
End If

If Trim(Text4.Text) = "" Then
MsgBox "输入不能为空"
Text4.SetFocus
Exit Sub
End If

If Not IsNumeric(Trim(Text4.Text)) Then
MsgBox "输入必须为数字"
Text4.SelStart = 0
Text4.SelLength = Len(Trim(Text4.Text))
Text4.SetFocus
Exit Sub
End If

If CInt(Trim(Text4.Text)) > 255 Then
MsgBox "输入不能大于255"
Text4.SelStart = 0
Text4.SelLength = Len(Trim(Text4.Text))
Text4.SetFocus
Exit Sub
End If

strremoteip = Trim(Text1.Text) + "." + Trim(Text2.Text) + "." + Trim(Text3.Text) + "." + Trim(Text4.Text) 'IP地址

Else
strremoteip = "255.255.255.255" '广播式

End If

ReDim sendbuf(5)
sendbuf(0) = &H96 '命令字，表示驱动蜂鸣器声响

'机号
i = CInt(Trim(Text6.Text))
sendbuf(1) = i Mod 256
sendbuf(2) = (i / 256) Mod 256

sendbuf(3) = Combo1.ListIndex '声音类型

Winsock1.RemoteHost = strremoteip '目标IP地址

Winsock1.SendData sendbuf

Winsock1.RemoteHost = "" '目标IP地址清空
End Sub

Private Sub Command2_Click()
Unload Me

End Sub

Private Sub Form_Initialize()
Combo1.ListIndex = 0
Winsock1.Protocol = sckUDPProtocol '用UDP协议


On Error GoTo exception
Winsock1.RemotePort = 39169 '读卡器专用端口号
Winsock1.Bind 39169 '绑定

Exit Sub


exception:

MsgBox "读卡器专用UDP协议端口[39169]已被其他程序占用，无法打开，程序将自行退出，请检查后重新打开软件！"

PostQuitMessage 1 '退出主程序

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim UdpData() As Byte
Dim sendbuf() As Byte

Dim strls As String
Dim strip As String

Winsock1.GetData UdpData

If UdpData(0) = &HC1 Or UdpData(0) = &HD1 Then
'接收到卡号
If bytesTotal >= 14 Then

strls = "接收到刷卡信息：读卡器IP地址["

'读卡器IP地址
strip = Str$(UdpData(1)) + "." + Str$(UdpData(2)) + "." + Str$(UdpData(3)) + "." + Str$(UdpData(4))
strls = strls + strip
strls = strls + "],机号["

'机号
strls = strls + Str$(Int(UdpData(5)) + Int(UdpData(6)) * 256)

strls = strls + "],数据包序号["

'数据包序号，每个包都不一样，按递增1变化
strls = strls + Str$(Int(UdpData(7)) + Int(UdpData(8)) * 256)

strls = strls + "],物理卡号["

'物理卡号
strls = strls + Hex$(UdpData(9)) + "-" + Hex$(UdpData(10)) + "-" + Hex$(UdpData(11)) + "-" + Hex$(UdpData(12)) + "-" + Hex$(UdpData(13))

strls = strls + "]"
Text5.Text = strls

'接收成功要发送确认信息

ReDim sendbuf(8)

sendbuf(0) = &H69 '表示修改读卡器参数

'IP地址
sendbuf(1) = UdpData(1)
sendbuf(2) = UdpData(2)
sendbuf(3) = UdpData(3)
sendbuf(4) = UdpData(4)

'机号
sendbuf(5) = UdpData(5)
sendbuf(6) = UdpData(6)

'数据包序号
sendbuf(7) = UdpData(7)
sendbuf(8) = UdpData(8)

Winsock1.RemoteHost = strip

Winsock1.SendData sendbuf

Winsock1.RemoteHost = ""


End If

End If

End Sub