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