frmuser.frm

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

         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   264
      Left            =   240
      TabIndex        =   8
      Top             =   1200
      Width           =   1092
   End
   Begin VB.Label Label5 
      Caption         =   "验证密码："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   264
      Left            =   240
      TabIndex        =   5
      Top             =   2160
      Width           =   1104
   End
   Begin VB.Label Label4 
      Caption         =   " 密 码："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   264
      Left            =   240
      TabIndex        =   4
      Top             =   1680
      Width           =   1104
   End
   Begin VB.Label Label3 
      Caption         =   "登录名称："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   264
      Left            =   240
      TabIndex        =   3
      Top             =   720
      Width           =   1344
   End
   Begin VB.Label Label1 
      Caption         =   "员工姓名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   1092
   End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim active As Integer
Dim listview_index As Integer
Dim str_DutyNo, str_DutyName As String
Dim rs As New ADODB.Recordset
Dim txtUserno As String
Dim sid(1024) As String
Dim DeCpassword As String

Private Sub cmd_Co_Click(Index As Integer)
    Select Case Index
    Case 0
        active = 0
        Cmd_F
        txtUser.Enabled = True
        txtUser.SetFocus
        txtUser.Text = ""
        Combo1.Text = ""
        Combo2.Text = ""
        
    Case 1
        active = 1
        str_Set
        txtUser.Enabled = False
    Case 2
        str_Set
        If active <> 3 Then
           If MsgBox("确实要删除该记录吗?", vbCritical + vbYesNo, "中芯德立提示信息") = vbYes Then
              maSys_db.Execute "delete from 用户信息表 where 登录名称='" & Trim(txtUser.Text) & "'"
              Rs_Record_Set
           End If
        End If
        Cmd_T
    Case 3
        If active = 1 Then
           If Combo1.Text <> "" And Combo2.Text <> "" Then
              maSys_db.Execute "update 用户信息表 set 员工姓名='" & Trim(Combo1.Text) & "',用户类型='" & Trim(Combo2.Text) & "' where 登录名称='" & Trim(txtUser.Text) & "'"
              Rs_Record_Set
           End If
        Else
           If txtPassword <> txtPassword1 Then MsgBox "2次输入密码不一致，请重新输入！", vbInformation + vbOKOnly, "中芯德立提示信息": Exit Sub
           DeCpassword = DeCrypt(txtPassword.Text, "19760419")
           If txtUser <> "" And txtPassword <> "" And txtPassword1 <> "" And Combo1.Text <> "" And Combo2.Text <> "" Then
              Set rs = GetRecordset(maSys_db, "select * from 用户信息表 where 登录名称='" & Trim(txtUser.Text) & "'")
              If Not rs.EOF Then  '该员工编号在数据库中已经存在！
                   MsgBox "该编号在数据库中已经存在，请核对！", vbInformation + vbOKOnly, "中芯德立提示信息"
              Exit Sub
              End If
              
              maSys_db.Execute "insert into 用户信息表(员工姓名,员工编号,登录名称,登录密码,用户类型) values('" & Trim(Combo1.Text) & "','" & txtUserno & "','" & Trim(txtUser.Text) & "','" & Trim(DeCpassword) & "','" & Trim(Combo2.Text) & "')"
              Rs_Record_Set
           Else
              MsgBox "输入不能为空！", vbInformation + vbOKOnly, "中芯德立提示信息"
           
           End If
        End If
        Cmd_T
    Case 4
        Cmd_T
    Case 5
        Unload Me
    End Select
End Sub
Private Sub str_Set()
    If ListView_Duty.ListItems.Count <> 0 Then
       listview_index = ListView_Duty.SelectedItem
'       str_DutyNo = ListView_Duty.ListItems(listview_index).SubItems(1)
'       str_DutyName = ListView_Duty.ListItems(listview_index).SubItems(2)
       txtUser = ListView_Duty.ListItems(listview_index).SubItems(1)
       Combo1.Text = ListView_Duty.ListItems(listview_index).SubItems(2)
       Combo2.Text = ListView_Duty.ListItems(listview_index).SubItems(3)
       
       Cmd_F
    Else
       str_Msg = MsgBox("没有可供操作的记录！", vbInformation + vbOKOnly, "中芯德立提示信息")
       active = 3
       Exit Sub
    End If
End Sub

Private Sub Combo1_Click()
Dim sCount As Integer
sCount = Combo1.ListIndex
txtUserno = sid(sCount)
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2
    
    Combo2.Clear
    Combo2.AddItem "管理员"
    Combo2.AddItem "普通用户"
    Combo2.ListIndex = 0
    txtUser.Text = ""
    txtPassword.Text = ""
    txtPassword1.Text = ""
    Combo1.Text = ""
    Combo2.Text = ""
    Set rs = GetRecordset(maSys_db, "select * from 员工信息临时表")
    Combo1.Clear
   
    i = 0
    Do While Not rs.EOF
        Combo1.AddItem rs!员工姓名
        sid(i) = rs!员工编号
        i = i + 1
        rs.MoveNext
    Loop
    
    Rs_Record_Set
    Cmd_T
    
'    maSys_db.Execute "delete from Full_UserDict "
'    maSys_db.Execute "delete from linkdatabuffer "
End Sub
Private Sub Rs_Record_Set() '显示记录到listview
    Dim L As ListItem
    Dim i As Integer
    
    Set rs = GetRecordset(maSys_db, "select * from 用户信息表")

    ListView_Duty.ColumnHeaders.Clear
    ListView_Duty.ListItems.Clear
    ListView_Duty.View = lvwReport
    ListView_Duty.ColumnHeaders.Add , , "ID", 800
    ListView_Duty.ColumnHeaders.Add , , "登录名称", 1500
    ListView_Duty.ColumnHeaders.Add , , "员工姓名", 1500
    ListView_Duty.ColumnHeaders.Add , , "用户类型", 1500
    i = 1
    If rs.EOF Then
       Exit Sub
    Else
        rs.MoveFirst
        Do While Not rs.EOF
            Set L = ListView_Duty.ListItems.Add(, , i)
                L.SubItems(1) = CStr(rs!登录名称)
                L.SubItems(2) = CStr(rs!员工姓名)
                L.SubItems(3) = CStr(rs!用户类型)
            i = i + 1
            rs.MoveNext
        Loop
    End If
End Sub
Private Sub Cmd_T()
    cmd_Co(0).Enabled = True
    cmd_Co(1).Enabled = True
    cmd_Co(2).Enabled = True
    cmd_Co(3).Enabled = False
    cmd_Co(4).Enabled = False
    cmd_Co(5).Enabled = True
End Sub
Private Sub Cmd_F()
    cmd_Co(0).Enabled = False
    cmd_Co(1).Enabled = False
    cmd_Co(2).Enabled = False
    cmd_Co(3).Enabled = True
    cmd_Co(4).Enabled = True
    cmd_Co(5).Enabled = False
End Sub