frmuser.frm

学生选课系统有原代码

            EndProperty
            Height          =   300
            Left            =   2040
            TabIndex        =   5
            Top             =   360
            Width           =   1452
         End
         Begin VB.TextBox Text3 
            BeginProperty Font 
               Name            =   "幼圆"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   288
            IMEMode         =   3  'DISABLE
            Left            =   2040
            PasswordChar    =   "*"
            TabIndex        =   4
            Top             =   1560
            Width           =   1452
         End
         Begin VB.CommandButton Command1 
            Caption         =   "确 定"
            BeginProperty Font 
               Name            =   "幼圆"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   324
            Left            =   960
            TabIndex        =   3
            Top             =   2640
            Width           =   1110
         End
         Begin VB.CommandButton Command2 
            Caption         =   "退 出"
            BeginProperty Font 
               Name            =   "幼圆"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   324
            Left            =   2880
            TabIndex        =   2
            Top             =   2640
            Width           =   1110
         End
         Begin VB.Label Label14 
            BackStyle       =   0  'Transparent
            Caption         =   "读取"
            BeginProperty Font 
               Name            =   "幼圆"
               Size            =   10.5
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   270
            Left            =   765
            TabIndex        =   32
            Top             =   2160
            Width           =   645
         End
         Begin VB.Label Label13 
            BackStyle       =   0  'Transparent
            Caption         =   "修改"
            BeginProperty Font 
               Name            =   "幼圆"
               Size            =   10.5
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   270
            Left            =   1920
            TabIndex        =   31
            Top             =   2160
            Width           =   645
         End
         Begin VB.Label Label12 
            BackStyle       =   0  'Transparent
            Caption         =   "完全控制"
            BeginProperty Font 
               Name            =   "幼圆"
               Size            =   10.5
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   270
            Left            =   3120
            TabIndex        =   30
            Top             =   2160
            Width           =   1080
         End
         Begin VB.Label Label3 
            AutoSize        =   -1  'True
            Caption         =   "密码确认："
            BeginProperty Font 
               Name            =   "幼圆"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   210
            Left            =   480
            TabIndex        =   9
            Top             =   1560
            Width           =   1080
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "用户名："
            BeginProperty Font 
               Name            =   "幼圆"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   210
            Left            =   480
            TabIndex        =   8
            Top             =   390
            Width           =   870
         End
         Begin VB.Label Label2 
            AutoSize        =   -1  'True
            Caption         =   "密  码："
            BeginProperty Font 
               Name            =   "幼圆"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   210
            Left            =   480
            TabIndex        =   7
            Top             =   960
            Width           =   870
         End
      End
   End
End
Attribute VB_Name = "user_frm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs1 As New ADODB.Recordset  '可以考虑过程变量
Private Const sign = "用户信息框"
Private Sub Check1_Click(Index As Integer)
    Select Case Index
        Case 1
            If Check1(1).Value = 1 Then
                Check1(0).Value = 1
                Check1(0).Enabled = False
            Else
                Check1(0).Value = 0
                Check1(0).Enabled = True
            End If
        Case 2
            If Check1(2).Value = 1 Then
                Check1(0).Value = 1
                Check1(1).Value = 1
                Check1(0).Enabled = False
                Check1(1).Enabled = False
            Else
                Check1(0).Value = 0
                Check1(1).Value = 0
                Check1(0).Enabled = True
                Check1(1).Enabled = True
            End If
    End Select
End Sub

Private Sub Command1_Click()
    Dim tsql As String
    Dim mrc As New ADODB.Recordset
    If Trim(Text1.Text) = "" Then               '先判断用户框是否空
        MsgBox "请输入用户名！", vbExclamation
        Text1.SetFocus
        Exit Sub
    Else
        tsql = "SELECT * FROM 密码 WHERE 用户名='" & Trim(Text1.Text) & "';"
        mrc.Open tsql, con, adOpenDynamic, adLockOptimistic, adCmdText
        If Not mrc.EOF Then                       '唯一性检验
            MsgBox "该用户已经存在，请重新输入新用户！", vbExclamation
            Text1.Text = ""
            Text2.Text = ""
            Text3.Text = ""
            Text1.SetFocus
            Exit Sub
        End If
    End If
  
    If Trim(Text2.Text) = Empty Then        '然后判断密码框是否空
        MsgBox "密码不能为空，请输入密码!", vbExclamation
        Text2.SetFocus
        Exit Sub
    ElseIf Trim(Text2.Text) <> Trim(Text3.Text) Then
        MsgBox "两次输入的密码不一致，请重新输入!", vbExclamation
        Text2.SetFocus
        Text2.Text = ""
        Text3.Text = ""
        Exit Sub
    Else
    
    Dim right As String
    If Check1(0).Value = 0 And Check1(1).Value = 0 And Check1(2).Value = 0 Then
        MsgBox "请选择权限!", vbExclamation, sign
        Check1(0).SetFocus
        Exit Sub
    ElseIf Check1(2).Value = 1 Then 'chck1(0)  (1) 一定为1
        mrc.AddNew
        mrc.Fields(2) = "管理员"
        right = "管理员"
    ElseIf Check1(1).Value = 1 Then
        mrc.AddNew
        mrc.Fields(2) = "修改"
        right = "修改"
    Else
        mrc.AddNew
        mrc.Fields(2) = "读取"
        right = "读取"
    End If
    With mrc
        .Fields(0) = Trim(Text1.Text)
        .Fields(1) = Trim(Text2.Text)
        .Update
        .Close
    End With

End If

MsgBox "用户注册完毕!" & vbCrLf & "用户名为：" & Text1.Text & vbCrLf & "密码为：" & Text2.Text & vbCrLf & "用户权限为：" & right, 64, sign
    '因为用户的个数已经大于0(只要加一个即可）,所以使"删除用户"按钮可用
    MsgBox "用户新增完毕，请确定！", vbExclamation
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Text1.SetFocus
    '同时把列表框中的内容刷新一遍
    Form_Load
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Command3_Click()
    '如果选择的用户是正在使用的用户---规则：当前用户不能删除
    If Combo1.Text = "" Then
        MsgBox "请先选择您要删除的用户。", vbExclamation
        Exit Sub
    ElseIf Combo1.Text = UserName Then
        MsgBox "当前用户，不能删除！", vbExclamation
        Exit Sub
    End If
    Dim r As Byte
    r = MsgBox("确定删除" & Combo1.Text & "用户吗?", 33, "")
    If r = 1 Then
        Dim rs2 As ADODB.Recordset
        Dim sql As String
        sql = "SELECT * FROM 密码 WHERE 用户名 ='" & Trim(Combo1.Text) & "';"
        Set rs2 = New ADODB.Recordset
        rs2.Open sql, con, adOpenDynamic, adLockOptimistic, adCmdText
        rs2.Delete
        Combo1.Clear
        Call Form_Load
        rs2.Close
        Combo1.SetFocus
    End If
End Sub

Private Sub Command4_Click()
    Unload Me
End Sub

Private Sub Command5_Click()

Dim sql As String
    Dim rs2 As New ADODB.Recordset   '与另一个rs2不冲的，为什么？
    If Trim(Text5.Text) = Empty Then
        MsgBox "请输入旧密码！", vbExclamation, sign
        Text5.SetFocus
        Exit Sub
    ElseIf Trim(Text5.Text) <> OldPassword Then
        MsgBox "旧密码错误，请重输！", vbExclamation, sign
        Text5.Text = ""
        Text6.Text = Empty
        Text7.Text = Empty
        Text5.SetFocus
        Exit Sub
    Else
        If Trim(Text6.Text) <> Trim(Text7.Text) Or Trim(Text6.Text) = "" Or Trim(Text7.Text) = "" Then
            MsgBox "新密码和密码确认有错，请重输！", vbExclamation, sign
            Text6.SetFocus
            Text6.Text = ""
            Text7.Text = Empty
            Exit Sub
        Else
            sql = "SELECT * FROM 密码 WHERE 用户名='" & UserName & "'"
            rs2.Open sql, con, adOpenDynamic, adLockOptimistic, adCmdText
            rs2.Fields(1) = Trim(Text6.Text)
            rs2.Update
            rs2.Close
            OldPassword = Trim(Text6.Text)  '把新的密码给旧密码
        End If
        MsgBox "密码修改完毕，请确定！", vbInformation
        Text5.Text = Empty
        Text6.Text = Empty
        Text7.Text = Empty
    End If
End Sub

Private Sub Command6_Click()
    Unload Me
End Sub

Private Sub Form_Activate()
    Label10.Caption = UserName
    Label8.Caption = UserName
End Sub

Private Sub Form_Load()

    If Right1 = "管理员" Then
        Dim str1 As String
        str1 = "SELECT * FROM 密码;"
        rs1.Open str1, con, adOpenDynamic, adLockOptimistic, adCmdText
        '用来向第二张tab设置添加用户
        Dim i As Byte
        Combo1.Clear
        For i = 0 To rs1.RecordCount - 1
            Combo1.AddItem rs1.Fields(0)
            rs1.MoveNext
        Next i
        '因为rs1不和其他如datagrid/datacombo等绑定在一起，所以可以关闭。
        '添加列表，只要添加一次即可
        rs1.Close
    Else
        user_frm.SSTab1.TabVisible(2) = True
        user_frm.SSTab1.TabVisible(0) = False
        user_frm.SSTab1.TabVisible(1) = False
    End If

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Text2.SetFocus
    End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Text3.SetFocus
    End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Command1.SetFocus
    End If
End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Text6.SetFocus
    End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Text7.SetFocus
    End If
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Command5.SetFocus
    End If
End Sub