mod_ccms.bas

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

Attribute VB_Name = "mod_ccms"
Public stMAC(3) As Byte
Public stCardNo(3) As Byte
Public mKEY(6) As Byte
Public aKEY0(6) As Byte
Public aKEY1(6) As Byte
Public aKEY2(6) As Byte
Public aKEY3(6) As Byte
Public aKEY7(6) As Byte
Public bKEY1(6) As Byte
Public bKEY2(6) As Byte
Public bKEY3(6) As Byte
Public bKEY7(6) As Byte
Public st8(8) As Byte
Public pbAuth(32) As Byte               '记录内容
Public DataBuff0(16) As Byte
Public DataBuffc(16) As Byte
Public DataBuff32(16) As Byte
Public sTest As String
Public stLen As Byte
Public stData(200) As Byte
Public stBuff(200) As Byte
Public stDataLen As Byte
Public siValue(3) As Byte
Public SerialNum(3) As Byte  '物理卡号缓冲
Public blOperResult As Boolean  '操作结果（Boolean）
Public mwst As Integer
Public sKey As String
Public sWhere As String
Public sLogin As String
Public str_Active As Integer
Public sErr As String
Public sSystem As String

Public Declare Function GetBusPosinfo Lib "postopc.dll" (ByVal hCom As Long, ByRef INfo As Byte) As Long
Public Declare Function OpenComm Lib "postopc.dll" (ByVal Port As Byte, ByVal BaudRate As Long) As Long
Public Declare Function CloseCom Lib "postopc.dll" (ByVal hCom As Long) As Long
Public Declare Function SetBusPosTime Lib "postopc.dll" (ByVal hCom As Long, ByVal Ctime As String) As Long
Public Declare Function GetCurData Lib "postopc.dll" (ByVal hCom As Long, ByVal PathName As String, ByVal FileName As String) As Long
Public Declare Function GetBusPosHisList Lib "postopc.dll" (ByVal hCom As Long, ByVal ListName As String) As Long
Public Declare Function GetHisData Lib "postopc.dll" (ByVal hCom As Long, ByVal PathName As String, ByVal FileName As String, ByVal FileNum As Byte) As Long
Public Declare Function DownloadBlacklist Lib "postopc.dll" (ByVal hCom As Long, ByVal BlackListFileName As String) As Long
Public Declare Function SetBusPosLine Lib "postopc.dll" (ByVal hCom As Long, ByVal lineinfo As String) As Long
Public Declare Function SetBusDeviceNO Lib "postopc.dll" (ByVal hCom As Long, ByVal DeviceNO As String) As Long
Public Declare Function GetCardSno Lib "postopc.dll" (ByVal hCom As Long, ByVal sno As String) As Long
Public Declare Function GetHansetData Lib "postopc.dll" (ByVal hCom As Long, ByVal PathName As String, ByVal FileName As String) As Long

Public PriceTable(31) As Byte

'基本函数
Declare Function Connection Lib "HYMifare.dll" (ByVal PortIdx As Long) As Boolean
Declare Function Disconnection Lib "HYMifare.dll" () As Boolean
'ConnectionUSBDevice
Declare Function ConnectionUSBDevice Lib "HYMifare.dll" () As Boolean
'蜂鸣器
Declare Function BuzzerSound Lib "HYMifare.dll" (ByVal sTime As Byte) As Byte
'SetTime
Declare Function SetTime Lib "HYMifare.dll" (ByVal hour As Byte, ByVal min As Byte, ByVal sec As Byte) As Byte
'SetDate
Declare Function SetDate Lib "HYMifare.dll" (ByVal year As Byte, ByVal month As Byte, ByVal day As Byte) As Byte
'读日期时间
Declare Function ReadTime Lib "HYMifare.dll" (ByRef sTime As Byte) As Byte
'LcdClear
Declare Function LcdClear Lib "HYMifare.dll" () As Boolean
'LcdEnglish  8*8
Declare Function LcdEnglish Lib "HYMifare.dll" (ByVal line As Byte, ByVal col As Byte, ByVal str As String) As Byte
'LcdLargeEnglish  8*16
Declare Function LcdLargeEnglish Lib "HYMifare.dll" (ByVal line As Byte, ByVal col As Byte, ByVal str As String) As Byte
'LcdChinese
Declare Function LcdChinese Lib "HYMifare.dll" (ByVal line As Byte, ByVal col As Byte, ByVal str As Byte) As Byte
'SetDisModel
Declare Function SetDisModel Lib "HYMifare.dll" (ByVal ss As Byte) As Byte

