logindb.frm

这个是我以前做的一个客户管理系统.包内已经含有源码和所用到的控件.代码是用VB写的,数据库采用MSSQL的.

VERSION 5.00
Begin VB.Form frmLoginDB 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "数据库登录"
   ClientHeight    =   2565
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3225
   ControlBox      =   0   'False
   Icon            =   "LoginDB.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2565
   ScaleWidth      =   3225
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox txtDBPass 
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   1170
      PasswordChar    =   "*"
      TabIndex        =   5
      Top             =   1350
      Width           =   1845
   End
   Begin VB.TextBox txtDBUser 
      Height          =   300
      Left            =   1170
      TabIndex        =   4
      Text            =   "sa"
      Top             =   930
      Width           =   1845
   End
   Begin VB.TextBox txtDBName 
      Height          =   300
      Left            =   1170
      TabIndex        =   3
      Top             =   510
      Width           =   1845
   End
   Begin VB.TextBox txtSvrName 
      BackColor       =   &H80000018&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   1170
      TabIndex        =   2
      Text            =   "(local)"
      Top             =   90
      Width           =   1845
   End
   Begin VB.CommandButton cmdConnect 
      Caption         =   "连接服务器"
      Height          =   315
      Left            =   300
      TabIndex        =   0
      Top             =   2070
      Width           =   1245
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "关闭"
      Height          =   315
      Left            =   1710
      TabIndex        =   1
      Top             =   2070
      Width           =   1245
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "用户密码:"
      Height          =   180
      Left            =   90
      TabIndex        =   9
      Top             =   1410
      Width           =   810
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "数据库用户:"
      Height          =   180
      Left            =   90
      TabIndex        =   8
      Top             =   990
      Width           =   990
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "帐套名称:"
      Height          =   180
      Left            =   90
      TabIndex        =   7
      Top             =   570
      Width           =   810
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "服务器名称:"
      Height          =   180
      Left            =   90
      TabIndex        =   6
      Top             =   150
      Width           =   990
   End
End
Attribute VB_Name = "frmLoginDB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public mbSucess             As Boolean          '返回是否连接成功
Private Function mbConnect() As Boolean
'**********************************************
'
'连接数据库
'
'*********************************************
    Dim sSql            As String
    Dim CnString        As String
    Dim svrName         As String
    Dim UsrName         As String
    Dim DBName          As String
    Dim Pass            As String
    
    On Error GoTo ErrConnect
    
    svrName = txtSvrName
    UsrName = txtDBUser
    DBName = txtDBName
    Pass = txtDBPass
    
    Set CN = New ADODB.Connection
        
    '建立数据库连接
    CN.Provider = "SQLOLEDB.1"
    CnString = "User ID= " & UsrName & ";password=" & Pass & ";Initial Catalog=;Data Source=" & svrName
    Screen.MousePointer = vbHourglass
    CN.Open CnString
    Screen.MousePointer = vbDefault
    If CN Is Nothing Then
        MsgBox "请检查输入的数据库用户和密码是否正确!!!", vbInformation, "数据库连接错误"
        Exit Function
    End If
    CN.CursorLocation = adUseClient
    '判断是否存在数据库 DBName
    If bExistDataBase(DBName) = False Then
        MsgBox "数据库【" & DBName & "】不存在,请重新输入数据库名称!!!", vbInformation, ""
        txtDBName.SetFocus
        mbConnect = False
        Exit Function
    End If
    
    '使用数据库
    
    CN.Execute "Use " & DBName
    
    mbConnect = mbSaveServerInfo(svrName, UsrName, Pass, DBName)
    
    mbConnect = True
    Exit Function
ErrConnect:
    Screen.MousePointer = vbDefault
    mbConnect = False
    MsgBox "请检查输入的数据库用户和密码是否正确!!!", vbInformation, "数据库连接错误"
    Err.Clear
    
End Function

Private Sub cmdClose_Click()
    
    mbSucess = False
    Me.Hide
    
End Sub

Private Sub cmdConnect_Click()
    
    If mbConnect() Then
        MsgBox "数据库连接成功！！！", vbInformation, ""
        mbSucess = True
        Me.Hide
    End If
    
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        SendKeys "{TAB}"
    ElseIf KeyAscii = vbKeyEscape Then
        KeyAscii = 0
        Unload Me
    End If
    
End Sub

Private Sub Form_Load()
    
    Center Me
    KeyPreview = True
    txtSvrName = gGetServerInfo(1)
    txtDBUser = gGetServerInfo(2)
    txtDBPass = gGetServerInfo(3)
    txtDBName = gGetServerInfo(4)
    
End Sub

Private Sub txtDBName_GotFocus()
    InitTextBox txtDBName
End Sub

Private Sub txtDBPass_GotFocus()
    InitTextBox txtDBPass
End Sub

Private Sub txtDBUser_GotFocus()
    InitTextBox txtDBUser
End Sub

Private Sub txtSvrName_GotFocus()
    InitTextBox txtSvrName
End Sub