?? frmuser.frm
字號(hào):
VERSION 5.00
Begin VB.Form frmUser
BorderStyle = 1 'Fixed Single
Caption = "用戶(hù)維護(hù)"
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 = "查詢(xún)"
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 = "收費(fèi):"
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 = "編號(hào):"
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 = "上機(jī)" Then
strCType = "U"
ElseIf strCType = "租借" Then
strCType = "H"
Else
strCType = "O"
End If
If Trim(strUID) = "" Then
MsgBox "請(qǐng)?zhí)顚?xiě)用戶(hù)編號(hào)!"
Me.txtUID.SetFocus
Exit Sub
End If
If Not (IsNumeric(strUID) And InStr(1, strUID, ".", vbTextCompare) <= 0) Then
MsgBox "請(qǐng)正確填寫(xiě)用戶(hù)編號(hào)!"
Me.txtUID.SetFocus
Exit Sub
End If
If Trim(strUName) = "" Then
MsgBox "請(qǐng)?zhí)顚?xiě)用戶(hù)姓名!"
Me.txtUName.SetFocus
Exit Sub
End If
If Not IsNumeric(strBalance) Then
MsgBox "請(qǐng)正確余額數(shù)!"
Me.txtBalance.SetFocus
Exit Sub
End If
strCondition = "UID='" & strUID & "'"
If objDBOpt.IsRecordExist("CUSER", strCondition) Then
If MsgBox("用戶(hù)信息已經(jīng)存在,覆蓋嗎?", 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 "數(shù)據(jù)修改成功!"
Me.txtUID.Text = ""
Me.txtUName.Text = ""
Me.txtPwd.Text = ""
Me.txtBalance.Text = "0"
Me.cmbCType.ListIndex = 0
Exit Sub
Else
MsgBox "數(shù)據(jù)修改失敗!"
Exit Sub
End If
rsRoom.Close
Else
MsgBox "數(shù)據(jù)修改失敗!"
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 "數(shù)據(jù)添加成功!"
Me.txtUID.Text = ""
Me.txtUName.Text = ""
Me.txtPwd.Text = ""
Me.txtBalance.Text = "0"
Me.cmbCType.ListIndex = 0
Exit Sub
Else
MsgBox "數(shù)據(jù)添加失敗!"
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 "請(qǐng)?zhí)顚?xiě)用戶(hù)編號(hào)!"
Me.txtUID.SetFocus
Exit Sub
End If
strCondition = "UID = '" & strUID & "'"
If objDBOpt.DelRecord("CUser", strCondition) Then
MsgBox "數(shù)據(jù)刪除成功!"
Else
MsgBox "數(shù)據(jù)刪除失敗!"
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 = "上機(jī)" Then
strCType = "U"
ElseIf strCType = "租借" Then
strCType = "H"
Else
strCType = "O"
End If
If Trim(strUID) = "" Then
MsgBox "請(qǐng)?zhí)顚?xiě)用戶(hù)編號(hào)!"
Me.txtUID.SetFocus
Exit Sub
End If
If Not (IsNumeric(strUID) And InStr(1, strUID, ".", vbTextCompare) < 1) Then
MsgBox "請(qǐng)正確填寫(xiě)用戶(hù)編號(hào)!"
Me.txtUID.SetFocus
Exit Sub
End If
If Trim(strUName) = "" Then
MsgBox "請(qǐng)?zhí)顚?xiě)用戶(hù)姓名!"
Me.txtUName.SetFocus
Exit Sub
End If
If Not IsNumeric(strBalance) Then
MsgBox "請(qǐng)正確余額數(shù)!"
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 "數(shù)據(jù)修改成功!"
Exit Sub
Else
MsgBox "數(shù)據(jù)修改失敗!"
Exit Sub
End If
Else
MsgBox "數(shù)據(jù)修改失敗!"
Exit Sub
End If
Else
MsgBox "要修改的數(shù)據(jù)不存在!"
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 "請(qǐng)?zhí)顚?xiě)用戶(hù)編號(hào)!"
Me.txtUID.SetFocus
Exit Sub
End If
strCondition = "UID = '" & strUID & "'"
Set rsTmp = objDBOpt.getRecord("CUser", "*", strCondition)
If rsTmp Is Nothing Then
MsgBox "數(shù)據(jù)查詢(xún)失敗"
Exit Sub
Else
If rsTmp.EOF And rsTmp.BOF Then
MsgBox "沒(méi)有找到符合條件的信息!"
Exit Sub
Else
Me.txtUName.Text = rsTmp.Fields("UName").Value
'安全起見(jiàn),密碼不顯示
'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()
'加入的收費(fèi)方式
Me.cmbCType.AddItem "上機(jī)"
Me.cmbCType.AddItem "租借"
Me.cmbCType.AddItem "免費(fèi)"
Me.cmbCType.ListIndex = 0
Me.txtBalance.Text = "0"
End Sub
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -