<%option explicit%>
<%
shopcheckadmin "shopa_displayorders.asp"
'**************************************************************************
' Version 6.50
' Nov 12, 2005 Fix order amount
' Dec 31, 2005 add textbox for oitemnames
' xdisplayordersproductlist
'**************************************************************************
'VP-ASP 6.50 - send pin numbers when order processed
dim ordernumber
dim mailtype,my_subject,my_to,my_toaddress,my_from,my_fromaddress,body,htmlformat,attachmentarray
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 oitemsnamescount, oitemsnames, oitemsvalues
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
'VP-ASP 6.50 - enhanced advanced search
If Request("SortA")<>"" Then
mysql=request("Selectioncritereontext")
setsess "sqlquery", request("Selectioncritereontext")
end if
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 - button to mark orders failed
If Request("Fail")<>"" Then
For each item in Request("Failed")
MarkFailed Item
Next
End if
If Request("MarkPending")<>"" Then
For each item in Request("Pending")
MarkPending Item
Next
End if
GenerateSearchHeader ' Generate sort button etc
scriptresponder="shopa_formatorder.asp"
editresponder="shopa_editrecord.asp"
'debugwrite "sql=" & mysql
'VP-ASP 6.08 - remember page number
SetSess "pagenumberaddproduct",mypage
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 "
"
end if
gethelp
AdminPageTrailer ' Write admin trailer
'
Sub GetInput
Idfield="Orderid"
mypage = Request.querystring("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="" then
sortfield="orderid"
end if
'response.write "sortfield="& sortfield
' see which types processed or unprocessed
Proctype=request("Proctype")
If Proctype="" then
Proctype="0"
end if
'response.write "Proctype=" & proctype
Pendtype=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
'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"
'VP-ASP 6.50 - Added DISTINCT to line below to stop orders showing twice if customer has ordered more than one of the same product
MySql = "SELECT DISTINCT orders.* from " & dbtable
'whereok=" WHERE "
oitemsnames=request("oitemsnames")
If oitemsnames<>"" and isnumeric(oitemsnames) then
'If (oitemsnames<>"") AND (oitemsnames<>getlang("Langcommonselect")) then
mysql = mysql & " INNER JOIN oitems ON oitems.orderid = orders.orderid WHERE oitems.catalogid = " & oitemsnames & " "
sqladd= "AND"
dim addAND
addAND = false
for i =1 to specialsearchcount
if (Request("criterionvalue" & i )) > "" then
addAND = true
end if
next
if addAND = true then mysql = mysql & " AND "
end if
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 & ")"
'VP-ASP 6.50 - enhanced advanced search
'if getsess("advanced") <> "yes" then
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
'VP-ASP 6.50 - enhanced advanced search
' end if
end if
Mysql = mysql & sqlproc
Searchfieldvalue=request("searchfieldvalue")
Searchfieldname=request("Searchfieldname")
If searchfieldvalue<>"" and searchfieldname<> getlang("Langcommonselect") then
if searchfieldname = "orderid" then searchfieldname = "orders.orderid"
'searchfieldvalue=Replace(searchfieldvalue,"'","''")
'VP-ASP 6.08 - stop from searching amount on a non-numeric value
if searchfieldname = "orderamount" then
if not isnumeric(left(searchfieldvalue,1)) then
shoperror "Order Amount must be a numeric value"
else
mysql = mysql & whereOK & searchfieldname & " = " & Replace(searchfieldvalue,"'","''")
end if
else
mysql = mysql & whereOK & searchfieldname & " LIKE '%" & Replace(searchfieldvalue,"'","''") & "%'"
end if
whereok= " and "
end if
AddPaidSql mysql, whereok
If sortfield<>"" then
mysql=mysql & " order by orders." & sortfield & " " & sortupdown
end if
SetSess "sqlquery",MySQL
setSess "Proctype",Proctype
SetSess "sortfield",sortfield
SetSess "sortupdown",sortupdown
setsess "paidtype",paidtype
SetSess "pendtype",pendtype
SetSess "oitemsname",oitemsnames
'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
%>
<%'Put Headings On The Table of Field Names
for i=0 to howmanyfields
%>
<% SortHeader Headnames(i), fieldnames(i) %>
<%
next
%>
Processed
Failed
<%
If getconfig("xorderpending")="Yes" then
%>
Pending
<%
end if
'============================
'Printer Friendly Link
'============================
%>
Print
<%
If getconfig("xtracking")="Yes" then
%>
Track
<%
end if
%>
<%=getlang("langcommonview")%>
<%
%>
<%=getlang("LangMenuEdit")%>
<%
%>
Re-Mail
<%
%>
<% 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%>
<%
' 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
for i = 0 to howmanyfields
fieldname=fieldnames(i)
Select case ucase(fieldname)
Case "OCUSTOMERID"
%>
<%
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, ocardno = 0000 where orderid =" & item
'VP-ASP 6.50 - send pin numbers when order processed
ordernumber = item
dbc.Execute sql
updatestock item
If getconfig("xmailprocessed")="Yes" then
MailProcessedOrder dbc, item
end if
'VP-ASP 6.50 - only send pin number when order is processed
if getconfig("Xpinnumber") = "Yes" and getconfig("Xpinnumberwhenprocessed") = "Yes" then
ShopPinNumbers dbc, item, "yes"
end if
End sub
'VP-ASP 6.50 - button to mark orders failed
Sub MarkFailed (Item)
sql= "update orders set oaffid='0', coupon = NULL, commission = '0', opoints='0', ocardtype = 'Fail', ocardno = null, oprocessed='1' where orderid =" & item
dbc.Execute sql
End sub
Sub GenerateSearchHeader
%>
<%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
%>
