📄 guanliyuan.frm
字号:
VERSION 5.00
Begin VB.Form guanliyuan
Caption = "管理员"
ClientHeight = 7185
ClientLeft = 60
ClientTop = 420
ClientWidth = 9090
LinkTopic = "Form1"
Picture = "guanliyuan.frx":0000
ScaleHeight = 7185
ScaleWidth = 9090
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox txtnews
Height = 375
Left = 2400
TabIndex = 13
Text = "Text1"
Top = 3120
Width = 1335
End
Begin VB.CommandButton cmdmove
Caption = "|<"
Height = 345
Index = 0
Left = 1080
TabIndex = 12
Top = 3120
Width = 600
End
Begin VB.CommandButton cmdmove
Caption = ">|"
Height = 420
Index = 3
Left = 4440
TabIndex = 11
Top = 3120
Width = 600
End
Begin VB.CommandButton cmdseek
BackColor = &H0080C0FF&
Caption = "查询"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 720
Style = 1 'Graphical
TabIndex = 10
Top = 3960
Width = 1335
End
Begin VB.TextBox txtusername
BackColor = &H00FFFFC0&
DataSource = "DataEnvironment1"
Height = 375
Left = 2880
TabIndex = 7
Text = "Text2"
Top = 1440
Width = 1935
End
Begin VB.TextBox txtpassword
BackColor = &H00FFFFC0&
Height = 375
Left = 2880
TabIndex = 6
Text = "Text3"
Top = 2040
Width = 1935
End
Begin VB.CommandButton cmdmove
BackColor = &H00FFC0FF&
Caption = "<<"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 1680
Style = 1 'Graphical
TabIndex = 5
Top = 3120
Width = 735
End
Begin VB.CommandButton cmdmove
BackColor = &H000000C0&
Caption = ">>"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 2
Left = 3720
Style = 1 'Graphical
TabIndex = 4
Top = 3120
Width = 735
End
Begin VB.CommandButton cmdadd
BackColor = &H00C0E0FF&
Caption = "添加"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 720
Style = 1 'Graphical
TabIndex = 3
Top = 4680
Width = 1455
End
Begin VB.CommandButton cmddelete
BackColor = &H00C0C0FF&
Caption = "删除"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2760
Style = 1 'Graphical
TabIndex = 2
Top = 4680
Width = 1335
End
Begin VB.CommandButton cmdexit
BackColor = &H0080C0FF&
Caption = "退出"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4800
Style = 1 'Graphical
TabIndex = 1
Top = 4680
Width = 1335
End
Begin VB.CommandButton cmdsave
BackColor = &H000080FF&
Caption = "保存"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2520
Style = 1 'Graphical
TabIndex = 0
Top = 3960
Width = 1455
End
Begin VB.Label Label2
BackColor = &H00C0FFC0&
Caption = "用户名称："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1080
TabIndex = 9
Top = 1440
Width = 1575
End
Begin VB.Label Label3
BackColor = &H00C0FFC0&
Caption = "密码："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1080
TabIndex = 8
Top = 2040
Width = 1575
End
End
Attribute VB_Name = "guanliyuan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim isAdding As Boolean '定义操作状态标志
Dim objAdmin As Recordset '用于保存管理员数据表记录
Dim objCn As Connection '用于建立数据库联接
Private Sub cmdadd_Click()
txtnews = "添加新记录"
txtusername = ""
txtpassword = ""
isAdding = True
End Sub
Private Sub cmddelete_Click()
'根据是否处于添加记录状态执行不同的操作
If isAdding Then
'退出添加记录状态，显示当前记录
isAdding = False
If objAdmin.BOF And objAdmin.EOF Then
txtnews = "记录：无" '显示无记录提示
Else
'显示当前记录数据
txtusername = objAdmin.Fields("用户名称")
txtpassword = objAdmin.Fields("口令")
'显示当前记录编号和记录总数
txtnews = "记录：" & objAdmin.AbsolutePosition & "/" & objAdmin.RecordCount
End If
Else
If objAdmin.RecordCount > 0 Then
If MsgBox("是否删除当前记录？", vbYesNo + vbQuestion, "系统用户管理") = vbYes Then
objAdmin.Delete '执行删除当前记录操作
cmdmove(2).Value = True '显示下一记录数据
Else
'显示当前记录数据
txtusername = objAdmin.Fields("用户名")
txtpassword = objAdmin.Fields("口令")
'显示当前记录编号和记录总数
txtnews = "记录：" & objAdmin.AbsolutePosition & "/" & objAdmin.RecordCount
End If
End If
End If
End Sub
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub cmdMove_Click(Index As Integer)
With objAdmin
Select Case Index '切换当前记录
Case 0 '使第一个记录成为当前记录
If .RecordCount > 0 And Not .BOF Then .MoveFirst
Case 1 '使上一个记录成为当前记录
If .RecordCount > 0 And Not .BOF Then
.MovePrevious
If .BOF Then .MoveFirst
End If
Case 2 '使下一个记录成为当前记录
If .RecordCount > 0 And Not .EOF Then
.MoveNext
If .EOF Then .MoveLast
End If
Case 3 '使最后一个记录成为当前记录
If .RecordCount > 0 And Not .EOF Then .MoveLast
End Select
If .RecordCount < 1 Then
txtnews = "记录：无" '显示无记录提示
txtusername = ""
txtpassword = ""
Else
'显示当前记录数据
txtusername = .Fields("用户名称")
txtpassword = .Fields("密码")
'显示当前记录编号和记录总数
txtnews = "记录：" & .AbsolutePosition & "/" & .RecordCount
End If
End With
If isAdding Then isAdding = False '改变当前记录则退出当前添加记录状态
End Sub
Private Sub cmdsave_Click()
Dim objCopy As New Recordset
If Trim(txtusername) = "" Then
MsgBox "用户名不能为空！", vbCritical, "系统用户管理"
txtusername.SetFocus
txtusername = ""
ElseIf Len(Trim(txtpassword)) <> 6 Then
MsgBox "用户口令必须为6位字符串！", vbCritical, "系统用户管理"
txtpassword.SetFocus
txtpassword.SelStart = 0
txtpassword.SelLength = Len(txtpassword)
Else
Set objCopy = objAdmin.Clone
With objCopy
If .RecordCount > 0 Then
'检查用户名是否被使用
.MoveFirst
.Find "用户名称='" & Trim(txtusername) & "'"
If (isAdding And Not .EOF) Or (Not isAdding And Not .EOF And _
.AbsolutePosition <> objAdmin.AbsolutePosition) Then
MsgBox "用户名称：" & Trim(txtusername) & "已被使用，请使用其他用户名！", _
vbCritical, "系统用户管理"
txtusername.SetFocus
txtusername.SelStart = 0
txtusername.SelLength = Len(txtusername)
Exit Sub
End If
End If
End With
'保存或添加记录
If isAdding Then objAdmin.AddNew
objAdmin.Fields("用户名") = Trim(txtusername)
objAdmin.Fields("口令") = Trim(txtpassword)
objAdmin.Update
MsgBox "数据保存成功！", vbInformation, "系统用户管理"
isAdding = False
'显示当前记录编号和记录总数
txtnews = "记录：" & objAdmin.AbsolutePosition & "/" & objAdmin.RecordCount
End If
End Sub
Private Sub cmdseek_Click()
Dim strKey$
strKey = InputBox("请输入要查询的用户名！", "查询管理员")
If strKey = "" Then
MsgBox "输入无效！", vbInformation, "系统用户管理"
Else
With objAdmin
If .RecordCount > 0 Then
.MoveFirst
.Find "用户名称 like '*" & strKey & "*'"
If .EOF Then
MsgBox "无用户名称为 " & strKey & " 的管理员记录！", vbInformation, "系统用户管理"
Else
'显示当前记录数据
txtusername = .Fields("用户名称")
txtpassword = .Fields("密码")
'显示当前记录编号和记录总数
txtnews = "记录：" & .AbsolutePosition & "/" & .RecordCount
End If
Else
MsgBox "无管理员记录！", vbInformation, "系统用户管理"
End If
End With
End If
End Sub
Private Sub Form_Load()
'建立数据库联接
Set objCn = New Connection '实例化联接对象
With objCn '建立数据库联接
.Provider = "SQLOLEDB"
.ConnectionString = "User ID=sa;PWD=;Data Source=(local);" & _
"Initial Catalog=datatushu"
.Open
End With
'获取管理员记录
Set objAdmin = New Recordset '实例化objAdmin对象
With objAdmin
Set .ActiveConnection = objCn
.CursorLocation = adUseClient '指定使用客户端游标
.CursorType = adOpenStatic '指定使用静态游标
.LockType = adLockOptimistic
.Open "SELECT * FROM 管理者信息" '获取管理员登录信息
End With
'触发按钮单击事件，显示第一个记录
cmdmove(0).Value = True
End Sub
Private Sub txtnews_Change()
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -