frmmain.frm

这是利用Mifare SDK开发的读写基于ISO14443标准RF卡的程序。

      TabIndex        =   44
      Top             =   120
      Width           =   1695
   End
   Begin VB.Label Label7 
      Caption         =   "Data(32)"
      Height          =   255
      Left            =   3480
      TabIndex        =   33
      Top             =   7080
      Width           =   855
   End
   Begin VB.Label Label6 
      Caption         =   "S/N # (8)"
      Height          =   255
      Left            =   7560
      TabIndex        =   18
      Top             =   2880
      Width           =   1095
   End
   Begin VB.Label Label5 
      Caption         =   "Key Value(12)"
      Height          =   255
      Left            =   7560
      TabIndex        =   16
      Top             =   2520
      Width           =   1095
   End
   Begin VB.Label Label4 
      Caption         =   "Key Addr (00 - 0F)"
      Height          =   255
      Left            =   7560
      TabIndex        =   14
      Top             =   2160
      Width           =   1815
   End
   Begin VB.Label Label3 
      Caption         =   "Block # (00 - FF)"
      Height          =   255
      Left            =   7560
      TabIndex        =   12
      Top             =   1200
      Width           =   1815
   End
   Begin VB.Label Label2 
      Caption         =   "Reader ID (00 - FF)"
      Height          =   255
      Left            =   7560
      TabIndex        =   7
      Top             =   840
      Width           =   1815
   End
   Begin VB.Label Label1 
      Caption         =   "Station ID (00 - FF)"
      Height          =   255
      Left            =   7560
      TabIndex        =   6
      Top             =   480
      Width           =   1695
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim hReader As Long

Private Sub byte2hexstring(b() As Byte, n As Long, s As String)
    Dim i As Integer
    
    s = ""
    For i = 1 To n
        s = s + "[" + Hex(b(i - 1)) + "]"
    Next
End Sub
Private Sub SetBtnState(b As Integer)
    Dim i As Integer
    Dim n As Integer
    On Error Resume Next
    n = 28
    Select Case b
    Case -1:
        For i = 0 To n
            MF_Button(i).Enabled = False
        Next
    Case -2:
        For i = 0 To n
            MF_Button(i).Enabled = True
        Next
    Case 0:
        SetBtnState -2
        MF_Button(0).Enabled = False
    Case 2:
        SetBtnState -1
        MF_Button(0).Enabled = True
    Case 6:
        SetBtnState 0
    Case 20
        SetBtnState -1
        MF_Button(6).Enabled = True
    End Select
    MF_Button(25).Enabled = False
    MF_Button(28).Enabled = False
End Sub
Private Sub ResetMF_MSG(m As MF_MSG)
    m.nDataLen = 0
    m.nCmd = 0
    m.nBeep = 0
    m.nEcho = 0
    m.nBlockNo = 0
    m.nKeyAddr = 0
    m.nHaltAfterCommand = 0
End Sub
Private Sub SetSerialNo(m As MF_MSG)
    m.SerialNo(0) = Val("&H" + Mid(txtSerialNo, 1, 2))
    m.SerialNo(1) = Val("&H" + Mid(txtSerialNo, 3, 2))
    m.SerialNo(2) = Val("&H" + Mid(txtSerialNo, 5, 2))
    m.SerialNo(3) = Val("&H" + Mid(txtSerialNo, 7, 2))
    m.nSerialNoLen = 4
End Sub
Private Sub SetKeyValue(m As MF_MSG)
    m.KeyValue(0) = Val("&H" + Mid(txtKeyValue, 1, 2))
    m.KeyValue(1) = Val("&H" + Mid(txtKeyValue, 3, 2))
    m.KeyValue(2) = Val("&H" + Mid(txtKeyValue, 5, 2))
    m.KeyValue(3) = Val("&H" + Mid(txtKeyValue, 7, 2))
    m.KeyValue(4) = Val("&H" + Mid(txtKeyValue, 9, 2))
    m.KeyValue(5) = Val("&H" + Mid(txtKeyValue, 11, 2))
    m.nKeyValueLen = 6