'M1卡操作函数－－－－－－－－－－－－－－－－－－－
'寻卡
Declare Function MIFARE_SelectCard Lib "HYMifare.dll" (ByRef SerialNum As Byte) As Byte
'验证卡
Declare Function MIFARE_LoginSector Lib "HYMifare.dll" (ByVal Sector As Byte, ByVal LoginType As Byte, ByRef pKey As Byte) As Byte
'读卡
Declare Function MIFARE_ReadDataBlock Lib "HYMifare.dll" (ByVal Block As Byte, ByRef pData As Byte) As Byte
'写卡
Declare Function MIFARE_WriteDataBlock Lib "HYMifare.dll" (ByVal Block As Byte, ByRef pData As Byte) As Byte

'读值
Declare Function MIFARE_ReadValueBlock Lib "HYMifare.dll" (ByVal Block As Byte, ByRef pData As Byte) As Byte
'写值
Declare Function MIFARE_WriteValueBlock Lib "HYMifare.dll" (ByVal Block As Byte, ByRef pData As Byte) As Byte
'增值
Declare Function MIFARE_IncrementValue Lib "HYMifare.dll" (ByVal Block As Byte, ByRef pData As Byte) As Byte
'减值
Declare Function MIFARE_DecrementValue Lib "HYMifare.dll" (ByVal Block As Byte, ByRef pData As Byte) As Byte
Declare Function MIFARE_Halt Lib "HYMifare.dll" () As Boolean
'键盘函数---------------------------------------
Declare Function InputPassword Lib "HYMifare.dll" (ByVal Prompt As Byte, ByRef rPassword As Byte, ByRef rlen As Byte) As Byte

'SetSam1BaudRate
'Sam1PowerUp
'Sam1ExchangeApdu
'Sam1PowerDown
Declare Function SetSam1BaudRate Lib "HYMifare.dll" (ByVal BaudRate As Byte) As Byte
Declare Function Sam1PowerUp Lib "HYMifare.dll" (ByRef ATR As Byte, ByRef rlen As Byte) As Byte
Declare Function Sam1ExchangeApdu Lib "HYMifare.dll" (ByRef sData As Byte, ByVal sLen As Byte, ByRef rData As Byte, ByRef rlen As Byte) As Byte
Declare Function Sam1PowerDown Lib "HYMifare.dll" () As Boolean
'SetICCBaudRate
Declare Function SetICCBaudRate Lib "HYMifare.dll" (ByVal BaudRate As Byte) As Byte
Declare Function IccPowerUp Lib "HYMifare.dll" (ByRef ATR As Byte, ByRef rlen As Byte) As Byte
Declare Function IccExchangeApdu Lib "HYMifare.dll" (ByRef sData As Byte, ByVal sLen As Byte, ByRef rData As Byte, ByRef rlen As Byte) As Byte
Declare Function IccPowerDown Lib "HYMifare.dll" () As Boolean

Declare Function SetSam2BaudRate Lib "HYMifare.dll" (ByVal BaudRate As Byte) As Byte
Declare Function Sam2PowerUp Lib "HYMifare.dll" (ByRef ATR As Byte, ByRef rlen As Byte) As Byte
Declare Function Sam2ExchangeApdu Lib "HYMifare.dll" (ByRef sData As Byte, ByVal sLen As Byte, ByRef rData As Byte, ByRef rlen As Byte) As Byte
Declare Function Sam2PowerDown Lib "HYMifare.dll" () As Boolean
'
Declare Function hex_asc% Lib "mwic_32.dll" (ByRef hex As Byte, ByVal asc$, ByVal le&)
'Declare Function ic_encrypt% Lib "mwic_32.dll" (ByRef key As Byte, ByRef sorc As Byte, ByVal le%, ByRef ptrdest As Byte)
'Declare Function ic_decrypt% Lib "mwic_32.dll" (ByRef key As Byte, ByRef des As Byte, ByVal le%, ByRef pretest As Byte)

Function SystemInit() As Boolean '系统变量初始化
    aKEY0(0) = &HA0 '0扇区应用密码
    aKEY0(1) = &HA1
    aKEY0(2) = &HA2
    aKEY0(3) = &HA3
    aKEY0(4) = &HA4
    aKEY0(5) = &HA5
    
'    mKEY(0) = &HFF '出厂卡默认卡密码
'    mKEY(1) = &HFF
'    mKEY(2) = &HFF
'    mKEY(3) = &HFF
'    mKEY(4) = &HFF
'    mKEY(5) = &HFF
    
    mKEY(0) = &HA0 '出厂卡默认卡密码
    mKEY(1) = &HA1
    mKEY(2) = &HA2
    mKEY(3) = &HA3
    mKEY(4) = &HA4
    mKEY(5) = &HA5
    
    For n = 0 To 15 '出厂卡默认值，控制块数据
        DataBuffc(n) = &HFF
    Next n
    DataBuffc(0) = &HA0
    DataBuffc(1) = &HA1
    DataBuffc(2) = &HA2
    DataBuffc(3) = &HA3
    DataBuffc(4) = &HA4
    DataBuffc(5) = &HA5
    
    DataBuffc(7) = &H7
    DataBuffc(8) = &H80
    DataBuffc(9) = &H69
    
    For n = 0 To 15
        DataBuff0(n) = &H0
    Next n
