<%option explicit%> <% ShopCheckAdmin "shopa_searchreports.asp" '*********************************************************** ' VP-ASP Shop Administration ' Search Reports ' inputs are table, database ' Version 6.50 May 12, 2003 '************************************************************* Dim dbtable Dim fields(10) Dim CFields(10) dim fieldcount Dim File Dim ScriptResponder Dim Dbc dim Action dim fromdate dim todate Dim rs Dim Limit Dim Month Dim Year 'dim database scriptresponder="shopa_formatorder.asp" mypagesize=GetSess("ReportLimit") mypage=request("Page") if mypage<>"" then sql=GetSess("Sqlquery") ' on recursive calls we stored sql in sessikon variable fromdate=GetSess("Fromdate") todate=GetSess("Todate") WriteReport else GetInput If Action = "" or Serror<>"" Then DisplayForm Else If action="EMPTY" then EmptySearchResults Displayform else 'GenerateSQL WriteReport end if end if End If '******************************** Sub GetInput Serror="" dbtable="searchresults" limit=request("Limit") if limit="" then limit=100 end if SetSess "ReportLimit",limit mypagesize=limit action="" GetActionValues If action<> "" then GetDateValues end if end sub ' Sub GetActionValues action=request("summary") if action<>"" then action="SUMMARY" else action=request("Details") if action<>"" then action="DETAILS" end if end if if action="" then action=request("Empty") if action<>"" then action="EMPTY" end if end if end Sub ' Sub GetDateValues dim datevalue fromdate=request("fromdate") todate=request("todate") If fromdate<>"" then if todate="" then todate=date() end if ValidateDates exit sub end if ' Try month Month=Request("month") Year=Request("Year") If month>"0" then FormatMonth exit sub end if If Year>"0" then FormatYear exit sub end if ' Try Radio Buttons datevalue=request("DateSelect") datevalue=ucase(datevalue) 'debugwrite "datevalue=" & datevalue if datevalue="" then Serror= getlang("langReportDate") exit sub end if If datevalue="TODAY" then fromdate=date() todate=date() exit sub end if If datevalue="YESTERDAY" then fromdate=dateadd("d",-1, date()) todate=fromdate exit sub end if end sub Sub FormatMonth If lcase(getconfig("xenvironment"))="chillisoft" then formatmonthchilli exit sub end if month=cint(month) if Year="0" then Year=Datepart("yyyy",date()) else Year=clng(year) end if fromdate= month & "/" & Year month=month+1 if month = 13 then month=1 Year=Year+1 end if Todate= month & "/" & Year fromdate=cdate(fromdate) todate=cdate(todate) todate = dateadd("d",-1, todate) end sub ' Sub formatYear If lcase(getconfig("xenvironment"))="chillisoft" then formatyearchilli exit sub end if Year=clng(year) month=1 fromdate= month & "/" & Year Year=Year+1 Todate= month & "/" & Year fromdate=cdate(fromdate) todate=cdate(todate) todate=dateadd("d",-1,todate) end sub ' Sub ValidateDates If not Isdate(fromdate) then Serror="
" & getlang("LangReportInvalidDate") & fromdate end if If not Isdate(todate) then Serror="
" & getlang("LangReportInvalidDate") & todate end if end sub Sub GenerateSQL dim datesql Dim newsql 'VP-ASP 6.08 - paging issue fixed if mypage = "" then mypage=1 ' first time through end if sql="select * from searchresults where " datesql = " rdate>= " & datedelimit(fromdate) datesql = datesql & " and rdate<= " & datedelimit(todate) sql = sql & datesql newSql= replace (SQL, ".", "/") Sql=NewSql SetSess "Fromdate",fromdate SetSess "todate",Todate 'debugwrite sql end sub ' Sub WriteReport ' Generate table AdminPageHeader GenerateSQL ShopOpenOtherDB dbc, getconfig("xsearchdb") ShopOpenRecordSet SQL,RS, mypagesize, mypage GenerateDisplayHeader getlang("LangReport01") & fromdate & " to " & todate GenerateDisplayBodyHeader 'VP-ASP 6.09 - for print friendly reports response.write "
Print Report
" shopwriteheader getlang("LangReport01") & fromdate & " to " & todate if rs.eof then shopwriteerror getlang("LangSearchNone") else If Action="SUMMARY" then ProduceSummary else ProduceDetail end if end if GenerateDisplayBodyFooter AdMinPageTrailer end sub ' Sub ProduceSummary dim count dim total dim nopayment count=0 total=0 nopayment=0 While Not rs.EOF count=count+1 rs.movenext wend rs.close shopclosedatabase dbc shopwriteheader getlang("LangSearchNumber") & " " & count end sub ' Sub ProduceDetail dim count dim total dim nopayment count=0 total=0 nopayment=0 FormatTableStart limit=clng(mypagesize) While Not rs.EOF and count" & rs("orderid") & "" end if response.write ReportDetailColumn & fieldvalue & ReportdetailcolumnEnd next response.write ReportRowEnd end sub ' ' Sub DisplayForm dim fromdatex, todatex AdminPageHeader GenerateDisplayHeader getlang("LangSearchReport01") GenerateDisplayBodyHeader Response.write "
" if sError<> "" then shopwriteerror SError Serror="" end if %>
<% shopdateform "" %>

" name="Empty"> <% response.write "

" GenerateDisplayBodyFooter gethelp AdminPageTrailer end sub Sub FormattableStart dim i Fields(0)="ID" Fields(1)="rdate" Fields(2)="rtime" Fields(3)="categories" Fields(4)="words" Fields(5)="lastname" 'Fields(7)="" fieldcount=5 CFields(0)="ID" CFields(1)= getlang("LangDisplayDate") CFields(2)= getlang("LangDisplayTime") CFields(3)= getlang("LangSearchCategory") CFields(4)= getlang("LangSearchKeyword") CFields(5)= getlang("LangCustLastname") 'Fields(7)="" response.write ReportTableDef response.write "" for i = 0 to fieldcount Response.write ReportHeadColumn & CFields(i) & reportheadcolumnend next response.write ReportRowEnd end sub Sub FormatTableEnd response.write ReporttableEnd end sub ' Sub EmptySearchResults dim emptysql dim datesql emptysql="delete from searchresults Where " datesql = " rdate>= " & datedelimit(fromdate) datesql = datesql & " and rdate<= " & datedelimit(todate) emptysql = emptysql & datesql ShopOpenOtherDB dbc, getconfig("xsearchdb") dbc.execute(emptysql) shopclosedatabase dbc Serror= getlang("LangSearchEmptied") & " " & fromdate & " - " & todate & "
" end sub %>