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

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

ソース

参照

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

VB

最近はずっと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

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

ソース

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

WCF　はじめの一歩

.NET VB.NET WCF

今更ながらWCF(Windows Communication Foundation)を始めた。

長い間プログラミングから遠ざかっていた*1ので、若干書き方を忘れてきたけど思い出しつつ勉強開始
まずは基本中の基本からやってみる。

概要

イメージとしてはこんな感じ

Server側とClient側でContract（インターフェース）を決めてあげれば、通信部分のプロトコルとかなんやらはWCFがやってくれまっせという事です。

これに従って、今回作成するプロジェクトは以下の三種類

  • WcfService（コンソール）
  • WcfServiceInterface（ライブラリ）
  • WcfClient（コンソール）

また、参照設定に以下のアセンブリを追加しておく

  • System.ServiceModel（WCFの本体）
  • System.Runtime.Serialization

Contractの定義

まずはインターフェースの定義から

やり取りするデータの型をまずは決める。

WcfServiceInterface/Customer.vb
<DataContract(Namespace:="http://www.coma2n.com/wcfservice/customer")> _
Public Class Customer

    Private m_name As String
    <DataMember()> _
    Public Property Name() As String
        Get
            Return m_name
        End Get
        Set(ByVal value As String)
            m_name = value
        End Set
    End Property

End Class

簡単にNameというプロパティを持つCustomer型を定義する。

WCFを使ってやり取りするデータの型はDataContract属性でマークする必要がある。同様にプロパティはDataMember属性でマークする必要がある。

次は実際にこの型をやり取りするサービスのインターフェースを定義する。

WcfServiceInterface/IWcfService.vb
<ServiceContract(Namespace:="http://www.coma2n.com/wcfservice")> _
Public Interface IWcfService
    <OperationContract()> _
    Function GetCustomer() As Customer
End Interface

インターフェースの定義はこれで終わり。

Server側の実装

Server側では、まずサービスの実装を定義する。

WcfService/WcfServiceImpl.vb
Public Class WcfServiceImpl
    Implements IWcfService

    Public Function GetCustomer() As Customer Implements IWcfService.GetCustomer
        Return New Customer With {.Name = "Ozzy Osbourne"}
    End Function
End Class

こんだけ、後はこれをサービスとして公開する。

まずは、アプリケーション構成ファイルにendpointを定義する。

App.config
<?xml version="1.0" encoding="utf-8" ?>
<configuration>
    <system.serviceModel>
        <services>
            <service name="WcfService.WcfServiceImpl">
                <endpoint
                    address="net.tcp://localhost:8081/wcfService"
                    binding="netTcpBinding"
                    contract="WcfServiceInterface.IWcfService" />
            </service>
        </services>
    </system.serviceModel>
</configuration>

そして、エントリーポイントに以下のコードを追加する。

WcfService/Program.vb
Module Program
    Sub Main()
        Dim svcHost As ServiceHost = New ServiceHost(GetType(WcfServiceImpl))
        svcHost.Open()

        Console.ReadKey()
    End Sub
End Module

これでアプリケーションを起動すれば、サービスが公開される。

Client側の実装

あとはこのサービスを利用するクライアントを定義するだけ。

まずはアプリケーション構成ファイルにendpointを定義する。

App.config
<?xml version="1.0" encoding="utf-8" ?>
<configuration>
    <system.serviceModel>
        <client>
            <endpoint
                name="wcfService"
                address="net.tcp://localhost:8081/wcfService"
                contract="WcfServiceInterface.IWcfService"
                binding="netTcpBinding" />
        </client>
    </system.serviceModel>
</configuration>

あとはエントリーポイントでサービスに接続するコードを書くだけ。

WcfClient/Program.vb
Module Program
    Sub Main()
        Dim factory = New ChannelFactory(Of IWcfService)("wcfService")
        Dim wcfService = factory.CreateChannel()
        Dim customer = wcfService.GetCustomer()

        Console.WriteLine("Name = {0}", customer.Name)
        Console.ReadKey()
    End Sub
End Module

これだけでServer側でオブジェクトをアクティブ化して、クライアント側からプロキシ経由でオブジェクトのメソッドを呼び出す事ができる。.NET Remotingと比べるとMarshalByRefObjectやSerializable属性を使わなくても済むので、若干楽になった印象。

後は拡張性とかかすごいんでしょうね。まだ全然さわってないからわかんないけど。

まだ、CAOとSAOとかSingletonとSingleCallとかがどうなっているのか知らないので、その辺を調べていこうかと思う。

