<%option explicit%> <% '*********************************************************** ' Version 6.50 VP-ASP Affiliate account report ' July 5, 2005 '************************************************************* Dim totalorders, totalamount, Totalcommission dim totalProc, totalproccount, totalshipping, totalshippingproc dim totaltaxes, totaltaxesproc 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 getlang("LangaffnoID") end if end if AdminpageHeader totalcommission=0 ShopOpenOtherdb dbcorders,getconfig("xorderdb") FormatAffiliate lngaffid,"Report" commrate=affstrCommissionrate 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 GenerateDisplayBodyFooter 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") totaltaxes=totaltaxes+ objrs("otax") end if processed=objrs("oprocessed") shopaffcommission 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") totaltaxesproc=totaltaxesproc + objrs("otax") 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 GenerateDisplayHeader getlang("LangAffOrdersfor") & " " & fromdate & " - " & todate else GenerateDisplayHeader getlang("LangAffOrdersfor") & " " & lngaffid end if GenerateDisplayBodyHeader %><% 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" ' 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") fieldcount=8 end sub Sub GenerateSQL dim addsql dim mysql dim sqlproc dim datesql dim fromdatex, todatex Fromdate=GetSess("Fromdate") Todate=GetSess("Todate") addsql=" AND " MySql = "SELECT * from orders " sqlproc ="" addsql=" WHERE " Mysql=MySql & sqlproc 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 & addsql & " oaffid=" & lngaffid 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) Dofield getlang("LangProductTax"), shopformatcurrency(totaltaxes,xdecimalpoint) Doheader getlang("LangProcessed") dofield getlang("LangReportNumSales"),totalproccount DoField getlang("LangReportTotalSales"),shopformatcurrency(totalproc,xdecimalpoint) dofield getlang("LangProductShippingCost"),shopformatcurrency(totalshippingproc,xdecimalpoint) dofield getlang("LangProducttax"),shopformatcurrency(totaltaxesproc,xdecimalpoint) doheader getlang("langaffcommission") dofield getlang("LangAffCommission"),shopformatcurrency(totalcommission,xdecimalpoint) Response.write "

" end sub %>