📄 foruser1.frm
字号:
VERSION 5.00
Begin VB.Form frmuser1
BorderStyle = 3 'Fixed Dialog
Caption = "新增用户"
ClientHeight = 4350
ClientLeft = 2505
ClientTop = 3165
ClientWidth = 6780
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4350
ScaleWidth = 6780
ShowInTaskbar = 0 'False
Begin VB.CheckBox Check1
Caption = " 学生成绩管理"
ForeColor = &H00FF0000&
Height = 255
Index = 2
Left = 3000
TabIndex = 14
Top = 2760
Width = 1935
End
Begin VB.CheckBox Check1
Caption = " 学生信息管理"
ForeColor = &H00FF0000&
Height = 255
Index = 1
Left = 3000
TabIndex = 13
Top = 2280
Width = 1935
End
Begin VB.Frame frame1
Caption = "新增用户"
ForeColor = &H000000FF&
Height = 3975
Left = 240
TabIndex = 0
Top = 240
Width = 6255
Begin VB.CommandButton Command2
Caption = "取消"
Height = 375
Left = 3840
TabIndex = 16
Top = 3360
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 375
Left = 960
TabIndex = 15
Top = 3360
Width = 1455
End
Begin VB.TextBox Text1
BackColor = &H00C0FFFF&
Height = 270
Index = 2
Left = 4680
TabIndex = 8
Top = 600
Width = 1215
End
Begin VB.TextBox Text1
BackColor = &H00C0FFFF&
Height = 270
Index = 1
Left = 2280
TabIndex = 7
Top = 600
Width = 1215
End
Begin VB.TextBox Text1
BackColor = &H00C0FFFF&
Height = 270
Index = 0
Left = 2280
TabIndex = 6
Top = 240
Width = 1215
End
Begin VB.Frame Frame3
Caption = "权限"
ForeColor = &H000000FF&
Height = 1695
Left = 2520
TabIndex = 2
Top = 1320
Width = 3135
Begin VB.CheckBox Check1
Caption = " 系统管理"
ForeColor = &H00FF0000&
Height = 255
Index = 0
Left = 240
TabIndex = 12
Top = 240
Width = 1935
End
End
Begin VB.Frame Frame2
Caption = "用户类别"
ForeColor = &H000000FF&
Height = 1695
Left = 240
TabIndex = 1
Top = 1320
Width = 1815
Begin VB.OptionButton Option1
Caption = " 超级用户"
ForeColor = &H00FF0000&
Height = 255
Index = 2
Left = 120
TabIndex = 11
Top = 1200
Width = 1335
End
Begin VB.OptionButton Option1
Caption = " 普通用户"
ForeColor = &H00FF0000&
Height = 255
Index = 1
Left = 120
TabIndex = 10
Top = 720
Width = 1335
End
Begin VB.OptionButton Option1
Caption = " 只读用户"
ForeColor = &H00FF0000&
Height = 255
Index = 0
Left = 120
TabIndex = 9
Top = 240
Width = 1335
End
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "确定密码："
ForeColor = &H00FF0000&
Height = 180
Left = 3720
TabIndex = 5
Top = 600
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "密码："
ForeColor = &H00FF0000&
Height = 180
Left = 1680
TabIndex = 4
Top = 600
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "新用户名："
ForeColor = &H00FF0000&
Height = 180
Left = 1320
TabIndex = 3
Top = 240
Width = 900
End
End
End
Attribute VB_Name = "frmuser1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Const MF_REMOVE = &H1000&
Private Const SC_COLSE = &HF060
Private Sub Command1_Click()
If Trim(Text1(0).Text) = "" Then
MsgBox "用户名不能为空！", vbExclamation + vbOKOnly, "警告"
Text1(0).SetFocus
Exit Sub
End If
If Trim(Text1(1).Text) = "" Then
MsgBox "密码不能为空！", vbExclamation + vbOKOnly, "警告"
Text1(1).SetFocus
Exit Sub
End If
If Trim(Text1(2).Text) = "" Then
MsgBox "确认密码不能为空！", vbExclamation + vbOKOnly, "警告"
Text1(2).SetFocus
Exit Sub
End If
If Trim(Text1(1).Text) <> Trim(Text1(2).Text) Then
MsgBox "确认密码不正确！", vbExclamation + vbOKOnly, "警告"
Text1(2).SetFocus
Exit Sub
End If
Dim aa As Integer
aa = 0
If Option1(2).Value = True Then
For i = 0 To 3
If Check1(i).Value = 1 Then
aa = 1
Exit For
End If
Next i
If aa = 0 Then
MsgBox " 普通用户至少要有一项权限！", vbExclamation + vbOKOnly, "警告"
Exit Sub
End If
End If
Dim mrc As ADODB.Recordset
txtSQL = "select * from use where username='" & Trim(Text1(0).Text) & "'"
Set mrc = ExecuteSQL(txtSQL)
If mrc.EOF = False Then
MsgBox " 已存在该用户！", vbExclamation + vbOKOnly, "警告"
Text1(0).SetFocus
Text1(0).SelStart = 0
Text1(0).SelLength = Len(Text1(0).Text)
Exit Sub
End If
txtSQL = "select * from use"
Set mrc = ExecuteSQL(txtSQL)
mrc.AddNew
mrc.Fields(0) = Trim(Text1(0).Text)
mrc.Fields(1) = Trim(Text1(1).Text)
For i = 0 To 2
If Option1(i).Value = True Then
Select Case i
Case 0
mrc.Fields("admin") = "y"
Case 1
mrc.Fields("readonly") = "y"
Case 2
For j = 0 To 3
If Check1(j).Value = 1 Then
Select Case j
Case 0
mrc.Fields("qx1") = "y"
Case 1
mrc.Fields("qx2") = "y"
Case 2
mrc.Fields("qx3") = "y"
Case 3
mrc.Fields("qx4") = "y"
End Select
End If
Next j
End Select
End If
Next i
mrc.Update
MsgBox " 用户添加成功！", vbExclamation + vbOKOnly, "警告"
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
RemoveMenu GetSystemMenu(frmuser1.hWnd, 0), SC_COLSE, MF_REMOVE
Option1(0).Value = True
End Sub
Private Sub Form_Resize()
Text1(0).SetFocus
End Sub
Private Sub Option1_Click(Index As Integer)
If Index <> 2 Then
For i = 0 To 2
Check1(i).Enabled = False
Next i
Else
For i = 0 To 2
Check1(i).Enabled = True
Next i
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -