<% ' ************************************ Z-ODP Code ********************************************** ' * Copyright Notice: ' & Copyright 2006 - Sevic Network, Inc (Zoran Sevic) - http://zodp.sevic.net ' * ' * You may use and change this script as you see fit with the following conditions: ' * - You do not pass off this script as your own. ' * - You do not sell this script and only distribute it for free. ' * - Any changes made to this script to be freely shared with others ' * - You must leave this copyright notice intact even if you make changes to the script ' * - You are allowed to add additional copyrights from your own dirivative works of this script ' * - The link back at the bottom is not removed. ' ********************************************************************************************* Dim strOdpUrl, strOdpSearchUrl Dim strOdpPath, strOdpCat, strOdpTitle Dim objOdpXmlHttp Dim strOdpHtml Dim strOdpStatus strOdpUrl = "http://dmoz.org" strOdpSearchUrl = "http://search.dmoz.org/cgi-bin/search" If request.QueryString("type") = "search" Then strOdpCat = request.QueryString("cat") strOdpTitle = replace(request.QueryString("cat"), "/", ":") & ":Search Directory" Else strOdpCat = replace(replace(request.QueryString("path"), "/desc.html", ""), "/faq.html", "") strOdpTitle = replace(replace(strOdpCat, "/", ":"), "_", " ") Select Case request.QueryString("type") Case "desc" strOdpTitle = strOdpTitle & ":Category Description" Case "faq" strOdpTitle = strOdpTitle & ":Category FAQs" End Select End If 'Response.CharSet = "UTF-8" Function ZOdp () If (request.QueryString("path") = "" OR request.QueryString("path") = "/") AND request.QueryString("type") <> "search" Then Call writeRoot("") Call writeFooter() Else ' Set objOdpXmlHttp = Server.CreateObject("Msxml2.XMLHTTP") Set objOdpXmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") strOdpPath = request.QueryString("path") If request.QueryString("type") = "search" Then objOdpXmlHttp.open "GET", strOdpSearchUrl & "?" & request.ServerVariables("QUERY_STRING"), False Else '*** must replace the %2F to a / as the xml has a bug when you encode the url *** objOdpXmlHttp.open "GET", strOdpUrl & replace(Server.URLEncode(strOdpPath), "%2F", "/"), False End If objOdpXmlHttp.send strOdpStatus = objOdpXmlHttp.status If strOdpStatus = "200" Then strOdpHtml = objOdpXmlHttp.responseText ' Removes all headers from the html strOdpHtml = leftStrip(strOdpHtml, "") strOdpHtml = rightStrip(strOdpHtml, "") strOdpHtml = leftStrip(strOdpHtml, "") strOdpHtml = middlestrip(strOdpHtml, "") strOdpHtml = replace(strOdpHtml, "", "", 1, -1, 1) Select Case request.QueryString("type") Case "cat" Call parseCategory() Case "desc" Call parseDesc() Case "faq" Call parseFAQ() Case "search" Call parseSearch() Case "profile" Call parseEditorProfile() Case else End Select Call writeOdpPage() Else strOdpHtml = "ERROR Status:" & strOdpStatus End If Set objOdpXmlHttp = nothing Call writeFooter() End If End Function Function leftStrip(html, beginTag) leftStrip = html If instr(lcase(html), lcase(beginTag)) Then leftStrip = mid(html, instr(lcase(html), lcase(beginTag)) + len(beginTag)) End If End Function Function leftStripRev(html, beginTag) leftStripRev = html if InstrRev(lcase(html), lcase(beginTag)) Then leftStripRev = mid(html, instrrev(lcase(html), lcase(beginTag)) + len(beginTag)) End If End Function Function rightStrip(html, beginTag) rightStrip = html If instr(lcase(html), lcase(beginTag)) Then rightStrip = left(html, instr(lcase(html), lcase(beginTag))-1) End If End Function Function rightStripRev(html, beginTag) rightStripRev = html If instrRev(lcase(html), lcase(beginTag)) Then rightStripRev = left(html, instrrev(lcase(html), lcase(beginTag))-1) End If End Function Function middleStrip(html, beginTag, endTag) ' this routine basically nulls/strips everything from the a starting point to an ending point ' it uses a pretty complex routine, so change this at your own risk. middleStrip = html If instr(lcase(html), lcase(beginTag)) > 0 and instr(lcase(html), lcase(beginTag)) < instr(instr(lcase(html), lcase(beginTag)) + 1, lcase(html), lcase(endTag)) Then ' loop until there are no more changes needed. While instr(lcase(middleStrip), lcase(beginTag)) > 0 and instr(lcase(middleStrip), lcase(beginTag)) < instr(instr(lcase(middleStrip), lcase(beginTag)) + 1, lcase(middleStrip), lcase(endTag)) middleStrip = replace(middleStrip, mid(middleStrip, instr(lcase(middleStrip), lcase(beginTag)), ((instr(instr(lcase(middleStrip), lcase(beginTag)) + 1, lcase(middleStrip), lcase(endTag)) + len(endTag)) - instr(lcase(middleStrip), lcase(beginTag)))), "", 1, -1, 1) Wend End If End Function Function complexReplace(html, beginTag, endTag, replaceWith) ' this routine basically nulls/strips everything from the a starting point to an ending point ' it uses a pretty complex routine, so change this at your own risk. complexReplace = html If instr(lcase(html), lcase(beginTag)) > 0 and instr(lcase(html), lcase(beginTag)) < instr(instr(lcase(html), lcase(beginTag)) + 1, lcase(html), lcase(endTag)) Then ' loop until there are no more changes needed. While instr(lcase(complexReplace), lcase(beginTag)) > 0 and instr(lcase(complexReplace), lcase(beginTag)) < instr(instr(lcase(complexReplace), lcase(beginTag)) + 1, lcase(complexReplace), lcase(endTag)) complexReplace = replace(complexReplace, mid(complexReplace, instr(lcase(complexReplace), lcase(beginTag)), ((instr(instr(lcase(complexReplace), lcase(beginTag)) + 1, lcase(complexReplace), lcase(endTag)) + len(endTag)) - instr(lcase(complexReplace), lcase(beginTag)))), replaceWith, 1, -1, 1) Wend End If End Function Function breadCrumb() End Function Function parseCategory() ' strOdpHtml = rightStripRev(strOdpHtml, "") strOdpHtml = rightStripRev(strOdpHtml, "

") strOdpHtml = middleStrip(strOdpHtml, "") strOdpHtml = replace(strOdpHtml, "href=""/profiles/", "href=""?type=profile&path=/profiles/", 1, -1, 1) strOdpHtml = replace(strOdpHtml, strOdpSearchUrl, "", 1, -1, 1) strOdpHtml = replace(strOdpHtml, "" & vbnewline & " (editors only)") strOdpHtml = replace(strOdpHtml, "href=""/", "href=""?type=cat&path=/", 1, -1, 1) strOdpHtml = replace(strOdpHtml, "href=/", "href=?type=cat&path=/", 1, -1, 1) 'editors sometimes put hard coded links into their diescription strOdpHtml = replace(strOdpHtml, "href=""http://dmoz.org", "href=""?type=cat&path=", 1, -1, 1) End Function Function parseSearch() strOdpHtml = rightStripRev(strOdpHtml, "") strOdpHtml = replace(strOdpHtml, "" & vbnewline & "", "") strOdpHtml = middleStrip(strOdpHtml, "", "") strOdpHtml = replace(strOdpHtml, "") strOdpHtml = leftStrip(strOdpHtml, "") strOdpHtml = replace(strOdpHtml, "href=""faq.html#", "href=""#", 1, -1, 1) strOdpHtml = complexReplace(strOdpHtml, "by ", "Last modified") ' strOdpHtml = replace(strOdpHtml, "href=""/profiles/", "href=""?type=profile&path=/profiles/", 1, -1, 1) strOdpHtml = replace(strOdpHtml, "href=""/", "href=""?type=cat&path=/", 1, -1, 1) 'editors sometimes put hard coded links into their diescription strOdpHtml = replace(strOdpHtml, "href=""http://dmoz.org", "href=""?type=cat&path=", 1, -1, 1) strOdpHtml = "

"& strOdpTitle & "

" & strOdpHtml End Function Function parseEditorProfile() strOdpHtml = rightStripRev(strOdpHtml, "") strOdpHtml = middleStrip(strOdpHtml, "") '--------------------------------------------------------------------------------------- strOdpHtml = replace(strOdpHtml, "img src=""/img/", "img src=""http://dmoz.org/img/", 1, -1, 1) strOdpHtml = replace(strOdpHtml, "href=""/", "href=""?type=cat&path=/", 1, -1, 1) ' strOdpHtml = replace(strOdpHtml, "href=""/", "href=""" & "?cat=/") End Function Function writeOdpPage () Response.Write strOdpHtml End Function Function writeRoot(targerPage) Response.write("" & vbNewline) Response.write("

