List 6-140　Business.SlipコンポーネントのDeleteSlipメソッド

  1： Public Sub DeleteSlip(ByVal SlipID As Long)
  2：     ' 指定された伝票を削除する
  3：     ' まだDELETEDFLAGフィールドの値がFalseであればそれをTrueに
  4：     ' Trueであれば伝票のレコードそのものを削除する
  5：     ' 【引数】
  6：     '   SlipID = 削除したい伝票の伝票番号
  7：     Dim objContext As ObjectContext
  8：     Dim objDataSlip As DataObj.Slip
  9：     Dim objDataSlipDetail As DataObj.SlipDetail
 10：     Dim objDataSlipInformation As DataObj.SlipInformation
 11：     Dim old_CUSTOMERID As Variant, old_SUBTOTAL As Variant, old_TAX As Variant
 12：     Dim old_TOTAL As Variant, old_MADEDATE As Variant, old_MADEUSER As Variant
 13：     Dim old_LASTUSER As Variant, old_LASTDATE As Variant
 14：     
 15：     ' オブジェクトコンテキストの取得
 16：     Set objContext = GetObjectContext()
 17：     
 18：     ' エラーハンドラの設定
 19：     On Error GoTo ErrHandle
 20：       
 21：     ' セキュリティ設定が有効であることを確認
 22：     If Not objContext.IsSecurityEnabled() Then
 23：         ' セキュリティ設定が無効
 24：         Err.Raise ERR_NOSECURE, App.Title, _
   　                   "セキュリティ機構が無効です"
 25：     End If
 26：     
 27：     ' DataObj.Slipコンポーネントの実体化
 28：     Set objDataSlip = CreateObject("DataObj.Slip")
 29：     
 30：     ' 伝票の状態が承認ずみよりも進んでいないことを確認
 31：     If objDataSlip.Get_SlipStatus(SlipID) >= SlipStatus.Consented Then
 32：         Err.Raise ERR_CANTDELETE, App.Title, _
   　                   "承認された伝票は削除できません"
 33：     End If
 34：     
 35：     ' 削除されているかどうかを確認
 36：     Select Case objDataSlip.IsDeleted(SlipID)
 37：         Case ID_NotFound
 38：             ' 見つからない
 39：             Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
   　                       "指定された伝票番号を持つ伝票が見つかりません"
 40：         Case ID_Exists
 41：             ' 存在する
 42：             ' DELETEDFLAGフィールドをTRUEにするだけ
 43：             ' その時点の伝票の情報を取得
 44：             objDataSlip.GetRecord_Slip SlipID, old_CUSTOMERID, _
   　                                        old_SUBTOTAL, old_TAX, old_TOTAL, _
   　                                        old_MADEDATE, old_MADEUSER, _
   　                                        old_LASTDATE, old_LASTUSER
 45：             ' 削除する権限があるかどうかを調査
 46：             If objContext.Security.GetOriginalCallerName() <> old_MADEUSER Then
 47：                 If Not (objContext.IsCallerInRole("SalesAdmin") Or _
   　                         objContext.IsCallerInRole("AllAdmin")) Then
 48：                         Err.Raise ERR_NOSECURE, App.Title, _
   　                                   "他人が作成した伝票を削除することはできません"
 49：                 End If
 50：             End If
 51：             
 52：             ' DELETEDFLAGフィールドをTRUEに設定する
 53：             objDataSlip.SetDeletedFlag SlipID, True
 54：         Case ID_Deleted
 55：             ' 削除ずみ
 56：             ' レコードそのものを削除してしまう
 57：             ' 削除する権限があるかどうかを調査
 58：             If Not (objContext.IsCallerInRole("SalesAdmin") Or _
   　                     objContext.IsCallerInRole("AllAdmin")) Then
 59：                 Err.Raise ERR_NOSECURE, App.Title, _
   　                           "削除する権限がありません"
 60：             End If
 61：             
 62：             ' 伝票に付随する伝票追加情報も削除
 63：             Set objDataSlipInformation = CreateObject("DataObj.SlipInformation")
 64：             objDataSlipInformation.DeleteRecord SlipID
 65：             Set objDataSlipInformation = Nothing
 66：             
 67：             ' 伝票に付随する明細情報も削除
 68：             Set objDataSlipDetail = CreateObject("DataObj.SlipDetail")
 69：             objDataSlipDetail.DeleteRecord SlipID
 70：             Set objDataSlipDetail = Nothing
 71：     
 72：             ' レコードそのものを削除する
 73：             objDataSlip.DeleteRecord SlipID
 74：     End Select
 75：     
 76：     ' DataObj.Slipコンポーネントの解放
 77：     Set objDataSlip = Nothing
 78：     
 79：     ' トランザクションのコミット
 80：     objContext.SetComplete
 81：     ' オブジェクトコンテキストの解放
 82：     Set objContext = Nothing
 83：     
 84：     Exit Sub
 85： 
 86： ErrHandle:
 87：     ' エラーハンドラ
 88：     objContext.SetAbort
 89：     Set objContext = Nothing
 90：     Set objDataSlip = Nothing
 91：     Set objDataSlipInformation = Nothing
 92：     Set objDataSlipDetail = Nothing
 93：     
 94：     ' エラーの再発行
 95：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 96： End Sub