📄 frmusermanager.frm
字号:
VERSION 5.00
Begin VB.Form frmUserManager
BorderStyle = 3 'Fixed Dialog
Caption = "用户管理"
ClientHeight = 3000
ClientLeft = 45
ClientTop = 330
ClientWidth = 3540
Icon = "frmUserManager.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3000
ScaleWidth = 3540
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton cmdExit
Caption = "退出"
Height = 390
Left = 1725
TabIndex = 11
Top = 2325
Width = 1140
End
Begin VB.CommandButton cmdDelete
Caption = "删除"
Height = 390
Left = 1725
TabIndex = 5
Top = 1905
Width = 1140
End
Begin VB.TextBox txtUserCode
Height = 330
Left = 1500
MaxLength = 5
TabIndex = 0
Top = 195
Width = 975
End
Begin VB.TextBox txtNewPWD
Height = 330
IMEMode = 3 'DISABLE
Left = 1485
MaxLength = 10
PasswordChar = "*"
TabIndex = 2
Top = 960
Width = 1365
End
Begin VB.TextBox txtUserName
Height = 330
Left = 1500
TabIndex = 1
Top = 570
Width = 975
End
Begin VB.CommandButton cmdAdd
Caption = "增加"
Height = 390
Left = 435
TabIndex = 4
Top = 1905
Width = 1140
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消"
Height = 390
Left = 420
TabIndex = 6
Top = 2325
Width = 1140
End
Begin VB.TextBox txtNewPWD2
Height = 330
IMEMode = 3 'DISABLE
Left = 1485
MaxLength = 10
PasswordChar = "*"
TabIndex = 3
Top = 1350
Width = 1365
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户代号"
Height = 180
Index = 3
Left = 540
TabIndex = 10
Top = 270
Width = 720
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "验证新密码"
Height = 180
Index = 2
Left = 360
TabIndex = 9
Top = 1440
Width = 900
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户姓名"
Height = 180
Index = 0
Left = 540
TabIndex = 8
Top = 660
Width = 720
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "新密码"
Height = 180
Index = 4
Left = 690
TabIndex = 7
Top = 1050
Width = 540
End
End
Attribute VB_Name = "frmUserManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdAdd_Click()
On Error GoTo AddErr
If cmdAdd.Caption = "增加" Then
cmdAdd.Caption = "确定"
txtUserCode.Text = ""
txtUserName = ""
txtNewPWD.Text = ""
txtNewPWD2.Text = ""
Else
If txtNewPWD.Text <> txtNewPWD2.Text Then
MsgBox "口令不匹配!", vbInformation, "提示窗口"
Exit Sub
ElseIf txtUserCode.Text = "" Or txtUserName.Text = "" Then
MsgBox "用户编码和名称不能为空!", vbInformation, "提示窗口"
Exit Sub
End If
sSQL = "INSERT INTO 人员档案(StaffCode,Name,Password) VALUES('" & _
Trim(txtUserCode.Text) & "','" & Trim(txtUserName.Text) & "','" & Trim(txtNewPWD.Text) & "')"
Cmd.ActiveConnection = Conn
Cmd.CommandText = sSQL
Cmd.Execute
cmdAdd.Caption = "增加"
End If
Exit Sub
AddErr:
MsgBox "增加用户错误!", vbInformation, "提示信息"
End Sub
Private Sub cmdCancel_Click()
cmdAdd.Caption = "增加"
End Sub
Private Sub cmdDelete_Click()
On Error Resume Next
If txtUserCode.Text = "" Then Exit Sub
If MsgBox("确定要删除编码为" & txtUserCode.Text & "的用户吗?", vbQuestion + vbYesNo, "提示窗口") = vbNo Then Exit Sub
sSQL = "DELETE FROM 人员档案 WHERE STAFFCODE='" & Trim(txtUserCode.Text) & "'"
Cmd.ActiveConnection = Conn
Cmd.CommandText = sSQL
Cmd.Execute
txtUserCode.Text = ""
txtUserName = ""
txtNewPWD.Text = ""
txtNewPWD2.Text = ""
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then SendKeys "{TAB}"
End Sub
Private Sub Form_Load()
Dim xMac As String, xDataBase As String, xUid As String, xPwd As String
Dim UseODBC As Boolean
UseODBC = CBool(GetSetting("LSDSTAR", "数据库信息", "数据库连接方式", "1"))
xMac = GetSetting("LSDSTAR", "数据库信息", "机器名", "NT_SERVER")
xDataBase = GetSetting("LSDSTAR", "数据库信息", "数据库名", "DSTAR")
xUid = GetSetting("LSDSTAR", "数据库信息", "用户名", "sa")
xPwd = GetSetting("LSDSTAR", "数据库信息", "口令", "sa")
Set Conn = Nothing
Conn.ConnectionTimeout = 30
If UseODBC Then
ConnectString = "DSN=" & xDataBase & ";uid=" & xUid & ";pwd=" & xPwd
Else
ConnectString = "driver={SQL Server};" & _
"server=" & xMac & ";uid=" & xUid & ";pwd=" & xPwd & ";database=" & xDataBase & ";"
End If
Conn.Open ConnectString '打开连接
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -