mod_ccms.bas

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

For n = 0 To 15
   sTest = sTest & Right("00" + hex(DataBuff32(n)), 2)
Next n

On Error GoTo err1 '防止溢出
'L = 256
'sp_CardNo = DataBuff32(4) + DataBuff32(5) * L + DataBuff32(6) * L * L + DataBuff32(7) * L * L * L '卡号

sp_CardNo = Val(Right("00" + hex(DataBuff32(4)), 2) & Right("00" + hex(DataBuff32(5)), 2) & Right("00" + hex(DataBuff32(6)), 2) & Right("00" + hex(DataBuff32(7)), 2))

sp_Cardtype = DataBuff32(13) '卡类
If DataBuff32(12) = 4 Then sp_String = "ERR 1014": GoTo err '挂失卡

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 < 32 Then '  用户卡
    boperresult = MIFARE_SelectCard(SerialNum(0))
    If boperresult <> 0 Then sp_String = "ERR 1000": GoTo err
    boperresult = MIFARE_LoginSector(2, 0, aKEY2(0)) 'S0
    'boperresult = MIFARE_LoginSector(2, 0, mKEY(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
    
    '月票操作
    Dim ssMbz As String
    Dim ssDate As String
    Dim ssMonth As String
    Dim ssYearC As String
    Dim ssMonthC As String
    Dim ssTimes As String
    Dim ssData13(16) As Byte
    Dim ssData14(16) As Byte
    
    For n = 0 To 9
        boperresult = MIFARE_SelectCard(SerialNum(0))
        boperresult = MIFARE_LoginSector(3, 0, aKEY3(0)) 'S0
        If boperresult = 0 Then Exit For
    Next n
    If boperresult <> 0 Then sp_String = "ERR 1002": GoTo err
    
    For n = 0 To 9
        boperresult = MIFARE_ReadDataBlock(12, DataBuff32(0))
        If boperresult = 0 Then Exit For
    Next n
    If boperresult <> 0 Then sp_String = "ERR 1012": GoTo err
    
    smbz = Right("00" + hex(DataBuff32(0)), 2)
    If smbz = "11" Then
        For n = 0 To 9
            boperresult = MIFARE_ReadDataBlock(13, DataBuff32(0)) '正本
            If boperresult = 0 Then Exit For
        Next n
        If boperresult <> 0 Then sp_String = "ERR 1012": GoTo err
        sTest = ""
        For n = 0 To 15
           sTest = sTest & Right("00" + hex(DataBuff32(n)), 2)
           ssData13(n) = DataBuff32(n)
        Next n
    Else
        For n = 0 To 9
            boperresult = MIFARE_ReadDataBlock(14, DataBuff32(0)) '副本
            If boperresult = 0 Then Exit For
        Next n
        If boperresult <> 0 Then sp_String = "ERR 1012": GoTo err
        sTest = ""
        For n = 0 To 15
           sTest = sTest & Right("00" + hex(DataBuff32(n)), 2)
           ssData13(n) = DataBuff32(n)
        Next n
    End If
    
    If Mid(sTest, 1, 4) = "0000" Then '月票为初始值，未充次
        sp_Month = ""
    Else
        ssYearC = Format(Hex2Dec(Mid(sTest, 3, 2) & Mid(sTest, 1, 2)), "0000") '起始年
        ssMonthC = Format(Hex2Dec(Mid(sTest, 5, 2)), "00") '起始月
        ssTimes = Format(Hex2Dec(Mid(sTest, 7, 2)), "000") '起始月次
        sTest = ssYearC & ssMonthC & ssTimes
        For n = 0 To 10
            ssTimes = Format(ssData13(n + 4), "000") '月次
            If (Val(ssMonthC) + 1) > 12 Then
                ssMonthC = "01"
                ssYearC = Format(Val(ssYearC) + 1, "0000")
            Else
                ssMonthC = Format(Val(ssMonthC) + 1, "00")
            End If
            sTest = sTest & ssYearC & ssMonthC & ssTimes
        Next n
        sp_Month = sTest
    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()

R_Cardcheck = True
Exit Function

err:
R_Cardcheck = False
Exit Function

err1:
sp_String = "ERR 9999"
R_Cardcheck = False

End Function

Function R_ClearBlk() As Boolean '挂失卡解挂
Dim n As Integer
boperresult = MIFARE_SelectCard(SerialNum(0)) '检验是否是用户卡
boperresult = MIFARE_LoginSector(1, 0, aKEY1(0))
If boperresult <> 0 Then sp_String = "ERR 1002": GoTo err
boperresult = MIFARE_ReadDataBlock(4, DataBuff32(0))
If boperresult <> 0 Then sp_String = "ERR 1003": GoTo err

DataBuff32(12) = &H2
DataBuff32(15) = &H0 'XOR
For n = 0 To 14
    DataBuff32(15) = DataBuff32(15) Xor DataBuff32(n)
Next n
boperresult = MIFARE_WriteDataBlock(4, DataBuff32(0)) '发行区信息
If boperresult <> 0 Then sp_String = "ERR 1003": GoTo err

R_ClearBlk = True
Exit Function

err:
R_ClearBlk = False
End Function

'sp_cardid 卡流水号
'sp_string 返回值
'1111 计算密码错误
Function R_Cardsell(sp_Cardid As Long, sp_Cardtype As Integer, sp_LimtDate As String, sp_String As String) As Boolean '售卡
Dim spKeyPI(8) As Byte '加密因子
Dim spKeyID(8) As Byte '密码因子
Dim spKeyLA(8) As Byte '密码
'Dim sp_Cardid As String
Dim stNow As String
Dim i As Integer
Dim n As Integer
Dim SerialNumTmp(3) As Byte

sTest = Format(sp_Cardid, "00000000")
stCardNo(0) = "&h" + Mid(sTest, 1, 2)
stCardNo(1) = "&h" + Mid(sTest, 3, 2)
stCardNo(2) = "&h" + Mid(sTest, 5, 2)
stCardNo(3) = "&h" + Mid(sTest, 7, 2)

boperresult = MIFARE_SelectCard(SerialNumTmp(0))
If boperresult <> 0 Then sp_String = "ERR 1000": GoTo err
For n = 0 To 3
    If SerialNumTmp(n) <> SerialNum(n) Then sp_String = "ERR 1001": GoTo err '(与验卡操作不是同一张卡)
Next n

boperresult = MIFARE_LoginSector(1, 0, mKEY(0)) '
If boperresult <> 0 Then sp_String = "ERR 1002": GoTo err

DataBuff32(0) = "&H" & Mid(sKey, 1, 2) '密码因子前4字节
DataBuff32(1) = "&H" & Mid(sKey, 3, 2)
DataBuff32(2) = "&H" & Mid(sKey, 5, 2)
DataBuff32(3) = "&H" & Mid(sKey, 7, 2)
DataBuff32(4) = stCardNo(0) '卡流水号
DataBuff32(5) = stCardNo(1)
DataBuff32(6) = stCardNo(2)
DataBuff32(7) = stCardNo(3)
DataBuff32(8) = "&H" & Mid(sKey, 9, 2) '密码因子后4字节
DataBuff32(9) = "&H" & Mid(sKey, 11, 2)
DataBuff32(10) = "&H" & Mid(sKey, 13, 2)
DataBuff32(11) = "&H" & Mid(sKey, 15, 2)
DataBuff32(12) = &H2 '启用标志,1未启用 2 启用
DataBuff32(13) = sp_Cardtype '卡类
DataBuff32(14) = &H1 '密钥版本
DataBuff32(15) = &H0 'XOR
For n = 0 To 14
    DataBuff32(15) = DataBuff32(15) Xor DataBuff32(n)
Next n
boperresult = MIFARE_WriteDataBlock(4, DataBuff32(0)) '发行区信息
If boperresult <> 0 Then sp_String = "ERR 1003": GoTo err

stNow = Format(Now, "yyyymmdd")
DataBuff32(0) = "&H" + Mid(stNow, 1, 2)
DataBuff32(1) = "&H" + Mid(stNow, 3, 2)
DataBuff32(2) = "&H" + Mid(stNow, 5, 2)
DataBuff32(3) = "&H" + Mid(stNow, 7, 2)
If sp_LimtDate = "" Then
    DataBuff32(4) = &H20
    DataBuff32(5) = &H20
    DataBuff32(6) = &H1
    DataBuff32(7) = &H1
Else
    DataBuff32(4) = "&H" + Mid(sp_LimtDate, 1, 2)
    DataBuff32(5) = "&H" + Mid(sp_LimtDate, 3, 2)
    DataBuff32(6) = "&H" + Mid(sp_LimtDate, 5, 2)
    DataBuff32(7) = "&H" + Mid(sp_LimtDate, 7, 2)
End If
DataBuff32(8) = DataBuff32(0)
DataBuff32(9) = DataBuff32(1)
DataBuff32(10) = DataBuff32(2)
DataBuff32(11) = DataBuff32(3)
DataBuff32(12) = &H0
DataBuff32(13) = &H0
DataBuff32(14) = &H0
DataBuff32(15) = &H0 'XOR
For n = 0 To 14
    DataBuff32(15) = DataBuff32(15) Xor DataBuff32(n)
Next n
boperresult = MIFARE_WriteDataBlock(5, DataBuff32(0)) '发行日期、有效期、启用日期 卡压金(2)
If boperresult <> 0 Then sp_String = "ERR 1003": GoTo err

For i = 0 To 5
    DataBuff32(i) = aKEY1(i)
    DataBuff32(i + 10) = aKEY1(i)
Next i
DataBuff32(6) = &HFF
DataBuff32(7) = &H7
DataBuff32(8) = &H80
DataBuff32(9) = &H69

sTest = ""
For i = 0 To 15
    sTest = sTest & Right("00" + hex(DataBuff32(i)), 2)
Next i
boperresult = MIFARE_WriteDataBlock(7, DataBuff32(0)) '更新S1控制块
If boperresult <> 7 Then sp_String = "ERR 1003": GoTo err
boperresult = MIFARE_SelectCard(SerialNum(0))
boperresult = MIFARE_LoginSector(1, 0, aKEY1(0))
If boperresult <> 0 Then
    sp_String = "ERR 1002"
    GoTo err
End If
'----------------------------------------------------------钱包区
For n = 0 To 9
    boperresult = MIFARE_SelectCard(SerialNum(0))
    boperresult = MIFARE_LoginSector(2, 0, mKEY(0)) '
    If boperresult = 0 Then Exit For
Next n
If boperresult <> 0 Then GoTo errS1

siValue(0) = &H0 '初始化钱包默认值
siValue(1) = &H0
siValue(2) = &H0
siValue(3) = &H0