📄 添加用户.frm
字号:
VERSION 5.00
Begin VB.Form 用户
BorderStyle = 3 'Fixed Dialog
Caption = "添加新用户"
ClientHeight = 3720
ClientLeft = 45
ClientTop = 435
ClientWidth = 6675
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
Picture = "添加用户.frx":0000
ScaleHeight = 3720
ScaleWidth = 6675
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdCancel
Caption = "取 消"
Height = 375
Left = 4080
TabIndex = 4
Top = 3000
Width = 1095
End
Begin VB.CommandButton cmdOK
Caption = "确 定"
Height = 375
Left = 1320
TabIndex = 3
Top = 3000
Width = 1095
End
Begin VB.TextBox Text1
Height = 270
IMEMode = 3 'DISABLE
Index = 2
Left = 3000
PasswordChar = "*"
TabIndex = 2
Top = 2040
Width = 2295
End
Begin VB.TextBox Text1
Height = 270
IMEMode = 3 'DISABLE
Index = 1
Left = 3000
PasswordChar = "*"
TabIndex = 1
Top = 1320
Width = 2295
End
Begin VB.TextBox Text1
Height = 270
Index = 0
Left = 3000
TabIndex = 0
Text = "(10个字节以内)"
Top = 720
Width = 2295
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请确认密码"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 240
Left = 960
TabIndex = 7
Top = 2040
Width = 1275
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请输入密码"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 240
Left = 960
TabIndex = 6
Top = 1440
Width = 1275
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请输入用户名"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 240
Left = 960
TabIndex = 5
Top = 840
Width = 1530
End
End
Attribute VB_Name = "用户"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Integer
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
If Option1.Value Then
i = 0
End If
If Option2.Value Then
i = 1
End If
If Trim(Text1(0).Text) = "" Then
MsgBox "请输入用户名!!!", vbOKOnly + vbExclamation, "警告"
Exit Sub
Text1(0).SetFocus
Else
Dim Sc As String
Sc = "driver={Microsoft Access Driver (*.mdb)};dbq=" & App.Path & "\tradeunion.mdb"
Set cn = New ADODB.Connection
cn.Open Sc
Dim OneQuerySql As String
OneQuerySql = "select* from 用户表"
Dim AdoRsTradeMem As New ADODB.Recordset
If AdoRsTradeMem.State = adStateOpen Then
AdoRsTradeMem.Close
End If
AdoRsTradeMem.Open OneQuerySql, cn, adOpenKeyset, adLockOptimistic
While (AdoRsTradeMem.EOF = False) '启动一个While循环,判断用户名是否合法(已经在使用)
If Trim(AdoRsTradeMem.Fields(0)) = Trim(Text1(0).Text) Then
MsgBox "用户名已经存在,请重新输入其它用户名!", vbOKOnly + vbExclamation, "警告"
Text1(0).SetFocus
Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
Exit Sub
Else
AdoRsTradeMem.MoveNext
End If
Wend 'While循环结束语句
End If
If Trim(Text1(1).Text) <> Trim(Text1(2).Text) Then
MsgBox "两次输入密码不一致,请确认后重新输入", vbOKOnly + vbExclamation, "警告"
Text1(1).SetFocus
Text1(1).Text = ""
Text1(2).Text = ""
Exit Sub
Else
If Text1(1).Text = "" Then
MsgBox "密码不能为空!!!", vbOKOnly + vbExclamation, "警告"
Text1(1).SetFocus
Text1(1).Text = ""
Text1(2).Text = ""
Else
If i = 3 Then
MsgBox "请选择用户级别", vbOKOnly + vbExclamation, "警告"
Text1(0).SetFocus
Else
AdoRsTradeMem.AddNew
AdoRsTradeMem.Fields(0) = Trim(Text1(0).Text)
AdoRsTradeMem.Fields(1) = Trim(Text1(1).Text)
AdoRsTradeMem.Fields(2) = i
AdoRsTradeMem.Update
AdoRsTradeMem.Close
'调用写入日志函数
Call LogPlug("用户表", "添加新用户,新用户名是: " + Trim(Text1(0).Text))
Me.Hide
Unload Me
MsgBox "添加用户成功!", vbOKOnly + vbExclamation, "恭喜"
End If
End If
End If
End Sub
Private Sub Form_Load()
i = 3
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -