?? frmsetper.frm
字號:
Caption = "登錄信息"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00004080&
Height = 210
Left = 1440
TabIndex = 3
Top = 120
Width = 900
End
Begin VB.Image Image1
Height = 735
Left = 240
Picture = "frmSetPer.frx":1E5A
Stretch = -1 'True
Top = 0
Width = 735
End
Begin VB.Label Label1
BackColor = &H00FFC0C0&
Height = 855
Left = 0
TabIndex = 2
Top = 0
Width = 3855
End
End
Attribute VB_Name = "frmSetPer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim p As String '保存密碼用
Private Sub Command1_Click()
Frame2.Caption = "添加狀態"
Frame2.Visible = True
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = True
Label4.Caption = "密碼:"
Label5.Caption = "重復密碼:"
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Frame2.Refresh
End Sub
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseDown(Command1)
End Sub
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.BackColor = &H8000000D
End Sub
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseUp(Command1)
End Sub
Private Sub Command2_Click()
Dim strSQL As String
Call mbdOpen("用戶表", "user_ID", lv.SelectedItem.Text)
If mbdGet("權限") = "1" Then MsgBox "超級用戶不用刪除", vbQuestion + vbOKOnly: Call mbdClose: Exit Sub
Call mbdClose
If MsgBox("是否真要刪除?", vbQuestion + vbYesNo) = vbYes Then
strSQL = "Delete From 用戶表 "
strSQL = strSQL + "Where user_ID='" + lv.SelectedItem.Text + "'"
ADOcn.Execute strSQL
MsgBox "刪除成功", vbQuestion + vbOKOnly
End If
Call Form_Activate
End Sub
Private Sub Command2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseDown(Command2)
End Sub
Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command2.BackColor = &H8000000D
End Sub
Private Sub Command2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseUp(Command2)
End Sub
Private Sub Command3_Click()
Frame2.Caption = "修改狀態"
Frame2.Visible = True
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = True
Label4.Caption = "舊密碼:"
Label5.Caption = "新密碼:"
Text1.Text = lv.SelectedItem.Text
Text2.Text = "": Text3.Text = "": Text2.SetFocus
Frame2.Refresh
End Sub
Private Sub Command3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseDown(Command3)
End Sub
Private Sub Command3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command3.BackColor = &H8000000D
End Sub
Private Sub Command3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseUp(Command3)
End Sub
Private Sub Command4_Click()
Call Form_Activate
End Sub
Private Sub Command4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseDown(Command4)
End Sub
Private Sub Command4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command4.BackColor = &H8000000D
End Sub
Private Sub Command4_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseUp(Command4)
End Sub
Private Sub Command5_Click()
Dim strSQL As String
If Frame2.Caption = "添加狀態" Then
If Text2.Text <> Text3.Text Then MsgBox "前后密碼不一致,請重新輸入", vbQuestion + vbOKOnly: Text2.Text = "": Text3.Text = "": Text2.SetFocus: Exit Sub
Call mbdOpen("用戶表", "user_ID", Text1.Text)
If mbdGet("user_ID") <> "" Then MsgBox "已有一個相同用戶名了", vbCritical + vbOKOnly: Exit Sub
Call mbdClose
strSQL = "Insert Into 用戶表(user_ID,user_Password,權限)"
strSQL = strSQL + " Values('" + Text1.Text + "','" + EDcode$(Text3.Text, 12358) + "','" + "2" + "')"
ADOcn.Execute strSQL
MsgBox "已成功添加用戶", vbQuestion + vbOKOnly
Else
Call mbdOpen("用戶表", "user_ID", Text1.Text)
If EDcode$(mbdGet("user_Password"), 12358) <> Text2.Text Then MsgBox "原始密碼不正確", vbQuestion + vbOKOnly: Text2.Text = "": Text3.Text = "": Text2.SetFocus: Call mbdClose: Exit Sub
Call mbdClose
If Label5.Caption = "新密碼:" Then p = Text3.Text: Label5.Caption = "重復新密碼:": MsgBox "請重復新密碼", vbQuestion + vbOKOnly: Text3.Text = "": Text3.SetFocus: Exit Sub
If Text3.Text <> p Then MsgBox "新密碼前后兩次輸入不一致", vbQuestion + vbOKOnly: Text3.Text = "": Text3.SetFocus: Exit Sub
strSQL = "Update 用戶表 "
strSQL = strSQL + "Set user_Password='" + EDcode$(Text3.Text, 12358) + "'"
strSQL = strSQL + " Where user_ID='" + Text1.Text + "'"
ADOcn.Execute strSQL
MsgBox "修改成功", vbQuestion + vbOKOnly
End If
Call Command6_Click
End Sub
Private Sub Command5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseDown(Command5)
End Sub
Private Sub Command5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command5.BackColor = &H8000000D
End Sub
Private Sub Command5_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseUp(Command5)
End Sub
Private Sub Command6_Click()
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Frame2.Visible = False
Call Form_Activate
End Sub
Private Sub Command6_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseDown(Command6)
End Sub
Private Sub Command6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command6.BackColor = &H8000000D
End Sub
Private Sub Command6_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call cmdMouseUp(Command6)
End Sub
Private Sub Form_Activate()
Frame2.Visible = False
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = False
Disp
End Sub
Private Sub Form_Load()
lv.ColumnHeaders.Add , , "用戶名", 1000
lv.ColumnHeaders.Add , , "狀態"
Label17.Caption = User
Call mbdOpen("用戶表", "user_ID", User)
If mbdGet("權限") = "1" Then Label18.Caption = "超級用戶"
If mbdGet("權限") = "2" Then Label18.Caption = "受限用戶"
Call mbdClose
End Sub
Private Sub Disp()
Dim ADOrs As New Recordset
Dim Rec As Integer, i As Integer
lv.ListItems.Clear
ADOrs.ActiveConnection = ADOcn
ADOrs.CursorLocation = adUseClient
ADOrs.CursorType = adOpenDynamic
ADOrs.CursorType = adOpenStatic
ADOrs.LockType = adLockOptimistic
ADOrs.Open "Select * From 用戶表 Order By user_ID"
ADOrs.MoveLast
Rec = ADOrs.RecordCount
ADOrs.MoveFirst
For i = 1 To Rec
lv.ListItems.Add i, , ADOrs.Fields("user_ID")
If ADOrs("user_ID") = User Then
lv.ListItems(i).SubItems(1) = "活動的"
Else
lv.ListItems(i).SubItems(1) = " -- "
End If
ADOrs.MoveNext
If ADOrs.EOF Then Exit Sub
Next
ADOrs.Close
lv.Refresh
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Command1.BackColor <> &H8000000F Or Command2.BackColor <> &H8000000F Or Command4.BackColor <> &H8000000F Or Command3.BackColor <> &H8000000F Then
Command3.BackColor = &H8000000F
Command1.BackColor = &H8000000F
Command2.BackColor = &H8000000F
Command4.BackColor = &H8000000F
End If
End Sub
Private Sub Frame2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Command5.BackColor <> &H8000000F Or Command6.BackColor <> &H8000000F Then
Command5.BackColor = &H8000000F
Command6.BackColor = &H8000000F
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -