frmcpucardq.frm

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

        txtNewUserID.Text = Mid(databuff32, 1, 8)
        Set rs = GetRecordset(maSys_db, "select *  from LinkUser_Dict where M1_CardID='" & Trim(txtNewUserID) & "'")
        If Not (rs.EOF And rs.BOF) Then
            txtName.Text = rs.Fields("cname")
        Else
            MsgBox "该卡号在数据库中不存在，请检查！", vbInformation + vbOKOnly, "提示"
            Exit Sub
        End If
        For i = 0 To 3
            st = rf_readval(ByVal icdev, 58, rvalue) ''读值
            If st = 0 Then Exit For
        Next
        stMoneyOld.Text = rvalue / 100
        
        st = rf_halt(ByVal icdev)
        st = rf_beep(icdev, 30)
        
       
        
        listrecord
        cmdDel.Enabled = True
        stMoney.Text = ""
        stMoney.SetFocus
'''''
'''''        If MsgBox("请将新的M1卡放在读写器上！", vbQuestion + vbYesNo, "提示") <> vbYes Then
'''''            Exit Sub
'''''        End If
'''''
'''''        Set rs = GetRecordset(maSys_db, "select *  from LinkUser_Dict where M1_CardID='" & Trim(txtNewUserID) & "'")
'''''        If Not (rs.EOF And rs.BOF) Then
'''''            MsgBox "该卡号在数据库中已经存在，请检查！", vbInformation + vbOKOnly, "提示"
'''''        Else
'''''''            M1Key = "ffffffffffff"
'''''''            For i = 0 To 3
'''''''                st = rf_load_key_hex(ByVal icdev, 0, 14, ByVal M1Key)
'''''''                If st = 0 Then Exit For
'''''''            Next
'''''''''            If MsgBox("确认要发行卡号为" & txtNewUserID & "的新卡吗?", vbQuestion + vbYesNo, "提示") <> vbYes Then
'''''''''                 Exit Sub
'''''''''            End If
'''''            txtMoney = 0
'''''            M1Key = "e0e1e2e3e4e5"
'''''            For i = 0 To 3
'''''                st = rf_load_key_hex(ByVal icdev, 0, 14, ByVal M1Key)
'''''                If st = 0 Then Exit For
'''''            Next
'''''
'''''            For i = 0 To 3
'''''                st = rf_card(ByVal icdev, 1, pbout(0))
'''''                If st = 0 Then Exit For
'''''            Next
'''''
'''''            For i = 0 To 3
'''''                st = rf_authentication(ByVal icdev, 0, 14)  '验正14扇区密码
'''''                If st = 0 Then Exit For
'''''                If i = 4 And st <> 0 Then
'''''                      MsgBox "验证密钥错误，请检查！", vbInformation + vbOKOnly, "提示"
'''''                      Exit Sub
'''''                End If
'''''            Next
'''''
'''''            data32 = txtNewUserID & "ffffffffff1234567890ffff"
'''''            st = rf_write_hex(ByVal icdev, 57, ByVal data32)
'''''
'''''            'st = rf_read_hex(ByVal icdev, 57, databuff32)
'''''
'''''            For i = 0 To 3
'''''                st = rf_initval(ByVal icdev, 58, ByVal txtMoney)  '初始化块值
'''''                If st = 0 Then Exit For
'''''            Next
'''''''
'''''''            For i = 0 To 3
'''''''                st = rf_readval(ByVal icdev, 9, rvalue) ''读值
'''''''                If st = 0 Then Exit For
'''''''            Next
'''''''            fullAfter1 = rvalue
'''''''
'''''''            For i = 0 To 3
'''''''                st = rf_readval(ByVal icdev, 10, rvalue) ''读值
'''''''                If st = 0 Then Exit For
'''''''            Next
'''''''            fullafter2 = rvalue
''''            st = rf_halt(ByVal icdev)
            
'''''''            If fullAfter1 = fullafter2 And fullAfter1 = txtMoneyOld Then '''''''''''''''充正成功
            
