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