あ〜、VBつまんねぇ。

参考

*1:そろそろ.netに戻れそう

ガンダム 台場に立つ

その他

お台場にガンダムが出現したという事で、ちょっくら行ってきました。

https://photos-1.getdropbox.com/i/l/n26U5vv044oDpLrEjZpUahc61xR2Q_rb7WkYn-esMlE#1.jpg

ｷﾀ━━━━━━━━━━━━━━━━(ﾟ∀ﾟ)━━━━━━━━━━━━━━━━!!!!!!

https://photos-3.getdropbox.com/i/l/PrCHLLrOf9YNDc_y6mP0xdX3nr768cbYOsti9CClrbs#3.jpg
ディティールが素晴らしいですね！

https://photos-4.getdropbox.com/i/l/DBOOZuCSQXE82LJfGMixGqIkg9nJqBqeuMBTWcHQ910#4.jpg
若干、天気が悪いのがあれですが、よく撮れています。

https://photos-2.getdropbox.com/i/l/-x1bBu-JhZYnJ0BOgCIeGPDatdHvTuA6Slgmx1efw2M#6.jpg
下から

https://photos-1.getdropbox.com/i/l/W1-fRK9QDsxyWbq83xUzIkqzsKFzn4BrnbdOVxX3YIA#5.jpg
アップ

https://photos-3.getdropbox.com/i/l/O1t7OSPK68-waLkH-DzSiOYtJaItf309Ghuw0kHSFp8#7.jpg
ぐるっと回り込んで．．．

https://photos-4.getdropbox.com/i/l/WacmiLARVFmhGBKTGqkYq3PB4uRqBs17MnjqyvH_w7I#8.jpg
アップ

https://photos-1.getdropbox.com/i/l/6q28KRz9vdbCbuTBUACuMUY8x32E2bHi67OLiwn9Txc#9.jpg
側面

https://photos-3.getdropbox.com/i/l/FG6IMFvCax29GqxyzKiHlMAS8r6wXCMWFCqWHP5eyk0#11.jpg
バックパック

https://photos-4.getdropbox.com/i/l/HGIqEiYeJB1qIEiGbGwlPwq8aKPCJIrIqTfJiALqsVE#12.jpg
アップ

https://photos-1.getdropbox.com/i/l/onnlDee_0gytl0B1vOCl-XEHRidL1EGCqBf03l9yraw#13.jpg
関節部分のディティールも素晴らしいですね。

https://photos-2.getdropbox.com/i/l/viIekOglRB9eMrwN3r1tBgSVflMgZO486VvAM3jAtGA#14.jpg
木陰から

https://photos-1.getdropbox.com/i/l/pm3NpdEh86N8pDxlSw1YiBeAtEcTX-mUCh8L9ONEUzM#17.jpg
シュールｗ

まだ、一般公開前なのでアトラクションも何もなくて見るだけしかなかったのですが、素晴らしい出来でした。

帰りに豊洲によって、「スタートレック」を観てきました。こちらもなかなかおもしろかったです。

VB6の関数一覧を出力する

PowerShell PowerShell from Japan!!

ちょっとした小ネタです。

VB6のソースから関数の一覧を抜き出したいと言われたので、PowerShellでサクっと作ってみました。


Get-ChildItem -recurse -include *.bas | % {[string]::Join("`n", ((Get-Content $_) | % { $_.Trim() })).Replace("_`n", "").Split("`n") | ? { $_ -match "Public (Sub|Function)" }}

これを実行するとカレントディレクトリとその配下にあるディレクトリからVB6のモジュールファイルを検索して、その中に定義されているPublicな関数とプロシージャが標準出力に出力されます。

調子に乗ってワンライナーで書いたので読みづらいですが、やっている事は、

  1. Get-ChildItemでカレントディレクトリとその配下にある「.bas」ファイルを検索する。
  2. Get-Contentでファイルの内容を配列で取得する。
  3. string.Trimメソッドで各要素の先頭と末尾のスペースを削除する。
  4. string.Joinメソッドで、その配列を改行コードで連結する。
  5. string.Replaceメソッドで、"_" + 改行コードを削除する（VBの_改行を削除する）。
  6. string.Splitメソッドを使って、改行コードで分割する。
  7. 正規表現を使って、関数の定義を探す。

となります。

こういった処理が一行で書けてしまうのもPowerShellの魅力のひとつですね。

東京巡り - 浅草

その他

四月から転職して東京暮らしをしているわけですが、だいぶこっちの暮らしにも慣れてきたので、ちょこちょこ観光とかしてます。

今回は僕は元気でやってますという報告も兼ねて、その観光の一部をレポートしたいと思います。

余談ですが、こっちに来てから髪型をアシンメトリーでウィングな感じの茶髪のおしゃれヘアーに変えました（原宿で15,000円なり）。

で、観光ですが、僕は下町が好きなのでよく亀有とか北千住とかに行くんですが（綾瀬に住んでるので）、今回は浅草に行ってきました。


綾瀬から千代田線で北千住まで行って、そこから東武線で浅草まで行きます。

浅草駅から雷門通りを少し歩くと、右手に雷門が見えてきました。
https://photos-1.getdropbox.com/i/l/s-uY_A-hTp9TV2ojvRF-6ccWe5swjvQowtsBZdRyZf0#1.jpg

後ろから見るとこんな感じ
https://photos-2.getdropbox.com/i/l/XSM71CvR5vSiThQMk1IWa4YnsvkiV2ls2Ak-t3swiFM#2.jpg

さすが日本が誇る観光名所だけあって外国の方が多いですね。
https://photos-3.getdropbox.com/i/l/JmC1AuDw1Z6_VXHDY2wSJ04VehNZ_hfjnwNcslsFZto#3.jpg

雷門をくぐって仲見世通りを進んでいきます。
https://photos-4.getdropbox.com/i/l/n_l1qep_WP5pBnWPLEjKzvHpqCzbqmeAUse3WUbI6A8#4.jpg

途中で浅草名物「アイスモナカ」を買いました。
https://photos-1.getdropbox.com/i/l/PhjRsX02YjOp_mmRfDxBq6bzx0Zk7teRnZA-LMLhfik#5.jpg

(ﾟдﾟ)ｳﾏｰ

https://photos-2.getdropbox.com/i/l/Jt6kswAnKS9ulBGjrJU9tVbreo6QHH8gDYbhFFmiTIU#6.jpg

さらに進んでいきます。
https://photos-3.getdropbox.com/i/l/cvvTln2MKOs5NeeBVsMEmVwtyNNpuycrkbv8fg7H2nI#7.jpg

仲見世通りの終点、宝蔵門が見えてきました。
https://photos-4.getdropbox.com/i/l/cDNBKk--spSKjgBXfVYE2KH77PZm2CIdBgoN1TJlCJk#8.jpg

宝蔵門をくぐると、浅草寺です。残念ながら今は修復中のようでした。
https://photos-1.getdropbox.com/i/l/sohGIPq8VR6tiUB0AAUkxU_df22cO-52DXMM4luvaVU#9.jpg

左手には五重塔がありました。
https://photos-2.getdropbox.com/i/l/S2GjB5Y6Z8EmI2exOiIc_WFz7cvCG77tKAc2Xbg2mhA#10.jpg

なんか頭に煙りをかけています。これは頭が良くなるとかいうやつでしょうか？
https://photos-3.getdropbox.com/i/l/Y7c3U4Y7A5QA1la_iXkqYHkuYA9_Ofyv8Xqdo3Afqec#11.jpg

う〜ん、幻想的です。お参りをしておきました。
https://photos-4.getdropbox.com/i/l/8sLiCyOyc9D2yO4NvKvclyBCSLcIdo_ruoAfndKdePQ#12.jpg

帰り道に人形焼きを買いました。こち亀でお馴染みのやつですね。
https://photos-1.getdropbox.com/i/l/3gTGjBDB-_eiP6Mu9_KfN1buAYJUNdJrIz_Pn1OpFi0#13.jpg

(ﾟдﾟ)ｳﾏｰ

https://photos-2.getdropbox.com/i/l/dykOEOtWLvlnxMLtBVtUKAjnc-CRAsq3Ibf8KGGIjAY#14.jpg

仲見世通りを右に曲がり伝法院通りを進んでいきます。
https://photos-3.getdropbox.com/i/l/4Y7Jc9Zgix-NePGUKKdLj5vACRxR70Xm8Lso2HFYOwY#15.jpg

しばらく歩くと浅草演芸ホールに着きました。ナイツの漫才が観たかったんですが、やってませんでした。また次回に行きます。
https://photos-4.getdropbox.com/i/l/0thdet0e7_mBOdnctEg9LkEmsekieNkh6cqsnmz6Utk#16.jpg