End Sub
Private Sub SetWriteData(m As MF_MSG)
    Dim i As Integer
    For i = 1 To 16
        m.data(i - 1) = Val("&H" + Mid(txtData, 2 * i - 1, 2))
    Next
    m.nDataLen = 16
End Sub
Private Sub ProcRetMsg(m As MF_MSG)
    Dim i As Integer
    Dim s As String
    s = ""
    Call byte2hexstring(m.data, m.nDataLen, s)
    showMsg ">" & s
End Sub
Private Function SendMsg(m As MF_MSG) As Long
    SendMsg = DoMF(hReader, m)
    showMsg "Command:" & Hex(m.nCmd) & " result:" & Hex(SendMsg)
    Select Case m.nCmd
    Case CMD_GET_LIB_VER, CMD_READ_SERIAL_NO, CMD_READ_ID, CMD_READ, CMD_EREAD, CMD_SEL_READ, CMD_SEL_EREAD, CMD_WRITE, CMD_EWRITE, CMD_SEL_WRITE, CMD_SEL_EWRITE:
        If SendMsg = CMD_OK Then
            Call ProcRetMsg(m)
        End If
    Case CMD_RESET:
        Sleep (4000)
    Case Else
        Exit Function
    End Select
End Function
Private Function BCC(a() As Byte, nBytes As Integer)
    BCC = 0
End Function
Private Sub showMsg(s As String)
    List1.AddItem s
    List1.TopIndex = List1.ListCount - 1
    Me.Refresh
End Sub
Private Function GetReaderID() As Byte
    GetReaderID = Val(cbReaderID.ListIndex)
End Function
Private Function GetStationID() As Byte
    GetStationID = Val(cbStationID.ListIndex)
End Function
Private Function GetBlockNo() As Byte
    GetBlockNo = Val(cbBlockNo.ListIndex)
End Function
Private Function GetKeyAddr() As Byte
    GetKeyAddr = Val(cbKeyAddr.ListIndex)
End Function
Private Function GetKeyType() As Byte
    GetKeyType = CByte(cbKeyType.ListIndex)
End Function
Private Sub btnToHex_Click(Index As Integer)
    Dim s As String
    Dim i As Integer
    
    s = txtAscii.Text + Space(16)
    txtData.Text = ""
    For i = 1 To 16
        txtData.Text = txtData.Text + Right("00" + Hex(Asc(Mid(s, i, 1))), 2)
    Next
End Sub
Private Sub Form_Load()
    Dim i As Integer
    
    For i = 0 To &HFF
        cbStationID.AddItem Right("00" & Hex(i), 2)
        cbReaderID.AddItem Right("00" & Hex(i), 2)
        cbBlockNo.AddItem Right("00" & Hex(i), 2)
    Next
    
    cbStationID.ListIndex = 0
    cbReaderID.ListIndex = 0
    cbBlockNo.ListIndex = 0
    
    For i = 0 To &HF
        cbKeyAddr.AddItem Right("00" & Hex(i), 2)
    Next
    cbKeyAddr.ListIndex = 0
    For i = 1 To 8
        cbPortNo.AddItem i
    Next
    cbPortNo.ListIndex = 0
        
    cbKeyType.AddItem "Key A"
    cbKeyType.AddItem "Key B"
    cbKeyType.ListIndex = 0
    
    SetBtnState 2
End Sub

