clsdatabase.cls

FLA-502控制、标定、分析用

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDatabase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'*************************
'数据库操作
'*************************

Option Explicit
Dim dbTemp As New ADODB.Connection

Public Sub 更新数据库(strSql As String)
    On Error GoTo ErrHandle:
    Call 检查连接
    dbTemp.Execute (strSql)
    Exit Sub
    
ErrHandle:
    Call 重新连接
    dbTemp.Execute (strSql)
End Sub

Public Sub 更新批量数据(strSql() As String)
    On Error GoTo ErrHandle:
    Call 检查连接
    Dim i As Integer
    For i = 1 To UBound(strSql)
        dbTemp.Execute (strSql(i))
    Next
    Exit Sub
    
ErrHandle:
    Call 重新连接
    For i = 1 To UBound(strSql)
        dbTemp.Execute (strSql(i))
    Next
End Sub

Public Function 取数据(strSql As String) As ADODB.Recordset
    On Error GoTo ErrHandle:
    Call 检查连接
    Set 取数据 = dbTemp.Execute(strSql)
    Exit Function
ErrHandle:
    '很特殊的处理
    If Err.Number = -2147217900 Then
        MsgBox (Err.Description + " 存在错误输入符号:单引号 ' ")
        '不是妥当,骗过程序
        Set 取数据 = dbTemp.Execute("select * from EIS where ID=10000")
        Exit Function
    End If
    Call 重新连接
    Set 取数据 = dbTemp.Execute(strSql)
End Function

Public Function 取字段数据(strSql As String) As Variant
    On Error GoTo ErrHandle:
    Call 检查连接
    Dim rsTemp As New ADODB.Recordset
    Set rsTemp = dbTemp.Execute(strSql)
    If rsTemp.EOF = False Then
        rsTemp.MoveFirst
        取字段数据 = rsTemp.Fields(0).Value
    Else
        取字段数据 = Null
    End If
    rsTemp.Close
    Set rsTemp = Nothing
    Exit Function
    
ErrHandle:
     Call 重新连接
     Set rsTemp = dbTemp.Execute(strSql)
     If rsTemp.EOF = False Then
        rsTemp.MoveFirst
        取字段数据 = rsTemp.Fields(0).Value
     Else
        取字段数据 = Null
     End If
     rsTemp.Close
     Set rsTemp = Nothing
End Function

Public Sub Class_Initialize()
    If (dbTemp Is Nothing) = False Then
        If dbTemp.State <> adStateClosed Then
            dbTemp.Close
        End If
    End If
    Call GetDataConnectionString
    Call dbTemp.Open(g_szSQLConnStr)
    If dbTemp.State = adStateClosed Then
        MsgBox ("数据库连接出错!")
        Call 退出系统
    End If
End Sub

Public Sub Class_Terminate()
    On Error GoTo ErrHandle:
    If Not (dbTemp Is Nothing) Then
        If dbTemp.State = adStateOpen Then
            dbTemp.Close
        End If
    End If
    Set dbTemp = Nothing
    Exit Sub
    
ErrHandle:
    Set dbTemp = Nothing
End Sub

Private Sub 检查连接()
    If (dbTemp Is Nothing) = True Then
        Class_Initialize
        Exit Sub
    End If
    If dbTemp.State = adStateClosed Then
        Class_Initialize
    End If
End Sub

Private Sub 重新连接()
    If (dbTemp Is Nothing) = False Then
        If dbTemp.State <> adStateClosed Then
            dbTemp.Close
        End If
    End If
    Set dbTemp = Nothing
    Call dbTemp.Open(g_szSQLConnStr)
    If dbTemp.State = adStateClosed Then
        MsgBox ("数据库连接出错!")
        Call 退出系统
    End If
End Sub