ulogin.ctl

公文管理系统》是一套通过行文收发

VERSION 5.00
Begin VB.UserControl ULogin 
   Appearance      =   0  'Flat
   BackColor       =   &H00FFFFFF&
   ClientHeight    =   2775
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4125
   ScaleHeight     =   2775
   ScaleWidth      =   4125
   Begin VB.CommandButton Command1 
      Caption         =   "进入"
      Height          =   345
      Left            =   2760
      TabIndex        =   2
      Top             =   2190
      Width           =   1155
   End
   Begin VB.TextBox txtUserName 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      Height          =   345
      Left            =   1575
      TabIndex        =   0
      Top             =   870
      Width           =   2325
   End
   Begin VB.TextBox txtPassword 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   1575
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   1500
      Width           =   2325
   End
   Begin VB.Line Line1 
      BorderColor     =   &H000000FF&
      X1              =   540
      X2              =   3930
      Y1              =   720
      Y2              =   720
   End
   Begin VB.Label lblLabels 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "用户名(&U):"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   270
      Index           =   0
      Left            =   630
      TabIndex        =   5
      Top             =   990
      Width           =   1080
   End
   Begin VB.Label lblLabels 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "口  令(&P):"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   270
      Index           =   1
      Left            =   630
      TabIndex        =   4
      Top             =   1590
      Width           =   1080
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "系统登录："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   210
      Left            =   510
      TabIndex        =   3
      Top             =   450
      Width           =   1050
   End
End
Attribute VB_Name = "ULogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Public pIP As String
Public pConn As String
Dim strUserName As String
Public Sub setParam(s As String, u As String, p As String)
    pIP = s
    pConn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=OA;Data Source=lzy"
    login
End Sub
Private Sub login()
    Dim strUserName As String
    Dim strPassword As String
    Dim strTargetAsp As String
    Dim conn As ADODB.Connection
    Dim rsLogin As ADODB.Recordset
    Dim strSQL As String
    
  
    If Trim(txtUserName.Text) = "" Then
        MsgBox "“用户名”不能为空！"
        Exit Sub
    Else
        strUserName = Trim(txtUserName.Text)
    End If
    If Trim(txtPassword.Text) = "" Then
        MsgBox "“口令”不能为空！"
        Exit Sub
    Else
        strPassword = Trim(txtPassword.Text)
    End If
    
    pConn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=OA;Data Source=lzy"
    '检查口令、用户身份
    Set conn = New ADODB.Connection
    conn.ConnectionString = pConn
    conn.Open
    strUserName = Replace(strUserName, "'", "''")
    strSQL = "select * from 职员 where username='" & strUserName & "' and 口令='" & strPassword & "'"
    Set rsLogin = conn.Execute(strSQL)
    If rsLogin.EOF Or rsLogin.BOF Then
        MsgBox "用户名或口令错误，请检查！"
        txtPassword.SelStart = 0
        txtPassword.SelLength = Len(txtPassword.Text)
        txtPassword.SetFocus
    Else
        Select Case rsLogin("权限")
            Case "院领导"
                strTargetAsp = "LeadersMain.asp"
            Case "主任"
                strTargetAsp = "ZHURENMAIN.asp"
            Case "秘书"
                strTargetAsp = "MiShuMain.asp"
            Case "图书管理员"
                strTargetAsp = "TuShuManagerMain.asp"
            Case Else
                strTargetAsp = "OthersMain.asp"
        End Select
        
        SaveSetting "JGYOA", "Login", "UserName", strUserName
        SaveSetting "JGYOA", "Login", "Connect", pConn
        
        Hyperlink.NavigateTo "HTTP://" & "lzy" & "/oa/" & strTargetAsp, , "_parent"
        
    End If
    
    '释放变量
    Set rsLogin = Nothing
    Set conn = Nothing
End Sub

Private Sub Command1_Click()
    Call login
End Sub