frmcpucard.frm

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

            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)
            st = rf_beep(icdev, 30)
'''''''            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:

    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 = 3 And st <> 0 Then
              MsgBox "验证密钥错误，请检查！", vbInformation + vbOKOnly, "提示"
              Exit Sub
        End If
    Next

    st = rf_read_hex(ByVal icdev, 57, databuff32)
    If Mid(databuff32, 1, 8) = "ffffffff" Then
        MsgBox "该卡是新卡！", vbInformation + vbOKOnly, "提示"
        Exit Sub
    End If
    
    
    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
        
        maSys_db.Execute "delete linkuser_dict where m1_cardid='" & Trim(txtNewUserID) & "'", dbFailOnError
        data32 = "ffffffffffffffffff1234567890ffff"
        st = rf_write_hex(ByVal icdev, 57, ByVal data32)
        st = rf_halt(ByVal icdev)
        
    Else
        MsgBox "该卡号在数据库中不存在，请检查！", vbInformation + vbOKOnly, "提示"
        Exit Sub
    End If
    
    MsgBox "删除成功！", vbInformation + vbOKOnly, "提示"
    txtname.Text = ""
    txtNewUserID.Text = ""
    
    
    st = rf_beep(icdev, 30)
    
    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 cmdEdit_Click()

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 LinkUser_Dict order by M1_CardID"
    
    ListView1.ColumnHeaders.Clear
    ListView1.ListItems.Clear
    ListView1.View = lvwReport

    ListView1.ColumnHeaders.Add , , "卡号", 1500
    ListView1.ColumnHeaders.Add , , "姓名", 1800
    ListView1.ColumnHeaders.Add , , "时间", 2600

    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!cname
        L.ListSubItems.Add , , rs!CDate
        rs.MoveNext
        i = i + 1
    Loop
    rs.Close
End Sub
    
Private Sub Form_Unload(Cancel As Integer)
quit
End Sub