rsgllogin.frm

这是一个人事管理系统演示版,用 vb和sql 开发的

VERSION 5.00
Begin VB.Form rsglLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "登录"
   ClientHeight    =   1545
   ClientLeft      =   2835
   ClientTop       =   3480
   ClientWidth     =   3750
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   912.837
   ScaleMode       =   0  'User
   ScaleWidth      =   3521.047
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox txtUserName 
      Height          =   345
      Left            =   1290
      TabIndex        =   1
      Top             =   135
      Width           =   2325
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定(&O)"
      Height          =   390
      Left            =   480
      TabIndex        =   4
      Top             =   1020
      Width           =   1140
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   390
      Left            =   2100
      TabIndex        =   5
      Top             =   1020
      Width           =   1140
   End
   Begin VB.TextBox txtPassword 
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   1290
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   525
      Width           =   2325
   End
   Begin VB.Label lblLabels 
      Caption         =   "用户名称(&U):"
      Height          =   270
      Index           =   0
      Left            =   105
      TabIndex        =   0
      Top             =   150
      Width           =   1080
   End
   Begin VB.Label lblLabels 
      Caption         =   "密码(&P):"
      Height          =   270
      Index           =   1
      Left            =   105
      TabIndex        =   2
      Top             =   540
      Width           =   1080
   End
End
Attribute VB_Name = "rsglLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetProfileStr Lib "kernel32" _
    Alias "GetPrivateProfileStringA" (ByVal SecName As String, _
                                  ByVal EntrName As String, _
                                  ByVal DefString As String, _
                                  ByVal buff As String, _
                                  ByVal BuffSize As Long, _
                                  ByVal FileName As String) As Long

Private Declare Function SetProfileStr Lib "kernel32" _
    Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
                                    ByVal lpKeyName As Any, _
                                    ByVal lpString As Any, _
ByVal lpFileName As String) As Long


Public LoginSucceeded As Boolean
Private Sub CmdCancel_Click()
    '设置全局变量为 false
    '不提示失败的登录
    
    '若已经在登录状态该窗口作更换操作员用，不能取消。
    If LoginSucceeded = True Then
       MsgBox "不能取消，请重试!", vbInformation, "提示"
       Exit Sub
    End If
    
    LoginSucceeded = False
    End '登录失败，结束程序
End Sub
Private Sub CmdOk_Click()
On Error GoTo ErrMsg

    '检查正确的密码
    Dim ssql As String            'sql查询字串
    Dim rs As New ADODB.Recordset '返回的操作员数据集合
        
    
    '读取输入的用户名和密码，注意引号和空格的处理
    RSGLOperator.username = CutYH(Trim(txtUserName))
    RSGLOperator.password = CutYH(Trim(txtPassword))

    '验证用户名和密码的正确性，保证是公司职员，且为合法登记在册的操作员(每个员工都可能是操作员)。
    ssql = "select * from PERSON  where NAME='" & RSGLOperator.username & "' and passwd='" & RSGLOperator.password & "'"
    'sSql = "select getdate()"

    
    
    rs.Open ssql, RSGLConnStr, adOpenDynamic
    If rs.BOF = False Or rs.EOF = False Then '验证正确
     '打开主窗口
      LoginSucceeded = True
    
      Me.Hide
      rsglMDIForm.Show  '打开主窗体
      
'      '设置与权限相关的动作
       '设置主窗体的toolbar内容
       rsglMDIForm.rsglStatusBar.Panels(1).Text = "系统状态：正常"
       rsglMDIForm.rsglStatusBar.Panels(2).Text = "操作员:" & RSGLOperator.username
       rsglMDIForm.rsglStatusBar.Panels(3).Text = "时间:" & Date & " " & Format(Time, "hh:mm")  '系统时间
       
'      rsglMDIForm.StatusBar1.Panels(2).Text = "操作员:" & RSGLOperator.UserName
'
'      Call setMenuEnable(appid)
'      Call setToolbarEnable
'
    Else
        MsgBox "无效的密码，请重试!", , "登录"
        txtPassword.SetFocus
        SendKeys "{Home}+{End}"
    End If
Exit Sub
ErrMsg:
   DoWithErr ("登录")
   Resume Next
End Sub

Private Sub Form_Load()
 On Error GoTo ErrMsg
  
  'getConnString '获得连接字串
  Dim dbname As String * 255
  Dim dbname2 As String
  Dim username As String * 255
  Dim username2 As String
  Dim pwd As String * 255
  Dim pwd2 As String
  Dim dsn As String * 255
  Dim dsn2 As String
  Dim robname As String * 255
  Dim robname2 As String
  Dim n As Integer
  
  Dim i As Integer
  
  
  n = GetProfileStr("odbc", "用户名", "", username, Len(username), INIfileName)
  username2 = subname(username, n)
  n = GetProfileStr("odbc", "用户密码", "", pwd, 255, INIfileName)
  pwd2 = subname(pwd, n)
  n = GetProfileStr("odbc", "数据库名", "", dbname, 255, INIfileName)
  dbname2 = subname(dbname, n)
  n = GetProfileStr("odbc", "dsn", "", dsn, 255, INIfileName)
  dsn2 = subname(dsn, n)
  n = GetProfileStr("odbc", "机器名", "", robname, 255, INIfileName)
  robname2 = subname(robname, n)
  RSGLConnStr = "Provider=MSDASQL.1;Persist Security Info=False;User ID=" & username2 & ";pwd=" & pwd2 & ";Extended Properties=DSN=" & dsn2 & ";APP=Visual Basic;WSID=" & robname2 & ";Trusted_Connection=Yes;initial catalog=" & dbname2
  '设置连接字串
 ' RSGLConnStr = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;pwd=sa;Extended Properties=DSN=rsgl;APP=Visual Basic;WSID=JOHN;Trusted_Connection=Yes;initial catalog=rsgl"
  Dim cn_temp As New ADODB.Connection
  cn_temp.Open RSGLConnStr  '测试数据库连接
  cn_temp.Close
  
  '校准时间
  setSysTime
Exit Sub
ErrMsg:
   DoWithErr ("登录")
   Resume Next
End Sub
'让密码输入文本框中输入回车换到下一个输入位置：确定
Private Sub txtPassword_KeyPress(KeyAscii As Integer)
  If KeyAscii = vbKeyReturn Then '回车键的识别 vbKeyReturn
     CmdOK.SetFocus
     SendKeys "{Enter}"
  End If
End Sub
'让用户文本框中输入回车换到下一个输入位置：密码输入
Private Sub txtUserName_KeyPress(KeyAscii As Integer)
  If KeyAscii = vbKeyReturn Then
     txtPassword.SetFocus
     SendKeys "{Home}+{End}"
  End If
End Sub