advsecu.asp

AspMaker调用的自定义包

<!--##session advsecu##-->
<!--##
If DB.DBDBMSName = "ACCESS" Or DB.DBDBMSName = "MS Jet" Then
	ewCursorLocation = 2
Else
	ewCursorLocation = 3
End If

bUserTable = (PROJ.SecType = "Both" Or PROJ.SecType = "Use Table")
bStaticUserLevel = bUserTable And (Not DB.UseDynamicUserLevel And DB.SecUserLevelFld <> "")
bDynamicUserLevel = bUserTable And (DB.UseDynamicUserLevel And DB.UserLevelTbl <> "" And DB.SecUserLevelFld <> "")
bUserLevel = bStaticUserLevel Or bDynamicUserLevel

' Dynamic User Level
If bDynamicUserLevel Then
	iTblCnt = 0
	For i = 1 to DB.Tables.Count
		Set WRKTABLE = DB.Tables(i)
		If WRKTABLE.TblLoaded And _
			(WRKTABLE.TblName <> DB.UserLevelTbl And WRKTABLE.TblName <> DB.UserLevelPrivTbl) Then
			iTblCnt = iTblCnt + 1
		End If
	Next
	If iTblCnt > 0 Then
##-->
<%
Dim arTableName(<!--##=iTblCnt-1##-->)
<!--##
		iTblCnt = 0
		For i = 1 to DB.Tables.Count
			Set WRKTABLE = DB.Tables(i)
			If WRKTABLE.TblLoaded And _
				(WRKTABLE.TblName <> DB.UserLevelTbl And WRKTABLE.TblName <> DB.UserLevelPrivTbl) Then
				iTblCnt = iTblCnt + 1
##-->
arTableName(<!--##=iTblCnt-1##-->) = "<!--##=WRKTABLE.TblName##-->"
<!--##
			End If
		Next
##-->
%>
<!--##
	End If
End If
##-->
<%
' Advanced User Level Security for ASPMaker 5+

<!--## If bDynamicUserLevel Then ##-->
' Dynamic user level security
' User level definition table/field names
Const ewUsrLvlTbl = "<!--##=Quote(DB.DBQuoteS & DB.UserLevelTbl & DB.DBQuoteE)##-->"
Const ewUsrLvlIdFld = "<!--##=Quote(DB.DBQuoteS & DB.UserLevelIdFld & DB.DBQuoteE)##-->"
Const ewUsrLvlNameFld = "<!--##=Quote(DB.DBQuoteS & DB.UserLevelNameFld & DB.DBQuoteE)##-->"

' User Level privileges table/field names
Const ewUsrLvlPrivTbl = "<!--##=Quote(DB.DBQuoteS & DB.UserLevelPrivTbl & DB.DBQuoteE)##-->"
Const ewUsrLvlPrivTblNameFld = "<!--##=Quote(DB.DBQuoteS & DB.UserLevelPrivTblNameFld & DB.DBQuoteE)##-->"
Const ewUsrLvlPrivUsrLvlIdFld = "<!--##=Quote(DB.DBQuoteS & DB.UserLevelPrivUserLevelFld & DB.DBQuoteE)##-->"
Const ewUsrLvlPrivPrivFld = "<!--##=Quote(DB.DBQuoteS & DB.UserLevelPrivPrivFld & DB.DBQuoteE)##-->"
<!--## End If ##-->

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

<!--## If bStaticUserLevel Then ##-->
' 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 = <!--##=ewCursorLocation##-->
	rs.Fields.Append arFld(0), 3 'adInteger
	rs.Fields.Append arFld(1), 200, 255 'adVarChar
	rs.Open
<!--##
	sDbSec = DB.SecDefault
	arrGroup = Split(sDbSec, ";")
	For i = 0 to UBound(arrGroup)
		arrLvl = Split(arrGroup(i), ",")
		iUserLevelID = arrLvl(0)
		sUserLevelName = DoubleQuote(arrLvl(1), 1)
##-->
	rs.AddNew arFld, Array(<!--##=iUserLevelID##-->, <!--##=sUserLevelName##-->)
<!--##
	Next
##-->
	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 = <!--##=ewCursorLocation##-->
	rs.Fields.Append arFld(0), 200, 255 'adVarChar
	rs.Fields.Append arFld(1), 3 'adInteger
	rs.Fields.Append arFld(2), 3 'adInteger
	rs.Open
<!--##
	For i = 1 to DB.Tables.Count
		Set TABLE = DB.Tables.Seq(i)
		If TABLE.TblGen Then
			sTblName = TABLE.TblName
			sTblSec = TABLE.TblSecurity
			arrGroup = Split(sTblSec, ";")
			For j = 0 to UBound(arrGroup)
				arrLvl = Split(arrGroup(j), ",")
				iUserLevelID = arrLvl(0)
				iUserLevelName = arrLvl(1)
				iUserLevel = arrLvl(2)
##-->
	rs.AddNew arFld, Array("<!--##=sTblName##-->", <!--##=iUserLevelID##-->, <!--##=iUserLevel##-->)
<!--##
			Next
		End If
	Next
##-->
	rs.Update
	rs.MoveFirst
	arUserLevelPriv = rs.GetRows
	rs.Close
	Set rs = Nothing
	' Save the user level to session variable
	SaveUserLevel()
End Sub
<!--## ElseIf bDynamicUserLevel Then ##-->
' Dynamic user level security
' Sub to get current user level settings from database
Sub SetUpUserLevel
	SetUpUserLevelEx(CurrentUserLevel)
	' Save the user level to session variable
	SaveUserLevel()
End Sub

' Sub to get (all) user level settings from database
Sub SetUpUserLevelEx(UserLevel)
	If UserLevel = "" Or IsNull(UserLevel) Or Not IsNumeric(UserLevel) Then Exit Sub
	Dim conn, rs, Sql	
	Set conn = Server.CreateObject("ADODB.Connection")
	conn.Open xDb_Conn_Str
	 ' Get the user level definitions
	Sql = "SELECT " & ewUsrLvlIdFld & ", " & ewUsrLvlNameFld & " FROM " & ewUsrLvlTbl
	If UserLevel >= -1 Then	Sql = Sql & " WHERE " & ewUsrLvlIdFld & "=" & UserLevel
	Set rs = conn.Execute(Sql)
	If Not rs.Eof Then arUserLevel = rs.GetRows
	rs.Close
	Set rs = Nothing
	 ' Get the user level privileges
	Sql = "SELECT " & ewUsrLvlPrivTblNameFld & ", " & ewUsrLvlPrivUsrLvlIdFld & _
		", " & ewUsrLvlPrivPrivFld & " FROM " & ewUsrLvlPrivTbl
	If UserLevel >= -1 Then	Sql = Sql & " WHERE " & ewUsrLvlPrivUsrLvlIdFld & "=" & UserLevel
	Set rs = conn.Execute(Sql)
	If Not rs.Eof Then arUserLevelPriv = rs.GetRows
	rs.Close
	Set rs = Nothing
	conn.Close
	Set conn = Nothing
End Sub
<!--## Else ##-->
' No user level security
Sub SetUpUserLevel
End Sub
<!--## End If ##-->

' 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:<br>"
		Response.Write "UserLevelId, UserLevelName<br>"
		For I = 0 To UBound(arUserLevel, 2)
			Response.Write "&nbsp;&nbsp;" & arUserLevel(0, I) & ", " & _
				arUserLevel(1, I) & "<br>"
		Next
	Else
		Response.Write "No User Level definitions." & "<br>"
	End If
	If IsArray(arUserLevelPriv) Then
		Response.Write "User Level Privs:<br>"
		Response.Write "TableName, UserLevelId, UserLevelPriv<br>"
		For I = 0 To UBound(arUserLevelPriv, 2)
			Response.Write "&nbsp;&nbsp;" & arUserLevelPriv(0, I) & ", " & _
				arUserLevelPriv(1, I) & ", " & arUserLevelPriv(2, I) & "<br>"
		Next
	Else
		Response.Write "No User Level privilege settings." & "<br>"
	End If
	Response.Write "CurrentUserLevel = " & CurrentUserLevel & "<br>"
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

%>
<!--##/session##-->