<%option explicit%> <% Const ExtraDisplay="No" ShopCheckAdmin "shopa_editshipping.asp" '************************************************************************** ' Shop Shipping administration Only ' VP-ASP 6.50 ' '************************************************************************** dim howmanyfields dim arrayfields dim mysql Dim Fieldcount Dim Headnames Dim ProcType Dim SortType Dim Sortfield Dim SortUpDown Dim Sortupdownnames(2) Dim Sortupdownvalues(2) Dim Sortupdowncount Dim Procnames(3) dim Procvalues(3) Dim Fieldnames Dim Fieldnamecount Dim DisplayFields Dim displayFieldCount Dim DisplayField Dim Idfield Dim SelectField Dim SelectValue Dim maxfields Dim i Dim item dim dbtable Dim scriptresponder dim fieldname Dim rstemp Dim dbc dim SpecialFunction Dim Continue Dim SelectAll Dim productcategoryid dim language dim partsql dim Selectioncritereontext dim specialsearchcount dim Specialsearch setsess "shippingcalc", lcase(getconfig("xshippingcalc")) Specialsearch="YES" specialsearchcount=5 ' ' SelectAll="" SetSess "CurrentURL","shopa_editshipping.asp" SetSess "table","shipmethods" dbtable=GetSess("table") ShopcheckLicense AdminPageHeader GetDatabase If dbtable<>"" then ' no valid table if request("changeship") > "" then ConfigUpdateRecord end if GetSpecialFunction EditOpenDatabase dbc,database,dbtable SetSess "pagenumberaddproduct",mypage GenerateDisplayHeader "Set up " & getlang("langadminshipping") & " (" & getconfig("xshippingcalc") & ")" GetInput ProcessSpecialRequests ' Different Responders for different tables ShopopenRecordSet mysql, rstemp, mypagesize, mypage 'if the selected shipping calculation requires it, show the shipping methods if (lcase(getconfig("xshippingcalc")) <> "fixed") and (lcase(getconfig("xshippingcalc")) <> "other") and (lcase(getconfig("xshippingcalc")) <> "product") then GenerateDisplayBodyHeader GenerateTable GenerateDisplayBodyFooter %>

<% else GenerateDisplayBodyHeader %>

<%ChangeShippingForm%>

No shipmethods required for this shipping calculation.

<% GenerateDisplayBodyFooter %>

<% end if 'Call PageNavBar (Mysql) ' put bottom navigation bar GenerateDisplayHeader "Set up " & getlang("langbillother1") & " " & getlang("langadminshipping") dim othersql '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 othersql = "SELECT * from shipmethods WHERE (shiproutine <> '') AND (shiproutine <> 'upsxmlrealtime.asp')" else othersql = "SELECT * from shipmethods WHERE (NOT shiproutine IS NULL) AND (NOT shiproutine = '') AND (NOT shiproutine = 'upsxmlrealtime.asp')" end if ShopopenRecordSet othersql, rstemp, mypagesize, mypage GenerateDisplayBodyHeader %>

<% if not rstemp.eof then GenerateOtherTable else response.write getlang("langnorecords") end if GenerateDisplayBodyFooter %>

<% GenerateDisplayHeader "Set up UPS Real-Time " & getlang("langadminshipping") GenerateDisplayBodyHeader GenerateUPSTable GenerateDisplayBodyFooter %>

