frmlog.frm

本系统实现了对实验室设备的增删改查等基本的功能

            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   3240
         Style           =   1  'Graphical
         TabIndex        =   3
         Top             =   240
         Width           =   855
      End
      Begin VB.TextBox Txtser 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00C0C000&
         Height          =   375
         IMEMode         =   3  'DISABLE
         Left            =   840
         PasswordChar    =   "*"
         TabIndex        =   2
         Top             =   720
         Width           =   2175
      End
      Begin VB.TextBox Txtnum 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00C0C000&
         Height          =   375
         Left            =   840
         TabIndex        =   1
         Top             =   240
         Width           =   2175
      End
      Begin VB.Label Label5 
         BackStyle       =   0  'Transparent
         Caption         =   "密码"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FFFFFF&
         Height          =   375
         Left            =   120
         TabIndex        =   6
         Top             =   840
         Width           =   615
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "学号"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FFFFFF&
         Height          =   375
         Left            =   120
         TabIndex        =   5
         Top             =   360
         Width           =   615
      End
   End
End
Attribute VB_Name = "frmlog"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*****************************************
'模块名称：用户登录模块
'模块功能：完成用户登录，判断用户是否合法，允许合法用户登录，拒绝非法用户登录，并完成权限控制
'版本    ：1.0版
'代码编写者：熊锋
'编写日期：2006-10-18
'*****************************************
'Public Declare Function GetComputerName Lib "Kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Command1_Click() '用户登录系统时进行判断，判断用户信息是否正确，若正确，则打开用户权限表，按权限将主界面菜单进行屏蔽，达到操作限制的目的
   Dim rs As New ADODB.Recordset  '定义记录集，用于打开用户表，并判断是否存在相应的用户
   Dim rs1 As New ADODB.Recordset  '定义记录集，用于打开权限表，并将权限信息中的值给相应菜单项
   Dim rs2 As New ADODB.Recordset  '判断密码是否正确
   Dim rs3 As New ADODB.Recordset
   Dim n, X, M As Integer
'   If Txtdbsev.Text = "请选择服务器" Then
'      MsgBox "请选择服务器"
'      Exit Sub
'   End If
   If txtuser.Text = "" Then
      MsgBox "请输入用户名！"
      Exit Sub
   End If
   If txtid.Text = "" Then
      MsgBox "请输入密码"
      Exit Sub
   End If
   If txtuser.Text = "Admin" Or txtuser.Text = "admin" Then '判断是否是超级用户登录系统，超级用户登录系统可多次登录，不会锁定
      rs3.Open "select * from SysAd_Info where Admin_Name='" & Trim(txtuser.Text) & "' and Admin_SecNum='" & Trim(txtid.Text) & "'", DBCnn, adOpenStatic, adLockOptimistic
      If rs3.RecordCount > 0 Then
         frmmain.Show
         frmlog.Hide
      Else
         MsgBox "密码有误，请重新输入！"
      End If
   Else  '非超级用户登录系统时，不正确的登录次数有限制，超过5次不正确登录时，该用户即被锁定
      rs.Open "select * from SysAd_Info where Admin_Name='" & Trim(txtuser.Text) & "'", DBCnn, adOpenStatic, adLockOptimistic
      If rs.RecordCount <= 0 Then  '用户名存在
         MsgBox "该用户名不存在！请重新输入正确信息！"
      Else
         If Val(rs.Fields("Times")) >= 5 Then   '进入系统前，判断登录次数，超过次数不能正确登录即锁定该用户
             MsgBox "该用户已被锁定，请与超级管理员联系！"
         Else
             rs2.Open "select * from SysAd_Info where Admin_SecNum='" & Trim(txtid.Text) & "'", DBCnn, adOpenStatic, adLockOptimistic
            If rs2.RecordCount > 0 Then
               rs.Fields("Times") = 0  '用户锁定前正确登录时，将以前不正确次数改为0
               rs.Update
               frmmain.Show
               frmlog.Hide
