frm_login.frm

图书馆信息管理系统

         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00404040&
         Height          =   195
         Left            =   240
         TabIndex        =   19
         Top             =   1740
         Width           =   540
      End
      Begin VB.Label Lbl_TipSQL 
         BackStyle       =   0  'Transparent
         Caption         =   "SQL Server服务器设置"
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF8080&
         Height          =   195
         Left            =   600
         TabIndex        =   16
         Top             =   240
         Width           =   2535
      End
      Begin VB.Label Lbl_SQLPassword 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "密    码"
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00404040&
         Height          =   195
         Left            =   240
         TabIndex        =   15
         Top             =   1380
         Width           =   540
      End
      Begin VB.Label Lbl_SQLUID 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "用户名"
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00404040&
         Height          =   195
         Left            =   240
         TabIndex        =   14
         Top             =   1020
         Width           =   540
      End
      Begin VB.Label Lbl_SQLServer 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "服务器"
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00404040&
         Height          =   195
         Left            =   240
         TabIndex        =   13
         Top             =   653
         Width           =   540
      End
   End
   Begin VB.Label Lbl_TMInfo 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "图书馆信息管理系统"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00404040&
      Height          =   255
      Left            =   1560
      TabIndex        =   27
      Top             =   1200
      Width           =   2055
   End
   Begin VB.Label Lbl_TM 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00E0E0E0&
      BackStyle       =   0  'Transparent
      Caption         =   "Lab Master"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   18
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1560
      TabIndex        =   26
      Top             =   720
      Width           =   2055
   End
   Begin VB.Label Lbl_Version 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "Version"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00808080&
      Height          =   255
      Left            =   840
      TabIndex        =   24
      Top             =   1440
      Width           =   2775
   End
   Begin VB.Line Line_Split 
      BorderColor     =   &H00C0C0C0&
      X1              =   4320
      X2              =   4320
      Y1              =   240
      Y2              =   3120
   End
   Begin VB.Line Line_SplitShadow 
      BorderColor     =   &H00FFFFFF&
      X1              =   4335
      X2              =   4335
      Y1              =   240
      Y2              =   3120
   End
   Begin VB.Label Lbl_TMShadow 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00E0E0E0&
      BackStyle       =   0  'Transparent
      Caption         =   "Lab Master"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   18
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   375
      Left            =   1590
      TabIndex        =   28
      Top             =   690
      Width           =   2055
   End
End
Attribute VB_Name = "Frm_Login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private NowFrame As String
Option Explicit

Private Sub Cmb_UID_Change()
    Dim i As Integer
    For i = 0 To Cmb_UID.ListCount - 1
        If LCase(Cmb_UID.Text) = LCase(Cmb_UID.List(i)) Then
            Cmb_UID.ListIndex = i
            Cmb_UID.SelAll
        End If
    Next i
End Sub

Private Sub Cmb_UID_GotFocus()
    Cmb_UID.SelAll
End Sub

Private Sub Cmd_Exit_Click()
    End
End Sub

Private Sub Cmd_Login_Click()
    Dim strPassword As String    '用户密码
    
    strUID = Trim(Cmb_UID.Text)
    strPassword = Txt_Password.Text
    strSQLServer = Trim(Txt_SQLServer.Text)
    strSQLUID = Trim(Txt_SQLUID.Text)
    strSQLPassword = Trim(Txt_SQLPassword.Text)
    strSQLDB = Trim(Txt_SQLDB.Text)
    
On Error GoTo ERRORZONE:
    '数据完整性验证
    Dim Err_Msg As String
    Err_Msg = vbNullString
    If strUID = vbNullString Then
        Err_Msg = "用户名不能为空！"
    ElseIf strPassword = vbNullString Then
        Err_Msg = "密码不能为空！"
    ElseIf strSQLServer = vbNullString _
        Or strSQLUID = vbNullString _
        Or strSQLPassword = vbNullString _
        Or strSQLDB = vbNullString Then
        Err_Msg = "请完善服务器配置信息！"
    End If
    If Err_Msg <> vbNullString Then
        MsgFrm Err_Msg, "!", "提示"
        Txt_Password.SetFocus
        Exit Sub
    End If

    '建立主连接
    SQLConnect cnMain, strSQLServer, strSQLUID, strSQLPassword, strSQLDB
    
    '数据正确性验证
    If Login(strUID, strPassword) = True Then
        '登录信息正确
        Call SaveToUIDList(strUID)    '将正确的用户信息保存到配置文件
        Call SaveServer(strSQLServer, strSQLUID, strSQLPassword, strSQLDB)
        If cnMain.State = adStateOpen Then
            '主连接状态正确
            Unload Me
            Frm_Main.Show    '打开主窗口
            Exit Sub
        Else
            '如果主连接不是打开状态
            MsgFrm "数据库状态错误！", "x", "错误"
        End If
    Else
        '登录信息错误
        MsgFrm "用户名或密码错误！", "x", "登录失败"
    End If
    Txt_Password.SetFocus
    
    If cnMain.State = adStateOpen Then cnMain.Close
    Exit Sub
ERRORZONE:
    MsgFrm Err.Description, "x", "错误"
    If cnMain.State = adStateOpen Then cnMain.Close
End Sub

Private Sub Cmd_SQLBack_Click()
    Timer.Enabled = True
End Sub

