<% ' 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 ' ---- Constants ---- Const searchCompletePage = "tpbsearchcomplete.asp" ' ---- Request Parameter Variables ---- Dim partnerId, keywords ' ---- 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 objProAdUrl, proAdUrl, objHeadingNodes, headingsLink, headingName, headingCode Dim objMisspellingNodes, objMisspellingFormat, objMisspellingTerm, misspellingFormat, misspellingFormatBeginTag Dim misspellingFormatEndTag, misspellingTerm, misspellingSuggestion, misspellingSuggestionLink partnerId = Trim(Request("partnerId")) keywords = Trim(Request("keywords")) displayNumResAsNum = 4 If IsNull(partnerId) Then partnerId = "4699" End If toResolve = 10000 toConnect = 10000 toSend = 10000 toReceive = 10000 beginTimeSecond = Second(Now) Set srvXmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP") URL = "http://www.talkingphonebook.com/wdpsearch/businessdataaccessxml.htm?searchtype=keyword&keywords=" & Server.URLEncode(keywords) & "&partnerId=" & partnerId 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 If numResults <= 0 And misspellingSuggestion <> "" Then %>

<%= keywords %>
Did you mean to search for <%= misspellingSuggestion %>?

<% End If If numResults > 0 Then endTimeSecond = Second(Now) totalSeconds = endTimeSecond - beginTimeSecond %>

<% If misspellingSuggestion <> "" Then %>

Did you mean to search for <%= misspellingSuggestion %>? <% End If Set objListings = xml.selectNodes("//listings/listing") For i=0 To displayNumResAsNum - 1 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 addressInfo = "" If address <> "" Then addressInfo = address & ", " End If If city <> "" Then addressInfo = addressInfo & city & ", " End If If state <> "" Then addressInfo = addressInfo & state & " " End If If zip <> "" Then addressInfo = addressInfo & 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 & " ]" %>

<%=title%>

<%= strFormattedPN %>

<% Next %>

<% End If End If Else ' Handle failure ' Response.Write("load failed") End If ' Clean up resources Set xml = nothing %>