demokitwei.frm

来自「利用连接mg500读卡器进行卡片是否完好的检测程序」· FRM 代码 · 共 1,127 行 · 第 1/2 页

FRM
1,127
字号
'   Dim valuedata As Long
'
'   Call ReqtoAuthen(cobosector.Text)     'Sector
'   If MifStatus <> 0 Then
'        Exit Sub
'   End If
'   MifStatus = mifsw_read%(coboblock.Text, rdata(0))   'BlockNo=1, keep data into rdata
'   If MifStatus <> 0 Then
'       Textstatus.Text = Textstatus.Text & "Read -> Error" & Chr(10)
'       Exit Sub
'   Else
'        Textstatus.Text = Textstatus.Text & "Block" & coboblock.Text & "    "
'        For i = 0 To 15
'            If OptionHex.value Then
'                If rdata(i) < 16 Then
'                    Textstatus.Text = Textstatus.Text & "0" & Hex(rdata(i)) & " "
'                Else
'                    Textstatus.Text = Textstatus.Text & Hex(rdata(i)) & " "
'                End If
'            Else
'                If OptionText.value Then
'                    Textstatus.Text = Textstatus.Text & Chr(rdata(i))
'                End If
'            End If
'        Next i
'        If valuestatus Then
'            If OptionValue.value Then
'                valuedata = 0
'                valuedata = Val(rdata(0)) + Val(rdata(1)) * 256 + Val(rdata(2)) * 256 * 256 + Val(rdata(3)) * 256 * 256 * 256
'                Textstatus.Text = Textstatus.Text & valuedata
'            End If
'        End If
'        Textstatus.Text = Textstatus.Text & modestring & Chr(10)
'        MifStatus = mifsw_restore%(coboblock.Text)
'        If MifStatus = 0 Then
'            OptionValue.Enabled = True
'            Labelvalue.Enabled = True
'            valuestatus = 100
'        Else
'            OptionValue.Enabled = False
'            Labelvalue.Enabled = False
'        End If
'    End If
'End Sub

'Private Sub CmdReadAll_Click()
'
'
'
'    Timer2.Enabled = True
'
'End Sub

Private Sub cmdRequest_Click()
    MifStatus = mifsw_request_2%(mode, tagtype)  'request mode=0
    If MifStatus <> 0 Then
       MifStatus = mifsw_request_2%(mode, tagtype)
       If MifStatus <> 0 Then
           Textstatus.Text = "Request -> Error" & Chr(10) & "Please scan new card" & Chr(10)
          Exit Sub
        Else
            Textstatus.Text = "Request -> Ok" & Chr(10)
        End If
    Else
      Textstatus.Text = "Request -> Ok" & Chr(10)
    End If
End Sub

Private Sub cmdSelect_Click()
    MifStatus = mifsw_select%(snr, Size(0))
    If MifStatus <> 0 Then
        Textstatus.Text = Textstatus.Text & "Select -> Error" & Chr(10)
        Exit Sub
    Else
        Textstatus.Text = Textstatus.Text & "Select -> Ok" & Chr(10)
    End If

End Sub

Private Sub cmdUnhalt_Click()
    
    If MifStatus <> 0 Then
        Textstatus.Text = Textstatus.Text & "Unhalt -> Error" & Chr(10)
    Else
        Textstatus.Text = Textstatus.Text & "Unhalt -> Ok" & Chr(10)
    End If
        
End Sub

Private Sub cmdwrite_Click()
    Demokit.Enabled = False
    frmwrite.Show
End Sub

Private Sub coboblock_Click()
    Blockstatus = coboblock.Text
    OptionValue.value = False
    If OptionHex.value Or OptionText.value Then
    Else
        OptionHex.value = True
    End If
    valuestatus = &H0
    OptionValue.Enabled = False
    Labelvalue.Enabled = False
    
End Sub

Private Sub cobosector_Click()
    OptionValue.Enabled = False
    OptionValue.value = False
    Labelvalue.Enabled = False
    valuestatus = &H0
    coboblock.Clear
    coboblock.Text = Hex(cobosector.Text) * 4
    Blockstatus = coboblock.Text
    coboblock.AddItem (cobosector.Text * 4 + 0)
    coboblock.AddItem (cobosector.Text * 4 + 1)
    coboblock.AddItem (cobosector.Text * 4 + 2)
    coboblock.AddItem (cobosector.Text * 4 + 3)
    If OptionHex.value Or OptionText.value Then
    Else
        OptionHex.value = True
    End If

