frmcusi.frm

学生信息管理系统的设计,包含与数据库的通信接口和密码等.

            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "用户密码"
         Height          =   255
         Index           =   8
         Left            =   240
         TabIndex        =   31
         Top             =   960
         Width           =   975
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "用户名称"
         Height          =   255
         Index           =   7
         Left            =   240
         TabIndex        =   30
         Top             =   360
         Width           =   975
      End
   End
   Begin VB.ListBox List1 
      Appearance      =   0  'Flat
      Height          =   3450
      Left            =   240
      TabIndex        =   16
      Top             =   720
      Width           =   2415
   End
   Begin VB.Label Label2 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "  添   加"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   375
      Index           =   0
      Left            =   2880
      TabIndex        =   18
      Top             =   360
      Width           =   1335
   End
   Begin VB.Label Label2 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "  删   除"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   375
      Index           =   2
      Left            =   5520
      TabIndex        =   20
      Top             =   360
      Width           =   1335
   End
   Begin VB.Label Label2 
      Appearance      =   0  'Flat
      BackColor       =   &H00E0E0E0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "  修   改"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   375
      Index           =   1
      Left            =   4200
      TabIndex        =   19
      Top             =   360
      Width           =   1335
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      Caption         =   "   用  户  列  表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   375
      Left            =   240
      TabIndex        =   15
      Top             =   360
      Width           =   2415
   End
End
Attribute VB_Name = "frmcusi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mrc As ADODB.Recordset
Dim MsgText As String
Private Sub Command1_Click()
    Dim txtSQL As String
    If Text1(0) = "" Then
        MsgBox "用户名称不能为空!", vbOKOnly, "提示"
        Text1(0).SetFocus
        Exit Sub
    End If
    If Text1(1) = "" Then
        MsgBox "用户密码不能为空!", vbOKOnly, "提示"
        Text1(1).SetFocus
        Exit Sub
    Else
        If Text1(1) <> Text1(2) Then
            MsgBox "两次密码输入不同!", vbOKOnly, "提示"
            Text1(1) = ""
            Text1(2) = ""
            Text1(1).SetFocus
            Exit Sub
        End If
    End If
    txtSQL = "select * from user_Form where user_ID='" & Trim(Text1(0)) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = False Then
        MsgBox "此用户名已经存在!", vbOKOnly, "警告"
        Text1(0).SetFocus
        Exit Sub
    End If
    mrc.Close
    txtSQL = "select * from user_Form"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
    mrc.Fields(0) = Trim(Text1(0))
    mrc.Fields(1) = Trim(Text1(1))
    mrc.Fields(2) = Now
    mrc.Update
    mrc.Close
    For i = 0 To 2
        Text1(i) = ""
    Next
    MsgBox "用户信息添加成功!", vbOKOnly, "提示"
    Listapp
End Sub

Private Sub Command2_Click()
    Text1(0) = ""
    Text1(1) = ""
    Text1(2) = ""
End Sub

Private Sub Command3_Click()
    Dim txtSQL As String
    If Text1(3) = "" Then
        MsgBox "请你选择用户名称!", vbOKOnly, "提示"
        List1.SetFocus
        Exit Sub
    End If
    If Text1(4) = "" Then
        MsgBox "修改密码要旧密码!", vbOKOnly, "警告"
        Text1(4).SetFocus
        Exit Sub
    End If
    If Text1(5) = "" Then
        MsgBox "新的密码不能为空!", vbOKOnly, "提示"
        Text1(5).SetFocus
        Exit Sub
    Else
        If Text1(5) <> Text1(6) Then
            MsgBox "两次密码输入不同!", vbOKOnly, "提示"
            Text1(5) = ""
            Text1(6) = ""
            Text1(5).SetFocus
            Exit Sub
        End If
    End If
    txtSQL = "select * from user_Form where user_ID='" & Trim(Text1(3)) & "'and user_PWD='" & Trim(Text1(4)) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = False Then
        txtSQL = "delete from user_Form where user_ID='" & Trim(Text1(3)) & "'"
    Else
        MsgBox "用户密码输入错误!", vbOKOnly, "警告"
        Text1(4).SetFocus
        Exit Sub
    End If
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    txtSQL = "select * from user_Form"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    mrc.AddNew
    mrc.Fields(0) = Trim(Text1(3))
    mrc.Fields(1) = Trim(Text1(5))
    mrc.Fields(2) = Now
    mrc.Update
    mrc.Close
    For i = 3 To 6
        Text1(i) = ""
    Next
    MsgBox "用户信息修改成功!", vbOKOnly, "提示"
