<%option explicit%> <% ShopCheckAdmin "" '************************************************************************** ' Version 6.50 Display Projects with Billing Add-on ' November 11, 2005 '************************************************************************** dim Selectioncritereontext dim mysql Dim Fieldcount Dim Headnames(6) Dim Fieldnames(6) Dim ProcType Dim SortType Dim Sortfield Dim SortUpDown Dim Sortupdownnames(2) Dim Sortupdownvalues(2) dim sortupdowncount Dim Procnames(3) dim Procvalues(3) Dim Pendnames(20) dim Pendvalues(20) dim pendingcount dim Pendtype dim Pendingnamescount Dim Idfield Dim SearchFieldvalue, searchfieldname Dim i dim orderfieldcount, orderfields Dim item dim dbtable Dim scriptresponder Dim editresponder Dim dbc dim fieldname, projectdb projectdb=getconfig("xprojectdb") dim orderresponder, orderResponder1 dim specialsearchcount dim prevandor specialsearchcount=4 setsess "currenturl","shopa_projectdisplay.asp" if request.form("advanced") > "" then if request.form("advanced") <> getsess("advanced") then setsess "advanced", request.form("advanced") responseredirect "shopa_projectdisplay.asp" end if end if setsess "currenturl","shopa_projectdisplay.asp" AdminPageHeader ' Admin page headers are different SetFieldNames ' field names for table ShopOpenotherdb dbc, projectdb GetInput ' get all form fields If Request("Delete")<>"" Then For each item in Request("DeleteUser") DeleteRecord Item Next End if If Request("Process")<>"" Then For each item in Request("Processed") MarkProcessed Item Next End if GenerateSearchHeader ' Generate sort button etc scriptresponder="shopa_projectformat.asp" editresponder="shopa_editrecord.asp" 'debugwrite "sql=" & mysql ShopopenRecordSet mysql, rsorder, mypagesize, mypage GenerateTable ' write the tabe 'Call PageNavBar (Mysql) ' put bottom navigation bar rsOrder.close ' close database set rsOrder=nothing shopCloseDatabase dbc AdminPageTrailer ' Write admin trailer ' Sub GetInput Idfield="pid" mypage = Request.querystring("page") 'first time we need everything, othertimes sql is set up sortfield=request("Sortfield") ' See how we are sorting If Sortfield="" then sortfield="pid" end if 'response.write "sortfield="& sortfield ' see which types processed or unprocessed 'VP-ASP 6.09 - Security Precaution Proctype=cleanchars(request("Proctype")) If Proctype="" then Proctype="0" end if 'response.write "Proctype=" & proctype SortUpdown=request("SortUpdown") If SortUpdown="" then sortupdown="ASC" end if if mypage="" then mypage=1 GenerateSQL else Mysql=GetSess("projectsqlquery") Proctype=GetSess("projectProctype") sortfield=GetSess("projectsortfield") sortupdown=GetSess("projectsortupdown") end if maxrecs=getconfig("xeditdisplaymaxrecords") mypagesize=maxrecs end sub ' ' SQL is generate by using fields on form Sub GenerateSQL dim sqlproc dim dbtable, whereok dim bracketopen,i, 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" bracketopen=false dbtable="projects" MySql = "SELECT projects.* from " & dbtable 'whereok=" WHERE " for i = 1 to specialsearchcount specialsearchterm MYSQL,sqladd,Request("criterion" & i),Request("criterionvalue" & i ),Request("Selection" & i),bracketopen if sqladd = "AND" then whereok = " AND " else whereok =" WHERE " end if Next if bracketopen then MYSQl=MYSQL & ")" if getsess("advanced") <> "yes" then if Proctype="" then sqlproc = whereok & " processed=0" whereok= " AND " else if Proctype="*" then sqlproc="" else If Proctype="0" then sqlproc = whereok & " processed=" & Proctype whereok=" AND " else sqlproc = whereok & " processed<>0" whereok=" AND " end if end if end if end if Mysql = mysql & sqlproc 'VP-ASP 6.09 - Security precautions Searchfieldvalue=cleanchars(request("searchfieldvalue")) Searchfieldname=cleanchars(request("Searchfieldname")) If searchfieldvalue<>"" and searchfieldname<> getlang("Langcommonselect") then searchfieldvalue=Replace(searchfieldvalue,"'","''") if searchfieldname = "pid" then searchfieldname = "projects.pid" mysql = mysql & whereOK & searchfieldname & " LIKE '%" & searchfieldvalue & "%'" whereok= " and " end if If sortfield<>"" then mysql=mysql & " order by projects." & sortfield & " " & sortupdown end if 'VP-ASP 6.50 - Added 'project' to start of variable names here, as they were being called incorrectly and causing errors with paging SetSess "projectsqlquery",MySQL setSess "projectProctype",Proctype SetSess "projectsortfield",sortfield SetSess "projectsortupdown",sortupdown SetSess "sortupdown",sortupdown 'debugwrite mysql End sub Sub GenerateSQL_OLD dim sqlproc dim dbtable, whereok dbtable="projects" MySql = "SELECT * from " & dbtable whereok=" WHERE " 'response.write "generated sql=" & mysql if Proctype="" then sqlproc = whereok & " processed=0" whereok= " AND " else if Proctype="*" then sqlproc="" else If Proctype="1" then sqlproc = whereok & " processed<>0 " else sqlproc = whereok & " processed=0 " end if whereok=" AND " end if end if Mysql = mysql & sqlproc 'VP-ASP 6.09 - Security precautions Searchfieldvalue=cleanchars(request("searchfieldvalue")) Searchfieldname=cleanchars(request("Searchfieldname")) If searchfieldvalue<>"" and searchfieldname<> getlang("Langcommonselect") then mysql = mysql & whereOK & searchfieldname & " LIKE '%" & searchfieldvalue & "%'" end if If sortfield<>"" then mysql=mysql & " order by " & sortfield & " " & sortupdown end if SetSess "projectsqlquery",MySQL setSess "projectProctype",Proctype SetSess "projectsortfield",sortfield SetSess "projectsortupdown",sortupdown SetSess "sortupdown",sortupdown 'debugwrite mysql End sub ' Sub GenerateTable dim howmanyfields dim howmanyrecs dim my_link, fieldvalue dim billid, billurl, billformaturl howmanyfields=fieldcount GenerateDisplayHeaderFlat GenerateDisplayBodyHeader %>
<%if maxpages <> 0 then response.write getlang("langCommonPage") & mypage & getlang("langCommonOf") & maxpages%> <%if maxpages <> 0 then Call PageNavBar (Mysql)%>
<% Response.write "" Response.write "" 'Put Headings On The Table of Field Names for i=0 to howmanyfields ' Response.write ReportHeadColumn & Headnames(i) & ReportHeadColumnEnd Response.write ReportHeadColumn SortHeader Headnames(i), fieldnames(i) Response.write ReportHeadColumnEnd next Response.write ReportHeadColumn & getlang("LangOrdersMarkProcessed") & ReportHeadColumnEnd Response.write ReportHeadColumn & "
View
" & ReportHeadColumnEnd Response.write ReportHeadColumn & "
Edit
" & ReportHeadColumnEnd Response.write ReportHeadColumn & "
Delete
" & ReportHeadColumnEnd Response.write ReportRowEnd dim processed ' Now lets grab all the records howmanyrecs=0 DO UNTIL rsorder.eof OR howmanyrecs=maxrecs processed=rsorder("processed") 'VP-ASP 6.50 - broadened defintion of IF statement to cover cases where xmysql hasn't been set if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" OR getconfig("xMYSQL")="Yes" then if processed then processed=1 else processed=0 end if end if if processed<>0 then response.write ReportDetailRowX else response.write ReportDetailRow end if for i = 0 to howmanyfields fieldname=fieldnames(i) fieldvalue=rsorder(fieldname) Select case fieldname Case "price" response.write ReportDetailColumn & formatcurrency(rsorder(fieldname),getconfig("xdecimalpoint")) & ReportDetailcolumnend Case "billid" Formatbillid fieldvalue Case "paid" Case else response.write Reportdetailcolumn & rsorder(fieldname) & Reportdetailcolumnend end select next if processed<>0 then Response.write ReportDetailColumn & "