''''''''                maSys_db.Execute "delete from cardfullp", dbFailOnError '充正后删除
''''''''
''''''''                psRecord.Open "select * from list", maSys_db, 3, 3
''''''''                psRecord.AddNew
''''''''                psRecord.Fields("cpu_cardid") = Format(Val(CpuCardID), "00000000") '8
''''''''                psRecord.Fields("user_id") = Format(Trim(txtUser), "00000000") '8
''''''''                psRecord.Fields("m1_readerno") = Format(Val(CpuCardID), "00000000")  '08
''''''''                psRecord.Fields("m1_cardid") = Format(CardNO_ASC, "000000000000") '8
''''''''                psRecord.Fields("m1_cardtype") = CardType
''''''''                psRecord.Fields("m1_addmoney") = -Val(txtAddmoneyOld) / 100
''''''''                psRecord.Fields("m1_balance") = Val(fullAfter1 / 100)
''''''''                psRecord.Fields("m1_balance_old") = Val(fullBefore)
''''''''                txtCdate = Format(Now, "yyyy-mm-dd")
''''''''                txtCtime = Format(Now, "hh:mm:ss")
''''''''                psRecord.Fields("m1_cdate") = txtCdate
''''''''                psRecord.Fields("m1_ctime") = txtCtime
''''''''                psRecord.Fields("r_send") = "00"
''''''''                psRecord.Update
''''''''                psRecord.Close

''''
''''            pscard.Open "select * from LinkUser_Dict", maSys_db, 3, 3
''''            pscard.AddNew
''''            pscard.Fields("M1_CardID") = Trim(txtNewUserID) '8
''''            pscard.Fields("Cname") = Trim(txtName.Text) '10
''''            pscard.Fields("Cdate") = Format(Now, "yyyy-mm-dd hh:mm:ss")
''''            pscard.Update
''''            pscard.Close
''''''''''            pssql = "insert LinkUserH_Dict(Cpu_CardID,Cstate,Cdate)  values( " & _
''''''''''                     "'" & Trim(txtNewUserID) & "','" & Trim(comboState.Text) & "','" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "')"
''''''''''            maSys_db.Execute pssql
''''            MsgBox "发卡成功，ID号为：" & Trim(txtNewUserID), vbInformation + vbOKOnly, "提示"
''''            listrecord
''''        End If
''''    Else
''''        MsgBox "输入不能为空，请输入...", vbInformation + vbOKOnly, "提示"
''''        txtNewUserID.SetFocus
''''    End If
    Exit Sub
err:
    MsgBox "严重错误！", vbInformation + vbOKOnly, "提示"
    Exit Sub
End Sub

Private Sub cmdDel_Click() '删除用户
'txtDelUserID
    
Dim tmpString As String
    
On Error GoTo err:
    
    If txtName = "" Or stMoney.Text = "" Then
        Exit Sub
    End If
    
    If Val(stMoney.Text) <= 0 Then
        Exit Sub
    End If
    
    M1Key = "e0e1e2e3e4e5"
    For i = 0 To 3
        st = rf_load_key_hex(ByVal icdev, 0, 14, ByVal M1Key)
        If st = 0 Then Exit For
    Next
    
    For i = 0 To 3
        st = rf_card(ByVal icdev, 1, pbout(0))
        If st = 0 Then Exit For
    Next
    
    For i = 0 To 3
        st = rf_authentication(ByVal icdev, 0, 14)  '验正14扇区密码
        If st = 0 Then Exit For
        If i = 3 And st <> 0 Then
              MsgBox "验证密钥错误，请检查！", vbInformation + vbOKOnly, "提示"
              Exit Sub
        End If
    Next

    wvalue = Val(stMoney * 100)
    For i = 0 To 3
        st = rf_increment(ByVal icdev, 58, ByVal wvalue) '块增值操作
        If st = 0 Then Exit For
    Next
    
    For i = 0 To 3
        st = rf_readval(ByVal icdev, 58, rvalue) ''读值
        If st = 0 Then Exit For
    Next
    stMoneyOld.Text = rvalue / 100
    st = rf_halt(ByVal icdev)
    st = rf_beep(icdev, 30)
    
    
    rsdb.Open "select * from linkaddmoneybuffer", maSys_db, 3, 3
    rsdb.AddNew
    rsdb.Fields("cpu_cardid") = "00000000" '8
    rsdb.Fields("User_id") = "00000000" '8
    rsdb.Fields("m1_readerno") = "00000000"  '08
    rsdb.Fields("m1_cardid") = Format(txtNewUserID, "00000000") '8
    rsdb.Fields("m1_cardtype") = "00"
    rsdb.Fields("m1_addmoney") = Val(stMoney)
    rsdb.Fields("m1_balance") = Val(stMoneyOld)
    rsdb.Fields("m1_balance_old") = 0
    rsdb.Fields("m1_cdate") = Format(Now, "yyyy-mm-dd")
    rsdb.Fields("m1_ctime") = Format(Now, "hh:mm:ss")
    rsdb.Fields("r_send") = "SF"
    rsdb.Update
    rsdb.Close
    
    cmdDel.Enabled = False
    listrecord
