frmlogin.frm

VB库存管理系统

VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "系统登录"
   ClientHeight    =   1785
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3675
   Icon            =   "frmLogin.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1785
   ScaleWidth      =   3675
   StartUpPosition =   2  'CenterScreen
   Begin VB.ComboBox Cmbname 
      Height          =   300
      Left            =   1320
      TabIndex        =   5
      Text            =   "admin"
      Top             =   240
      Width           =   1815
   End
   Begin VB.CommandButton cmdcancel 
      Caption         =   "退  出"
      Height          =   375
      Left            =   1920
      TabIndex        =   4
      Top             =   1200
      Width           =   975
   End
   Begin VB.CommandButton cmdok 
      Caption         =   "登  录"
      Height          =   375
      Left            =   600
      TabIndex        =   3
      Top             =   1200
      Width           =   975
   End
   Begin VB.TextBox userpassword 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   1320
      PasswordChar    =   "*"
      TabIndex        =   0
      Text            =   "sys"
      Top             =   720
      Width           =   1815
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "密  码："
      Height          =   180
      Index           =   1
      Left            =   600
      TabIndex        =   2
      Top             =   840
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "用户名："
      Height          =   180
      Index           =   0
      Left            =   600
      TabIndex        =   1
      Top             =   360
      Width           =   720
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
   Dim pwdCount As Integer '这个是定义输入密码(登录的次数),会累加的.
   Dim mystring As String
   Dim mystr As String
   '************************调用API关闭"X"按钮*********************************
    Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

    Private Declare Function RemoveMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

    Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long

    Private Declare Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long

    Private Const MF_BYPOSITION = &H400&
    Private Const MF_DISABLED = &H2&

Private Sub Cmbname_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then userpassword.SetFocus

End Sub

    '***************************************************
Private Sub CmdCancel_Click()
'Unload Me
End
End Sub

Private Sub CmdOK_Click()
If Trim(Cmbname.Text) = "" Then  '当没有选择用户名时,不允许再下一步操作.
   MsgBox "没有输入用户名称,请重新输入!", vbOKOnly + vbExclamation, "警告"
   Cmbname.SetFocus
 Else
    SQL = "select * from userInfo where userID='" & Cmbname.Text & "'" 'SQL语句,
    Set rs = TransactSQL(SQL)  '连接模块中的连接数据库的函数,执行SQL语句
    If iflag = 1 Then
        If rs.EOF = True Then '查询到数据库无此条件时，不允许下一步操作
            MsgBox "查无此用户,请联系管理员!", vbOKOnly + vbExclamation, "警告"
            Cmbname.Text = ""
            Cmbname.SetFocus
        Else
            If Trim(rs.Fields(1)) = Trim(userpassword.Text) Then '用户名对应的密码跟登录界面上的相同，则进行登录
                rs.Close        '关闭数据库连接
'                Me.Hide
                gUserName = Trim(Cmbname.Text)  '保存用户名称
                gPWD = Trim(userpassword.Text)

                '以下两行是主界面上的任务栏上的东西
                frmMDIMain.StatusBar1.Panels(2) = "当前系统登录:" & gUserName
                frmMDIMain.StatusBar1.Panels(4) = "本程序由 钟干荣编写;欢迎下载使用.... "
'                frmMDIMain.mnusongxiu.Visible = False
'                frmMDIMain.mnufanxiu.Visible = False
'                MDIMain.Show
                '以下一段内容是关于权限的管理；如果不是admin的用户，则以下功能不可用
                If gUserName <> "admin" Then
'                    添加入库
                    frmMDIMain.mnuAddrk.Enabled = False
                    frmMDIMain.Toolbar1.Buttons(1).Enabled = False
'                    添加出库
                    frmMDIMain.mnuAddChuKu.Enabled = False
                    frmMDIMain.Toolbar1.Buttons(3).Enabled = False
'                    添加用户名称
                    frmMDIMain.mnuAdduser.Enabled = False
'                    备份数据库
                    frmMDIMain.mnubackdata.Enabled = False
'                    恢复数据库
                    frmMDIMain.mnuredata.Enabled = False
'                    初始化数据
                    frmMDIMain.mnufarmatdata.Enabled = False
'                    分配货位编号
                    frmMDIMain.mnufphw.Enabled = False
'                    查询用户名称与密码
                    frmMDIMain.mnuCheckUser.Enabled = False
                End If
'                以下一段是查询货位表是不是有货位编号存在，如果有，则分配货位编号的界面则不显示
'                如果货位表中没有货位编号，则显示分配货位编号的界面。
                SQL = "select * from [货位表]"
                Set rs = TransactSQL(SQL)
                If rs.EOF Then
                    
                    Unload Me
                    frmMDIMain.Show
                    frmfphw.Show 1
                Else
                    frmMDIMain.mnufphw.Enabled = False
'                    Exit Sub
                End If
                    Unload Me
                    frmMDIMain.Show
            Else
'                以下一段对输入密码的判断
                If userpassword.Text = "" Then
                    MsgBox "密码不能为空，请重新输入！", vbInformation, ginfo
                    userpassword.SetFocus
                    Exit Sub
                End If
                pwdCount = pwdCount + 1
                If pwdCount < 4 Then
                 mystring = MsgBox("密码错误,请重新输入!" & vbCrLf & "你还有:" & 4 - pwdCount & "次机会登录", vbOKOnly + vbExclamation, "通知")
                ElseIf pwdCount = 4 Then
                 mystring = MsgBox("对不起!" & vbCrLf & "你连续4次输入密码错误" & vbCrLf & "系统将强行退出", vbExclamation, "警告!")
                 Unload Me
                 Exit Sub
                End If
                
                 
                userpassword.Text = ""
                userpassword.SetFocus
            End If
            
        End If
    Else
        Unload Me
    End If
 End If
End Sub

Private Sub Form_Activate()
Cmbname.SetFocus
End Sub

Private Sub Form_Load()
Call DisableX(Me)       '调用下面的子过程,关闭控钮显示为灰色.
If Right(App.Path, 1) <> "\" Then
    CurrenFilePath = App.Path & "\"
Else
    CurrenFilePath = App.Path
End If
'以下一段把数据库里的用户名称显示在用户登录的界面上
   Set rs = New ADODB.Recordset
    SQL = "select * from userInfo"
    Set rs = TransactSQL(SQL)
    Do While Not rs.EOF
        Cmbname.AddItem rs.Fields(0).Value
        rs.MoveNext
    Loop
    rs.Filter = "userID='" & Cmbname.Text & "'"
End Sub
'**********************关闭按钮显示为灰色****************
    Private Sub DisableX(Frm As Form)

    Dim hMenu As Long, nCount As Long

    hMenu = GetSystemMenu(Frm.hwnd, 0)

    nCount = GetMenuItemCount(hMenu)

    Call RemoveMenu(hMenu, nCount - 1, MF_DISABLED Or MF_BYPOSITION)

    DrawMenuBar Frm.hwnd

    End Sub

'Private Sub Form_Unload(Cancel As Integer)
'Set rs = Nothing
'Unload Me
'End Sub

Private Sub userpassword_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then CmdOK_Click
If KeyCode = vbKeyUp Then Cmbname.SetFocus
If KeyCode = vbKeyDown Then CmdOK_Click
End Sub