End Function

Function ReaderOpen() As Boolean '打开端口
    blOperResult = ConnectionUSBDevice()
    If blOperResult Then
        ReaderOpen = True
    Else
        ReaderOpen = False
    End If
End Function

Function ReaderClose() As Boolean '关闭端口
    blOperResult = Disconnection()
    If blOperResult Then
        ReaderClose = True
    Else
        ReaderClose = False
    End If
End Function

Function ReaderSound(sp_Time As Byte) As Boolean '蜂鸣器
    boperresult = BuzzerSound(sp_Time)
End Function

'sp_key 密码因子,为空时表示读系统密码因子
'sp_string 返回值
'1111 计算密码错误
Function R_CardKey(sp_Key As String, sp_String As String) As Boolean '生成密码卡,读密码因子
Dim spKeyPI(8) As Byte '加密因子
Dim spKeyID(8) As Byte '密码因子
Dim spKeyLA(8) As Byte '密码
Dim i As Integer
Dim n As Integer
    boperresult = MIFARE_SelectCard(SerialNum(0))
    If boperresult <> 0 Then sp_String = "ERR 1000": GoTo err
If sp_Key <> "" Then

'    boperresult = MIFARE_SelectCard(SerialNum(0))
'    If boperresult <> 0 Then sp_String = "ERR 1000": GoTo err
    
    boperresult = MIFARE_LoginSector(1, 0, mKEY(0)) '
    If boperresult <> 0 Then sp_String = "ERR 1002": GoTo err
'    sp_Key = "1234567812345678"
    DataBuff32(0) = "&H" & Mid(sp_Key, 1, 2) '密码因子前4字节
    DataBuff32(1) = "&H" & Mid(sp_Key, 3, 2)
    DataBuff32(2) = "&H" & Mid(sp_Key, 5, 2)
    DataBuff32(3) = "&H" & Mid(sp_Key, 7, 2)
    DataBuff32(4) = &H0 '卡流水号
    DataBuff32(5) = &H0
    DataBuff32(6) = &H0
    DataBuff32(7) = &H0
    DataBuff32(8) = "&H" & Mid(sp_Key, 9, 2) '密码因子后4字节
    DataBuff32(9) = "&H" & Mid(sp_Key, 11, 2)
    DataBuff32(10) = "&H" & Mid(sp_Key, 13, 2)
    DataBuff32(11) = "&H" & Mid(sp_Key, 15, 2)
    DataBuff32(12) = &H2 '启用标志,1未启用 2 启用
    DataBuff32(13) = &H20 '卡类32
    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)
    
    DataBuff32(4) = &H20
    DataBuff32(5) = &H20
    DataBuff32(6) = &H1
    DataBuff32(7) = &H1
    
    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
End If

For i = 0 To 3
    spKeyID(i) = SerialNum(i) 'SerialNum
    spKeyID(i + 4) = SerialNum(i)
Next i
spKeyPI(0) = &HB0
spKeyPI(1) = &HA0
spKeyPI(2) = &HB1
spKeyPI(3) = &HA1
spKeyPI(4) = &H19
spKeyPI(5) = &H76
spKeyPI(6) = &H4
spKeyPI(7) = &H19
st = ic_encrypt(spKeyPI(0), spKeyID(0), 8, spKeyLA(0)) 'KEYA
If st <> 0 Then sp_String = "ERR 1111": GoTo err

sp_String = ""
For i = 0 To 7
    sp_String = sp_String & Right("00" + hex(spKeyLA(i)), 2)
Next i
    
For i = 0 To 5
    bKEY1(i) = spKeyLA(i)
    DataBuff32(i) = spKeyLA(i)
    DataBuff32(i + 10) = spKeyLA(i)
Next i
If sp_Key <> "" Then
    DataBuff32(6) = &HFF
    DataBuff32(7) = &H7
    DataBuff32(8) = &H80
    DataBuff32(9) = &H69
    boperresult = MIFARE_WriteDataBlock(7, DataBuff32(0)) '更新S0控制块
    If boperresult <> 7 Then sp_String = "ERR 1003": GoTo err
    boperresult = MIFARE_SelectCard(SerialNum(0))
    boperresult = MIFARE_LoginSector(1, 0, bKEY1(0))
    If boperresult <> 0 Then sp_String = "ERR 1002": GoTo err
