Friday, April 22, 2011

Ping using XML-RPC in ASP.NET

Many blogs have the ability to ping different ping-services, such as Ping-o-Matic, Feedburner and Techorati, whenever some content is created or updated. But it is not only blogs who can benefit from pinging these services. Almost all websites that is updated regularly can use this technique.
All these services use XML_RPC and the exact same format, so you can write a ping class ones and then just add whatever ping service URL later. I’ve written a very simple static ping class that can be used in any ASP.NET application.

The code


Here is the the three methods needed to send XML-RPC pings.

Imports Microsoft.VisualBasic
Imports System.Xml
Imports System.IO
Imports System.Net


Public Class XMLRPCPingRequest
    Public Function Send() As Boolean
        Try
            Dim lmessage As String = "", lstatus As Boolean
            Dim lInformation As String = "The XML RPC response will have a Struct with three members: 
"
            lInformation &= "Status (Boolean) which is true/1 if an error occurred 
"
            lInformation &= "Status message (string) which contains  ""Thanks for the ping"". if successful  or an error message.


"
            HttpContext.Current.Response.Write(lInformation)


            Execute("http://blogsearch.google.com/ping/RPC2", lmessage, lstatus)


            HttpContext.Current.Response.Write("Status Message: " & lmessage & "  Status :" & lstatus & "
")


            Execute("http://ping.myblog.jp", lmessage, lstatus)
            HttpContext.Current.Response.Write("Status Message: " & lmessage & "  Status :" & lstatus & "
")


            Execute("http://rpc.weblogs.com/RPC2", lmessage, lstatus)


            HttpContext.Current.Response.Write("Status Message: " & lmessage & "  Status :" & lstatus & "
")
        Catch ex As Exception
            Throw ex
        End Try
    End Function
    Private Sub Execute(ByVal pingserverUrl As String, ByRef lmessage As String, ByRef lStatus As Boolean)
        Try
            Dim request As HttpWebRequest
            request = DirectCast(WebRequest.Create(pingserverUrl), HttpWebRequest)
            request.Method = "POST"
            request.ContentType = "text/xml"
            request.Timeout = 3000


            AddXmlToRequest(request)
            'Read XML Response from Ping Server...


            Try
                Dim respMsg As String = ""
                Using sr As StreamReader = New StreamReader(request.GetResponse().GetResponseStream())
                    respMsg = sr.ReadToEnd()
                End Using


                Dim x As New XmlDocument() : x.LoadXml(respMsg)


                ProcessXmlResponseValue(x, lmessage, lStatus)
            Catch ex As Exception
                'Ignore the errors...
            End Try
        Catch ex As Exception
        End Try
    End Sub
    Private Function AddXmlToRequest(ByVal request As HttpWebRequest) As Boolean
        Try
            Dim lstream As Stream = DirectCast(request.GetRequestStream(), Stream)


            'Example :Ping methodName
            Using writer As XmlTextWriter = New XmlTextWriter(lstream, Encoding.ASCII)
                writer.WriteStartDocument()
                writer.WriteStartElement("methodCall")
                writer.WriteElementString("methodName", "weblogUpdates.ping") 'single XML-RPC Request:
                writer.WriteStartElement("params")
                writer.WriteStartElement("param")
                ' Add the name of your website here
                writer.WriteElementString("value", "The name of your website")
                writer.WriteEndElement()
                writer.WriteStartElement("param")
                ' The absolute URL of your website 
                writer.WriteElementString("value", "http://nanthakumar-software.blogspot.com/")
                writer.WriteEndElement()
                writer.WriteEndElement()
                writer.WriteEndElement()
            End Using


            ''Example :extendedPing methodName 
            '' Extended Ping XML-RPC Request with multiple category tags:
            'Using writer As XmlTextWriter = New XmlTextWriter(lstream, Encoding.ASCII)
            '    writer.WriteStartDocument()
            '    writer.WriteStartElement("methodCall")
            '    writer.WriteElementString("methodName", "weblogUpdates.extendedPing")


            '    writer.WriteStartElement("params")


            '    writer.WriteStartElement("param")
            '    ' Add the name of your website here
            '    writer.WriteElementString("value", "The name of your website")
            '    writer.WriteEndElement()


            '    writer.WriteStartElement("param")
            '    ' The absolute URL of your website 
            '    writer.WriteElementString("value", "http://nanthakumar-software.blogspot.com/")
            '    writer.WriteEndElement()


            '    writer.WriteStartElement("param")
            '    ' The absolute URL of your website 
            '    writer.WriteElementString("value", "http://nanthakumar-software.blogspot.com/")
            '    writer.WriteEndElement()
            '    writer.WriteEndElement()
            '    writer.WriteEndElement()
            'End Using


        Catch ex As Exception


        End Try


    End Function
    Private Sub ProcessXmlResponseValue(ByVal XmlDoc As XmlDocument, ByRef lMessage As String, ByRef lStatus As Boolean)
        Try
            For i As Integer = 0 To XmlDoc.GetElementsByTagName("member").Count - 1
                Dim lxmlNode As XmlNode
                lxmlNode = XmlDoc.GetElementsByTagName("member").Item(i)
                Select Case lxmlNode.Item("name").InnerText.ToUpper
                    Case "FLERROR" ' flerror (Boolean) which is true/1 if an error occurred
                        lStatus = GetBoolean(lxmlNode.Item("value").InnerText)
                    Case "MESSAGE"
                        lMessage = lxmlNode.Item("value").InnerText
                End Select
            Next
        Catch ex As Exception
            Throw ex
        End Try
    End Sub
    Public Function GetBoolean(ByVal obj As Object) As Boolean


        If IsDBNull(obj) Then Return False
        Try
            If obj.ToString = "True" Then
                Return True
            End If
        Catch ex As Exception
        End Try
        Try
            If CInt(obj.ToString) <> 0 Then
                Return True
            Else
                Return False
            End If
        Catch ex As Exception
        End Try
        Return obj
    End Function
End Class

Implementation


Download the class below and drop it into the App_Code folder or a class library. Then from anywhere in your ASP.NET project you can use the class by calling the Send method like so:
Dim o As New XMLRPCPingRequest
o.Send()
Because it can take some time to ping all the different services, you might want to consider doing it asynchronously. Here is how to do that. That’s it. Now you have a class that pings various services using XML-RPC. 

No comments: