<%option explicit%>
<%ShopCheckAdmin "shopa_shortcut_control.asp"
'*********************************************************
' VP-ASP Version 6.50
' Add shortcuts to administration
' November 23 2006
'**********************************************************
Dim objrec, temp
shopopendatabase con
If Request("change")<>"" Then
UpdateUserRecord
shopclosedatabase con
responseredirect "shopa_shortcut_control.asp"
End If
AdminPageHeader
'VP-ASP 6.09 - Precautionary Security Fix
dim fldautoid
fldautoid = request.querystring("id")
if fldautoid > "" then
if not isNumeric(fldautoid) then
shoperror "User ID is not numeric"
end if
end if
sql = "select * from tbluser where fldauto=" & cint(fldautoid)
if UCASE(getsess("admintype")) <> "SUPER" then
sql = sql & " AND fldusername = '" & getsess("Shopadmin") & "'"
end if
Set objRec = con.Execute(SQL)
if objrec.eof then
shopwriteerror "No admin user selected for editing.
Go Back"
closerecordset objrec
shopclosedatabase con
AdminPageTrailer
response.end
end if
%>
<%GenerateDisplayHeader "Change User Shortcuts"
GenerateDisplayBodyHeader%>
<%
GenerateDisplayBodyFooter
objREc.Close
set objrec=nothing
ShopCloseDatabase con
gethelp
shopclosedatabase con
AdminPageTrailer
Sub UpdateUserRecord
dim item, access, fldauto,sqlo
fldauto=request("id")
'VP-ASP 6.09 - Precautionary Security Fix
if fldauto > "" then
if not isNumeric(fldauto) then
shoperror "ID is not numeric"
end if
end if
dim a, tablelist
For each item in request("Access")
a = a & "," & item
Next
if a = "" then
else
access = Right(a,Len(a)-1)
a=""
for each item in Request("TableAccess")
a = a & "," & item
next
if len(a) > 0 then
tablelist = Right(a,Len(a)-1)
else
tablelist = ""
end if
end if
sqlo=""
sqlo="update tbluser set shortcut ='" & request("access") & "' where fldauto=" & fldauto
con.execute(sqlo)
shopClosedatabase con
end Sub
Sub UpdateAAField (isql,fieldname,fieldvalue)
'on error resume next
if fieldvalue="" then
exit sub
end if
If getconfig("xdebug")="Yes" then
Debugwrite fieldname & " " & fieldvalue & " "
end if
if isql="" then
isql="SET "
else
isql=isql &","
end if
isql=isql & fieldname & "='" & fieldvalue & "'"
end Sub
'--- Build Access control table for user
Sub BuildAccess(id)
Dim objrec3, objrec2, ba, temp
dim tempname
Dim accessarray(100), accesslist, accesscount, accessfound, accessid,i
ba = "select * from tbluser where fldauto = " & id
Set objRec2 = con.Execute(ba)
If Objrec2.eof then
Accesscount=0
else
AccessList=objrec2("shortcut")
If isnull(AccessList) or Accesslist = "" then
accesscount=0
else
parserecord accesslist,accessarray, accesscount,","
for i = 0 to accesscount-1
accessarray(i)=clng(accessarray(i))
next
end if
end if
objrec2.close
set objrec2=nothing
temp = "select * from tbluser WHERE fldauto = " & id
Set objRec3 = con.Execute(temp)
temp = "select * from tblaccess WHERE fldauto IN (" & objrec3("fldaccess") & ") order by fldauto"
Set objRec3 = con.Execute(temp)
While Not objRec3.EOF
accessfound=false
accessid=objrec3("fldauto")
for i=0 to accesscount-1
if accessid=accessarray(i) then
accessfound=True
exit for
end if
next
tempname=objrec3("fldname")
convertlangname tempname
If accessfound=True then
response.write "" & tempname & " "
Else
response.write "" & tempname & " "
End If
objRec3.MoveNext
Wend
objrec3.close
set objrec3=nothing
End Sub
%>