<% gethelp(getsess("shippingcalc")) rsTemp.close ' close database set rstemp=nothing ShopCloseDatabase dbc end if AdminPageTrailer ' Write admin trailer ' Sub GetDatabase Database=request("database") if database="" then database=GetSess("db") else SetSess "db",database end if if database="" then Debugwrite "No database specified" end if end sub '************************************************************************** Sub GetInput mypage = Request("page") 'VP-ASP 6.09 - Precautionary Security Fix if mypage > "" then If not isnumeric(mypage) then shoperror "Page size must be numeric" end if end if 'first time we need everything, othertimes sql is set up sortfield=request("Sortfield") ' See how we are sorting If Sortfield="" or Sortfield=getlang("langCommonSelect") then sortfield=IdField end if SelectValue=request("Selectvalue") SelectField=request("selectField") Productcategoryid=request("productcategoryid") If productcategoryid=getlang("langCommonselect") then productcategoryid="" end if If SelectField=getlang("langCommonselect") then selectvalue="" end if 'response.write "sortfield="& sortfield & "
" ' see which types processed or unprocessed SortUpdown=request("SortUpdown") If SortUpdown="" then sortupdown="ASC" end if if mypage="" then SetFieldNames ' field names for table GetDisplayfields mypage=1 GenerateSQL else Mysql=Getsess("sqlquery") Fieldcount=GetSess("Fieldcount") Fieldnames=GetsessA("Fieldnames") sortfield=GetSess("sortfield") sortupdown=GetSess("sortupdown") IDfield=GetSess("IDfield") productcategoryid=GetSess("productcategoryid") language=Getsess("editlanguage") dbtable=GetSess("table") DisplayFields=GetSess("DisplayFields") DisplayFieldCount=GetSess("DisplayFieldCount") partsql=getsess("partsql") end if maxrecs=getconfig("xeditdisplaymaxrecords") mypagesize=maxrecs SetUpDown ' see if mail of export If Request("SelectAll")<>"" then SelectAll=" checked " end if database=Getsess("db") end sub ' ' SQL is generate by using fields on form Sub GenerateSQL mypagesize=getconfig("xeditdisplaymaxrecords") shopproductcheck dim sqlproc dim key dim sqladd if Request("sorttext")<>"" then mysql=request("Selectioncritereontext") exit sub end if sqladd=" Where" MySql = "SELECT * from " & lcase(dbtable) dim i if Selectvalue<> "" then key = SelectValue & "%" mySQL = MySQL & " where " & SelectField & " like '" & key & "'" sqladd=" AND " end if If ucase(dbtable)="PRODUCTS" then DoRestrictProducts MySQL, sqladd end if If Productcategoryid<>"" then mysql=Mysql & sqladd mysql=Mysql & " ccategory=" & productcategoryid sqladd=" And " end if mysql=Mysql & sqladd mysql = mysql & " shiproutine IS NULL" sqladd=" And " If sortfield="" then sortfield=idfield If sortfield<>"" then mysql=mysql & " order by " & sortfield & " " & sortupdown end if SetSess "sqlquery",MySQL Setsess "sortfield",sortfield Setsess "sortupdown",sortupdown If getconfig("xdebug")="Yes" then debugwrite "generated sql=" & mysql & "
" end if End sub ' Sub DorestrictProducts (isql, sqladd) if getconfig("XAdminRestrictProducts")<>"Yes" then exit sub If GetSess("Admintype")="" then exit sub If GetSess("Admintype")="SUPER" then exit sub iSql = isql & sqladd & " userid='" & GetSess("shopadmin") & "'" sqladd=" and " end sub Sub GenerateTable() dim my_link Dim howmanyrecs Dim fieldvalue dim idvalue SetSess "Table",dbtable SetSess "Dbname",dbname SetSess "Idfield",idfield SetUpFieldsForShipping %>

<%ChangeShippingForm%>

<%CheckAll "shipping","SelectAll" %>

<%=ReportTableDef & "" %> <%for i=0 to howmanyfields ' response.write ReportHeadColumn & ArrayFields(i) & reportHeadColumnEnd response.write ReportHeadColumn & HeadNames(i) & reportHeadColumnEnd next response.write ReportHeadColumn & "" & getlang("langcommonedit") & "" & reportHeadColumnEnd If Specialfunction<>"" then ' Response.write ReportHeadColumn & SpecialFunction & reportHeadColumnEnd Response.write ReportHeadColumn response.write "" Response.write reportHeadColumnEnd end if %><% ' Now lets grab all the records howmanyrecs=0 DO UNTIL rstemp.eof OR howmanyrecs=maxrecs idvalue=rstemp(idfield) if partsql<>"" then Formatproductdetails idvalue, howmanyfields,arrayfields else my_link="shopa_editshipmethods.asp?which=" & rstemp(idfield) & "&idfield=" & idfield & "&table=" & dbtable & "&database=" & dbname ' response.write ReportDetailRow & ReportDetailColumn & "" & getlang("langCommonEdit") & "" & reportDetailColumnEnd response.write ReportDetailRow for i = 0 to howmanyfields If IsNull(rstemp(ArrayFields(i))) then response.write ReportDetailColumn & " " & reportDetailcolumnEnd else response.write ReportDetailColumn & rstemp(ArrayFields(i)) & ReportDetailColumnEnd end if next response.write ReportDetailColumn & "

" & reportDetailColumnEnd end if If SpecialFunction<>"" then response.write ReportDetailColumn & "" & reportdetailcolumnend end if response.write "" howmanyrecs=howmanyrecs+1 if howmanyrecs < maxrecs then rstemp.movenext end if loop if Specialfunction<>"" then %> <% if lcase(SpecialFunction) <> "delete" then%> <%else%> <%end if%>

<%Call PageNavBar (Mysql) ' put bottom navigation bar%>	">
">

<% else Response.write "" end if %>

<% end sub Sub GenerateOtherTable() dim my_link Dim howmanyrecs Dim fieldvalue dim idvalue SetSess "Table",dbtable SetSess "Dbname",dbname SetSess "Idfield",idfield howmanyfields = 2 Redim ArrayFields(howmanyfields) ArrayFields(0) = "shipmethodid" ArrayFields(1) = "shipmethod" ArrayFields(2) = "shiproutine" Redim Headnames(howmanyfields) Headnames(0)="ID" Headnames(1)=getlang("langshippingmethod") Headnames(2)=getlang("LangMenuFileName") %> <%CheckAll "shippingother","SelectAllOther" %>

<%=ReportTableDef & "" %> <%for i=0 to howmanyfields ' response.write ReportHeadColumn & ArrayFields(i) & reportHeadColumnEnd response.write ReportHeadColumn & HeadNames(i) & reportHeadColumnEnd next response.write ReportHeadColumn & "" & getlang("langcommonedit") & "" & reportHeadColumnEnd If Specialfunction<>"" then Response.write ReportHeadColumn response.write "" response.write reportHeadColumnEnd end if %><% ' Now lets grab all the records howmanyrecs=0 DO UNTIL rstemp.eof OR howmanyrecs=maxrecs idvalue=rstemp(idfield) if partsql<>"" then Formatproductdetails idvalue, howmanyfields,arrayfields else my_link="shopa_editshipmethods.asp?which=" & rstemp(idfield) & "&idfield=" & idfield & "&table=" & dbtable & "&database=" & dbname & "&other=yes" response.write ReportDetailRow for i = 0 to howmanyfields If IsNull(rstemp(ArrayFields(i))) then response.write ReportDetailColumn & " " & reportDetailcolumnEnd else response.write ReportDetailColumn & rstemp(ArrayFields(i)) & ReportDetailColumnEnd end if next response.write ReportDetailColumn & "

<%Call PageNavBar (Mysql) ' put bottom navigation bar%>	">
">

<% else Response.write "" end if %>

<% end sub Sub GenerateUPSTable()%>

	<%if (GetUPSConfig("xupsacctno", true, dbc) = "") or (GetUPSConfig("AccessLicenceNum", true, dbc) = "") then%> Add UPS Real-Time Shipping Configure UPS Real-Time Shipping <%else%> Configure UPS Real-Time Shipping Track UPS Orders Reset UPS Real-Time Shipping Turn Off UPS Real-Time Shipping <%end if%>
