List 6-33 Business.CustomerコンポーネントのDeleteCustomerメソッド
1: Public Sub DeleteCustomer(ByVal ID As Long)
2: ' 指定された顧客番号をもつ顧客を削除する
3: ' DELETEDFLAGフィールドがFalseであればそれをTrueに
4: ' DELETEDFLAGフィールドがTrueでありかつSalesAdminロール
5: ' またはAllAdminロールに属するユーザーから呼び出されたならば
6: ' レコードそのものを削除する
7: ' 【引数】
8: ' ID = 削除したい顧客を特定する顧客番号を指定する
9: ' 【戻り値】
10: ' なし
11: Dim objContext As ObjectContext
12: Dim objDataCustomer As DataObj.Customer
13: Dim objDataBill As DataObj.Bill
14: Dim objDataSlip As DataObj.Slip
15:
16: ' オブジェクトコンテキストの取得
17: Set objContext = GetObjectContext()
18:
19: ' エラーハンドラの設定
20: On Error GoTo ErrHandle
21:
22: ' DataObj.Customer,Bill,Slipの実体化
23: Set objDataCustomer = CreateObject("DataObj.Customer")
24: Set objDataBill = CreateObject("DataObj.Bill")
25: Set objDataSlip = CreateObject("DataObj.Slip")
26:
27: ' 削除対象となる顧客が伝票ならびに請求書で使われていないことを確認
28: If objDataBill.IsExistsCustomer(ID) Or _
objDataSlip.IsExistsCustomer(ID) Then
29: ' 存在している
30: Err.Raise Err_CANTDELETE, App.Title, _
"伝票か請求書が存在するため削除できません"
31: End If
32:
33: ' 現在の顧客の状態を確認
34: Select Case objDataCustomer.IsDeleted(ID)
35: Case ID_Exists
36: ' 存在する
37: ' DELETEDFLAGフィールドの値をTrueにするだけ
38: objDataCustomer.SetDeletedFlag ID, True
39: Case ID_Deleted
40: ' 削除ずみ
41: ' SalesAdminロールかAllAdminロールに属していることを確認
42: If Not objContext.IsSecurityEnabled() Then
43: Err.Raise Err_NOSECURE, App.Title, _
"セキュリティ機構が無効です"
44: End If
45: ' SalesAdminロールまたはAllAdminロールに属しているか
46: If Not (objContext.IsCallerInRole("SalesAdmin") Or _
objContext.IsCallerInRole("AllAdmin")) Then
47: ' 属していない
48: Err.Raise Err_CANTACCESS, App.Title, _
"削除権限がありません"
49: End If
50: ' レコードを本当に削除してしまう
51: objDataCustomer.DeleteRecord ID
52: Case ID_NotFound
53: ' 存在しない
54: Err.Raise DataObj.Err_NotFound, App.Title, _
"指定された顧客番号をもつ顧客が見つかりません"
55: End Select
56:
57: ' DataObj.Customer,Bill,Slipの解放
58: Set objDataSlip = Nothing
59: Set objDataBill = Nothing
60: Set objDataCustomer = 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 objDataCustomer = Nothing
75: Set objDataBill = Nothing
76: Set objDataSlip = Nothing
77:
78: ' エラーの再発行
79: Err.Raise Err.Number, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
80: End Sub