Else
    boperresult = MIFARE_SelectCard(SerialNum(0))
    boperresult = MIFARE_LoginSector(1, 0, bKEY1(0))
    If boperresult <> 0 Then sp_String = "ERR 1002": GoTo err
    boperresult = MIFARE_ReadDataBlock(4, DataBuff32(0))
    If boperresult <> 0 Then sp_String = "ERR 1012": GoTo err
    sp_String = ""
    For i = 0 To 15
        sp_String = sp_String & Right("00" + hex(DataBuff32(i)), 2)
    Next i
End If
R_CardKey = True
Exit Function

err:
R_CardKey = False
End Function

'sp_key 密码因子8字节，
'sp_cardid 卡流水号
'sp_string 返回值
'1111 计算密码错误
'9999 溢出
Function R_Cardcheck(sp_Key As String, sp_CardNo As Long, sp_Cardtype As Integer, sp_Balance As Currency, sp_LimtDate As String, sp_Month As String, sp_String As String) As Boolean '验卡
Dim spKeyPI(8) As Byte '加密因子
Dim spKeyID(8) As Byte '密码因子
Dim spKeyLA(8) As Byte '密码
Dim stNow As String
Dim i As Integer
Dim n As Integer
boperresult = MIFARE_SelectCard(SerialNum(0))
If boperresult <> 0 Then sp_String = "ERR 1000": GoTo err
For i = 0 To 3
    spKeyID(i) = SerialNum(i)
    spKeyID(i + 4) = SerialNum(i)
Next i
spKeyPI(0) = "&H" + Mid(sp_Key, 1, 2)
spKeyPI(1) = "&H" + Mid(sp_Key, 3, 2)
spKeyPI(2) = "&H" + Mid(sp_Key, 5, 2)
spKeyPI(3) = "&H" + Mid(sp_Key, 7, 2)
spKeyPI(4) = "&H" + Mid(sp_Key, 9, 2)
spKeyPI(5) = "&H" + Mid(sp_Key, 11, 2)
spKeyPI(6) = "&H" + Mid(sp_Key, 13, 2)
spKeyPI(7) = "&H" + Mid(sp_Key, 15, 2)

st = ic_encrypt(spKeyPI(0), spKeyID(0), 8, spKeyLA(0)) 's1keya=s1keyb 物理卡号+物理卡号 与密码因子DES加密
If st <> 0 Then sp_String = "ERR 1111": GoTo err
For i = 0 To 5
    aKEY1(i) = spKeyLA(i)
Next i

spKeyPI(0) = "&H" + Mid(sp_Key, 1, 2)
spKeyPI(1) = "&H" + Mid(sp_Key, 3, 2)
spKeyPI(2) = "&H" + Mid(sp_Key, 5, 2)
spKeyPI(3) = "&H" + Mid(sp_Key, 7, 2)
spKeyPI(4) = "&H" + Mid(sp_Key, 9, 2)
spKeyPI(5) = "&H" + Mid(sp_Key, 11, 2)
spKeyPI(6) = "&H" + Mid(sp_Key, 13, 2)
spKeyPI(7) = "&H" + Mid(sp_Key, 15, 2)
spKeyID(0) = SerialNum(0)
spKeyID(1) = SerialNum(1)
spKeyID(2) = SerialNum(2)
spKeyID(3) = SerialNum(3)
spKeyID(4) = &H7
spKeyID(5) = &H55
spKeyID(6) = &H3
spKeyID(7) = &H26
st = ic_encrypt(spKeyPI(0), spKeyID(0), 8, spKeyLA(0)) 's2KEYA
If st <> 0 Then sp_String = "ERR 1111": GoTo err
For i = 0 To 5
    aKEY2(i) = spKeyLA(i)
    aKEY3(i) = spKeyLA(i)
Next i

spKeyID(0) = SerialNum(0)
spKeyID(1) = SerialNum(1)
spKeyID(2) = SerialNum(2)
spKeyID(3) = SerialNum(3)
spKeyID(4) = &H7
spKeyID(5) = &H55
spKeyID(6) = &H9
spKeyID(7) = &H11
st = ic_encrypt(spKeyPI(0), spKeyID(0), 8, spKeyLA(0)) 's2KEYB
If st <> 0 Then sp_String = "ERR 1111": GoTo err
For i = 0 To 5
    bKEY2(i) = spKeyLA(i)
    bKEY3(i) = spKeyLA(i)
Next i

boperresult = MIFARE_LoginSector(1, 0, mKEY(0)) '先检验是不是出厂卡
If boperresult = 0 Then sp_String = "ERR 1010": GoTo err

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
stCardNo(0) = DataBuff32(4)
stCardNo(1) = DataBuff32(5)
stCardNo(2) = DataBuff32(6)
stCardNo(3) = DataBuff32(7)
sTest = ""