|
Option Explicit |
|
|
|
Public Enum OraParm |
|
ORAPARM_INPUT = 1 |
|
ORAPARM_OUTPUT = 2 |
|
ORAPARM_BOTH = 3 |
|
End Enum |
|
|
|
Public Enum OraType |
|
ORATYPE_VARCHAR2 = 1 |
|
ORATYPE_NUMBER = 2 |
|
ORATYPE_DATE = 12 |
|
End Enum |
|
|
|
Public Enum OraDyn |
|
ORADYN_DEFAULT = &H0& |
|
ORADYN_READONLY = &H4& |
|
ORADYN_NOCACHE = &H8& |
|
End Enum |
|
|
|
Private cnn As ADODB.Connection |
|
Private cmd As ADODB.Command |
|
|
|
' Collection of ADODB.Parameter |
|
Public Parameters As Collection |
|
Public Enum RefreshParameterDirection |
|
ParamInput |
|
ParamOutput |
|
End Enum |
|
|
|
Private Sub Class_Initialize() |
|
Set cnn = New ADODB.Connection |
|
'If you want to open database in constructor |
|
'OpenDatabase "ExampleDb", "scott/tiger" |
|
End Sub |
|
|
|
Private Sub Class_Terminate() |
|
CloseDatabase |
|
End Sub |
|
|
|
' OraSession.OpenDatabase |
|
Public Sub OpenDatabase(ByVal database_name As String, ByVal connect_string As String) |
|
|
|
Dim userPassword As Variant |
|
userPassword = Split(connect_string, "/") |
|
With cnn |
|
' .Provider = "MSDAORA" |
|
.Provider = "OraOLEDB.Oracle" |
|
.Properties("Data Source") = database_name |
|
.Properties("User ID") = userPassword(0) |
|
.Properties("Password") = userPassword(1) |
|
.Open |
|
End With |
|
|
|
If cmd Is Nothing Then |
|
Set cmd = New ADODB.Command |
|
cmd.ActiveConnection = cnn |
|
cmd.CommandType = adCmdText |
|
End If |
|
|
|
End Sub |
|
|
|
' OraSession.Close |
|
Public Sub CloseDatabase() |
|
ClearParameters |
|
If Not cmd Is Nothing Then |
|
Set cmd = Nothing |
|
End If |
|
If Not cnn Is Nothing Then |
|
If cnn.State = adStateOpen Then cnn.Close |
|
End If |
|
End Sub |
|
|
|
' OraDatabase.ConnectionOK |
|
Public Property Get ConnectionOK() As Boolean |
|
ConnectionOK = (cnn.State = adStateOpen) |
|
End Property |
|
|
|
' OraDatabase.Paramters.Add |
|
Public Sub AddParameter(ByVal name As String, ByVal value As Variant, ByVal ioType As Long, Optional ByVal serverType As Long) |
|
|
|
Dim param As ADODB.Parameter |
|
Set param = cmd.CreateParameter(name, , ioType, , value) |
|
If serverType = 0 Then |
|
Select Case VarType(Value) |
|
Case vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbDecimal |
|
serverType = OraType.ORATYPE_NUMBER |
|
Case vbDate |
|
serverType = OraType.ORATYPE_DATE |
|
Case vbString, vbNull |
|
serverType = OraType.ORATYPE_VARCHAR2 |
|
End Select |
|
End If |
|
SetParamType param, serverType |
|
|
|
' Store into Collection |
|
If Parameters Is Nothing Then |
|
Set Parameters = New Collection |
|
End If |
|
Parameters.Add param, name |
|
|
|
End Sub |
|
|
|
' OraDatabase.Paramters(name).ServerType |
|
Public Sub SetParameterServerType(ByVal name As String, ByVal serverType As Long) |
|
SetParamType Parameters(name), serverType |
|
End Sub |
|
|
|
' Set the parameter type and size from Oracle ServerType |
|
Private Sub SetParamType(ByVal param As ADODB.Parameter, ByVal serverType As Long) |
|
Select Case serverType |
|
Case ORATYPE_NUMBER |
|
param.Type = adNumeric |
|
Case ORATYPE_DATE |
|
param.Type = adDBTimeStamp |
|
Case ORATYPE_VARCHAR2 |
|
param.Type = adVarChar |
|
param.SIZE = 255 |
|
End Select |
|
End Sub |
|
|
|
' OraDatabase.Paramters(name).Remove |
|
Public Sub RemoveParameter(ByVal name As String) |
|
Parameters.Remove name |
|
End Sub |
|
|
|
' Clear Parameters |
|
Public Sub ClearParameters() |
|
If Not Parameters Is Nothing Then |
|
Set Parameters = Nothing |
|
End If |
|
End Sub |
|
|
|
' Synchronize parameter values between Me.Parameters and cmd.Parametes |
|
Public Sub RefreshParameters(Optional ByVal direction As RefreshParameterDirection = ParamInput) |
|
Dim cmdParam As ADODB.Parameter |
|
For Each cmdParam In cmd.Parameters |
|
Select Case direction |
|
Case ParamInput |
|
cmdParam.value = Parameters(cmdParam.name).value |
|
Case ParamOutput |
|
Parameters(cmdParam.name).value = cmdParam.value |
|
End Select |
|
Next cmdParam |
|
End Sub |
|
|
|
' OraDatabase.CreateDynaset |
|
Public Function CreateDynaset(ByVal sql As String, Optional ByVal options As Long = &H0&, Optional ByVal cursorName As String) As ADODB.Recordset |
|
Dim cursorType As ADODB.CursorTypeEnum |
|
Dim lockType As ADODB.LockTypeEnum |
|
Dim rst As ADODB.Recordset |
|
Set rst = New ADODB.Recordset |
|
|
|
rst.CursorLocation = adUseClient |
|
'Convert CursorType |
|
If options And ORADYN_NOCACHE Then |
|
cursorType = adOpenForwardOnly |
|
Else |
|
cursorType = adOpenStatic |
|
End If |
|
'Convert LockType |
|
If options And ORADYN_READONLY Then |
|
lockType = adLockReadOnly |
|
Else |
|
lockType = adLockOptimistic |
|
End If |
|
|
|
cmd.CommandText = "" |
|
Call BindByPosition(sql, cursorName) |
|
cmd.CommandText = sql |
|
|
|
If cursorName <> "" Then |
|
cmd.Properties("PLSQLRSet") = True |
|
Else |
|
cmd.Properties("PLSQLRSet") = False |
|
End If |
|
rst.Open cmd, , cursorType, lockType |
|
|
|
Set CreateDynaset = rst |
|
|
|
End Function |
|
|
|
' OraDatabase.CreatePLSQLDynaset |
|
Public Function CreatePLSQLDynaset(ByVal sql As String, ByVal cursorName As String, Optional ByVal options As Long = &H0&) As ADODB.Recordset |
|
Set CreatePLSQLDynaset = CreateDynaset(sql, options, cursorName) |
|
End Function |
|
|
|
' OraDatabase.ExecuteSQL |
|
Public Function ExecuteSQL(ByVal sql As String) As Long |
|
Dim recordAffected As Long |
|
Dim parametersCount As Long |
|
|
|
cmd.CommandText = "" |
|
parametersCount = BindByPosition(sql) |
|
cmd.CommandText = sql |
|
|
|
cmd.Execute recordAffected |
|
ExecuteSQL = recordAffected |
|
|
|
'Update values of out parameters |
|
If parametersCount > 0 Then |
|
RefreshParameters ParamOutput |
|
End If |
|
End Function |
|
|
|
' Bind parameters by position |
|
Private Function BindByPosition(ByRef sql As String, Optional cursorName As String) As Long |
|
|
|
' Initialize cmd.Parameters |
|
Dim i As Long |
|
For i = cmd.Parameters.COUNT - 1 To 0 Step -1 |
|
cmd.Parameters.Delete i |
|
Next |
|
|
|
' Extract bind variables from sql |
|
Dim reg As Object |
|
Set reg = CreateObject("VBScript.RegExp") |
|
With reg |
|
.Pattern = ":(\w+)" |
|
.IgnoreCase = True |
|
.Global = True |
|
End With |
|
|
|
Dim match As Object |
|
Dim matches As Object |
|
Set matches = reg.Execute(sql) |
|
BindByPosition = matches.COUNT |
|
|
|
If matches.COUNT = 0 Then |
|
Exit Function |
|
End If |
|
|
|
Dim param As ADODB.Parameter |
|
For Each match In matches |
|
'Add parameters to cmd.Parameters except cursor variables |
|
If match.submatches(0) <> cursorName Then |
|
Set param = Parameters(match.submatches(0)) |
|
'Add a deep copy of the parameter |
|
cmd.Parameters.Append CopyParameter(param) |
|
End If |
|
Next match |
|
|
|
' When sql includes cursor valiables |
|
If cursorName <> "" Then |
|
sql = ReplaceRefCursor(sql, cursorName) |
|
End If |
|
|
|
' Convert parameter markers into "?" |
|
sql = reg.Replace(sql, "?") |
|
|
|
End Function |
|
|
|
' Create a deep copy of the parameter |
|
Private Function CopyParameter(ByVal param As ADODB.Parameter) As ADODB.Parameter |
|
Dim copy As ADODB.Parameter |
|
Set copy = New ADODB.Parameter |
|
With copy |
|
.name = param.name |
|
.value = param.value |
|
.direction = param.direction |
|
.Type = param.Type |
|
.SIZE = param.SIZE |
|
End With |
|
Set CopyParameter = copy |
|
End Function |
|
|
|
' Replace sql having cursor variables |
|
Private Function ReplaceRefCursor(ByVal sql As String, ByVal cursorName As String) As String |
|
Dim reg As Object |
|
Set reg = CreateObject("VBScript.RegExp") |
|
With reg |
|
.Pattern = ",? *:" & cursorName |
|
.IgnoreCase = True |
|
.Global = True |
|
End With |
|
|
|
' Remove cursor variables from sql |
|
sql = reg.Replace(sql, "") |
|
|
|
' Convert to ODBC syntax |
|
reg.Pattern = "begin (.*); *end;" |
|
sql = reg.Replace(sql, "{CALL $1}") |
|
|
|
ReplaceRefCursor = sql |
|
End Function |
|
|
|
' OraSession.BeginTrans |
|
Public Sub BeginTrans() |
|
cnn.BeginTrans |
|
End Sub |
|
|
|
' OraSession.CommitTrans |
|
Public Sub CommitTrans() |
|
cnn.CommitTrans |
|
End Sub |
|
|
|
' OraSession.Rollback |
|
Public Sub Rollback() |
|
cnn.RollbackTrans |
|
End Sub |
|
|
|
' OraSession.ResetTrans |
|
Public Sub ResetTrans() |
|
On Error Resume Next |
|
cnn.RollbackTrans |
|
End Sub |
|
|
|
' OraDatabase(OraSession).LastServerErr |
|
Public Property Get LastServerErr() As Long |
|
If cnn.Errors.COUNT > 0 Then |
|
LastServerErr = cnn.Errors(cnn.Errors.COUNT - 1).NativeError |
|
End If |
|
End Property |
|
|
|
' OraDatabase(OraSession).LastServerErrText |
|
Public Property Get LastServerErrText() As String |
|
If cnn.Errors.COUNT > 0 Then |
|
LastServerErrText = cnn.Errors(cnn.Errors.COUNT - 1).Description |
|
End If |
|
End Property |
|
|
|
' OraDatabase(OraSession).LastServerReset |
|
Public Sub LastServerErrReset() |
|
cnn.Errors.CLEAR |
|
End Sub |
yabtb.blogspot.com
