<%option explicit%> <% '************************************************************************** ' Version 4.50 Version add/delete userids ' adds or updates individual user privileges ' June 6, 2002 '************************************************************************** dim objrec, id, user, msg, admintype, item, d Dim Menuaccess, menulist ShopCheckAdmin "shopa_user_control.asp" sError="" ShopOpenDatabase con If Not Request("submit")="" Then ValidateFields if sError="" then UpdateFields end if End If If Request("Delete")<>"" Then For each item in Request("DeleteUser") d = "delete from tbluser where fldauto = " & item con.Execute(d) Next End If AdminPageHeader Displayform sql = "select * from tbluser" Set objRec = con.Execute(SQL) While Not objRec.EOF id = objrec("fldauto") user = objrec("fldusername") menuaccess=objrec("fldaccess") menulist=convertaccess(menuaccess) FormatMenuRow objRec.MoveNext wend Closerecordset objRec response.write "" response.write "

" Response.write "" response.write "" DisplayForm2 AdminPageTrailer Shopclosedatabase con ' Sub ValidateFields Serror="" if Request("Access")="" then sError= sError & LangAdminRequired & "
" end if if Request("TableAccess")="" then sError= sError & LangAdminTableMissing & "
" end if if Request("UserName")="" then sError= sError & LangAdminUserMissing & "
" end if if Request("Password")="" then sError= sError & LangAdminPasswordMissing & "
" end if admintype=Request("admintype") admintype=ucase(admintype) end sub Sub BuildTableAccess Dim Tables, Tablecount, i GetDatabaseTables Tables, tablecount, con For i=0 to tablecount -1 response.write "" & Tables(i) & "
" next end sub ' Sub BuildTypeAccess %>

<%=LangNormalAdministrator%>

<%=LangRestrictedAdministrator%>

<% end sub Sub UpdateFields Dim Dup, rs, item, access Dim a Dim tablelist dim sqlo dim username,fldauto,rso username=request("Username") dup = "select * from tbluser where fldusername = '" & username & "'" Set rs = con.Execute(dup) If Not rs.EOF Then Serror = LangAdminDuplicate exit sub end if rs.close set rs=nothing sqlo="Insert into tbluser (fldUsername) VALUES('" & request("username") & "')" con.execute(sqlo) sqlo = "select max(fldauto) from tbluser where fldusername='" & username & "'" Set rso = con.Execute(sqlo) fldauto = rso(0) rso.close set rso=nothing 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, "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) 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 DisplayForm If Serror<>"" then Response.write getconfig("xfont") & "" & sError & "" end if Response.write "

" & xfont Response.write "" & LangAdminAdministrators & "

" Response.write "
" Response.write "" Response.write "" Userheader LangAdminUserName UserHeader LangadminMenuAccess Userheader LangCommonedit Userheader LangCommonDelete Response.write "" end sub Sub UserHeader (title) Response.write "" end sub Sub FormatMenuRow response.write "" %> <% end sub Sub Displayform2 %>
" Response.write title response.write "
<%=user%> <%=menulist%> Edit
<%If msg <> "" Then%> <%End If%>
<%=msg%>
<%=LangAddAdmin%>
<%=LangAdminUsername%>
<%=LangAdminPassword%>
<%=LangAdminMenuAccess%>:
<%BuildAccess "0"%> 		<%=LangAdminTableAccess%>:
<%BuildTableAccess%>		 <%=LangAdminType%>
<%BuildTypeAccess%>
<% end sub %>