<%
' This ASP file uses VBScript to invoke the TalkingPhoneBook.com ProAd Display
' and then make a few modifications to display the ProAd on newstimes.com.
'
' 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
Function GetSearchResults(SearchURL, PartnerID, Keywords)
On Error Resume Next
CRLF = chr(13) & chr(10)
Response.write(CRLF & CRLF & "" & CRLF & CRLF)
Dim objXMLHTTP
Dim strFullURL
Dim strHTMLReturned
strHTMLReturned = ""
searchURL = URLDecode(SearchURL)
' Need to take the searchURL and remove the keywords parameter from it
beginKeywordsIndex = InStr(1,SearchURL,"&keywords")
endKeywordsIndex = InStr(beginKeywordsIndex + 1, SearchURL, "&")
'Response.Write(" endKeywordsIndex : " & endKeywordsIndex & "
")
preURL = Mid(SearchURL, 1, beginKeywordsIndex - 1)
postURL = ""
If (endKeywordsIndex > 0) Then
postURL = Mid(SearchURL, endKeywordsIndex + 1)
End If
'Response.Write("
preURL: " & preURL & "
")
'Response.Write("
postURL: " & postURL & "
")
strFullURL = preURL & "&keywords=" & Server.URLEncode(keywords) & "&" & postURL
'strFullURL = SearchURL & "?partnerid=" & partnerid & "&keywords=" & Trim(Keywords)
'strFullURL = SearchURL
Response.Write("")
Set objXMLHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
objXMLHttp.setTimeouts 60000, 60000, 60000, 60000
objXMLHttp.open "GET", strFullURL, false
With Err
If .Number = 0 Then
objXMLHttp.send
If .Number = 0 Then strHTMLReturned = objXMLHttp.responseText
'Response.Write("")
'Response.Write("")
Else
Response.Write(CRLF & CRLF & "" & CRLF)
Response.Write("" & CRLF & CRLF)
End If
End With
Set objXMLHttp = Nothing
GetSearchResults = strHTMLReturned
' Need to Swap TalkingPhoneBook.com's Google Key for NewsTimes.com's
GetSearchResults = Replace(GetSearchResults, "ABQIAAAAqKhDYfYHut89s0ObnmZ0sxQpFHar9AQhY2NmcU3O6WprM-10qBQruKBAPhsPlDNvdxdfdxC5hEB_8g", "ABQIAAAAh8RaunqJdJxbf9HHMCUDExRfeUk1FQG2JdTIJM3tUkvzPGzbvBQ4l5-4T5mUKzsW_EQLpfH0oRqoSg")
End Function
Function URLDecode(str)
str = Replace(str, "+", " ")
For i = 1 To Len(str)
sT = Mid(str, i, 1)
If sT = "%" Then
If i+2 <= Len(str) Then
sR = sR & _
Chr(CLng("&H" & Mid(str, i+1, 2)))
i = i+2
End If
Else
sR = sR & sT
End If
Next
URLDecode = sR
End Function
%>
ProAd Display
<%
If Len(Trim(Request.queryString("Keywords") & "")) > 0 Then
Response.Write("")
Response.Write("")
Response.Write("")
Response.Write(GetSearchResults(Mid(Request.QueryString,InStr(1,Request.QueryString,"tulink") + 7), Request.queryString("partnerId"), Request.queryString("keywords")))
End If
%>