End Sub

Private Sub Command1_Click()

    snr = 0
    snr1 = 0
    snr2 = 0
    
    Textstatus.Text = ""
    Command1.Enabled = False
    Timer2.Enabled = True
    Textstatus.Enabled = True
    
End Sub

Private Sub Command2_Click()

    Command2.Enabled = False
    Command1.Enabled = True
    Timer2.Enabled = False
    Textstatus.Enabled = False
    Textstatus.Text = ""
    
End Sub

Private Sub CmdReadsnr_Click()
    Call modestatus(modestring)
    
    MifStatus = mifsw_request_2%(mode, tagtype)  'request mode= 1
    If MifStatus <> 0 Then
    MifStatus = mifsw_request_2%(mode, tagtype)
    If MifStatus <> 0 Then
              Exit Sub
          End If
    End If

    MifStatus = mifsw_anticoll%(mode, snr)
    If MifStatus <> 0 Then
        Exit Sub
    End If
    
    Textstatus.Text = "卡号:" & snr
End Sub

Private Sub CommandLoadkey_Click()
'There are all together 6 mode(keysets),i.e mode 0,1,2,4,5,6

'KeyA KeySet0 = mode 0      'KeyB KeySet0 = mode 4
'KeyA KeySet1 = mode 1      'KeyB KeySet1 = mode 5
'KeyA KeySet2 = mode 2      'KeyB KeySet2 = mode 6

'mifsw_load_key(mode,keynumber,transportkey,newkey)

'This example only loads Key Set into mode 0(KEYA KEYSET0) for 16 sectors (sector 0 to 15)

Dim intkeynr As Integer
Dim keynr(0 To 5) As Byte
Dim i As Integer
Dim Strtext(0 To 5) As String
Dim x As Integer
    
'********Transport Key(common for all keysets) ********************
'TKey(byte, secno)
    TKey(0, 0) = &HBD
    TKey(1, 0) = &HDE
    TKey(2, 0) = &H6F
    TKey(3, 0) = &H37
    TKey(4, 0) = &H83
    TKey(5, 0) = &H83

    TKey(0, 1) = (&H14)
    TKey(1, 1) = (&H8A)
    TKey(2, 1) = (&HC5)
    TKey(3, 1) = (&HE2)
    TKey(4, 1) = (&H28)
    TKey(5, 1) = (&H28)

    TKey(0, 2) = (&H7D)
    TKey(1, 2) = (&H3E)
    TKey(2, 2) = (&H9F)
    TKey(3, 2) = (&H4F)
    TKey(4, 2) = (&H95)
    TKey(5, 2) = (&H95)
  
    TKey(0, 3) = (&HAD)
    TKey(1, 3) = (&HD6)
    TKey(2, 3) = (&H6B)
    TKey(3, 3) = (&H35)
    TKey(4, 3) = (&HC8)
    TKey(5, 3) = (&HC8)
  
    TKey(0, 4) = (&HDF)
    TKey(1, 4) = (&HEF)
    TKey(2, 4) = (&H77)
    TKey(3, 4) = (&HBB)
    TKey(4, 4) = (&HE4)
    TKey(5, 4) = (&HE4)
  
    TKey(0, 5) = (&H9)
    TKey(1, 5) = (&H84)
    TKey(2, 5) = (&H42)
    TKey(3, 5) = (&H21)
    TKey(4, 5) = (&HBC)
    TKey(5, 5) = (&HBC)
  
    TKey(0, 6) = (&H5F)
    TKey(1, 6) = (&HAF)
    TKey(2, 6) = (&HD7)
    TKey(3, 6) = (&HEB)
    TKey(4, 6) = (&HA5)
    TKey(5, 6) = (&HA5)
  
    TKey(0, 7) = (&H29)
    TKey(1, 7) = (&H14)
    TKey(2, 7) = (&H8A)
    TKey(3, 7) = (&HC5)
    TKey(4, 7) = (&H9F)
    TKey(5, 7) = (&H9F)
  
    TKey(0, 8) = (&HFA)
    TKey(1, 8) = (&HFD)
    TKey(2, 8) = (&HFE)
    TKey(3, 8) = (&H7F)
    TKey(4, 8) = (&HFF)
    TKey(5, 8) = (&HFF)

  
    TKey(0, 9) = (&H73)
    TKey(1, 9) = (&H39)
    TKey(2, 9) = (&H9C)
    TKey(3, 9) = (&HCE)
    TKey(4, 9) = (&HBE)
    TKey(5, 9) = (&HBE)

    TKey(0, 10) = (&HFC)
    TKey(1, 10) = (&H7E)
    TKey(2, 10) = (&HBF)
    TKey(3, 10) = (&HDF)
    TKey(4, 10) = (&HBF)
    TKey(5, 10) = (&HBF)

    TKey(0, 11) = (&HCF)
    TKey(1, 11) = (&HE7)
    TKey(2, 11) = (&H73)
    TKey(3, 11) = (&H39)
    TKey(4, 11) = (&H51)
    TKey(5, 11) = (&H51)
  
    TKey(0, 12) = (&HF7)
    TKey(1, 12) = (&HFB)
    TKey(2, 12) = (&H7D)
    TKey(3, 12) = (&H3E)
    TKey(4, 12) = (&H5A)
    TKey(5, 12) = (&H5A)
          
    TKey(0, 13) = (&HF2)
    TKey(1, 13) = (&H79)
    TKey(2, 13) = (&H3C)
    TKey(3, 13) = (&H1E)
    TKey(4, 13) = (&H8D)
    TKey(5, 13) = (&H8D)
    
    TKey(0, 14) = (&HCF)
    TKey(1, 14) = (&HE7)
    TKey(2, 14) = (&H73)
    TKey(3, 14) = (&H39)
    TKey(4, 14) = (&H45)
    TKey(5, 14) = (&H45)
  
    TKey(0, 15) = (&HB7)
    TKey(1, 15) = (&HDB)
    TKey(2, 15) = (&H6D)
    TKey(3, 15) = (&HB6)
    TKey(4, 15) = (&H7D)
    TKey(5, 15) = (&H7D)
    loadkeystatus = &H0
    
    For x = 0 To 5
    
        Strtext(x) = Text1(x).Text
        Strtext(x) = "&H" & Strtext(x)
        nKeyA(x) = Strtext(x)

    Next x
    
    For x = 0 To 5
    
        Strtext(x) = Text2(x).Text
        Strtext(x) = "&H" & Strtext(x)
        nKeyB(x) = Strtext(x)

    Next x
    
    For x = 0 To 5
    
        If Text3(x).Text = "" Then
            DataString(x, 0) = "&h00"
        Else
            DataString(x, 0) = "&H" & Text3(x).Text
        End If
        
        If Text4(x).Text = "" Then
            DataString(x + 10, 0) = "&h00"
        Else
            DataString(x + 10, 0) = "&H" & Text4(x).Text
        End If
    Next x
    
    DataString(6, 0) = &HFF
    DataString(7, 0) = &H7
    DataString(8, 0) = &H80
    DataString(9, 0) = &H69

    For intkeynr = 0 To 15
    MifStatus = mifsw_load_key(mode, intkeynr, TKey(mode, intkeynr), keynr(0))
        If MifStatus = -4 Then
            MifStatus = mifsw_exit%()
            Exit Sub
        Else
            cmdloadkey.Enabled = False
            loadkeystatus = &HFF
        End If
    Next intkeynr
    If loadkeystatus Then
        Textstatus.Text = " Load Key -> Ok"
    Else
        Textstatus.Text = "Load Key -> Error "
    End If

End Sub

Private Sub Form_Load()
    
    Framestatus.Enabled = False
    
End Sub

Private Sub Image1_Click()

End Sub

Private Sub mnuAboutInfo_Click()
    FrmInfo.Show
    Demokit.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    MifStatus = mifsw_exit%()
    End
End Sub

Private Sub mnuFileClose_Click()
    Call CmdExit_Click
End Sub

Private Sub mnufileexit_Click()
    Call cmdEnd_Click
End Sub

Private Sub mnuFileLoadkey_Click()
    Call cmdLoadkey_Click
End Sub

Private Sub mnuFileOpen_Click()
    Call cmdOpenPort_Click
End Sub

'Private Sub mnumifare_light_Click()
'
'         Call CmdExit_Click
'         Demokit.Hide
'         frmmifarelight.Show
'
'End Sub

