www.pudn.com > DataCollectionSystem.rar > frmLogIn.frm, change:2004-01-29,size:12432b


VERSION 5.00 
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx" 
Begin VB.Form frmLogIn  
   BackColor       =   &H00E0E0E0& 
   BorderStyle     =   1  'Fixed Single 
   Caption         =   "系统登录" 
   ClientHeight    =   2550 
   ClientLeft      =   45 
   ClientTop       =   330 
   ClientWidth     =   4695 
   BeginProperty Font  
      Name            =   "宋体" 
      Size            =   9 
      Charset         =   0 
      Weight          =   400 
      Underline       =   0   'False 
      Italic          =   0   'False 
      Strikethrough   =   0   'False 
   EndProperty 
   Icon            =   "frmLogIn.frx":0000 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   2550 
   ScaleWidth      =   4695 
   StartUpPosition =   2  'CenterScreen 
   Begin MSComctlLib.ImageList ImgIcon  
      Left            =   3960 
      Top             =   120 
      _ExtentX        =   1005 
      _ExtentY        =   1005 
      BackColor       =   -2147483643 
      ImageWidth      =   32 
      ImageHeight     =   32 
      MaskColor       =   12632256 
      _Version        =   393216 
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}  
         NumListImages   =   2 
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmLogIn.frx":030A 
            Key             =   "" 
         EndProperty 
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmLogIn.frx":0624 
            Key             =   "" 
         EndProperty 
      EndProperty 
   End 
   Begin 数据采集子系统.LaVolpeButton cmdSubmit  
      Height          =   495 
      Left            =   3120 
      TabIndex        =   7 
      Top             =   1920 
      Width           =   1335 
      _ExtentX        =   2355 
      _ExtentY        =   873 
      BTYPE           =   3 
      TX              =   "登录(&L)" 
      ENAB            =   0   'False 
      BeginProperty FONT {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
         Name            =   "宋体" 
         Size            =   9 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      COLTYPE         =   1 
      BCOL            =   14215660 
      FCOL            =   0 
      FCOLO           =   0 
      EMBOSSM         =   12632256 
      EMBOSSS         =   16777215 
      MPTR            =   0 
      MICON           =   "frmLogIn.frx":093E 
      ALIGN           =   0 
      IMGLST          =   "ImgIcon" 
      IMGICON         =   "2" 
      ICONAlign       =   0 
      ORIENT          =   0 
      STYLE           =   0 
      IconSize        =   4 
      SHOWF           =   -1  'True 
      BSTYLE          =   0 
   End 
   Begin 数据采集子系统.LaVolpeButton cmdExit  
      Height          =   495 
      Left            =   240 
      TabIndex        =   6 
      Top             =   1920 
      Width           =   1335 
      _ExtentX        =   2355 
      _ExtentY        =   873 
      BTYPE           =   3 
      TX              =   "退出(&X)" 
      ENAB            =   -1  'True 
      BeginProperty FONT {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
         Name            =   "宋体" 
         Size            =   9 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      COLTYPE         =   1 
      BCOL            =   14215660 
      FCOL            =   0 
      FCOLO           =   0 
      EMBOSSM         =   12632256 
      EMBOSSS         =   16777215 
      MPTR            =   0 
      MICON           =   "frmLogIn.frx":095A 
      ALIGN           =   0 
      IMGLST          =   "ImgIcon" 
      IMGICON         =   "1" 
      ICONAlign       =   0 
      ORIENT          =   0 
      STYLE           =   0 
      IconSize        =   4 
      SHOWF           =   -1  'True 
      BSTYLE          =   0 
   End 
   Begin VB.TextBox txtMasterPassword  
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   9.75 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      ForeColor       =   &H00FF0000& 
      Height          =   285 
      IMEMode         =   3  'DISABLE 
      Left            =   1440 
      PasswordChar    =   "*" 
      TabIndex        =   5 
      Top             =   1440 
      Width           =   3015 
   End 
   Begin VB.ComboBox lstUserID  
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   9.75 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      ForeColor       =   &H00FF0000& 
      Height          =   315 
      ItemData        =   "frmLogIn.frx":0976 
      Left            =   1440 
      List            =   "frmLogIn.frx":0978 
      Style           =   2  'Dropdown List 
      TabIndex        =   4 
      Top             =   960 
      Width           =   3015 
   End 
   Begin VB.Label lblMasterPasswordCap  
      AutoSize        =   -1  'True 
      BackColor       =   &H00E0E0E0& 
      Caption         =   "密  码:" 
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   9.75 
         Charset         =   134 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      ForeColor       =   &H00FF0000& 
      Height          =   195 
      Left            =   240 
      TabIndex        =   3 
      Top             =   1440 
      Width           =   705 
   End 
   Begin VB.Label lblUserIDCap  
      AutoSize        =   -1  'True 
      BackColor       =   &H00E0E0E0& 
      Caption         =   "用户名:" 
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   9.75 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      ForeColor       =   &H00FF0000& 
      Height          =   195 
      Left            =   240 
      TabIndex        =   2 
      Top             =   960 
      Width           =   690 
   End 
   Begin VB.Image imgLock  
      Height          =   720 
      Left            =   120 
      Picture         =   "frmLogIn.frx":097A 
      Top             =   240 
      Width           =   720 
   End 
   Begin VB.Label lblEnter  
      AutoSize        =   -1  'True 
      BackColor       =   &H00E0E0E0& 
      Caption         =   "请输入用户名和密码" 
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   9.75 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   195 
      Left            =   960 
      TabIndex        =   1 
      Top             =   600 
      Width           =   1755 
   End 
   Begin VB.Label lblWelcome  
      AutoSize        =   -1  'True 
      BackColor       =   &H00E0E0E0& 
      Caption         =   "欢迎使用本系统" 
      BeginProperty Font  
         Name            =   "楷体_GB2312" 
         Size            =   18 
         Charset         =   134 
         Weight          =   700 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      ForeColor       =   &H00FF0000& 
      Height          =   360 
      Left            =   960 
      TabIndex        =   0 
      Top             =   120 
      Width           =   2625 
   End 
End 
Attribute VB_Name = "frmLogIn" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
 
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long 
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long 
Private Declare Function ClassXP Lib "ClassXP.dll" (ByVal hwnd As Long, ByVal dwFlags As Long) As Long 
 
Private Const MF_BYPOSITION = &H400& 
Dim cnn As New ADODB.Connection 
Dim rs As New ADODB.Recordset 
Dim rd As New ADODB.Recordset 
 
Private Sub RemoveMenus(frm As Form, _ 
    remove_restore As Boolean, _ 
    remove_move As Boolean, _ 
    remove_size As Boolean, _ 
    remove_minimize As Boolean, _ 
    remove_maximize As Boolean, _ 
    remove_seperator As Boolean, _ 
    remove_close As Boolean) 
Dim hMenu As Long 
     
    ' Get the form's system menu handle. 
    hMenu = GetSystemMenu(hwnd, False) 
     
    If remove_close Then DeleteMenu hMenu, 6, MF_BYPOSITION 
    If remove_seperator Then DeleteMenu hMenu, 5, MF_BYPOSITION 
    If remove_maximize Then DeleteMenu hMenu, 4, MF_BYPOSITION 
    If remove_minimize Then DeleteMenu hMenu, 3, MF_BYPOSITION 
    If remove_size Then DeleteMenu hMenu, 2, MF_BYPOSITION 
    If remove_move Then DeleteMenu hMenu, 1, MF_BYPOSITION 
    If remove_restore Then DeleteMenu hMenu, 0, MF_BYPOSITION 
End Sub 
 
Private Sub cmdExit_Click() 
ClassXP 0, 0 
End 
End Sub 
 
Private Sub cmdSubmit_Click() 
Dim sql As String 
 
sql = "Select ID,UserName,PassWord From 用户权限表 Where UserName=" & "'" & Trim(lstUserID.Text) & "'" 
rd.Open sql, cnn, adOpenStatic, adLockOptimistic 
 
If Trim(lstUserID.Text) = rd.Fields(1).Value And Trim(txtMasterPassword.Text) = rd.Fields(2).Value Then 
    rd.Close 
    Set rd = Nothing 
    frmLogIn.Hide 
    Unload frmLogIn 
    Load Frm_About 
ElseIf Trim(txtMasterPassword.Text) = "" Then 
    MsgBox "密码不能为空!", vbOKOnly + 16, "警告" 
    rd.Close 
    Set rd = Nothing 
Else 
    MsgBox "密码错误,请确认后重新输入!", vbOKOnly + 16, "警告" 
    txtMasterPassword.Text = "" 
    txtMasterPassword.SetFocus 
    rd.Close 
    Set rd = Nothing 
End If 
 
End Sub 
 
Private Sub Form_Activate() 
    txtMasterPassword.SetFocus 
End Sub 
 
Private Sub Form_Load() 
    Dim connStr As String, strSQL As String 
    ClassXP 0, 1 
    RemoveMenus Me, False, False, False, False, False, True, True 
    If App.PrevInstance = True Then 'this will insure that your program cannot be opened more then once 
       MsgBox "程序已经在运行!!", vbOKOnly + vbCritical, "错误" 
       End 
    End If 
    strSQL = "Select ID,UserName,PassWord From 用户权限表" 
    connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Profiles\sysdb.mdb" & ";Jet OLEDB:Database password=420111197709065755" 
    cnn.CursorLocation = adUseServer 
    cnn.ConnectionString = connStr 
    cnn.Open connStr 
    rs.Open strSQL, cnn, adOpenStatic, adLockOptimistic 
    rs.MoveFirst 
    Do While Not rs.EOF 
    lstUserID.AddItem rs.Fields(1).Value, rs.Fields(0).Value - 1 
    rs.MoveNext 
    Loop 
    lstUserID.ListIndex = 0 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
    ClassXP 0, 0 
    rs.Close 
    cnn.Close 
    Set rs = Nothing 
    Set cnn = Nothing 
End Sub 
 
Private Sub lstUserID_Change() 
If Len(lstUserID.Text) > 0 And Len(txtMasterPassword.Text) > 0 Then 
    cmdSubmit.Enabled = True 
Else 
    cmdSubmit.Enabled = False 
End If 
 
End Sub 
 
Private Sub txtMasterPassword_Change() 
If Len(lstUserID.Text) > 0 And Len(txtMasterPassword.Text) > 0 Then 
    cmdSubmit.Enabled = True 
Else 
    cmdSubmit.Enabled = False 
End If 
 
End Sub 
 
Private Sub txtMasterPassword_KeyPress(KeyAscii As Integer) 
     
    If KeyAscii = 13 Then 
        If Len(lstUserID.Text) > 0 And Len(txtMasterPassword.Text) > 0 Then 
            cmdSubmit_Click 
        Else 
            Beep 
            Exit Sub 
        End If 
    End If 
 
End Sub