frmmifare.frm

一个读写mifare卡VB编程事例,适合做IC卡应用开发.

        bytMode = &H61
    End If
    
    Dim bRetval As Long
    Dim block As Byte
    Dim arrKey(6) As Byte
    block = CLng(txtBlock.Text)
    arrKey(0) = HexToByte(Mid(txtKey.Text, 1, 2))
    arrKey(1) = HexToByte(Mid(txtKey.Text, 3, 2))
    arrKey(2) = HexToByte(Mid(txtKey.Text, 5, 2))
    arrKey(3) = HexToByte(Mid(txtKey.Text, 7, 2))
    arrKey(4) = HexToByte(Mid(txtKey.Text, 9, 2))
    arrKey(5) = HexToByte(Mid(txtKey.Text, 11, 2))
    bRetval = MF_AuthKey(m_hPort, bytMode, m_snr(0), arrKey(0), block)
    If 0 <> bRetval Then
        'MsgBox "AuthKey OK!"
    Else
        MsgBox "AuthKey Failed!"
    End If
End Sub

Private Sub btnIncrement_Click()
    Dim block As Byte
    block = CLng(txtBlock.Text)
    Dim lValue As Long
    lValue = CLng(txtValue.Text)
    
    If 0 <> MF_Increment(m_hPort, block, lValue) Then
    Else
        MsgBox "Increment Failed!"
    End If
End Sub


Private Sub btnDecrement_Click()
    Dim block As Byte
    block = CLng(txtBlock.Text)
    Dim lValue As Long
    lValue = CLng(txtValue.Text)
    
    If 0 <> MF_Decrement(m_hPort, block, lValue) Then
    Else
        MsgBox "Decrement Failed!"
    End If
End Sub

Private Sub btnRead_Click()

    Dim block As Byte
    block = CLng(txtBlock.Text)
    
    If 0 <> MF_Read(m_hPort, block, DataBuf(0)) Then
        txtData.Text = ToHexString(DataBuf(0)) & ToHexString(DataBuf(1)) & _
                ToHexString(DataBuf(2)) & ToHexString(DataBuf(3)) & _
                ToHexString(DataBuf(4)) & ToHexString(DataBuf(5)) & _
                ToHexString(DataBuf(6)) & ToHexString(DataBuf(7)) & _
                ToHexString(DataBuf(8)) & ToHexString(DataBuf(9)) & _
                ToHexString(DataBuf(10)) & ToHexString(DataBuf(11)) & _
                ToHexString(DataBuf(12)) & ToHexString(DataBuf(13)) & _
                ToHexString(DataBuf(14)) & ToHexString(DataBuf(15))
    Else
        MsgBox "Read Failed!"
    End If
End Sub

Private Sub btnClosePort_Click()
    If (m_hPort >= 0) Then
        SC_CloseReader m_hPort
    End If
    m_hPort = -1
End Sub

Private Sub btnConfig_Click()
    Dim bRetval As Long
    bRetval = RF_SetTransMode(m_hPort, cmbCardType.ItemData(cmbCardType.ListIndex), 0)
    If 0 <> bRetval Then
        'MsgBox "Config OK!"
    Else
        MsgBox "Config Failed!"
    End If
End Sub

Private Sub btnHalt_Click()
    If 0 <> MF_Halt(m_hPort) Then
        'MsgBox "Halt OK!"
    Else
        MsgBox "Halt Failed!"
    End If
End Sub

Private Sub btnOpenPort_Click()
    If (m_hPort >= 0) Then
        SC_CloseReader m_hPort
    End If
    
    m_hPort = SC_OpenReader(cmbPort.Text, txtParam.Text)
    If (m_hPort < 0) Then
        MsgBox "Open Port Failed!"
    Else
        MsgBox "Operator is OK!"
    End If
End Sub



Private Sub btnRequest_Click()
    Dim bytMode As Byte
    If cmbRequestMode.ListIndex = 0 Then
        bytMode = &H52
    Else
        bytMode = &H26
    End If
    Dim atq(2) As Byte
    If 0 <> MF_Request(m_hPort, bytMode, atq(0)) Then
        txtATQ.Text = ToHexString(atq(0)) & ToHexString(atq(1))
    Else
        MsgBox "Request Failed!"
    End If
End Sub

