<%option explicit%> <% shopcheckadmin "shopa_displayorders.asp" '************************************************************************** ' Version 5.00 Display orders ' April 25, 2003 ' Demo Version '************************************************************************** ' 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 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 setsess "currenturl","shopa_displayorders.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 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 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 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 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") 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") pendtype=getsess("pendtype") end if maxrecs=getconfig("xeditdisplaymaxrecords") mypagesize=maxrecs end sub ' ' SQL is generate by using fields on form Sub GenerateSQL dim sqlproc dim dbtable, whereok dbtable="orders" MySql = "SELECT * from " & dbtable whereok=" WHERE " 'response.write "generated sql=" & 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 Searchfieldvalue=request("searchfieldvalue") Searchfieldname=request("Searchfieldname") If searchfieldvalue<>"" and searchfieldname<> getlang("Langcommonselect") then mysql = mysql & whereOK & searchfieldname & " LIKE '%" & searchfieldvalue & "%'" end if If sortfield<>"" then mysql=mysql & " order by " & sortfield & " " & sortupdown end if SetSess "sqlquery",MySQL setSess "Proctype",Proctype SetSess "sortfield",sortfield SetSess "sortupdown",sortupdown 'debugwrite mysql End sub ' Sub GenerateTable dim howmanyfields dim howmanyrecs dim my_link dim processed dim pending, orderid, pendingfieldname, fieldname howmanyfields=fieldcount response.write "" & getlang("LangCommonPage") & " " & mypage & getlang("LangCommonof") & " " & maxpages & "
" Response.write ReportTableDef Response.write ReportHeadrow Response.write ReportHeadColumn & ReportHeadColumnEnd Response.write ReportHeadColumn & ReportHeadColumnEnd If getconfig("xtracking")="Yes" then Response.write ReportHeadColumn & ReportHeadColumnEnd end if Response.write ReportHeadColumn & getlang("LangOrdersMarkProcessed") & ReportHeadColumnEnd If getconfig("xorderpending")="Yes" then Response.write ReportHeadColumn & getlang("LangOrdersMarkPending") & ReportHeadColumnEnd end if 'Put Headings On The Table of Field Names for i=0 to howmanyfields Response.write ReportHeadColumn & Headnames(i) & ReportHeadColumnEnd next Response.write ReportHeadColumn & getlang("LangMenuDelete") & ReportHeadColumnEnd Response.write ReportRowEnd ' Now lets grab all the records howmanyrecs=0 DO UNTIL rsorder.eof OR howmanyrecs=maxrecs orderid=rsorder(idfield) processed=rsorder("oprocessed") pending=rsorder("opending") If isnull(pending) then pending="No" if getconfig("xmysql")="Yes" then if processed then processed=1 else processed=0 end if end if if processed<>0 then response.write ReportDetailRowX else response.write ReportDetailRow end if Response.write ReportDetailColumn my_link=scriptresponder & "?oid=" & rsorder(idfield) & "&idfield=" & idfield %> <%=getlang("LangCommonView")%> <% Response.write ReportDetailcolumnEnd Response.write ReportDetailColumn my_link=editresponder & "?which=" & rsorder(idfield) & "&idfield=" & idfield & "&table=orders" %> <%=getlang("LangCommonEdit")%> <% Response.write ReportDetailColumnEnd If getconfig("xtracking")="Yes" then Response.write ReportDetailColumn my_link="shopa_trackingorder.asp" & "?oid=" & rsorder(idfield) %> <%=getlang("Langtracking")%> <% Response.write ReportDetailColumnEnd end if if processed<>0 then Response.write ReportDetailColumn & "

" & getlang("LangCommonYes") & "

" & ReportDetailColumnEnd else Response.write Reportdetailcolumn & "

" & reportdetailcolumnend end if if getconfig("xorderpending")="Yes" then Response.write ReportDetailColumn & "

" Pendingfieldname="Pending_" & orderid GenerateSelectNV PendingFieldnames,pending,Pendingfieldname, Pendingfieldcount,getlang("LangCommonSelect") fieldname="pending" Response.write "" ' Response.write 'Pending' value='" & rsorder(idfield) & "'>

" & reportdetailcolumnend Response.write "

" & ReportDetailColumnEnd end if for i = 0 to howmanyfields fieldname=fieldnames(i) if ucase(fieldname)="OCUSTOMERID" then response.write ReportDetailColumn & "" & rsorder(fieldname) & "" else if ucase(fieldname)="ORDERAMOUNT" then response.write ReportDetailColumn & shopformatcurrency(rsorder(fieldname),getconfig("xdecimalpoint")) & ReportDetailcolumnend else response.write Reportdetailcolumn & rsorder(fieldname) & Reportdetailcolumnend end if end if next %> <% Response.write ReportRowEnd howmanyrecs=howmanyrecs+1 if howmanyrecs < maxrecs then rsorder.movenext end if loop response.write("") %>
"> "> <% if getconfig("xorderpending")="Yes" then %> "> <% end if response.write("") 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)="orderid" headnames(1)="customerid" Headnames(2)=getlang("langDisplayDate") Headnames(3)=getlang("langDisplayAmount") 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)="*" ProcValues(1)="1" ProcValues(2)="0" ' Pendingcount=0 if getconfig("xorderpending")="Yes" then SetupPending end if 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 If getconfig("xmailprocessed")="Yes" then MailProcessedOrder dbc, item end if End sub Sub GenerateDisplayHeader %>

<% %>

<%=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 %>

<% 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 %>