Private Sub MF_Button_Click(Index As Integer)
    Dim m As MF_MSG
    Dim b() As Byte
    Dim i As Integer
    Dim res As Long
    
    Call ResetMF_MSG(m)
    showMsg Index & " [" + MF_Button(Index).Caption + "] Clicked."
    Select Case Index
    Case 0: ' open reader
        hReader = OpenReader(cbPortNo.ListIndex + 1, GetStationID(), GetReaderID())
        showMsg "hReader = " & hReader
    Case 1: ' read reader id
        m.nCmd = CMD_READ_ID
        res = SendMsg(m)
    Case 2: ' close reader
        If hReader <> 0 Then
            res = CloseReader(hReader)
        End If
    Case 3: ' trigger io
        m.nCmd = CMD_TRIGGER_IO
        res = SendMsg(m)
    Case 4: ' set reader id
        m.nCmd = CMD_WRITE_ID
        m.nValue = GetReaderID()
        res = SendMsg(m)
    Case 5:
        m.nCmd = CMD_GET_LIB_VER
        res = SendMsg(m)
    Case 6: ' stop
        m.nCmd = CMD_STOP
        m.nValue = GetReaderID()
        res = SendMsg(m)
    Case 7: ' read
        m.nCmd = CMD_READ
        m.nBlockNo = GetBlockNo()
        m.nKeyType = GetKeyType()
        Call SetKeyValue(m)
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 8: ' select read
        m.nBlockNo = GetBlockNo()
        m.nKeyType = GetKeyType()
        m.nCmd = CMD_SEL_READ
        Call SetKeyValue(m)
        Call SetSerialNo(m)
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 9 ' e read
        m.nCmd = CMD_EREAD
        m.nBlockNo = GetBlockNo()
        m.nKeyAddr = GetKeyAddr()
        m.nKeyType = GetKeyType()
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 10: ' sel e read
        m.nCmd = CMD_SEL_EREAD
        m.nBlockNo = GetBlockNo()
        m.nKeyAddr = GetKeyAddr()
        m.nKeyType = GetKeyType()
        Call SetSerialNo(m)
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 11: ' load key
        m.nCmd = CMD_LOADKEY2
        m.nKeyAddr = GetKeyAddr()
        m.nKeyType = GetKeyType()
        Call SetKeyValue(m)
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 12: ' reset
        m.nCmd = CMD_RESET
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
        showMsg ("Ready ....")
    Case 13: ' wake up
        m.nCmd = CMD_WAKE_UP
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 14: ' turn on RF
        m.nCmd = CMD_RF_ON
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 15: ' turn off RF
        m.nCmd = CMD_RF_OFF
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 16: ' trigger ON
        m.nCmd = CMD_TRIGGER_CONTROL
        m.nValue = 0
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 17: ' trigger OFF
        m.nCmd = CMD_TRIGGER_CONTROL
        m.nValue = 1
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 18: ' halt a card
        m.nCmd = CMD_SEL_HALT
        Call SetSerialNo(m)
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 19:
        m.nCmd = CMD_READ_SERIAL_NO
        'Reader will not halt card after this command
        res = SendMsg(m)
        Debug.Print m.nSerialNoLen
   
    Case 21: ' write
        m.nCmd = CMD_WRITE
        m.nBlockNo = GetBlockNo()
        m.nKeyType = GetKeyType()
        Call SetKeyValue(m)
        Call SetWriteData(m)
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 22: ' sel write
        m.nCmd = CMD_SEL_WRITE
        m.nBlockNo = GetBlockNo()
        m.nKeyType = GetKeyType()
        Call SetKeyValue(m)
        Call SetWriteData(m)
        Call SetSerialNo(m)
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 23: ' e write
        m.nCmd = CMD_EWRITE
        m.nKeyAddr = GetKeyAddr()
        m.nBlockNo = GetBlockNo()
        m.nKeyType = GetKeyType()
        Call SetWriteData(m)
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 24: ' sel e write
        m.nCmd = CMD_SEL_EWRITE
        m.nKeyAddr = GetKeyAddr()
        m.nBlockNo = GetBlockNo()
        m.nKeyType = GetKeyType()
        Call SetWriteData(m)
        Call SetSerialNo(m)
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)
    Case 26, 27: ' long beep, short beep
        m.nCmd = IIf(Index = 26, CMD_LONG_BUZZER, CMD_SHORT_BUZZER)
        m.nHaltAfterCommand = IIf(chkHaltCard.Value = 0, 0, 1)
        res = SendMsg(m)

    Case Else
    End Select
    SetBtnState Index
End Sub