" & vbNewline) Response.write("Arts " & vbNewline) Response.write("Movies," & vbNewline) Response.write("Television," & vbNewline) Response.write("Music..." & vbNewline) Response.write("	" & vbNewline) Response.write("Business " & vbNewline) Response.write("Jobs," & vbNewline) Response.write("Real Estate," & vbNewline) Response.write("Investing..." & vbNewline) Response.write("	" & vbNewline) Response.write("Computers " & vbNewline) Response.write("Internet," & vbNewline) Response.write("Software," & vbNewline) Response.write("Hardware..." & vbNewline) Response.write("
" & vbNewline) Response.write("Games " & vbNewline) Response.write("Video Games," & vbNewline) Response.write("RPGs," & vbNewline) Response.write("Gambling..." & vbNewline) Response.write("	" & vbNewline) Response.write("Health " & vbNewline) Response.write("Fitness," & vbNewline) Response.write("Medicine," & vbNewline) Response.write("Alternative..." & vbNewline) Response.write("	" & vbNewline) Response.write("Home " & vbNewline) Response.write("Family," & vbNewline) Response.write("Consumers," & vbNewline) Response.write("Cooking..." & vbNewline) Response.write("
" & vbNewline) Response.write("Kids and Teens " & vbNewline) Response.write("Arts," & vbNewline) Response.write("School Time," & vbNewline) Response.write("Teen Life..." & vbNewline) Response.write("	" & vbNewline) Response.write("News " & vbNewline) Response.write("Media," & vbNewline) Response.write("Newspapers," & vbNewline) Response.write("Weather..." & vbNewline) Response.write("	" & vbNewline) Response.write("Recreation " & vbNewline) Response.write("Travel," & vbNewline) Response.write("Food," & vbNewline) Response.write("Outdoors," & vbNewline) Response.write("Humor..." & vbNewline) Response.write("
" & vbNewline) Response.write("Reference " & vbNewline) Response.write("Maps," & vbNewline) Response.write("Education," & vbNewline) Response.write("Libraries..." & vbNewline) Response.write("	" & vbNewline) Response.write("Regional " & vbNewline) Response.write("US," & vbNewline) Response.write("Canada," & vbNewline) Response.write("UK," & vbNewline) Response.write("Europe..." & vbNewline) Response.write("	" & vbNewline) Response.write("Science " & vbNewline) Response.write("Biology," & vbNewline) Response.write("Psychology," & vbNewline) Response.write("Physics..." & vbNewline) Response.write("
" & vbNewline) Response.write("Shopping " & vbNewline) Response.write("Autos," & vbNewline) Response.write("Clothing," & vbNewline) Response.write("Gifts..." & vbNewline) Response.write("	" & vbNewline) Response.write("Society " & vbNewline) Response.write("People," & vbNewline) Response.write("Religion," & vbNewline) Response.write("Issues..." & vbNewline) Response.write("	" & vbNewline) Response.write("Sports " & vbNewline) Response.write("Baseball," & vbNewline) Response.write("Soccer," & vbNewline) Response.write("Basketball..." & vbNewline) Response.write("
" & vbNewline) Response.write("World " & vbNewline) Response.write("Deutsch," & vbNewline) Response.write("Espa�ol," & vbNewline) Response.write("Fran�ais," & vbNewline) Response.write("Italiano," & vbNewline) Response.write("Japanese," & vbNewline) Response.write("Nederlands," & vbNewline) Response.write("Polska," & vbNewline) Response.write("Dansk," & vbNewline) Response.write("Svenska..." & vbNewline) Response.write("

" & vbNewline) End Function Function writeFooter () Response.write("

" & vbNewline) ' ******** DO NOT DELETE - this must stay as per license agreement with ODP ********** Response.write("

" & vbNewline) Response.write("" & vbNewline) Response.write("" & vbNewline) Response.write("

Help build the largest human-edited directory on the web.

" & vbNewline) Response.write("Submit a Site -" & vbNewline) Response.write("Open Directory Project -" & vbNewline) Response.write("Become an Editor" & vbNewline) Response.write("

" & vbNewline) Response.write("

" & vbNewline) ' ************************************************************************************* ' ***** DO NOT DELETE - the link back must stay to use this script ******************** Response.Write("

Powered by Z-ODP

") ' ************************************************************************************* End Function %>