End Sub

Private Sub Command4_Click()
    Text1(3) = ""
    Text1(4) = ""
    Text1(5) = ""
    Text1(6) = ""
End Sub

Private Sub Command5_Click()
    Dim txtSQL As String
    If Text1(7) = "" Then
        MsgBox "请你选择用户名称!", vbOKOnly, "提示"
        List1.SetFocus
        Exit Sub
    Else
        If Text1(7) = UserName Then
            MsgBox "不可以删除正在使用的用户!", vbOKOnly, "警告"
            Text1(7) = ""
            Text1(8) = ""
            List1.SetFocus
            Exit Sub
        End If
    End If
    If Text1(8) = "" Then
        MsgBox "删除用户需要密码!", vbOKOnly, "警告"
        Text1(8).SetFocus
        Exit Sub
    End If
    txtSQL = "select * from user_Form where user_ID='" & Trim(Text1(7)) & "'and user_PWD='" & Trim(Text1(8)) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = False Then
        txtSQL = "delete from user_Form where user_ID='" & Trim(Text1(7)) & "'"
    Else
        MsgBox "用户密码输入错误!", vbOKOnly, "警告"
        Text1(8).SetFocus
        Exit Sub
    End If
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    Text1(7) = ""
    Text1(8) = ""
    MsgBox "用户信息已经删除!", vbOKOnly, "提示"
    Listapp
End Sub

Private Sub Command6_Click()
    Text1(7) = ""
    Text1(8) = ""
End Sub

Private Sub Form_Load()
    Me.Caption = "用户信息->添   加"
    Picture1(1).Top = Picture1(0).Top
    Picture1(1).Left = Picture1(0).Left
    Picture1(2).Top = Picture1(0).Top
    Picture1(2).Left = Picture1(0).Left
    Listapp
    For i = 0 To 2
        Label2(i).BackColor = &HE0E0E0
        Picture1(i).Visible = False
    Next
    Label2(0).BackColor = &HFFFFFF
    Picture1(0).Visible = True
End Sub

Private Sub Label2_Click(Index As Integer)
    Me.Caption = "用户信息"
    Me.Caption = Me.Caption & "->" & Trim(Label2(Index).Caption)
    For i = 0 To 2
        Label2(i).BackColor = &HE0E0E0
        Picture1(i).Visible = False
    Next
    Label2(Index).BackColor = &HFFFFFF
    Picture1(Index).Visible = True
    For i = 0 To 8
        Text1(i) = ""
    Next
End Sub
Private Sub Form_Resize()
    dColor.ZOrder 1
End Sub
Private Sub Listapp()
    Dim txSQL As String
    Dim mrcc As ADODB.Recordset
    txSQL = "select * from user_Form"
    Set mrcc = ExecuteSQL(txSQL, MsgText)
    List1.Clear
    Do While Not mrcc.EOF
        List1.AddItem Trim(mrcc!user_ID)
        mrcc.MoveNext
    Loop
    mrcc.Close
End Sub

Private Sub List1_Click()
    If Picture1(1).Visible = True Then
        Text1(3) = List1.Text
    End If
    If Picture1(2).Visible = True Then
        Text1(7) = List1.Text
    End If
End Sub

Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
    EnterToTab KeyCode
End Sub

Private Sub Text1_GotFocus(Index As Integer)
    Text1(Index).SelStart = 0
    Text1(Index).SelLength = Len(Text1(Index))
End Sub