frmmain.frm

用vb写的饮食管理系统功能全面

VERSION 5.00
Object = "{0BA686C6-F7D3-101A-993E-0000C0EF6F5E}#1.0#0"; "THREED32.OCX"
Object = "{E3AE1957-12AC-4DB7-8CE4-EB281F9E0359}#1.0#0"; "XPButton.ocx"
Begin VB.Form frmSplash 
   BackColor       =   &H000080FF&
   BorderStyle     =   0  'None
   Caption         =   "餐饮茶馆控制系统"
   ClientHeight    =   6375
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   7455
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6375
   ScaleWidth      =   7455
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin XPButton.Button cmdCancel 
      Height          =   315
      Left            =   6540
      TabIndex        =   4
      Top             =   1320
      Width           =   675
      _ExtentX        =   1191
      _ExtentY        =   556
      caption         =   "退出"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin XPButton.Button cmdOK 
      Height          =   315
      Left            =   5730
      TabIndex        =   3
      Top             =   1320
      Width           =   705
      _ExtentX        =   1244
      _ExtentY        =   556
      caption         =   "登录"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.ComboBox UserTxt 
      BackColor       =   &H80000004&
      Height          =   300
      Left            =   5760
      TabIndex        =   0
      Top             =   270
      Width           =   1500
   End
   Begin VB.TextBox txtPassword 
      Appearance      =   0  'Flat
      BackColor       =   &H80000004&
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   5745
      MaxLength       =   30
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   840
      Width           =   1500
   End
   Begin Threed.SSPanel SSPanel1 
      Height          =   360
      Left            =   -15
      TabIndex        =   2
      Top             =   6015
      Width           =   7500
      _Version        =   65536
      _ExtentX        =   13229
      _ExtentY        =   635
      _StockProps     =   15
      Caption         =   "云南昆明阳光软件工作室    电话：[phone] "
      BackColor       =   12632256
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Font3D          =   3
   End
   Begin VB.Image Img 
      Height          =   450
      Index           =   2
      Left            =   5130
      Top             =   750
      Width           =   465
   End
   Begin VB.Image Img 
      Height          =   450
      Index           =   1
      Left            =   5130
      Stretch         =   -1  'True
      Top             =   180
      Width           =   465
   End
End
Attribute VB_Name = "frmSplash"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim LOGINNO As Integer
Dim PassYu(30) As String
Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long

Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Dim strConnect As String
Dim pass As String


Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    '检查密码的正确性
 'On Error GoTo Err_Display
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
        '密码正确时
        Me.Hide
        frmSplash.MousePointer = 11
        '正常登录时
        Load frmMain
        ' AuthorityE  '设定权限
        frmMain.Show
        Exit Sub
    Else
        MsgBox "无效的密码，再试一次！", 32, "登录"
        LOGINNO = LOGINNO + 1
    If LOGINNO > 3 Then
        MsgBox "对不起，您不能使用该系统！", vbCritical, "登录失败"
        '不能登录时
        Unload Me
        Exit Sub
     End If
        txtPassword.SetFocus
        SendKeys "{Home}+{End}"
    End If
    
    Exit Sub

Err_Display:

  MsgBox "应用程序错误:" & vbCr & vbCr & err.Description, vbOKOnly, "提示：By Yusilong."
  Exit Sub
End Sub

Private Sub Form_Load()

    GetFormSet Me, Screen
    '安装公司图片
    'On Error Resume Next
  
    Img(1).Picture = LoadResPicture(252, vbResIcon)
    Img(2).Picture = LoadResPicture(210, vbResIcon)

    frmSplash.Picture = LoadPicture(App.Path & "\Setup.Bmp")

    Dim retValue As Long
    retValue = SetActiveWindow(Me.hwnd)
     
     
    CurrDir = App.Path & "\"
'    Me.Icon = LoadResPicture(227, vbResIcon)
    
    CurrYear = Year(Date)
    CurrMonth = get2month(Month(Date))
    
Dim DB As Database, EF As Recordset, x As Long, i As Long
Dim UserYu(30) As String


    Set DB = OpenDatabase(ConData, False, False, Constr)
  
    Set EF = DB.OpenRecordset("Main", dbOpenTable)
    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
    
    EF.Close
    DB.Close
    
    If x >= 1 Then
        UserTxt.ListIndex = 0
    End If
    
    LOGINNO = 1
    
    '退出
    Exit Sub
NetErr:
    MsgBox " 未知错误,请重新登录!     ", vbInformation
    UserTxt.Enabled = False
    txtPassword.Enabled = False
    Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
   SaveFormSet Me
    
End Sub

Private Sub txtPassword_Change()

 '   UserText = CheckProduct("Main", "口令", ConVertEncry(Trim(txtPassword.Text)), 0)
     
' If UserText <> "" Then
'    Me.Hide
'    Load frmMain
'    frmMain.Show
' End If
   
End Sub

Private Sub txtPassword_KeyPress(KeyAscii As Integer)

  If KeyAscii = 13 Then
     If Trim(txtPassword.Text) <> "" And Trim(UserTxt.Text) <> "" Then
        cmdOK.Value = True
     End If
  End If
  
End Sub

Private Sub UserTxt_Click()

 SendKeys "{Tab}"
 
End Sub

Private Sub UserTxt_KeyPress(KeyAscii As Integer)

  If KeyAscii = 13 Then
     txtPassword.SetFocus
  End If
  
End Sub