frmlogin.frm

用VB做的一个数据库管理系统

VERSION 5.00
Begin VB.Form frmLogin 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "登录..."
   ClientHeight    =   1860
   ClientLeft      =   2835
   ClientTop       =   3480
   ClientWidth     =   3975
   ControlBox      =   0   'False
   Icon            =   "frmLogin.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1098.949
   ScaleMode       =   0  'User
   ScaleWidth      =   3732.31
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox UserTxt 
      Height          =   300
      Left            =   1350
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   345
      Width           =   2325
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   480
      Left            =   330
      Picture         =   "frmLogin.frx":000C
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   6
      Top             =   1155
      Width           =   480
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定(O)"
      Default         =   -1  'True
      Height          =   390
      Left            =   1365
      TabIndex        =   2
      Top             =   1245
      Width           =   1140
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   390
      Left            =   2550
      TabIndex        =   3
      Top             =   1245
      Width           =   1140
   End
   Begin VB.TextBox txtPassword 
      Height          =   285
      IMEMode         =   3  'DISABLE
      Left            =   1335
      PasswordChar    =   "*"
      TabIndex        =   0
      Top             =   750
      Width           =   2325
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      Caption         =   "用户名(&U):"
      Height          =   180
      Index           =   0
      Left            =   285
      TabIndex        =   4
      Top             =   405
      Width           =   900
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      Caption         =   "密码(&P):"
      Height          =   180
      Index           =   1
      Left            =   450
      TabIndex        =   5
      Top             =   795
      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 LOGINNO As Integer
Dim PassYu(10) As String
Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    '检查密码的正确性
Dim X As Long
    X = UserTxt.ListIndex
    '如果有加密，解密方法放此处，将PassYu(X)数组中的值，
    '转换成原来信息
  Dim FindStr As String
'将加密口令变回来
     Dim shiftStr As String, shiftStrR As Variant, shiftNum As Integer, iLi As Integer, sureStr As String
      shiftStr = Trim(txtPassword.Text)
      shiftNum = Len(shiftStr)
      iLi = 1
      sureStr = ""
        For iLi = 1 To shiftNum
            shiftStrR = Mid(shiftStr, iLi, 1)
            shiftStrR = Asc(shiftStrR)
            shiftStrR = shiftStrR - 3
            shiftStrR = Chr(shiftStrR)
            sureStr = sureStr & shiftStrR
        Next
        '密匙
   '开始查找 sureStr为解除的口令
    If sureStr = PassYu(X) Then
        UserText = UserTxt.Text
        '密码正确时
        frmLogin.MousePointer = 11
        Load MDIForm1
        Unload Me
        MDIForm1.Show
        Exit Sub
    Else
        MsgBox "无效的密码，再试一次！", 32, "登录"
        LOGINNO = LOGINNO + 1
    If LOGINNO > 3 Then
        MsgBox "对不起，您不能使用该系统！", 64, "登录失败"
        Unload Me
        Exit Sub
     End If
        txtPassword.SetFocus
        SendKeys "{Home}+{End}"
    End If
End Sub
Private Sub Form_Load()
 
  On Error GoTo Err_SQL

  Me.Show
  Me.Refresh
  
  Dim retValue As Long
    retValue = SetActiveWindow(Me.hwnd)
  Browser = CurDir()
    If Right(Browser, 1) <> "\" Then
       Browser = Browser + "\"
    End If
If App.PrevInstance = True Then
   MsgBox "仓库管理系统已经启动，请按 Alt+Tab 切换！", vbOKOnly + 48, "警告..."
   Unload Me
   Exit Sub
End If
   ConData1 = ""
   ConData2 = ConData1
   ConData3 = ConData1
   Constr = ";UID=;PWD=;"
    
Dim DB As Database, Ef As Recordset, X As Long, I As Long
Dim UserYu(10) As String

    Set DB = OpenDatabase(App.Path & "\Sys\User.mdb", 0, 0, Constr)
    Set Ef = DB.OpenRecordset("Select * From Main", dbOpenDynaset)
    
        X = Ef.RecordCount
    Set Ef = DB.OpenRecordset("Select 操作员,口令 From MAIN", dbOpenDynaset)
    For I = 0 To X - 1
        UserYu(I) = Ef.Fields(0).Value
        If Not IsNull(Ef.Fields(1).Value) Then
           PassYu(I) = Ef.Fields(1).Value
        End If
        UserTxt.AddItem UserYu(I), I
        Ef.MoveNext
    Next
     DB.Close
If X >= 1 Then
    UserTxt.ListIndex = 0
End If
LOGINNO = 1
 Exit Sub
Err_SQL:
  MsgBox "对不起，系统错误 ： " & vbCrLf & vbCrLf & Err.Description, vbCritical, "提示：By Yusilong."
 
End Sub

Private Sub UserTxt_Click()
 SendKeys "{Tab}"
End Sub

Private Sub UserTxt_LostFocus()
 txtPassword.SetFocus
End Sub