📄 frmuseradd.frm
字号:
VERSION 5.00
Object = "{1666F204-B71B-4E6D-AA21-DCE71B94F422}#7.0#0"; "SmartXpButton.ocx"
Begin VB.Form FrmUseradd
BackColor = &H8000000B&
BorderStyle = 0 'None
ClientHeight = 3180
ClientLeft = 0
ClientTop = 0
ClientWidth = 3930
Icon = "FrmUseradd.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 212
ScaleMode = 3 'Pixel
ScaleWidth = 262
Begin VB.TextBox username
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 1800
TabIndex = 1
Top = 720
Width = 1600
End
Begin VB.TextBox setpass
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
IMEMode = 3 'DISABLE
Left = 1800
PasswordChar = "*"
TabIndex = 2
Top = 1320
Width = 1600
End
Begin VB.TextBox confpass
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
IMEMode = 3 'DISABLE
Left = 1800
PasswordChar = "*"
TabIndex = 3
Top = 1935
Width = 1600
End
Begin SmartXpButton.SmartNetXpButton Comok
Height = 375
Left = 360
TabIndex = 0
Top = 2520
Width = 975
_ExtentX = 1720
_ExtentY = 661
BackColor = -2147483637
BackColorPop = 65535
BackColorPush = 12648447
CaptionAreaLayout= 1
Caption = "确定"
CaptionBackColor= 12648384
ShowCaption = -1 'True
ForeColor = 64
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Picture = "FrmUseradd.frx":030A
ShowPictureFixSize= -1 'True
PictureFixWidth = 24
PictureFixHeight= 24
End
Begin SmartXpButton.SmartNetXpButton Comcancel
Height = 375
Left = 2520
TabIndex = 4
Top = 2520
Width = 975
_ExtentX = 1720
_ExtentY = 661
BackColor = -2147483637
BackColorPop = 65535
BackColorPush = 12648447
CaptionAreaLayout= 1
Caption = "取消"
CaptionBackColor= 12648384
ShowCaption = -1 'True
ShowPushColor = 0 'False
ForeColor = 64
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Picture = "FrmUseradd.frx":0464
ShowPictureFixSize= -1 'True
PictureFixWidth = 24
PictureFixHeight= 24
End
Begin VB.Label Label1
BackColor = &H00FF8080&
BackStyle = 0 'Transparent
Caption = "输入新用户名"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 345
Left = 240
TabIndex = 8
Top = 720
Width = 1980
End
Begin VB.Label Label2
BackColor = &H00FF8080&
BackStyle = 0 'Transparent
Caption = "设置用户密码"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 345
Left = 240
TabIndex = 7
Top = 1320
Width = 1620
End
Begin VB.Label Label3
BackColor = &H00FF8080&
BackStyle = 0 'Transparent
Caption = "确认用户密码"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 345
Left = 240
TabIndex = 6
Top = 1935
Width = 1740
End
Begin VB.Label lblTitle
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "添加用户"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 240
Left = 0
TabIndex = 5
Top = 0
Width = 1020
End
Begin VB.Image imgTitleMinimize
Height = 195
Left = 2760
Picture = "FrmUseradd.frx":063E
Top = 3600
Width = 195
End
Begin VB.Image imgTitleClose
Height = 195
Left = 2760
Picture = "FrmUseradd.frx":0888
Top = 3240
Width = 195
End
Begin VB.Image imgTitleHelp
Height = 195
Left = 2760
Picture = "FrmUseradd.frx":0AD2
Top = 2880
Width = 195
End
Begin VB.Image imgTitleLeft
Height = 450
Left = 1320
Picture = "FrmUseradd.frx":0D1C
Top = 2880
Width = 285
End
Begin VB.Image imgTitleRight
Height = 450
Left = 1680
Picture = "FrmUseradd.frx":1466
Top = 2880
Width = 285
End
Begin VB.Image imgWindowBottomLeft
Height = 450
Left = 2040
Picture = "FrmUseradd.frx":1BB0
Top = 2880
Width = 285
End
Begin VB.Image imgWindowBottomRight
Height = 450
Left = 2400
Picture = "FrmUseradd.frx":22FA
Top = 2880
Width = 285
End
Begin VB.Image imgTitleMain
Height = 450
Left = 1320
Picture = "FrmUseradd.frx":2A44
Stretch = -1 'True
Top = 3360
Width = 285
End
Begin VB.Image imgWindowBottom
Height = 450
Left = 1680
Picture = "FrmUseradd.frx":318E
Stretch = -1 'True
Top = 3360
Width = 285
End
Begin VB.Image imgWindowLeft
Height = 450
Left = 2040
Picture = "FrmUseradd.frx":38D8
Stretch = -1 'True
Top = 3360
Width = 285
End
Begin VB.Image imgWindowRight
Height = 450
Left = 2400
Picture = "FrmUseradd.frx":4022
Stretch = -1 'True
Top = 3360
Width = 285
End
End
Attribute VB_Name = "FrmUseradd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'强制变量声明。所有变量使用前都需要定义
Option Explicit
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
Public OK As Boolean
'记录确定次数
Dim miCount As Integer
'初始化窗口，使用户名为空
Private Sub Form_Load()
username.Text = ""
setpass.Text = ""
confpass.Text = ""
MakeWindow Me
AlwaysOnTop Me, True
End Sub
Private Sub imgTitleClose_Click()
Unload Me
End Sub
Private Sub imgTitleHelp_Click()
MsgBox "You can insert code here for loading a help file."
End Sub
Private Sub imgTitleLeft_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
DoDrag Me
End Sub
Private Sub imgTitleMain_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
DoDrag Me
End Sub
Private Sub imgTitleMinimize_Click()
Me.WindowState = 1
End Sub
Private Sub imgTitleRight_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
DoDrag Me
End Sub
Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
DoDrag Me
End Sub
'定义取消键
Private Sub Comcancel_Click()
Unload Me
End Sub
'定义确定键
Private Sub Comok_Click()
Dim txtSQL As String
Dim mrc As ADODB.Recordset
Dim MsgText As String
'判断新用户名是否为空
If Trim(username.Text) = "" Then
MsgBox "请输入用户名称", vbOKOnly + vbExclamation, "警告"
Exit Sub
username.SetFocus
Else
txtSQL = "select*from user_Infor"
'取得所有用户信息，用以判断是否新用户名重复
Set mrc = ExecuteSQL(txtSQL, MsgText)
'判断是否为记录集中最后的记录
While (mrc.EOF = False)
'判断是否有重复记录
If Trim(mrc.Fields(0)) = Trim(username) Then
MsgBox "用户已经存在，请重新输入用户名！", vbOKOnly + vbExclamation, "警告"
username.SetFocus
username.Text = ""
setpass.Text = ""
confpass.Text = ""
Exit Sub
Else
mrc.MoveNext
End If
Wend
End If
'判断两次输入密码是否一致
If Trim(setpass.Text) <> Trim(confpass.Text) Then
MsgBox "两次输入的密码不一样，请确认！", vbOKOnly + vbExclamation, "警告"
setpass.SetFocus
setpass.Text = ""
confpass.Text = ""
Exit Sub
Else
'添加新记录
mrc.AddNew
mrc.Fields(0) = Trim(username.Text)
mrc.Fields(1) = Trim(confpass.Text)
'更新数据库
mrc.Update
'关闭数据集对象
mrc.Close
Me.Hide
MsgBox "添加用户成功！", vbOKOnly + vbExclamation, "添加用户"
username.Text = ""
setpass.Text = ""
confpass.Text = ""
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -