📄 frmxgmm.frm
字号:
VERSION 5.00
Begin VB.Form frmxgmm
BackColor = &H00C0FFFF&
BorderStyle = 0 'None
Caption = "修改密码"
ClientHeight = 2850
ClientLeft = 0
ClientTop = 0
ClientWidth = 5730
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Moveable = 0 'False
ScaleHeight = 2850
ScaleWidth = 5730
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.Frame famxgmm
BackColor = &H00A56E3A&
Caption = "修改密码"
Height = 2715
Left = 60
TabIndex = 0
Top = 60
Width = 5595
Begin VB.TextBox txtymm
Appearance = 0 'Flat
BackColor = &H00C0FFFF&
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
IMEMode = 3 'DISABLE
Left = 2280
PasswordChar = "*"
TabIndex = 1
Top = 360
Width = 2175
End
Begin VB.TextBox txtxmm
Appearance = 0 'Flat
BackColor = &H00C0FFFF&
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
IMEMode = 3 'DISABLE
Left = 2280
PasswordChar = "*"
TabIndex = 2
Top = 840
Width = 2175
End
Begin VB.TextBox txtmmqr
Appearance = 0 'Flat
BackColor = &H00C0FFFF&
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
IMEMode = 3 'DISABLE
Left = 2280
PasswordChar = "*"
TabIndex = 3
Top = 1320
Width = 2175
End
Begin VB.CommandButton cmdSave_xgmm
Appearance = 0 'Flat
Height = 450
Left = 1140
Picture = "frmxgmm.frx":0000
Style = 1 'Graphical
TabIndex = 4
Top = 1920
Width = 1455
End
Begin VB.CommandButton cmdExit_xgmm
Appearance = 0 'Flat
Height = 450
Left = 2820
Picture = "frmxgmm.frx":07B0
Style = 1 'Graphical
TabIndex = 5
Top = 1920
Width = 1455
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密码确认："
Height = 195
Left = 1260
TabIndex = 8
Top = 1380
Width = 900
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "新密码："
Height = 195
Left = 1440
TabIndex = 7
Top = 900
Width = 720
End
Begin VB.Label Label23
Alignment = 1 'Right Justify
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "原密码："
Height = 195
Left = 1440
TabIndex = 6
Top = 420
Width = 720
End
Begin VB.Shape Shape4
FillColor = &H00C0FFFF&
FillStyle = 0 'Solid
Height = 315
Left = 1080
Top = 360
Width = 1155
End
Begin VB.Shape Shape1
FillColor = &H00C0FFFF&
FillStyle = 0 'Solid
Height = 315
Left = 1080
Top = 840
Width = 1155
End
Begin VB.Shape Shape2
FillColor = &H00C0FFFF&
FillStyle = 0 'Solid
Height = 315
Left = 1080
Top = 1320
Width = 1155
End
End
End
Attribute VB_Name = "frmxgmm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private strsql As String
Private i As Long
' Private Const SWP_NOMOVE = 2
' Private Const SWP_NOSIZE = 1
' Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
' Private Const HWND_TOPMOST = -1
' Private Const HWND_NOTOPMOST = -2
' Private Declare Function 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) As Long
''**************************************************************************************
''**************************************************************************************
''设置窗口在最前面,尽量不要使用,与MsgBox窗口冲突
'Private Function SetTopMostWindow(hwnd As Long, Topmost As Boolean) As Long
'On Error Resume Next
' If (Topmost) Then
' SetTopMostWindow = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
' Else
' SetTopMostWindow = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
' SetTopMostWindow = False
' End If
'End Function
'**************************************************************************************
'*******************************************
'*******************************************
'***修改密码模块****************************
Private Sub cmdSave_xgmm_Click()
On Error GoTo err_savexgmm
Dim rs As ADODB.Recordset
Screen.MousePointer = vbHourglass
strsql = "select * from employees employees where employee_id='" & g_susername & "' and company_id='"
strsql = strsql & g_companyid & "'"
Set rs = GetRsBySQL(strsql)
If Trim(rs("pwd")) = Trim(txtymm) And Trim(txtxmm) = Trim(txtmmqr) Then
If MsgBox("您真的要修改密码吗?", vbOKCancel, "修改密码") = vbOK Then
rs("pwd") = txtxmm
rs.Update
MsgBox "密码修改成功,新密码在您下次登录时生效!", vbInformation, "修改密码结果"
End If
Else
MsgBox "新密码和密码确认不一致或者原密码错误,请您重新输入!", vbInformation, "错误警告"
txtymm.SetFocus
txtymm.SelStart = 0
txtymm.SelLength = Len(txtymm)
End If
rs.Close
Set rs = Nothing
Screen.MousePointer = vbDefault
Unload frmxgmm
Exit Sub
err_savexgmm:
Set rs = Nothing
MsgBox "密码修改失败,请稍后再试!", vbInformation, "错误警告"
End Sub
Private Sub cmdExit_xgmm_Click()
Unload frmxgmm
End Sub
Private Sub Initxgmm()
On Error Resume Next
txtymm = ""
txtxmm = ""
txtmmqr = ""
End Sub
Private Sub Form_Load()
On Error Resume Next
Call Initxgmm
'SetTopMostWindow Me.hwnd, True '保持窗口在最前面,不能使用,与MsgBox窗口冲突
txtymm.SetFocus
End Sub
Private Sub txtxmm_GotFocus()
txtxmm.SelStart = 0
txtxmm.SelLength = Len(txtxmm)
End Sub
Private Sub txtmmqr_GotFocus()
txtmmqr.SelStart = 0
txtmmqr.SelLength = Len(txtmmqr)
End Sub
Private Sub txtymm_GotFocus()
txtymm.SelStart = 0
txtymm.SelLength = Len(txtymm)
End Sub
'*******************************************
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -