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