VB6で（なんちゃって）構造化例外処理

最近はずっとVB6*1で仕事をしているので、できない事が多くてイライラしてくる。

だからと言って、いい加減な物を作るわけにはいかないので、VB6でもできる限りの事をやる為に色々とフレームワーク的なものを作り始めた。これを使えば一定の品質を保てるって程度のやつ。

まずはVB6のしょぼいエラー処理の機能をもう少しましにする機能を作った。

やりたい事は

• 一貫したエラー処理
• 呼び出し履歴が参照できる（スタックトレース）
• エラーに追加情報を載せる

これらを実現する為に、まず例外クラスから作ることにする。

その前にこのクラスが必要なので、載せとく。単なる文字列バッファクラスね。

clsStringBuilder.cls

Option Explicit
'#---------------------------------------------------------------------------
'# クラス名：clsStringBuilder
'# 概要　　：文字列バッファクラス
'#---------------------------------------------------------------------------

Private m_strBuffer As String

Private Sub Class_Initialize()
    m_strBuffer = ""
End Sub

'#---------------------------------------------------------------------------
'# 関数名：Append
'# 機能  ：バッファに文字列を追加します。
'#
'# 引数  ：strValue：   文字列
'#       ：varParam0：  パラメータ１
'#       ：varParam1：  パラメータ２
'#       ：varParam2：  パラメータ３
'#       ：varParam3：  パラメータ４
'#       ：varParam4：  パラメータ５
'#
'# 戻り値：自分自身
'# 備考　：文字列に「{番号}」という形式の文字列を入れると、その部分が
'#         引数で指定した番号のパラメータと置き換わります。
'#         例： objBuffer.Append("my name is {0}.", "hoge")
'#              ' 「my name is hoge.」という文字列が追加される。
'#---------------------------------------------------------------------------
Public Function Append( _
    Optional ByRef strValue As String = "", _
    Optional ByRef varParam0 As Variant, _
    Optional ByRef varParam1 As Variant, _
    Optional ByRef varParam2 As Variant, _
    Optional ByRef varParam3 As Variant, _
    Optional ByRef varParam4 As Variant) As clsStringBuilder

    Dim i As Integer
    Dim varParams(4) As Variant
    If Not IsMissing(varParam0) Then varParams(0) = varParam0
    If Not IsMissing(varParam1) Then varParams(1) = varParam1
    If Not IsMissing(varParam2) Then varParams(2) = varParam2
    If Not IsMissing(varParam3) Then varParams(3) = varParam3
    If Not IsMissing(varParam4) Then varParams(4) = varParam4
    
    For i = LBound(varParams) To UBound(varParams)
        strValue = Replace(strValue, "{" & CStr(i) & "}", varParams(i))
    Next
    
    m_strBuffer = m_strBuffer & strValue
    
    Set Append = Me
End Function

'#---------------------------------------------------------------------------
'# 関数名：AppendLine
'# 機能  ：バッファに文字列を追加して、改行を挿入します。
'#
'# 引数  ：strValue：   文字列
'#       ：varParam0：  パラメータ１
'#       ：varParam1：  パラメータ２
'#       ：varParam2：  パラメータ３
'#       ：varParam3：  パラメータ４
'#       ：varParam4：  パラメータ５
'#
'# 戻り値：自分自身
'#---------------------------------------------------------------------------
Public Function AppendLine( _
    Optional ByRef strValue As String = "", _
    Optional ByRef varParam0 As Variant, _
    Optional ByRef varParam1 As Variant, _
    Optional ByRef varParam2 As Variant, _
    Optional ByRef varParam3 As Variant, _
    Optional ByRef varParam4 As Variant) As clsStringBuilder
    
    Set AppendLine = Append( _
        strValue & vbCrLf, _
        varParam0, varParam1, varParam2, varParam3, varParam4 _
    )
End Function

'#---------------------------------------------------------------------------
'# 関数名：Clear
'# 機能  ：バッファにある文字列をクリアします。
'#
'#---------------------------------------------------------------------------
Public Sub Clear()
    m_strBuffer = ""
End Sub

'#---------------------------------------------------------------------------
'# 関数名：ToString
'# 機能  ：現在のバッファの文字列を取得します。
'#
'# 戻り値：文字列
'#---------------------------------------------------------------------------
Public Function ToString() As String
    ToString = m_strBuffer
End Function

'#---------------------------------------------------------------------------
'# プロパティ名：Length
'# 機能        ：現在のバッファの文字列長さを取得します。
'#
'# 戻り値：文字列の長さ
'#---------------------------------------------------------------------------
Public Property Get Length() As Long
    Length = Len(m_strBuffer)
End Property

実装

で、例外クラスが以下

clsException.cls

Option Explicit
'#---------------------------------------------------------------------------
'# クラス名：clsException
'# 概要　　：ユーザ定義のエラーの情報を格納するクラス
'#---------------------------------------------------------------------------

Private m_lngNumber As Long
Private m_strSource As String
Private m_strDescription As String

Private m_objInnerException As clsException

'#---------------------------------------------------------------------------
'# プロパティ名：Number
'# 機能  ：エラー番号を取得、設定します。
'#
'# 戻り値：エラー番号
'#---------------------------------------------------------------------------
Public Property Let Number(ByRef lngNumber As Long)
    m_lngNumber = lngNumber
End Property
Public Property Get Number() As Long
    Number = m_lngNumber
End Property

'#---------------------------------------------------------------------------
'# プロパティ名：Source
'# 機能  ：エラーのソースを取得、設定します。
'#
'# 戻り値：エラーのソース
'#---------------------------------------------------------------------------
Public Property Let Source(ByRef strSource As String)
    m_strSource = strSource
End Property
Public Property Get Source() As String
    Source = m_strSource
End Property

'#---------------------------------------------------------------------------
'# プロパティ名：Description
'# 機能  ：エラーの詳細を取得、設定します。
'#
'# 戻り値：エラーの詳細
'#---------------------------------------------------------------------------
Public Property Let Description(ByRef strDescription As String)
    m_strDescription = strDescription
End Property
Public Property Get Description() As String
    Description = m_strDescription
End Property

'#---------------------------------------------------------------------------
'# プロパティ名：InnerException
'# 機能  ：内部エラーオブジェクトを取得、設定します。
'#
'# 戻り値：エラーオブジェクト
'#---------------------------------------------------------------------------
Public Property Set InnerException(ByRef objInnerException As clsException)
    Set m_objInnerException = objInnerException
End Property
Public Property Get InnerException() As clsException
    Set InnerException = m_objInnerException
End Property

Private Sub Class_Initialize()
    m_lngNumber = 0
    m_strSource = ""
    m_strDescription = ""
End Sub

'#---------------------------------------------------------------------------
'# 関数名：ToString
'# 機能  ：現在のオブジェクトを文字列に変換します。
'#
'# 戻り値：文字列
'#---------------------------------------------------------------------------
Public Function ToString() As String
    Dim objExp As clsException
    
    Set objExp = Me
    
    With New clsStringBuilder
        .AppendLine "エラー番号：[{0}]", Me.Number
        .AppendLine
        .AppendLine Me.Description
        
        Do Until objExp Is Nothing
            .AppendLine "  at {0}", objExp.Source
            
            Set objExp = objExp.InnerException
        Loop
        
        ToString = .ToString
    End With
End Function

あとはこのクラスを使って色々とエラーを発生させるためのモジュールを定義する。

modException.bas

Option Explicit

' 不正な操作
Public Const InvalidOperation = 1000
' 不正な引数
Public Const InvalidArgument = 1001
' インデックスが範囲外
Public Const IndexOutOfRange = 1002
' 未実装
Public Const NotImplementation = 1003

Private m_objLastException As clsException
    
'#---------------------------------------------------------------------------
'# 関数名：modException_Throw
'# 機能  ：指定したエラー内容で例外をスローします。
'#
'# 引数  ：lngNumber：          エラー番号
'#       ：strSource：          エラーソース
'#       ：strDescription：     エラーの詳細
'#---------------------------------------------------------------------------
Public Sub modException_Throw( _
    ByRef lngNumber As Long, _
    ByRef strSource As String, _
    ByRef strDescription As String)
    
    Dim objException As New clsException
    
    With objException
        .Number = lngNumber
        .Source = strSource
        .Description = strDescription
        
        If Not m_objLastException Is Nothing Then
            Set objException.InnerException = m_objLastException
        End If
    End With
    
    Set m_objLastException = objException
    
    Call Err.Raise(lngNumber, strSource, strDescription)
