<%option explicit%> <% shopcheckadmin "shopa_config.asp" '*************************************************** ' VPASP 5.00 has My company as its own edit facility ' group=xxxx display group of fields ' topic=description of group ' May 22, 2003 ' Nov 19, 2003 Fixes for Sun ASP 4.0 '*************************************************** dim fields(500),defaults(500),captions(500), values(500),fieldcount, defaultcount 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 If serror<>"" then response.write errorfontstart & serror & errorfontend end if %>
" method="post" id="Formadmin" name="Formadmin"> <% Response.write tabledef Response.write reportheadrow Response.write "" & configtopic & ReportHeadColumnEnd Response.write ReportRowEnd dim i for i = 0 to fieldcount-1 ConfigDisplayrow i next response.write "" Response.write "" Response.write "" Response.Write("

") If Getconfig("xbuttoncontinue")="" then Response.Write("


") else Response.Write("") end if Response.write "

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

" AddSpecialLinks end sub Sub ConfigDisplayRow (i) dim fieldname, caption, mydefault, Yesnotype dim srowcolor fieldname=fields(i) caption=fields(i) mydefault=values(i) YesnoType=FieldsYesNo(i) dim rc response.write TableRow Response.write "" Response.write caption & tablecolumnend Response.write tablecolumn Handlespecialfields rc, fieldname,mydefault If rc<>0 then If YesnoType="1" then GenerateSelectNV YesNos,mydefault,fieldname, YesnoCount,"" else %> <% end if end if response.write tablecolumnend response.write tablecolumn %> " value="<%=YesnoType%>"> <% response.write tablecolumnend Response.write tablerowend 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 response.redirect "shopa_config.asp" end sub ' Sub ConfigGetDefaultvalues dim csql,i,rs,Yesno, searchfield shopopendatabase dbc if ucase(configgroup)<>"SEARCH" then csql="select * from " & xconfigtable & " where fieldgroup='" & configgroup & "'" csql=csql & " order by fieldname" else searchfield=request("keyword") csql="select * from " & xconfigtable & " where fieldname LIKE '%" & searchfield & "%'" 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") 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,other,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,jmailjmail43,aspemail,ocxmail,dundas,cdosys" end if parserecord shippingmethods,shipping,shippingcount,"," GenerateSelectNV shipping,mydefault,fieldname, shippingcount,"" end sub %>