'Private Sub OptionHex_Click()
'
'   Call ReqtoAuthen(cobosector.Text)     'Sector
'   If MifStatus <> 0 Then
'        Exit Sub
'   End If
'   MifStatus = mifsw_read%(coboblock.Text, rdata(0))   'BlockNo=1, keep data into rdata
'   If MifStatus <> 0 Then
'       Textstatus.Text = Textstatus.Text & "Read -> Error" & Chr(10)
'       Exit Sub
'   Else
'        Textstatus.Text = Textstatus.Text & "Block" & coboblock.Text & "    "
'            For i = 0 To 15
'                If rdata(i) < 16 Then
'                    Textstatus.Text = Textstatus.Text & "0" & Hex(rdata(i)) & " "
'                Else
'                    Textstatus.Text = Textstatus.Text & Hex(rdata(i)) & " "
'                End If
'            Next i
'            Textstatus.Text = Textstatus.Text & Chr(10)
'   End If
'
'End Sub

'Private Sub Optiontext_Click()
'
'   Call ReqtoAuthen(cobosector.Text)     'Sector
'   If MifStatus <> 0 Then
'        Exit Sub
'   End If
'   MifStatus = mifsw_read%(coboblock.Text, rdata(0))   'BlockNo=1, keep data into rdata
'   If MifStatus <> 0 Then
'       Textstatus.Text = Textstatus.Text & "Read -> Error" & Chr(10)
'       Exit Sub
'   Else
'        Textstatus.Text = Textstatus.Text & "Block" & coboblock.Text & "    "
'        For i = 0 To 15
'            Textstatus.Text = Textstatus.Text & Chr(rdata(i))
'        Next i
'        Textstatus.Text = Textstatus.Text & Chr(10)
'   End If
'
'End Sub
Private Sub modestatus(p As String)
    
    If mode = 0 Then
        p = "    (KeyA KeySet0)"
    Else
        If mode = 1 Then
            p = "    (KeyA KeySet1)"
        Else
            If mode = 2 Then
                p = "    (KeyA KeySet2)"
            Else
                If mode = 4 Then
                    p = "    (KeyB KeySet0)"
                Else
                    If mode = 5 Then
                        p = "    (KeyB KeySet1)"
                    Else
                        If mode = 6 Then
                            p = "    (KeyB KeySet2)"
                        End If
                    End If
                End If
            End If
        End If
    End If
End Sub


Private Sub Timer1_Timer()
    
    h = 115200
    
    If k = 10 Then
        Timer1.Enabled = False
        cmdOpenPort.Enabled = True
    End If
    
    s = k
    
    MifStatus = mifsw_init%(s, h)
    If MifStatus < 0 Then
        MsgBox "Init Error, " + CStr(MifStatus)
        MifStatus = mifsw_exit%()
        k = k + 1
        Exit Sub
    End If
    
    '*********reader configuration***************
    MifStatus = mifsw_config%(&HC6, &HE)
    If MifStatus <> 0 Then
    '            MsgBox "Config Error, " + CStr(MifStatus)
        MifStatus = mifsw_exit%()
        k = k + 1
        Exit Sub
    Else

        cmdloadkey.Enabled = True
        cmdEnd.Enabled = True
        cmdExit.Enabled = True
        Framestatus.Enabled = True
        cmdEnd.Enabled = False

        mnuFileClose.Enabled = True
        mnuFileLoadkey.Enabled = True
        Textstatus.Text = "成功打开读卡器" & s

        Timer1.Enabled = False
    End If
'    Command1.Enabled = True
End Sub

Private Sub Timer2_Timer()

    Dim intkeynr As Integer
    Dim intblocknr As Integer
    Dim rdatastr As String
    Dim rdatastring As String
    

    rdatastring = ""

    Call ReqtoAnticoll(0)   'Sector

    If MifStatus = 0 Then

        If snr1 = snr Then

'            Textstatus.Text = "请放入新的一张卡"

            Exit Sub
        Else
            snr1 = snr

        End If
        
    Else
        Exit Sub
    End If

    Textstatus.Text = ""
    
    Textstatus.Text = Textstatus.Text & "第" & CardNumber & "张" & Chr(10)
    
    intblocknr = 0
    
    For intkeynr = 0 To 15

        Call ReqtoAuthen(intkeynr) 'Sector
        
        MifStatus = mifsw_write%(intkeynr * 4 + 3, DataString(0, 0))
        If MifStatus <> 0 Then
            Textstatus.Text = Textstatus.Text & "扇区" & intkeynr & "更改密码错误!!!" & Chr(10)
        Else
            Textstatus.Text = Textstatus.Text & "扇区" & intkeynr & "更改密码成功" & Chr(10)
        End If

    Next intkeynr
    
    CardNumber = CardNumber + 1
End Sub

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?