📄 frmadduser.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmAddUser
BorderStyle = 1 'Fixed Single
Caption = "用户管理"
ClientHeight = 4245
ClientLeft = 45
ClientTop = 330
ClientWidth = 8310
Icon = "frmAddUser.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4245
ScaleWidth = 8310
Begin VB.Frame Frame2
Caption = "添加用户"
Height = 3735
Left = 4680
TabIndex = 2
Top = 120
Width = 3495
Begin VB.TextBox txtPwdt
Height = 270
IMEMode = 3 'DISABLE
Left = 1200
PasswordChar = "*"
TabIndex = 10
Top = 1920
Width = 2055
End
Begin VB.TextBox txtPwd
Height = 270
IMEMode = 3 'DISABLE
Left = 1200
PasswordChar = "*"
TabIndex = 9
Top = 1200
Width = 2055
End
Begin VB.ComboBox cboZ
Height = 300
Left = 1200
TabIndex = 6
Text = "Combo1"
Top = 2640
Width = 2055
End
Begin VB.TextBox txtUser
Height = 270
Left = 1200
TabIndex = 3
Top = 480
Width = 2055
End
Begin MSForms.CommandButton cmdDel
Height = 375
Left = 1200
TabIndex = 13
Top = 3120
Width = 975
Caption = "删除"
PicturePosition = 327683
Size = "1720;661"
Picture = "frmAddUser.frx":0442
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin VB.Label Label4
Caption = "确认密码:"
Height = 255
Left = 240
TabIndex = 12
Top = 1920
Width = 855
End
Begin VB.Label Label3
Caption = "密 码:"
Height = 255
Left = 240
TabIndex = 11
Top = 1200
Width = 735
End
Begin VB.Label Label2
Caption = "属于的组:"
Height = 255
Left = 240
TabIndex = 8
Top = 2640
Width = 855
End
Begin VB.Label Label1
Caption = "用户名："
Height = 375
Left = 240
TabIndex = 7
Top = 480
Width = 735
End
Begin MSForms.CommandButton cmdReturn
Height = 375
Left = 2280
TabIndex = 5
Top = 3120
Width = 1095
Caption = "返回"
PicturePosition = 327683
Size = "1931;661"
Picture = "frmAddUser.frx":257C
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdAdd
Height = 375
Left = 120
TabIndex = 4
Top = 3120
Width = 975
Caption = "添加"
PicturePosition = 327683
Size = "1720;661"
Picture = "frmAddUser.frx":47B6
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
End
Begin VB.Frame Frame1
Caption = "用户列表"
Height = 3975
Left = 0
TabIndex = 0
Top = 0
Width = 4455
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 3495
Left = 120
TabIndex = 1
Top = 360
Width = 4215
_ExtentX = 7435
_ExtentY = 6165
_Version = 393216
SelectionMode = 1
AllowUserResizing= 1
End
End
End
Attribute VB_Name = "frmAddUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type UserZu
ZuName As String
Cjz As String
End Type
Private Sub cmdAdd_Click()
Dim strUser As String
Dim strPwd As String
Dim strPwdt As String
Dim strZName As String
strUser = Trim(txtUser)
strPwd = Trim(txtPWD)
strPwdt = Trim(txtPwdt)
If strUser = "" Then
MsgBox "用户名不能为空"
TextFocus txtUser
Exit Sub
End If
If strPwd = "" Or strPwdt = "" Then
txtPWD = ""
txtPwdt = ""
MsgBox "密码不能为空"
TextFocus txtPWD
Exit Sub
End If
If strPwd <> strPwdt Then
MsgBox "两次密码不一致！"
TextFocus txtPWD
Exit Sub
End If
If chkcboz = False Then
MsgBox "没有此组！"
TextFocus cboZ
Exit Sub
End If
Dim strSql As String
Dim strMsg As String
Dim rs As New ADODB.Recordset
strSql = "select * from t_user where 用户='" & strUser & "'"
Set rs = ExecuteSQL(strSql, strMsg)
If Not rs.EOF Then
MsgBox "已有相同的用户名！"
TextFocus txtUser
Exit Sub
End If
rs.Close
strSql = "select * from t_user"
Set rs = ExecuteSQL(strSql, strMsg)
rs.AddNew
rs.Fields("用户") = strUser
rs.Fields("密码") = strPwd
rs.Fields("组") = Trim(cboZ.Text)
rs.Fields("创建时间") = Now
rs.Update
rs.Close
Set rs = Nothing
Call Form_Load
MsgBox "一个用户被成功创建!"
End Sub
Private Sub cmdDel_Click()
Dim strUser As String
If Grid1.Rows <= 1 Then Exit Sub
If Grid1.Row < 1 Then Exit Sub
strUser = Grid1.TextMatrix(Grid1.Row, 1)
If strUser = m_UN Then
MsgBox "不能删除自身！"
Exit Sub
End If
If MsgBox("你真的要删除该用户吗？", vbQuestion + vbYesNo) = vbYes Then
Dim strSql As String
Dim strMsg As String
Dim rs As New ADODB.Recordset
strSql = "delete * from t_user where 用户='" & strUser & "'"
Set rs = ExecuteSQL(strSql, strMsg)
Call Form_Load
End If
End Sub
Private Sub cmdReturn_Click()
Unload Me
End Sub
Private Function getNextZu(myzu() As UserZu, zname As String)
i = 1
Do While i <= UBound(myzu)
If myzu(i).Cjz = zname Then
cboZ.AddItem myzu(i).ZuName
Call getNextZu(myzu, myzu(i).ZuName)
End If
i = i + 1
Loop
If i > UBound(myzu) Then
Exit Function
End If
End Function
Private Sub Form_Load()
Me.Left = ReadIni("用户管理", "left")
Me.Top = ReadIni("用户管理", "top")
Dim myzu() As UserZu
Dim strSql As String
Dim strMsg As String
Dim rs As New Recordset
strSql = "select * from t_zqx"
Set rs = ExecuteSQL(strSql, strMsg)
ReDim myzu(rs.RecordCount)
For i = 1 To rs.RecordCount
myzu(i).ZuName = rs.Fields("组名")
myzu(i).Cjz = rs.Fields("创建者")
rs.MoveNext
Next
cboZ.Clear
Call getNextZu(myzu, m_UZ)
cboZ.AddItem m_UZ
rs.Close
strSql = "select 用户,组,创建时间 from t_user"
For i = 0 To cboZ.ListCount - 1
If i = 0 Then
strSql = strSql & " where 组='" & cboZ.List(i) & "'"
Else
strSql = strSql & " or 组='" & cboZ.List(i) & "'"
End If
Next
Set rs = ExecuteSQL(strSql, strMsg)
Call FillData(rs, Grid1)
End Sub
'判断是否有组
Private Function chkcboz() As Boolean
Dim zname
zname = Trim(cboZ.Text)
For i = 0 To cboZ.ListCount - 1
If zname = cboZ.List(i) Then
chkcboz = True
Exit Function
End If
Next
chkcboz = False
End Function
Private Sub Form_Unload(Cancel As Integer)
Call WriteIni("用户管理", "left", Me.Left)
Call WriteIni("用户管理", "top", Me.Top)
End Sub
Private Sub Grid1_Click()
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -