frmuser.frm

这个是我以前做的一个客户管理系统.包内已经含有源码和所用到的控件.代码是用VB写的,数据库采用MSSQL的.

VERSION 5.00
Begin VB.Form frmUser 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "用户管理"
   ClientHeight    =   3945
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5385
   Icon            =   "frmUser.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3945
   ScaleWidth      =   5385
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   345
      Left            =   4020
      TabIndex        =   5
      Top             =   3510
      Width           =   1275
   End
   Begin VB.CommandButton cmdChangePass 
      Caption         =   "更改用户密码"
      Height          =   345
      Left            =   2700
      TabIndex        =   4
      Top             =   3510
      Width           =   1275
   End
   Begin VB.CommandButton cmdDelUser 
      Caption         =   "删除用户"
      Height          =   345
      Left            =   1380
      TabIndex        =   3
      Top             =   3510
      Width           =   1275
   End
   Begin VB.CommandButton cmdAddNew 
      Caption         =   "添加用户"
      Height          =   345
      Left            =   60
      TabIndex        =   2
      Top             =   3510
      Width           =   1275
   End
   Begin VB.Frame Frame1 
      Caption         =   "用户列表"
      Height          =   3435
      Left            =   30
      TabIndex        =   0
      Top             =   0
      Width           =   5295
      Begin VB.ListBox lstUsers 
         Columns         =   4
         Height          =   3120
         Left            =   90
         TabIndex        =   1
         Top             =   210
         Width           =   5115
      End
   End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdAddNew_Click()
    frmNewUser.mbAddNew = True
    frmNewUser.Show 1
End Sub

Private Sub cmdChangePass_Click()
    If lstUsers.ListIndex <> -1 Then
        frmNewUser.mbAddNew = False
        frmNewUser.mUserID = lstUsers.ItemData(lstUsers.ListIndex)
        frmNewUser.Show 1
    End If
    
End Sub

Private Sub cmdDelUser_Click()

If lstUsers.ListIndex <> -1 And lstUsers.List(lstUsers.ListIndex) <> "系统管理员" Then
    CN.Execute "Delete from users where User_ID=" & lstUsers.ItemData(lstUsers.ListIndex)
    lstUsers.RemoveItem lstUsers.ListIndex
Else
    MsgBox "系统管理员不能删除！！！", vbInformation + vbOKOnly, ""
End If

End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        SendKeys "{tab}"
    ElseIf KeyAscii = vbKeyEscape Then
        KeyAscii = 0
        Unload Me
    End If
End Sub

Private Sub Form_Load()
    
    Center Me
    Me.KeyPreview = True
    Call GetUsers
    
End Sub

Private Sub GetUsers()
Dim Rst     As New ADODB.Recordset
Dim sSql    As String
Dim i       As Integer

On Error GoTo Err_Handle
    sSql = "Select User_ID,UserName,UserPass from Users"
    Rst.Open sSql, CN
    If Rst.EOF = False Then
        lstUsers.Clear
        i = 0
        Do Until Rst.EOF
            lstUsers.AddItem Rst.Fields!UserName, i
            lstUsers.ItemData(i) = Rst.Fields!User_ID
            i = i + 1
            Rst.MoveNext
        Loop
    End If
    Rst.Close
    
Exit Sub
Err_Handle:
    gShowMsg "取得用户,frmUser.GetUsers()"
End Sub

Private Sub lstUsers_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyF5 Then
        KeyCode = 0
        Call GetUsers
    End If
End Sub