List 6-20　DataObj.Historyコンポーネント

  1： Implements IObjectConstruct
  2： Implements ObjectControl
  3： 
  4： ' データベース接続文字列
  5： Dim g_DBConnection As String
  6： 
  7： Private Sub IObjectConstruct_Construct(ByVal pCtorObj As Object)
  8：     ' コンストラクタ文字列を取得し，変数g_DBConnectionに代入
  9：     g_DBConnection = pCtorObj.ConstructString()
 10： End Sub
 11： 
 12： Private Sub ObjectControl_Activate()
 13：     ' アクティブ化されたときにg_DBConnection変数が初期化されていなければ
 14：     ' デフォルトの値を設定する
 15：     If g_DBConnection = "" Then
 16：         g_DBConnection = "Driver=SQL Server;Server=(local);UID=sa;Database=businesssampleDB;"
 17：     End If
 18： End Sub
 19： 
 20： Private Sub ObjectControl_Deactivate()
 21：     ' 非アクティブ化されたときの処理（ここでは何もしない）
 22： End Sub
 23： 
 24： Private Function ObjectControl_CanBePooled() As Boolean
 25：     ' オブジェクトのプーリングの設定（Visual Basicの場合には無意味）
 26：     ObjectControl_CanBePooled = True
 27： End Function
 28： 
 29： Public Sub AddHistory(ByVal TABLENAME As String, ByVal FIELDNAME As String, _
   　                       ByVal RECORDID As Long, _
   　                       ByVal OLDDATA As Variant, ByVal NEWDATA As Variant)
 30：     ' 履歴テーブルに履歴情報を加える
 31：     ' 【引数】
 32：     '   TABLENAME = テーブル名
 33：     '   FIELDNAME = フィールド名
 34：     '   RECORDID = 更新されたレコードID
 35：     '   OLDDATA = 古いデータの値
 36：     '   NEWDATA = 新しいデータの値
 37：     ' 【戻り値】
 38：     '   なし
 39：     Dim objContext As ObjectContext
 40：     Dim objRec As ADODB.Recordset
 41：     Dim userName As String, NowDate As Date
 42：     
 43：     ' オブジェクトコンテキストの取得
 44：     Set objContext = GetObjectContext()
 45：     
 46：     ' エ悼ーハンドラの設定
 47：     On Error GoTo ErrHandle
 48：     
 49：     ' ユーザー名と現在の時刻を取得
 50：     userName = objContext.Security.GetOriginalCallerName()
 51：     NowDate = Now()
 52：     
 53：     ' データベースに接続して，履歴情報を記述する
 54：     Set objRec = CreateObject("ADODB.Recordset")
 55：     objRec.Open "履歴", g_DBConnection, adOpenKeyset, _
   　                 adLockPessimistic, adCmdTable
 56：     
 57：     ' 新しいレコードを追加
 58：     objRec.AddNew
 59：     
 60：     ' レコードにデータを設定
 61：     objRec.Fields("DATE").Value = NowDate
 62：     objRec.Fields("TABLENAME").Value = TABLENAME
 63：     objRec.Fields("FIELDNAME").Value = FIELDNAME
 64：     objRec.Fields("RECORDID").Value = RECORDID
 65：     objRec.Fields("OLDDATA").Value = OLDDATA
 66：     objRec.Fields("NEWDATA").Value = NEWDATA
 67：     objRec.Fields("UPDATEUSER").Value = userName
 68：     
 69：     ' データベースに反映
 70：     objRec.Update
 71：     
 72：     ' データベースとの接続を閉じてレコードセットを解放
 73：     objRec.Close
 74：     Set objRec = Nothing
 75：     
 76：     ' コミットする
 77：     objContext.SetComplete
 78：     
 79：     ' オブジェクトコンテキストの解放
 80：     Set objContext = Nothing
 81：     
 82：     Exit Sub
 83： 
 84： ErrHandle:
 85：     ' エラーハンドラ
 86：     objContext.SetAbort
 87：     Set objContext = Nothing
 88：     Set objRec = Nothing
 89：     
 90：     ' エラーの再発行
 91：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 92： End Sub