frm_xfjs.frm

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

End If

st = dc_card(ByVal icdev, &H1, pbOut(0))
If st <> 0 Then
      MsgBox "寻卡失败，请将卡放在IC卡读写器上！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
End If
    
CardID = Right("00" + hex(pbOut(0)), 2) + Right("00" + hex(pbOut(1)), 2) + Right("00" + hex(pbOut(2)), 2) + Right("00" + hex(pbOut(3)), 2)
sKey = "ffffffffffff"
sKeyPin = CardID & CardID
sN = 1
For i = 0 To 3
    skeyID(i) = "&h" + Mid(CardID, sN, 2)
    skeyID(i + 4) = "&H" + Mid(CardID, sN, 2)
    sN = sN + 2
Next i

skeyPI(0) = &H19
skeyPI(1) = &H76
skeyPI(2) = &H4
skeyPI(3) = &H19
For i = 0 To 3
    skeyPI(i + 4) = skeyPI(i)
Next i

st = ic_encrypt(skeyPI(0), skeyID(0), 8, skeyLA(0)) 'KEYA
If st <> 0 Then MsgBox "密钥计算错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
sKeyLast = ""
For i = 0 To 5
    sKeyLast = sKeyLast & Right("00" + hex(skeyLA(i)), 2)
Next i

st = dc_load_key_hex(ByVal icdev, 0, 1, ByVal sKey)
If st <> 0 Then MsgBox "密钥装载错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
st = dc_authentication(ByVal icdev, 0, 1)  '默认密钥验正1扇区密码
If st <> 0 Then
    st = dc_load_key_hex(ByVal icdev, 0, 1, ByVal sKeyLast)
    If st <> 0 Then MsgBox "密钥装载错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    st = dc_card(ByVal icdev, &H1, pbOut(0))
    st = dc_authentication(ByVal icdev, 0, 1)  '用户密钥验正1扇区密码
    If st <> 0 Then MsgBox "密钥验证错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    st = dc_read_hex(ByVal icdev, 4, DataBuff32)
    If st <> 0 Then MsgBox "读卡错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    
    sCardid = Mid(DataBuff32, 1, 8)
    '查询该卡状态，是否是挂失卡
    
    Set rs = GetRecordset(maSys_db, "select * from 会员信息表 where IC卡号='" & sCardid & "'")
    If rs.EOF Then
       MsgBox "未找到对应的会员IC卡信息！", vbInformation + vbOKOnly, "中芯德立提示信息"
       GoTo err
    Else
       If rs!备注 <> "启用" Then
            MsgBox "该会员IC卡已经挂失，请先解除挂失！", vbInformation + vbOKOnly, "中芯德立提示信息"
            GoTo err
       End If
    End If
    st = dc_readval(ByVal icdev, 5, rvalue) ''读值
    If st <> 0 Then MsgBox "读会员卡电子钱包错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    sBeforeMoney = rvalue / 100
'    sCardMissage = sCardMissage + Trim(Format(rvalue, "00000000"))
'    st = dc_readval(ByVal icdev, 6, rvalue) ''读值
'    If st <> 0 Then MsgBox "读会员卡积分错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
'    sBeforeTimes = rvalue
'    sCardMissage = sCardMissage + Trim(Format(rvalue, "00000000"))
    If sBeforeMoney < sMoney Then
        MsgBox "读会员卡电子钱包余额不够本次消费，请先充值！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    End If
    st = dc_beep(icdev, 20)
    cmdxfJS.Enabled = True
Else
    
    st = dc_beep(icdev, 20)
    MsgBox "该卡是新卡！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
End If

err:
st = dc_halt(ByVal icdev)
st = dc_reset(icdev, 10)
st = dc_exit(icdev)
icdev = -1

End Sub

Private Sub cmdxfJS_Click() '结算

If Option1 Then '收现金
    sType = Option1.Caption
    maSys_db.Execute "update 消费明细临时表 set 支付类型='" & Trim(sType) & "'" _
                   & ",备注='1' where 帐单号=" & Val(frm_xfmx.txtxfLS)
End If

