📄 frm_accountadd.frm
字号:
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Left = 240
TabIndex = 13
Top = 420
Width = 540
End
Begin VB.Label Lbl_PWD2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "确认密码"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Left = 240
TabIndex = 12
Top = 1140
Width = 720
End
Begin VB.Label Lbl_PWD
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密码"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Left = 240
TabIndex = 11
Top = 780
Width = 360
End
Begin VB.Label Lbl_Status
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "状态"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Left = 240
TabIndex = 10
Top = 2580
Width = 360
End
End
Begin LabMangeSystem.XButton Cmd_Add
Height = 375
Left = 3840
TabIndex = 7
Top = 720
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = ""
BackColor = 14737632
ForeColor = 8421504
MouseDownColor = -2147483644
MouseOnColor = -2147483644
StyleColor = 16777215
Style3dColor1 = 16577259
Style3dColor2 = 8421504
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
IfDraw = -1 'True
End
Begin LabMangeSystem.XButton Cmd_Close
Height = 375
Left = 3840
TabIndex = 8
Top = 1200
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "关闭"
BackColor = 14737632
ForeColor = 8421504
MouseDownColor = -2147483644
MouseOnColor = -2147483644
StyleColor = 16777215
Style3dColor1 = 16577259
Style3dColor2 = 8421504
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
IfDraw = -1 'True
End
Begin VB.Label Lbl_Tip
BackStyle = 0 'Transparent
Caption = "提示：密码不修改请留空。为了安全起见，二级密码只显示前两个字符并填充为八个字符。"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 1575
Left = 3840
TabIndex = 21
Top = 1800
Width = 1095
End
Begin VB.Line Line_Split
BorderColor = &H00C0C0C0&
X1 = 3600
X2 = 3600
Y1 = 600
Y2 = 3840
End
Begin VB.Line Line_SplitShadow
BorderColor = &H00FFFFFF&
X1 = 3615
X2 = 3615
Y1 = 615
Y2 = 3840
End
End
Attribute VB_Name = "Frm_AccountAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public xUID As String '用户名
Public FormType As String '窗口类型(添加 OR 修改)
Dim ModPWD As Boolean '是否修改密码
Dim ModSubPWD As Boolean '是否修改二级密码
Option Explicit
Private Sub Cmd_Add_Click()
Dim Err_Msg As String
On Error GoTo ERRORZONE
If FormType = "ADD" Then
If Trim(Txt_UID.Text) = vbNullString _
Or Txt_PWD.Text = vbNullString _
Or Txt_PWD2.Text = vbNullString _
Or Trim(Txt_Name.Text) = vbNullString _
Or Cmb_Type.Text = vbNullString _
Or Txt_SubPWD.Text = vbNullString Then
MsgFrm "请输入必要信息！", "!", "提示"
Exit Sub
End If
If StrComp(Txt_PWD.Text, Txt_PWD2.Text, 0) <> 0 Then
MsgFrm "两次密码不相同！", "!", "提示"
Exit Sub
End If
If ADD_Account(Err_Msg) = False Then GoTo ERRORZONE
Unload Me
ElseIf FormType = "MOD" Then
If Trim(Txt_UID.Text) = vbNullString _
Or Trim(Txt_Name.Text) = vbNullString _
Or Cmb_Type.Text = vbNullString Then
MsgFrm "请输入必要信息！", "!", "提示"
Exit Sub
End If
If Txt_PWD.Text <> vbNullString Then
If StrComp(Txt_PWD.Text, Txt_PWD2.Text, 0) <> 0 Then
MsgFrm "两次密码不相同！", "!", "提示"
Exit Sub
End If
ModPWD = True
End If
If ModSubPWD = True Then
If Trim(Txt_SubPWD.Text) = vbNullString Then
MsgFrm "请输入新二级密码！", "!", "提示"
End If
End If
If MOD_Account(Err_Msg) = False Then GoTo ERRORZONE
Unload Me
End If
Call Frm_AccountMag.Cmd_Refresh_Click
Exit Sub
ERRORZONE:
MsgFrm Err_Msg, "x", "错误"
Call Frm_AccountMag.Cmd_Refresh_Click
End Sub
Private Sub Cmd_Close_Click()
Unload Me
End Sub
Private Sub Cmd_TBarClose_Click()
Call Cmd_Close_Click
End Sub
Private Sub Form_Load()
Dim strSQL As String
Dim rs As New ADODB.Recordset
strSQL = "SELECT 账户类型 FROM 账户类型"
rs.Open strSQL, cnMain, 1, 1
Cmb_Type.Clear
Do While Not rs.EOF
Cmb_Type.AddItem rs("账户类型")
rs.MoveNext
Loop
Cmb_Status.AddItem "正常"
Cmb_Status.AddItem "停用"
Call SetFormType
End Sub
Private Sub SetFormType()
If FormType = "ADD" Then
Me.caption = "添加账户"
Cmd_Add.caption = "添加"
Cmb_Status.Enabled = False
Lbl_Tip.Visible = False
ElseIf FormType = "MOD" Then
Me.caption = "修改账户"
Cmd_Add.caption = "修改"
If HavePower("修改账户权限") = False Then
Cmb_Type.Enabled = False
Cmb_Status.Enabled = False
End If
Txt_UID.Enabled = False
Lbl_Tip.Visible = True
Call LoadData
End If
Lbl_TBarText.caption = Me.caption
End Sub
Private Sub LoadData()
On Error Resume Next
Dim strSQL As String
Dim rs As New ADODB.Recordset
strSQL = "SELECT * FROM 账户 WHERE 用户名 =" & Str2SQL(xUID)
rs.Open strSQL, cnMain, 1, 1
Txt_UID.Text = rs("用户名")
Txt_PWD.Text = vbNullString
Txt_PWD2.Text = vbNullString
Txt_Name.Text = rs("真实姓名")
Dim i As Long
For i = 0 To Cmb_Type.ListCount - 1
If Cmb_Type.List(i) = rs("账户类型") Then Cmb_Type.ListIndex = i
Next
Txt_SubPWD.Text = Left$(rs("二级密码"), 2) & "******"
If rs("状态") = "正常" Then
Cmb_Status.ListIndex = 0
Else: Cmb_Status.ListIndex = 1
End If
End Sub
Private Function ADD_Account(Optional ByRef Err_Msg As String) As Boolean
On Error GoTo ERRORZONE
cnMain.Execute "INSERT 账户 VALUES(" & _
Str2SQL(Txt_UID.Text) & "," & _
Str2SQL(Txt_PWD.Text) & "," & _
Str2SQL(Txt_Name.Text) & "," & _
Str2SQL(Txt_SubPWD.Text) & "," & _
Str2SQL(Cmb_Type.Text) & ", Null, '正常')"
ADD_Account = True
Exit Function
ERRORZONE:
Err_Msg = Err.Description
ADD_Account = False
End Function
Private Function MOD_Account(Optional ByRef Err_Msg As String) As Boolean
On Error GoTo ERRORZONE
Dim strSQL As String
strSQL = "UPDATE 账户 SET " & _
"真实姓名 = " & Str2SQL(Txt_Name.Text) & _
",账户类型 = " & Str2SQL(Cmb_Type.Text) & _
",状态 = " & Str2SQL(IIf(Cmb_Status.ListIndex = 0, "正常", "停用"))
If ModPWD = True Then
strSQL = strSQL & ",密码 = " & Str2SQL(Txt_PWD.Text)
End If
If ModSubPWD = True Then
strSQL = strSQL & ",二级密码 = " & Str2SQL(Txt_SubPWD.Text)
End If
strSQL = strSQL & " WHERE 用户名 = " & Str2SQL(Txt_UID.Text)
cnMain.Execute strSQL
MOD_Account = True
Exit Function
ERRORZONE:
Err_Msg = Err.Description
MOD_Account = False
End Function
Private Sub Txt_SubPWD_Change()
ModSubPWD = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -