Here some prototyping code of a class that is able to connect to Oracle through OleDB and to check if the connection is up before doing some application logic. Class name is TUploadHelper.
Private m_conn As Object
Private Function GetConn_() As Object
If m_conn Is Nothing Then
Set m_conn = CreateObject("ADODB.Connection")
End If
Set GetConn_ = m_conn
End Function
Private Function Connected_() As Boolean
Dim recordSet As Object
Dim value As Long
Dim errCode As Variant
Dim errMsg As Variant
If Not PopErrors() Then On Error GoTo L_ERR_HANDLER
value = 0
Connected_ = False
Set recordSet = CreateObject("ADODB.Recordset")
Set recordSet.ActiveConnection = GetConn_()
recordSet.Open "select 1 as value_ from dual"
While Not recordSet.EOF
value = recordSet.Fields(0)
If 1 = value Then
Connected_ = True
GoTo L_CLEANUP
End If
Wend
' не вернулось ни одной записи
L_ERR_HANDLER:
errCode = Err.Number
errMsg = Err.Description
L_CLEANUP:
On Error GoTo 0
If 1 = recordSet.State Then
recordSet.Close
End If
Set recordSet = Nothing
End Function
Private Sub Class_Deinitialize()
If Not m_conn Is Nothing Then
If 1 = m_conn.State Then
m_conn.Close
End If
Set m_conn = Nothing
End If
End Sub
Private Function Authorized_() As Boolean
Authorized_ = False
End Function
Private Sub Connect_()
' Dim state_ As Variant
m_conn.Open "Provider=OraOLEDB.Oracle;Data Source=your_server.world;User ID=your_user;Password=your_pass;PLSQLRSet=1;"
' state_ = m_conn.State
End Sub
Public Sub Ut()
If Not Connected_ Then
Connect_
If Not Connected_ Then
End If
End If
End Sub
And here is module code that implements singleton pattern for TUploadHelper object.
'Singleton pattern
Private g_uploadHelper As TUploadHelper
Public Property Get GetUploadHelper() As TUploadHelper
If g_uploadHelper Is Nothing Then
Set g_uploadHelper = New TUploadHelper
End If
Set GetUploadHelper = g_uploadHelper
End Property
No comments:
Post a Comment