" & getlang("LangCommonYes") & "

" & ReportDetailColumnEnd else Response.write Reportdetailcolumn & "

" & reportdetailcolumnend end if Response.write ReportDetailColumn & "
" my_link=scriptresponder & "?oid=" & rsorder(idfield) & "&idfield=" & idfield %> View Project <% Response.write "
" & ReportDetailcolumnEnd Response.write ReportDetailColumn & "
" my_link=editresponder & "?which=" & rsorder(idfield) & "&idfield=" & idfield & "&table=projects" %> Edit Project <% Response.write "
" & ReportDetailColumnEnd %> <% Response.write ReportRowEnd howmanyrecs=howmanyrecs+1 if howmanyrecs < maxrecs then rsorder.movenext end if loop response.write("
") %>

">    ">
<% response.write("") %>
<%if maxpages <> 0 then response.write getlang("langCommonPage") & mypage & getlang("langCommonOf") & maxpages%> <%if maxpages <> 0 then Call PageNavBar (Mysql)%>
<% GenerateDisplayBodyFooter gethelp end sub Sub SetFieldNames Fieldcount=5 Fieldnames(0)="pid" Fieldnames(1)="pdate" fieldnames(2)="customer" fieldnames(3)="price" fieldnames(4)="description" fieldnames(5)="billid" Headnames(0)="pid" Headnames(1)= getlang("LangDisplayDate") Headnames(2)="Customer" Headnames(3)= getlang("LangDisplayAmount") Headnames(4)="Description" Headnames(5)="Billing #" Sortupdownnames(0)= getlang("LangAscending") Sortupdownnames(1)= getlang("LangDescending") Sortupdownvalues(0)="ASC" Sortupdownvalues(1)="DESC" Procnames(0)= getlang("LangCommonAll") Procnames(1)= getlang("LangProcessed") Procnames(2)= getlang("LangUnprocessed") ProcValues(0)="*" ProcValues(1)="1" ProcValues(2)="0" end sub Sub DeleteRecord(Item) dim Rowsaffected dbc.Execute "delete from projects where pid = " & Item, RowsAffected, 1 end sub Sub MarkProcessed (Item) 'Response.write "item=" & item sql= "update projects set processed = 1 where pid =" & item dbc.Execute sql End sub Sub GenerateSearchHeader %>
Display Projects <%shopwriteheader "Display Projects" %> Add New Project

