mod_ccms.bas

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

If boperresult = 7 Or boperresult = 13 Then
Else
    GoTo errS1
End If

For i = 0 To 9 '恢复发行区出厂值密码
    boperresult = MIFARE_SelectCard(SerialNumTmp(0))
    boperresult = MIFARE_LoginSector(1, 0, aKEY1(0))
    If boperresult = 0 Then Exit For
Next i
If boperresult <> 0 Then GoTo errS2
For i = 0 To 9
    boperresult = MIFARE_WriteDataBlock(7, DataBuffc(0))
    If boperresult = 7 Or boperresult = 13 Then Exit For
Next i
If boperresult = 7 Or boperresult = 13 Then
Else
    GoTo errS2
End If
R_Carddel = True
Exit Function

errS1:
For i = 0 To 9
    boperresult = MIFARE_LoginSector(2, 0, mKEY(0))
    If boperresult = 0 Then Exit For
Next i
If boperresult <> 0 Then GoTo err
For i = 0 To 9
    boperresult = MIFARE_WriteDataBlock(11, spKey(0))
    If boperresult = 7 Or boperresult = 13 Then Exit For
Next i
GoTo err
Exit Function

errS2:
For i = 0 To 9
    boperresult = MIFARE_LoginSector(2, 0, mKEY(0))
    If boperresult = 0 Then Exit For
Next i
If boperresult <> 0 Then GoTo err
For i = 0 To 9
    boperresult = MIFARE_WriteDataBlock(11, spKey(0))
    If boperresult = 7 Or boperresult = 13 Then Exit For
Next i

For i = 0 To 9
    boperresult = MIFARE_LoginSector(3, 0, mKEY(0))
    If boperresult = 0 Then Exit For
Next i
If boperresult <> 0 Then GoTo err
For i = 0 To 9
    boperresult = MIFARE_WriteDataBlock(15, spKey(0))
    If boperresult = 7 Or boperresult = 13 Then Exit For
Next i
GoTo err
Exit Function

err:
R_Carddel = False
End Function

'sp_CardNo 用户卡流水号
'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错误

Function R_CardFull(sp_AddMoney As Currency, sp_BeforeMoney As Currency, sp_AfterMoney As Currency, sp_String As String) As Boolean '充值
Dim spKeyPI(8) As Byte '加密因子
Dim spKeyID(8) As Byte '密码因子
Dim spKeyLA(8) As Byte '密
Dim SerialNumTmp(3) As Byte
Dim n As Integer
Dim siValueB10(3) As Byte
Dim siValueRead9(3) As Byte
Dim siValueRead10(3) As Byte
Dim siMoney9 As Currency
Dim siMoney10 As Currency
Dim siAfterMoney As Currency
Dim m As Integer
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

siAfterMoney = sp_BeforeMoney + sp_AddMoney '充值后金额
If siAfterMoney < 0 Then sp_String = "ERR 1032": GoTo err  '(如果充正金额大于卡原余额，则中止操作)

'充值金额处理
If sp_AddMoney < 0 Then
    sTest = hex(CDbl(-Val(sp_AddMoney) * 100))
Else
    sTest = hex(CDbl(Val(sp_AddMoney) * 100))
End If
If Len(sTest) <= 8 Then
    Do While Not Len(sTest) = 8
        sTest = "0" + sTest
    Loop
End If
siValue(3) = "&H" + Mid(sTest, 1, 2)
siValue(2) = "&H" + Mid(sTest, 3, 2)
siValue(1) = "&H" + Mid(sTest, 5, 2)
siValue(0) = "&H" + Mid(sTest, 7, 2)
For n = 0 To 3
    siValueB10(n) = siValue(n)
Next n

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

If sp_AddMoney > 0 Then '充值
    boperresult = MIFARE_IncrementValue(9, siValue(0))
    If boperresult <> 0 Then sp_String = "ERR 1016": GoTo err
    boperresult = MIFARE_IncrementValue(10, siValueB10(0))
Else '充正
    boperresult = MIFARE_DecrementValue(9, siValue(0))
    If boperresult <> 0 Then sp_String = "ERR 1016": GoTo err
    boperresult = MIFARE_DecrementValue(10, siValueB10(0))
End If

boperresult = MIFARE_ReadValueBlock(9, siValueRead9(0))
sTest = ""
m = 3
For n = 0 To 3
   sTest = sTest & Right("00" + hex(siValueRead9(m)), 2)
   m = m - 1
Next n
siMoney9 = Hex2Dec(sTest) / 100

boperresult = MIFARE_ReadValueBlock(10, siValueRead10(0))
sTest = ""
m = 3
For n = 0 To 3
   sTest = sTest & Right("00" + hex(siValueRead10(m)), 2)
   m = m - 1
Next n
siMoney10 = Hex2Dec(sTest) / 100
If siMoney9 > siMoney10 Then
    siMoney9 = siMoney10
End If

If siAfterMoney <> siMoney9 Then '钱包不正常充值,恢复钱包到交易前状态
    If siMoney9 = sp_BeforeMoney Then sp_String = "ERR 1017": GoTo err
    sTest = hex(CDbl(Val(sp_BeforeMoney) * 100))
    If Len(sTest) <= 8 Then
        Do While Not Len(sTest) = 8
            sTest = "0" + sTest
        Loop
    End If
    siValue(3) = "&H" + Mid(sTest, 1, 2)
    siValue(2) = "&H" + Mid(sTest, 3, 2)
    siValue(1) = "&H" + Mid(sTest, 5, 2)
    siValue(0) = "&H" + Mid(sTest, 7, 2)
    boperresult = MIFARE_SelectCard(SerialNum(0))
    boperresult = MIFARE_LoginSector(2, 1, bKEY2(0))
    boperresult = MIFARE_WriteValueBlock(9, siValue(0))
    If boperresult <> 0 Then
        boperresult = MIFARE_WriteValueBlock(10, siValue(0))
        If boperresult <> 0 Then
             sp_String = "ERR 1018": GoTo err '错误未恢复
        End If
    End If
    sp_String = "ERR 1017" '正常恢复
    GoTo err
End If
sp_AfterMoney = siAfterMoney
R_CardFull = True
Exit Function

err:
     R_CardFull = False
End Function

'sp_CardNo 用户卡流水号
'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错误

Function R_CardMonth(sp_Month As String, sp_String As String) As Boolean '充次

Dim SerialNumTmp(3) As Byte
Dim spMonth(16) As Byte
Dim ssBZ As String
Dim n As Integer
Dim i As Integer


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

For i = 0 To 9
    boperresult = MIFARE_LoginSector(3, 1, bKEY3(0))
    If boperresult = 0 Then Exit For
Next i
If boperresult <> 0 Then sp_String = "ERR 1022": GoTo err
   
For i = 0 To 9
    boperresult = MIFARE_WriteDataBlock(12, DataBuff0(0)) '将标志改为00
    If boperresult = 0 Then Exit For
Next i
If boperresult <> 0 Then sp_String = "ERR 1003": GoTo err
    
i = 1
For n = 0 To 15
    DataBuff32(n) = "&h" & Mid(sp_Month, i, 2)
    i = i + 2
Next n

For i = 0 To 9
    boperresult = MIFARE_WriteDataBlock(13, DataBuff32(0)) '更改正本
    If boperresult = 0 Then Exit For
Next i
If boperresult <> 0 Then sp_String = "ERR 1003": GoTo err

spMonth(0) = &H11
For i = 1 To 15
    spMonth(i) = &H0
Next i
For i = 0 To 14
    spMonth(15) = spMonth(15) Xor spMonth(i)
Next i
For i = 0 To 9
    boperresult = MIFARE_WriteDataBlock(12, spMonth(0)) '将标志改为11
    If boperresult = 0 Then Exit For
Next i
If boperresult <> 0 Then sp_String = "ERR 1003": GoTo err
For i = 0 To 9
    boperresult = MIFARE_WriteDataBlock(14, DataBuff32(0)) '更改副本
    If boperresult = 0 Then Exit For
