frmsetper.frm

VB编制的图书管理系统,希望可给朋友们带来帮助.

      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