<%option explicit%> <% ShopCheckAdmin "shopa_editshipping.asp" '******************************* ' Version 6.50 ' Display fields in one record of one table ' setting field to keyword "NULL" sets field to empty ' March 8, 2004 '******************************* dim Addaction,Updateaction, Deleteaction dim rstemp dim which dim idfield dim dbtable, conn dim shipmethodid, shipmethod, smprice, shipbasecost, shipextracost dim shipother1, shipother2, shipcost1, shipcost2, shiproutine, shipcountry dim shippingcalc if request("other") = "yes" then shippingcalc = "other" setsess "shippingcalc", shippingcalc else shippingcalc = lcase(getconfig("xshippingcalc")) setsess "shippingcalc", shippingcalc end if Addaction=Request.form("add") Updateaction=Request.form("update") Deleteaction=request("delete") GetInputValues If DeleteAction<>"" then DeleteRecord end if sError="" EditOpenDatabase conn, database,dbtable If Addaction = "" and Updateaction = "" Then AdminPageHeader GenerateForm AdminPageTrailer Else sError="" ValidateShipMethod ' need to validate anything, nothing is required if sError = "" Then AdminPageHeader UpdateRecord GenerateForm AdminPageTrailer else AdminPageHeader GenerateForm AdminPageTrailer end if end if Shopclosedatabase conn '************************ Sub GetInputValues ' ID, allows editing a record which=request.querystring("which") 'VP-ASP 6.09 - Precautionary Security Fix if which > "" then If not isnumeric(which) then shoperror "ID must be numeric" end if end if database=request.querystring("database") idfield="shipmethodid" dbtable="shipmethods" ValidateTable End Sub ' Sub ValidateTable '******************************************** 'See if user has access to this table Dim UserTables, i dim tablecount if getconfig("XRestrictAdminTables")<>"Yes" then exit sub UserTables=GetSess("UserTables") If Isnull(UserTables) then exit sub end if if UserTables="" then exit Sub else UserTables=split(GetSess("UserTables"),",",-1,1) end if tablecount=ubound(UserTables) for i = 0 to tablecount if ucase(dbtable)=ucase(Usertables(i)) then exit sub end if next dbtable="" end sub Sub GenerateForm dim sqltemp if which <> "" then sqltemp="select * from " & dbtable sqltemp=sqltemp & " where " & idfield & "=" & which 'Debugwrite sqltemp set rstemp=conn.execute(sqltemp) end if if sError<> "" then shopwriteError SError Serror="" end if DisplayForm gethelp(getsess("shippingcalc")) if which <> "" then rstemp.close set rstemp=nothing end if end Sub '**************************** Sub DisplayForm() 'VP-ASP 6.50 - should always call this SetUpRowsCalc dim thing, methodrows methodrows = getsess("methodrows") if which <> "" then shipmethodid=rstemp("shipmethodid") shipmethod=rstemp("shipmethod") smprice=rstemp("smprice") shipbasecost=rstemp("shipbasecost") shipextracost=rstemp("shipextracost") shipother1=rstemp("shipother1") shipother2=rstemp("shipother2") shipcost1=rstemp("shipcost1") shipcost2=rstemp("shipcost2") shiproutine=rstemp("shiproutine") shipcountry=rstemp("shipcountry") else 'VP-ASP 6.50 - called earlier in sub ' SetUpRowsCalc ' dim thing, methodrows ' methodrows = getsess("methodrows") if methodrows > "" then methodrows = split(methodrows,",") for each thing in methodrows if request(left(thing, instr(thing, "-") - 1)) > "" then select case left(thing, instr(thing, "-") - 1) case "shipmethod" shipmethod = request("shipmethod") case "shiproutine" shiproutine = request("shiproutine") end select End If next else exit sub end if end if dim otherparams if request.querystring("other") = "yes" then otherparams = "&other=yes" else otherparams = "" end if %>