UPS, UPS brandmark, and the Color Brown are trademarks of United Parcel Service of America, Inc. All Rights Reserved.

<% end sub Sub SetFieldNames Fieldnamecount=0 dim fSql dim rs dim fldname ReDim Fieldnames(200) FSQL = "SELECT * FROM " & lcase(dbtable) 'debugwrite fSQL Set rs = dbc.Execute(fSQL) For each fldName in rs.Fields Fieldnames(fieldcount)=fldName.Name ' debugwrite fieldnames(fieldcount) & "
" fieldcount=fieldcount+1 next rs.close Idfield=Fieldnames(0) SetSessA "Fieldnames",Fieldnames DisplayFields=Fieldnames Displayfieldcount=fieldcount SetSessA "DisplayFields",Displayfields SetSess "DisplayFieldCount",displayfieldCount End Sub Sub SetUpDown Sortupdownnames(0)=getlang("langAscending") Sortupdownnames(1)=getlang("langDescending") Sortupdownvalues(0)="ASC" Sortupdownvalues(1)="DESC" SortUpDowncount=2 end sub ' ******************************************************* Sub DeleteRecord(Item) dim Rowsaffected dim dsql dbc.Execute "delete from " & dbtable & " where " & idfield & "=" & Item, RowsAffected, 1 end sub '***************************************************** Sub GetDisplayFields dim i Dim displayArray(100) DisplayFieldCount = Request("DisplayFields").Count 'Debugwrite DisplayfieldCount if DisplayfieldCount=0 then SetSess "Displayfieldcount",displayfieldcount exit sub end if displayField=Request("DisplayFields") DisplayFields= Split(DisplayField, ", ", -1, 1) If DisplayFields(0)="All" then Displayfieldcount=0 end if SetSessA "DisplayFields",DisplayFields SetSess "Displayfieldcount",displayfieldcount end sub '***************************** Sub ValidateTable '******************************************** 'See if user has access to this table Dim UserTables 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 SetUpFieldsForShipping select case lcase(getconfig("xshippingcalc")) case "lookup" howmanyfields = 2 Redim ArrayFields(howmanyfields) ArrayFields(0) = "shipmethodid" ArrayFields(1) = "shipmethod" ArrayFields(2) = "smprice" Redim Headnames(howmanyfields) Headnames(0)="ID" Headnames(1)=getlang("langshippingmethod") Headnames(2)=getlang("langproductprice") case "weight" howmanyfields = 3 Redim ArrayFields(howmanyfields) ArrayFields(0) = "shipmethodid" ArrayFields(1) = "shipmethod" ArrayFields(2) = "shipbasecost" ArrayFields(3) = "shipextracost" Redim Headnames(howmanyfields) Headnames(0)="ID" Headnames(1)=getlang("langshippingmethod") Headnames(2)=getlang("langproductbaseprice") Headnames(3)="Extra Cost" addshippingcountry case "quantity" howmanyfields = 3 Redim ArrayFields(howmanyfields) ArrayFields(0) = "shipmethodid" ArrayFields(1) = "shipmethod" ArrayFields(2) = "shipbasecost" ArrayFields(3) = "shipextracost" Redim Headnames(howmanyfields) Headnames(0)="ID" Headnames(1)=getlang("langshippingmethod") Headnames(2)=getlang("langproductbaseprice") Headnames(3)="Extra Cost" addshippingcountry case "quantityrange" howmanyfields = 5 Redim ArrayFields(howmanyfields) ArrayFields(0) = "shipmethodid" ArrayFields(1) = "shipmethod" ArrayFields(2) = "shipbasecost" ArrayFields(3) = "shipextracost" ArrayFields(4) = "shipother1" ArrayFields(5) = "shipother2" Redim Headnames(howmanyfields) Headnames(0)="ID" Headnames(1)=getlang("langshippingmethod") Headnames(2)=getlang("langproductbaseprice") Headnames(3)="Extra Cost" Headnames(4) = "Min Quantity" Headnames(5) = "Max Quantity" addshippingcountry case "pricerange" howmanyfields = 5 Redim ArrayFields(howmanyfields) ArrayFields(0) = "shipmethodid" ArrayFields(1) = "shipmethod" ArrayFields(2) = "shipbasecost" ArrayFields(3) = "shipextracost" ArrayFields(4) = "shipcost1" ArrayFields(5) = "shipcost2" Redim Headnames(howmanyfields) Headnames(0)="ID" Headnames(1)=getlang("langshippingmethod") Headnames(2)=getlang("langproductbaseprice") Headnames(3)="Extra Cost" Headnames(4) = "Min Cost" Headnames(5) = "Max Cost" addshippingcountry case "weightrange" howmanyfields = 5 Redim ArrayFields(howmanyfields) ArrayFields(0) = "shipmethodid" ArrayFields(1) = "shipmethod" ArrayFields(2) = "shipbasecost" ArrayFields(3) = "shipextracost" 'VP-ASP 6.09 - changed from shipcost1 and shipcost2 for more informative display ArrayFields(4) = "shipother1" ArrayFields(5) = "shipother2" Redim Headnames(howmanyfields) Headnames(0)="ID" Headnames(1)=getlang("langshippingmethod") Headnames(2)=getlang("langproductbaseprice") Headnames(3)="Extra Cost" Headnames(4) = "Min Weight" Headnames(5) = "Max Weight" addshippingcountry case else howmanyfields = 2 Redim ArrayFields(howmanyfields) ArrayFields(0) = "shipmethodid" ArrayFields(1) = "shipmethod" ArrayFields(2) = "smprice" Redim Headnames(howmanyfields) Headnames(0)="ID" Headnames(1)=getlang("langshippingmethod") Headnames(2)=getlang("langproductprice") end select end sub Sub GetSpecialFunction specialfunction=Request("Specialfunction") if specialfunction="" then specialfunction=GetSess("specialfunction") If Specialfunction="" then specialfunction=getlang("langCommonDelete") setsess("specialfunction"),specialfunction end if else If ucase(Specialfunction)="NULL" then SpecialFunction="" end if end if SetSess "specialfunction",specialfunction end sub Sub ProcessSpecialRequests if Request("All") <> "" then SEtSess "Allrecords","Yes" ProcessSpecialFunction else SetSess "AllRecords","" end if If Request("Selected")<>"" then ProcessSpecialFunction end if end sub Sub ProcessSpecialfunction dim deletename deletename=getlang("langcommonDelete") & "User" SpecialFunction=ucase(Request("SpecialFunction")) If SpecialFunction=ucase(getlang("langCommonDelete")) Then For each item in Request(Deletename) DeleteRecord Item Next exit sub End if end sub sub addshippingcountry If Getconfig("xshippingbycountry")="Yes" then howmanyfields = howmanyfields + 1 Redim Preserve ArrayFields(howmanyfields) Redim Preserve Headnames(howmanyfields) ArrayFields(howmanyfields) = "shipcountry" Headnames(howmanyfields) = getlang("langcustcountry") end if 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 ConfigUpdateRecord dim fieldname, fieldvalue, sql shopopendatabase dbc fieldname = "xshippingcalc" fieldvalue = request("xshippingcalc") If fieldvalue="" then fieldvalue="NULL" else Fieldvalue=replace(fieldvalue,"'","''") fieldvalue="'" & fieldvalue & "'" end if sql="update " & xconfigtable & " set fieldvalue=" & fieldvalue sql=sql & " where fieldname='" & fieldname & "'" dbc.execute(sql) Shopclosedatabase dbc If getconfig("xautoloadconfiguration")="Yes" then application("init" & "_" & xshopid)="" LoadApplicationVariables end if end sub Sub ChangeShippingForm%> <%End Sub %>