VB6で（なんちゃって）宣言的トランザクション

VB

前回に引き続きVB6でも、できるだけの事はやってみようシリーズ

VB6でデータベースを使ったアプリケーションでよくやってしまうのは、トランザクションの張り忘れとかロールバック、コミットのし忘れなど。おまけに汎用的な関数の中でやっちゃったりして、トランザクションがまともに機能しなかったりする。

こういうのはきっちりルールを決めて実装しなくちゃいけないんだけど、なかなか守れないのが実情。そういう状況を打破するために宣言するだけでトランザクションの開始とコミット、ロールバックが自動で行われるモジュールを作ってみた。

使い方はこんな感じ

modMain.bas
Sub Main()
    Call modException_ClearLastException()

On Error Goto EXCEPT
    ' modTransaction_Beginでトランザクションが開始される
    ' また、引数に接続オブジェクトを渡す事もできる
    With modTransaction_Begin
        ' Connectionプロパティで接続オブジェクトが取れるので
        ' それを使って何らかのDBアクセスを行う
        Call DoSomething(.Connection)
        '
        '
        '
        ' また、明示的にロールバックする場合はRollbackメソッドを呼び出す
        If Condition() Then .Rollback
    End With
    ' Withブロックを抜けた時点でコミットされる
    ' Withブロック内でエラーが発生した場合は、ロールバックされる
    Exit Sub
EXCEPT:
    With modException_GetLastException()
        Debug.Print .ToString

        MsgBox .Description, vbExclamation
    End With
End Sub

modTransaction_Begin関数を呼び出すとclsTransactionクラスというトランザクションを制御するクラスのインスタンスが返ってくる。

このインスタンスをWithブロックを使って生存期間を限定してやる事でトランザクションを張る場所を制御できる。

仕掛けとしてはこう

  1. クラスのコンストラクタでトランザクションを開始
  2. デストラクタでErrオブジェクトにエラー番号が設定されていればロールバック、そうでなければコミットする。

以下がクラスの実装

clsTransaction.cls

Option Explicit
'#---------------------------------------------------------------------------
'# クラス名：clsTransaction
'# 概要　　：トランザクションに関する操作を実行するクラス
'#---------------------------------------------------------------------------

Private m_objCon As ADODB.Connection

'#---------------------------------------------------------------------------
'# プロパティ名：Connection
'# 機能  ：接続オブジェクトを取得します。
'#
'# 戻り値：接続オブジェクト
'#---------------------------------------------------------------------------
Public Property Get Connection() As ADODB.Connection
    Set Connection = m_objCon
End Property

Private Sub Class_Initialize()
    If modTransaction_Connection Is Nothing Then
        Call modException_Throw(InvalidOperation, "clsTransaction.Class_Initialize", _
            "不正な操作です。[clsDao]のインスタンス化には[clsDao_New]関数を使用して下さい。" _
        )
    End If
    
    Set m_objCon = modTransaction_Connection
    
    Me.Begin
End Sub

Private Sub Class_Terminate()
    If modException_ExsitsException() Then
        If Err.Number = 0 Then
            Me.Commit
        Else
            Me.ROLLBACK
        End If
    End If
End Sub

'#---------------------------------------------------------------------------
'# 関数名：Begin
'# 機能  ：トランザクションを開始します。
'#
'# 戻り値：開始に成功したかどうか
'#---------------------------------------------------------------------------
Public Function Begin() As Boolean
    If Not m_objCon Is Nothing Then
        Call m_objCon.BeginTrans
        
        Begin = True
    End If
End Function

'#---------------------------------------------------------------------------
'# 関数名：Commit
'# 機能  ：トランザクションをコミットします。
'#
'# 戻り値：コミットに成功したかどうか
'#---------------------------------------------------------------------------
Public Function Commit() As Boolean
    If Not m_objCon Is Nothing Then
        Call m_objCon.CommitTrans
        
        Commit = True
    End If