浅草演芸ホールの隣にある浅草ROXとかいうところにクレープ屋さんがあったので、買ってみました。
https://photos-1.getdropbox.com/i/l/NGJJbB3vbgZX4qms6eEAUtHgdg_9a36Ynff8p7NSvTU#1.jpg

(ﾟдﾟ)ｳﾏｰ

https://photos-2.getdropbox.com/i/l/QVE6neYbbCxRfb-CpHfMl1yKgi1dwXo9C2Ea66wW7I0#2.jpg

この辺で歩き疲れてきたので、新仲見世通りを通って帰りました。

いまいち何をしに行ったのかわかりませんが、また行こうと思います。いいところですね。

Struts 2でもさわってみるか その１

Java Struts

最近のJavaのフレームワークがどうなっているか調べるために、Strutsの後継である「Struts 2」をさわってみた。

「Struts 2」はStrutsに「WebWork」というフレームワークをマージしたもの。「Struts 1」と似てはいるけど、別物と考えた方がいい。

最新のバイナリを以下のサイトからダウンロードしてきて使う。現在のバージョンは「2.1.6」

開発環境には、

を使う。

とりあえず簡単なTodoアプリでも作ってみる*1。

作ってみる

「Tomcat プロジェクト」で新規プロジェクトを作る。プロジェクト名は「jTodo」にする。

Struts 2の開発に必要なJarファイルを「WEB-INF/lib」フォルダにコピーしておく（以下は必須のJarファイル）。

  • commons-fileupload-1.2.1.jar
  • commons-logging-1.0.4.jar
  • freemarker-2.3.13.jar
  • ognl-2.6.11.jar
  • struts2-core-2.1.6.jar
  • xwork-2.1.2.jar

あと、楽をする為にConventionプラグインを使うので以下のJarファイルもコピーしておく。

  • struts2-convention-plugin-2.1.6.jar

「struts2-core-2.1.6.jar」をビルドパスに追加しておく。

まずはデプロイメントデスクリプタ（web.xml）から。