<% if serror > "" then%>
<%shopwriteerror sError%>

<%end if%>
Search Projects
<% if getconfig("xorderpending")="Yes" then %> <% end if %>
Only show Projects that are:
<%GenerateSelect Procnames,ProcValues,Proctype,"Proctype",2%>
<%GenerateSelect Pendnames,PendValues,Pendtype,"Pendtype",Pendingnamescount-1%>
 
<% GenerateSearch %>
<%WriteSelectTable specialsearchcount%>
<% AddHowMany %>

">

" type="hidden" id="advanced">
<%end sub ' Sub GenerateRadio (Fieldname,fieldvalue,radiotype, currentvalue) if currentvalue=Fieldvalue then %> <%=fieldname%>
<% else %> <%=fieldname%>
<% end if end sub Sub GenerateSelect (iFieldnames,ifieldvalues,currentvalue,selectname, count) %> <% end sub Sub GenerateSearch GetFieldnames %>
<%=getlang("langCommonSearch")%> <% if instr(searchfieldname, ".") > 0 then GenerateSelectNV OrderFields, right(searchfieldname, len(searchfieldname) - instr(searchfieldname, ".")), "searchfieldname", orderfieldcount,getlang("langCommonSelect") else GenerateSelectNV OrderFields, searchfieldname, "searchfieldname", orderfieldcount,getlang("langCommonSelect") end if %>
<% end sub Sub GetFieldNames dim sqltemp, dbc, rstemp If GetSess("projectfieldcount")<>"" then Orderfields=GetSessA("ProjectFields") OrderfieldCount=GetSess("ProjectFieldCount") exit sub end if redim orderfields(200) ShopOpenOtherdb dbc, projectdb sqltemp="select * from projects " set rstemp=dbc.execute(sqltemp) orderfieldcount=rstemp.fields.count -1 for i=0 to orderfieldcount OrderFields(i)= rstemp(i).name next SetSessA "ProjectFields",Orderfields SetSess "ProjectFieldCount",Orderfieldcount rstemp.close set rstemp=nothing shopclosedatabase dbc end sub ' Sub Formatbillid (billid) dim billurl, billformaturl billurl="" If not isnull (billid) then if billid>0 then billformaturl="shopa_billingformat.asp?id=" & billid billurl= "" & billid & "" end if end if response.write ReportDetailColumn & billurl & ReportDetailcolumnend 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 i,""%>
" name=criterionvalue<%=i%> size="15">
<%RadioButtons i%>
<% End Sub '============================================== ' SPECIAL SEARCH CUSTOMISATION ' Write all the fields for that table '============================================== Sub Writetableallfields (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 projects" Set rs = dbc.Execute(SQL) %> <% closerecordset rs 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 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 specialsearchterm (SQL,sqladd,criterion,criterionvalue,andor,bracketopen) dim openbracket,closebracket openbracket="" closebracket="" if criterionvalue="" then exit sub if criterion = "pid" then criterion = "projects.pid" 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 '%" & 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 '%" & criterionvalue & "%'" & closebracket & " " prevandor=andor end if sqladd="AND" End Sub Sub addpendingsql (sqlproc, whereok) if Pendtype="" then exit sub end if if Pendtype="*" then exit sub else pendtype=replace(pendtype,"'","''") If Pendtype="No" then sqlproc = sqlproc & whereok & " (opending='" & Pendtype & "'" & " or opending is null )" else sqlproc = sqlproc & whereok & " (opending='" & Pendtype & "'" & ")" end if whereok=" AND " end if end sub %>