frm_hyic.frm

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

        L.SubItems(3) = CStr(rs!IC卡类)
        L.SubItems(4) = CStr(rs!部门)
        L.SubItems(5) = CStr(rs!证件编号)
        i = i + 1
        rs.MoveNext
Loop

End Sub

Private Sub listrecord1()
Dim L As ListItem
Dim i As Integer
Dim rs As New ADODB.Recordset
Set rs = GetRecordset(maSys_db, "select * from 充值积分明细表 where IC卡类>'32' order by 操作时间 desc")
ListView1.ColumnHeaders.Clear
ListView1.ListItems.Clear
ListView1.View = lvwReport
ListView1.ColumnHeaders.Add , , "ID", 800

ListView1.ColumnHeaders.Add , , "IC卡号", 1500
ListView1.ColumnHeaders.Add , , "IC卡类", 1500
ListView1.ColumnHeaders.Add , , "操作员", 2500
ListView1.ColumnHeaders.Add , , "操作类型", 1500
ListView1.ColumnHeaders.Add , , "操作时间", 2000
ListView1.ColumnHeaders.Add , , "持卡人", 1500
i = 1
If rs.EOF Then Exit Sub
rs.MoveFirst
Do While Not rs.EOF
    Set L = ListView1.ListItems.Add(, , i)
        L.SubItems(1) = CStr(rs!IC卡号)
        L.SubItems(2) = CStr(rs!IC卡类)
        L.SubItems(3) = CStr(rs!操作员)
        L.SubItems(4) = CStr(rs!操作类型)
        L.SubItems(5) = CStr(rs!操作时间)
        L.SubItems(6) = CStr(rs!员工编号)
        i = i + 1
        rs.MoveNext
Loop

End Sub

Private Sub cmbcardtype_Click()
If cmbcardtype.ListCount > 0 Then
    sListNo = cmbcardtype.ListIndex
    sTypeid = sType(sListNo)
End If
End Sub

Private Sub cmbdept_Click()
If cmbdept.Text <> "" Then
     Call sHymc
End If
End Sub

Private Sub cmdicd_Click() '退卡

If MsgBox("需要退卡，请确认?", vbInformation + vbYesNo, "中芯德立提示信息") = vbYes Then
    If ReaderOpen = False Then MsgBox "未检测到IC卡读写器，请检查！", vbInformation + vbOKOnly, "中芯德立提示信息": Exit Sub
    If R_Carddel(sErr) = True Then
        On Error GoTo err
        If Format(sCardTYpe, "00") >= "33" Then
            maSys_db.Execute "insert into 充值积分明细表(IC卡号,卡上余额,卡上积分,充值金额,赠送积分,操作员,操作时间,操作类型,员工编号,IC卡类)" _
                            & "values('" & Format(sCardid, "00000000") & "',0,0," _
                            & "0,0,'" & strUserName & "'," & "'" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "'," _
                            & "'退卡','" & Trim(sEmpid) & "','" & Format(sCardTYpe, "00") & "')"
        
        Else
            maSys_db.Execute "update 员工信息临时表 set IC卡号='0',IC卡类='0'" _
                              & " where IC卡号='" & Format(sCardid, "00000000") & "'"
            maSys_db.Execute "insert into 充值积分明细表(IC卡号,卡上余额,卡上积分,充值金额,赠送积分,操作员,操作时间,操作类型,员工编号,IC卡类)" _
                            & "values('" & Format(sCardid, "00000000") & "',0,0," _
                            & -sBalance & ",0,'" & strUserName & "'," & "'" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "'," _
                            & "'退卡','" & Trim(sEmpid) & "','" & Format(sCardTYpe, "00") & "')"
            
        End If
        Call listrecord
        Call listrecord1
        Call ReaderSound(2)
        MsgBox "退卡成功，卡号：" & Format(sCardid, "00000000"), vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    Else
        MsgBox "退卡错误，卡号：" & Format(sCardid, "00000000"), vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    End If
End If

err:
cmdicd.Enabled = False
Call ReaderClose
End Sub

Private Sub cmdici_Click() '发卡
Dim i As Integer
If txtIC.Text = "" Or Val(txtIC.Text) = 0 Then MsgBox "IC卡号不能为空，请重新输入！", vbInformation + vbOKOnly, "中芯德立提示信息": Exit Sub

If sTypeid >= 33 Then
Set rs = GetRecordset(maSys_db, "select * from 充值积分明细表 where IC卡号='" & Format(Trim(txtIC.Text), "00000000") & "' order by 操作时间 desc")
If rs.RecordCount <> 0 Then
    If rs.Fields("操作类型") = "售卡" Then
        MsgBox "该IC卡号在数据库中已经存在！", vbInformation + vbOKOnly, "中芯德立提示信息"
        txtIC.Text = ""
        Exit Sub
    End If
End If
End If


If sTypeid <= 32 Then
    If txtEmpID.Text = "" Or Combo1.Text = "" Then MsgBox "人员信息不能为空，请重新输入！", vbInformation + vbOKOnly, "中芯德立提示信息": Exit Sub
    Set rs = GetRecordset(maSys_db, "select * from 员工信息临时表 where 员工编号='" & Format(Trim(txtEmpID.Text), "00000000") & "'")
    If rs.RecordCount <> 0 Then
        If rs.Fields("IC卡号") <> "0" Then
        MsgBox "此人已经发行了IC卡，卡号为：" & rs.Fields("IC卡号"), vbInformation + vbOKOnly, "中芯德立提示信息"
        txtIC.Text = ""
        Exit Sub
        End If
    End If
    
    Set rs = GetRecordset(maSys_db, "select * from 员工信息临时表 where IC卡号='" & Format(Trim(txtIC.Text), "00000000") & "'")
    If rs.RecordCount <> 0 Then
        If rs.Fields("IC卡号") <> "0" Then
        MsgBox "该IC卡号在数据库中已经存在", vbInformation + vbOKOnly, "中芯德立提示信息"
        txtIC.Text = ""
        Exit Sub
        End If
    End If
End If

If cmbcardtype.Text = "" Then MsgBox "IC卡类不能为空，请重新输入！", vbInformation + vbOKOnly, "中芯德立提示信息": Exit Sub
If ReaderOpen = False Then MsgBox "未检测到IC卡读写器，请检查！", vbInformation + vbOKOnly, "中芯德立提示信息": Exit Sub
'Function R_Cardsell(sp_Cardid As String, sp_Cardtype As Integer, sp_LimtDate As String, sp_String As String) As Boolean '售卡
sCardid = Val(txtIC.Text)
sCardTYpe = sTypeid
'sDate = Format(Now, "yyyy-mm-dd hh:mm:ss")
sDate = "20200101"

If sTypeid <> "34" Then
    stf = R_Cardsell(sCardid, sCardTYpe, sDate, sErr)
Else '发折扣设置卡
    Dim sZK As String
    '从数据库取折扣设置信息
    For i = 0 To 31
        Set rs = GetRecordset(maSys_db, "select * from 会员类型设置表 where 类型编号='" & Format(i, "00") & "'")
        If rs.RecordCount <> 0 Then
            sZK = sZK & Right("00" + hex(Val(rs.Fields("折扣"))), 2)
        Else
            sZK = sZK & "00"
        End If
    Next i
    
    If Len(sZK) <> 64 Then GoTo err
    stf = R_Cardsell34(sCardid, sCardTYpe, sDate, sZK, sErr)
End If

If stf = True Then
    If sTypeid < 32 Then
        maSys_db.Execute "update 员工信息临时表 set IC卡号='" & Format(Trim(txtIC.Text), "00000000") & "',IC卡类='" & Format(sTypeid, "00") & "'" _
                          & " where 员工编号='" & Trim(txtEmpID) & "'"
    End If
    maSys_db.Execute "insert into 充值积分明细表(IC卡号,卡上余额,卡上积分,充值金额,赠送积分,操作员,操作时间,操作类型,员工编号,IC卡类)" _
                    & "values('" & Format(sCardid, "00000000") & "',0,0," _
                    & "0,0,'" & strUserName & "'," & "'" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "'," _
                    & "'售卡','" & Trim(Combo1.Text) & "','" & Format(sTypeid, "00") & "')"
    Call listrecord
    Call listrecord1
    Call ReaderSound(2)
    MsgBox "发卡成功，卡号：" & Format(txtIC, "00000000"), vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
Else
    MsgBox "发卡错误！：" & Format(txtIC, "00000000"), vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
End If


err:
cmdici.Enabled = False
Call ReaderClose

End Sub

Private Sub cmdicm_Click() '验卡
If ReaderOpen = False Then MsgBox "未检测到IC卡读写器，请检查！", vbInformation + vbOKOnly, "中芯德立提示信息": Exit Sub
If sKey = "" Then
    MsgBox "请先将密码卡放在感应区！", vbInformation + vbOKOnly, "中芯德立提示信息"
    If R_CardKey(sKey, sErr) = False Then MsgBox "密码装载失败！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
    sKey = Mid(sErr, 1, 8) & Mid(sErr, 17, 8)
    MsgBox "OK，请保管好密码卡，将用户卡放在读写器感应区！", vbInformation + vbOKOnly, "中芯德立提示信息"
End If
If Len(sKey) <> 16 Then GoTo err

If R_Cardcheck(sKey, sCardid, sCardTYpe, sBalance, sDate, sMonth, sErr) = True Then
    ReaderSound (2)
    Set rs = GetRecordset(maSys_db, "select * from 充值积分明细表 where IC卡号='" & Format(sCardid, "00000000") & "' and 操作类型='售卡' order by 操作时间 desc ")
    If rs.RecordCount <> 0 And rs.Fields("操作类型") = "售卡" Then
        sEmpid = rs.Fields("员工编号")
    ElseIf rs.RecordCount <> 0 And rs.Fields("操作类型") = "退卡" Then
        MsgBox "该卡已经在坏卡退卡中退过卡", vbInformation + vbOKOnly, "中芯德立提示信息"
        GoTo err
    Else
        'GoTo err
    End If
    If Format(sCardTYpe, "00") = "33" Then
        MsgBox "该卡是数据采集卡，持卡人：" & sEmpid, vbInformation + vbOKOnly, "中芯德立提示信息"
    ElseIf Format(sCardTYpe, "00") = "34" Then
        MsgBox "该卡是折扣设置卡，持卡人：" & sEmpid, vbInformation + vbOKOnly, "中芯德立提示信息"
    ElseIf Format(sCardTYpe, "00") = "35" Then
        MsgBox "该卡是操作员卡，持卡人：" & sEmpid, vbInformation + vbOKOnly, "中芯德立提示信息"
    Else
        Set rs = GetRecordset(maSys_db, "select * from 员工信息临时表 where IC卡号='" & Format(sCardid, "00000000") & "'")
        If Not rs.EOF Then
            sTest = Format(sCardid, "00000000") & Format(sCardTYpe, "00") & Format(sBalance, "0000.00") & sDate & rs.Fields("员工姓名")
            sEmpid = rs.Fields("员工姓名")
            frm_icMissage.Show 1
        Else
            MsgBox "该卡在数据库中不存在，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
        End If
   End If
   
   cmdicd.Enabled = True
   cmdici.Enabled = False
Else
     If sErr = "ERR 1010" Then
        cmdici.Enabled = True
        cmdicd.Enabled = False
        ReaderSound (2)
        MsgBox "该卡是新卡，可以发卡！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
     ElseIf sErr = "ERR 1014" Then
        MsgBox "该卡是黑名单卡，请收回！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
     Else
        MsgBox "验卡错误，请重试！", vbInformation + vbOKOnly, "中芯德立提示信息": GoTo err
     End If
End If

err:
Call ReaderClose

End Sub

Private Sub cmdicq_Click()
Unload Me
End Sub

Private Sub Combo1_Click()
If Combo1.ListCount > 0 Then
sListNo = Combo1.ListIndex
sHybhLast = sHybh(sListNo)
txtEmpID = sHybh(sListNo)
End If
End Sub

Private Sub Command1_Click() '坏卡退卡
Dim sRecord As String
Dim Mride As Currency
Dim Mfull As Currency
Dim Mreturn As Currency
Dim MfullDate As String
Dim MrideDate As String
Mride = 0
Mfull = 0
If txtIC.Text <> "" And Val(txtIC.Text) > 0 Then
    Set rs = GetRecordset(maSys_db, "select * from 员工信息临时表 where IC卡号='" & Format(Trim(txtIC.Text), "00000000") & "'")
    If rs.RecordCount <> 0 Then
        sEmpid = rs.Fields("员工姓名")
        sCardTYpe = rs.Fields("IC卡类")
        '查询充值库
        Set rs = GetRecordset(maSys_db, "select * from 充值积分明细表 where IC卡号='" & Format(Trim(txtIC.Text), "00000000") & "' order by 操作时间 desc")
        If rs.RecordCount <> 0 Then
            If rs.Fields("操作类型") <> "退卡" Then
                Mfull = rs.Fields("卡上余额")
                MfullDate = rs.Fields("操作时间")
            Else
                MsgBox "该卡已经退卡！", vbInformation + vbOKOnly, "中芯德立提示信息"
                Exit Sub
            End If
        End If
        
        '查询消费数据库
        Set rs = GetRecordset(maSys_db, "select * from 消费明细 where IC卡号='" & Format(Trim(txtIC.Text), "00000000") & "' order by 消费时间 desc")
        If rs.RecordCount <> 0 Then
            Mride = rs.Fields("卡上余额")
            MrideDate = rs.Fields("消费时间")
        End If
        
        If MrideDate > MfullDate Then
            Mreturn = Mride
        Else
            Mreturn = Mfull
        End If
        
        If MsgBox("卡上余额：" & str(Mreturn) & ",需要退卡，请确认?", vbInformation + vbYesNo, "中芯德立提示信息") = vbNo Then: Exit Sub
        
        maSys_db.Execute "update 员工信息临时表 set IC卡号='0',IC卡类='0'" _
                              & " where IC卡号='" & Format(Trim(txtIC.Text), "00000000") & "'"
        maSys_db.Execute "insert into 充值积分明细表(IC卡号,卡上余额,卡上积分,充值金额,赠送积分,操作员,操作时间,操作类型,员工编号,IC卡类)" _
                        & "values('" & Format(txtIC, "00000000") & "',0,0," _
                        & -Mreturn & ",0,'" & strUserName & "'," & "'" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "'," _
                        & "'退卡','" & Trim(sEmpid) & "','" & Format(sCardTYpe, "00") & "')"
        Call listrecord
        MsgBox "退卡成功！", vbInformation + vbOKOnly, "中芯德立提示信息"
        Exit Sub
        
    Else '查控制卡
        Set rs = GetRecordset(maSys_db, "select * from 充值积分明细表 where IC卡号='" & Format(Trim(txtIC.Text), "00000000") & "' order by 操作时间 desc")
        If rs.RecordCount <> 0 Then
            If rs.Fields("操作类型") = "售卡" Then
                If MsgBox("该卡是控制卡，需要退卡，请确认?", vbInformation + vbYesNo, "中芯德立提示信息") = vbNo Then: Exit Sub
                maSys_db.Execute "insert into 充值积分明细表(IC卡号,卡上余额,卡上积分,充值金额,赠送积分,操作员,操作时间,操作类型,员工编号,IC卡类)" _
                        & "values('" & Format(txtIC, "00000000") & "',0,0," _
                        & "0,0,'" & strUserName & "'," & "'" & Format(Now, "yyyy-mm-dd hh:mm:ss") & "'," _
                        & "'退卡','" & Trim(rs.Fields("员工编号")) & "','" & Format(rs.Fields("IC卡类"), "00") & "')"
                Call listrecord1
                MsgBox "退卡成功！", vbInformation + vbOKOnly, "中芯德立提示信息"
                Exit Sub
            End If
        End If
    
    End If
