MetaWeblog API Mk.1

This is the first stab at building a MetaWeblog API service endpoint.  It was mostly successful, though ultimately unwieldy as I had to munge around too much text after a while.

<%@ WebHandler Language="VB" Class="MetaWeblogAPI" %>

Imports System.IO
Imports System.Data
Imports CookComputing.XmlRpc
Imports System.Data.SqlClient
Public Class MetaWeblogAPI
  Inherits XmlRpcService : Implements IHttpHandler
  Private Shared Sub Authenticate(ByVal username As String, ByVal password As String)
    ' Check the login and password in the database.
        If username = "ukdavidw" And password = "qwko-812" Then
            ' Authentication ok
        Else
            Throw New System.Security.Authentication.InvalidCredentialException("Incorrect Password, please try again.")
        End If
  End Sub

  <XmlRpcMethod("blogger.getUsersBlogs")> _
   Public Function getUsersBlogs(ByVal appKey As String, ByVal username As String, ByVal password As String) As XmlRpcStruct()
    ' This is hardcoded to return only the ID of LPC.  As its the only blog on this server,
    ' it makes sense to do it this way instead of accessing the database.
    Authenticate(username, password)
    Dim rpcstruct As XmlRpcStruct = New XmlRpcStruct
    rpcstruct.Add("blogid", "2")
    rpcstruct.Add("blogName", "LPC")
    rpcstruct.Add("url", "http://davewhite.net")
    Dim datarpcstruct As XmlRpcStruct() = New XmlRpcStruct() {rpcstruct}
    Return datarpcstruct
  End Function
  <XmlRpcMethod("metaWeblog.setTemplate")> _
  Public Function setTemplate(ByVal appKey As String, ByVal blogid As String, ByVal username As String, ByVal password As String, ByVal template As String, ByVal templateType As String) As Boolean
    ' Unused - there's only one template
    Authenticate(username, password)
    Throw New System.NotImplementedException("SetTemplate is not implemented")
  End Function

  <XmlRpcMethod("metaWeblog.getCategories")> _
  Public Function getCategories(ByVal blogid As String, ByVal username As String, ByVal password As String) As XmlRpcStruct()
    ' This returns a list of categories.  Although you don't see them on the front page, they are
    ' actually there.  They're fairly limited and I don't have any real use for them, but I may one day
    ' expand their use.  In looking through this I just found a huge error caused by writing this and then
    ' re-using some of it without re-writing.  Bad Dave, BAD.  To be fixed.
    Authenticate(username, password)
    Dim sqlConn As ConnectionStringSettings
    sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")
    Dim objConnection As SqlConnection
    Dim objRecords As SqlDataReader
    Dim strSQL2 As String = "select count(iID) from Categories"
    objConnection = New SqlConnection(sqlConn.ConnectionString)
    objConnection.Open()
    Dim strSQL As String = "select * from Categories"
    Dim i As Integer = 0
    Dim iRecCount As Integer
    Dim objcommand2 As New SqlCommand(strSQL2, objConnection)
    iRecCount = objcommand2.ExecuteScalar
    Dim categories(iRecCount - 1) As XmlRpcStruct
    Dim objCommand As SqlCommand
    objCommand = New SqlCommand(strSQL, objConnection)
    objRecords = objCommand.ExecuteReader()
    Try
      If Not objRecords.HasRows Then
        Throw New Exception("Oh oh... no categories!")
        Exit Try
      End If
      While objRecords.HasRows AndAlso i < iRecCount
        objRecords.Read()
        Dim rpcstruct As New XmlRpcStruct
        rpcstruct.Add("categoryid", objRecords("iID"))
        rpcstruct.Add("title", objRecords("strCategory"))
        rpcstruct.Add("description", objRecords("strDescription"))
        categories(i) = rpcstruct
        System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
      End While
    Catch ex As Exception
      If Not ex.Message = "Invalid attempt to read when no data is present." Then
        Throw New Exception("Error : " & ex.Message)
      End If
    Finally
      objRecords.Close()
      objConnection.Close()
    End Try
    Return categories
  End Function
  <XmlRpcMethod("metaWeblog.getRecentPosts")> _
  Public Function getRecentPosts(ByVal blogid As String, ByVal username As String, ByVal password As String, ByVal numberOfPosts As Integer) As XmlRpcStruct()
    ' This is the routine that is called when WLW opens the Recent Posts from the blog.  Firstly we need
    ' to authenticate that the username and password are indeed authorised...
    Authenticate(username, password)
    ' Then open the database and get the last numberOfPosts entries from the table.
    Dim sqlConn As ConnectionStringSettings
    sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")
    Dim objConn As New SqlConnection(sqlConn.ConnectionString)
    objConn.Open()
    Dim objRecords As SqlDataReader
    ' Here we need posts of type 0 and 1, which are Drafts and Published Posts.  There's a type 2 which
    ' is deleted posts, but you never get to see that.
    Dim objCommand As New SqlCommand("select top " & numberOfPosts & " * from Blog where PostType in (0,1) order by ID desc")
    objCommand.Connection = objConn
    objRecords = objCommand.ExecuteReader()
    Dim posts(numberOfPosts - 1) As XmlRpcStruct
    Dim i As Integer = 0
    Try
      While objRecords.Read AndAlso i < numberOfPosts
        ' Loop and build out the XML structure
        Dim rpcstruct As XmlRpcStruct = New XmlRpcStruct
        rpcstruct.Add("title", objRecords("Title"))
        rpcstruct.Add("link", "http://davewhite.net/default.aspx?id=" & objRecords("ID"))
        rpcstruct.Add("description", LPC.Functions.TextFromDBToLiveWriter(objRecords("Text")))
        rpcstruct.Add("dateCreated", LPC.Functions.GetDateTimeforBlogs(objRecords("DateAdded")))
        If objRecords("Guid") Is DBNull.Value Then
          rpcstruct.Add("guid", Guid.NewGuid.ToString)
        Else
          rpcstruct.Add("guid", objRecords("Guid").ToString)
        End If
        rpcstruct.Add("postid", objRecords("ID"))
        rpcstruct.Add("author", "Dave White")
        posts(i) = rpcstruct
        System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
      End While
    Catch ex As Exception
      Throw New Exception("oh oh..." & ex.Message)
    Finally
      objRecords.Close()
      objConn.Close()
    End Try
    Return posts
  End Function

  <XmlRpcMethod("metaWeblog.getTemplate")> _
  Public Function getTemplate(ByVal appKey As String, ByVal blogid As String, ByVal username As String, ByVal password As String, ByVal templateType As String) As String
    ' Returns the template to whatever needs it.  You know, I actually have no idea what purpose this
    ' routine server for a WLW implementation.  I have to check that.
    Authenticate(username, password)
    Dim template As String = "<HTML>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <HEAD>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <TITLE><$BlogTitle$>: <$BlogDescription$></TITLE>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " </HEAD>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <BODY >" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <h1><$BlogTitle$></h1>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & "" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <!-- Blogger code begins here -->" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & "" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <BLOGGER>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <BlogDateHeader>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <b><h4><$BlogDateHeaderDate$>:</h4></b>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " </BlogDateHeader>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " " & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <a name='<$BlogItemNumber$>'><$BlogItemBody$></a>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <br>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <small><$BlogItemAuthor$> " & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <br>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <center>______________________</center>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " <br>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " </p>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " </BLOGGER>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " '" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " </BODY>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.VisualBasic.Chr(10) & " </HTML>"
    Return template
  End Function

  <XmlRpcMethod("metaWeblog.newPost")> _
  Public Function newPost(ByVal blogid As String, ByVal username As String, ByVal password As String, ByVal rpcstruct As XmlRpcStruct, ByVal publish As Boolean) As String
    ' Publishing a new post with this one, and I've found something else I need to improve.  I think
    ' that I'm going to re-write this entire class after I post this entry.
    Authenticate(username, password)
    Dim iResult As Integer
    Dim sqlConn As ConnectionStringSettings
    sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")
    Dim objConn As New SqlConnection(sqlConn.ConnectionString)
    Dim objCommand As SqlCommand
    Dim objParam As SqlParameter
    Try
      objConn.Open()
      objCommand = New SqlCommand("AddEntryFromService", objConn)
      objCommand.CommandType = Data.CommandType.StoredProcedure
      objCommand.Parameters.Add("@Title", SqlDbType.NVarChar)
      objCommand.Parameters.Add("@Guid", SqlDbType.UniqueIdentifier)
      objCommand.Parameters.Add("@Text", SqlDbType.NText)
      objCommand.Parameters.Add("@PostType", SqlDbType.Int)
      objCommand.Parameters.Add("@PostTime", SqlDbType.SmallDateTime)
      ' Values
      objCommand.Parameters("@Title").Value = rpcstruct("title").ToString
      objCommand.Parameters("@Guid").Value = System.Guid.NewGuid
      ' The line below used to munch through the post text and format it in such a way that it worked
      ' properly in the blog, and was also valid HTML / XHTML.  The new version of WLW actually posts
      ' valid XHTML now, so it just isn't needed anymore.
      'objCommand.Parameters("@Text").Value = LPC.Functions.TextToDBFromLiveWriter(rpcstruct("description"))
      objCommand.Parameters("@Text").Value = rpcstruct("description")
      ' Check if this is a draft, or a post for publishing.
      If publish = True Then
        objCommand.Parameters("@PostType").Value = 1
      Else
        objCommand.Parameters("@PostType").Value = 0
      End If
      ' Check if the date has been specified.  If not then set to UTC.
      If Not rpcstruct("dateCreated") Is Nothing Then
        objCommand.Parameters("@PostTime").Value = rpcstruct("dateCreated")
      Else
        objCommand.Parameters("@PostTime").Value = Now.ToUniversalTime
      End If
      objParam = objCommand.Parameters.AddWithValue("RETURN_VALUE", 8)
      objParam.Direction = Data.ParameterDirection.ReturnValue
      objCommand.ExecuteNonQuery()
      iResult = objCommand.Parameters("RETURN_VALUE").Value
    Catch ex As Exception
      Throw New System.Security.Authentication.InvalidCredentialException("Error adding post : " & ex.Message)
    Finally
      objConn.Close()
    End Try
    Return iResult
  End Function

  <XmlRpcMethod("metaWeblog.editPost")> _
  Public Function editPost(ByVal postid As String, ByVal username As String, ByVal password As String, ByVal rpcstruct As XmlRpcStruct, ByVal publish As Boolean) As Boolean
    ' This is the same as posting a new blog, except it takes the blog ID as a parameter.
    Authenticate(username, password)
    Dim Title, Blog As String
    Dim sqlConn As ConnectionStringSettings
    sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")
    Dim objConn As New SqlConnection(sqlConn.ConnectionString)
    objConn.Open()
    Dim objCommand As New SqlCommand("Update Blog set Title=@Title, Text=@Text, PostType=@PostType where ID=@iID", objConn)
    Title = LPC.Functions.TextToDBFromLiveWriter(rpcstruct("title"))
    Blog = LPC.Functions.TextToDBFromLiveWriter(rpcstruct("description"))
    objCommand.Parameters.AddWithValue("@Title", Title)
    objCommand.Parameters.AddWithValue("@Text", Blog)
    objCommand.Parameters.AddWithValue("@iID", postid)
    objCommand.Parameters.Add("@PostType", SqlDbType.Int)
    If publish = True Then
      objCommand.Parameters("@PostType").Value = 1
    Else
      objCommand.Parameters("@PostType").Value = 0
    End If
    Try
      objCommand.ExecuteNonQuery()
      Return True
    Catch ex As Exception
      Throw New Exception("There was a problem editing your post. (PostID : " & postid & ") Message (" & ex.Message & ")")
      Return ex.Message
    Finally
      objConn.Close()
    End Try
    Return True
  End Function

  <XmlRpcMethod("metaWeblog.getPost")> _
  Public Function getPost(ByVal postid As String, ByVal username As String, ByVal password As String) As XmlRpcStruct
    ' Reads a specific post from the database.
    Authenticate(username, password)
    Dim sqlConn As ConnectionStringSettings
    sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")
    Dim objConn As New SqlConnection(sqlConn.ConnectionString)
    objConn.Open()
    Dim objRecords As SqlDataReader
    Dim objCommand As New SqlCommand("select * from Blog where ID=@ID", objConn)
    objCommand.Parameters.Add("@ID", SqlDbType.Int)
    objCommand.Parameters("@ID").Value = CInt(postid)
    Dim rpcstruct As XmlRpcStruct = New XmlRpcStruct
    Try
      objRecords = objCommand.ExecuteReader()
      objRecords.Read()
      rpcstruct.Add("title", objRecords("Title"))
      rpcstruct.Add("link", "http://davewhite.net/default.aspx?id=" & objRecords("ID"))
      rpcstruct.Add("description", LPC.Functions.TextFromDBToLiveWriter(objRecords("Text")))
      rpcstruct.Add("dateCreated", LPC.Functions.GetDateTimeforBlogs(objRecords("DateAdded")))
      If objRecords("Guid") Is DBNull.Value Then
        rpcstruct.Add("guid", Guid.NewGuid.ToString)
      Else
        rpcstruct.Add("guid", objRecords("Guid").ToString)
      End If
      rpcstruct.Add("postid", objRecords("ID"))
      rpcstruct.Add("author", "Dave White")
      objRecords.Close()
    Catch ex As Exception
      Throw New Exception("What happened?")
    Finally
      objConn.Close()
    End Try
    Return rpcstruct
  End Function

  <XmlRpcMethod("blogger.deletePost")> _
  Public Function deletePost(ByVal appKey As String, ByVal postid As String, ByVal username As String, ByVal password As String, ByVal publish As Boolean) As Boolean
    ' Kills a post
    Authenticate(username, password)
    Dim sqlConn As ConnectionStringSettings
    sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")
    Dim objConn As New SqlConnection(sqlConn.ConnectionString)
    objConn.Open()
    Dim objCommand As New SqlCommand("update Blog set PostType=2 where ID=@iID", objConn)
    objCommand.Parameters.AddWithValue("@iID", postid)
    Try
      objCommand.ExecuteNonQuery()
    Catch ex As Exception
      Throw New Exception("There was a problem deleting your post. (PostID : " & postid & ") Message (" & ex.Message & ")")
      objConn.Close()
      Return False
    Finally
      objConn.Close()
    End Try
    Return True
  End Function

  <XmlRpcMethod("metaWeblog.newMediaObject")> _
  Public Function newMediaObject(ByVal blogid As String, ByVal username As String, ByVal password As String, ByVal rpcstruct As XmlRpcStruct) As XmlRpcStruct
    Authenticate(username, password)
    ' Some programs specify a directory AND filename.  We don't want that - all we want is the filename, so that we control where it goes.
    ' This truncates that down and checks for redundancy.  If a file is there already, we'll use a GUID for the name instead.
    Dim name As String = rpcstruct("name").ToString
    Dim type As String = rpcstruct("type").ToString
    Dim media As Byte() = CType(rpcstruct("bits"), Byte())
    Dim index As Integer = name.LastIndexOf("/") + 1
    Dim strFileName As String = name.Substring(index)
    ' Check for the file existing.
    If File.Exists(HttpContext.Current.Server.MapPath("/photos/posted/") & strFileName) Then
      ' File Exists, so lets use a GUID as the filename.
      Dim strFileNameOnServer As String = HttpContext.Current.Server.MapPath("/photos/posted") & strFileName
      Dim iIndex As Integer = strFileNameOnServer.LastIndexOf(".")
      Dim sExt As String = strFileNameOnServer.Substring(iIndex)
      strFileName = Guid.NewGuid.ToString & sExt
    End If
    ' Write the file and return the URL.
    Dim stream As FileStream = File.Create(HttpContext.Current.Server.MapPath("/photos/posted/") & strFileName)
    stream.Write(media, 0, media.Length)
    stream.Flush()
    stream.Close()
    stream.Dispose()
    Dim rstruct As XmlRpcStruct = New XmlRpcStruct
    rstruct.Add("url", "http://davewhite.net/photos/posted/" & strFileName)
    Return rstruct
  End Function
End Class

Johann Sebastian Bach's grave is here, along with the organ whose construction he advised on. Pretty awesome tbh :-)This is where US and Soviet forces met for the first time in world war two.Awesome awesome view from a restaurant on top of the Bastei!We had lunch in Meissen at the cafe in the famous porcelain factory, and ate from about €1000 worth of chinaA little light lunch and some wine...Dresden's famous frauenkirche, recently rebuilt after being destroyed in the second world war.