&idfield=<%=idfield%>&table=<%=dbtable%><%=otherparams%> method=POST>

Set up <%=getlang("langadminshipping")%>

<% shopwriteheader getlang("LangEdit02") shopwriteerror sError If which<>"" then ' response.write "" & getlang("LangCommonEdit") & "  " end if %>Return to Shipping Methods Table <% Response.Write TableDef WriteRowsForCalc ' FormatEditRow getlang("LangMenuFileName"),"shiproutine",shiproutine Response.Write(TableDefEnd) If which<>"" then %>     <% else %><% end if %>

<% end sub '************ ' Sub UpdateRecord dim sqltemp 'VP-ASP 6.50 - broadened defintion of IF statement to cover cases where xmysql hasn't been set if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" OR getconfig("xMYSQL")="Yes" then MYSQLProcessrecord updateaction, conn, dbtable, idfield, which exit sub end if If updateaction<>"" then sqltemp="select * from " & dbtable sqltemp= sqltemp & " where " & idfield & "=" & which Set rstemp = Server.CreateObject("ADODB.Recordset") rstemp.open sqltemp, conn, 1, 3 rstemp.Update else Set rstemp = Server.CreateObject("ADODB.Recordset") rstemp.open dbtable, conn, adOpenKeyset, adLockOptimistic rstemp.AddNew end if GenerateUpdateSQL which = rstemp(idfield) rstemp.close set rstemp=nothing sError= sError & getlang("LangEdit03") & "
" end sub ' ******** general Sql Sub GenerateUpdateSQL() Dim howmanyfields dim fieldname, fieldvalue, fieldtype dim i howmanyfields=rstemp.fields.count -1 rstemp.update for i=1 to howmanyfields fieldname = rstemp(i).name fieldtype=rstemp(i).type fieldvalue = request.form(fieldname) If fieldname="shipcountry" and fieldvalue=getconfig("langcommonselect") then fieldvalue="" end if EUpdatefield fieldname,fieldvalue next rstemp.update end sub Sub EUpdateField (fieldname, fieldvalue) on error resume next 'Debugwrite fieldname & "value=" & fieldvalue if fieldvalue="" then rstemp(Fieldname)=NULL exit sub end if if ucase(fieldvalue)="NULL" then rstemp(Fieldname)=NULL else rstemp(Fieldname)=fieldvalue end if end sub Sub DeleteRecord dim myconn EditOpenDatabase myconn, database,dbtable dim sql, url sql="delete from " & dbtable & " where " & idfield & "=" & which myconn.execute(sql) shopclosedatabase myconn url="shopa_editshipping.asp" responseredirect url end sub sub SetUpRowsCalc select case shippingcalc case "other" setsess "methodrows", "shipmethod-" & getlang("LangShippingMethod") & ",shiproutine-" & getlang("LangMenuFileName") case "lookup" setsess "methodrows", "shipmethod-" & getlang("LangShippingMethod") case "weight" setsess "methodrows", "shipmethod-" & getlang("LangShippingMethod") case "quantity" setsess "methodrows", "shipmethod-" & getlang("LangShippingMethod") case "quantityrange" setsess "methodrows", "shipmethod-" & getlang("LangShippingMethod") case "pricerange" setsess "methodrows", "shipmethod-" & getlang("LangShippingMethod") case "weightrange" setsess "methodrows", "shipmethod-" & getlang("LangShippingMethod") case else setsess "methodrows", "shipmethod-" & getlang("LangShippingMethod") end select End sub sub WriteRowsForCalc select case shippingcalc case "other" FormatEditRowStatic "","ID",shipmethodid FormatEditRow getlang("LangShippingMethod") & "*","shipmethod",shipmethod FormatEditRow getlang("LangMenuFileName") & "*","shiproutine",shiproutine 'VP-ASP 6.50 - add option to specify country for this shipping routine addshippingcountry case "lookup" FormatEditRowStatic "","ID",shipmethodid FormatEditRow getlang("LangShippingMethod") & "*","shipmethod",shipmethod FormatEditRow getlang("LangShipPrice"),"smprice",smprice 'VP-ASP 6.50 - add option to specify country for this shipping routine addshippingcountry case "weight" FormatEditRowStatic "","ID",shipmethodid FormatEditRow getlang("LangShippingMethod") & "*","shipmethod",shipmethod FormatEditRow getlang("LangProductBasePrice"),"shipbasecost",shipbasecost FormatEditRow "Extra Cost","shipextracost",shipextracost addshippingcountry case "quantity" FormatEditRowStatic "","ID",shipmethodid FormatEditRow getlang("LangShippingMethod") & "*","shipmethod",shipmethod FormatEditRow getlang("LangProductBasePrice"),"shipbasecost",shipbasecost FormatEditRow "Extra Cost","shipextracost",shipextracost addshippingcountry case "quantityrange" FormatEditRowStatic "","ID",shipmethodid FormatEditRow getlang("LangShippingMethod") & "*","shipmethod",shipmethod FormatEditRow getlang("LangProductBasePrice"),"shipbasecost",shipbasecost FormatEditRow "Extra Cost","shipextracost",shipextracost FormatEditRow "Minimum Quantity","shipother1",shipother1 FormatEditRow "Maximum Quantity","shipother2",shipother2 addshippingcountry case "pricerange" FormatEditRowStatic "","ID",shipmethodid FormatEditRow getlang("LangShippingMethod") & "*","shipmethod",shipmethod FormatEditRow getlang("LangProductBasePrice"),"shipbasecost",shipbasecost FormatEditRow "Extra Cost","shipextracost",shipextracost FormatEditRow "Minimum Price","shipcost1",shipcost1 FormatEditRow "Maximum Price","shipcost2",shipcost2 addshippingcountry case "weightrange" FormatEditRowStatic "","ID",shipmethodid FormatEditRow getlang("LangShippingMethod") & "*","shipmethod",shipmethod FormatEditRow getlang("LangProductBasePrice"),"shipbasecost",shipbasecost FormatEditRow "Extra Cost","shipextracost",shipextracost FormatEditRow "Minimum Weight","shipother1",shipother1 FormatEditRow "Maximum Weight","shipother2",shipother2 addshippingcountry case else FormatEditRowStatic "","ID",shipmethodid FormatEditRow getlang("LangShippingMethod") & "*","shipmethod",shipmethod FormatEditRow getlang("LangShipPrice"),"smprice",smprice end select end sub sub addshippingcountry If Getconfig("xshippingbycountry")="Yes" then Response.Write(tableRow & tablecolumn & getlang("langCustCountry") & tablecolumnend & "") 'VP-ASP 6.50 - extra parameter for shopcountries ShopCountries "shipCountry", shipCountry,"yes" Response.Write("") end if end sub Sub ValidateShipmethod dim thing, methodrows methodrows = getsess("methodrows") if methodrows > "" then methodrows = split(methodrows,",") for each thing in methodrows if request(left(thing, instr(thing, "-") - 1)) = "" then sError = sError & right(thing, len(thing)-instr(thing,"-")) & getlang("langCustRequired") & "
" End If next end if 'VP-ASP 6.50 - validate range fields to ensure they are numeric select case shippingcalc case "quantityrange" if request.form("shipother1") > "" then if not isnumeric(request.form("shipother1")) then sError = sError & "Minimum Quantity must be numeric" end if end if if request.form("shipother2") > "" then if not isnumeric(request.form("shipother2")) then sError = sError & "Maximum Quantity must be numeric" end if end if case "weightrange" if request.form("shipother1") > "" then if not isnumeric(request.form("shipother1")) then sError = sError & "Minimum Weight must be numeric" end if end if if request.form("shipother2") > "" then if not isnumeric(request.form("shipother2")) then sError = sError & "Maximum Weight must be numeric" end if end if end select end sub %>