加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 (https://www.lidatong.com.cn/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 大数据 > 正文

TCPIP接口读卡器VB例子代码

发布时间:2020-12-16 22:53:39 所属栏目:大数据 来源:网络整理
导读:详细代码如下: 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 "机号不能为空" Tex

详细代码如下:


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

(编辑:李大同)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    推荐文章
      热点阅读