''''''    If txtNewUserID.Text <> "" Then
''''''        Set rs = GetRecordset(maSys_db, "select *  from LinkUser_Dict where M1_CardID='" & Trim(txtNewUserID) & "'")
''''''        If Not (rs.EOF And rs.BOF) Then
''''''            tmpString = "delete  from LinkUser_Dict where M1_CardID='" & Trim(txtNewUserID) & "'"
''''''            maSys_db.Execute tmpString, dbFailOnError
''''''
''''''''''            pssql = "insert LinkUserH_Dict(Cpu_CardID,Cstate,Cdate)  values( " & _
''''''''''                     "'" & Trim(txtNewUserID) & "','删除','" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "')"
''''''''''            maSys_db.Execute pssql
''''''            MsgBox "ID号为" & Trim(txtNewUserID) & "的认证卡信息删除成功！", vbInformation + vbOKOnly, "提示"
''''''            listrecord
''''''        Else
''''''            MsgBox "该用户在数据库中不存在，请检查！", vbInformation + vbOKOnly, "提示"
''''''        End If
''''''    Else
''''''        MsgBox "输入不能为空，请输入...", vbInformation + vbOKOnly, "提示"
''''''        txtNewUserID.SetFocus
''''''    End If
    Exit Sub
err:
     Exit Sub
End Sub

'''''''Private Sub cmdEdit_Click() '修改密码
'''''''
'''''''On Error GoTo err:
'''''''
'''''''    Dim tmpString As String
'''''''    If txtNewUserID <> "" And comboState.Text <> "" Then
'''''''        Set rs = GetRecordset(maSys_db, "select *  from LinkUser_Dict where Cpu_CardID='" & Trim(txtNewUserID) & "'")
'''''''        If Not (rs.EOF And rs.BOF) Then
'''''''
'''''''            tmpString = "update LinkUser_Dict set CState='" & Trim(comboState.Text) & "' where Cpu_CardID='" & Trim(txtNewUserID.Text) & "'"
'''''''            maSys_db.Execute tmpString, dbFailOnError
'''''''
'''''''            pssql = "insert LinkUserH_Dict(Cpu_CardID,Cstate,Cdate)  values( " & _
'''''''                     "'" & Trim(txtNewUserID) & "','" & Trim(comboState.Text) & "','" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "')"
'''''''            maSys_db.Execute pssql
'''''''            MsgBox "ID号为" & Trim(txtNewUserID.Text) & "的认证卡状态修改成功！", vbInformation + vbOKOnly, "提示"
'''''''            listrecord
'''''''        Else
'''''''            MsgBox "该用户在数据库中不存在，请检查！", vbCritical + vbOKOnly, "警告"
'''''''
'''''''        End If
'''''''    End If
'''''''    Exit Sub
'''''''err:
'''''''      Exit Sub
'''''''End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()
    icdev = rf_init(0, 115200) '''''''''''''打开读写器，建立连接
    If icdev < 0 Then
        icdev = rf_init(1, 115200)
        If icdev < 0 Then
            MsgBox "IC卡读写器初始化失败！", vbCritical + vbOKOnly, "警告"
            cmdAdd.Enabled = False
            cmdDel.Enabled = False
            Exit Sub
        End If
    End If
    
    
    Me.Top = (Screen.Height - Me.Height) / 2 + 200
    Me.Left = (Screen.Width - Me.Width) / 2
    
    
    listrecord
    
End Sub

Private Sub listrecord()
    Dim L As ListItem
    Dim i As Integer
    pssql = "select * from linkaddmoneybuffer where r_send='SF' order by m1_cdate,m1_ctime desc"
    
    ListView1.ColumnHeaders.Clear
    ListView1.ListItems.Clear
    ListView1.View = lvwReport

    ListView1.ColumnHeaders.Add , , "卡号", 1500
    ListView1.ColumnHeaders.Add , , "充值金额", 1200
    ListView1.ColumnHeaders.Add , , "余额", 1200
    ListView1.ColumnHeaders.Add , , "日期", 1500
    ListView1.ColumnHeaders.Add , , "时间", 1500

    Set rs = GetRecordset(maSys_db, pssql)
    Do While Not rs.EOF
        Set L = ListView1.ListItems.Add(, "a" + CStr(i), CStr(rs!M1_CardID))
        'L.ForeColor = vbRed
        L.ListSubItems.Add , , rs!m1_addmoney
        L.ListSubItems.Add , , rs!m1_balance
        L.ListSubItems.Add , , rs!m1_cdate
        L.ListSubItems.Add , , rs!m1_ctime
        rs.MoveNext
        i = i + 1
    Loop
    rs.Close
    
End Sub
    


Private Sub Form_Unload(Cancel As Integer)
quit
End Sub