<%option explicit%>
<%
shopcheckadmin "shopa_config.asp"
'***************************************************
' VPASP 4.50 update configuration table
' group=xxxx display group of fields
' topic=description of group
'
'***************************************************
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 getconfig("xfont") & serror & ""
end if
%>
"
AddSpecialLinks
end sub
Sub ConfigDisplayRow (i)
dim fieldname, caption, default, Yesnotype
dim srowcolor
srowcolor=xtablerowcolor
fieldname=fields(i)
caption=fields(i)
default=values(i)
YesnoType=FieldsYesNo(i)
Response.write "
"
%>
<%=caption%>
<%
If YesnoType="1" then
GenerateSelectNV YesNos,default,fieldname, YesnoCount,""
else
%>
<%end if %>
" value="<%=YesnoType%>">
<%
end sub
Sub ConfigWriteinfo
dim msg
dim initname
If getconfig("xautoloadconfiguration")="Yes" then
initname="init" & "_" & xshopid
application(initname)=""
LoadApplicationVariables
msg=server.urlencode(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 & Langnorecords & " "
end if
CloseRecordset rs
shopclosedatabase dbc
end sub
Sub AddSpecialLinks
dim msg
if ucase(configgroup)<>"MAIN" then exit sub
msg=langcommonedit & " " & LangExportSetTable & " " & "mycompany"
Response.write "
" value="<%=YesnoType%>">