frmmifare.frm

磁条读写机

      Left            =   1860
      TabIndex        =   16
      Top             =   2400
      Width           =   1620
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Mode[in]"
      Height          =   180
      Left            =   600
      TabIndex        =   14
      Top             =   1980
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "ATQ[out]"
      Height          =   180
      Left            =   3240
      TabIndex        =   12
      Top             =   1980
      Width           =   720
   End
End
Attribute VB_Name = "frmMifare"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_hPort As Long
Dim m_snr(4) As Byte
Dim databuf(16) As Byte
    
Private Sub btnAnticoll_Click()
    Dim bRetval As Long
    bRetval = MF_Anticoll(m_hPort, 0, m_snr(0))
    If 0 <> bRetval Then
        txtSnr.Text = ToHexString(m_snr(0)) & ToHexString(m_snr(1)) & ToHexString(m_snr(2)) & ToHexString(m_snr(3))
    Else
        MsgBox "Anticoll Failed!"
    End If
End Sub

Private Sub btnAuthKey_Click()
    Dim bytMode As Byte
    If cmbRequestMode.ListIndex = 0 Then
        bytMode = &H60
    Else
        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 = MF_Config(m_hPort)
    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, "")
    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))
    End If
    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 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 "Anticoll Failed!"
    End If
End Sub

Private Sub Command1_Click()

End Sub

Private Sub btnWrite_Click()
    Dim block As Byte
    block = CLng(txtBlock.Text)
    
    'set databuf...
    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
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