If Option2 Then '电子钱包
    sType = Option2.Caption
    If MsgBox("请将IC卡放在读写器上！", vbInformation + vbYesNo, "中芯德立提示信息") <> vbYes Then Exit Sub
    'dc_decrement
    icdev = dc_init(100, 115200) ''打开读写器，建立连接
    If icdev < 0 Then
        icdev = dc_init(100, 115200)
        If icdev < 0 Then
            MsgBox "未检测到IC卡读写器，请检查！", vbInformation + vbOKOnly, "中芯德立提示信息": Exit Sub
        End If
    End If
    
    st = dc_card(ByVal icdev, &H1, pbOut(0))
    If st <> 0 Then
          MsgBox "寻卡失败，请将卡放在IC卡读写器上！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    End If
        
    CardID = Right("00" + hex(pbOut(0)), 2) + Right("00" + hex(pbOut(1)), 2) + Right("00" + hex(pbOut(2)), 2) + Right("00" + hex(pbOut(3)), 2)
    sKey = "ffffffffffff"
    sKeyPin = CardID & CardID
    sN = 1
    For i = 0 To 3
        skeyID(i) = "&H" + Mid(CardID, sN, 2)
        skeyID(i + 4) = "&H" + Mid(CardID, sN, 2)
        sN = sN + 2
    Next i
    
    skeyPI(0) = &H19
    skeyPI(1) = &H76
    skeyPI(2) = &H4
    skeyPI(3) = &H19
    For i = 0 To 3
        skeyPI(i + 4) = skeyPI(i)
    Next i
    
    st = ic_encrypt(skeyPI(0), skeyID(0), 8, skeyLA(0)) 'KEYA
    If st <> 0 Then MsgBox "密钥计算错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    sKeyLast = ""
    For i = 0 To 5
        sKeyLast = sKeyLast & Right("00" + hex(skeyLA(i)), 2)
    Next i
    
    st = dc_load_key_hex(ByVal icdev, 0, 1, ByVal sKeyLast)
    st = dc_authentication(ByVal icdev, 0, 1)  '验正1扇区密码
    If st <> 0 Then
          MsgBox "密钥认证错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    End If
    
    st = dc_decrement(ByVal icdev, 5, Val(sMoney) * 100) '块减值操作
    If st <> 0 Then MsgBox "电子钱包充值错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    
    st = dc_readval(ByVal icdev, 5, rvalue) ''读值
    If st <> 0 Then MsgBox "电子钱包读值错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    
    If rvalue <> (sBeforeMoney * 100 - sMoney * 100) Then '减值不成功
       st = dc_initval(ByVal icdev, 5, sBeforeMoney * 100) '恢复钱包
       MsgBox "充值不成功！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    End If
    txtAfterMoney = rvalue / 100
    maSys_db.Execute "update 会员信息表 set 卡上余额=" & txtAfterMoney & " where IC卡号='" & sCardid & "'"
    maSys_db.Execute "update 消费明细临时表 set 支付类型='" & Trim(sType) & "'" _
                   & ",卡上余额=" & txtAfterMoney & ",备注='1' where 帐单号=" & Val(frm_xfmx.txtxfLS)
    st = dc_beep(icdev, 20)
End If
MsgBox "结算成功！", vbInformation + vbOKOnly, "中芯德立提示信息"
st = dc_halt(ByVal icdev)
st = dc_reset(icdev, 10)
st = dc_exit(icdev)
icdev = -1
'    cmdicf.Enabled = False
Unload Me
Exit Sub
err:
    st = dc_halt(ByVal icdev)
    st = dc_reset(icdev, 10)
    st = dc_exit(icdev)
    icdev = -1
'    cmdicf.Enabled = False
    Unload Me
End Sub

'Private Sub Combo1_Click()
'sListNo = Combo1.ListIndex
'sHybhLast = sHybh(sListNo)
'End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
sMoney = 0
Label5.Caption = Label5.Caption + Trim(frm_xfmx.txtxfLS)
Set rs = GetRecordset(maSys_db, "select * from 消费明细临时表 where 帐单号=" & Val(frm_xfmx.txtxfLS) & " and 备注='0'")
If rs.EOF Then
   MsgBox "请选择未结算帐单！", vbInformation + vbOKOnly, "中芯德立提示信息"
   cmdxfJS.Enabled = False
   Exit Sub
Else
    rs.MoveFirst
    Do While Not rs.EOF
        sMoney = sMoney + rs!实收金额
        rs.MoveNext
    Loop
End If
Label2.Caption = Label2.Caption + "" + Trim(str(sMoney))
If Option1 Then
    cmdICC.Enabled = False
Else
    cmdICC.Enabled = True
End If

'Call sHymc
End Sub

'Private Sub sHymc()
'Set rs = GetRecordset(maSys_db, "select * from 会员信息表")
'If Not rs.EOF Then
'      Combo1.Clear
'      sListNo = 0
'      Do While Not rs.EOF
'         Combo1.AddItem Trim(rs!会员名称)
'         sHybh(sListNo) = rs!会员编号
'         sListNo = sListNo + 1
'         rs.MoveNext
'      Loop
'      Combo1.ListIndex = 0
'Else
'      Combo1.Clear
'      MsgBox "请先注册会员信息！", vbInformation + vbOKOnly, "中芯德立提示信息"
'End If
'End Sub

Private Sub Option1_Click()
cmdICC.Enabled = False
If sMoney <> 0 Then
cmdxfJS.Enabled = True
End If
End Sub

Private Sub Option2_Click()
If sMoney <> 0 Then
cmdICC.Enabled = True
End If
cmdxfJS.Enabled = False
End Sub

'Private Sub Option3_Click()
'cmdICC.Enabled = True
'cmdxfJS.Enabled = False
'End Sub

Private Sub txtxfK_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
     If Val(txtxfK) < sMoney Then
        MsgBox "输入错误，请重输入！", vbInformation + vbOKOnly, "中芯德立提示信息"
        txtxfK = ""
        txtxfK.SetFocus
        Exit Sub
     Else
        txtxfKL = txtxfK - sMoney
     End If
     
End If
If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 And KeyAscii <> 46 Then
        KeyAscii = 0
End If
End Sub

Private Sub txtxfK_LostFocus()
If Not Option1 Then Exit Sub
If Val(txtxfK) < sMoney Then
   MsgBox "输入错误，请重输入！", vbInformation + vbOKOnly, "中芯德立提示信息"
   txtxfK = ""
   txtxfK.SetFocus
   Exit Sub
Else
   txtxfKL = txtxfK - sMoney
End If
End Sub