List 6-65　Business.ProductコンポーネントのDeleteProductメソッド

  1： Public Sub DeleteProduct(ByVal ProductID As Long)
  2：     ' 指定された製品番号を持つ製品を削除する
  3：     ' 指定された製品を示すレコードのDELETEDFLAGフィールドの値が
  4：     '   FalseであればそれをTrueに
  5：     '   TrueでありかつProductsAdminロールまたはAllAdminロールに属する
  6：     '       ユーザーから呼び出されたならばレコードそのものを削除する
  7：     ' 【引数】
  8：     '   ProductID = 削除したい製品を特定する製品番号を指定する
  9：     ' 【戻り値】
 10：     '   なし
 11：     Dim objContext As ObjectContext
 12：     Dim objDataProduct As DataObj.Product
 13：     Dim objDataStock As DataObj.STOCK
 14：     Dim objDataSlipDetail As DataObj.SlipDetail
 15：     
 16：     ' オブジェクトコンテキストの取得
 17：     Set objContext = GetObjectContext()
 18：     
 19：     ' エラーハンドラの設定
 20：     On Error GoTo ErrHandle
 21：     
 22：     ' DataObj.Product，Stock，SlipDetailの実体化
 23：     Set objDataProduct = CreateObject("DataObj.Product")
 24：     Set objDataStock = CreateObject("DataObj.Stock")
 25：     Set objDataSlipDetail = CreateObject("DataObj.SlipDetail")
 26：     
 27：     ' 削除対象となる製品が在庫情報ならびに明細情報で使われていないことを確認
 28：     If objDataStock.IsExistsProduct(ProductID) Or _
   　          objDataSlipDetail.IsExistsProduct(ProductID) Then
 29：         ' 使われている
 30：         Err.Raise BusinessError.ERR_CANTACCESS, App.Title, _
   　                   "在庫か伝票明細が存在するため削除できません"
 31：     End If
 32：     
 33：     ' 現在の製品の状態を確認
 34：     Select Case objDataProduct.IsDeleted(ProductID)
 35：         Case ID_Exists
 36：             ' 存在する
 37：             ' DELETEDFLAGフィールドの値をTrueにするだけ
 38：             objDataProduct.SetDeletedFlag ProductID, True
 39：         Case ID_Deleted
 40：             ' 削除ずみ
 41：             ' ProductsAdminロールかAllAdminロールに属していることを確認
 42：             If Not objContext.IsSecurityEnabled() Then
 43：                 Err.Raise BusinessError.ERR_NOSECURE, App.Title, _
   　                           "セキュリティ機構が無効です"
 44：             End If
 45：             ' ProductsAdminロールまたはAllAdminロールに属していることを確認
 46：             If Not (objContext.IsCallerInRole("ProductsAdmin") Or _
   　                       objContext.IsCallerInRole("AllAdmin")) Then
 47：                 ' 属していない
 48：                 Err.Raise BusinessError.ERR_CANTACCESS, App.Title, _
   　                           "削除権限がありません"
 49：             End If
 50：             ' レコードを本当に削除してしまう
 51：             objDataProduct.DeleteRecord ProductID
 52：         Case ID_NotFound
 53：             ' 存在しない
 54：             Err.Raise Errorcode.Err_NotFound, App.Title, _
   　                       "指定された製品番号を持つ製品が見つかりません"
 55：     End Select
 56：     
 57：     ' DataObj.Product，Stock，SlipDetailの解放
 58：     Set objDataSlipDetail = Nothing
 59：     Set objDataStock = Nothing
 60：     Set objDataProduct = Nothing
 61：     
 62：     ' コミットする
 63：     objContext.SetComplete
 64：     
 65：     ' オブジェクトコンテキストの解放
 66：     Set objContext = Nothing
 67：     
 68：     Exit Sub
 69： 
 70： ErrHandle:
 71：     ' エラーハンドラ
 72：     objContext.SetAbort
 73：     Set objContext = Nothing
 74：     Set objDataProduct = Nothing
 75：     Set objDataStock = Nothing
 76：     Set objDataSlipDetail = Nothing
 77：     
 78：     ' エラーの再発行
 79：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 80： End Sub