frmsqllogin.frm

vSQL server 的教务管理系统

VERSION 5.00
Begin VB.Form frmSQLLogin 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "SQL服务器登录："
   ClientHeight    =   2385
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3810
   Icon            =   "frmSQLLogin.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2385
   ScaleWidth      =   3810
   StartUpPosition =   2  '屏幕中心
   Begin VB.Timer Timer1 
      Interval        =   200
      Left            =   0
      Top             =   0
   End
   Begin VB.CommandButton CmdHelp 
      Caption         =   "帮助"
      Height          =   375
      HelpContextID   =   1
      Left            =   2760
      TabIndex        =   5
      Top             =   1920
      Width           =   915
   End
   Begin VB.TextBox txtServerName 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000C0&
      Height          =   320
      Left            =   1200
      MaxLength       =   20
      TabIndex        =   0
      Text            =   "(Local)"
      Top             =   80
      Width           =   2175
   End
   Begin VB.CommandButton cmdConnect 
      Caption         =   "连接"
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   1920
      Width           =   915
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   1560
      TabIndex        =   6
      Top             =   1920
      Width           =   915
   End
   Begin VB.CheckBox chkAuthentication 
      Caption         =   "使用Win NT验证登录"
      Height          =   375
      Left            =   1200
      TabIndex        =   1
      Top             =   420
      Value           =   1  'Checked
      Width           =   2055
   End
   Begin VB.Frame Frame1 
      Enabled         =   0   'False
      Height          =   1035
      Left            =   60
      TabIndex        =   7
      Top             =   840
      Width           =   3675
      Begin VB.TextBox txtUserName 
         Height          =   315
         Left            =   1080
         TabIndex        =   2
         Top             =   240
         Width           =   2355
      End
      Begin VB.TextBox txtPassword 
         Height          =   315
         IMEMode         =   3  'DISABLE
         Left            =   1080
         PasswordChar    =   "*"
         TabIndex        =   3
         Top             =   600
         Width           =   2355
      End
      Begin VB.Label Label2 
         Alignment       =   1  'Right Justify
         Caption         =   "密  码:"
         Enabled         =   0   'False
         Height          =   195
         Left            =   240
         TabIndex        =   9
         Top             =   600
         Width           =   795
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         Caption         =   "登录名:"
         Enabled         =   0   'False
         Height          =   195
         Left            =   240
         TabIndex        =   8
         Top             =   240
         Width           =   795
      End
   End
   Begin VB.Label Label3 
      Alignment       =   1  'Right Justify
      Caption         =   "SQL 服务器:"
      Height          =   255
      Left            =   -120
      TabIndex        =   10
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "frmSQLLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub chkAuthentication_Click()
If chkAuthentication.Value = vbChecked Then
  'This assumes a trusted connection
  Frame1.Enabled = False
  Label1.Enabled = False
  Label2.Enabled = False
Else
  'This assumes a login is required
  Frame1.Enabled = True
  Label1.Enabled = True
  Label2.Enabled = True
End If
End Sub

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

Private Sub cmdConnect_Click()
    ' Connect to server through SQL Server OLE DB Provider.
    
    Dim ServerName As String
    Dim DatabaseName As String
    Dim UserName As String
    Dim Password As String
    Set Con = New ADODB.Connection
    On Error GoTo ErrorConnect:

' Put text box values into connection variables.
    
     ServerName = Trim(txtServerName.Text)
     DatabaseName = "教务管理系统"
     UserName = Trim(txtUserName.Text)
     Password = txtPassword.Text
     
     ' Set connection properties.
    Con.ConnectionTimeout = 25
    Con.Provider = "sqloledb"
    Con.Properties("Data Source").Value = ServerName
    Con.Properties("Initial Catalog").Value = DatabaseName

    
    ' Decision code for login authorization type: WinNT or SQL Server.
   If chkAuthentication.Value = vbChecked Then
        'This assumes a trusted connection
        Con.Properties("Integrated Security").Value = "SSPI"
   Else
        'This assumes a login is required
        Con.Properties("User ID").Value = UserName
        Con.Properties("Password").Value = Password
   End If
    
    ' Change mousepointer while trying to open database.
    Screen.MousePointer = vbHourglass
    
    ' Open the database.
    Con.Open
   
    ' Change mousepointer back to the default after open.
    Screen.MousePointer = vbDefault
    
    '连接成功后
    Con.CursorLocation = adUseClient
    SqlConnect = True
    Me.Hide
     
    Exit Sub
   
ErrorConnect:
    Screen.MousePointer = vbDefault
    MsgBox "错误源：" & err.Source & Chr(13) & "错误代号：" & err.Number & Chr(13) & "错误提示：" & err.Description, 16, Gdate & Time()

End Sub

Private Sub CmdHelp_Click()
     Dim Scr_hDC As Long
     Scr_hDC = GetDesktopWindow()
     StartDoc = ShellExecute(Scr_hDC, "Open", App.Path & "\help.chm", "", "C:\", 1)
End Sub

Private Sub Timer1_Timer()
If MyHotKey(vbKeyF1) Then
     Dim Scr_hDC As Long
     Scr_hDC = GetDesktopWindow()
     StartDoc = ShellExecute(Scr_hDC, "Open", App.Path & "\help.chm", "", "C:\", 1)
End If
End Sub