WEB-INF/web.xml
<?xml version="1.0" encoding="UTF-8"?>
<web-app id="WebApp_9" version="2.4" xmlns="http://java.sun.com/xml/ns/j2ee"
 xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
 xsi:schemaLocation="http://java.sun.com/xml/ns/j2ee http://
                     java.sun.com/xml/ns/j2ee/web-app_2_4.xsd">

    <filter>
        <filter-name>struts2</filter-name>
        <filter-class>org.apache.struts2.dispatcher.FilterDispatcher
        </filter-class>
    </filter>

    <filter-mapping>
        <filter-name>struts2</filter-name>
        <url-pattern>/*</url-pattern>
    </filter-mapping>

    <welcome-file-list>
        <welcome-file>index.jsp</welcome-file>
    </welcome-file-list>

</web-app>

次はStrutsの設定ファイル（struts.xml）、別に無くてもいい（Conventionプラグイン使うから）。

WEB-INF/src/struts.xml
<?xml version="1.0" encoding="UTF-8" ?>
<!DOCTYPE struts PUBLIC
    "-//Apache Software Foundation//DTD Struts Configuration 2.0//EN"
    "http://struts.apache.org/dtds/struts-2.0.dtd">

<struts>
	<constant name="struts.devMode" value="true"/>
	<constant name="struts.convention.classes.reload" value="true" />
</struts>

とりあえず、Todoアイテムの情報を格納するクラスを作っておく。

com.coma2n.jtodo.TodoItem.java

package com.coma2n.jtodo;

public class TodoItem {
    private int id;
    private int priority;
    private String title;
    
    public void setId(int id) {
        this.id = id;
    }
    public int getId() {
        return id;
    }
    public void setPriority(int priority) {
        this.priority = priority;
    }
    public int getPriority() {
        return priority;
    }
    public void setTitle(String title) {
        this.title = title;
    }
    public String getTitle() {
        return title;
    }
    
    public TodoItem() {
    }
    public TodoItem(int id, int priority, String title) {
        this.id = id;
        this.priority = priority;
        this.title = title;
    }
}

プロパティとしてId、Priority、Titleを定義しておく。

まずはTodoアイテムの一覧を表示する画面（初期画面）から作る。ビューにはJSPを使う*2。

WEB-INF/content/index.jsp

<%@ page language="java" contentType="text/html; charset=UTF-8"
    pageEncoding="UTF-8"%>
<%@taglib prefix="s" uri="/struts-tags" %>
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
    <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
    <title>jTodo</title>
    <style type="text/css">
        #datagrid {
          background-color: silver;
        }
        #datagrid th {
          background-color: blue;
          color: white;
          padding: 4px;
        }
        #datagrid td {
          background-color: white;
          padding: 2px;
        }
    </style>
</head>
<body>
    <table id="datagrid" border="0" rules="all">
        <thead>
           <tr>
               <th>優先度</th>
               <th>タイトル</th>
           </tr>
        </thead>
        <tbody>
        <s:iterator value="#session.ITEMS" var="item">
           <tr>
               <td align="center"><s:property value="#item.Priority" /></td>
               <td><s:property value="#item.Title" /></td>
           </tr>
        </s:iterator>
        </tbody>
    </table>
</body>
</html>

解説

Strutsタグのタグライブラリをインポートしている。

<%@taglib prefix="s" uri="/struts-tags" %>

iteratorタグでリスト要素に対して処理を行える。ここではvalue属性にセッション*3から取り出した「ITEMS」というキーのオブジェクトをリスト要素として渡し、その各要素をvar属性で「item」と宣言している。

当たり前だけど、現時点ではセッションに何も格納されていない。

<s:iterator value="#session.ITEMS" var="item">
...
</s:iterator>

そして、その中ではpropertyタグを使ってオブジェクトのプロパティを出力している。

<tr>
   <td align="center"><s:property value="#item.Priority" /></td>
   <td><s:property value="#item.Title" /></td>
</tr>

まぁ簡潔って言えば、簡潔かな。前とあんまり変わってないね。

で、次はこのページにデータを送るためのコントローラ（Strutsではアクション）を実装するんだけど、「Struts 1」ではActionSupportとかいうクラスを継承してクラスを作って、「struts.xml」にマッピングを追加して〜とか、なんか一画面追加するためだけでも色んな事をする必要があったんだけど、「Struts 2」ではその辺がだいぶ楽になっている。

といっても、Conventionプラグインを使わないと以前と同じようにやるか、アノテーションに頼る事になる。

コンベンションプラグインを使うとどうなるかと言うと、その名が示す通りアクションクラスを規約に従って作れば、自動的にビューと関連付けてくれるというもの。

その規約の条件は、

  • クラス名を「***Action」とする*4。
  • 関連づけるビューは「***Action」の「***」部分を同じにする。
  • 「public String execute」というシグネチャのメソッドを実装する*5。
  • 二階層より下のパッケージにクラスを含める*6。
  • ビューは「WEB-INF/content」フォルダに含める*7。

となっている。

ということで、「index.jsp」に対応するアクションクラスの「IndexAction」を実装する。

com.coma2n.jtodo.actions.IndexAction.java
package com.coma2n.jtodo.actions;

import java.util.Map;
import java.util.ArrayList;

import org.apache.struts2.interceptor.SessionAware;

import com.coma2n.jtodo.TodoItem;

public class IndexAction implements SessionAware {
    private Map<String, Object> session;
    
    @Override
    public void setSession(Map<String, Object> session) {
        this.session = session;
    }
    
    @SuppressWarnings("unchecked")
    public String execute() {
        ArrayList<TodoItem> list = (ArrayList<TodoItem>)session.get("ITEMS");
        if(list == null) {
            list = new ArrayList<TodoItem>();
            
            session.put("ITEMS", list);
        }
        return "success";
    }
}
解説

今回、Todoアイテムの情報を外部に永続化するのが面倒くさかったのでメモリ中でやる事にした。

「Struts 2」ではセッション情報にアクセスしたいクラスでSessionAwareインターフェースを実装してやれば、自動的にセッション情報のMapオブジェクトが渡されるようになっている*8。

executeメソッドでは、セッションから「ITEMS」のキーでオブジェクトを取得して、存在しなければ新しくインスタンス化して設定しているだけ。

このexecuteメソッドというのは、ASP.NETの「Page_Load」イベントハンドラのような役割をもっているらしい。

これで「http://localhost:8080/jTodo」にアクセスして、データが入っていれば（入ってるわけがないけど）以下のように表示される。

うん、「Struts 1」に比べてだいぶ楽になっている。

続きはまた今度

ソース

*1:俺、こればっかりやなorz

*2:Struts 2ではVelocityや他のビューを簡単に切り替える事ができる

*3:Mapオブジェクト

*4:ActionSupportから継承すればいらない

*5:いらんかもしれん

*6:設定で変更できる

*7:設定で変更できる

*8:この辺、Springの影響をもろに感じる