End Function

'#---------------------------------------------------------------------------
'# 関数名：Rollback
'# 機能  ：トランザクションをロールバックします。
'#
'# 戻り値：ロールバックに成功したかどうか
'#---------------------------------------------------------------------------
Public Function ROLLBACK() As Boolean
    If Not m_objCon Is Nothing Then
        Call m_objCon.RollbackTrans
        
        ROLLBACK = True
    End If
End Function

'#---------------------------------------------------------------------------
'# 関数名：GetDao
'# 機能  ：Daoオブジェクトを取得します。
'#
'# 戻り値：Daoオブジェクト
'#---------------------------------------------------------------------------
Public Function GetDao() As clsDao
    If Not m_objCon Is Nothing Then
        Set GetDao = clsDao_New(m_objCon)
    End If
End Function

これに対応するモジュール

modTransaction

Option Explicit

' clsTransactionのコンストラクタで接続オブジェクトを取得する為に
' 一時的に参照する為の変数、それ以外の目的では使用しない事
Public modTransaction_Connection As ADODB.Connection

'#---------------------------------------------------------------------------
'# 関数名：modTransaction_Begin
'# 機能  ：指定した接続でトランザクションを開始します。
'#
'# 引数  ：objCon：     接続オブジェクト（省略時はカレントプロジェクト）
'#
'# 戻り値：トランザクションオブジェクト
'#---------------------------------------------------------------------------
Public Function modTransaction_Begin(Optional ByRef objcon As ADODB.Connection) As clsTransaction
    If objcon Is Nothing Then
        Set modTransaction_Connection = CurrentProject.Connection
    Else
        Set modTransaction_Connection = objcon
    End If
    
On Error Resume Next
    Set modTransaction_Begin = New clsTransaction
    Set modTransaction_Connection = Nothing
End Function

これを使う事でコミットやロールバックのし忘れを防ぐ事もできるし、トランザクションの期間を明確にできる。

あとは、これを最上位のモジュールから呼び出すという事をルール付ければいい。

おまけでこういうのも作った

modMain.bas
Sub Main()
    Dim objRs As RecordSet
    Dim varResult As Variant
    Dim intRecords As Integer

    With modTransaction_Begin
        ' clsDaoクラスのインスタンスが返ってくる
        With .GetDao()
            ' レコードセットを返すメソッド
            Set objRs = .Execute("SELECT * FROM HogeTable")

            ' 単一の結果が返ってくる
            varResult = .ExecuteScalar("SELECT COUNT(*) FROM HogeTable")

            ' 影響を受けた行数が返ってくる
            intRecords = ExecuteNonQuery("DELETE FROM HogeTable")
        End With
    End With

    ' このユーティリティ関数でもインスタンス可できる
    ' 引数に接続オブジェクトを渡す事も可能
    With clsDao_New
        ' DoSomething
    End With
End Sub

ADO.NETのインターフェースをそのままぱくったDAOクラス（clsDao）、それなりに便利かもしれない。

以下、ソース

clsDao.cls

Option Explicit
'#---------------------------------------------------------------------------
'# クラス名：clsDao
'# 概要　　：データベースへのアクセスに関する操作を提供するクラス
'#---------------------------------------------------------------------------

Private m_objCon As ADODB.Connection
Private m_blnIsCreateNew As Boolean

'#---------------------------------------------------------------------------
'# プロパティ名：Connection
'# 機能  ：接続オブジェクトを取得します。
'#
'# 戻り値：接続オブジェクト
'#---------------------------------------------------------------------------
Public Property Get Connection() As ADODB.Connection
    Set Connection = m_objCon
End Property

Private Sub Class_Initialize()
    If modDao_Connection Is Nothing Then
        Call modException_Throw(InvalidOperation, "clsDao.Class_Initialize", _
            "不正な操作です。[clsDao]のインスタンス化には[clsDao_New]関数を使用して下さい。" _
        )
    End If
    
    Set m_objCon = modDao_Connection
    m_blnIsCreateNew = modDao_IsCreateNew
