📄 frmuser.frm
字号:
VERSION 5.00
Begin VB.Form frmUser
BorderStyle = 1 'Fixed Single
Caption = "用户维护"
ClientHeight = 5565
ClientLeft = 45
ClientTop = 330
ClientWidth = 6585
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5565
ScaleWidth = 6585
Begin VB.CommandButton cmdAdd
Caption = "添加"
Height = 495
Left = 240
TabIndex = 15
Top = 4680
Width = 975
End
Begin VB.CommandButton cmdDel
Caption = "删除"
Height = 495
Left = 2880
TabIndex = 14
Top = 4680
Width = 975
End
Begin VB.CommandButton cmdCancel
Caption = "取消"
Height = 495
Left = 5400
TabIndex = 13
Top = 4680
Width = 975
End
Begin VB.CommandButton cmdModi
Caption = "修改"
Height = 495
Left = 1560
TabIndex = 12
Top = 4680
Width = 975
End
Begin VB.CommandButton cmdSearch
Caption = "查询"
Height = 495
Left = 4200
TabIndex = 11
Top = 4680
Width = 975
End
Begin VB.Frame Frame1
Height = 3975
Left = 600
TabIndex = 0
Top = 120
Width = 5535
Begin VB.ComboBox cmbCType
Height = 315
Left = 2640
Style = 2 'Dropdown List
TabIndex = 10
Top = 2040
Width = 1575
End
Begin VB.TextBox txtPwd
Appearance = 0 'Flat
Height = 375
IMEMode = 3 'DISABLE
Left = 2640
MaxLength = 16
PasswordChar = "*"
TabIndex = 7
Top = 2520
Width = 1575
End
Begin VB.TextBox txtBalance
Appearance = 0 'Flat
Height = 375
Left = 2640
MaxLength = 10
TabIndex = 5
Top = 3120
Width = 1575
End
Begin VB.TextBox txtUName
Appearance = 0 'Flat
Height = 375
Left = 2640
MaxLength = 10
TabIndex = 3
Top = 1320
Width = 1575
End
Begin VB.TextBox txtUID
Appearance = 0 'Flat
Height = 375
Left = 2640
MaxLength = 6
TabIndex = 1
Top = 600
Width = 1575
End
Begin VB.Label Label5
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "收费："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 285
Left = 1080
TabIndex = 9
Top = 2040
Width = 945
End
Begin VB.Label Label4
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "密码："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 285
Left = 1080
TabIndex = 8
Top = 2640
Width = 945
End
Begin VB.Label Label3
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "余额："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 285
Left = 1080
TabIndex = 6
Top = 3240
Width = 945
End
Begin VB.Label Label1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "姓名："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 285
Left = 1080
TabIndex = 4
Top = 1440
Width = 945
End
Begin VB.Label Label2
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "编号："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 285
Left = 1080
TabIndex = 2
Top = 720
Width = 945
End
End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdAdd_Click()
Dim strUID As String
Dim strUName As String
Dim strCType As String
Dim strPWD As String
Dim strBalance As String
Dim strCondition As String
Dim strSql As String
Dim rsRoom As ADODB.Recordset
strUID = Trim(Me.txtUID.Text)
strUName = Trim(Me.txtUName.Text)
strCType = Trim(Me.cmbCType.Text)
strPWD = Me.txtPwd.Text
strBalance = Trim(Me.txtBalance.Text)
If strCType = "上机" Then
strCType = "U"
ElseIf strCType = "租借" Then
strCType = "H"
Else
strCType = "O"
End If
If Trim(strUID) = "" Then
MsgBox "请填写用户编号！"
Me.txtUID.SetFocus
Exit Sub
End If
If Not (IsNumeric(strUID) And InStr(1, strUID, ".", vbTextCompare) <= 0) Then
MsgBox "请正确填写用户编号！"
Me.txtUID.SetFocus
Exit Sub
End If
If Trim(strUName) = "" Then
MsgBox "请填写用户姓名！"
Me.txtUName.SetFocus
Exit Sub
End If
If Not IsNumeric(strBalance) Then
MsgBox "请正确余额数！"
Me.txtBalance.SetFocus
Exit Sub
End If
strCondition = "UID='" & strUID & "'"
If objDBOpt.IsRecordExist("CUSER", strCondition) Then
If MsgBox("用户信息已经存在，覆盖吗？", vbOKCancel) = vbOK Then
Set rsRoom = objDBOpt.getRecord("CUser", "*", strCondition, 1, 3)
If Not (rsRoom Is Nothing) Then
If Not rsRoom.EOF Then
rsRoom.Fields("uname").Value = strUName
rsRoom.Fields("Ctype").Value = strCType
rsRoom.Fields("pwd").Value = strPWD
rsRoom.Fields("balance").Value = strBalance
rsRoom.Update
MsgBox "数据修改成功！"
Me.txtUID.Text = ""
Me.txtUName.Text = ""
Me.txtPwd.Text = ""
Me.txtBalance.Text = "0"
Me.cmbCType.ListIndex = 0
Exit Sub
Else
MsgBox "数据修改失败！"
Exit Sub
End If
rsRoom.Close
Else
MsgBox "数据修改失败！"
Exit Sub
End If
Else
Me.txtUID.Text = ""
Me.txtUName.Text = ""
Me.txtPwd.Text = ""
Me.txtBalance.Text = "0"
Me.cmbCType.ListIndex = 0
Exit Sub
End If
Else
If objDBOpt.AddRecord("CUser", "UID,UName,CType,Pwd,Balance", "'" & strUID & "','" & strUName & "','" & strCType & "','" & strPWD & "'," & strBalance) Then
MsgBox "数据添加成功！"
Me.txtUID.Text = ""
Me.txtUName.Text = ""
Me.txtPwd.Text = ""
Me.txtBalance.Text = "0"
Me.cmbCType.ListIndex = 0
Exit Sub
Else
MsgBox "数据添加失败！"
Exit Sub
End If
End If
Set rsRoom = Nothing
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdDel_Click()
Dim strUID As String
Dim strCondition As String
strUID = Trim(Me.txtUID.Text)
If strUID = "" Then
MsgBox "请填写用户编号！"
Me.txtUID.SetFocus
Exit Sub
End If
strCondition = "UID = '" & strUID & "'"
If objDBOpt.DelRecord("CUser", strCondition) Then
MsgBox "数据删除成功！"
Else
MsgBox "数据删除失败！"
End If
End Sub
Private Sub cmdModi_Click()
Dim strUID As String
Dim strUName As String
Dim strCType As String
Dim strPWD As String
Dim strBalance As String
Dim strCondition As String
Dim strSql As String
Dim rsRoom As ADODB.Recordset
strUID = Trim(Me.txtUID.Text)
strUName = Trim(Me.txtUName.Text)
strCType = Trim(Me.cmbCType.Text)
strPWD = Me.txtPwd.Text
strBalance = Trim(Me.txtBalance.Text)
If strCType = "上机" Then
strCType = "U"
ElseIf strCType = "租借" Then
strCType = "H"
Else
strCType = "O"
End If
If Trim(strUID) = "" Then
MsgBox "请填写用户编号！"
Me.txtUID.SetFocus
Exit Sub
End If
If Not (IsNumeric(strUID) And InStr(1, strUID, ".", vbTextCompare) < 1) Then
MsgBox "请正确填写用户编号！"
Me.txtUID.SetFocus
Exit Sub
End If
If Trim(strUName) = "" Then
MsgBox "请填写用户姓名！"
Me.txtUName.SetFocus
Exit Sub
End If
If Not IsNumeric(strBalance) Then
MsgBox "请正确余额数！"
Me.txtBalance.SetFocus
Exit Sub
End If
strCondition = "UID='" & strUID & "'"
If objDBOpt.IsRecordExist("CUSER", strCondition) Then
Set rsRoom = objDBOpt.getRecord("CUser", "*", strCondition, 1, 3)
If Not (rsRoom Is Nothing) Then
If Not rsRoom.EOF Then
rsRoom.Fields("uname").Value = strUName
rsRoom.Fields("Ctype").Value = strCType
rsRoom.Fields("pwd").Value = strPWD
rsRoom.Fields("balance").Value = strBalance
rsRoom.Update
MsgBox "数据修改成功！"
Exit Sub
Else
MsgBox "数据修改失败！"
Exit Sub
End If
Else
MsgBox "数据修改失败！"
Exit Sub
End If
Else
MsgBox "要修改的数据不存在！"
End If
End Sub
Private Sub cmdSearch_Click()
Dim strUID As String
Dim strCondition As String
strUID = Trim(Me.txtUID.Text)
If strUID = "" Then
MsgBox "请填写用户编号！"
Me.txtUID.SetFocus
Exit Sub
End If
strCondition = "UID = '" & strUID & "'"
Set rsTmp = objDBOpt.getRecord("CUser", "*", strCondition)
If rsTmp Is Nothing Then
MsgBox "数据查询失败"
Exit Sub
Else
If rsTmp.EOF And rsTmp.BOF Then
MsgBox "没有找到符合条件的信息！"
Exit Sub
Else
Me.txtUName.Text = rsTmp.Fields("UName").Value
'安全起见，密码不显示
'Me.txtPwd.Text = rsTmp.Fields("PWD").Value
Me.txtBalance.Text = rsTmp.Fields("Balance").Value
If Trim(rsTmp.Fields("CTYPE").Value) = "U" Then
Me.cmbCType.ListIndex = 0
ElseIf Trim(rsTmp.Fields("CTYPE").Value) = "H" Then
Me.cmbCType.ListIndex = 1
Else
Me.cmbCType.ListIndex = 2
End If
End If
End If
End Sub
Private Sub Form_Load()
'加入的收费方式
Me.cmbCType.AddItem "上机"
Me.cmbCType.AddItem "租借"
Me.cmbCType.AddItem "免费"
Me.cmbCType.ListIndex = 0
Me.txtBalance.Text = "0"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -