串口.frm

WM-02U读卡器VBDEMO,非常好用哦,只要你需要

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form 串口 
   Caption         =   "WM-02R/U测试(北京完美研究所，tel:[phone]）"
   ClientHeight    =   2670
   ClientLeft      =   45
   ClientTop       =   420
   ClientWidth     =   6675
   LinkTopic       =   "Form1"
   ScaleHeight     =   2670
   ScaleWidth      =   6675
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "退  出"
      Height          =   375
      Left            =   5160
      TabIndex        =   4
      Top             =   1920
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "清除显示"
      Height          =   375
      Left            =   5160
      TabIndex        =   3
      Top             =   1320
      Width           =   1095
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      ItemData        =   "串口.frx":0000
      Left            =   5520
      List            =   "串口.frx":001C
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   600
      Width           =   735
   End
   Begin VB.TextBox Text1 
      Height          =   2055
      Left            =   360
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   360
      Width           =   4215
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   5520
      Top             =   0
      _ExtentX        =   794
      _ExtentY        =   794
      _Version        =   393216
      DTREnable       =   -1  'True
      RThreshold      =   1
   End
   Begin VB.Label Label1 
      Caption         =   "串口:"
      Height          =   255
      Left            =   5040
      TabIndex        =   1
      Top             =   600
      Width           =   615
   End
End
Attribute VB_Name = "串口"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'北京完美研究所版权   www.iccard.cn

Private Sub Combo1_Change()
initchk CInt(Combo1.Text)
End Sub

Private Sub Combo1_Click()
initchk CInt(Combo1.Text)
End Sub

Private Sub Command1_Click()
Text1.Text = ""
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
Combo1.ListIndex = 0
'initchk CInt(Combo1.Text)
End Sub

Private Sub MSComm1_OnComm() '串口的消息响应函数
Select Case MSComm1.CommEvent '串口事件
    Case comEvReceive '接收到数据
    Dim Buffer As Variant '存储数据的缓冲区
    Dim StringBuf(8) As String '数据数组
    'MsgBox MSComm1.InBufferCount'接收的字节个数
    Buffer = MSComm1.Input '清理接收缓冲区，此时，接收的字节数已经为0
    Dim I As Integer
    Dim CardNumber As Long '卡号
    Dim CardNumber1 As Long
    Dim CardNumber2 As Long
    Dim CardNumber3 As Long
    Dim CardNumber4 As Long
    
    CardNumber3 = CDec(Buffer(4)) * 2 ^ 16 + (Buffer(5) * 2 ^ 8) + Buffer(6)
    CardNumber2 = (Buffer(5) * 2 ^ 8) + Buffer(6)
    CardNumber1 = CDec(Buffer(6))
    For I = 0 To 7
        StringBuf(I) = DecToHex(CDec(Buffer(I))) '转换成十六进制
    Next

    If CDec(Buffer(3)) > 127 Then
        'Buffer(3) = Buffer(3) And &HF
        Buffer(3) = Buffer(3) - &H70
        CardNumber4 = CDec(Buffer(3)) * 2 ^ 24 + CDec(Buffer(4)) * 2 ^ 16 + (Buffer(5) * 2 ^ 8) + Buffer(6)
        Text1.Text = "读卡日期:" & Date & Chr(13) & Chr(10) & _
                 "读卡时间:" & Time() & Chr(13) & Chr(10) & _
                 "十六进制数:" & StringBuf(2) & StringBuf(3) & StringBuf(4) & StringBuf(5) & StringBuf(6) & Chr(13) & Chr(10) & _
                 "4字节十进制卡号:" & "-" & Str(Trim(CardNumber4)) & Chr(13) & Chr(10) & _
                 "3字节十进制卡号:" & Str(CardNumber3) & Chr(13) & Chr(10) & _
                 "2字节十进制卡号:" & Str(CardNumber2) & Chr(13) & Chr(10) & _
                 "1字节十进制卡号:" & Str(CardNumber1) & Chr(13) & Chr(10)
    Else
        CardNumber4 = CDec(Buffer(3)) * 2 ^ 24 + CDec(Buffer(4)) * 2 ^ 16 + (Buffer(5) * 2 ^ 8) + Buffer(6)
        'CardNumber4 = CDec(Buffer(3)) * 2 ^ 24 + CDec(Buffer(4)) * 2 ^ 16 + (Buffer(5) * 2 ^ 8) + Buffer(6)
        Text1.Text = "读卡日期:" & Date & Chr(13) & Chr(10) & _
                     "读卡时间:" & Time() & Chr(13) & Chr(10) & _
                     "十六进制数:" & StringBuf(2) & StringBuf(3) & StringBuf(4) & StringBuf(5) & StringBuf(6) & Chr(13) & Chr(10) & _
                     "4字节十进制卡号:" & Str(CardNumber4) & Chr(13) & Chr(10) & _
                     "3字节十进制卡号:" & Str(CardNumber3) & Chr(13) & Chr(10) & _
                     "2字节十进制卡号:" & Str(CardNumber2) & Chr(13) & Chr(10) & _
                     "1字节十进制卡号:" & Str(CardNumber1) & Chr(13) & Chr(10)
    End If
End Select

End Sub
Function DecToHex(DecNumber As Integer) As String '转换成十六进制
        If DecNumber <= 15 Then
            DecToHex = "  0" & Hex(DecNumber)
        Else: DecToHex = "  " & Hex(DecNumber)
        End If
End Function

Private Sub Form_Unload(Cancel As Integer) '退出时关闭端口

    If (MSComm1.PortOpen) Then
        MSComm1.PortOpen = False
    End If

End Sub
Public Function initchk(sc As Integer) As Boolean
If MSComm1.PortOpen Then
    MSComm1.PortOpen = False
End If
MSComm1.CommPort = sc  '串口号，
MSComm1.Settings = "9600,N,8,1" '串口的属性
MSComm1.InputLen = 0 '接收缓冲区的大小
MSComm1.InputMode = comInputModeBinary '二进制接受方式
MSComm1.RThreshold = 7 '每7个字节响应消息
MSComm1.PortOpen = True '打开通信串口
End Function
Public Function closechk()
MSComm1.PortOpen = False
End Function