TCPIP接口读卡器VB例子代码

TCPIP接口读卡器VB例子代码     界面

 

 

 

详细代码如下：

 

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

'广州荣士电子有限公司，联系电话020-82318861,82322852,定制13826029618 网址http://www.icmcu.com

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