<%Option Explicit%> <% '****************************************************************** ' Version 6.50 June 29, 2005 ' This routine Lists review for a product ' if xreviewauthorize is yes, then check listing for authorized ' Dec 31, 2005 Fix paging next and previous '****************************************************************** Dim dbc, url Dim PRODUCTNAME, CATALOGID SetSess "CurrentUrl","shopreviewlist.asp" ShopOpenDatabase dbc mypage=request.querystring("page") If not isnumeric(mypage) then shoperror "Page size must be numeric" end if mypagesize=Getconfig("xeditdisplaymaxrecords") ' If there is no page, then we must generate sql otherwise sqlis in Session(sqlQuery) if mypage= "" then mypage=1 ' first time through ProcessFirst ' get input variables CreateSql ' generate sql else sql=GetSess("reviewsql") ' on recursive calls we stored sql in sessikon variable catalogid=GetSess("reviewid") ' on recursive calls we stored sql in sessikon variable end if ShopPageHeader ' normal page header GetProductDetails if getconfig("xbreadcrumbs") = "Yes" then if ucase(getconfig("xCrossLinkurl"))="SHOPEXD.ASP" then 'VP-ASP 6.50.4 - added getconfig call around xmysite url= getconfig("xMYSITE") & "shopexd.asp?id=" & catalogid else 'VP-ASP 6.50.4 - added getconfig call around xmysite url= getconfig("xMYSITE") & "shopquery.asp?catalogid=" & catalogid end if response.write "" end if Response.Write "

" & getlang("LangRatingRead") & "

" Response.write ReviewHeader AddHyperlinks Response.write ReviewHeaderEnd DisplayAddMessage DisplayProducts ' display products ShopPageTrailer ' normal trailer Shopclosedatabase dbc ' Process first time Sub ProcessFirst() catalogid= Request("id") ' category id If catalogid="" then shoperror getlang("LangNoCatalogId") end if if not isnumeric(catalogid) then shoperror getlang("LangNoCatalogId") end if SetSess "Reviewid",catalogid end sub ' Sub CreateSQL() sql="select * from reviews where catalogid=" & catalogid If getconfig("xratingauthorize")="Yes" then sql=sql & " and authorized is not null" end if sql=sql & " order by id desc" Setsess "reviewsql",sql 'debugwrite sql end sub ' ****** Display Products Sub DisplayProducts() Dim header Dim recordcount dim words dim wordcount dim i dim msg dim rc ShopOpenRecordSet SQL,objRS, mypagesize, mypage if objRS.eof then objRS.Close set objRS=nothing ShopCloseDatabase dbc shopwriteerror getlang("langRatingNone") exit sub end if recordcount=0 'response.write "

" & getconfig("xfont") & getlang("LangCommonPage") & mypage & getlang("LangCommonOf") & maxpages & "" Response.write reporttabledef While Not objRS.EOF and recordcount < maxrecs ReviewFormatRow ' actual row is formatted objRS.MoveNext recordcount=recordcount+1 Wend response.write reporttableend dim savesql savesql=getsess("sqlquery") ' Dec 31 mod if getconfig("xproductpagingnextprevious")="Yes" then Call PageNavBarNext (SQL) else Call PageNavBar (SQL) end if ' end mod setsess "sqlquery",savesql closerecordset objrs end sub Sub ReviewFormatRow dim comment, title,location,name,reviewdate,stars dim rating, starimage comment=objrs("comment") title=objrs("title") name=objrs("name") location=objrs("location") reviewdate=objrs("reviewdate") rating=objrs("rating") GetStars rating, starimage Response.write tablerow Response.write tablecolumn Response.write title & "   " If starimage<>"" then response.write "
" end if Response.write name & "  " & location & "  " & reviewDate Response.write reportdetailcolumnend & tablerowend Response.write reportdetailrow Response.write reportdetailcolumn Response.write "

" & Comment & "

" Response.write reportdetailcolumnend & tablerowend Response.write " " end sub Sub GetStars(rating,image) dim strrating strrating=cstr(rating) Select case strrating Case "1" image="vpasp_stars1.gif" Case "2" image="vpasp_stars2.gif" Case "3" image="vpasp_stars3.gif" Case "4" image="vpasp_stars4.gif" Case "5" image="vpasp_stars5.gif" Case else image="" end select 'VP-ASP 600 - moved images to images/misc folder if image > "" then image = "images/misc/" & image end if end Sub Sub GetProductDetails dim rs, psql, conn shopopendatabaseP conn psql="select * from products where catalogid=" & catalogid set rs=conn.execute(psql) if not rs.eof then productname=rs("cname") productname=translatelanguage(dbc, "products", "cname","catalogid", catalogid, productname) end if rs.close set rs=nothing shopclosedatabase conn end sub ' Sub AddHyperlinks Dim strurl, strmessage, breaker Response.write ReviewHyperlinkFont strurl="shopreviewadd.asp?id=" & catalogid strurl=addwebsess(strurl) strMessage=breaker & "" & getlang("LangRatingWrite") & "" breaker="  " response.write strMessage strurl="shopquery.asp?catalogid=" & catalogid strurl=addwebsess(strurl) strMessage=breaker & "" & getlang("LangRatingProductReturn") & "" breaker="  " response.write strMessage Response.write reviewhyperlinkfontend end sub Sub DisplayaddMessage 'VP-ASP 6.50 - precautionary security fix sError=cleanchars(request("msg")) If serror="" then exit sub shopwriteerror getlang("LangReviewAuthorize") end sub %>