<%
' Advanced User Level Security for ASPMaker 5+
Const ewAllowAdd = 1
Const ewAllowDelete = 2
Const ewAllowEdit = 4
Const ewAllowView = 8
Const ewAllowList = 8
Const ewAllowReport = 8
Const ewAllowSearch = 8
Const ewAllowAdmin = 16
Dim arUserLevel ' User Level definitions
Dim arUserLevelPriv ' User Level privileges
' Define User Level Variables
Dim ewCurLvl ' Current user level
ewCurLvl = CurrentUserLevel()
Dim ewCurSec
' Static user level security
'-------------------------------------------------------------------------------
' Function SetUpUserLevel
' ...
Sub SetUpUserLevel
'On Error Resume Next
Dim rs, arFld
' User Level definitions
arFld = Array("Id", "Name")
Set rs = Server.CreateObject("ADODB.RecordSet")
rs.CursorLocation = 2
rs.Fields.Append arFld(0), 3 'adInteger
rs.Fields.Append arFld(1), 200, 255 'adVarChar
rs.Open
rs.AddNew arFld, Array(0, "Anonymous")
rs.AddNew arFld, Array(1, "dataentry")
rs.AddNew arFld, Array(2, "user")
rs.Update
rs.MoveFirst
arUserLevel = rs.GetRows
rs.Close
Set rs = Nothing
' User Level privileges
arFld = Array("TblName", "UserLevelId", "Priv")
Set rs = Server.CreateObject("ADODB.RecordSet")
rs.CursorLocation = 2
rs.Fields.Append arFld(0), 200, 255 'adVarChar
rs.Fields.Append arFld(1), 3 'adInteger
rs.Fields.Append arFld(2), 3 'adInteger
rs.Open
rs.AddNew arFld, Array("Cuentas", 0, 0)
rs.AddNew arFld, Array("Cuentas", 1, 13)
rs.AddNew arFld, Array("Cuentas", 2, 0)
rs.AddNew arFld, Array("Usuarios", 0, 0)
rs.AddNew arFld, Array("Usuarios", 1, 0)
rs.AddNew arFld, Array("Usuarios", 2, 0)
rs.AddNew arFld, Array("Vendedoras", 0, 0)
rs.AddNew arFld, Array("Vendedoras", 1, 13)
rs.AddNew arFld, Array("Vendedoras", 2, 0)
rs.AddNew arFld, Array("CuentasFM", 0, 0)
rs.AddNew arFld, Array("CuentasFM", 1, 0)
rs.AddNew arFld, Array("CuentasFM", 2, 8)
rs.AddNew arFld, Array("UserLevels", 0, 0)
rs.AddNew arFld, Array("UserLevels", 1, 0)
rs.AddNew arFld, Array("UserLevels", 2, 0)
rs.Update
rs.MoveFirst
arUserLevelPriv = rs.GetRows
rs.Close
Set rs = Nothing
' Save the user level to session variable
SaveUserLevel()
End Sub
' Get current user privilege
Function CurrentUserLevelPriv(TableName)
CurrentUserLevelPriv = GetUserLevelPrivEx(TableName, CurrentUserLevel)
End Function
' Get anonymous user privilege
Function GetAnonymousPriv(TableName)
GetAnonymousPriv = GetUserLevelPrivEx(TableName, 0)
End Function
' Get user privilege based on table name and user level
Function GetUserLevelPrivEx(TableName, UserLevel)
GetUserLevelPrivEx = 0
If CStr(UserLevel) = "-1" Then ' System Administrator
GetUserLevelPrivEx = 31
ElseIf UserLevel >= 0 Then
If IsArray(arUserLevelPriv) Then
Dim I
For I = 0 to UBound(arUserLevelPriv, 2)
If CStr(arUserLevelPriv(0, I)) = CStr(TableName) And _
CStr(arUserLevelPriv(1, I)) = CStr(UserLevel) Then
GetUserLevelPrivEx = arUserLevelPriv(2, I)
If IsNull(GetUserLevelPrivEx) Then GetUserLevelPrivEx = 0
If Not IsNumeric(GetUserLevelPrivEx) Then GetUserLevelPrivEx = 0
GetUserLevelPrivEx = CLng(GetUserLevelPrivEx)
Exit For
End If
Next
End If
End If
End Function
' Get current user level name
Function CurrentUserLevelName
GetUserLevelName(CurrentUserLevel)
End Function
' Get user level name based on user level
Function GetUserLevelName(UserLevel)
GetUserLevelName = ""
If CStr(UserLevel) = "-1" Then
GetUserLevelName = "Administrator"
ElseIf UserLevel >= 0 Then
If IsArray(arUserLevel) Then
Dim I
For I = 0 to UBound(arUserLevel, 2)
If CStr(arUserLevel(0, I)) = CStr(UserLevel) Then
GetUserLevelName = arUserLevel(1, I)
Exit For
End If
Next
End If
End If
End Function
' Sub to display all the User Level settings (for debug only)
Sub ShowUserLevelInfo
Dim I
If IsArray(arUserLevel) Then
Response.Write "User Levels:
"
Response.Write "UserLevelId, UserLevelName
"
For I = 0 To UBound(arUserLevel, 2)
Response.Write " " & arUserLevel(0, I) & ", " & _
arUserLevel(1, I) & "
"
Next
Else
Response.Write "No User Level definitions." & "
"
End If
If IsArray(arUserLevelPriv) Then
Response.Write "User Level Privs:
"
Response.Write "TableName, UserLevelId, UserLevelPriv
"
For I = 0 To UBound(arUserLevelPriv, 2)
Response.Write " " & arUserLevelPriv(0, I) & ", " & _
arUserLevelPriv(1, I) & ", " & arUserLevelPriv(2, I) & "
"
Next
Else
Response.Write "No User Level privilege settings." & "
"
End If
Response.Write "CurrentUserLevel = " & CurrentUserLevel & "
"
End Sub
' Function to check privilege for List page (for menu items)
Function AllowList(TableName)
AllowList = CBool(CurrentUserLevelPriv(TableName) And ewAllowList)
End Function
' Get current user name from session
Function CurrentUserName
CurrentUserName = Session(ewSessionUserName) & ""
End Function
' Get current user id from session
Function CurrentUserID
CurrentUserID = Session(ewSessionUserID) & ""
End Function
' Get current parent user id from session
Function CurrentParentUserID
CurrentParentUserID = Session(ewSessionParentUserID) & ""
End Function
' Get current user level from session
Function CurrentUserLevel
If IsLoggedIn Then
CurrentUserLevel = Session(ewSessionUserLevel)
Else
CurrentUserLevel = 0 ' Anonymous if not logged in
End If
End Function
' Check if user is logged in
Function IsLoggedIn
IsLoggedIn = (Session(ewSessionStatus) = "login")
End Function
' Check if user is system administrator
Function IsSysAdmin
IsSysAdmin = (Session(ewSessionSysAdmin) = 1)
End Function
' Save user level to session
Sub SaveUserLevel
Session(ewSessionArUserLevel) = arUserLevel
Session(ewSessionArUserLevelPriv) = arUserLevelPriv
End Sub
' Load user level from session
Sub LoadUserLevel
If Not IsArray(Session(ewSessionArUserLevel)) Then
SetupUserLevel
SaveUserLevel
End If
arUserLevel = Session(ewSessionArUserLevel)
arUserLevelPriv = Session(ewSessionArUserLevelPriv)
End Sub
%>