Greenwitchcitizen.com Business Search

<% ' This ASP file uses VBScript to invoke the TalkingPhoneBook.com Yellow Page ' XML Service and displays the output. The page layout of these results ' is consistent with the previous page design (the YELLOW PAGE RESULTS section is ' in the bottom right corner of a four section table layout). ' ' NOTE: We do not have a .NET environment to develop on at The Talking Phone Book ' so our implementation is limited to VBScript. We have designed and tested this ' functionality thouroughly and are confident in the overall solution. However, ' utilizing advanced exception handling mechanisms available in a .NET environment ' would make this solution more robust. Additionaly, I had to be quite creative to ' deliver much of the functionality contained below. The development phase would ' have been a lot quicker and easier if this were developed using .NET. Keep this ' in mind if you plan to add additional functionality to this page. ' ' David Avery - davery@talkingphonebook.com ' Created January 2009 - For NewsTimes.com based on previous implementation for timesunion.com ' ---- Request input parameters ---- Dim keywords, partnerId, bookCodeString, letter, heading_code, start, location, zipCode, searchType Dim numHeadingsToDisplay, numCitiesToDisplay, numZipsToDisplay ' ---- Additional Member Variables ---- Dim queryString, evenOddStyle ' ---- Member variables for connecting to the XML service and parsing the results ---- Dim toResolve, toConnect, toSend, toReceive, srvXmlHttp, URL Dim currNode, numResults, results, xml, objListings, hasResultsBool Dim objTitle, title, objAddress, address, objCity, city, objState, state, objZip, zip, objPhone, phone, phoneRe, strFormattedPN Dim cityStateZipInfo, objProAdUrl, proAdUrl, objHeadingNodes, headingsLink, headingName, headingCode Dim objMisspellingNodes, objMisspellingFormat, objMisspellingTerm, misspellingFormat, misspellingFormatBeginTag Dim misspellingFormatEndTag, misspellingTerm, misspellingSuggestion, misspellingSuggestionLink Dim objRefinementHeadingNodes, objHeadingC, objHeadingN, objListingC, headingC, headingN, listingC Dim objRefinementCityNodes, objCityName, cityName, ojbCityListingC, cityListingC Dim objRefinementZipNodes, ojbZipCode, zipC ' ---- Constant for search results page (this page) in case you need to change it later ---- Const searchCompletePage = "tpbsearchcomplete.asp" keywords = Trim(Request("keywords")) partnerId = Trim(Request("partnerId")) bookCodeString = Request.QueryString("book_code") letter = Trim(Request("letter")) heading_code = Trim(Request("heading_code")) start = Trim(Request("start")) If Len(start & "") <= 0 Then start = 1 End If location = Trim(Request("location")) zipCode = Trim(Request("zip")) searchType = Trim(Request("searchType")) If Len(searchType & "") <= 0 Then searchType = "keyword" End if numHeadingsToDisplay = Trim(Request("nhtd")) numCitiesToDisplay = Trim(Request("nctd")) numZipsToDisplay = Trim(Request("nztd")) queryString = Request.QueryString() %> Greenwitchcitizen.com Business Search

