frmmain.frm

HD 6P RFID发卡器、考勤卡钟 串口通讯接口程序 VB 源码

        m_nBufferLength = 1000
        Dim nLED As Long
        If m_nLEDCount Mod 2 = 0 Then
            nLED = HD_LIGHTENLED
        Else
            nLED = HD_BLACKLED
        End If
        m_nLEDCount = m_nLEDCount + 1
    
        m_bResult = SendCommandA(MT_LED, nLED, Len(nLED), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdReadCardID_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        m_bResult = SendCommandA(MT_READ_CARDID, nil, 0, m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdReadBlock_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        Dim Header As HEADER_BLOCKOPRSTRUCT
        Header.BlockNum = 1
        Header.AuthMode = 1
        Call MemSet_HD(Header.AuthKeyA(0), &HFF, 6)
        Call MemSet_HD(Header.AuthKeyB(0), &HFF, 6)
        
        m_bResult = SendCommandA(MT_READ_BLOCK, Header, Len(Header), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdWriteBlock_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        Dim WriteBlock As WRITEBLOCKSTRUCT
        WriteBlock.Header.BlockNum = 1 '扇区号
        WriteBlock.Header.AuthMode = 1
        Call MemSet_HD(WriteBlock.Header.AuthKeyA(0), &HFF, 6) '校验密码
        Call MemSet_HD(WriteBlock.Header.AuthKeyB(0), &HFF, 6)
'       Call MemSet_HD(WriteBlock.BlockData.Data(0), &H11, 16) '写入数据
        Dim i As Integer
        For i = 0 To 15
            WriteBlock.BlockData.Data(i) = i
        Next i
        
        m_bResult = SendCommandA(MT_WRITE_BLOCK, WriteBlock, Len(WriteBlock), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdInitEW_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        Dim Header As HEADER_BLOCKOPRSTRUCT
        Header.BlockNum = 1
        Header.AuthMode = 1
        Call MemSet_HD(Header.AuthKeyA(0), &HFF, 6)
        Call MemSet_HD(Header.AuthKeyB(0), &HFF, 6)
        
        m_bResult = SendCommandA(MT_INIT_NOTECASE, Header, Len(Header), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdAddEW_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        Dim Notecase As OPRNOTECASESTRUCT
        Notecase.Header.BlockNum = 1
        Notecase.Header.AuthMode = 1
        Call MemSet_HD(Notecase.Header.AuthKeyA(0), &HFF, 6)
        Call MemSet_HD(Notecase.Header.AuthKeyB(0), &HFF, 6)
        Notecase.Money = 100000 '单位为分
        
        m_bResult = SendCommandA(MT_ADD_NOTECASE, Notecase, Len(Notecase), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdReduceEW_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        Dim Notecase As OPRNOTECASESTRUCT
        Notecase.Header.BlockNum = 1
        Notecase.Header.AuthMode = 1
        Call MemSet_HD(Notecase.Header.AuthKeyA(0), &HFF, 6)
        Call MemSet_HD(Notecase.Header.AuthKeyB(0), &HFF, 6)
        Notecase.Money = 100000 '单位为分
        
        m_bResult = SendCommandA(MT_REDUCE_NOTECASE, Notecase, Len(Notecase), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdReadHD4k_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        Dim bSecNo As Byte
        bSecNo = 3
        
        m_bResult = SendCommandA(MT_READ_CARDOFHD4K, bSecNo, Len(bSecNo), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdReadHD4kEW_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        Dim bSecNo As Byte
        bSecNo = 3
        
        m_bResult = SendCommandA(MT_READEW_CARDOFHD4K, bSecNo, Len(bSecNo), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdWriteHD4kEW_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        Dim HD4kEW As EW_HD4K
        HD4kEW.FileSort = FILEOFHD4K_POS
        HD4kEW.SectorNo = 2
        HD4kEW.CardNo = 1 '实际不会改写卡号
        HD4kEW.Balance = 10000
        HD4kEW.TraceOfEW = 3
        HD4kEW.Date.Year = 2009
        HD4kEW.Date.Month = 12
        HD4kEW.Date.Day = 16
        
        m_bResult = SendCommandA(MT_WRITEEW_CARDOFHD4K, HD4kEW, Len(HD4kEW), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub cmdInitHD6k_Click()
    MSComm.InBufferCount = 0
    MSComm.OutBufferCount = 0
    stbResult.Panels(2).Text = ""
    
    If MSComm.PortOpen Then
        m_nBufferLength = 1000
        If m_CardID.CardID = 0 Then
            stbResult.Panels(2).Text = "请先获取卡序列号"
            Exit Sub
        End If
       m_bResult = SendCommandA(MT_INIT_CARDOFHD6K, m_CardID, Len(m_CardID), m_bBuffer(0), m_nBufferLength)
       ' m_bResult = SendCommandA(MT_ERASEDATA_CARDOFHD6K, m_CardID, Len(m_CardID), m_bBuffer(0), m_nBufferLength)
        If m_bResult Then
            ReDim m_bSendData(0 To m_nBufferLength - 1) As Byte
            Call CopyMemory(m_bSendData(0), m_bBuffer(0), m_nBufferLength)
            MSComm.Output = m_bSendData
        End If
    End If
End Sub

Private Sub lstData_DblClick()
    lstData.Clear
End Sub

Private Sub MSComm_OnComm()
    Dim bRecvData() As Byte
    Dim nLength As Long
    Dim nCommand As Long
    
    Select Case MSComm.CommEvent
        Case comEvReceive
            Sleep (50) '等待接收完数据
            nLength = MSComm.InBufferCount
            bRecvData = MSComm.Input
            If DealHDLCFrame(bRecvData(0), nLength) Then
                Call DoRecvData
            End If
    End Select
End Sub
    
'字符串填零
Public Function AddZero(ByVal strData As String, ByVal nLength As Integer) As String
    While Len(strData) < nLength
        strData = "0" + strData
    Wend
    AddZero = strData
End Function

'处理接收命令
Private Sub DoRecvData()
    Dim nResultCode As Long
    
    nResultCode = GetResultCode
    If nResultCode <> 0 Then
        stbResult.Panels(2).Text = "结果码: " + CStr(nResultCode)
        Exit Sub
    End If
    
    nCommand = GetCommand
    Select Case nCommand
        Case MT_RECV_READERPROP
            Dim bbbbb As Boolean
            bbbbb = GetData(Prop, Len(Prop))
            lstData.AddItem (AddZero(CStr(Prop.ReaderID), 10) + "," + _
                             AddZero(CStr(Prop.MainSoftwareVer), 5) + "." + AddZero(CStr(Prop.MiniSoftwareVer), 5) + _
                             "," + AddZero(CStr(Prop.MainHardwareVer), 5) + "." + AddZero(CStr(Prop.MiniHardwareVer), 5))
        Case MT_READ_CARDID, MT_SEND_CARDID
            Dim mmmm As CARDIDSTRUCT
            Call GetData(m_CardID, Len(m_CardID))
            lstData.AddItem AddZero(CStr(m_CardID.CARDTYPE), 3) + ", 卡序列号: " + AddZero(m_CardID.CardID, 10)
        Case MT_READ_BLOCK
            Dim Block As BLOCKSTRUCT
            Call GetData(Block, Len(Block))
            lstData.AddItem (AddZero(Hex(Block.Data(0)), 2) + AddZero(Hex(Block.Data(1)), 2) + _
                             AddZero(Hex(Block.Data(2)), 2) + AddZero(Hex(Block.Data(3)), 2) + _
                             AddZero(Hex(Block.Data(4)), 2) + AddZero(Hex(Block.Data(5)), 2) + _
                             AddZero(Hex(Block.Data(6)), 2) + AddZero(Hex(Block.Data(7)), 2) + _
                             AddZero(Hex(Block.Data(8)), 2) + AddZero(Hex(Block.Data(9)), 2) + _
                             AddZero(Hex(Block.Data(10)), 2) + AddZero(Hex(Block.Data(11)), 2) + _
                             AddZero(Hex(Block.Data(12)), 2) + AddZero(Hex(Block.Data(13)), 2) + _
                             AddZero(Hex(Block.Data(14)), 2) + AddZero(Hex(Block.Data(15)), 2))
        Case MT_READ_CARDOFHD4K
             Dim bData(0 To 99) As Byte
             Call GetData(bData(0), 100)
             Select Case bData(0) '卡文件类型
                Case FILEOFHD4K_ATT
                    Dim AttCard As ATTGUARDCARD_HD4K
                    Call CopyMemory(AttCard, bData(0), Len(AttCard))
                    lstData.AddItem (CStr(AttCard.FileSort) + "," + AddZero(CStr(AttCard.CardNo), 10) + "," + AttCard.Name)
                Case FILEOFHD4K_POS
                    Dim PosCard As POSCARD_HD4K
                    Call CopyMemory(PosCard, bData(0), Len(PosCard))
                    lstData.AddItem (CStr(PosCard.FileSort) + "," + AddZero(CStr(PosCard.CardNo), 10) + "," + PosCard.Name)
                Case FILEOFHD4K_OPR
                    Dim OprCard As OPRCARD_HD4K
                    Call CopyMemory(OprCard, bData(0), Len(OprCard))
                    lstData.AddItem (CStr(OprCard.FileSort) + "," + AddZero(CStr(OprCard.CardNo), 10) + "," + OprCard.Name)
                Case Else
                    stbResult.Panels(2).Text = "卡文件类型错误"
             End Select
        Case MT_READEW_CARDOFHD4K:
             Dim HD4kEW As EW_HD4K
             Call GetData(HD4kEW, Len(HD4kEW))
            lstData.AddItem (AddZero(CStr(HD4kEW.CardNo), 10) + "," + AddZero(CStr(HD4kEW.Balance), 10))
        Case MT_READDATA_CARDOFHD6K
             Dim bbbb As Boolean
             bbbb = GetData(card, Len(card))
             str = "" '清空
             str = str + "卡类型为：" + CStr(card.CardID.CARDTYPE)
             str = str + "卡序列号:" + CStr(card.CardID.CardID)
             str = str + "卡号：" + CStr(card.CardNo)
          
             str = str + "人员编号：" + CStr(card.PersonNo)
             str = str + "姓名：" + CStr(card.MyName)
             str = str + "密码：" + CStr(card.Password)
             str = str + "卡级别:" + CStr(card.GradeNo)
          
             If (card.CARDTYPE And CardType_POS) = CardType_POS Then
                str = str + "此卡支持消费"
             End If
             If (card.CARDTYPE And CARDTYPE_ATT) = CARDTYPE_ATT Then
                str = str + "此卡支持考勤"
             End If
             If (card.CARDTYPE And CARDTYPE_ACC) = CARDTYPE_ACC Then
                str = str + "此卡支持门禁"
             End If
             If (card.CARDTYPE And CARDTYPE_OPR) = CARDTYPE_OPR Then
                str = str + "此卡支持操作员"
             End If
             lstData.AddItem (str)
             MsgBox "读卡成功"
        Case MT_READEW_CARDOFHD6K
             Dim EWInfo As EW_HD6K
             Call MemSet_HD(EWInfo, &H0, Len(EWInfo))
             str = ""
             Call GetData(EWInfo, Len(EWInfo))
             str = str + "钱包余额：" + CStr(EWInfo.Balance)
             str = str + "充值额：" + CStr(EWInfo.Deposit)
             str = str + "累计充值额为：" + CStr(EWInfo.SumOfDeposit)
             str = str + "日累计消费额：" + CStr(EWInfo.IntradaySumOfAmount)
             str = str + "交易流水号：" + CStr(EWInfo.TraceOfEW)
             lstData.AddItem (str)
             MsgBox "读钱包成功"
        Case MT_READ_CARDOFHD4K
             MsgBox "读卡成功"
        Case MT_WRITE_CARDOFHD4K
             MsgBox "写卡成功"
        Case MT_READEW_CARDOFHD4K
             MsgBox "读4K钱包成功"
             lstData.Clear
             Dim EW_4k As EW_HD4K
             Call GetData(EW_4k, Len(EW_4k))
             str = ""
             str = str + "卡号为" + CStr(EW_4k.CardNo)
             str = str + "卡余额为" + CStr(EW_4k.Balance)
             str = str + "卡流水为" + CStr(EW_4k.TraceOfEW)
             lstData.AddItem (str)
        Case MT_WRITEEW_CARDOFHD4K
             MsgBox "写4K钱包成功"
        Case Else
             stbResult.Panels(2).Text = "操作成功"
    End Select
End Sub