📄 frmmmxg.frm
字号:
VERSION 5.00
Begin VB.Form Frmmmxg
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "密码修改"
ClientHeight = 2790
ClientLeft = 45
ClientTop = 330
ClientWidth = 3210
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "Frmmmxg.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2790
ScaleWidth = 3210
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox Txtsrxmm
BeginProperty Font
Name = "@宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
IMEMode = 3 'DISABLE
Left = 1365
MaxLength = 8
PasswordChar = "*"
TabIndex = 7
Top = 1065
Width = 1665
End
Begin VB.TextBox Txtqrmm
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
IMEMode = 3 'DISABLE
Left = 1365
MaxLength = 8
PasswordChar = "*"
TabIndex = 6
Top = 1545
Width = 1665
End
Begin VB.TextBox Txtxm
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1365
TabIndex = 3
Top = 105
Width = 1665
End
Begin VB.TextBox Txtmm
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
IMEMode = 3 'DISABLE
Left = 1365
PasswordChar = "*"
TabIndex = 2
Top = 585
Width = 1665
End
Begin VB.CommandButton Cmdok
Caption = "确定(&O)"
Default = -1 'True
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 540
TabIndex = 1
Top = 2220
Width = 975
End
Begin VB.CommandButton Cmdexit
Cancel = -1 'True
Caption = "退出(&X)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1770
TabIndex = 0
Top = 2265
Width = 975
End
Begin VB.Label Label3
Caption = "新 密 码："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 390
TabIndex = 9
Top = 1125
Width = 945
End
Begin VB.Label Label4
Caption = "确认新密码："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 210
TabIndex = 8
Top = 1605
Width = 1125
End
Begin VB.Label Label1
Caption = "用 户 名："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 375
TabIndex = 5
Top = 165
Width = 930
End
Begin VB.Label Label2
Caption = "原始密码："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Left = 390
TabIndex = 4
Top = 645
Width = 915
End
End
Attribute VB_Name = "Frmmmxg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim userMima As String
Dim strSQL As String
Private rstlr As New ADODB.Recordset
Private cnntemp As New ADODB.Connection
Private Sub CmdExit_Click()
Unload Me
End Sub
Private Sub CmdOK_Click()
Dim Reply%, strMima$
If Txtxm.Text = "" Then
MsgBox "请输入用户名", vbInformation + vbOKOnly, "提示"
Txtxm.SetFocus
Exit Sub
End If
If Txtmm.Text = "" Then
MsgBox "请输入原始密码", vbInformation + vbOKOnly, "提示"
Txtmm.SetFocus
Exit Sub
End If
'On Error GoTo Err
strSQL = "select * from DB_User where username='" & Txtxm.Text & "'"
Call DirectRecordset(strSQL, rstlr)
If rstlr.RecordCount <> 0 Then
strMima$ = rstlr("password1")
rstlr.Close
Else
MsgBox "请输入正确的用户名", vbCritical + vbOKOnly, "警告"
Txtxm.SelStart = 0
Txtxm.SelLength = Len(Txtxm.Text)
Txtxm.SetFocus
Exit Sub
End If
'*************密码确认************
If Txtmm.Text <> strMima Then
MsgBox "请输入正确的原始密码", vbCritical + vbOKOnly, "警告"
Txtmm.SelStart = 0
Txtmm.SelLength = Len(Txtmm.Text)
Txtmm.SetFocus
Exit Sub
Else
If Txtsrxmm.Text = "" Then
MsgBox "请输入新密码", vbInformation + vbOKOnly, "提示"
Txtsrxmm.SetFocus
Exit Sub
End If
If Txtqrmm.Text = "" Then
MsgBox "请确认新密码！", vbInformation + vbOKOnly, "提示"
Txtqrmm.SetFocus
Exit Sub
End If
'*************密码修改************
If Txtsrxmm.Text = Txtqrmm.Text Then
strSQL = "update DB_User set password1='" & Txtqrmm.Text & "' where username='" & Txtxm.Text & "'"
cnntemp.Execute (strSQL)
Txtsrxmm.Text = ""
Txtqrmm.Text = ""
Txtxm.Text = ""
Txtmm.Text = ""
CmdOk.Enabled = False
Txtxm.SetFocus
Reply = MsgBox("密码已修改！", vbInformation + vbOKCancel, "请注意")
Else
Txtqrmm.Text = ""
Txtqrmm.SetFocus
End If
End If
Exit Sub
Err:
If Err.Number <> 0 Then
MsgBox Err.Description, vbExclamation, Me.Caption
Exit Sub
End If
On Error GoTo 0
End Sub
Private Sub Form_Load()
Me.Show
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX _
, Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Me.Height \ Screen.TwipsPerPixelY, 0
Txtxm.SetFocus
On Error GoTo Err
Dim strConnect As String
' strConnect = ServerIp
'
' Set cnntemp = Nothing
' With cnntemp
' .Open strConnect
' End With
Set cnntemp = Nothing
With cnntemp
.Provider = "Microsoft.jet.OLEDB.4.0"
.Open App.Path & "\travel.mdb", "admin"
End With
Exit Sub
Err:
If Err.Number <> 0 Then
MsgBox Err.Description, vbExclamation, Me.Caption
Exit Sub
End If
On Error GoTo 0
End Sub
Private Sub Txtxm_Change()
Txtmm.Text = ""
Txtsrxmm.Text = ""
Txtqrmm.Text = ""
CmdOk.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -