<%option explicit%> <% '************************************************************************** ' Version 5.00 Version add/delete userids ' adds or updates individual user privileges ' May 16, 2003 '************************************************************************** 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 & getlang("LangAdminRequired") & "
" end if if Request("TableAccess")="" then sError= sError & getlang("LangAdminTableMissing") & "
" end if if Request("UserName")="" then sError= sError & getlang("LangAdminUserMissing") & "
" end if if Request("Password")="" then sError= sError & getlang("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 %>

<%=getlang("LangNormalAdministrator")%>

<%=getlang("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 = getlang("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 shopwriteerror sError end if shopwriteheader getlang("LangAdminAdministrators") Response.write "

" Response.write "" Response.write reportheadrow Userheader getlang("LangAdminUserName") UserHeader getlang("LangadminMenuAccess") Userheader getlang("LangCommonedit") Userheader getlang("LangCommonDelete") Response.write reportrowend end sub Sub UserHeader (title) Response.write reportheadcolumn Response.write title response.write ReportHeadColumnEnd end sub Sub FormatMenuRow response.write ReportDetailRow response.write ReportDetailColumn Response.write user response.write ReportDetailColumnend response.write ReportDetailColumn response.write menulist response.write ReportDetailColumnend response.write ReportDetailColumn %> <%=getlang("Langcommonedit")%> <% response.write ReportDetailColumnend response.write ReportDetailColumn %> <% response.write ReportDetailColumnend response.write ReportRowEnd end sub Sub Displayform2 %>

<%If msg <> "" Then%> <%End If%>

<%=msg%>
<% shopwriteheader getlang("LangAddAdmin") %>
<%=getlang("LangAdminUsername")%>
<%=getlang("LangAdminPassword")%>
<%=getlang("LangAdminMenuAccess")%> <%BuildAccess "0"%>	<%=getlang("LangAdminTableAccess")%> <%BuildTableAccess%>	<%=getlang("LangAdminType")%> <%BuildTypeAccess%>
" name="submit">

<% end sub Function ConvertAccess(list) dim objrec2, ac, temp, name on error resume next temp = "select * from tblaccess where fldauto in (" & list & ")" Set objRec2 = con.Execute(temp) Do while objRec2.EOF <> True name = name & objrec2("fldname") & ", " objRec2.MoveNext Loop objrec2.close set objrec2=nothing If name <> "" Then ConvertAccess = Left(name,Len(name)-2) End If End Function %>