<%option explicit%> <% shopcheckadmin "shopa_displaycustomers.asp" '************************************************************************** ' Version 6.50 Display Customers ' March 8, 2004 '************************************************************************** ' dim Selectvalue dim mysql Dim Fieldcount Dim Headnames(20) Dim Fieldnames(20) Dim SortType Dim Sortfield Dim SortUpDown, sortupdowncount Dim Sortupdownnames(2) Dim Sortupdownvalues(2) Dim Idfield Dim SearchFieldvalue, searchfieldname,searchfieldtype Dim SelectFields, selectfieldcount Dim i dim orderfieldcount, orderfields Dim item dim dbtable Dim scriptresponder Dim editresponder dim orderresponder dim displayfields Dim dbc dim fieldname Dim orderdbc, orders, orderlastdate, ordersum dim databaseflag, multidatabase dim formbycustomer dim arrayfields, arrayfieldcount, arrayheaders Dim displayfield, displayfieldcount dim specialsearchcount dim Specialsearch dim Selectioncritereontext specialsearchcount=4 Specialsearch="YES" setsess "currenturl","shopa_displaycustomers.asp" if request.form("advanced") > "" then if request.form("advanced") <> getsess("advanced") then setsess "advanced", request.form("advanced") responseredirect "shopa_displaycustomers.asp" end if end if '********************************************************************** ' main program logic '*********************************************************************** AdminPageHeader Opendatabases SetDefaults GetInputValues Displayform Closedatabases adminpagetrailer '************************************************************** ' Get parameters from request or session variables '************************************************************* Sub GetInputvalues mypage = Request.querystring("page") Searchfieldvalue=request("criterionvalue99") Searchfieldname=request("txtfielddropdown") 'Searchfieldname=request("criterion99") Searchfieldtype=request("criteriontype99") 'first time we need everything, othertimes sql is set up sortfield=request("Sortfield") ' See how we are sorting If Sortfield="" then sortfield="contactid" end if SortUpdown=request("SortUpdown") If SortUpdown="" then sortupdown="DESC" end if CheckOrderSort sortfield if mypage="" then mypage=1 GenerateSQL else Mysql=GetSess("custsqlquery") sortfield=GetSess("custsortfield") sortupdown=GetSess("custsortupdown") DisplayFields=GetSess("custDisplayFields") DisplayFieldCount=GetSess("custDisplayFieldCount") Formbycustomer=getsess("Custformbycustomer") end if If displayfieldcount<>0 then arrayfields=displayfields arrayfieldcount=displayfieldcount-1 arrayheaders=displayfields else arrayfields=fieldnames arrayfieldcount=fieldcount arrayheaders=headnames end if Selectfields=orderfields selectfieldcount=orderfieldcount AddOrderFields selectfields, selectfieldcount end sub '***************************************************************** ' if split databases use two opens otherwise use one '***************************************************************** Sub Opendatabases multidatabase=false If getconfig("xorderdb")<>"" or getconfig("xcustomerdb")<>"" then opencustomerdb dbc openorderdb orderdbc multidatabase=true else shopopendatabase dbc multidatabase=false end if end sub Sub CloseDatabases shopclosedatabase dbc if multidatabase=false then exit sub shopclosedatabase orderdbc end sub '************************************************************************ ' Set default field names '****************************************************************** Sub setDefaults GetFieldNames ' field names for table SetFieldnames ' default fields GetDisplayfields ' Field to display scriptresponder="shopa_formatcustomer.asp" editresponder="shopa_editrecord.asp" orderresponder="shopa_displayorders.asp" formbycustomer=true Idfield="contactid" maxrecs=getconfig("xeditdisplaymaxrecords") mypagesize=maxrecs dbtable="customers" end sub '************************************************************************* ' sql has already been set up in mysql ' we are displaying data by customer '********************************************************************* Sub Displayform GenerateDisplayheader ShopopenRecordSet mysql, rsorder, mypagesize, mypage GenerateTableByCustomer ' write the tabe Call PageNavBar (Mysql) ' put bottom navigation bar closerecordset rsorder end sub '************************************************************************* ' generate SQL ' SQL is generate by using fields on form '************************************************************************* Sub GenerateSQL If formbycustomer=false then GenerateSqlByOrder exit sub end if dim sqlproc dim key dim sqladd if Request("Selectioncritereontext")<>"" then if trim(ucase(request("Selectioncritereontext"))) <> trim(ucase(session("sqlquery"))) then mysql=request("Selectioncritereontext") setsess "sqlquery", request("Selectioncritereontext") exit sub end if end if sqladd=" Where" MySql = "SELECT * from " & lcase(dbtable) dim i dim bracketopen bracketopen=false simplespecialsearchterm MYSQL,sqladd,Request("criterion99"),Request("criterionvalue99"),Request("criteriontype99"),bracketopen For i = 1 to specialsearchcount specialsearchterm MYSQL,sqladd,Request("criterion" & i),Request("criterionvalue" & i ),Request("Selection" & i),bracketopen Next if bracketopen then MYSQl=MYSQL & ")" if Selectvalue<> "" then key = SelectValue & "%" mySQL = MySQL & " where " & SelectField & " like '" & replace(key, "'", "''") & "'" sqladd=" AND " end if If sortfield="" then sortfield=idfield If sortfield<>"" then mysql=mysql & " order by " & sortfield & " " & sortupdown end if SetSess "custsqlquery",MySQL Setsess "custsortfield",sortfield Setsess "custsortupdown",sortupdown SetSess "custformbycustomer",formbycustomer If getconfig("xdebug")="Yes" then debugwrite "generated sql=" & mysql & "
" end if End sub Sub GenerateSQL_OLD If formbycustomer=false then GenerateSqlByOrder exit sub end if dim sqlproc dim dbtable, whereok dbtable="customers" MySql = "SELECT contactid from " & dbtable whereok=" WHERE " If searchfieldvalue<>"" and searchfieldname<> getlang("Langcommonselect") then mysql = mysql & whereOK & searchfieldname & " LIKE '%" & replace(searchfieldvalue,"'","''") & "%'" end if If sortfield<>"" then mysql=mysql & " order by " & sortfield & " " & sortupdown end if SetSess "custsqlquery",MySQL SetSess "custsortfield",sortfield SetSess "custsortupdown",sortupdown SetSess "sortupdown",sortupdown SetSess "custformbycustomer",formbycustomer 'debugwrite mysql End sub ' '********************************************************************** ' recordset rsorder has been opened, array tells us want to display ' arrayfields=displayfields ' arrayfieldcount=displayfieldcount ' arrayheaders=displayfields '***************************************************************** Sub GenerateTableByCustomer dim howmanyfields dim howmanyrecs dim my_link dim rc dim customeridfield, custrs dim orderid, fieldname, fieldvalue, customerid If formbycustomer=True then customeridfield="contactid" else customeridfield="ocustomerid" end if howmanyfields=arrayfieldcount GenerateDisplayHeaderFlat GenerateDisplayBodyHeader %>
<%if maxpages <> 0 then response.write getlang("langCommonPage") & mypage & getlang("langCommonOf") & maxpages%> <%if maxpages <> 0 then Call PageNavBar (Mysql)%>
<% 'Put Headings On The Table of Field Names for i=0 to howmanyfields %><% next %><% '************************************************************************* ' display the records '*********************************************************************** ' Now lets grab all the records howmanyrecs=0 DO UNTIL rsorder.eof OR howmanyrecs=maxrecs customerid=rsorder(customeridfield) GetCustomerdetails customerid, custrs, rc if rc=0 then GetOrderdetails customerid for i = 0 to howmanyfields fieldname=arrayfields(i) Select case ucase(fieldname) case "CONTACTID" Response.write ReportDetailColumn my_link=editresponder & "?which=" & custrs(idfield) & "&idfield=" & idfield & "&table=customers" %><%=getlang("LangCommonEdit") & " " & custrs("contactid")%><% Response.write ReportDetailColumnEnd case "ORDERTOTAL" response.write ReportDetailColumn & shopformatcurrency(ordersum,getconfig("xdecimalpoint")) & ReportDetailcolumnend & vbcrlf case "EMAIL" fieldvalue=custrs(fieldname) my_link="" & fieldvalue & "" response.write ReportDetailColumn & my_link & ReportDetailcolumnend & vbcrlf case "ORDERLASTDATE" response.write ReportDetailColumn & orderlastdate & ReportDetailcolumnend case "ORDERCOUNT" my_link=orderresponder & "?searchfieldvalue=" & custrs(idfield) & "&searchfieldname=ocustomerid" response.write ReportDetailColumn response.write "" & orders & "" Response.write ReportDetailcolumnend & vbcrlf case else response.write Reportdetailcolumn & custrs(fieldname) & Reportdetailcolumnend & vbcrlf end select next 'AddCustEdit custrs Response.write ReportRowEnd howmanyrecs=howmanyrecs+1 end if closerecordset custrs if howmanyrecs < maxrecs then rsorder.movenext end if loop %>
<% SortHeader arrayheaders(i), arrayfields(i) %>
<%if maxpages <> 0 then response.write getlang("langCommonPage") & mypage & getlang("langCommonOf") & maxpages%> <%if maxpages <> 0 then Call PageNavBar (Mysql)%>
<% GenerateDisplayBodyFooter end sub '******************************************************************** ' Basic Fields to display '******************************************************************** Sub SetFieldNames Fieldcount=5 fieldnames(0)="lastname" fieldnames(1)="firstname" fieldnames(2)="country" fieldnames(3)="state" fieldnames(4)="email" AddOrderFields fieldnames, fieldcount fieldcount=fieldcount-1 ' headnames(0)=getlang("langcustlastname") headnames(1)=getlang("langcustfirstname") HeadNames(2)=getlang("langCustCountry") HeadNames(3)=getlang("langCustState") HeadNames(4)=getlang("langCustemail") Headnames(5)=getlang("LangAffViewOrders") Headnames(6)=getlang("LangAffAmount") Headnames(7)=getlang("LangAffLastDate") Sortupdownnames(0)=getlang("langAscending") Sortupdownnames(1)=getlang("langDescending") Sortupdownvalues(0)="ASC" Sortupdownvalues(1)="DESC" sortupdowncount=2 end sub Sub AddOrderFields (darray, darraycount) darray(darraycount)="ordercount" darraycount=darraycount+1 darray(darraycount)="ordertotal" darraycount=darraycount+1 darray(darraycount)="orderlastdate" darraycount=darraycount+1 end sub '******************************************************************** ' Basic form used to dispaly customers to allow selection '********************************************************************* ' Sub GenerateDisplayHeader_old %>
<%=getlang("langEdittablename")%>: <%=dbtable%>

<%=getlang("langEditSort")%>

<%=getlang("langEditSelect")%>

<%=getlang("langEditDisplay")%>

  <%GenerateSelectV SElectfields,SElectfields,sortfield,"sortfield", selectfieldcount-1, ""%>

  <%GenerateSelectV Sortupdownnames,Sortupdownvalues,sortupdown,"sortupdown", sortupdowncount,""%>

<%GenerateSelectNV OrderFields,SearchFieldname,"SearchFieldname", orderfieldcount, getlang("langCommonSelect")%>

<%GenerateSelectMult SelectFields,selectfieldcount,DisplayFields,DisplayfieldCount,"DisplayFields","All"%>

">

">
<% end sub Sub GenerateDisplayHeader %>
<%shopwriteheader "Customers" %>
 
<%shopwriteerror sError%>

<%=ucase(left(dbtable, 1)) & lcase(right(dbtable, len(dbtable) - 1))%> Search
Show items that meet this criteria: <% Writetableallfields dbtable,"99",request.form("criterion99") %> ">
 
  <% AddHowMany %>
 
<% If Specialsearch="YES" then%> <%else%> <%end if %>
<%callSpecialSearch%>

<%GenerateSelectNV Fieldnames,SelectField,"SelectField", fieldcount, getlang("langCommonSelect")%>