End Sub

Private Sub Class_Terminate()
    If Not m_objCon Is Nothing And m_blnIsCreateNew Then
        Call m_objCon.Close
    End If
End Sub

'#---------------------------------------------------------------------------
'# 関数名：Execute
'# 機能  ：指定したSQLでデータベースに問い合わせを行います。
'#
'# 引数  ：strSql：     SQL
'# 　　  ：cursorType： [Option]カーソルの種類
'# 　　  ：lockType：   [Option]ロックの種類
'#
'# 戻り値：結果オブジェクト
'#---------------------------------------------------------------------------
Public Function Execute( _
    ByVal strSql As String, _
    Optional cursorType As CursorTypeEnum = CursorTypeEnum.adOpenStatic, _
    Optional lockType As LockTypeEnum = LockTypeEnum.adLockReadOnly) As Recordset
    
    Dim objRs As New Recordset
    
    Call objRs.Open(strSql, Me.Connection, cursorType, lockType)
    
    Set Execute = objRs
End Function

'#---------------------------------------------------------------------------
'# 関数名：ExecuteScalar
'# 機能  ：指定したSQLでデータベースに問い合わせを行います（結果が単一の値）。
'#
'# 引数  ：strSql：     SQL
'# 　　  ：cursorType： [Option]カーソルの種類
'# 　　  ：lockType：   [Option]ロックの種類
'#
'# 戻り値：結果の値
'#---------------------------------------------------------------------------
Public Function ExecuteScalar( _
    ByVal strSql As String, _
    Optional cursorType As CursorTypeEnum, _
    Optional lockType As LockTypeEnum) As Variant

    With Execute(strSql, cursorType, lockType)
        If .EOF Then
            Call modException_Throw(InvalidArgument, _
                "clsDao.ExecuteSingle", "返却されるレコードが存在しません。" _
            )
        End If
        
        ExecuteScalar = .Fields(0).Value
    End With
End Function

'#---------------------------------------------------------------------------
'# 関数名：ExecuteNonQuery
'# 機能  ：指定したSQLでデータベースに問い合わせを行います（影響を受けた行数を返却）。
'#
'# 引数  ：strSql：     SQL
'#
'# 戻り値：影響を受けた行数
'#---------------------------------------------------------------------------
Public Function ExecuteNonQuery(ByVal strSql As String) As Integer
    Dim intRecords As Integer
    
    Call Connection.Execute(strSql, intRecords)
    
    ExecuteNonQuery = intRecords
End Function

対応するモジュール

modDao.bas
Option Explicit

' clsDaoのコンストラクタで接続オブジェクトを取得する為に
' 一時的に参照する為の変数、それ以外の目的では使用しない事
Public modDao_Connection As ADODB.Connection
' Connectionが新しく作られたかどうか
Public modDao_IsCreateNew As Boolean

'#---------------------------------------------------------------------------
'# 関数名：clsDao_New
'# 機能  ：指定した接続でDAOオブジェクトを生成します。
'#
'# 引数  ：objCon：     接続オブジェクト（省略時はカレントプロジェクト）
'#
'# 戻り値：DAOオブジェクト
'#---------------------------------------------------------------------------
Public Function clsDao_New(Optional ByRef objcon As ADODB.Connection) As clsDao
    If objcon Is Nothing Then
        Set modDao_Connection = CurrentProject.Connection
        modDao_IsCreateNew = True
    Else
        Set modDao_Connection = objcon
        modDao_IsCreateNew = False
    End If
    
On Error Resume Next
    Set clsDao_New = New clsDao
    Set modDao_Connection = Nothing
End Function

こういうのを用意して、プロジェクトメンバーに周知させれば、一定の品質を保てるようになればいいなぁ．．．

ソース

参照