mod_ccms.bas

一个完整的非接触IC卡会员管理系统

    stBuff(3) = &H2
    stBuff(4) = &H8
    stBuff(5) = st8(0)
    stBuff(6) = st8(1)
    stBuff(7) = st8(2)
    stBuff(8) = st8(3)
    stBuff(9) = st8(4)
    stBuff(10) = st8(5)
    stBuff(11) = st8(6)
    stBuff(12) = st8(7)
    boperresult = Sam1ExchangeApdu(stBuff(0), 13, stData(0), stLen) 'ISAM外部认证
    If boperresult <> 0 And Right("00" + hex(stData(0)), 2) <> "90" Then sp_String = "ERR 2003": GoTo err
    PINCRC = True
    
    Exit Function
err:
     PINCRC = False
End Function

'验卡
'sp_String 错误信息
'ERR 1000 寻卡错误
'ERR 1001 不是同一张卡操作
'ERR 1002 扇区密码错误
'ERR 1003 写扇区错误
'ERR 1004 卡流水号错误
'ERR 1005 卡MAC计算错误
'ERR 1006 GET M1KEYA错误
'ERR 1007 GET M1KEYB错误
'ERR 1008 GET S1KEYB错误
'ERR 1010 出厂卡，未初始化的卡
'ERR 1011 初始化卡
'ERR 1012 读信息错误
'ERR 1013 卡未启用
'ERR 1014 挂失卡
'ERR 1015 卡停用
'如果sp_String = "MonthTimes" 且长度大于10，则说明有月票信息
Function CardCheck(sp_String As String, sp_CardNo As Long, sp_Cardtype As Integer, sp_LimtDate As String, sp_Balance As Currency, sp_MonthCurTimes As Long, sp_MonthCountTimes As Long) As Boolean '验卡
    Dim siValue9 As Currency
    Dim siValue10 As Currency
    Dim m As Integer
    Dim cardbz As Integer
    Dim L As Long
    Dim siMonth As Integer
    sp_String = ""
    sp_CardNo = 0
    sp_Cardtype = 0
    sp_LimtDate = ""
    L = 256
    siMonth = 0
    boperresult = MIFARE_SelectCard(SerialNum(0)) '----S0
    If boperresult <> 0 Then sp_String = "ERR 1000": GoTo err
    boperresult = MIFARE_LoginSector(0, 0, aKEY0(0))
    If boperresult = 0 Then
        boperresult = MIFARE_ReadDataBlock(1, DataBuff32(0))
        If boperresult = 0 And DataBuff32(7) = 7 And DataBuff32(8) = 8 Then
            siMonth = 1
        End If
    End If
    
    boperresult = MIFARE_SelectCard(SerialNum(0)) '----S1
    If boperresult <> 0 Then sp_String = "ERR 1000": GoTo err
    aKEY1(0) = SerialNum(0)
    aKEY1(1) = SerialNum(1)
    aKEY1(2) = SerialNum(2)
    aKEY1(3) = SerialNum(3)
    aKEY1(4) = SerialNum(0)
    aKEY1(5) = SerialNum(1)
    boperresult = MIFARE_LoginSector(1, 0, aKEY1(0))
    If boperresult <> 0 Then
        boperresult = MIFARE_LoginSector(1, 0, mKEY(0))
        If boperresult <> 0 Then
            sp_String = "ERR 1002":  GoTo err '非发行的用户卡
        Else
            sp_String = "ERR 1010"
        End If
    End If
    boperresult = MIFARE_ReadDataBlock(4, DataBuff32(0))
    If boperresult <> 0 Then sp_String = "ERR 1003": GoTo err
    stCardNo(0) = DataBuff32(4)
    stCardNo(1) = DataBuff32(5)
    stCardNo(2) = DataBuff32(6)
    stCardNo(3) = DataBuff32(7)
    stMAC(0) = DataBuff32(8)
    stMAC(1) = DataBuff32(9)
    stMAC(2) = DataBuff32(10)
    stMAC(3) = DataBuff32(11)
    
'    sTest = ""
'    For n = 0 To 15
'       sTest = sTest & Right("00" + Hex(DataBuff32(n)), 2)
'    Next n
    
    On Error GoTo err '防止溢出
    sp_CardNo = DataBuff32(4) + DataBuff32(5) * L + DataBuff32(6) * L * L + DataBuff32(7) * L * L * L '卡号
    sp_Cardtype = DataBuff32(13) '卡类
    cardbz = DataBuff32(12)
    
    If GetS1KeyB = False Then sp_String = "ERR 1008": GoTo err
    If GetM1KEYA = False Then sp_String = "ERR 1006": GoTo err
    If GetM1KEYB = False Then sp_String = "ERR 1007": GoTo err
    
    If sp_String = "ERR 1010" Then GoTo err
    
    If sp_Cardtype = 50 Then '未售卡类型
        
        boperresult = MIFARE_SelectCard(SerialNum(0))
        If boperresult <> 0 Then sp_String = "ERR 1000": GoTo err
        boperresult = MIFARE_LoginSector(2, 0, aKEY2(0)) 'S0
        If boperresult <> 0 Then sp_String = "ERR 1002": GoTo err
        
        boperresult = MIFARE_SelectCard(SerialNum(0))
        If boperresult <> 0 Then sp_String = "ERR 1000": GoTo err
        boperresult = MIFARE_LoginSector(3, 0, aKEY3(0)) 'S0
        If boperresult <> 0 Then sp_String = "ERR 1002": GoTo err
        
        boperresult = MIFARE_SelectCard(SerialNum(0))
        If boperresult <> 0 Then sp_String = "ERR 1000": GoTo err
        boperresult = MIFARE_LoginSector(7, 0, aKEY7(0)) 'S0
        If boperresult <> 0 Then sp_String = "ERR 1002": GoTo err
        
        sp_String = "ERR 1011"
        GoTo err
    End If
    
    If cardbz = 4 Then sp_String = "ERR 1014": GoTo err '卡是否启用'2启用  1未启用 3停用 4 黑名单
    If cardbz = 1 Then sp_String = "ERR 1013": GoTo err '卡是否启用'2启用  1未启用 3停用 4 黑名单
    If cardbz = 3 Then sp_String = "ERR 1015": GoTo err '卡是否启用'2启用  1未启用 3停用 4 黑名单
    
    
    
    boperresult = MIFARE_ReadDataBlock(5, DataBuff32(0))
    If boperresult <> 0 Then sp_String = "ERR 1012": GoTo err
    
    sTest = ""
    For n = 0 To 15
       sTest = sTest & Right("00" + hex(DataBuff32(n)), 2)
    Next n
    sp_LimtDate = Mid(sTest, 9, 8) '有效期
        
    If sp_Cardtype < 50 Then '  用户卡
    '---------------------------------------------------------------2
        boperresult = MIFARE_SelectCard(SerialNum(0))
        If boperresult <> 0 Then sp_String = "ERR 1000": GoTo err
        boperresult = MIFARE_LoginSector(2, 0, aKEY2(0)) 'S0
        If boperresult <> 0 Then sp_String = "ERR 1002": GoTo err
        boperresult = MIFARE_ReadValueBlock(9, siValue(0))
        If boperresult <> 0 Then sp_String = "ERR 1012": GoTo err
        sTest = ""
        m = 3
        For n = 0 To 3
           sTest = sTest & Right("00" + hex(siValue(m)), 2)
           m = m - 1
        Next n
        siValue9 = Hex2Dec(sTest) / 100
        
        boperresult = MIFARE_ReadValueBlock(10, siValue(0))
        If boperresult <> 0 Then sp_String = "ERR 1012": GoTo err
        sTest = ""
        m = 3
        For n = 0 To 3
           sTest = sTest & Right("00" + hex(siValue(m)), 2)
           m = m - 1
        Next n
        siValue10 = Hex2Dec(sTest) / 100
        
        If siValue9 > siValue10 Then
             sp_Balance = siValue10   '余额
        Else
             sp_Balance = siValue9
        End If
        
        '开通了月票的卡需要读取月票区信息
        '读卡的月票区信息
        If siMonth = 1 Then
            Dim yearn As Integer
            Dim yearnext As Integer
            Dim yi As Integer
            Dim i_mod As Integer
            Dim stB As Integer
            Dim MonthCount As Long
            Dim MonthCurTimes As Long
            Dim stN As Integer
            Dim sTimes As String
            Dim month0(16) As Byte
            Dim month1(16) As Byte
            Dim plCurTimes As Long
            Dim MonthBalance As Long
            plCurTimes = 0 '当前月次数
            MonthCount = 0 '总次数
            MonthCurTimes = 0 '当前月余次
            sp_String = "MonthTimes"
            yearn = Val(Format(Now, "yyyy"))
            yearnext = yearn + 1
            boperresult = MIFARE_SelectCard(SerialNum(0)) '----S1
            boperresult = MIFARE_LoginSector(7, 0, aKEY7(0))
            If boperresult <> 0 Then sp_String = "ERR 1020": GoTo err
            For yi = yearn To yearnext
                 i_mod = yi Mod 2 '
                 If i_mod = 0 Then '偶年
                    stB = 30
                 Else
                    stB = 29
                 End If
                 boperresult = MIFARE_ReadDataBlock(stB, DataBuff32(0))
                 If boperresult <> 0 Then sp_String = "ERR 1021": GoTo err
                 stN = 1
                 For i = 0 To 15
                     month0(i) = DataBuff32(i)
                 Next i
                 If yi = yearn And Val(Right(str(yi), 2)) = month0(0) Then '当前年充次信息
                     plCurTimes = month0(Val(month(Now))) '当前月充次次数
                     For stN = Val(month(Now)) To 12
                          If month0(stN) <> 0 Then
                                sTimes = month0(stN)
                                MonthCount = MonthCount + sTimes
                                '200707120
                                sp_String = sp_String + Trim(str(yearn)) + Format(str(stN), "00") + Format(sTimes, "000")
                          End If
                     Next stN
                 Else '次年充次信息
                     If Val(Right(str(yi), 2)) = month0(0) Then
                         For stN = 1 To 12
                              If month0(stN) <> 0 Then
                                    sTimes = month0(stN)
                                    MonthCount = MonthCount + sTimes
                                    sp_String = sp_String + Trim(str(yearn)) + Format(str(stN), "00") + Format(sTimes, "000")
                              End If
                         Next stN
                     End If
                 End If
             Next yi
             boperresult = MIFARE_SelectCard(SerialNum(0)) '----S8
             boperresult = MIFARE_LoginSector(8, 0, aKEY7(0))
             If boperresult <> 0 Then sp_String = "ERR 1022": GoTo err
             boperresult = MIFARE_ReadValueBlock(33, siValue(0))
             If boperresult <> 0 Then sp_String = "ERR 1023": GoTo err
             sTest = ""
             m = 3
             For n = 0 To 3
                sTest = sTest & Right("00" + hex(siValue(m)), 2)
                m = m - 1
             Next n
             siValue9 = Hex2Dec(sTest)
            
             boperresult = MIFARE_ReadValueBlock(34, siValue(0))
             If boperresult <> 0 Then sp_String = "ERR 1023": GoTo err
             sTest = ""
             m = 3
             For n = 0 To 3
                sTest = sTest & Right("00" + hex(siValue(m)), 2)
                m = m - 1
             Next n
             siValue10 = Hex2Dec(sTest)
            
             If siValue9 > siValue10 Then
                  MonthBalance = siValue10   '余额
             Else
                  MonthBalance = siValue9
             End If
             sp_MonthCountTimes = MonthBalance
'            If MonthBeforeMoney > 2000 Then
'                Print #1, "卡月票余次非法:卡号  " & CardNO_ASC & "  " & Now
'                MsgBox "卡余额非法！", vbCritical + vbOKOnly, "警告"
'
'                Exit Sub
'            End If

         '----计算前月余次
             If plCurTimes = 0 Then
                 MonthCurTimes = 0
             Else
                 If MonthBalance > MonthCount Then '当前月票钱包数大于当前月及以后月份的次数和
                    MonthCurTimes = plCurTimes '当前月余次
                 ElseIf MonthCount <= MonthBalance And MonthBalance > MonthCount - plCurTimes Then
                    MonthCurTimes = MonthBalance - MonthCount + plCurTimes
                 'ElseIf MonthCount <= MonthBeforeMoney > MonthCount - plCurTimes Then
                 End If
                
             End If
             sp_MonthCurTimes = MonthCurTimes
        End If
    Else '#--------控制卡
    End If
    boperresult = MIFARE_Halt()
    CardCheck = True
    Exit Function
err:
    If sp_String = "" Then
        sp_String = "ERR 0000" '& sTest '溢出"
    End If
    CardCheck = False
End Function

Function GetMAC(sp_in() As Byte, sp_out() As Byte) As Boolean  '计算MAC
    boperresult = MIFARE_SelectCard(SerialNum(0)) '物理卡号
    If boperresult <> 0 Then GoTo err
    
    aKEY1(0) = SerialNum(0)
    aKEY1(1) = SerialNum(1)
    aKEY1(2) = SerialNum(2)
    aKEY1(3) = SerialNum(3)
    aKEY1(4) = SerialNum(0)
    aKEY1(5) = SerialNum(1)
    
    stBuff(0) = &H80
    stBuff(1) = &H1A
    stBuff(2) = &H8
    stBuff(3) = &H10
    stBuff(4) = &H0
    boperresult = Sam1ExchangeApdu(stBuff(0), 5, stData(0), stLen) '初始化
    If boperresult <> 0 And Right("00" + hex(stData(0)), 2) <> "90" Then GoTo err
    
    stBuff(0) = &H80
    stBuff(1) = &HFA
    stBuff(2) = &H5
    stBuff(3) = &H0
    stBuff(4) = &H10
    For n = 0 To 7
        stBuff(n + 5) = &H0
    Next n
    stBuff(13) = &H7
    stBuff(14) = &H55
    stBuff(15) = SerialNum(0)
    stBuff(16) = SerialNum(1)
    stBuff(17) = SerialNum(2)
    stBuff(18) = SerialNum(3)
    stBuff(19) = sp_in(0) '卡流水
    stBuff(20) = sp_in(1)
    boperresult = Sam1ExchangeApdu(stBuff(0), 21, stData(0), stLen) '计算MAC
    If boperresult <> 0 And Right("00" + hex(stData(0)), 2) <> "61" Then GoTo err
   
    stBuff(0) = &H0
    stBuff(1) = &HC0
    stBuff(2) = &H0
    stBuff(3) = &H0
    stBuff(4) = &H4
    boperresult = Sam1ExchangeApdu(stBuff(0), 5, stData(0), stLen)
    If boperresult <> 0 And Right("00" + hex(stData(4)), 2) <> "90" Then GoTo err
    
    For n = 0 To 3
        sp_out(n) = stData(n)
    Next n
    GetMAC = True
    Exit Function
