将以下代码粘贴到 Main.mdb 的 basRDPRef模块中：
Public Function HasPermission(ByVal ModuleName As String, _
Optional ByVal FunctionName As String _
) As Boolean
On Error GoTo ErrorHandler
Dim strRoleID As String
Dim lngModuleID As Long
Dim lngFunctionID As Long
Dim strModuleName As String
Dim strFunctionName As String
Dim strMessage As String
Dim blnNoControl As Boolean
Dim strWhere As String
HasPermission = False
strModuleName = "'" & Replace(ModuleName, "'", "''") & "'"
lngModuleID = Nz(DLookup("ModuleID", "SysLocalModules", "ModuleName=" & strModuleName), 0)
If lngModuleID = 0 Then
strMessage = LoadString("Permission module | is not defined, control does not effective.")
strMessage = Replace(strMessage, "|", ModuleName)
MsgBoxEx strMessage, vbCritical
Exit Function
End If
If GetParameter("Use Developer Identity Login", dbBoolean, False) Then
HasPermission = True
Exit Function
End If
If ACount("*", "Sys_Roles") < 2 Then
HasPermission = True
Exit Function
End If
strRoleID = GetParameter("Current User Role ID", dbLong, "")
If Not ACount("*", "Sys_ModulePermissions", "RoleID=" & strRoleID & " AND ModuleID=" & lngModuleID) > 0 Then
Exit Function
End If
If Len(FunctionName) = 0 Then
Exit Function
End If
strFunctionName = "'" & Replace(FunctionName, "'", "''") & "'"
lngFunctionID = Nz(DLookup("FunctionID", "SysLocalFunctions", "FunctionName=" & strFunctionName), 0)
If lngFunctionID = 0 Then
strMessage = LoadString("Permission item |2| in |1| is not defined, control does not effective.")
strMessage = Replace(strMessage, "|1|", ModuleName)
strMessage = Replace(strMessage, "|2|", FunctionName)
MsgBoxEx strMessage, vbCritical
Exit Function
End If
If ACount("*", "Sys_FunctionPermissions", "RoleID=" & strRoleID & " AND FunctionID=" & lngFunctionID) > 0 Then
HasPermission = True
End If
ExitHere:
Exit Function
ErrorHandler:
MsgBoxEx Err.Description, vbCritical
Resume ExitHere
End Function