'               MsgBox "欢迎使用实验室设备管理系统！"
            Else
               rs.Fields("Times") = rs.Fields("Times") + 1  '用户密码不正确时，即将不正确登录次数加1
               rs.Update
               MsgBox "密码输入有误，请重新输入！"
            End If
         End If
      End If
   End If
   '通过菜单屏蔽控制权限
      rs1.Open "select * from Limit_Info where Role_id in (select Role_id from SysAd_Info where Admin_Name='" & Trim(txtuser.Text) & "')", DBCnn, adOpenStatic, adLockOptimistic
         If rs1.RecordCount > 0 Then
            n = frmmain.menu1.UBound  '6
            X = frmmain.menu1.UBound + frmmain.menu2.UBound '11
            Y = frmmain.menu1.UBound + frmmain.menu2.UBound + frmmain.menu3.UBound '17
            For i = 1 To frmmain.menu1.UBound
                 frmmain.menu1(i).Enabled = rs1.Fields(i)
            Next i
            For i = 1 To frmmain.menu2.UBound
                 frmmain.menu2(i).Enabled = rs1.Fields(i + n)
            Next i
            For i = 1 To frmmain.menu3.UBound
                 frmmain.menu3(i).Enabled = rs1.Fields(i + X)
            Next i
            For i = 1 To frmmain.menu4.UBound
                 frmmain.menu4(i).Enabled = rs1.Fields(i + Y)
            Next i
            For i = 0 To frmmain.Lab.UBound - 2
                 frmmain.Lab(i).Enabled = rs1.Fields(i + 1)
            Next i
         End If
   rs1.Close
End Sub

Private Sub Command1_KeyPress(KeyAscii As Integer) '
      If KeyAscii = 13 Then
         Command2.SetFocus
      End If
End Sub

Private Sub Command3_Click()
   Dim rs As New ADODB.Recordset
   If Txtdbsev.Text = "" Then
      MsgBox "请输入服务器名"
      Exit Sub
   End If
   If Txtnum.Text = "" Then
      MsgBox "学号必须输入"
      Exit Sub
   End If
   If Txtser.Text = "" Then
      MsgBox "密码必须输入"
      Exit Sub
   End If
    rs.Open "select * from User_Info where Usr_ID='" & Trim(Txtnum.Text) & "' and Usr_Sernum='" & Trim(Txtser.Text) & "'", DBCnn, adOpenStatic, adLockOptimistic
      If rs.RecordCount <= 0 Then
         MsgBox "学号或密码有误，不能登录"
         Exit Sub
      Else
         frmstuinfo.Show
         frmlog.Hide
      End If
End Sub

Private Sub Command3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       Command4.SetFocus
    End If
End Sub

Private Sub Command4_Click()
   frmregister.Show
End Sub

Private Sub Command5_Click()
   Dim dbsev As String
   If Txtdbsev.Text = "" Then
      MsgBox "请输入服务器名"
      Exit Sub
   End If
   dbsev = Txtdbsev.Text
   Unload frmlog
   frmlog.Show
   Txtdbsev.Text = dbsev
   Option1.Value = True
'   Dim rs As New ADODB.Recordset
'    rs.Open "select * from Reg_Info", DBCnn, adOpenStatic, adLockOptimistic
'     Command4.Enabled = rs.Fields("Reg")  '看是否有注册权限
'   rs.Close
End Sub
'
Private Sub Form_Load()
    Dim rs As New ADODB.Recordset
    Set cnn = New ADODB.Connection
        cnn.Open "driver=SQL Server;server=;uid=;pwd=:database=master"
    rs.Open "select SrvName from SysServers where IsRemote='0'", cnn, adOpenStatic, adLockOptimistic
   
    Dim Server As SQLDMO.NameList
    Dim appDMO  As New SQLDMO.Application
    Dim i As Integer
    Set Server = appDMO.ListAvailableSQLServers
     For i = 0 To Server.Count
       Txtdbsev.AddItem Server(i)
     Next i
     Txtdbsev.RemoveItem (0)
     Txtdbsev.AddItem rs.Fields("SrvName")
'     Txtdbsev.AddItem "XIONGFENG"
     rs.Close
     cnn.Close
End Sub

Private Sub Option1_Click()
'   Command5.Enabled = True
   If Txtdbsev.Text = "请选择服务器" Then
      MsgBox "请先选择服务器"
      Option1.Value = False
      Exit Sub
   End If
   Frame2.Visible = False
   Frame1.Visible = True
   Txtnum.SetFocus
   Dim rs As New ADODB.Recordset
   rs.Open "select * from Reg_Info", DBCnn, adOpenStatic, adLockOptimistic
     Command4.Enabled = rs.Fields("Reg")  '看是否有注册权限
   rs.Close
End Sub

Private Sub Option2_Click()
'   Command5.Enabled = False
   Frame2.Visible = True
   Frame1.Visible = False
   txtuser.SetFocus
End Sub



Private Sub Txtdbsev_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub txtid_KeyPress(KeyAscii As Integer)  '用户名输完后，回车是跳到登录按钮
    If KeyAscii = 13 Then
       Command1.SetFocus
    End If
End Sub



Private Sub Txtnum_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       SendKeys "{tab}"
    End If
End Sub


Private Sub Txtser_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       Command3.SetFocus
    End If
End Sub

Private Sub txtuser_KeyPress(KeyAscii As Integer)  '用户名输完后，回车是跳到txtid
    If KeyAscii = 13 Then
       SendKeys "{tab}"
    End If
End Sub