<%=getlang("langEditDisplay")%>

<%GenerateSelectMult Fieldnames,fieldcount,DisplayFields,DisplayfieldCount,"DisplayFields","All"%>

Query Statement

" onclick="location.href='shopa_editdisplay.asp?<%=Request.ServerVariables("QUERY_STRING")%>'" >

">

" type="hidden" id="advanced">
<%end sub Sub GenerateSelect (iFieldnames,ifieldvalues,currentvalue,selectname, count) %> <% end sub Sub GenerateSearch %>
<%=getlang("langCommonSearch")%> <% GenerateSelectNV OrderFields, searchfieldname, "searchfieldname", orderfieldcount,getlang("langCommonSelect") %>
<% end sub '**************************************************************************** ' allow merchant to display fields they want to see '***************************************************************************** Sub GenerateFieldSelection %>
Select <%GenerateSelectMult OrderFields,Orderfieldcount,DisplayFields,DisplayfieldCount,"DisplayFields","All"%>
<% end sub '******************************************************************** ' we need to know fields in customer table '******************************************************************* Sub GetFieldNames dim sqltemp, rstemp If GetSess("custfieldcount")<>"" then Orderfields=GetSessA("CustFields") OrderfieldCount=GetSess("CustFieldCount") exit sub end if redim orderfields(200) sqltemp="select * from customers " set rstemp=dbc.execute(sqltemp) orderfieldcount=rstemp.fields.count -1 for i=0 to orderfieldcount OrderFields(i)= rstemp(i).name next SetSessA "CustFields",Orderfields SetSess "CustFieldCount",Orderfieldcount rstemp.close set rstemp=nothing end sub '************************************************************************* ' Need to get number of orders for this customer '*********************************************************************** Sub Getorderdetails (contactid) Dim sql, rs orders=0 orderlastdate="" ordersum=0 sql="select * from orders where ocustomerid=" & contactid sql=sql & " order by orderid" If Multidatabase=True then set rs=orderdbc.execute(sql) else set rs=dbc.execute(sql) end if do while not rs.eof orders=orders+1 ordersum=ordersum+rs("orderamount") orderlastdate=rs("odate") rs.movenext loop closerecordset rs end sub '************************************************************************* ' Need to get number of orders for this customer '*********************************************************************** Sub GetCustomerdetails (contactid, custrs, rc) Dim sql If contactid<>"" then sql="select * from customers where contactid=" & contactid set custrs=dbc.execute(sql) If custrs.eof then rc=4 else rc=0 end if else rc=4 end if end sub Sub AddCustEdit (rsorder) dim my_link my_link=editresponder & "?which=" & rsorder(idfield) & "&idfield=" & idfield & "&table=customers" %>
Edit Customers
<% end sub ' Sub GetDisplayFields dim i Dim displayArray(200) DisplayFieldCount = Request("DisplayFields").Count 'Debugwrite DisplayfieldCount if DisplayfieldCount=0 then SetSess "CustDisplayfieldcount",displayfieldcount exit sub end if displayField=Request("DisplayFields") DisplayFields= Split(DisplayField, ", ", -1, 1) If DisplayFields(0)="All" then Displayfieldcount=0 end if SetSessA "CustDisplayFields",DisplayFields SetSess "CustDisplayfieldcount",displayfieldcount end sub Sub CheckorderSort (sortfield) dim prefix prefix=left(sortfield,5) if prefix="order" then formbycustomer=False ' do form by orders end if end sub '***************************************************************** ' If doing order Fields '***************************************************************** Sub GenerateSQlBYOrder mysql="SELECT ocustomerid, Sum(orders.orderamount) AS ordertotal, Count(orders.orderid) AS ordercount " mysql=mysql & " FROM orders GROUP BY orders.ocustomerid" If sortfield<>"" then Select case sortfield case "ordercount" mysql=mysql & " ORDER BY Count(orders.orderid)" case "ordertotal" mysql=mysql & " Order by Sum(orders.orderamount)" case else mysql=mysql & " Order by ocustomerid" end select mysql=mysql & " " & sortupdown end if SetSess "custsqlquery",MySQL SetSess "custsortfield",sortfield SetSess "custsortupdown",sortupdown SetSess "sortupdown",sortupdown SetSess "custformbycustomer",formbycustomer 'debugwrite mysql end sub '============================================== ' SPECIAL SEARCH CUSTOMISATION ' Writes the Table '============================================== Sub WriteSelectTable (num) dim i Selectioncritereontext=MYSQL %> <% For i = 1 to num %> <% Next %> <% For i = 1 to num %> <% Next %> <% For i = 1 to num %> <% Next %> <% For i = 1 to num %> <% Next %>
Select <%=i%>
<%Writetableallfields dbtable,i,""%>
" name=criterionvalue<%=i%> size="15">
<%RadioButtons i%>
<% End Sub '============================================== '============================================== ' SPECIAL SEARCH CUSTOMISATION ' Write all the fields for that table '============================================== Sub callSpecialSearch WriteSelectTable specialsearchcount End Sub Sub Writetableallfields (dbtable,num,selecttype) dim sql,rs,fieldnamestable,fieldcount,strselect,fldName,selected fieldcount=0 if selecttype="multiple" then strselect=" type=multiple size=5 " else strselect=" size=1" end if SQL = "SELECT * FROM " & dbtable Set rs = dbc.Execute(SQL) %> <% closerecordset rs End Sub Sub RadioButtons (num) if num=specialsearchcount then exit sub dim value,i,selected dim valuearray(3) valuearray(0)="And" valuearray(1)="Or" valuearray(2)="Not" value=Request("Selection"&num) %> <% if value="" then value="Or" For i = 0 to 2 if value=valuearray(i) then selected=" CHECKED" else selected="" end if %> <% Next %>
<%=valuearray(i)%> <%=Selected%>>
<% End Sub Sub Writeselect(table,num,idfield,fieldname) sql="select * from " & table & "" set rs=dbc.execute(sql) %> <% closerecordset rs End Sub dim prevandor prevandor="" Sub specialsearchterm (SQL,sqladd,criterion,criterionvalue,andor,bracketopen) dim openbracket,closebracket openbracket="" closebracket="" if criterionvalue="" then exit sub if lcase(Sqladd)=" where" then sql=sql & sqladd sqladd="AND" end if if lcase(andor) = "not" then andor=" and " sql = sql & prevandor sql = sql & " " & criterion & " Not like '%" & replace(criterionvalue,"'","''") & "%'" prevandor=andor else select case (lcase(andor)) case "or" if bracketopen=false then openbracket="(" bracketopen=true end if case "and" if bracketopen then closebracket=")" bracketopen=false end if end select sql = sql & " " & prevandor & " " & openbracket & criterion & " like '%" & replace(criterionvalue,"'","''") & "%'" & closebracket & " " prevandor=andor end if sqladd="AND" End Sub Sub simplespecialsearchterm (SQL,sqladd,criterion,criterionvalue,criteriontype,bracketopen) dim openbracket,closebracket openbracket="" closebracket="" if criterionvalue="" then exit sub if lcase(Sqladd)=" where" then sql=sql & sqladd sqladd="AND" end if if bracketopen then closebracket=")" bracketopen=false end if select case criteriontype case "equals" criterionvalue = " like '" & replace(criterionvalue,"'","''") & "' " case "starts with" criterionvalue = " like '" & replace(criterionvalue,"'","''") & "%' " case "contains" criterionvalue = " like '%" & replace(criterionvalue,"'","''") & "%' " end select sql = sql & " " & openbracket & criterion & criterionvalue & closebracket sqladd="AND" End Sub '============================================== Sub AddHowMany %>
Results Per Page <%GenerateSelectV split("10,20,50,100",","),split("10,20,50,100",","),getsess("showhowmany"),"showhowmany", 4,getlang("langCommonSelect")%>
<% end sub %>