<% ' VBScript Functions Function ConvertToJSArray1D(VBArray, ArrayName) Dim vb2jsRow , vb2jsStr, vb2jsi vb2jsRow = Ubound(VBArray,1) %> <% Response.Write("") End Function %> <% ' If we have at least a keyword and a partnerId we can do a search If Len(keywords & "") > 0 And Len(partnerId & "") > 0 Then ' Build the search URL URL = "http://www.talkingphonebook.com/wdpsearch/businessdataaccessxml.htm?searchtype="&searchType&"&keywords=" & Server.URLEncode(keywords) & "&partnerId=" & partnerId 'If Len(searchType & "") > 0 And searchType = "category" Then 'URL = Replace(URL, "http://www.talkingphonebook.com/wdpsearch/businessdataaccessxml.htm?searchtype=keyword", "http://www.talkingphonebook.com/wdpsearch/businessdataaccessxml.htm?searchtype=category") 'End If ' Add book_code params if any where passed to this page For Each item In Request.QueryString("book_code") URL = URL & "&book_code=" & Server.URLEncode(item) Next ' Add letter if one was passed to this page If Len(letter & "") > 0 Then URL = URL & "&letter=" & Server.URLEncode(letter) End If ' Add heading_code if one was passed to this page If Len(heading_code & "") > 0 Then URL = URL & "&heading_code=" & Server.URLEncode(heading_code) End If ' Add start if one was passed to this page If Len(start & "") > 0 Then URL = URL & "&start=" & Server.URLEncode(start) End If ' Add location if one was passed to this page If Len(location & "") > 0 Then URL = URL & "&location=" & Server.URLEncode(location) End If ' Add zip if one was passed to this page If Len(zipCode & "") > 0 Then URL = URL & "&zip=" & Server.URLEncode(zipCode) End If toResolve = 10000 toConnect = 10000 toSend = 10000 toReceive = 10000 Set srvXmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP") srvXmlHttp.open "GET", URL, false srvXmlHttp.setTimeouts toResolve, toConnect, toSend, toReceive ' not needed but a handy feature srvXmlHttp.send() If srvXmlHttp.status = 200 Then ' not needed but also a handy feature result = srvXmlHttp.responseText Set xml = Server.CreateObject("MSXML2.DOMDocument") If xml.load(srvXmlHttp.responseStream) Then xml.setProperty "SelectionLanguage", "XPath" Set objMisspellingNodes = xml.selectNodes("//misspellings/misspelling") misspellingSuggestion = "" misspellingFormat = "" For Each Node In objMisspellingNodes Set objMisspellingFormat = Node.selectSingleNode("format") misspellingFormat = objMisspellingFormat.Text If misspellingFormat <> "normal" Then misspellingFormatBeginTag = "" misspellingFormatEndTag = "" Else misspellingFormatBeginTag = "" misspellingFormatEndTag = "" End If Set objMisspellingTerm = Node.selectSingleNode("term") misspellingTerm = objMisspellingTerm.Text misspellingSuggestion = misspellingSuggestion & " " & misspellingFormatBeginTag & misspellingTerm & misspellingFormatEndTag misspellingSuggestionLink = misspellingSuggestionLink & " " & misspellingTerm Next Set currNode = xml.selectSingleNode("//metadata/numresults") On Error Resume Next numResults = currNode.Text Err.Clear Set objRefinementHeadingNodes = xml.selectNodes("//refinement/headings/heading") ' By declaring the headingArray of 50 records we are setting the upper bound to ' total number of headings displayed on the refinement form. The more optimal ' solution would be to use the objRefinementHeadingNodes.Length value, but this ' isn't possible with the VBScript solution because to declare the Array object ' you must use an Integer constant. I would change this if you are on a .NET ' environment to eliminate unnecessary processing and better functionality if there ' are indeed more than 50 headings. Dim headingsArray(50), headingCounter headingCounter = 0 For Each Node In objRefinementHeadingNodes Set objListingC = Node.selectSingleNode("listing_count") listingC = objListingC.Text Set objHeadingC = Node.selectSingleNode("heading_code") headingC = objHeadingC.Text Set objHeadingN = Node.selectSingleNode("heading_name") headingN = ObjHeadingN.Text headingsArray(headingCounter) = listingC & "$" & headingN & "$" & headingC headingCounter = headingCounter + 1 Next Call ConvertToJSArray1D(headingsArray,"headingsArray") Set objRefinementCityNodes = xml.selectNodes("//refinement/cities/city") ' See note above about declaring the array Dim citiesArray(50), cityCounter cityCounter = 0 For Each Node In objRefinementCityNodes Set ojbCityListingC = Node.selectSingleNode("listing_count") cityListingC = ojbCityListingC.Text Set objCityName = Node.selectSingleNode("city_name") cityName = objCityName.Text citiesArray(cityCounter) = cityListingC & "$" & cityName cityCounter = cityCounter + 1 Next Call ConvertToJSArray1D(citiesArray, "citiesArray") Set objRefinementZipNodes = xml.selectNodes("//refinement/zipcodes/zip") ' See note above about declaring the array Dim zipsArray(50), zipCounter zipCounter = 0 For Each Node In objRefinementZipNodes zipC = Node.Text zipsArray(zipCounter) = zipC zipCounter = zipCounter + 1 Next Call ConvertToJSArray1D(zipsArray, "zipsArray") %>

