<%@ Language=VBScript %> <% '************************************************************************* ' DO NOT MODIFY THIS SCRIPT IF YOU WANT UPDATES TO WORK! ' Function : Statistics & Reports ' Product : CandyPress Store Administration ' Version : 2.5 ' Modified : February 2004 ' Copyright: Copyright (C) 2004 CandyPress.Com ' See "license.txt" for this product for details regarding ' licensing, usage, disclaimers, distribution and general ' copyright requirements. If you don't have a copy of this ' file, you may request one at webmaster@candypress.com ' Custom : Adam L. - Added Quarterly and Yearly '************************************************************************* Option explicit Response.Buffer = true const adminLevel = 1 %> <% 'Work fields dim repType dim repPeriod dim repInterval dim repOrderStatus dim startDate dim startDateAll dim endDate dim aValues dim aLabels dim strTitle dim strYAxisLabel dim strXAxisLabel dim I dim repID dim errMsg dim firstDayOfQuarter dim showArr, item 'Database dim mySQL, cn, rs, rs2 '************************************************************************* 'Open Database Connection call openDB() 'Store Configuration if loadConfig() = false then response.redirect "sysMsg.asp?errMsg=" & server.URLEncode("Could not load Store Configuration settings.") end if 'Get form values repID = trim(Request.Form("repID")) if repID = "01" then 'ORDERS repType = lCase(trim(Request.Form("repType"))) repOrderStatus = lCase(trim(Request.Form("repOrderStatus"))) repPeriod = lCase(trim(Request.Form("repPeriod"))) repInterval = lCase(trim(Request.Form("repInterval"))) elseif repID = "02" then 'GENERAL REPORTS repType = lCase(trim(Request.Form("repType"))) end if 'If no form values were found, check the cookie if len(repID & repType & repOrderStatus & repPeriod & repInterval & "") = 0 then for each item in Request.Cookies if item = "CPStatistics" then showArr = Split(Request.Cookies(item),"*|*") repID = showArr(0) repType = showArr(1) repOrderStatus = showArr(2) repPeriod = showArr(3) repInterval = showArr(4) end if next else 'Save Search Criteria in a Cookie Response.Cookies("CPStatistics") = repID & "*|*" & repType & "*|*" & repOrderStatus & "*|*" & repPeriod & "*|*" & repInterval Response.Cookies("CPStatistics").expires = Date() + 30 end if %>

Statistics

orders for the last

<% 'Display the requested chart if repID = "01" then 'ORDERS call orderRep() call ShowChart(aValues,aLabels,strTitle,strXAxisLabel,strYAxisLabel) elseif repID = "02" then 'GENERAL REPORTS call generalRep() call ShowTable(aValues,aLabels,strTitle) else %>

To create a report, select the query parameters you want and click the "Show" button.

<% end if 'If there was an error, display it if len(trim(errMsg)) > 0 then %>

<%=errMsg%>

<% end if %> <% 'Close Database Connection call closedb() '********************************************************************* 'ORDER REPORTS '********************************************************************* Sub orderRep() 'Determine start date of FIRST interval if repInterval = "q" then 'Determine the current quarter Select Case Month(Date()) Case 1,2,3 ' First Quarter firstDayOfQuarter = "01/01/" & datePart("yyyy",Date()) Case 4,5,6 ' Second Quarter firstDayOfQuarter = "04/01/" & datePart("yyyy",Date()) Case 7,8,9 ' Third Quarter firstDayOfQuarter = "07/01/" & datePart("yyyy",Date()) Case 10,11,12 ' Fourth Quarter firstDayOfQuarter = "10/01/" & datePart("yyyy",Date()) End Select startdate = dateAdd(repInterval,CLng("-"&repPeriod),firstDayOfQuarter) elseif repInterval = "yyyy" then startDate = dateAdd(repInterval,CLng("-"&repPeriod),"01/01/" & datePart("yyyy",Date())) else startDate = dateAdd(repInterval,CLng("-"&repPeriod),now()) end if if repInterval = "m" then 'Adjust Day to 1st startDate = datePart("m",startDate) & "/01/" & datePart("yyyy",startDate) end if startDateAll = startDate 'Determine end date of FIRST interval if repInterval = "m" or repInterval = "ww" or repInterval = "q" or repInterval = "yyyy" then endDate = dateAdd(repInterval,1,startDate) 'Add Interval endDate = dateAdd("d",-1,endDate) 'Subtract 1 day else endDate = startDate 'EndDate = StartDate end if 'Get the required data from the database aValues = "" aLabels = "" for I = 0 to CLng(repPeriod) 'Starting from 0 includes current day/week/month 'Get values from Database if repType = "n" then mySQL = "SELECT COUNT(*) as orderTotal " else mySQL = "SELECT SUM(total) as orderTotal " end if mySQL = mySQL _ & "FROM cartHead " _ & "WHERE orderStatus='" & repOrderStatus & "' " _ & "AND orderDateInt>='" & left(dateInt(startDate),8) & "000000' " _ & "AND orderDateInt<='" & left(dateInt(endDate),8) & "999999' " set rs = openRSexecute(mySQL) if not isNumeric(rs("orderTotal")) then aValues = aValues & "0" else aValues = aValues & rs("orderTotal") end if call closeRS(rs) 'Determine what label to show if repInterval = "m" or repInterval = "ww" or repInterval = "q" or repInterval = "yyyy" then aLabels = aLabels & formatTheDate(startDate) & "-" & formatTheDate(endDate) else aLabels = aLabels & formatTheDate(startDate) end if 'Tack on a comma to the end if I <> CLng(repPeriod) then aValues = aValues & "," aLabels = aLabels & "," end if 'Increment Start and End dates startDate = dateAdd("d",1,endDate) if repInterval = "m" or repInterval = "ww" or repInterval = "q" or repInterval = "yyyy" then endDate = dateAdd(repInterval,1,startDate) 'Add Interval endDate = dateAdd("d",-1,endDate) 'Subtract 1 day else endDate = startDate 'EndDate = StartDate end if next 'Make Arrays aValues = split(aValues,",") aLabels = split(aLabels,",") 'Report Title strTitle = "From " & formatTheDate(startDateAll) & " to " & formatTheDate(now()) & "" 'Interval Label (Y Axis) select case repInterval case "d" strYAxisLabel = "Days" case "ww" strYAxisLabel = "Weeks" case "m" strYAxisLabel = "Months" case "q" strYAxisLabel = "Quarters" case "yyyy" strYAxisLabel = "Years" end select 'Report Type Label (X Axis) select case repType case "n" strXAxisLabel = "Number of Orders" case "t" strXAxisLabel = "Order Total Amounts" end select end sub '********************************************************************* 'GENERAL REPORTS '********************************************************************* Sub generalRep() 'Get the required data from the database select case repType case "pq" mySQL = "SELECT a.description, SUM(a.quantity) AS prodQty " _ & "FROM cartRows a, cartHead b " _ & "WHERE a.idOrder = b.idOrder " _ & "AND (b.orderStatus='1' OR b.orderStatus='2' OR b.orderStatus='7') " _ & "GROUP BY a.description " _ & "ORDER BY SUM(a.quantity) DESC " strTitle = "Top Products by Quantity Sold" aLabels = array("Description","Quantity") case "pa" mySQL = "SELECT a.description, SUM(a.quantity*a.unitPrice) AS prodTotal " _ & "FROM cartRows a, cartHead b " _ & "WHERE a.idOrder = b.idOrder " _ & "AND (b.orderStatus='1' OR b.orderStatus='2' OR b.orderStatus='7') " _ & "GROUP BY a.description " _ & "ORDER BY SUM(a.quantity*a.unitPrice) DESC " strTitle = "Top Products by Amount Sold" aLabels = array("Description","Amount") case "cq" mySQL = "SELECT lastName, name, COUNT(*) AS custQty " _ & "FROM cartHead " _ & "WHERE orderStatus='1' OR orderStatus='2' OR orderStatus='7' " _ & "GROUP BY lastName,name " _ & "ORDER BY COUNT(*) DESC " strTitle = "Top Customers by Number of Orders" aLabels = array("Last Name","Name","Orders") case "ca" mySQL = "SELECT lastName, name, SUM(total) AS custTotal " _ & "FROM cartHead " _ & "WHERE orderStatus='1' OR orderStatus='2' OR orderStatus='7' " _ & "GROUP BY lastName,name " _ & "ORDER BY SUM(total) DESC " strTitle = "Top Customers by Order Value" aLabels = array("Last Name","Name","Total") case "la" mySQL = "SELECT locCountry, SUM(total) AS cntryTotal, SUM(subTotal) AS cntrysubTotal, SUM(shipmentTotal) AS cntryshipmentTotal, SUM(taxTotal) AS cntrytaxTotal, SUM(otherFeeTotal) AS cntryotherFeeTotal, SUM(handlingFeeTotal) AS cntryhandlingFeeTotal, SUM(discTotal) AS cntrydiscTotal, SUM(adjustAmount) AS cntryadjustAmount, ((SUM(subTotal)-SUM(discTotal))*0.3) " _ & "FROM cartHead " _ & "WHERE orderStatus='1' OR orderStatus='2' OR orderStatus='7' " _ & "GROUP BY locCountry " _ & "ORDER BY SUM(total) DESC " strTitle = "Top Countries by Order Value" aLabels = array("Country","Total","SubTotal","SEDEX","SEG/SEDEX","TAXA BOL/CC","TAXA MANIPUL","DESCONTOS","AJUSTE AO VALOR","Total Liquido") case "il" mySQL = "SELECT description, stock " _ & "FROM products " _ & "ORDER BY stock ASC " strTitle = "Products with the lowest Inventory levels" aLabels = array("Description","Stock") end select set rs = openRSexecute(mySQL) if not rs.eof then aValues = rs.getRows(50) end if call closeRS(rs) end sub '********************************************************************* 'Create a graph of passed values and labels '********************************************************************* Sub ShowChart(ByRef aValues, ByRef aLabels, ByRef strTitle, ByRef strXAxisLabel, ByRef strYAxisLabel) 'Constants Const barHeight = 15 Const maxBarWidth = 400 Const colMain = "#FFFFFF" Const colXYLabels = "#DDDDDD" Const colLabels = "#EEEEEE" 'Variables dim maxValue, I, tot1, tot2 'Do some checks on the parms if not (IsArray(aValues) and IsArray(aLabels)) then errMsg = "Invalid Value or Label array." exit sub end if if UBound(aValues) <> UBound(aLabels) then errMsg = "Value and Label array not the same length." exit sub end if 'Determine Max Value maxValue = 0 For I = 0 To UBound(aValues) If Cdbl(maxValue) < CDbl(aValues(I)) Then maxValue = aValues(I) end if Next 'If Max value = 0, then there is nothing to display if CDbl(maxValue) = 0 then errMsg = "There is no data for the current selection." exit sub end if %>
<% for I = 0 to Ubound(aValues) '1) Calculate the value as a percentage of the maximum ' value. '2) Determine the number of pixels the percentage ' represents as a portion of the maximum allowed bar ' width. tot1 = Int((CDbl(aValues(I)) / Cdbl(maxValue)) * 100) tot2 = Int((tot1 * maxBarWidth) / 100) 'Should we show the decimals? if repType = "t" then aValues(I) = moneyD(aValues(I)) end if 'If tot2 is 0 change it to 1, otherwise the width tag for 'the image is not displayed properly in NS4.7 if tot2=0 then tot2=1 end if %> <% next %>

width=0 align=center valign=middle bgcolor="<%=colXYLabels%>"> <% for I = 1 to len(strYAxisLabel) Response.Write "" & mid(strYAxisLabel,I,1) & " " next %>	<%=strTitle%>
<%=replace(aLabels(I)," "," ")%>	height=<%=barHeight%> align=absMiddle> <%=aValues(I)%>
	<%=strXAxisLabel%>

<% End Sub '********************************************************************* 'Create a table of passed values and labels '********************************************************************* Sub ShowTable(ByRef aValues, ByRef aLabels, ByRef strTitle) 'Variables dim rowColor, col1, col2 dim row, col 'Do some checks on the parms if not IsArray(aValues) then errMsg = "There is no data for the current selection." exit sub end if %>

<%=strTitle%>

<% for col = 0 to UBound(aLabels) Response.Write "" next %> <% 'Row Colors col1 = "#DDDDDD" col2 = "#EEEEEE" rowColor = col2 'Write Rows for row = 0 to UBound(aValues,2) 'Write columns Response.Write "" for col = 0 to UBound(aValues,1) Response.Write "" next Response.Write "" 'Switch Row Color if rowColor = col2 then rowColor = col1 else rowColor = col2 end if next %>

" & aLabels(col) & "

" & aValues(col,row) & "

<% End Sub %>