📄 frmnew.frm
字号:
VERSION 5.00
Begin VB.Form frmNew
AutoRedraw = -1 'True
BackColor = &H00E0E0E0&
BorderStyle = 3 'Fixed Dialog
Caption = "新用户"
ClientHeight = 5280
ClientLeft = 45
ClientTop = 330
ClientWidth = 6195
Icon = "frmNew.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5280
ScaleWidth = 6195
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.Frame Frame2
BackColor = &H00E0E0E0&
Caption = "附加信息"
Height = 1635
Left = 120
TabIndex = 13
Top = 2940
Width = 5925
Begin VB.TextBox TxtQzmm
Height = 375
Left = 1530
TabIndex = 15
Top = 330
Width = 4185
End
Begin VB.TextBox Txtyhsf
Height = 375
Left = 1530
TabIndex = 14
Top = 840
Width = 4155
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户身份:"
Height = 180
Index = 1
Left = 600
TabIndex = 17
Top = 960
Width = 810
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "签字密码:"
Height = 180
Index = 2
Left = 600
TabIndex = 16
Top = 420
Width = 810
End
End
Begin VB.Frame Frame1
BackColor = &H00E0E0E0&
Caption = "基本信息"
Height = 2685
Left = 90
TabIndex = 2
Top = 90
Width = 5925
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 315
Left = 1530
TabIndex = 7
Top = 270
Width = 4215
End
Begin VB.TextBox Text3
Appearance = 0 'Flat
Height = 315
Left = 1530
TabIndex = 6
Top = 1230
Width = 4215
End
Begin VB.TextBox Text4
Appearance = 0 'Flat
Height = 315
IMEMode = 3 'DISABLE
Left = 1530
PasswordChar = "*"
TabIndex = 5
Top = 1680
Width = 4215
End
Begin VB.TextBox Text2
Appearance = 0 'Flat
Height = 315
Left = 1530
TabIndex = 4
Top = 720
Width = 4215
End
Begin VB.TextBox Text5
Appearance = 0 'Flat
Height = 315
Left = 1530
TabIndex = 3
Top = 2130
Width = 4215
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H80000013&
BackStyle = 0 'Transparent
Caption = "用户名(英文):"
Height = 180
Left = 240
TabIndex = 12
Top = 360
Width = 1170
End
Begin VB.Label label2
AutoSize = -1 'True
BackColor = &H80000013&
BackStyle = 0 'Transparent
Caption = "部门:"
Height = 180
Left = 960
TabIndex = 11
Top = 780
Width = 450
End
Begin VB.Label Label3
AutoSize = -1 'True
BackColor = &H80000013&
BackStyle = 0 'Transparent
Caption = "用户名(中文):"
Height = 180
Left = 240
TabIndex = 10
Top = 1260
Width = 1170
End
Begin VB.Label Label4
AutoSize = -1 'True
BackColor = &H80000013&
BackStyle = 0 'Transparent
Caption = "密码:"
Height = 180
Left = 960
TabIndex = 9
Top = 1740
Width = 450
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "内线电话:"
Height = 180
Left = 600
TabIndex = 8
Top = 2220
Width = 810
End
End
Begin VB.CommandButton CmdClose
Caption = "取消"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 450
Left = 4785
TabIndex = 1
Top = 4665
Width = 1020
End
Begin VB.CommandButton CmdSave
Caption = "添加"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 450
Left = 3150
TabIndex = 0
Top = 4665
Width = 1020
End
End
Attribute VB_Name = "frmNew"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub CmdClose_Click()
Unload Me
End Sub
Private Sub CmdSave_Click()
Dim str As String
Dim Myuserid As String
Dim Pcry As Object
Dim Mstr As String
Dim tempPsw As String
Dim rst As ADODB.Recordset
'判断输入的数据是否正确
If Trim(Text1.Text) = "" Then
MsgBox "用户名不能为空!", 48, "系统提示"
Exit Sub
ElseIf Trim(Text2.Text) = "" Then
MsgBox "部门不能为空!", 48, "系统提示"
Exit Sub
ElseIf Trim(Text3.Text) = "" Then
MsgBox "用户名不能为空!", 48, "系统提示"
Exit Sub
End If
If lstrlen(Trim(Text4.Text)) > 50 Then
MsgBox "用户密码最多只能输入50个字符!", 48, "用户管理器"
Exit Sub
End If
If Trim(TxtQzmm.Text) = "" Or Trim(Txtyhsf.Text) = "" Then
MsgBox "签字密码或用户身份不能为空!"
Exit Sub
End If
str = "select username from groupuser where username='" & Trim(Text1.Text) & "'"
Set RstUser = Pubsaconn.Execute(str)
If Not RstUser.EOF Then
MsgBox "该用户名已存在,请输入不同的名字!", 48, "用户管理器"
Exit Sub
End If
tempPsw = Text4.Text
If tempPsw = "" Then
str = "insert into groupuser (groupname,username,deparment_c,username_C,password,phoneno,arrangeorder,tagpsw,field1) values(' ','" & Trim(Text1.Text) _
& "','" & Trim(Text2.Text) & "','" & Trim(Text3.Text) _
& "','" & Trim(tempPsw) & "','" & Trim(Text5.Text) & "',0,'" & TxtQzmm.Text & "','" & Txtyhsf.Text & "')"
Else
Set Pcry = CreateObject("Crypt.clsCrypt")
Mstr = Pcry.Encode(tempPsw)
str = "insert into groupuser (groupname,username,deparment_c,username_C,password,phoneno,arrangeorder,tagpsw,field1) values(' ','" & Trim(Text1.Text) _
& "','" & Trim(Text2.Text) & "','" & Trim(Text3.Text) _
& "','" & Trim(Mstr) & "','" & Trim(Text5.Text) & "',0,'" & TxtQzmm.Text & "','" & Txtyhsf.Text & "')"
Set Pcry = Nothing
End If
Pubsaconn.Execute str, 64
'为了使用新的邮件的
'获得用户ID
Set rst = New ADODB.Recordset
Set rst = Pubsaconn.Execute("select max(id) from groupuser")
If rst.EOF Then
MsgBox err.Description, 64
Exit Sub
End If
Myuserid = rst(0)
Set rst = Nothing
str = "insert into tbuserfolder (foldername,sysfolderflag,userid) values('收件箱',1,'" & Myuserid & "')"
Pubsaconn.Execute str
str = "insert into tbuserfolder (foldername,sysfolderflag,userid) values('发件箱',2,'" & Myuserid & "')"
Pubsaconn.Execute str
str = "insert into tbuserfolder (foldername,sysfolderflag,userid) values('垃圾箱',3,'" & Myuserid & "')"
Pubsaconn.Execute str
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text1.SetFocus
End Sub
Private Sub Form_Load()
'换皮肤
Call LoadSkin(Me)
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetGride frmUserMain.GrdUser, frmUserMain.GrdGroup
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -