clsdbstate.cls

VB数据库设计的代码。需要根据自己的数据库再作调整

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDbState"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'***********************************************************************
'* 函数名：GetConnState
'* 功  能：取得数据库连接状态
'* 参  数：
'* 版  本：2005.12.29 颜志军 初版
'***********************************************************************
Public Function GetConnState() As Boolean
    If g_conn Is Nothing Or Not IsObject(g_conn) Then
         GetConnState = False
         Exit Function
    End If
    If g_conn.State = adStateOpen Then
       GetConnState = True
    Else
       GetConnState = False
    End If
End Function

'***********************************************************************
'* 函数名：ConnDb
'* 功  能：连接数据库
'* 参  数：
'* 版  本：2005.12.29 颜志军 初版
'***********************************************************************
Private Function ConnDb() As Boolean
    If GetConnState() Then
        Exit Function
    End If
    
    On Error Resume Next
    
    '取得数据库参数设定信息
    Dim cfgFile As clsConfigFile        '配置文件类
    Dim server As String                '服务器
    Dim user As String                  '用户名
    Dim pwd As String                   '密码
    Dim dataName As String              '数据库名
    
    Set cfgFile = New clsConfigFile
    cfgFile.GetDatabasePara server, user, pwd, dataName
    
    server = Trim(server)
    user = Trim(user)
    pwd = Trim(pwd)
    dataName = Trim(dataName)
    
    '判断各参数是否为空
    If IsNull(server) Or IsEmpty(server) Or server = "" _
        Or IsNull(user) Or IsEmpty(user) Or user = "" _
        Or IsNull(pwd) Or IsEmpty(pwd) Or pwd = "" _
        Or IsNull(dataName) Or IsEmpty(dataName) Or dataName = "" Then
        
        ConnDb = False
        Exit Function
    End If

    '连接数据库
    ConnDb = False
    On Error GoTo FUNEND
    Set g_conn = New ADODB.Connection
    g_conn.ConnectionString = "Provider=SQLOLEDB;Data Source=" & server & _
        ";Initial Catalog=" & dataName & _
        ";User Id=" & user & _
        ";Password=" & pwd & ";"

    g_conn.Open

    If g_conn.State = adStateOpen Then
       ConnDb = True
    Else
       ConnDb = False
    End If
FUNEND:
End Function


Private Sub Class_Initialize()
    ConnDb
End Sub