📄 frmuser.frm
字号:
VERSION 5.00
Object = "{E684D8A3-716C-4E59-AA94-7144C04B0074}#1.1#0"; "GRIDEX20.OCX"
Begin VB.Form frmUser
BorderStyle = 3 'Fixed Dialog
Caption = "Form1"
ClientHeight = 4005
ClientLeft = 45
ClientTop = 450
ClientWidth = 5730
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4005
ScaleWidth = 5730
ShowInTaskbar = 0 'False
Begin GridEX20.GridEX Grid
Height = 3015
Left = 150
TabIndex = 13
Top = 225
Width = 2640
_ExtentX = 4657
_ExtentY = 5318
Version = "2.0"
BoundColumnIndex= ""
ReplaceColumnIndex= ""
ColumnAutoResize= -1 'True
GroupByBoxVisible= 0 'False
RowHeaders = -1 'True
ColumnHeaderHeight= 270
IntProp1 = 0
IntProp2 = 0
IntProp7 = 0
ColumnsCount = 2
Column(1) = "frmUser.frx":0000
Column(2) = "frmUser.frx":00C8
FormatStylesCount= 5
FormatStyle(1) = "frmUser.frx":016C
FormatStyle(2) = "frmUser.frx":02B0
FormatStyle(3) = "frmUser.frx":0360
FormatStyle(4) = "frmUser.frx":0414
FormatStyle(5) = "frmUser.frx":04EC
ImageCount = 0
PrinterProperties= "frmUser.frx":05A4
End
Begin VB.CommandButton cmdDel
Caption = "删除"
Height = 465
Left = 4275
TabIndex = 8
Top = 3375
Width = 1215
End
Begin VB.CommandButton cmdSave
Caption = "保存"
Height = 465
Left = 2925
TabIndex = 7
Top = 3375
Width = 1215
End
Begin VB.CommandButton cmdEdit
Caption = "修改"
Height = 465
Left = 1575
TabIndex = 6
Top = 3375
Width = 1215
End
Begin VB.CommandButton cmdAdd
Caption = "新增"
Height = 465
Left = 225
TabIndex = 5
Top = 3375
Width = 1215
End
Begin VB.Frame Frame1
Caption = "用户信息"
Height = 3120
Left = 2925
TabIndex = 0
Top = 150
Width = 2670
Begin VB.TextBox txtPwd3
Height = 315
Left = 975
TabIndex = 12
Text = "Text1"
Top = 1995
Width = 1215
End
Begin VB.TextBox txtPwd2
Height = 315
Left = 975
TabIndex = 11
Text = "Text1"
Top = 1580
Width = 1215
End
Begin VB.TextBox txtPwd1
Height = 315
Left = 975
TabIndex = 10
Text = "Text1"
Top = 1165
Width = 1215
End
Begin VB.TextBox txtName
Height = 315
Left = 975
TabIndex = 9
Text = "Text1"
Top = 750
Width = 1215
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "用 户 名:"
Height = 180
Left = 135
TabIndex = 4
Top = 817
Width = 810
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "重输密码:"
Height = 195
Left = 135
TabIndex = 3
Top = 2055
Width = 765
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "输入密码:"
Height = 195
Left = 135
TabIndex = 2
Top = 1636
Width = 765
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "原始密码:"
Height = 195
Left = 135
TabIndex = 1
Top = 1219
Width = 765
End
End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rstGrid As New ADODB.Recordset
Dim rstExec As New ADODB.Recordset
Dim m_Edit As Boolean
Dim m_LoginID As Integer
Dim m_Password As String
Private Sub cmdAdd_Click()
If Trim(LoginName) <> "Admin" Then
Message "你没有新增的权限!"
Exit Sub
End If
txtName.Enabled = True
txtPwd1.Enabled = False
txtPwd2.Enabled = True
txtPwd3.Enabled = True
txtName.Text = ""
txtPwd1.Text = ""
txtPwd2.Text = ""
txtPwd3.Text = ""
txtName.SetFocus
m_Edit = False
End Sub
Private Sub cmdDel_Click()
If Trim(LoginName) <> "Admin" Then
Message "你没有删除的权限!"
Exit Sub
End If
If Trim(rstGrid.Fields("Name")) = "Admin" Then
Message "管理员帐号不能删除!"
Exit Sub
End If
If MsgBox("确定删除?", vbInformation + vbYesNo, "询问") = vbNo Then
Exit Sub
End If
Grid.AllowDelete = True
Grid.Delete
AllClose
End Sub
Private Sub cmdEdit_Click()
If Grid.RowCount = 0 Then
Message "没有可用信息!"
Exit Sub
End If
txtName.Enabled = True
txtPwd1.Enabled = True
txtPwd2.Enabled = True
txtPwd3.Enabled = True
txtName.Text = rstGrid.Fields("Name")
If Trim(rstGrid.Fields("name")) = "Admin" Then txtName.Enabled = False
txtPwd1.Text = ""
txtPwd2.Text = ""
txtPwd3.Text = ""
m_Edit = True
If IsNull(rstGrid.Fields("Password")) Then m_Password = "" Else m_Password = Trim(rstGrid.Fields("Password"))
m_LoginID = rstGrid.Fields("LoginID")
txtPwd1.SetFocus
End Sub
Private Sub cmdSave_Click()
Dim sPwd As String
If Trim(txtName.Text) = "" Then
Message "请输入用户名!"
Exit Sub
End If
If Trim(txtPwd2.Text) <> Trim(txtPwd3.Text) Then
Message "两次密码不一致!"
Exit Sub
End If
Dim strSQL As String
If m_Edit = False Then
If rstExec.State = 1 Then rstExec.Close
Set rstExec = Nothing
rstExec.CursorLocation = adUseClient
rstExec.Open "select * from login where name='" & txtName.Text & "'", con, adOpenStatic, adLockBatchOptimistic
If rstExec.RecordCount > 0 Then
Message "该用户名已存在!"
Exit Sub
End If
rstExec.AddNew
rstExec.Fields("Name") = Trim(txtName.Text)
rstExec.UpdateBatch
If rstExec.State = 1 Then rstExec.Close
Set rstExec = Nothing
rstExec.CursorLocation = adUseClient
rstExec.Open "select top 1 * from login where name='" & txtName.Text & "'", con, adOpenStatic, adLockBatchOptimistic
If rstExec.RecordCount > 0 Then
m_LoginID = rstExec.Fields("LoginID")
Else
Message "记录未找到!"
Exit Sub
End If
m_LoginID = rstExec.Fields("LoginID")
sPwd = Trim(txtPwd2.Text)
rstExec.Fields("Password") = sPwd
rstExec.UpdateBatch
' strSQL = "insert into login(Name,Password) values('" & Trim(txtName.Text) & "','" & Trim(txtPwd2.Text) & "')"
' con.Execute strSQL
LoadGrid
Call cmdAdd_Click
Else
sPwd = Trim(txtPwd1.Text)
If sPwd <> m_Password Then
Message "原始密码不正确!"
Exit Sub
End If
If rstExec.State = 1 Then rstExec.Close
Set rstExec = Nothing
rstExec.CursorLocation = adUseClient
rstExec.Open "select * from login where LoginID=" & m_LoginID, con, adOpenStatic, adLockBatchOptimistic
If rstExec.RecordCount < 1 Then
Message "记录未找到!"
Exit Sub
End If
sPwd = Trim(txtPwd2.Text)
rstExec.Fields("Name") = Trim(txtName.Text)
rstExec.Fields("Password") = sPwd
rstExec.UpdateBatch
' strSQL = "update login1 set name1='" & Trim(txtName.Text) & "' ,password1='" & Trim(txtPwd2.Text) & "' where LoginID=" & m_LoginID
' Debug.Print strSQL
' con.Execute strSQL
LoadGrid
AllClose
Message "更改成功!"
End If
End Sub
Private Sub Form_Load()
Me.Icon = frmMain.Icon
Me.Caption = "用户管理"
LoadGrid
End Sub
Private Sub LoadGrid()
If rstGrid.State = 1 Then rstGrid.Close
Set rstGrid = Nothing
rstGrid.CursorLocation = adUseClient
rstGrid.Open "select * from login", con, adOpenStatic, adLockOptimistic
Set Grid.ADORecordset = rstGrid
Grid.Columns(1).Visible = False
Grid.Columns(2).Caption = "用户名"
Grid.Columns(3).Visible = False
Grid.AllowAddNew = False
Grid.AllowEdit = False
Grid.SelectionStyle = jgexEntireRow
AllClose
End Sub
Sub AllClose()
txtName.Text = ""
txtPwd1.Text = ""
txtPwd2.Text = ""
txtPwd3.Text = ""
txtName.Enabled = False
txtPwd1.Enabled = False
txtPwd2.Enabled = False
txtPwd3.Enabled = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If rstGrid.State = 1 Then rstGrid.Close
Set rstGrid = Nothing
End Sub
Private Sub sButton1_Click()
End Sub
Private Sub Grid_Click()
If Grid.RowCount = 0 Then
Message "没有可用信息!"
Exit Sub
End If
txtName.Enabled = False
txtPwd1.Enabled = False
txtPwd2.Enabled = False
txtPwd3.Enabled = False
txtName.Text = rstGrid.Fields("Name")
txtPwd1.Text = ""
txtPwd2.Text = ""
txtPwd3.Text = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -