📄 frmuserreg.frm
字号:
VERSION 5.00
Begin VB.Form frmUserReg
BorderStyle = 3 'Fixed Dialog
Caption = "新用户注册"
ClientHeight = 4845
ClientLeft = 2985
ClientTop = 2265
ClientWidth = 5355
Icon = "frmUserReg.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4845
ScaleWidth = 5355
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.Frame Frame2
Caption = "帐户设置"
Height = 1455
Left = 90
TabIndex = 17
Top = 855
Width = 5145
Begin VB.TextBox txtUserID
Height = 270
Left = 2025
TabIndex = 0
Top = 270
Width = 1860
End
Begin VB.TextBox txtPassword
Height = 270
IMEMode = 3 'DISABLE
Left = 2025
PasswordChar = "*"
TabIndex = 1
Top = 630
Width = 1860
End
Begin VB.TextBox txtOkPassword
Height = 270
IMEMode = 3 'DISABLE
Left = 2025
PasswordChar = "*"
TabIndex = 2
Top = 990
Width = 1860
End
Begin VB.Label Label9
Caption = "用户名："
Height = 195
Left = 945
TabIndex = 21
Top = 315
Width = 915
End
Begin VB.Label Label5
Caption = "输入密码："
Height = 195
Left = 945
TabIndex = 19
Top = 675
Width = 915
End
Begin VB.Label Label6
Caption = "确认密码："
Height = 195
Left = 945
TabIndex = 18
Top = 1035
Width = 960
End
End
Begin VB.CommandButton cmdCancel
Caption = "取消"
Height = 285
Left = 3735
TabIndex = 9
Top = 4410
Width = 1050
End
Begin VB.CommandButton cmdOk
Caption = "确定"
Height = 285
Left = 2520
TabIndex = 8
Top = 4410
Width = 1050
End
Begin VB.Frame Frame1
Caption = "用户资枓"
Height = 1815
Left = 90
TabIndex = 10
Top = 2430
Width = 5145
Begin VB.TextBox txtName
Height = 270
Left = 1215
TabIndex = 3
Top = 270
Width = 1500
End
Begin VB.ComboBox CboSex
Height = 315
ItemData = "frmUserReg.frx":030A
Left = 3960
List = "frmUserReg.frx":0314
Style = 2 'Dropdown List
TabIndex = 4
Top = 270
Width = 780
End
Begin VB.TextBox txtCompanyName
Height = 270
Left = 1215
TabIndex = 5
Top = 630
Width = 2580
End
Begin VB.TextBox txtCompanyAddr
Height = 270
Left = 1215
TabIndex = 6
Top = 990
Width = 3525
End
Begin VB.TextBox txtHomeAddr
Height = 270
Left = 1215
TabIndex = 7
Top = 1350
Width = 3525
End
Begin VB.Label Label2
Caption = "性别："
Height = 285
Left = 3150
TabIndex = 15
Top = 315
Width = 690
End
Begin VB.Label Label3
Caption = "公司名称："
Height = 285
Left = 315
TabIndex = 14
Top = 675
Width = 915
End
Begin VB.Label Label4
Caption = "公司地址："
Height = 240
Left = 315
TabIndex = 13
Top = 1035
Width = 915
End
Begin VB.Label lablel5
Caption = "家庭地址："
Height = 240
Left = 315
TabIndex = 12
Top = 1395
Width = 915
End
Begin VB.Label Label1
Caption = "姓名："
Height = 240
Left = 315
TabIndex = 11
Top = 315
Width = 690
End
End
Begin VB.Label Label8
Caption = "（不设置密码即为没有密码）"
Height = 240
Left = 1665
TabIndex = 20
Top = 495
Width = 2400
End
Begin VB.Label Label7
Caption = "为防止别人未经您的许可查看您的个人资枓，您可以给您的记录薄设置密码。"
Height = 375
Left = 1710
TabIndex = 16
Top = 90
Width = 3390
End
Begin VB.Image Image1
Height = 480
Left = 585
Picture = "frmUserReg.frx":0320
Top = 135
Width = 480
End
End
Attribute VB_Name = "frmUserReg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************
' 新用户注册
'******************************************************
Private Sub cmdCancel_Click()
Unload frmUserReg
End Sub
Private Sub cmdOK_Click()
Dim strUserID As String
Dim strUserName As String
Dim strSex As String
Dim strPassword As String
Dim strCompanyName As String
Dim strCompanyAddr As String
Dim strHomeAddr As String
Dim strErrMessage As String
Dim intChar As Integer
Dim i As Integer
On Error GoTo VBError
strUserID = Trim(txtUserID.Text)
strUserName = Trim(txtName.Text)
strSex = cboSex.Text
strCompanyName = Trim(txtCompanyName.Text)
strCompanyAddr = Trim(txtCompanyAddr.Text)
strHomeAddr = Trim(txtHomeAddr.Text)
strPassword = Trim(txtPassword.Text)
'检验用户输入的帐户资料和密码是否合法
If Trim(strUserID) = "" Then
strErrMessage = "必须填写用户名" & vbCrLf
End If
If Trim(strUserName) = "" Then
strErrMessage = "必须填写用户姓名" & vbCrLf
End If
If Trim(strSex) = "" Then
strErrMessage = strErrMessage & "必须选择性别" & vbCrLf
End If
If strPassword = txtOkPassword.Text Then
For i = 1 To Len(strPassword)
intChar = Asc(Mid(strPassword, i, 1))
If intChar < 33 And intChar > 126 Then
strErrMessage = strErrMessage & "密码字符不能为空格、汉字、控制字符、扩展字符"
Exit For
End If
Next i
Else
strErrMessage = strErrMessage & "两次输入的密码不一致"
End If
If strErrMessage <> "" Then
MsgBox strErrMessage, vbCritical, SYSTEMCAPTION
Exit Sub
End If
On Error GoTo ADOError
'插入新的帐户记录
strQry = "insert into user(ID,name,sex,companyname,companyaddress,homeaddress,password,lastlogintime) values('" & strUserID & "','" & strUserName & "','" & strSex & "','" & strCompanyName & "','" & strCompanyAddr & "','" & strHomeAddr & "','" & strPassword & "','" & Now() & "')"
cnnConnection.Execute strQry
strQry = "select ID from user where ID = '" & strUserID & "'"
Set rstCustomers = GetRecordSet(cnnConnection, strQry)
'设置登录成功标志,记录登录成功的用户
blnLoginFlag = True
UserID = rstCustomers!ID
Unload frmUserReg
Done:
Set rstCustomers = Nothing
Exit Sub
ADOError:
DisplayADOErrors cnnConnection
VBError:
DisplayVBError
GoTo Done
End Sub
Private Sub Form_Unload(Cancel As Integer)
'加载主窗体
Load frmMain
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -