<%
' Copyright (c) 2003 the-final-showdown@agresticism.org
' Licensed under the MIT license:
' http://www.opensource.org/licenses/mit-license.php
' ?O?GA!
' If you can use XML-RPC, do so. See http://www.wc.cc.va.us/dtod/xmlrpcb2/
' For blo.gs:
' xmlRPC("http://ping.blo.gs/", "weblogUpdates.extendedPing", Array(Name, URL, "", RSSURL))
' For Weblogs.Com:
' xmlRPC("http://rpc.weblogs.com/RPC2/", "weblogUpdates.ping", Array(Name, URL))
' For BlogRolling:
' xmlRPC("http://rpc.blogrolling.com/pinger/", "weblogUpdates.ping", Array(Name, URL))
Public Function PingSite(Site, Name, URL, RSSURL)
Dim HTTP, RegExp
Dim PingURL, PingParams, PingMethod, Delimiters
PingMethod = 1
' Uncomment these if you're doing this programatically. This file is also used for the demo, so that's why they aren't executed by default.
' Name = Server.URLEncode(Name)
' URL = Server.URLEncode(URL)
' RSSURL = Server.URLEncode(RSSURL)
' Can add more sites to this, if you like.
Select Case LCase(Site)
Case "weblogs.com":
' This returns a form, hence the delimiters.
PingURL = "http://newhome.weblogs.com/pingSiteForm?name=" & Name & "&url=" & URL
PingParams = ""
PingMethod = 2
Delimiters = Array("Enter the name and URL of a weblog that has been updated. \n", "
", "$2")
Case "blo.gs":
' direct set to 1 means that we get plain text back.
PingURL = "http://ping.blo.gs/"
PingParams = "name=" & Name & "&url=" & URL & "&direct=1"
Delimiters = Array("", "")
' rssURL is optional.
If Len(RSSURL) > 0 Then
PingParams = PingParams & "&rssURL=" & RSSURL
End If
Case "blogrolling":
'Also returns more than just text.
PingURL = "http://www.blogrolling.com/ping.php"
PingParams = "title=" & Name & "&url_1=" & URL & "&pingform=single"
Delimiters = Array("
", "", "$3")
End Select
Set HTTP = Server.CreateObject("SOFTWING.AspTear")
Set RegExp = New RegExp
' Ping the site and return the response.
PingSite = HTTP.Retrieve(PingURL, PingMethod, PingParams, "", "")
' Weblogs.com and BlogRolling return stuff we don't need, so strip that out and just return the text.
If Len(Delimiters(0)) > 0 Then
RegExp.Pattern = "([\w\W]+)" & Delimiters(0) & "(.*?)" & Delimiters(1) & "([\w\W]+)"
PingSite = Trim(RegExp.Replace(PingSite, Delimiters(2)))
End If
' Destroy the objects.
Set HTTP = Nothing
Set RegExp = Nothing
End Function
%>