frmlogin.frm

经典delphi,Delphi下深入Windows核心编程.原书光盘代码

VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "登录"
   ClientHeight    =   3675
   ClientLeft      =   30
   ClientTop       =   330
   ClientWidth     =   4965
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3675
   ScaleWidth      =   4965
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Tag             =   "Login"
   Begin VB.ComboBox userCombo1 
      Height          =   300
      ItemData        =   "frmLogin.frx":0000
      Left            =   1560
      List            =   "frmLogin.frx":0002
      TabIndex        =   6
      Top             =   1320
      Width           =   2055
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   360
      Left            =   2100
      TabIndex        =   4
      Tag             =   "Cancel"
      Top             =   2304
      Width           =   1140
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   360
      Left            =   492
      TabIndex        =   3
      Tag             =   "OK"
      Top             =   2304
      Width           =   1140
   End
   Begin VB.TextBox txtPassword 
      Height          =   288
      IMEMode         =   3  'DISABLE
      Left            =   1548
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   1812
      Width           =   2064
   End
   Begin VB.Label Label1 
      Caption         =   "工厂进销存   管理系统"
      BeginProperty Font 
         Name            =   "华文彩云"
         Size            =   24
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000001&
      Height          =   972
      Left            =   480
      TabIndex        =   5
      Top             =   120
      Width           =   2532
   End
   Begin VB.Label lblLabels 
      Caption         =   "密  码:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Index           =   1
      Left            =   348
      TabIndex        =   0
      Tag             =   "&Password:"
      Top             =   1824
      Width           =   1080
   End
   Begin VB.Label lblLabels 
      Caption         =   "用户名:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   0
      Left            =   345
      TabIndex        =   2
      Tag             =   "&User Name:"
      Top             =   1320
      Width           =   1080
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long


Public OK As Boolean

Private Sub Form_Load()
    Dim sBuffer As String
    Dim lSize As Long
    Dim ms As String
    Dim MsgText As String
    Dim mrce As New ADODB.Recordset
    
    
    
   Dim cnn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim sTokens() As String
   
   'On Error GoTo ExecuteSQL_Error
   
   sTokens = Split(SQL)
   Set cnn = New ADODB.Connection
    

   MsgText = "select name from dbo.tableuser"
   Set mrce = ExecuteSQL(MsgText, ms)
    
   With mrce
      sBuffer = Space$(10)
      lSize = Len(sBuffer)
      Call GetUserName(sBuffer, lSize)
        If Not mrce.EOF Then
'          txtUserName.Text = Left$(sBuffer, lSize)
             Do While Not mrce.EOF
               userCombo1.AddItem mrce!Name
               mrce.MoveNext
             
               Loop
             
        End If
    End With
End Sub



Private Sub cmdCancel_Click()
    OK = False
    Me.Hide
End Sub


Private Sub cmdOK_Click()
    'ToDo: create test for correct password
    'check for correct password
   Dim ms As String
   
    MsgText = "select pwd from dbo.tableuser where name ='" + userCombo1.Text + "'"
    
     Set mrce = ExecuteSQL(MsgText, ms)
     With mrce
     If Not mrce.EOF Then
     m$ = mrce!pwd
     End If
     End With
    If txtPassword.Text = m Then
        OK = True
        Me.Hide
    Else
        MsgBox "Invalid Password, try again!", , "Login"
        txtPassword.SetFocus
        txtPassword.SelStart = 0
        txtPassword.SelLength = Len(txtPassword.Text)
    End If
End Sub