err:
    GetMAC = False
End Function

Function GetMACCJ(sp_in() As Byte, sp_out() As Byte) As Boolean  '计算MACCJ 建设部
    boperresult = MIFARE_SelectCard(SerialNum(0)) '物理卡号
    If boperresult <> 0 Then GoTo err
    
    aKEY1(0) = SerialNum(0)
    aKEY1(1) = SerialNum(1)
    aKEY1(2) = SerialNum(2)
    aKEY1(3) = SerialNum(3)
    aKEY1(4) = SerialNum(0)
    aKEY1(5) = SerialNum(1)
    
    stBuff(0) = &H0
    stBuff(1) = &HA4
    stBuff(2) = &H0
    stBuff(3) = &H0
    stBuff(4) = &H2
    stBuff(5) = &H10
    stBuff(6) = &H1
    boperresult = Sam1ExchangeApdu(stBuff(0), 7, stData(0), stLen) '选择文件
    If boperresult <> 0 And Right("00" + hex(stData(0)), 2) <> "90" Then GoTo err
    
    stBuff(0) = &H80
    stBuff(1) = &H40
    stBuff(2) = &H0
    stBuff(3) = &H0
    stBuff(4) = &H3
    stBuff(5) = &HB
    stBuff(6) = &H1
    stBuff(6) = &H0
    
    boperresult = Sam1ExchangeApdu(stBuff(0), 7, stData(0), stLen) '计算MAC
    If boperresult <> 0 And Right("0