<% '****************************************************************** ' VP-ASP 6.50 ' Reads and formats the affiliate log records ' Feb 4, 2003 '******************************************************************* Sub affiliatereport(fromdate, todate, affid) ' Generate table generatesql fromdate, todate, affid ShopOpenOtherDB dbc,getconfig("xaffiliateDB") Set rs=dbc.execute(sql) if rs.eof then shopwriteError getlang("LangNoRecords") else If fromdate="" then ProduceYearlySummary rs else ' determine if we want a monthly or a daily summary report if DatePart("yyyy", todate) = datepart("yyyy", fromdate) then ' its the same year if DatePart("m", todate) = datepart("m", fromdate ) then ' its the same month, do a daily summary ProduceDailySummary fromdate, todate else ProduceMonthlySummary fromdate, todate end if else ' its not the same year, therefore must be month summary ProduceYearlySummary rs end if end if end if closerecordset rs shopclosedatabase dbc end sub Sub ProduceMonthlySummary (fromdate, todate) 'VP-ASP 6.50 - Graphical reports dim theMonths(20), maxtotal dim count dim total dim nopayment dim nTotal dim nCurrentMonth dim nFromMonth dim nToMonth dim nMonthTotal dim nNumberMonths %>
<%=getlang("LangReport01") & fromdate & " to " & todate%>

<% nTotal = array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) count=0 total=0 nopayment=0 if Not rs.EOF then nFromMonth = datepart("m", fromdate) nToMonth = datepart("m", todate) while not rs.eof nCurrentMonth = datepart("m", rs("affdate") ) select case nCurrentMonth case 1 nTotal(0) = nTotal(0) + 1 case 2 nTotal(1) = nTotal(1) + 1 case 3 nTotal(2) = nTotal(2) + 1 case 4 nTotal(3) = nTotal(3) + 1 case 5 nTotal(4) = nTotal(4) + 1 case 6 nTotal(5) = nTotal(5) + 1 case 7 nTotal(6) = nTotal(6) + 1 case 8 nTotal(7) = nTotal(7) + 1 case 9 nTotal(8) = nTotal(8) + 1 case 10 nTotal(9) = nTotal(9) + 1 case 11 nTotal(10) = nTotal(10) + 1 case 12 nTotal(11) = nTotal(11) + 1 end select rs.movenext wend end if ' output the table header Response.Write ReportTableDef Response.Write ReportHeadRow Response.Write ReportHeadColumn Response.Write getlang("LangReportMonth") Response.Write ReportHeadColumnEnd Response.Write ReportHeadColumn 'VP-ASP 6.50 - Graphical reports Response.Write "" Response.Write ReportHeadColumnEnd Response.Write ReportHeadColumn Response.Write getlang("LangReportLinks") Response.Write ReportHeadColumnEnd Response.Write ReportRowEnd if nFromMonth > nToMonth then nNumberMonths = (12 - nFromMonth ) + nToMonth for i = (nFromMonth - 1) to (nNumberMonths + nFromMonth - 1) ' total all the links if i >= 12 then nMonthTotal = nMonthTotal + nTotal(i - 12) else nMonthTotal = nMonthTotal + nTotal(i) end if %> <% if i >= 12 then Response.Write(monthname(i - 11) ) else Response.Write monthname(i + 1) end if %> <% if i >= 12 then Response.Write(nTotal(i - 12 ) ) else Response.Write nTotal(i) end if %> <% next else nNumberMonths = nToMonth - nFromMonth for i = (nFromMonth - 1) to (nNumberMonths + nFromMonth - 1) 'VP-ASP 6.50 - Graphical reports theMonths(i) = nTotal(i) if nTotal(i) > maxtotal then maxtotal = nTotal(i) end if if i >= 12 then nMonthTotal = nMonthTotal + nTotal(i - 12) else nMonthTotal = nMonthTotal + nTotal(i) end if next for i = 0 to ubound(theMonths) If theMonths(i) > 0 then %> <%=monthname(i + 1)%> <% response.write "" if theMonths(i) = clng(maxtotal) then for linecounter = 0 to theMonths(i) if linecounter < 300 then response.write "" else exit for end if next else howmanytoshow = 100/maxtotal howmanytoshow = theMonths(i) * howmanytoshow if maxtotal > 300 then howmanytoshow = (howmanytoshow/100) * 300 else howmanytoshow = (howmanytoshow/100) * maxtotal end if 'response.write howmanytoshow & "
" for linecounter = 0 to howmanytoshow response.write "" next end if response.write "" %> <%=theMonths(i)%> <% end if next end if ' output the total row %> <%=getlang("LangReportTotal") %> <%=nMonthTotal %>

 

<% end sub Sub ProduceDailySummary(fromdate, todate) 'VP-ASP 6.50 - Graphical reports dim theDays(100) dim count dim total dim nopayment dim nTotal Dim nCurrentDay Dim sMonthName Dim nFromDay Dim nToDay %>
<%=getlang("LangReport01") & fromdate & " to " & todate %>

<% ' initialise all to 0 for report printing nTotal = array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) count=0 total=0 nopayment=0 if Not rs.EOF then ' get the day ' debugwrite "affid=" & rs("affid") & " id=" & rs("afflogid") sMonthName = MonthName(datepart("m", rs("affdate") )) nFromDay = datepart("d", fromdate) nToDay = datepart("d", todate ) while not rs.eof nCurrentDay = datepart("d", rs("affdate") ) select case nCurrentDay case 1 nTotal(0) = nTotal(0) + 1 case 2 nTotal(1) = nTotal(1) + 1 case 3 nTotal(2) = nTotal(2) + 1 case 4 nTotal(3) = nTotal(3) + 1 case 5 nTotal(4) = nTotal(4) + 1 case 6 nTotal(5) = nTotal(5) + 1 case 7 nTotal(6) = nTotal(6) + 1 case 8 nTotal(7) = nTotal(7) + 1 case 9 nTotal(8) = nTotal(8) + 1 case 10 nTotal(9) = nTotal(9) + 1 case 11 nTotal(10) = nTotal(10) + 1 case 12 nTotal(11) = nTotal(11) + 1 case 13 nTotal(12) = nTotal(12) + 1 case 14 nTotal(13) = nTotal(13) + 1 case 15 nTotal(14) = nTotal(14) + 1 case 16 nTotal(15) = nTotal(15) + 1 case 17 nTotal(16) = nTotal(16) + 1 case 18 nTotal(17) = nTotal(17) + 1 case 19 nTotal(18) = nTotal(18) + 1 case 20 nTotal(19) = nTotal(19) + 1 case 21 nTotal(20) = nTotal(20) + 1 case 22 nTotal(21) = nTotal(21) + 1 case 23 nTotal(22) = nTotal(22) + 1 case 24 nTotal(23) = nTotal(23) + 1 case 25 nTotal(24) = nTotal(24) + 1 case 26 nTotal(25) = nTotal(25) + 1 case 27 nTotal(26) = nTotal(26) + 1 case 28 nTotal(27) = nTotal(27) + 1 case 29 nTotal(28) = nTotal(28) + 1 case 30 nTotal(29) = nTotal(29) + 1 case 31 nTotal(30) = nTotal(30) + 1 end select rs.movenext wend end if ' output the table header Response.Write ReportTableDef Response.Write ReportHeadRow Response.Write ReportHeadColumn Response.Write getlang("LangReportDay") Response.Write ReportHeadColumnEnd Response.Write ReportHeadColumn 'VP-ASP 6.50 - Graphical reports Response.Write ReportHeadColumnEnd Response.Write ReportHeadColumn Response.Write getlang("LangReportLinks") Response.Write ReportHeadColumnEnd Response.Write ReportRowEnd for i = (nFromDay - 1) to (nToDay - 1) 'VP-ASP 6.50 - Graphical reports theDays(i) = nTotal(i) if nTotal(i) > maxtotal then maxtotal = nTotal(i) end if ' total all the links nDayTotal = nDayTotal + nTotal(i) next for i = 0 to ubound(theDays) If theDays(i) > 0 then %> <%=sMonthname & " " & (i + 1)%> <% response.write "" if theDays(i) = clng(maxtotal) then for linecounter = 0 to theDays(i) if linecounter < 300 then response.write "" else exit for end if next else howmanytoshow = 100/maxtotal howmanytoshow = theDays(i) * howmanytoshow if maxtotal > 300 then howmanytoshow = (howmanytoshow/100) * 300 else howmanytoshow = (howmanytoshow/100) * maxtotal end if 'response.write howmanytoshow & "
" for linecounter = 0 to howmanytoshow response.write "" next end if response.write "" %> <%=theDays(i)%> <% end if next ' output the total row %> <%=getlang("LangReportTotal")%> <%=nDayTotal%> <% end sub Sub ProduceYearlySummary (rs) 'VP-ASP 6.50 - Graphical reports dim prevyear, total, theYears(20),theTotals(20), i, maxtotal CurrentYear = datepart("yyyy", rs("affdate") ) PrevYear=CurrentYear total=0 Response.Write ReportTableDef 'VP-ASP 6.50 - Graphical reports ProduceYearReportHeader while not rs.eof CurrentYear = datepart("yyyy", rs("affdate") ) If CurrentYear<>PrevYear then 'VP-ASP 6.50 - Graphical reports 'ProduceYearReport Prevyear, total theYears(i) = prevyear theTotals(i) = total if total > maxtotal then maxtotal = total end if i = i + 1 total=0 PrevYear=CurrentYear end if total=total+1 rs.movenext wend 'VP-ASP 6.50 - Graphical reports theYears(i) = prevyear theTotals(i) = total if total > maxtotal then maxtotal = total end if for i = 0 to ubound(theYears) if theYears(i) > "" and theTotals(i) > "" then execute("ProduceYearReport " & theYears(i) & ", " & theTotals(i) & ", " & maxtotal) end if next 'ProduceYearReport prevyear, total Response.Write ReportTableEnd end sub 'VP-ASP 6.50 - Graphical reports Sub ProduceYearReportHeader Response.Write ReportHeadRow Response.Write ReportHeadColumn Response.Write "Year" Response.Write ReportHeadColumnEnd Response.Write ReportHeadColumn Response.Write ReportHeadColumnEnd Response.Write ReportHeadColumn Response.Write getlang("LangReportLinks") Response.Write ReportHeadColumnEnd Response.Write ReportRowEnd end sub 'VP-ASP 6.50 - Graphical reports sub produceyearreport (year, total,maxtotal) Response.Write ReportDetailRow Response.Write ReportDetailColumn Response.Write Year Response.Write ReportDetailColumnEnd %><% response.write "" if total = clng(maxtotal) then for linecounter = 0 to total if linecounter < 300 then response.write "" else exit for end if next else howmanytoshow = 100/maxtotal howmanytoshow = total * howmanytoshow if maxtotal > 300 then howmanytoshow = (howmanytoshow/100) * 300 else howmanytoshow = (howmanytoshow/100) * maxtotal end if for linecounter = 0 to howmanytoshow response.write "" next end if response.write "" %><% Response.Write ReportDetailColumn Response.Write Total Response.Write ReportDetailColumnEnd Response.Write ReportRowEnd end sub Sub GenerateSQL (fromdate, todate, affid) dim datesql, addsql Dim newsql datesql="" mypage=1 ' first time through addsql= " where " Sql="select * from affiliatelog " If fromdate<>"" then datesql=addsql datesql = datesql & " affdate>= " & DateDelimit(fromdate) datesql = datesql & " AND affdate<= " & datedelimit(todate) addsql=" and " end if sql = sql & datesql If affid<>"" then sql=sql & addsql & " affid=" & affid end if newSql= replace (SQL, ".", "/") Sql=NewSql 'VP-ASP 6.50 - Graphical reports sql = sql & " ORDER BY affdate" 'debugwrite sql if Getconfig("xdebug")="Yes" then debugwrite sql end if end sub Sub affiliatereportDetail(fromdate, todate, affid) dim fields(20), fieldcount, total generatesql fromdate, todate, affid ShopOpenOtherDB dbc,getconfig("xaffiliateDB") total=0 Set rs=dbc.execute(sql) if rs.eof then shopwriteerror getlang("LangNoRecords") else AffDetailHeader fields, fieldcount do while not rs.eof AffDetailrow rs, fields, fieldcount total=total+1 rs.movenext loop Affdetailtrailer total end if closerecordset rs shopclosedatabase dbc end sub Sub AffDetailHeader (fields, fieldcount) dim capfields(20) dim i Fields(0)="affid" Fields(1)="affdate" Fields(2)="affdirecturl" Fields(3)="affreferrer" Fields(4)="affcookie" fieldcount=4 CapFields(0)= getlang("Langaff") CapFields(1)= getlang("LangDisplayDate") CapFields(2)="affdirecturl" CapFields(3)="affreferrer" CapFields(4)="affcookie" response.write REportTableDEf response.write ReportHeadRow for i = 0 to fieldcount response.write ReportHeadColumn & capfields(i) & ReportHeadColumnEnd next response.write ReportRowEnd end sub Sub affdetailtrailer (total) response.write ReportTableEnd response.write "

" & reportinfofont Response.write "
" & getlang("LangAffLinks") & "=" & total response.write ReportinfofontEnd & "

" end sub Sub AffDetailrow (rs, fields, fieldcount) dim i, scriptresponder dim fieldvalue scriptresponder="shopa_editrecord.asp" response.write ReportDetailRow for i = 0 to fieldcount fieldvalue=rs(fields(i)) If fields(i)="affid" then my_link=scriptresponder & "?table=affiliates&which=" & rs("affid") & "&idfield=" & "affid" fieldvalue="" & rs("affid") & "" end if response.write ReportDetailColumn & fieldvalue & ReportDetailColumnEnd next response.write ReportRowEnd end sub %>