Private Sub Form_Load()
    Me.caption = Me.caption & " " & AppVersion
    Lbl_Version.caption = Lbl_Version.caption & " " & AppVersion
    
    Frmae_Login.Top = 240
    Frmae_SQLServer.Top = 240 + 3750
    NowFrame = Frmae_Login.Name
    Timer.Enabled = False
    Timer.Interval = 1
    
    Call LoadUIDList
    Call LoadServer
    
    If Cmb_UID.ListCount > 0 Then Cmb_UID.ListIndex = Cmb_UID.ListCount - 1
    If cnMain.State <> 0 Then cnMain.Close
End Sub

Private Sub Frmae_Login_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Lbl_GoSQLSet.FontItalic = False
    Lbl_GoSQLSet.FontUnderline = False
    Lbl_ForgetPWD.FontItalic = False
    Lbl_ForgetPWD.FontUnderline = False
End Sub

Private Sub Lbl_ForgetPWD_Click()
On Error GoTo ERRORZONE
    strSQLServer = Trim(Frm_Login.Txt_SQLServer.Text)
    strSQLUID = Trim(Frm_Login.Txt_SQLUID.Text)
    strSQLPassword = Trim(Frm_Login.Txt_SQLPassword.Text)
    strSQLDB = Trim(Frm_Login.Txt_SQLDB.Text)
    
    '打开窗体前打开主连接
    SQLConnect cnMain, strSQLServer, strSQLUID, strSQLPassword, strSQLDB
    Frm_FindPassword.Show 1
    Exit Sub
ERRORZONE:
    MsgFrm Err.Description, "x", "错误"
    If cnMain.State = adStateOpen Then cnMain.Close
End Sub

Private Sub Lbl_ForgetPWD_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Lbl_ForgetPWD.FontItalic = True
    Lbl_ForgetPWD.FontUnderline = True
End Sub

Private Sub Lbl_GoSQLSet_Click()
    Timer.Enabled = True
End Sub

Private Sub Lbl_GoSQLSet_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Lbl_GoSQLSet.FontItalic = True
    Lbl_GoSQLSet.FontUnderline = True
End Sub

Private Sub Timer_Timer()
    If NowFrame = Frmae_Login.Name Then
        Frmae_Login.Top = Frmae_Login.Top - 75
        Frmae_SQLServer.Top = Frmae_SQLServer.Top - 75
        
        If Frmae_SQLServer.Top = 240 Then
            NowFrame = Frmae_SQLServer.Name
            Timer.Enabled = False
        End If
    ElseIf NowFrame = Frmae_SQLServer.Name Then
        Frmae_Login.Top = Frmae_Login.Top + 75
        Frmae_SQLServer.Top = Frmae_SQLServer.Top + 75
        
        If Frmae_Login.Top = 240 Then
            NowFrame = Frmae_Login.Name
            Timer.Enabled = False
        End If
    End If
End Sub

'载入用户列表
Private Sub LoadUIDList()
On Error GoTo ERRORZONE
    Dim strTmp As String
    Dim i, j As Integer
    Open AppPath & "Saves\UIDList.ini" For Input As #1
        Do Until EOF(1)
            Line Input #1, strTmp
            strTmp = Trim(strTmp)
            If strTmp <> "" Then
                Cmb_UID.AddItem strTmp
                j = j + 1
                If j >= 10 Then Close #1: Exit Sub
            End If
        Loop
    Close #1
ERRORZONE:
End Sub

'保存用户列表
Private Sub SaveToUIDList(strUID As String)
On Error GoTo ERRORZONE
    Dim strTmp As String
    Open AppPath & "Saves\UIDList.ini" For Input As #1
        Do Until EOF(1)
            Line Input #1, strTmp
            If StrComp(Trim(strUID), Trim(strTmp), 1) = 0 Then Close #1: Exit Sub
        Loop
    Close #1
    Open AppPath & "Saves\UIDList.ini" For Append As #1
        Print #1, strUID
    Close #1
ERRORZONE:
End Sub

'载入SQL服务器配置信息
Private Sub LoadServer()
On Error GoTo ERRORZONE
    Dim strTmp As String, strT() As String
    Dim i As Integer
    Open AppPath & "Saves\Server.ini" For Input As #1
        If EOF(1) = False Then Line Input #1, strTmp
    Close #1
    If strTmp <> "" Then
        strT = Split(strTmp, "|")
        For i = 0 To 3
            strT(i) = Trim(strT(i))
        Next i
        Txt_SQLServer.Text = strT(0)
        Txt_SQLUID.Text = strT(1)
        Txt_SQLPassword.Text = strT(2)
        Txt_SQLDB.Text = strT(3)
    End If
Exit Sub
ERRORZONE:
    Txt_SQLServer.Text = vbNullString
    Txt_SQLUID.Text = vbNullString
    Txt_SQLPassword.Text = vbNullString
    Txt_SQLDB.Text = vbNullString
End Sub

'保存SQL服务器配置信息
Private Sub SaveServer(ByVal strServer As String, ByVal strUID As String, ByVal strPassword As String, ByVal strDataBase As String)
On Error GoTo ERRORZONE
    Open AppPath & "Saves\Server.ini" For Output As #1
        Print #1, strServer & "|" & strUID & "|" & strPassword & "|" & strDataBase
    Close #1
Exit Sub
ERRORZONE:
End Sub

Private Sub Txt_Password_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call Cmd_Login_Click
End Sub