Private Sub btnRequest2_Click()
    Dim bytMode As Byte
    If cmbRequestMode.ListIndex = 0 Then
        bytMode = &H52
    Else
        bytMode = &H26
    End If
    
    Dim atq(2) As Byte
    Dim bRetval As Long
    bRetval = MF_Request(m_hPort, bytMode, atq(0))
    If 0 = bRetval Then
        bRetval = MF_Request(m_hPort, bytMode, atq(0))
    End If
    If 0 <> bRetval Then
        txtATQ.Text = ToHexString(atq(0)) & ToHexString(atq(1))
    Else
        MsgBox "Request Failed!"
    End If
End Sub

Private Sub btnRequest3_Click()
    Dim bytMode As Byte
    If cmbRequestMode.ListIndex = 0 Then
        bytMode = &H52
    Else
        bytMode = &H26
    End If
    
    Dim atq(2) As Byte
    Dim bRetval As Long
    bRetval = MF_Request(m_hPort, bytMode, atq(0))
    If 0 = bRetval Then
        bRetval = MF_Request(m_hPort, bytMode, atq(0))
        If 0 = bRetval Then
            bRetval = MF_Request(m_hPort, bytMode, atq(0))
        End If
    End If

    
    If 0 <> bRetval Then
        txtATQ.Text = ToHexString(atq(0)) & ToHexString(atq(1))
    Else
        MsgBox "Request Failed!"
    End If
End Sub

Private Sub btnSelect_Click()
    Dim bRetval As Long
    Dim sak As Byte
    bRetval = MF_Select(m_hPort, m_snr(0), sak)
    If 0 <> bRetval Then
        txtSAK.Text = ToHexString(sak)
    Else
        MsgBox "Select Failed!"
    End If
End Sub

Private Sub Command1_Click()

End Sub

Private Sub btnWrite_Click()
    Dim block As Byte
    block = CLng(txtBlock.Text)
    
    If 0 = SCHelp_HexStringToBytes(txtData.Text, DataBuf(0), 16) Then
        MsgBox "Data Format Error!"
        Exit Sub
    End If
    
    If block Mod 4 = 3 Then
        If vbYes <> MsgBox("It's key block,write now?", vbYesNo) Then
            Exit Sub
        End If
    End If
    If 0 <> MF_Write(m_hPort, block, DataBuf(0)) Then
    Else
        MsgBox "Write Failed!"
    End If
End Sub

Private Sub Form_Load()
m_hPort = -1
cmbPort.ListIndex = 0
cmbCardType.ListIndex = 0
cmbRequestMode.ListIndex = 0
btnVerifyMode.ListIndex = 0
End Sub

Private Function HexToByte(strVal As String) As Byte
Dim HighVal As String
Dim LowVal As String
HighVal = Left$(strVal, 1)
LowVal = Right$(strVal, 1)

If Asc(HighVal) >= Asc("0") And Asc(HighVal) <= Asc("9") Then
    HexToByte = (Asc(HighVal) - Asc("0")) * 16
ElseIf Asc(HighVal) >= Asc("A") And Asc(HighVal) <= Asc("F") Then
    HexToByte = (Asc(HighVal) - Asc("A") + 10) * 16
ElseIf Asc(HighVal) >= Asc("a") And Asc(HighVal) <= Asc("f") Then
    HexToByte = (Asc(HighVal) - Asc("a") + 10) * 16
End If

If Asc(LowVal) >= Asc("0") And Asc(LowVal) <= Asc("9") Then
    HexToByte = (Asc(LowVal) - Asc("0")) + HexToByte
ElseIf Asc(LowVal) >= Asc("A") And Asc(LowVal) <= Asc("F") Then
    HexToByte = (Asc(LowVal) - Asc("A") + 10) + HexToByte
ElseIf Asc(LowVal) >= Asc("a") And Asc(LowVal) <= Asc("f") Then
    HexToByte = (Asc(LowVal) - Asc("a") + 10) + HexToByte
End If

End Function


Private Function ToHexString(ByVal val As Byte) As String
Dim HighVal As Byte
Dim LowVal As Byte
HighVal = val \ 16
LowVal = val Mod 16

If HighVal < 10 Then
    ToHexString = Chr(Asc("0") + HighVal)
Else
    ToHexString = Chr(Asc("A") + HighVal - 10)
End If

If LowVal < 10 Then
    ToHexString = ToHexString & Chr(Asc("0") + LowVal)
Else
    ToHexString = ToHexString & Chr(Asc("A") + LowVal - 10)
End If
End Function


Private Sub txtData_KeyPress(KeyAscii As Integer)
With txtData

    If KeyAscii = vbKeyUp Or KeyAscii = vbKeyDown Or KeyAscii = vbKeyRight Or KeyAscii = vbKeyLeft Or KeyAscii = vbKeyEnd Or KeyAscii = vbKeyHome Or KeyAscii = vbKeyPageDown Or KeyAscii = vbKeyPageUp Then
        Exit Sub
    End If
    If KeyAscii = vbKeyBack Then
        KeyAscii = 0
        If .SelStart <> 0 Then
            .SelStart = .SelStart - 1
            .SelLength = 1
            .SelText = "F"
            .SelStart = .SelStart - 1
        End If
    ElseIf (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) _
        Or (KeyAscii >= Asc("A") And KeyAscii <= Asc("F")) _
        Or (KeyAscii >= Asc("a") And KeyAscii <= Asc("f")) Then
    
        '大小写转换
        If KeyAscii >= Asc("a") And KeyAscii <= Asc("f") Then
            KeyAscii = KeyAscii + Asc("A") - Asc("a")
        End If
        
    
        If .SelStart < .MaxLength Then
            .SelLength = 1
            .SelText = Chr$(KeyAscii)
        End If

    
    End If
    
    KeyAscii = 0
    .SelLength = 0

End With
End Sub

Private Sub txtKey_KeyPress(KeyAscii As Integer)
With txtKey

    If KeyAscii = vbKeyUp Or KeyAscii = vbKeyDown Or KeyAscii = vbKeyRight Or KeyAscii = vbKeyLeft Or KeyAscii = vbKeyEnd Or KeyAscii = vbKeyHome Or KeyAscii = vbKeyPageDown Or KeyAscii = vbKeyPageUp Then
        Exit Sub
    End If
    If KeyAscii = vbKeyBack Then
        KeyAscii = 0
        If .SelStart <> 0 Then
            .SelStart = .SelStart - 1
            .SelLength = 1
            .SelText = "F"
            .SelStart = .SelStart - 1
        End If
    ElseIf (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) _
        Or (KeyAscii >= Asc("A") And KeyAscii <= Asc("F")) _
        Or (KeyAscii >= Asc("a") And KeyAscii <= Asc("f")) Then
    
        '大小写转换
        If KeyAscii >= Asc("a") And KeyAscii <= Asc("f") Then
            KeyAscii = KeyAscii + Asc("A") - Asc("a")
        End If
        
    
        If .SelStart < .MaxLength Then
            .SelLength = 1
            .SelText = Chr$(KeyAscii)
        End If

    
    End If
    
    KeyAscii = 0
    .SelLength = 0

End With
End Sub

Private Sub txtSnr_KeyPress(KeyAscii As Integer)
With txtSnr

    If KeyAscii = vbKeyUp Or KeyAscii = vbKeyDown Or KeyAscii = vbKeyRight Or KeyAscii = vbKeyLeft Or KeyAscii = vbKeyEnd Or KeyAscii = vbKeyHome Or KeyAscii = vbKeyPageDown Or KeyAscii = vbKeyPageUp Then
        Exit Sub
    End If
    If KeyAscii = vbKeyBack Then
        KeyAscii = 0
        If .SelStart <> 0 Then
            .SelStart = .SelStart - 1
            .SelLength = 1
            .SelText = "F"
            .SelStart = .SelStart - 1
        End If
    ElseIf (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) _
        Or (KeyAscii >= Asc("A") And KeyAscii <= Asc("F")) _
        Or (KeyAscii >= Asc("a") And KeyAscii <= Asc("f")) Then
    
        '大小写转换
        If KeyAscii >= Asc("a") And KeyAscii <= Asc("f") Then
            KeyAscii = KeyAscii + Asc("A") - Asc("a")
        End If
        
    
        If .SelStart < .MaxLength Then
            .SelLength = 1
            .SelText = Chr$(KeyAscii)
        End If

    
    End If
    
    KeyAscii = 0
    .SelLength = 0

End With
End Sub