Else
    MsgBox "卡号输入错误！", vbInformation + vbOKOnly, "中芯德立提示信息": Exit Sub
End If

End Sub

Private Sub Form_Load()
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
cmdici.Enabled = False
cmdicd.Enabled = False
Call sGetDept
'Call sHymc
Call sGettype
sWhere = "select * from 员工信息临时表 where IC卡号<>'0' order by IC卡号"
Call listrecord
Call listrecord1
End Sub

Private Sub sGettype()
Set rs = GetRecordset(maSys_db, "select * from 会员类型设置表 order by 类型编号")
If rs.EOF Then
    MsgBox "请先设置卡类型信息！", vbInformation + vbOKOnly, "中芯德立提示信息"
    cmdicm.Enabled = False
    Exit Sub
Else
    cmbcardtype.Clear
    rs.MoveFirst
    sListNo = 0
    Do While Not rs.EOF
        cmbcardtype.AddItem rs.Fields("类型名称")
        sType(sListNo) = rs.Fields("类型编号")
        sListNo = sListNo + 1
        rs.MoveNext
    Loop
End If
End Sub
Private Sub sGetDept()
Set rs = GetRecordset(maSys_db, "select * from dept_dict")
If rs.EOF Then
   cmdicm.Enabled = False
   MsgBox "请先设置部门信息！", vbInformation + vbOKOnly, "中芯德立提示信息"
   Exit Sub
Else
    cmbdept.Clear
    rs.MoveFirst
    Do While Not rs.EOF
        cmbdept.AddItem rs.Fields("dept_name")
        rs.MoveNext
    Loop
End If
If cmbdept.ListCount > 0 Then
    cmbdept.ListIndex = 0
End If
End Sub

Private Sub sHymc()
Combo1.Clear
If cmbdept.ListCount > 0 Then
    Set rs = GetRecordset(maSys_db, "select * from 员工信息临时表 where 部门='" & cmbdept.Text & "' order by 员工姓名")
    If Not rs.EOF Then
          sListNo = 0
          Do While Not rs.EOF
             Combo1.AddItem Trim(rs!员工姓名)
             sHybh(sListNo) = rs!员工编号
             sListNo = sListNo + 1
             rs.MoveNext
          Loop
          Combo1.ListIndex = 0
          cmdicm.Enabled = True
    Else
          Combo1.Clear
          txtEmpID = ""
          cmdicm.Enabled = False
          'MsgBox "请先增加员工信息！", vbInformation + vbOKOnly, "中芯德立提示信息"
    End If
End If
End Sub

Private Sub txtEmpID_KeyPress(KeyAscii As Integer)
If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 Then
        KeyAscii = 0
End If

End Sub

Private Sub txtIC_KeyPress(KeyAscii As Integer)
'If KeyAscii = 13 Then
If KeyAscii > 57 Or KeyAscii < 48 And KeyAscii <> 8 Then
        KeyAscii = 0
End If
End Sub