<%option explicit%> <% '*********************************************************** ' Version 6.50 VP-ASP Affiliate account report ' July 5, 2005 '************************************************************* Dim totalorders, totalamount, Totalcommission dim totalProc, totalproccount, totalshipping, totalshippingproc dim commissionrate Dim dbcorders Dim dbcaff Dim Headnames(10) Dim Fieldnames(10) Dim Fieldcount Dim fromdate Dim todate Dim ordercount dim processed dim commission dim commrate ShopCheckAdmin "" lngaffid=request("affid") if lngaffid="" Then shoperror getlang("LangaffnoID") end if 'VP-ASP 6.09 - Precautionary security fix if lngaffid > "" then if not isnumeric(lngaffid) then shoperror "Affiliate ID must be numeric" end if end if AdminpageHeader totalcommission=0 ShopOpenOtherdb dbcorders,getconfig("xorderdb") FormatAffiliate lngaffid,"Report" commrate=affmastercommissionrate if isnumeric(commrate) then commrate=csng(commrate) end if If serror="" then FormatOrders If Serror<>"" then Response.write errorfontstart & serror & errorfontend & "
" else FormatSummary end if end if AdminPageTrailer shopclosedatabase dbcorders ' Sub FormatOrders dim forceflag forceflag=False ' only get real commission GenerateSQL dim calculated 'debugwrite sql Set objRS = Server.CreateObject("ADODB.Recordset") Set objRS = dbcorders.Execute(SQL) if objRS.eof then Serror= getlang("LangAffNoOrders") objrs.close set objrs=nothing exit sub end if SetFieldNames FormatOrderHeader Do While Not ObjRS.EOF totalorders=totalorders+1 if not isnull( objrs("orderamount")) then totalamount=totalamount+ objrs("orderamount") totalshipping=totalshipping+ objrs("oshipcost") end if processed=objrs("oprocessed") commrate=objrs("mastercommissionrate") shopaffcommissionMaster dbcorders,objrs, lngaffid, commrate, commission, calculated, forceflag if calculated=True then totalcommission=totalcommission+commission totalproc=totalproc+ objrs("orderamount") totalproccount=totalproccount+1 totalshippingproc=totalshippingproc + objrs("oshipcost") end if FormatSingleOrder objRS.movenext loop Response.write "" objrs.close set objrs=nothing End sub ' Sub FormatSingleOrder dim fieldname dim i, tempfieldname dim fieldvalue response.write "" for i = 0 to fieldcount fieldname=fieldnames(i) tempfieldname=ucase(fieldname) Select case tempfieldname Case "ORDERAMOUNT" response.write ReportDetailColumn & shopformatcurrency(objRS(fieldname),getconfig("xdecimalpoint")) & ReportDEtailColumnEnd Case "OSHIPCOST" response.write ReportDetailColumn & shopformatcurrency(objRS(fieldname),getconfig("xdecimalpoint")) & ReportDEtailColumnEnd Case "COMMISSION" response.write ReportDetailColumn & shopformatcurrency(commission,getconfig("xdecimalpoint")) & ReportDEtailColumnEnd Case "OPROCESSED" If Processed= 0 then fieldvalue= getlang("langCommonNo") else fieldvalue = getlang("LangCommonYes") end if response.write ReportDEtailColumn & fieldvalue & ReportDEtailColumnEnd Case else response.write ReportdetailColumn & objRS(fieldname) & ReportDetailColumnEnd end select next response.write ReportRowEnd end sub Sub FormatOrderHeader dim i totalorders=0 totalamount=0 totalproc=0 totalproccount=0 If Fromdate <>"" then %>

<%=Reportinfofont%><%= getlang("LangAffOrdersfor")%> <%=fromdate%> - <%=todate%> <%=reportinfofontend%>

<% else %>

<%=ReportInfoFont%><%= getlang("LangAffOrdersfor")%> <%=lngaffid%> <%=Reportinfofontend%>

<% end if Response.write ReportTableDef Response.write "" For i=0 to fieldcount response.write ReportHeadColumn & Headnames(i) & ReportHeadColumnEnd next response.write ReportRowEnd end sub ' Sub SetFieldNames fieldnames(0)="orderid" fieldnames(1)="ocustomerid" fieldnames(2)="odate" fieldnames(3)="orderamount" fieldnames(4)="oshipcost" fieldnames(5)="olastname" fieldnames(6)="ocountry" fieldnames(7)="oprocessed" fieldnames(8)="commission" fieldnames(9)="oaffid" ' headnames(0)="orderid" headnames(1)="customerid" Headnames(2)= getlang("LangDisplayDate") Headnames(3)= getlang("LangDisplayAmount") Headnames(4)= getlang("LangProductShippingCost") Headnames(5)= getlang("LangCustLastName") HeadNames(6)= getlang("LangCustCountry") HeadNames(7)= getlang("LangProcessed") Headnames(8)= getlang("LangAffCommission") Headnames(9)= getlang("LangAff") fieldcount=9 end sub Sub GenerateSQL dim addsql dim mysql dim sqlproc dim datesql dim fromdatex, todatex Fromdate=GetSess("Fromdate") Todate=GetSess("Todate") mysql="select affiliates.*, orders.* FROM affiliates INNER JOIN orders ON affiliates.affid = orders.oaffid" mysql = mysql & " WHERE affiliates.referralid=" & lngaffid addsql=" AND " If fromdate<>"" then fromdatex = DateDelimit (fromdate) todatex = dateDelimit (todate) datesql = " odate>= " & fromDatex datesql = datesql & " AND odate<= " & todatex mysql = mysql & addsql & "(" & datesql & ")" Addsql=" AND " end if mysql=mysql & " order by orderid" SQL=Mysql 'debugwrite mysql end sub ' ' Sub FormatSummary dim xdecimalpoint xdecimalpoint=getconfig("xdecimalpoint") response.write "

" Response.write FoRderTable Doheader getlang("LangReportNumSales") DoField getlang("LangReportNumSales"),totalOrders DoField getlang("LangReportTotalsales"),shopformatcurrency(totalamount,xdecimalpoint) Dofield getlang("LangProductShippingCost"), shopformatcurrency(totalshipping,xdecimalpoint) Doheader getlang("LangProcessed") dofield getlang("LangReportNumSales"),totalproccount DoField getlang("LangReportTotalSales"),shopformatcurrency(totalproc,xdecimalpoint) dofield getlang("LangProductShippingCost"),shopformatcurrency(totalshippingproc,xdecimalpoint) doheader getlang("langaffcommission") dofield getlang("LangAffCommission"),shopformatcurrency(totalcommission,xdecimalpoint) Response.write "" end sub %>