<%option explicit%>
<%ShopCheckAdmin "shopa_user_control.asp"
'*********************************************************
' VP-ASP Version 6.50
' Edit user priviliges
' April 9, 2004
'**********************************************************
Dim objrec, temp
Dim a, TableList
Dim Tables, Tablecount, CurrentTables, CurrentCount
'VP-ASP 6.00 - Allow tables from split databases to be selected
dim affcon, custcon, ordercon, productcon, projectcon, searchcon
ShopOpenDatabase con
'VP-ASP 6.00 - Allow tables from split databases to be selected
if getconfig("xaffiliatedb") > "" then
OpenAffiliateDB affcon
end if
if getconfig("xcustomerdb") > "" then
OpenCustomerDB custcon
end if
if getconfig("xorderdb") > "" then
OpenOrderDB ordercon
end if
if getconfig("xproductdb") > "" then
ShopOpenDatabaseP productcon
end if
if getconfig("xprojectdb") > "" then
ShopOpenOtherDB projectcon, getconfig("xprojectDb")
end if
if getconfig("xsearchdb") > "" then
ShopOpenOtherDB searchcon, getconfig("xSearchDb")
end if
If Request("change")<>"" Then
UpdateUserRecord
responseredirect "shopa_user_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)
Set objRec = con.Execute(SQL)
%>
<%GenerateDisplayHeader getlang("LangUserChange")
GenerateDisplayBodyHeader%>
<%
GenerateDisplayBodyFooter
objREc.Close
set objrec=nothing
ShopCloseDatabase con
'VP-ASP 6.00 - Allow tables from split databases to be selected
if getconfig("xaffiliatedb") > "" then
ShopCloseDatabase affcon
end if
if getconfig("xcustomerdb") > "" then
ShopCloseDatabase custcon
end if
if getconfig("xorderdb") > "" then
ShopCloseDatabase ordercon
end if
if getconfig("xproductdb") > "" then
ShopCloseDatabase productcon
end if
if getconfig("xprojectdb") > "" then
ShopCloseDatabase projectcon
end if
if getconfig("xsearchdb") > "" then
ShopCloseDatabase searchcon
end if
gethelp
AdminPageTrailer
'
Sub BuildTableAccess
dim i, rc
temp=objrec("tablesallowed")
if isNull(temp) then
temp=""
end if
CurrentTables= Split(temp,",")
CurrentCount=ubound(CurrentTables)
GetDatabaseTables Tables, tablecount, con
'VP-ASP 6.00 - Allow tables from split databases to be selected
if getconfig("xaffiliatedb") > "" then
GetDatabaseTablesPlus Tables, tablecount, affcon
end if
if getconfig("xcustomerdb") > "" then
GetDatabaseTablesPlus Tables, tablecount, custcon
end if
if getconfig("xorderdb") > "" then
GetDatabaseTablesPlus Tables, tablecount, ordercon
end if
if getconfig("xproductdb") > "" then
GetDatabaseTablesPlus Tables, tablecount, productcon
end if
if getconfig("xprojectdb") > "" then
GetDatabaseTablesPlus Tables, tablecount, projectcon
end if
if getconfig("xsearchdb") > "" then
GetDatabaseTablesPlus Tables, tablecount, searchcon
end if
For i=0 to tablecount -1
if lcase(tables(i)) <> "ups_config" then
LocateTable tables(i),rc
If rc=0 then
response.write "" & Tables(i) & " " & vbcrlf
else
response.write "" & Tables(i) & " " & vbcrlf
end if
end if
next
end sub
Sub LocateTable (tablename, rc)
'on error resume next
dim i
rc=4
if CurrentCount=0 then
If tablename=CurrentTables(0) then
rc=0
exit sub
else
exit sub
end if
end if
for i = 0 to CurrentCount
if ucase(tablename)=ucase(CurrentTables(i)) then
rc=0
exit sub
end if
next
rc=4
end sub
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
For each item in request("Access")
a = a & "," & item
Next
access = Right(a,Len(a)-1)
a=""
for each item in Request("TableAccess")
a = a & "," & item
next
'VP-ASP 6.50 - if admin not allowed any menu items this was erroring
if len(a) > 0 then
tablelist = Right(a,Len(a)-1)
else
tablelist = ""
end if
sqlo=""
updateaafield sqlo, "fldusername",request("username")
updateaafield sqlo, "fldpassword",request("password")
updateaafield sqlo, "fldaccess",access
updateaafield sqlo, "tablesallowed",tablelist
updateaafield sqlo, "admintype",request("admintype")
sqlo="update tbluser " & sqlo & " 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
Sub BuildTypeAccess
Dim admintype
Dim Checked
admintype=objRec("Admintype")
if isnull(admintype) then
Checked=" Checked "
else
if admintype="SUPER" Then
Checked=" Checked "
end if
end if
%>
name="admintype">
<%=getlang("LangNormalAdministrator")%>
<%
If checked="" then
Checked=" Checked "
else
Checked=""
end if
%>
<%
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("fldaccess")
If isnull(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 tblaccess 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
%>