End Sub

'#---------------------------------------------------------------------------
'# 関数名：modException_Throw
'# 機能  ：現在のエラーを再スローします。
'#
'# 引数  ：strSource：      ソース
'#---------------------------------------------------------------------------
Public Sub modException_Rethrow( _
    Optional ByRef strSource As Variant)
    
    If Err.Number <> 0 Then
        Call modException_Throw(Err.Number, _
            IIf(IsMissing(strSource), Err.Source, strSource), Err.Description
        )
    End If
End Sub

'#---------------------------------------------------------------------------
'# 関数名：modException_GetLastException
'# 機能  ：最後にスローされたエラーを取得します。
'#
'# 戻り値：エラー内容
'#---------------------------------------------------------------------------
Public Function modException_GetLastException() As clsException
    If Not m_objLastException Is Nothing Then
        Set modException_GetLastException = m_objLastException
    ' 標準のエラーで代替してやる
    ElseIf Err.Number <> 0 Then
        Dim objException As New clsException
        
        With objException
            .Number = Err.Number
            .Source = Err.Source
            .Description = Err.Description
        End With
        
        Set modException_GetLastException = objException
    End If
End Function

'#---------------------------------------------------------------------------
'# 関数名：modException_ClearLastException
'# 機能  ：最後にスローされたエラーを消去します。
'#
'#---------------------------------------------------------------------------
Public Sub modException_ClearLastException()
    Set m_objLastException = Nothing
    
    Call Err.Clear
End Sub

'#---------------------------------------------------------------------------
'# 関数名：modException_ExistsException
'# 機能  ：エラーがスローされたかどうかを調べます。
'#
'# 戻り値：スローされていればTrue
'#---------------------------------------------------------------------------
Public Function modException_ExistsException() As Boolean
    modException_ExsitsException = Not modException_GetLastException() Is Nothing
End Function

使い方

使い方としてはこんな感じ

エラーを発生させてキャッチ

Sub Main()
    ' 最初に必ず呼び出す
    Call modException_ClearLastException()

On Error Goto EXCEPT:
    Call Execute
    
    Exit Sub
EXCEPT:
    With modException_GetLastException
        ' スタックトレースを出力
        Debug.Print .ToString
        
        MsgBox .Description
    End With
End Sub

Sub Execute()
    Call modException_Throw(666, "Execute", "エラー発生")
End Sub

ランタイムエラーをキャッチして、再スロー

Sub Main()
    ' 最初に必ず呼び出す
    Call modException_ClearLastException()

On Error Goto EXCEPT:
    Call Execute1
    
    Exit Sub
EXCEPT:
    With modException_GetLastException
        ' スタックトレースを出力
        Debug.Print .ToString
        
        MsgBox .Description
    End With
End Sub

Sub Execute1()
On Error Goto EXCEPT:
    Call Execute2
    
    Exit Sub
EXCEPT:
    ' スルー
    Call modException_Rethrow("Execute1")
End Sub

Sub Execute2()
On Error Goto EXCEPT:
    Call Execute3
    
    Exit Sub
EXCEPT:
    ' スルー
    Call modException_Rethrow("Execute2")
End Sub

Sub Execute3()
On Error Goto EXCEPT:
    ' なんかエラーが発生する処理
    
    Exit Sub
EXCEPT:
    ' 再スロー
    Call modException_Rethrow("Execute3")
End Sub

手動でスタックトレースを積み上げていかなければいけないので、コード量は増えちゃうけど必ず役に立つ時が来るので、やっときたい。
たいした事はやっていないけど、プロジェクトでエラー処理を共通化できるので、それなりに効果はあるはず。

ソース

• http://code.assembla.com/coma2n-public/subversion/nodes/lang/vb/framework/trunk/system?rev=30#

*1:正確にはAccess VBAだけど