?? guanliyuan.frm
字號:
VERSION 5.00
Begin VB.Form guanliyuan
Caption = "管理員"
ClientHeight = 7185
ClientLeft = 60
ClientTop = 420
ClientWidth = 9090
LinkTopic = "Form1"
Picture = "guanliyuan.frx":0000
ScaleHeight = 7185
ScaleWidth = 9090
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox txtnews
Height = 375
Left = 2400
TabIndex = 13
Text = "Text1"
Top = 3120
Width = 1335
End
Begin VB.CommandButton cmdmove
Caption = "|<"
Height = 345
Index = 0
Left = 1080
TabIndex = 12
Top = 3120
Width = 600
End
Begin VB.CommandButton cmdmove
Caption = ">|"
Height = 420
Index = 3
Left = 4440
TabIndex = 11
Top = 3120
Width = 600
End
Begin VB.CommandButton cmdseek
BackColor = &H0080C0FF&
Caption = "查詢"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 720
Style = 1 'Graphical
TabIndex = 10
Top = 3960
Width = 1335
End
Begin VB.TextBox txtusername
BackColor = &H00FFFFC0&
DataSource = "DataEnvironment1"
Height = 375
Left = 2880
TabIndex = 7
Text = "Text2"
Top = 1440
Width = 1935
End
Begin VB.TextBox txtpassword
BackColor = &H00FFFFC0&
Height = 375
Left = 2880
TabIndex = 6
Text = "Text3"
Top = 2040
Width = 1935
End
Begin VB.CommandButton cmdmove
BackColor = &H00FFC0FF&
Caption = "<<"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 1680
Style = 1 'Graphical
TabIndex = 5
Top = 3120
Width = 735
End
Begin VB.CommandButton cmdmove
BackColor = &H000000C0&
Caption = ">>"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 2
Left = 3720
Style = 1 'Graphical
TabIndex = 4
Top = 3120
Width = 735
End
Begin VB.CommandButton cmdadd
BackColor = &H00C0E0FF&
Caption = "添加"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 720
Style = 1 'Graphical
TabIndex = 3
Top = 4680
Width = 1455
End
Begin VB.CommandButton cmddelete
BackColor = &H00C0C0FF&
Caption = "刪除"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2760
Style = 1 'Graphical
TabIndex = 2
Top = 4680
Width = 1335
End
Begin VB.CommandButton cmdexit
BackColor = &H0080C0FF&
Caption = "退出"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 4800
Style = 1 'Graphical
TabIndex = 1
Top = 4680
Width = 1335
End
Begin VB.CommandButton cmdsave
BackColor = &H000080FF&
Caption = "保存"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2520
Style = 1 'Graphical
TabIndex = 0
Top = 3960
Width = 1455
End
Begin VB.Label Label2
BackColor = &H00C0FFC0&
Caption = "用戶名稱："
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1080
TabIndex = 9
Top = 1440
Width = 1575
End
Begin VB.Label Label3
BackColor = &H00C0FFC0&
Caption = "密碼："
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1080
TabIndex = 8
Top = 2040
Width = 1575
End
End
Attribute VB_Name = "guanliyuan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim isAdding As Boolean '定義操作狀態標志
Dim objAdmin As Recordset '用于保存管理員數據表記錄
Dim objCn As Connection '用于建立數據庫聯接
Private Sub cmdadd_Click()
txtnews = "添加新記錄"
txtusername = ""
txtpassword = ""
isAdding = True
End Sub
Private Sub cmddelete_Click()
'根據是否處于添加記錄狀態執行不同的操作
If isAdding Then
'退出添加記錄狀態，顯示當前記錄
isAdding = False
If objAdmin.BOF And objAdmin.EOF Then
txtnews = "記錄：無" '顯示無記錄提示
Else
'顯示當前記錄數據
txtusername = objAdmin.Fields("用戶名稱")
txtpassword = objAdmin.Fields("口令")
'顯示當前記錄編號和記錄總數
txtnews = "記錄：" & objAdmin.AbsolutePosition & "/" & objAdmin.RecordCount
End If
Else
If objAdmin.RecordCount > 0 Then
If MsgBox("是否刪除當前記錄？", vbYesNo + vbQuestion, "系統用戶管理") = vbYes Then
objAdmin.Delete '執行刪除當前記錄操作
cmdmove(2).Value = True '顯示下一記錄數據
Else
'顯示當前記錄數據
txtusername = objAdmin.Fields("用戶名")
txtpassword = objAdmin.Fields("口令")
'顯示當前記錄編號和記錄總數
txtnews = "記錄：" & objAdmin.AbsolutePosition & "/" & objAdmin.RecordCount
End If
End If
End If
End Sub
Private Sub cmdexit_Click()
Unload Me
End Sub
Private Sub cmdMove_Click(Index As Integer)
With objAdmin
Select Case Index '切換當前記錄
Case 0 '使第一個記錄成為當前記錄
If .RecordCount > 0 And Not .BOF Then .MoveFirst
Case 1 '使上一個記錄成為當前記錄
If .RecordCount > 0 And Not .BOF Then
.MovePrevious
If .BOF Then .MoveFirst
End If
Case 2 '使下一個記錄成為當前記錄
If .RecordCount > 0 And Not .EOF Then
.MoveNext
If .EOF Then .MoveLast
End If
Case 3 '使最后一個記錄成為當前記錄
If .RecordCount > 0 And Not .EOF Then .MoveLast
End Select
If .RecordCount < 1 Then
txtnews = "記錄：無" '顯示無記錄提示
txtusername = ""
txtpassword = ""
Else
'顯示當前記錄數據
txtusername = .Fields("用戶名稱")
txtpassword = .Fields("密碼")
'顯示當前記錄編號和記錄總數
txtnews = "記錄：" & .AbsolutePosition & "/" & .RecordCount
End If
End With
If isAdding Then isAdding = False '改變當前記錄則退出當前添加記錄狀態
End Sub
Private Sub cmdsave_Click()
Dim objCopy As New Recordset
If Trim(txtusername) = "" Then
MsgBox "用戶名不能為空！", vbCritical, "系統用戶管理"
txtusername.SetFocus
txtusername = ""
ElseIf Len(Trim(txtpassword)) <> 6 Then
MsgBox "用戶口令必須為6位字符串！", vbCritical, "系統用戶管理"
txtpassword.SetFocus
txtpassword.SelStart = 0
txtpassword.SelLength = Len(txtpassword)
Else
Set objCopy = objAdmin.Clone
With objCopy
If .RecordCount > 0 Then
'檢查用戶名是否被使用
.MoveFirst
.Find "用戶名稱='" & Trim(txtusername) & "'"
If (isAdding And Not .EOF) Or (Not isAdding And Not .EOF And _
.AbsolutePosition <> objAdmin.AbsolutePosition) Then
MsgBox "用戶名稱：" & Trim(txtusername) & "已被使用，請使用其他用戶名！", _
vbCritical, "系統用戶管理"
txtusername.SetFocus
txtusername.SelStart = 0
txtusername.SelLength = Len(txtusername)
Exit Sub
End If
End If
End With
'保存或添加記錄
If isAdding Then objAdmin.AddNew
objAdmin.Fields("用戶名") = Trim(txtusername)
objAdmin.Fields("口令") = Trim(txtpassword)
objAdmin.Update
MsgBox "數據保存成功！", vbInformation, "系統用戶管理"
isAdding = False
'顯示當前記錄編號和記錄總數
txtnews = "記錄：" & objAdmin.AbsolutePosition & "/" & objAdmin.RecordCount
End If
End Sub
Private Sub cmdseek_Click()
Dim strKey$
strKey = InputBox("請輸入要查詢的用戶名！", "查詢管理員")
If strKey = "" Then
MsgBox "輸入無效！", vbInformation, "系統用戶管理"
Else
With objAdmin
If .RecordCount > 0 Then
.MoveFirst
.Find "用戶名稱 like '*" & strKey & "*'"
If .EOF Then
MsgBox "無用戶名稱為 " & strKey & " 的管理員記錄！", vbInformation, "系統用戶管理"
Else
'顯示當前記錄數據
txtusername = .Fields("用戶名稱")
txtpassword = .Fields("密碼")
'顯示當前記錄編號和記錄總數
txtnews = "記錄：" & .AbsolutePosition & "/" & .RecordCount
End If
Else
MsgBox "無管理員記錄！", vbInformation, "系統用戶管理"
End If
End With
End If
End Sub
Private Sub Form_Load()
'建立數據庫聯接
Set objCn = New Connection '實例化聯接對象
With objCn '建立數據庫聯接
.Provider = "SQLOLEDB"
.ConnectionString = "User ID=sa;PWD=;Data Source=(local);" & _
"Initial Catalog=datatushu"
.Open
End With
'獲取管理員記錄
Set objAdmin = New Recordset '實例化objAdmin對象
With objAdmin
Set .ActiveConnection = objCn
.CursorLocation = adUseClient '指定使用客戶端游標
.CursorType = adOpenStatic '指定使用靜態游標
.LockType = adLockOptimistic
.Open "SELECT * FROM 管理者信息" '獲取管理員登錄信息
End With
'觸發按鈕單擊事件，顯示第一個記錄
cmdmove(0).Value = True
End Sub
Private Sub txtnews_Change()
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -