List 6-199 Business.UtilityコンポーネントのGetUserInRoleメソッド
1: Public Function GetUserInRole() As USERROLE
2: ' このメソッドを呼び出したユーザーが
3: ' どのロールに属するのかを返す
4: Dim objContext As ObjectContext
5: Dim retVal As USERROLE
6:
7: ' オブジェクトコンテキストの取得
8: Set objContext = GetObjectContext()
9:
10: ' エラーハンドラの設定
11: On Error GoTo ErrHandle
12:
13: retVal = 0
14: With objContext
15: If .IsCallerInRole("Sales") Then
16: retVal = retVal Or ROLE_SALES
17: End If
18: If .IsCallerInRole("SalesManager") Then
19: retVal = retVal Or ROLE_SALESMANAGER
20: End If
21: If .IsCallerInRole("Products") Then
22: retVal = retVal Or ROLE_PRODUCTS
23: End If
24: If .IsCallerInRole("Accounting") Then
25: retVal = retVal Or ROLE_ACCOUNTING
26: End If
27: If .IsCallerInRole("SalesAdmin") Then
28: retVal = retVal Or ROLE_SALESADMIN
29: End If
30: If .IsCallerInRole("ProductsAdmin") Then
31: retVal = retVal Or ROLE_PRODUCTSADMIN
32: End If
33: If .IsCallerInRole("AccountingAdmin") Then
34: retVal = retVal Or ROLE_ACCOUNTINGADMIN
35: End If
36: If .IsCallerInRole("ALLADMIN") Then
37: retVal = retVal Or ROLE_ALLADMIN
38: End If
39: End With
40:
41: GetUserInRole = retVal
42:
43: objContext.SetComplete
44:
45: Set objContext = Nothing
46:
47: Exit Function
48:
49: ErrHandle:
50: ' エラーハンドラ
51: objContext.SetAbort
52: Set objContext = Nothing
53:
54: ' エラーの再発行
55: Err.Raise Err.Number, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
56: End Function