<%option explicit%> <% shopcheckadmin "shopa_config.asp" '*************************************************** ' VPASP 6.50 has My company as its own edit facility ' group=xxxx display group of fields ' topic=description of group ' Feb 24, 2004 use Configsystem '*************************************************** dim fields(500),defaults(500),captions(500), values(500),fieldcount, defaultcount, helpTexts(500) dim fieldsyesno(500) dim valuecount dim dbc valuecount=0 Dim sAction, dbtable dim configfields dim configtopic, configgroup Dim YesNos, YesNoCount Yesnos=array("Yes","No") Yesnocount=2 Setsess "currenturl","shopa_configsystem.asp" GetConfigType sAction=Request("Action") if saction="" then saction=request("Action.x") end if If sAction = "" Then AdminPageHeader ConfigGetDefaultvalues ConfigDisplayForm AdminPageTrailer Else ConfigValidateData() if sError = "" Then ConfigUpdateRecord ConfigWriteInfo else AdminPageHeader ConfigDisplayForm AddminPageTrailer end if end if ' Sub GetConfigType configgroup=request("group") configtopic=request("topic") end sub Sub ConfigValidatedata sError="" dim i, field, suffix, suffixl, partname suffix="_yesno" suffixl=len(suffix) i=0 for each field in request.form If Ucase(field)="TYPE" or ucase(field)="TOPIC" or ucase(field)="ACTION" then else partname=right(field,suffixl) If partname<>suffix then fields(i)=field values(i)=request(fields(i)) FieldsYesno(i)=request(fields(i) & suffix) 'debugwrite field & " " & values(i) & "yesno=" & fieldsyesno(i) i=i+1 end if end if next fieldcount=i 'debugwrite "fieldcount=" & fieldcount end sub Sub ConfigUpdateRecord dim strsql, sqlo,i shopopendatabase dbc for i = 0 to fieldcount-1 ConfigUpdatefield i next Shopclosedatabase dbc end sub ' Sub ConfigUpdatefield (i) dim usql dim fieldname, fieldvalue fieldname=fields(i) fieldvalue=values(i) If fieldvalue="" then fieldvalue="NULL" else Fieldvalue=replace(fieldvalue,"'","''") fieldvalue="'" & fieldvalue & "'" end if usql="update " & xconfigtable & " set fieldvalue=" & fieldvalue usql=usql & " where fieldname='" & fieldname & "'" 'debugwrite usql dbc.execute(usql) end sub Sub ConfigDisplayForm %>

<%shopwriteheader "Shop Configuration"%>

<%If serror<>"" then response.write errorfontstart & serror & errorfontend end if %>

<%If serror<>"" then if getsess("configtab") = "settings" then response.write "Back to Config" else response.write "Back to Config" end if exit sub end if %>
<% if configtopic > "" then GenerateDisplayHeader configtopic elseif request("keyword") > "" then GenerateDisplayHeader "Search: " & request("keyword") else GenerateDisplayHeader "" end if GenerateDisplayBodyHeader%> " method="post" id="Formadmin" name="Formadmin"> <%dim i for i = 0 to fieldcount-1 ConfigDisplayrow i next %>

<% If Getconfig("xbuttoncontinue")="" then %>

"> <%else%> "> <%end if If getconfig("xbuttonreset")="" then response.write "
" else Response.Write("") end if response.write "

" if getsess("configtab") = "settings" then response.write "Back to Config" else response.write "Back to Config" end if AddSpecialLinks GenerateDisplayBodyFooter GetHelp end sub Sub ConfigDisplayRow (i) dim fieldname, caption, mydefault, Yesnotype, helpText dim srowcolor fieldname=fields(i) caption=fields(i) mydefault=values(i) YesnoType=FieldsYesNo(i) helpText=helpTexts(i) dim rc %> <%=caption%> <% Handlespecialfields rc, fieldname,mydefault If rc<>0 then If YesnoType="1" then GenerateSelectNV YesNos,mydefault,fieldname, YesnoCount,"" else %><% end if end if %> <%=helpText%>

<% end sub Sub ConfigWriteinfo dim msg dim initname If getconfig("xautoloadconfiguration")="Yes" then initname="init" & "_" & xshopid application(initname)="" LoadApplicationVariables msg=server.urlencode(getlang("langAdminreloaded") & " - " & xshopid) response.redirect "shopa_config.asp?msg=" & msg end if responseredirect "shopa_config.asp" end sub ' Sub ConfigGetDefaultvalues dim csql,i,rs,Yesno, searchfield shopopendatabase dbc if ucase(configgroup)<>"SEARCH" then if getconfig("xnewconfigmode") = "Yes" then csql="select * from " & xconfigtable & " where fieldgroup2='" & configgroup & "'" if getconfig("xshowhiddenconfig") = "No" then 'AND getsess("admintype")<>"SUPER" then csql=csql & " and ((showfield = 'Yes') OR (showfield IS NULL) OR (showfield = ''))" end if csql=csql & " order by fieldname" else csql="select * from " & xconfigtable & " where fieldgroup='" & configgroup & "'" if getconfig("xshowhiddenconfig") = "No" then ' AND getsess("admintype")<>"SUPER" then csql=csql & " and ((showfield = 'Yes') OR (showfield IS NULL) OR (showfield = ''))" end if csql=csql & " order by fieldname" end if else 'VP-ASP 6.50 - add trim to keyword searchfield=trim(replace(request("keyword"),"'","''")) csql="select * from " & xconfigtable & " where fieldname LIKE '%" & searchfield & "%'" if getconfig("xshowhiddenconfig") = "No" then 'AND getsess("admintype")<>"SUPER" then csql=csql & " and ((showfield = 'Yes') OR (showfield IS NULL) OR (showfield = ''))" end if csql=csql & " order by fieldname" 'debugwrite csql end if set rs=dbc.execute(csql) i=0 do while not rs.eof fields(i)=rs("fieldname") values(i)=rs("fieldvalue") helpTexts(i)=rs("message") Yesno=rs("fieldYesno") If Yesno=0 then fieldsyesno(i)="0" else fieldsyesno(i)="1" end if ' debugwrite Fields(i) & "=" & values(i) if isnull(values(i)) then values(i)="" end if i=i+1 rs.movenext Loop fieldcount=i if fieldcount=0 then Serror=Serror & getlang("langnorecords") & "
" end if CloseRecordset rs shopclosedatabase dbc end sub Sub AddSpecialLinks dim msg if ucase(configgroup)="MAIN" then msg=getlang("langcommonedit") & " " & getlang("langExportSetTable") & " " & "mycompany" Response.write "

" & msg & "

" exit sub end if if ucase(configgroup)="SHIPPING" then msg=getlang("langcommonedit") & " " & getlang("langExportSetTable") & " " & "shipmethods" Response.write "

" & msg & "

" exit sub end if end sub Sub Handlespecialfields (rc, fieldname,mydefault) rc=4 select case fieldname case "xshippingcalc" HandleXshippingcalc fieldname,mydefault rc=0 case "xemailtype" HandleXemailtype fieldname,mydefault rc=0 end select end sub ' Sub Handlexshippingcalc (fieldname, mydefault) dim shippingmethods,shipping(20),shippingcount shippingmethods=getconfig("xshippingmethods") if shippingmethods="" then shippingmethods="lookup,pricerange,pricepercent,product,fixed,message,weight,weightrange,quantity,quantityrange" end if parserecord shippingmethods,shipping,shippingcount,"," GenerateSelectNV shipping,mydefault,fieldname, shippingcount,"" end sub Sub Handlexemailtype (fieldname, mydefault) dim shippingmethods,shipping(20),shippingcount shippingmethods=getconfig("xemailtypes") if shippingmethods="" then shippingmethods="cdonts,aspmail,softart,jmail,jmail43,aspemail,ocxmail,dundas,cdosys" end if parserecord shippingmethods,shipping,shippingcount,"," GenerateSelectNV shipping,mydefault,fieldname, shippingcount,"" end sub %>