<%option explicit%> <% ShopCheckAdmin "" '************************************************************************** ' Shop Affiliate Display orders ' VP-ASP 6.50 July 5, 2005 '************************************************************************** dim mysql Dim Fieldcount Dim Headnames(6) Dim Fieldnames(6) Dim ProcType Dim PendType 'VP-ASP 6.09 - declare missing variables Dim Pendnames(20) dim Pendvalues(20) dim pendingnamescount Dim SortType Dim Sortfield Dim SortUpDown Dim Sortupdownnames(2) Dim Sortupdownvalues(2) dim sortupdowncount Dim Procnames(3) dim Procvalues(3) Dim Idfield Dim i Dim item dim dbtable Dim scriptresponder Dim editresponder Dim dbc dim fieldname Dim affid, fromdate,todate dim PaidFieldnames(20),paidfieldcount, paidnamescount, paidnames(20),paidvalues(20) dim paid, paidtype, ocardtype dim specialsearchcount dim prevandor dim Selectioncritereontext dim searchfieldvalue, searchfieldname specialsearchcount=4 setsess "currenturl","shopa_affdisplayorders.asp" if request.form("advanced") > "" then if request.form("advanced") <> getsess("advanced") then setsess "advanced", request.form("advanced") responseredirect "shopa_affdisplayorders.asp?affid="&request("affid") end if end if dim datedelim dim datesql scriptresponder="shopa_formatorder.asp" editresponder="shopa_editrecord.asp" AdminPageHeader ' Admin page headers are different SetFieldNames ' field names for table OpenOrderDB dbc ' open database GetInput ' get all form fields If Request("Delete")<>"" Then For each item in Request("DeleteUser") DeleteRecord Item Next End if If Request("Process")<>"" Then For each item in Request("Processed") MarkProcessed Item Next End if 'VP-ASP 6.50 - mark orders paid to affiliate If Request("Paid")<>"" Then For each item in Request("PaidUser") MarkPaid Item Next End if GenerateSearchDisplayHeader ' Generate sort button etc 'response.write "sql=" & mysql ShopopenRecordSet mysql, rsorder, mypagesize, mypage GenerateTable ' write the tabe Call PageNavBar (Mysql) ' put bottom navigation bar rsOrder.close set rsorder=nothing ' close database shopCloseDatabase dbc AdminPageTrailer ' Write admin trailer ' Sub GetInput Idfield="Orderid" mypage = Request.querystring("page") 'first time we need everything, othertimes sql is set up sortfield=request("Sortfield") ' See how we are sorting If Sortfield="" then sortfield="OrderID" end if 'response.write "sortfield="& sortfield ' see which types processed or unprocessed 'VP-ASP 6.09 - Security Precaution Proctype=cleanchars(request("Proctype")) If Proctype="" then Proctype="All" end if 'VP-ASP 6.09 - Security Precaution Pendtype=cleanchars(request("Pendtype")) If Pendtype="" then Pendtype="All" end if Paidtype=request("Paidtype") If Paidtype="" then Paidtype="*" end if 'response.write "Proctype=" & proctype SortUpdown=request("SortUpdown") If SortUpdown="" then sortupdown="ASC" end if if mypage="" then mypage=1 GenerateSQL else Mysql=GetSess("sqlquery") Proctype=GetSess("Proctype") sortfield=GetSess("sortfield") sortupdown=GetSess("sortupdown") affid=getsess("affidDisplay") end if maxrecs=40 mypagesize=maxrecs end sub ' ' SQL is generate by using fields on form Sub GenerateSQL affid=Request("affid") 'VP-ASP 6.09 - Precautionary security fix if affid > "" then if not isnumeric(affid) Then affid = "" end if end if dim sqlproc dim dbtable, whereok dim bracketopen,i, sqladd 'if Request("Selectioncritereontext")<>"" then ' if trim(ucase(request("Selectioncritereontext"))) <> trim(ucase(session("sqlquery"))) then ' mysql=request("Selectioncritereontext") ' setsess "sqlquery", request("Selectioncritereontext") ' exit sub ' end if 'end if sqladd=" Where" bracketopen=false dbtable="orders" MySql = "SELECT orders.* from " & dbtable 'whereok=" WHERE " for i = 1 to specialsearchcount specialsearchterm MYSQL,sqladd,Request("criterion" & i),Request("criterionvalue" & i ),Request("Selection" & i),bracketopen if sqladd = "AND" then whereok = " AND " else whereok =" WHERE " end if Next if bracketopen then MYSQl=MYSQL & ")" if getsess("advanced") <> "yes" then if Proctype="" then sqlproc =whereok & " WHERE Oprocessed=0" whereok= " AND " else if Proctype="All" then sqlproc="" ' AddPendingSql sqlproc, whereok else sqlproc =" WHERE oprocessed=" & Proctype whereok=" AND " ' AddPendingSql sqlproc, whereok end if end if end if Mysql = mysql & sqlproc 'VP-ASP 6.09 - Security precautions Searchfieldvalue=cleanchars(request("searchfieldvalue")) Searchfieldname=cleanchars(request("Searchfieldname")) 'VPASP 6.5.1 - only show selected affiliate If affid <> "" Then mysql = mysql & whereok & " oaffid=" & affid End If If searchfieldvalue<>"" and searchfieldname<> getlang("Langcommonselect") then if searchfieldname = "orderid" then searchfieldname = "orders.orderid" searchfieldvalue=Replace(searchfieldvalue,"'","''") mysql = mysql & whereOK & searchfieldname & " LIKE '%" & searchfieldvalue & "%'" whereok= " and " end if AddPaidSql mysql, whereok If sortfield<>"" then mysql=mysql & " order by orders." & sortfield & " " & sortupdown end if 'response.write mysql SetSess "sqlquery",MySQL setSess "Proctype",Proctype SetSess "sortfield",sortfield SetSess "sortupdown",sortupdown setsess "paidtype",paidtype SetSess "pendtype",pendtype 'debugwrite mysql End sub Sub GenerateSQL_OLD dim sqlproc dim dbtable dim addsql dbtable="orders" affid=Request("affid") setsess "affidDisplay",affid Fromdate=GetSess("Fromdate") Todate=GetSess("Todate") if affid="" Then shoperror "No affiliate id Has been entered" end if addsql=" AND " MySql = "SELECT * from " & dbtable 'response.write "generated sql=" & mysql if getsess("advanced") <> "yes" then if Proctype="" then sqlproc =" WHERE Oprocessed=0" else if Proctype="All" then sqlproc="" addsql=" WHERE " else sqlproc =" WHERE oprocessed=" & Proctype end if end if else addsql = " WHERE " end if Mysql = mysql & sqlproc if fromdate<>"" then datesql = " odate>= " & datedelimit(fromDate) datesql = datesql & " AND odate<= " & datedelimit(todate) mysql = mysql & addsql & "(" & datesql & ")" addsql=" AND " end if mysql = mysql & addsql & " Oaffid=" & affid If sortfield<>"" then mysql=mysql & " order by " & sortfield & " " & sortupdown end if SetSess "sqlquery",MySQL SetSess "Proctype",Proctype SetSess "sortfield",sortfield SetSess "sortupdown",sortupdown 'Response.write "
" & mysql End sub ' Sub GenerateTable dim howmanyfields dim howmanyrecs dim my_link howmanyfields=fieldcount GenerateDisplayHeader "Orders for Affiliate " & affid GenerateDisplayBodyHeader %>
<%if maxpages <> 0 then response.write getlang("langCommonPage") & mypage & getlang("langCommonOf") & maxpages%>
">    ">
 <%if maxpages <> 0 then Call PageNavBar (Mysql)%>