REFINE YOUR SEARCH

CATEGORY

LOCATIONS

ZIP CODE

SORT BY LETTER

A B C D E F G H I J K L M N O P Q R S T U V W X Y Z ... All

<% Set objListings = xml.selectNodes("//listings/listing") For i=0 To 9 If i < objListings.length Then If i Mod 2 <> 1 Then evenOddStyle = "even" Else evenOddStyle = "odd" End If Set objListing = objListings.item(i) proAdUrl = "" Set objProAdUrl = objListing.selectSingleNode("proad_url") On Error Resume Next proAdUrl = objProAdUrl.Text Err.Clear Set objTitle = objListing.selectSingleNode("title") title = objTitle.Text Set objAddress = objListing.selectSingleNode("line/address") address = objAddress.Text Set objCity = objListing.selectSingleNode("line/city") city = objCity.Text Set objState = objListing.selectSingleNode("line/state") state = objState.Text Set objZip = objListing.selectSingleNode("line/zip") zip = objZip.Text cityStateZipInfo = "" If city <> "" Then cityStateZipInfo = cityStateZipInfo & city & ", " End If If state <> "" Then cityStateZipInfo = cityStateZipInfo & state & " " End If If zip <> "" Then cityStateZipInfo = cityStateZipInfo & zip End If Set objPhone = objListing.selectSingleNode("line/phone") phone = objPhone.Text Set phoneRe = New RegExp ' Specify the pattern phoneRe.Pattern = "(\d{3})(\d{3})(\d{4})" ' Use the replace method to perform the formatting strFormattedPN = phoneRe.Replace(phone, "($1) $2-$3") Set objHeadingNodes = objListing.selectNodes("heading") headingsLink = "[ " headingName = "" headingCode = "" For Each Node In objHeadingNodes Set objHeadingName = Node.selectSingleNode("heading_name") headingName = objHeadingName.Text Set objHeadingCode = Node.selectSingleNode("heading_code") headingCode = objHeadingCode.Text headingsLink = headingsLink & "" headingsLink = headingsLink & headingName headingsLink = headingsLink & ", " Next headingsLink = Left(headingsLink, Len(headingsLink) - 2) headingsLink = headingsLink & " ]" %> <% End If Next %>

<%= keywords %> Listing(s) <% If misspellingSuggestion <> "" Then queryString = Replace(queryString, Server.URLEncode(keywords), Server.URLEncode(misspellingSuggestionLink)) %>
Did you mean to search for <%= misspellingSuggestion %>? <% End If %>

<% If proAdUrl <> "" Then proAdUrl = "tpbnewstimesproad.asp?tulink=" & proAdUrl & "&url=url&maxSearchPage=maxSearchPage&partnerId=" & Server.URLEncode(partnerId) & "&keywords=" & Server.URLEncode(keywords) & "&supressHeader=1" %> <% Else %> <% End If %> <% if headingName<>"" then %> <% end if %>

<%=title%>	Info	<%=title%>
<%= address %> <%= cityStateZipInfo %> Phone: <%= strFormattedPN %>
<%= headingsLink %>
<% if address <>"" then %> ">Map \| ">Directions <% end if %>

<% End If Else ' Handle failure ' Response.Write("load failed") End If End If%>