📄 form8.frm
字号:
BorderColor = &H00FFFFFF&
X1 = 120
X2 = 3600
Y1 = 1450
Y2 = 1450
End
End
Begin VB.Frame Frame4
Height = 2535
Left = -74520
TabIndex = 6
Top = 600
Width = 3735
Begin VB.CommandButton Command10
Caption = "取消"
Height = 320
Left = 2280
TabIndex = 11
Top = 1920
Width = 1095
End
Begin VB.CommandButton Command9
Caption = "确定"
Height = 320
Left = 360
TabIndex = 10
Top = 1920
Width = 1095
End
Begin VB.TextBox Text10
Height = 300
IMEMode = 3 'DISABLE
Left = 1680
PasswordChar = "*"
TabIndex = 9
Top = 1200
Width = 1935
End
Begin VB.TextBox Text9
Height = 300
IMEMode = 3 'DISABLE
Left = 1680
PasswordChar = "*"
TabIndex = 8
Top = 720
Width = 1935
End
Begin VB.TextBox Text8
Height = 300
Left = 1680
Locked = -1 'True
TabIndex = 7
Top = 360
Width = 1935
End
Begin VB.Label Label12
Alignment = 2 'Center
Caption = "密码确认："
Height = 255
Left = 360
TabIndex = 14
Top = 1200
Width = 975
End
Begin VB.Label Label11
Alignment = 2 'Center
Caption = "用户密码："
Height = 255
Left = 240
TabIndex = 13
Top = 840
Width = 1215
End
Begin VB.Label Label10
Alignment = 2 'Center
Caption = "删除用户名："
Height = 255
Left = 240
TabIndex = 12
Top = 480
Width = 1335
End
Begin VB.Line Line5
X1 = 120
X2 = 3600
Y1 = 1680
Y2 = 1680
End
Begin VB.Line Line6
BorderColor = &H00FFFFFF&
X1 = 120
X2 = 3600
Y1 = 1690
Y2 = 1690
End
End
Begin VB.Frame Frame5
Height = 1335
Left = -74520
TabIndex = 1
Top = 720
Width = 3735
Begin VB.TextBox Text6
Height = 300
IMEMode = 3 'DISABLE
Left = 1440
PasswordChar = "*"
TabIndex = 3
Top = 360
Width = 2175
End
Begin VB.TextBox Text7
Height = 300
IMEMode = 3 'DISABLE
Left = 1440
PasswordChar = "*"
TabIndex = 2
Top = 840
Width = 2175
End
Begin VB.Label Label8
Caption = "输入新密码："
Height = 375
Left = 120
TabIndex = 5
Top = 360
Width = 1215
End
Begin VB.Label Label9
Caption = "密码确认："
Height = 255
Left = 120
TabIndex = 4
Top = 840
Width = 1215
End
End
End
End
Attribute VB_Name = "Form8"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Dim m, n As Single
Private Declare Sub SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Dim mimauser(), mimapass() As String
Dim usercount As Integer
Private Sub Command1_Click()
SSTab1.Tab = 1
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub
Private Sub Command10_Click()
SSTab1.Tab = 0
End Sub
Private Sub Command11_Click()
If Text6.Text = "" Or Text7.Text = "" Then
rr = MsgBox("请输入新密码或新验证密码！", vbOKOnly, "提示")
Exit Sub
End If
If Trim(Text6.Text) <> Trim(Text7.Text) Then
rr = MsgBox("输入的新密码与新验证密码不一致！", vbOKOnly, "提示")
Exit Sub
Else
Adodc1.ConnectionString = " Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & curpath + "wupin.mdb;Persist Security Info=False"
Adodc1.CommandType = adCmdText
Me.Adodc1.RecordSource = "select * from login where user =" & "'" & Combo1.Text & "'"
Me.Adodc1.Refresh
'Me.Adodc1.Recordset.Edit
Me.Adodc1.Recordset.Fields("mima").Value = Trim(Text6.Text)
Me.Adodc1.Recordset.Update
rr = MsgBox("更改密码成功，请保存好新密码！", vbOKOnly, "提示")
SSTab1.Tab = 0
End If
End Sub
Private Sub Command12_Click()
SSTab1.Tab = 2
End Sub
Private Sub Command2_Click()
SSTab1.Tab = 2
Text4.Text = Combo1.Text
Text5.Text = ""
End Sub
Private Sub Command3_Click()
If Text2.Text = "" Or Text3.Text = "" Then
rr = MsgBox("请填写用户密码或确认密码！", vbOKOnly, "提示")
Exit Sub
End If
If Text2.Text <> Text3.Text Then
rr = MsgBox("密码不一致！", vbOKOnly, "提示")
Exit Sub
End If
Adodc1.ConnectionString = " Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & curpath + "wupin.mdb;Persist Security Info=False"
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from login"
Adodc1.Refresh
Me.Adodc1.Recordset.AddNew
Me.Adodc1.Recordset.Fields("user").Value = Trim(Text1.Text)
Me.Adodc1.Recordset.Fields("mima").Value = Trim(Text2.Text)
Me.Adodc1.Recordset.Update
rr = MsgBox("新用户添加成功，请保存号密码！", vbOKOnly, "提示")
Call comboref
SSTab1.Tab = 0
End Sub
Private Sub Command4_Click()
SSTab1.Tab = 0
End Sub
Private Sub Command5_Click()
If usercount < 2 Then
rr = MsgBox("当前只有一个用户，不能删除！", vbOKOnly, "提示")
Exit Sub
Else
SSTab1.Tab = 3
Text8.Text = Combo1.Text
Text9.Text = ""
Text10.Text = ""
End If
End Sub
Private Sub Command6_Click()
Unload Me
End Sub
Private Sub Command7_Click()
If Text5.Text = "" Then
rr = MsgBox("请输入原密码！", vbOKOnly, "提示")
Exit Sub
End If
If Trim(Text5.Text) <> mimapass(Combo1.ListIndex + 1) Then
rr = MsgBox("输入密码与原密码不一致，无权更改密码！", vbOKOnly, "提示")
Exit Sub
Else
SSTab1.Tab = 4
End If
End Sub
Private Sub Command8_Click()
SSTab1.Tab = 0
End Sub
Private Sub Command9_Click()
If Text9.Text = "" Then
rr = MsgBox("请输入原用户密码！", vbOKOnly, "提示")
Exit Sub
End If
If Trim(Text9.Text) <> Trim(Text10.Text) Then
rr = MsgBox("输入的原用户密码与验证原用户密码不一致！", vbOKOnly, "提示")
Exit Sub
End If
If Trim(Text9.Text) <> mimapass(Combo1.ListIndex + 1) Then
rr = MsgBox("输入密码与原密码不一致，无权删除该用户！", vbOKOnly, "提示")
Exit Sub
End If
Me.Adodc1.RecordSource = "select * from login where user =" & "'" & Combo1.Text & "'"
Me.Adodc1.Refresh
Me.Adodc1.Recordset.Delete
rr = MsgBox("删除用户成功！", vbOKOnly, "提示")
Call comboref
SSTab1.Tab = 0
End Sub
Private Sub Form_Initialize()
If Right(App.path, 1) = "\" Then ' 若 App.Path 为根目录
curpath = App.path
Else
curpath = App.path + "\"
End If
Call comboref
End Sub
Private Sub Form_Load()
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
Adodc1.ConnectionString = " Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & curpath + "wupin.mdb;Persist Security Info=False"
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from login"
Adodc1.Refresh
usercount = Me.Adodc1.Recordset.RecordCount
End Sub
Sub comboref()
Adodc1.ConnectionString = " Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & curpath + "wupin.mdb;Persist Security Info=False"
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from login"
Adodc1.Refresh
usercount = Me.Adodc1.Recordset.RecordCount
If Me.Adodc1.Recordset.RecordCount > 0 Then
Combo1.Clear
ReDim mimauser(Me.Adodc1.Recordset.RecordCount)
ReDim mimapass(Me.Adodc1.Recordset.RecordCount)
Dim i As Integer
Me.Adodc1.Recordset.MoveFirst
Do Until Me.Adodc1.Recordset.EOF
i = i + 1
mimauser(i) = Me.Adodc1.Recordset.Fields("user").Value
Combo1.AddItem mimauser(i)
mimapass(i) = Me.Adodc1.Recordset.Fields("mima").Value
Me.Adodc1.Recordset.MoveNext
Loop
End If
Combo1.ListIndex = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -