List 6-85　BusinessProductコンポーネントのDeleteStorageメソッド

  1： Public Sub DeleteStorage(ByVal StockID As Long)
  2：     ' 指定された入庫予定を削除する
  3：     ' DELETEDFLAGフィールドの値がFalseであればそれをTrueに，
  4：     ' DELETEDFLAGフィールドの値がTrueでありかつProductsAdminロール
  5：     ' またはAllAdminロールに属するユーザーから呼び出されたならば
  6：     ' レコードそのものを削除する
  7：     ' 【引数】
  8：     '   StockID = 削除したいレコードを特定するレコードID（IDフィールドの値）
  9：     ' 【戻り値】
 10：     '   なし
 11：     Dim objContext As ObjectContext
 12：     Dim objDataStock As DataObj.STOCK
 13：     
 14：     
 15：     ' オブジェクトコンテキストの取得
 16：     Set objContext = GetObjectContext()
 17：     
 18：     ' エラーハンドラの設定
 19：     On Error GoTo ErrHandle
 20：     
 21：     ' DataObj.Stockの実体化
 22：     Set objDataStock = CreateObject("DataObj.Stock")
 23：     
 24：     ' 出庫でないことを確認
 25：     If Not objDataStock.InStock(StockID) Then
 26：         Err.Raise BusinessError.ERR_CANTACCESS, App.Title, _
   　                   "出庫予定を操作することはできません"
 27：     End If
 28：     
 29：     ' 施行まえであることを確認
 30：     If objDataStock.IsDue(StockID) <> STOCK_NODUE Then
 31：         Err.Raise BusinessError.ERR_CANTACCESS, App.Title, _
   　                   "指定された入庫予定は存在しないか施行ずみです"
 32：     End If
 33：     
 34：     ' 現在の状態の確認
 35：     If objDataStock.IsDeleted(StockID) = ID_Exists Then
 36：         ' 削除ずみではない
 37：         ' DELETEDFLAGフィールドの値をTrueにするだけ
 38：         objDataStock.SetDeletedFlag StockID, True
 39：     Else
 40：         ' 削除ずみ
 41：         ' ProducsAdminロールか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 ERR_CANTACCESS, App.Title, _
   　                       "削除権限がありません"
 49：         End If
 50：         ' レコードを本当に削除してしまう
 51：         objDataStock.DeleteRecord StockID
 52：     End If
 53：     
 54：     ' DataObj.Stockの解放
 55：     Set objDataStock = Nothing
 56：     
 57：     ' コミットする
 58：     objContext.SetComplete
 59：     
 60：     ' オブジェクトコンテキストの解放
 61：     Set objContext = Nothing
 62：     
 63：     Exit Sub
 64： 
 65： ErrHandle:
 66：     ' エラーハンドラ
 67：     objContext.SetAbort
 68：     Set objContext = Nothing
 69：     Set objDataStock = Nothing
 70：     
 71：     ' エラーの再発行
 72：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 73： End Sub