<% 'Put Headings On The Table of Field Names for i=0 to howmanyfields%> <% next %> <% ' Now lets grab all the records howmanyrecs=0 DO UNTIL rsorder.eof OR howmanyrecs=maxrecs if cint(rsorder("oprocessed"))<>0 then response.write "" else response.write "" end if for i = 0 to howmanyfields fieldname=fieldnames(i) if ucase(fieldname)="OCUSTOMERID" then response.write "" else if ucase(fieldname)="ORDERAMOUNT" then response.write("") else response.write("") end if end if next if cint(rsorder("oprocessed"))<>0 then %> <% else %> <% end if%> <%if rsorder("affpaid")<>0 then%> <%else%> <%end if%> <% howmanyrecs=howmanyrecs+1 if howmanyrecs < maxrecs then rsorder.movenext end if loop response.write("
<%=Headnames(i) %><%= getlang("LangOrdersMarkProcessed")%> <%=getlang("langcommonview")%> <%=getlang("LangMenuEdit")%> <%= getlang("LangMenuDelete")%> Paid
" & rsorder(fieldname) & "" & shopformatcurrency(rsorder(fieldname),getconfig("xdecimalpoint")) & "" & rsorder(fieldname) & "<%= getlang("LangCommonYes")%> <%my_link=scriptresponder & "?oid=" & rsorder(idfield) & "&idfield=" & idfield %> View Affiliate Orders <%my_link=editresponder & "?which=" & rsorder(idfield) & "&idfield=" & idfield & "&table=orders" %> Edit Affiliate Orders
<%= getlang("LangCommonYes")%>
") %>
<%if maxpages <> 0 then response.write getlang("langCommonPage") & mypage & getlang("langCommonOf") & maxpages%>
">    ">
 <%if maxpages <> 0 then Call PageNavBar (Mysql)%>
<% GenerateDisplayBodyFooter end sub Sub SetFieldNames Fieldcount=5 fieldnames(0)="orderid" fieldnames(1)="ocustomerid" fieldnames(2)="odate" fieldnames(3)="orderamount" fieldnames(4)="olastname" fieldnames(5)="ocountry" headnames(0)= getlang("LangProductOrderNumber") headnames(1)="Customerid" headnames(2)= getlang("LangStatusDate") headnames(3)= getlang("LangProductTotal") headnames(4)= getlang("LangCustlastname") headnames(5)= getlang("LangCustCountry") Sortupdownnames(0)= getlang("LangAscending") Sortupdownnames(1)= getlang("LangDescending") Sortupdownvalues(0)="ASC" Sortupdownvalues(1)="DESC" Procnames(0)= getlang("LangAllOrders") Procnames(1)= getlang("LangProcessed") Procnames(2)= getlang("LangUnprocessed") ProcValues(0)="All" ProcValues(1)="1" ProcValues(2)="0" setuppaid end sub Sub DeleteRecord(Item) dim Rowsaffected dbc.execute "delete from oitems where orderid = " & item dbc.execute "delete from orders where orderid = " & item, rowsaffected, 1 end sub Sub MarkProcessed (Item) 'Response.write "item=" & item sql= "update orders set oprocessed = 1 where orderid =" & item dbc.Execute sql End sub 'VP-ASP 6.50 - Mark orders that have been paid to affiliate Sub MarkPaid (Item) sql= "update orders set affpaid = 1, affdatepaid ='" & now() & "' where orderid =" & item dbc.Execute sql End sub Sub GenerateRadio (Fieldname,fieldvalue,radiotype, currentvalue) if currentvalue=Fieldvalue then %> <%=fieldname%>
<% else %> <%=fieldname%>
<% end if end sub Sub GenerateSearchDisplayHeader %>
Affiliate Orders <%shopwriteheader "Orders For Affiliate #" & affid %> <%shopwriteerror sError%>

Search Orders
<% if getconfig("xorderpending")="Yes" then %> <% end if %> <% AddHowMany %>
Only show Orders that are:
<%GenerateSelect Procnames,ProcValues,Proctype,"Proctype",2%>
<%GenerateSelect Pendnames,PendValues,Pendtype,"Pendtype",Pendingnamescount-1%>
<%GenerateSelect Paidnames,PaidValues,PaidType,"Paidtype",Paidnamescount-1%>
 
<%WriteSelectTable specialsearchcount%>

">

" type="hidden" id="advanced"> <%end sub '============================================== ' SPECIAL SEARCH CUSTOMISATION ' Write all the fields for that table '============================================== Sub Writetableallfields (num,selecttype) dim sql,rs,fieldnamestable,fieldcount,strselect,fldName,selected fieldcount=0 if selecttype="multiple" then strselect=" type=multiple size=5 " else strselect=" size=1" end if SQL = "SELECT * FROM orders" Set rs = dbc.Execute(SQL) %> <% closerecordset rs End Sub Sub AddHowMany %>   Results Per Page <%GenerateSelectV split("10,20,50,100",","),split("10,20,50,100",","),getsess("showhowmany"),"showhowmany", 4,getlang("langCommonSelect")%> <% end sub Sub GenerateSelect (iFieldnames,ifieldvalues,currentvalue,selectname, count) %> <% end sub Sub GenerateSearch GetFieldnames %>
<%=getlang("langCommonSearch")%> <% GenerateSelectNV OrderFields, searchfieldname, "searchfieldname", orderfieldcount,getlang("langCommonSelect") %>
<% end sub Sub GetFieldNames dim sqltemp, rstemp If GetSess("orderfieldcount")<>"" then Orderfields=GetSessA("OrderFields") OrderfieldCount=GetSess("OrderFieldCount") exit sub end if redim orderfields(200) sqltemp="select * from orders " set rstemp=dbc.execute(sqltemp) orderfieldcount=rstemp.fields.count -1 for i=0 to orderfieldcount OrderFields(i)= rstemp(i).name next SetSessA "OrderFields",Orderfields SetSess "OrderFieldCount",Orderfieldcount rstemp.close set rstemp=nothing end sub Sub MarkPending (Item) 'Response.write "item=" & item dim pendingfieldname, pendingfieldvalue pendingfieldname="pending_" & item pendingfieldvalue=request(pendingfieldname) pendingfieldvalue=replace(pendingfieldvalue,"'","''") If pendingfieldvalue=getlang("langcommonselect") then sql= "update orders set opending=NULL where orderid =" & item else sql= "update orders set opending='" & pendingfieldvalue & "'" & " where orderid =" & item end if 'debugwrite sql dbc.Execute sql End sub Sub addpendingsql (sqlproc, whereok) if Pendtype="" then exit sub end if if Pendtype="*" then exit sub else pendtype=replace(pendtype,"'","''") If Pendtype="No" then sqlproc = sqlproc & whereok & " (opending='" & Pendtype & "'" & " or opending is null )" else sqlproc = sqlproc & whereok & " (opending='" & Pendtype & "'" & ")" end if whereok=" AND " end if end sub ' Sub SetupPending dim words(20), wordcount dim status, nostatus status=getconfig("xorderpendingvalues") If status="" then exit sub parserecord status, words, wordcount,"," for i = 0 to wordcount-1 Pendnames(i)=words(i) pendvalues(i)=words(i) pendingfieldnames(i)=words(i) next Pendingfieldcount=i nostatus=getlang("langAllOrders") Pendnames(i)=nostatus Pendvalues(i)="*" i=I+1 Pendingnamescount=i end sub ' Sub SetupPaid dim words(20), wordcount, values(10),valuecount dim status, nostatus, value dim yes, no yes=trim(getlang("langcommonyes")) no=trim(getlang("langcommonno")) status=Getlang("LangAdminPayments") & " " & yes & "," & Getlang("LangAdminPayments") & " " & no value="Yes,No" parserecord status, words, wordcount,"," parserecord value, values, valuecount,"," for i = 0 to wordcount-1 Paidnames(i)=words(i) paidvalues(i)=values(i) paidfieldnames(i)=words(i) next Paidfieldcount=i nostatus=getlang("langAllOrders") Paidnames(i)=nostatus Paidvalues(i)="*" i=I+1 Paidnamescount=i end sub Sub AddPaidSql (sql, whereok) dim tpaidtype If paidtype="" or paidtype="*" then exit sub tpaidtype=lcase(paidtype) sql=sql & whereok whereok=" and " if tpaidtype="yes" then sql=sql & " ocardtype is not null" else sql=sql & " (ocardtype is null)" end if end sub Sub Validateorder (ocardtype, paidyesno) if isnull(ocardtype) then Paidyesno="No" else Paidyesno="Yes" end if end sub '************************************************************** ' Update stock on processed '************************************************************** Sub UpdateStock (orderid) If getconfig("xupdatestockonprocessed")<>"Yes" then exit sub dim oid,strsql oid=orderid ShopOpendatabaseP stockconn strSQL = "select * FROM oitems where orderid = " & Oid Set Items = dbc.Execute(strSQL) UpdateStockDetails Shopclosedatabase stockconn end sub Sub UpdateStockDetails dim catalogid dim quantity Do While Not Items.EOF quantity=Items("numitems") catalogid=items("catalogid") UpdateStockLevels catalogid, quantity Items.MoveNext Loop closerecordset items end sub ' Sub UpdateStockLevels (catalogid, quantity) dim rsproduct dim myconn dim stock '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 mysqlupdatestocklevels catalogid, quantity, stockconn exit sub end if Set rsproduct = Server.CreateObject ("adodb.recordset") sql ="select cstock from products where catalogid=" & catalogid rsproduct.Open SQL, stockconn, adOpenKeyset, adLockOptimistic , adcmdText If not rsproduct.eof then stock=rsproduct("cstock") stock=stock-quantity rsproduct("cstock")=stock rsproduct.update end if closerecordset rsproduct end sub '============================================== ' SPECIAL SEARCH CUSTOMISATION ' Writes the Table '============================================== Sub WriteSelectTable (num) dim i Selectioncritereontext=MYSQL %> <% For i = 1 to num %> <% Next %> <% For i = 1 to num %> <% Next %> <% For i = 1 to num %> <% Next %> <% For i = 1 to num %> <% Next %>
Select <%=i%>
<%Writetableallfields i,""%>
" name=criterionvalue<%=i%> size="15">
<%RadioButtons i%>
<% End Sub Sub RadioButtons (num) if num=specialsearchcount then exit sub dim value,i,selected dim valuearray(3) valuearray(0)="And" valuearray(1)="Or" valuearray(2)="Not" value=Request("Selection"&num) %> <% if value="" then value="Or" For i = 0 to 2 if value=valuearray(i) then selected=" CHECKED" else selected="" end if %> <% Next %>
<%=valuearray(i)%> <%=Selected%>>
<% End Sub Sub specialsearchterm (SQL,sqladd,criterion,criterionvalue,andor,bracketopen) dim openbracket,closebracket openbracket="" closebracket="" if criterionvalue="" then exit sub if lcase(Sqladd)=" where" then sql=sql & sqladd sqladd="AND" end if if lcase(andor) = "not" then andor=" and " sql = sql & prevandor sql = sql & " " & criterion & " Not like '%" & criterionvalue & "%'" prevandor=andor else select case (lcase(andor)) case "or" if bracketopen=false then openbracket="(" bracketopen=true end if case "and" if bracketopen then closebracket=")" bracketopen=false end if end select sql = sql & " " & prevandor & " " & openbracket & criterion & " like '%" & criterionvalue & "%'" & closebracket & " " prevandor=andor end if sqladd="AND" End Sub Sub AddPrintLink() dim ordernumberprint SetSess "ordernumberprint",getsess("oid") %> Print <% End Sub Sub SetupPaid dim words(20), wordcount, values(10),valuecount dim status, nostatus, value dim yes, no yes=trim(getlang("langcommonyes")) no=trim(getlang("langcommonno")) status=Getlang("LangAdminPayments") & " " & yes & "," & Getlang("LangAdminPayments") & " " & no value="Yes,No" parserecord status, words, wordcount,"," parserecord value, values, valuecount,"," for i = 0 to wordcount-1 Paidnames(i)=words(i) paidvalues(i)=values(i) paidfieldnames(i)=words(i) next Paidfieldcount=i nostatus=getlang("langAllOrders") Paidnames(i)=nostatus Paidvalues(i)="*" i=I+1 Paidnamescount=i end sub Sub AddPaidSql (sql, whereok) dim tpaidtype If paidtype="" or paidtype="*" then exit sub tpaidtype=lcase(paidtype) sql=sql & whereok whereok=" and " if tpaidtype="yes" then sql=sql & " ocardtype is not null" else sql=sql & " (ocardtype is null)" end if end sub %>