frmusers.frm

本源代码为学生图书管管理系统

VERSION 5.00
Begin VB.Form frmUsers 
   Caption         =   "用户设置"
   ClientHeight    =   2460
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6030
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2460
   ScaleWidth      =   6030
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame3 
      Caption         =   "用户名列表"
      Height          =   2175
      Left            =   3360
      TabIndex        =   8
      Top             =   120
      Width           =   2535
      Begin VB.ListBox lstUsers 
         Appearance      =   0  'Flat
         Height          =   1830
         Left            =   120
         TabIndex        =   9
         Top             =   240
         Width           =   2295
      End
   End
   Begin VB.Frame Frame2 
      Height          =   735
      Left            =   120
      TabIndex        =   4
      Top             =   1560
      Width           =   3255
      Begin VB.CommandButton cmdDelete 
         Caption         =   "删除"
         Height          =   375
         Left            =   2280
         TabIndex        =   11
         Top             =   240
         Width           =   615
      End
      Begin VB.CommandButton cmdModify 
         Caption         =   "修改"
         Height          =   375
         Left            =   840
         TabIndex        =   7
         Top             =   240
         Width           =   615
      End
      Begin VB.CommandButton cmdSave 
         Caption         =   "保存"
         Height          =   375
         Left            =   1560
         TabIndex        =   6
         Top             =   240
         Width           =   615
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "添加"
         Height          =   375
         Left            =   120
         TabIndex        =   5
         Top             =   240
         Width           =   615
      End
   End
   Begin VB.Frame Frame1 
      Height          =   1455
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3255
      Begin VB.TextBox Text1 
         Appearance      =   0  'Flat
         BackColor       =   &H00C0FFFF&
         Enabled         =   0   'False
         Height          =   270
         IMEMode         =   3  'DISABLE
         Left            =   120
         TabIndex        =   10
         Text            =   "登录后请用密码修改来更改个人密码"
         Top             =   1080
         Width           =   3015
      End
      Begin VB.TextBox txttip1 
         Appearance      =   0  'Flat
         BackColor       =   &H00C0FFFF&
         Enabled         =   0   'False
         Height          =   270
         IMEMode         =   3  'DISABLE
         Left            =   120
         TabIndex        =   3
         Text            =   "登录者密码初始状态为“0000”"
         Top             =   840
         Width           =   3015
      End
      Begin VB.TextBox txtUserName 
         Appearance      =   0  'Flat
         Height          =   375
         Left            =   1320
         TabIndex        =   2
         Top             =   240
         Width           =   1815
      End
      Begin VB.Label Label1 
         Caption         =   "用户登录名："
         Height          =   375
         Left            =   240
         TabIndex        =   1
         Top             =   360
         Width           =   1215
      End
   End
End
Attribute VB_Name = "frmUsers"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim bModify As Boolean
Dim strusername As String

Private Sub cmdAdd_Click()

    txtUserName.Enabled = True
    txtUserName.Text = ""
    txtUserName.SetFocus
    bModify = False
    cmdModify.Enabled = False
    cmdDelete.Enabled = False
End Sub

Private Sub cmdDelete_Click()
    Dim strsql As String
    strsql = " delete from users where username='" & txtUserName.Text & "'"
    conLIB.Execute strsql
    ShowUsers
End Sub

Private Sub cmdModify_Click()
    strusername = txtUserName.Text
    txtUserName.Enabled = True
    bModify = True
    
End Sub

Private Sub cmdSave_Click()
    Dim strsql As String
    Dim rsuser As New ADODB.Recordset
    
    If txtUserName.Text = "" Then
        MsgBox "请输入登录名", vbOKOnly, "提示"
        txtUserName.SetFocus
        Exit Sub
    Else
    '查表中是否是有此登录名
        strsql = "select username from users where username='" & txtUserName.Text & "'"
        rsuser.Open strsql, conLIB, adOpenStatic, adLockOptimistic
        If rsuser.EOF And rsuser.BOF Then
            rsuser.Close
            Set rsuser = Nothing
            If bModify = False Then
                strsql = "insert into users values('" & txtUserName.Text & "','0000')"
               
            Else
                strsql = "update users set username='" & txtUserName.Text & "'where username='" & strusername & "'"
            End If
            conLIB.Execute strsql
            txtUserName.Enabled = False
            ShowUsers
            Exit Sub
        Else
            MsgBox "已有一个相同名字的登录者存在，请选用其它登录名", vbOKOnly, "错误"
            txtUserName.SelStart = 0
            txtUserName.SelLength = Len(txtUserName.Text)
            rsuser.Close
            Set rsuser = Nothing
            Exit Sub
        End If
    End If
    bModify = False
End Sub

Private Sub Form_Load()
    txtUserName.Enabled = False
    ShowUsers
    cmdModify.Enabled = False
    cmdDelete.Enabled = False
    bModify = False
    strusername = ""
End Sub
Private Sub ShowUsers()
    Dim strsql As String
    Dim rsuser As New ADODB.Recordset
    strsql = "select username from users"
    If rsuser.State = adStateOpen Then rsuser.Close
    
    rsuser.Open strsql, conLIB, adOpenStatic, adLockOptimistic
    lstUsers.Clear
    If rsuser.EOF And rsuser.BOF Then
        rsuser.Close
        Set rsuser = Nothing
        Exit Sub
    Else
        rsuser.MoveFirst
        While Not rsuser.EOF
            lstUsers.AddItem rsuser!UserName
            lstUsers.AddItem ""
            rsuser.MoveNext
        Wend
    End If
End Sub

Private Sub lstUsers_Click()
    Dim i As Integer
    For i = 1 To lstUsers.ListCount
       txtUserName.Text = lstUsers.List(lstUsers.ListIndex)
       txtUserName.Enabled = False
        i = lstUsers.ListCount
    Next i
    cmdModify.Enabled = True
    cmdDelete.Enabled = True
End Sub