Next i
'If boperresult <> 0 Then sp_String = "ERR 1003": GoTo err
R_CardMonth = True
Exit Function

err:
     R_CardMonth = False
End Function

Function ReadOld65(sp_Balance As Currency, sp_String As String) As Boolean '读8扇区钱包余额
    Dim m As Integer
    Dim siValue9 As Currency
    Dim siValue10 As Currency
    
    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
         sp_Balance = siValue10   '余额
    Else
         sp_Balance = siValue9
    End If
    ReadOld65 = True
    Exit Function
err:
    ReadOld65 = False
End Function

'sp_pin 认证卡密码
'sp_OperatorID 认证卡卡号
'sp_String 错误信息
'ERR 2000 ISAM复位错误
'ERR 2001 ISAM选择文件错误
'ERR 2002 ISAM取随机数据错误
'ERR 2003 ISAM外部认证
'ERR 3001 认证卡复位错误
'ERR 3002 校验密码
'ERR 3003 认证卡内部认证
'ERR 3004 认证卡取响应
'
Function PINCRC(sp_pin() As Byte, sp_OperatorID As String, sp_String As String) As Boolean '认证
    Dim ps As String
    boperresult = Sam1PowerUp(stBuff(0), stLen) 'ISAM复位
    If boperresult <> 0 Then sp_String = "ERR 2000": GoTo err
    
    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) 'ISAM选文件
    If boperresult <> 0 Then sp_String = "ERR 2001": GoTo err
    
    stBuff(0) = &H0
    stBuff(1) = &H84
    stBuff(2) = &H0
    stBuff(3) = &H0
    stBuff(4) = &H8
    boperresult = Sam1ExchangeApdu(stBuff(0), 5, stData(0), stLen) 'ISAM取随机数
    If boperresult <> 0 Then sp_String = "ERR 2002": GoTo err
    
    For n = 0 To 7
        st8(n) = stData(n)
    Next n
    
    boperresult = IccPowerUp(stBuff(0), stLen) '认证卡复位
    If boperresult <> 0 Then sp_String = "ERR 3001": GoTo err
    
    sTest = ""
    For n = 0 To stLen
       sTest = sTest & Right("00" + hex(stBuff(n)), 2)
    Next n
    sp_OperatorID = Mid(sTest, 29, 8)
    
    '
    stBuff(0) = &H0
    stBuff(1) = &H20
    stBuff(2) = &H0
    stBuff(3) = &H0
    stBuff(4) = &H3
    stBuff(5) = sp_pin(0)
    stBuff(6) = sp_pin(1)
    stBuff(7) = sp_pin(2)
    boperresult = IccExchangeApdu(stBuff(0), 8, stData(0), stLen)
    If boperresult <> 0 Then sp_String = "ERR 3002": GoTo err
    ps = Right("00" + hex(stData(0)), 2) + Right("00" + hex(stData(1)), 2)
    If ps <> "9000" Then sp_String = "3002": GoTo err
    '00 88 00 01 08 DATA
    stBuff(0) = &H0
    stBuff(1) = &H88
    stBuff(2) = &H0
    stBuff(3) = &H1
    stBuff(4) = &H8
    
    For n = 0 To 7
        stBuff(n + 5) = st8(n)
    Next n
    
    boperresult = IccExchangeApdu(stBuff(0), 13, stData(0), stLen) '认证卡内部认证
    If boperresult <> 0 Then sp_String = "ERR 3003": GoTo err
    
    stBuff(0) = &H0
    stBuff(1) = &HC0
    stBuff(2) = &H0
    stBuff(3) = &H0
    stBuff(4) = &H8
    boperresult = IccExchangeApdu(stBuff(0), 5, stData(0), stLen) '取响应
    If boperresult <> 0 Then sp_String = "ERR 3004": GoTo err
    
    For n = 0 To 7
        st8(n) = stData(n)
    Next n
    
    stBuff(0) = &H0
    stBuff(1) = &H82
    stBuff(2) = &H0