<%option explicit%>
<%ShopCheckAdmin "shopa_user_control.asp"
'*********************************************************
' VP-ASP Version 5.00
' Edit user priviliges
' Jan 5, 2003
'**********************************************************
Dim objrec, temp
Dim a, TableList
Dim Tables, Tablecount, CurrentTables, CurrentCount
ShopOpenDatabase con
If Request("change")<>"" Then
UpdateUserRecord
response.redirect "shopa_user_control.asp"
End If
AdminPageHeader
sql = "select * from tbluser where fldauto=" & cint(request.querystring("id"))
Set objRec = con.Execute(SQL)
%>
<%
objREc.Close
set objrec=nothing
ShopCloseDatabase con
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
For i=0 to tablecount -1
LocateTable tables(i),rc
If rc=0 then
response.write "" & Tables(i) & " " & vbcrlf
else
response.write "" & Tables(i) & " " & vbcrlf
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")
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
tablelist = Right(a,Len(a)-1)
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
%>