oo4oからADOへの変換 (7) Adapterクラスの作成（ADOでパラメータの名前によるバインドを可能にする）

1. 基礎編
2. パラメータとストアド・プロシージャ
3. Edit メソッドとトランザクション
4. AddNew メソッドとデフォルト列値
5. Find 系メソッド
6. カーソル変数（REF CURSOR）
7. Adapterクラスの作成（ADOでパラメータの名前によるバインドを可能にする）
   

移行方針について

oo4o から ADO へ移行する場合、大きく二つの方針が考えられると思います。

1. 既存コードに手に入れず、oo4o のインタフェースを実装した ADO（ADO.NET）のラッパークラスを作成する。
2. 全面的に ADO（ADO.NET）に書き換える。

まず、手っ取り早く (1) を検討したくなります。既存コードをそのまま利用できるのですから。しかし、今後もそのコードを継続して使用する場合、廃止された仕様に縛られ続けることにもなります。また、ADO とoo4o の仕様の差は大きく、 oo4o のインタフェースを完全に実装したラッパークラスの作成は困難です。
かといって、(2) の場合は書き換えに要する時間と費用の問題があります。oo4o と ADO の仕様の差は大きく書き換えも単純ではありません。（コンバータの作成を考えましたが、文法が大きく異なるため中途半端なものにならざるを得ません。）

では、どうするのか

移行に関係なく、データプロバイダの API を素のまま使わずデータベースアクセス用の共通クラスや関数を作成して手続きを単純化することは、よくある話ですし、望ましいことです。
その共通クラスの作成の際、oo4o の仕様を織り込むことで移行コストを抑えつつ、メンテナンス性も維持することを考えてみたいと思います。

ADO ラッパー（Adapter）クラスの作成

以下のような方針で ADO のラッパークラスを作成してみます。

• 単一クラスとする。（ Excel や Access のファイルに簡単に織り込めるのが望ましい。）
• oo4o の OraSession、OraDatabase のインタフェースを極力実装する。
• OraDynaset は対象外（ADO.Recordset に書き換える。）
• Oracle のデータ型を使えるようにする。
• 「名前によるバインド」を ADO でも可能にする。

クラス名は OraAdapter とします。

OraAdapter

	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

view raw OraAdapter.cls hosted with ❤ by GitHub

使用例

OraAdapter クラスを使って Oracle® Objects for OLE開発者ガイドの OraParametersコレクション Addメソッド の例を書き換えてみます。

Sub Form_Load()
 
'Declare variables
'Dim OraSession As OraSession
'Dim OraDatabase As OraDatabase
  Dim OraDatabase As OraAdapter
 
'Create the OraSession Object.
'Set OraSession = CreateObject("OracleInProcServer.XOraSession")
  Set OraDatabase = New OraAdapter
 
'Create the OraDatabase Object.
'Set OraDatabase = OraSession.OpenDatabase("ExampleDb", "scott/tiger", 0&)
  OraDatabase.OpenDatabase "ExamleDb", "scott/tiger"
 
'Add EMPNO as an Input/Output parameter and set its initial value.
'OraDatabase.Parameters.Add "EMPNO", 7369, ORAPARM_INPUT
  OraDatabase.AddParameter "EMPNO", 7369, ORAPARM_INPUT
'OraDatabase.Parameters("EMPNO").serverType = ORATYPE_NUMBER
  OraDatabase.SetParameterServerType "EMPNO", ORATYPE_NUMBER
'または、OraDatabase.Parameters("EMPNO").Type = adNumeric
 
'Add ENAME as an Output parameter and set its initial value.
'OraDatabase.Parameters.Add "ENAME", 0, ORAPARM_OUTPUT
  OraDatabase.AddParameter "ENAME", 0, ORAPARM_OUTPUT
'OraDatabase.Parameters("ENAME").serverType = ORATYPE_VARCHAR2
  OraDatabase.SetParameterServerType "ENAME", ORATYPE_VARCHAR2
'または、OraDatabase.Parameters("ENAME").Type = adVarChar
'OraDatabase.Parameters("ENAME").Size = 255
 
'Add SAL as an Output parameter and set its initial value.
'OraDatabase.Parameters.Add "SAL", 0, ORAPARM_OUTPUT
  OraDatabase.AddParameter "SAL", 0, ORAPARM_OUTPUT
'OraDatabase.Parameters("SAL").serverType = ORATYPE_NUMBER
  OraDatabase.SetParameterServerType "SAL", ORATYPE_NUMBER
'または、OraDatabase.Parameters("SAL").serverType = adNumeric
 
'Execute the Stored Procedure Employee.GetEmpName to retrieve ENAME.
' This Stored Procedure can be found in the file ORAEXAMP.SQL.
  OraDatabase.ExecuteSQL ("Begin Employee.GetEmpName (:EMPNO, :ENAME); end;")
'Display the employee number and name.
 
'Execute the Stored Function Employee.GetSal to retrieve SAL.
' This Stored Function can be found in the file ORAEXAMP.SQL.
  OraDatabase.ExecuteSQL ("declare SAL number(7,2); Begin" & _
           ":SAL:=Employee.GetEmpSal (:EMPNO); end;")
 
'Display the employee name, number and salary.
  MsgBox "Employee " & OraDatabase.Parameters("ENAME").value & ", #" & _
          OraDatabase.Parameters("EMPNO").value & ",Salary=" & _
          OraDatabase.Parameters("SAL").value
 
'Remove the Parameters.
'OraDatabase.Parameters.Remove "EMPNO"
'OraDatabase.Parameters.Remove "ENAME"
'OraDatabase.Parameters.Remove "SAL"
  OraDatabase.ClearParameters
End Sub

そのまま書き換えた場合に比べ、大幅に単純化されていることが分かります。

補足

• データプロバイダに OraOLEDB でなく MSDAORA を指定しても動きます。
• OraAdapter.Parameters は ADODB.Parameter のコレクションです。
  したがって、OraDatabase.Parameters("EMPNO").serverType = ORATYPE_NUMBER は、
  OraDatabase.SetParameterServerType "EMPNO", ORATYPE_NUMBER
  ではなく
  OraDatabase.Parameters("EMPNO").Type = adNumeric
  に書き換えることも可能です。
• CreateOraDynaset は OraDynaset ではなく、ADODB.Recordset を返します。
  OraDynaset と Recordset の違いについては、以下の記事も参考にしてください。
  
  • Editメソッドとトランザクション
  • Find 系メソッド
  • AddNewメソッドとデフォルト列値
• パラメータを変更してOraDynaset.Refresh をしている場合は、

OraAdapter.RefreshParameters
OraDynaset.Requery

に書き換えてください。