<%option explicit%> <% shopcheckadmin "" '************************************************************************** ' Version 6.50 Display orders' ' April 13, 2004 ' Oct 2, 2004 case on ocustomerid '************************************************************************** ' dim Selectioncritereontext dim mysql Dim Fieldcount Dim Headnames(6) Dim Fieldnames(6) Dim ProcType Dim SortType Dim Sortfield Dim SortUpDown Dim Sortupdownnames(2) Dim Sortupdownvalues(2) dim sortupdowncount Dim Procnames(3) dim Procvalues(3) Dim Pendnames(20) dim Pendvalues(20) dim pendingcount Dim Idfield Dim SearchFieldvalue, searchfieldname Dim i dim orderfieldcount, orderfields Dim item dim dbtable Dim scriptresponder Dim editresponder Dim dbc dim fieldname dim pending, pendtype dim PendingFieldnames(20),pendingfieldcount, pendingnamescount dim PaidFieldnames(20),paidfieldcount, paidnamescount, paidnames(20),paidvalues(20) dim paid, paidtype, ocardtype dim stockconn, items dim specialsearchcount dim prevandor specialsearchcount=4 setsess "currenturl","shopa_displayorders.asp" if request.form("advanced") > "" then if request.form("advanced") <> getsess("advanced") then setsess "advanced", request.form("advanced") responseredirect "shopa_displayorders.asp" end if end if ShopcheckLicense Shopproductcheck 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 If Request("MarkPending")<>"" Then For each item in Request("Pending") MarkPending Item Next End if GenerateDisplayHeader ' Generate sort button etc scriptresponder="shopa_formatorder.asp" editresponder="shopa_editrecord.asp" 'debugwrite "sql=" & mysql ShopopenRecordSet mysql, rsorder, mypagesize, mypage Selectioncritereontext = mysql GenerateTable ' write the tabe 'Call PageNavBar (Mysql) ' put bottom navigation bar rsOrder.close ' close database set rsOrder=nothing shopCloseDatabase dbc If getconfig("xlistallorders")="Yes" then response.write "

" & getlang("LangAllOrders") & "

" end if 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="0" end if 'response.write "Proctype=" & proctype 'VP-ASP 6.09 - Security Precaution Pendtype=cleanchars(request("Pendtype")) If Pendtype="" then Pendtype="" end if SortUpdown=request("SortUpdown") Paidtype=request("Paidtype") If Paidtype="" then Paidtype="*" end if If SortUpdown="" then sortupdown="DESC" end if if mypage="" then mypage=1 GenerateSQL else Mysql=GetSess("sqlquery") Proctype=GetSess("Proctype") sortfield=GetSess("sortfield") sortupdown=GetSess("sortupdown") pendtype=getsess("pendtype") end if if request.form("showhowmany") > "" then if request.form("showhowmany") <> getlang("langcommonselect") then setsess "showhowmany", request.form("showhowmany") else setsess "showhowmany", getconfig("xeditdisplaymaxrecords") end if else if getsess("showhowmany") > "" then else setsess "showhowmany", getconfig("xeditdisplaymaxrecords") end if end if maxrecs=getsess("showhowmany") mypagesize=maxrecs end sub ' ' SQL is generate by using fields on form Sub GenerateSQL dim sqlproc dim dbtable, whereok dim bracketopen,i, sqladd sqladd=" Where" bracketopen=false dbtable="orders" MySql = "SELECT * from " & dbtable 'whereok=" WHERE " 'response.write "generated sql=" & mysql 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 Proctype="" then sqlproc = whereok & " oprocessed=0" whereok= " AND " else if Proctype="*" then sqlproc="" AddPendingSql sqlproc, whereok else If Proctype="0" then sqlproc = whereok & " oprocessed=" & Proctype whereok=" AND " AddPendingSql sqlproc, whereok else sqlproc = whereok & " oprocessed<>0" whereok=" AND " end if end if end if Mysql = mysql & sqlproc 'VP-ASP 6.09 - Security precautions Searchfieldvalue=cleanchars(request("searchfieldvalue")) Searchfieldname=cleanchars(request("Searchfieldname")) If searchfieldvalue<>"" and searchfieldname<> getlang("Langcommonselect") then mysql = mysql & whereOK & searchfieldname & " LIKE '%" & searchfieldvalue & "%'" whereok= " and " end if AddPaidSql mysql, whereok If sortfield<>"" then mysql=mysql & " order by " & sortfield & " " & sortupdown end if SetSess "sqlquery",MySQL setSess "Proctype",Proctype SetSess "sortfield",sortfield SetSess "sortupdown",sortupdown setsess "paidtype",paidtype SetSess "pendtype",pendtype 'debugwrite mysql End sub ' Sub GenerateTable dim howmanyfields dim howmanyrecs dim my_link dim processed dim pending, orderid, pendingfieldname, fieldname dim paidyesno howmanyfields=fieldcount GenerateDisplayHeaderFlat GenerateDisplayBodyHeader %>
<%if maxpages <> 0 then response.write getlang("langCommonPage") & mypage & getlang("langCommonOf") & maxpages%> <%if maxpages <> 0 then Call PageNavBar (Mysql)%>
<% If getconfig("xtracking")="Yes" then %><% end if 'Put Headings On The Table of Field Names for i=0 to howmanyfields %><% next %><% If getconfig("xorderpending")="Yes" then %><% end if %><% %><% %><% ' Now lets grab all the records howmanyrecs=0 DO UNTIL rsorder.eof OR howmanyrecs=maxrecs orderid=rsorder(idfield) processed=rsorder("oprocessed") pending=rsorder("opending") ocardtype=rsorder("ocardtype") validateorder ocardtype,PaidYesno If isnull(pending) then pending="No" '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 if processed then processed=1 else processed=0 end if end if If paidYesno="Yes" then if processed<>0 then response.write ReportDetailRowX else response.write ReportDetailRow end if else response.write ReportDetailRowUnpaid end if '============================ 'Printer Friendly Link '============================ Response.write "" If getconfig("xtracking")="Yes" then %> <% end if for i = 0 to howmanyfields fieldname=fieldnames(i) Select case ucase(fieldname) Case "OCUSTOMERID" %><% case "ORDERAMOUNT" %><% case "ORDERID" %><% Case else %><% end select next if processed<>0 then %><% else %><% end if if getconfig("xorderpending")="Yes" then %><% end if %><% my_link=editresponder & "?which=" & rsorder(idfield) & "&idfield=" & idfield & "&table=orders" %><% howmanyrecs=howmanyrecs+1 if howmanyrecs < maxrecs then rsorder.movenext end if loop response.write("
 <% SortHeader Headnames(i), fieldnames(i) %><%=getlang("LangOrdersMarkProcessed")%><%=getlang("LangOrdersMarkPending")%><%=getlang("langcommonview")%><%=getlang("LangMenuEdit")%><% if request("specialfunction") = "Mail" then response.write getlang("langcustemail") elseif request("specialfunction") = "Export" then response.write getlang("langspecialexport") else response.write getlang("langmenudelete") end if%>
" AddPrintLink() Response.write "<%=getlang("Langtracking")%><%=rsorder(fieldname)%><%shopformatcurrency rsorder(fieldname),getconfig("xdecimalpoint") %><%=rsorder(fieldname)%><%=rsorder(fieldname)%><%=getlang("LangCommonYes")%>

<% Pendingfieldname="Pending_" & orderid GenerateSelectNV PendingFieldnames,pending,Pendingfieldname, Pendingfieldcount,getlang("LangCommonSelect") fieldname="pending" %> value=<%=Chr(34) & orderid & Chr(34)%>>
") %>

">    ">
   <% if getconfig("xorderpending")="Yes" then %> ">    <% end if response.write("") %>
<%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=6 fieldnames(0)="orderid" fieldnames(1)="ocustomerid" fieldnames(2)="odate" fieldnames(3)="orderamount" fieldnames(4)="olastname" fieldnames(5)="ocountry" fieldnames(6)="ocardtype" headnames(0)="orderid" headnames(1)="customerid" Headnames(2)=getlang("langDisplayDate") Headnames(3)=getlang("langDisplayAmount") Headnames(4)=getlang("langCustLastName") HeadNames(5)=getlang("langCustCountry") HeadNames(6)=getlang("LangCheckoutPaymentType") 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)="*" ProcValues(1)="1" ProcValues(2)="0" ' Pendingcount=0 if getconfig("xorderpending")="Yes" then SetupPending end if 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 updatestock item If getconfig("xmailprocessed")="Yes" then MailProcessedOrder dbc, item end if End sub Sub GenerateDisplayHeader %>
<%shopwriteheader "Orders" %> <%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%>

Query Statement

">

" 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 GenerateDisplayHeader_OLD %> <% %>
<%=getlang("langOrderSort")%> <% GenerateSelect Headnames,fieldnames,sortfield,"sortfield",fieldcount response.write "" GenerateSelect Sortupdownnames,Sortupdownvalues,sortupdown,"sortupdown",1 response.write "" GenerateSelect Procnames,ProcValues,Proctype,"Proctype",2 if getconfig("xorderpending")="Yes" then response.write "" GenerateSelect Pendnames,PendValues,Pendtype,"Pendtype",Pendingnamescount-1 end if response.write "" GenerateSelect Paidnames,PaidValues,Paidtype,"Paidtype",Paidnamescount-1 %> ">
<% GenerateSearch end sub ' Sub GenerateRadio (Fieldname,fieldvalue,radiotype, currentvalue) if currentvalue=Fieldvalue then %> <%=fieldname%>
<% else %> <%=fieldname%>
<% end if 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 %>