VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "登錄"
   ClientHeight    =   2910
   ClientLeft      =   30
   ClientTop       =   330
   ClientWidth     =   3900
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2910
   ScaleWidth      =   3900
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Tag             =   "Login"
   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        =   2
      Top             =   1812
      Width           =   2064
   End
   Begin VB.TextBox txtUserName 
      Height          =   288
      Left            =   1548
      TabIndex        =   1
      Top             =   1416
      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          =   975
      Left            =   240
      TabIndex        =   6
      Top             =   120
      Width           =   3615
   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          =   252
      Index           =   0
      Left            =   348
      TabIndex        =   5
      Tag             =   "&User Name:"
      Top             =   1440
      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


    sBuffer = Space$(255)
    lSize = Len(sBuffer)
    Call GetUserName(sBuffer, lSize)
    If lSize > 0 Then
        txtUserName.Text = Left$(sBuffer, lSize)
    Else
        txtUserName.Text = vbNullString
    End If
End Sub



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


Private Sub cmdOK_Click()
    'To Do - 創建測試密碼是否正確
    '檢查正確密碼
    Dim mrc As adodb.Recordset
    Dim txtSQL As String
    Dim MsgText As String
    
  On Error GoTo myErr
        If Trim(txtUserName & " ") <> "" Then
            txtSQL = "select * from users where id='" & Trim(txtUserName & " ") & "'"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
            
            If mrc.EOF = True Then
                MsgBox "沒有這個用戶，再重新輸入！", vbOKOnly + vbExclamation, "登錄"
                        txtUserName.SetFocus
                       
            Else    '登陸成功
                If Trim(txtPassword & " ") = Trim(mrc!Password) Then
                    sUserName = Trim(txtUserName)
                    If Permission(sUserName, 10, 19) = True Then
                        OK = True
                        Me.Hide
                    Else
                        End
                    End If
                Else
                    MsgBox "密碼錯誤，再試一次！", vbOKOnly + vbExclamation, "登錄"
                        txtPassword.SetFocus
                        txtPassword.SelStart = 0
                        txtPassword.SelLength = Len(txtPassword.Text)
                End If
            End If
        Else
            MsgBox "沒有這個用戶，再重新輸入！", vbOKOnly + vbExclamation, "登錄"
            txtUserName.SetFocus
        End If
        miCount = miCount + 1
        If miCount = 3 Then
            Me.Hide
        End If
        Exit Sub
        
myErr:
    ShowError
End Sub
'檢查用戶是否可以進入程序
Public Function Permission(Id As String, Begin As Integer, Over As Integer) As Boolean
    Dim recTemp As adodb.Recordset
    Dim sSQL As String
    Dim MsgText As String
  On Error GoTo myErr
    '檢查用戶的權限
        sSQL = "select distinct module from permission where id='" & sUserName & "'"
        sSQL = sSQL & " and module between " & Begin & " and " & Over
        Set recTemp = ExecuteSQL(sSQL, MsgText)
        '判斷是否有進入的權限
        If recTemp.EOF Then
            MsgBox "您沒有進入系統的權限!", vbOKOnly + vbExclamation, "登錄失敗"
            Permission = False
        Else
            Permission = True
        End If
    Exit Function
    
myErr:
    ShowError
End Function