1: <%@ WebHandler Language="VB" Class="MetaWeblogAPI" %>
2:
3: Imports System.IO
4: Imports System.Data
5: Imports CookComputing.XmlRpc
6: Imports System.Data.SqlClient
7: Public Class MetaWeblogAPI
8: Inherits XmlRpcService : Implements IHttpHandler
9:
10: Private Shared Sub Authenticate(ByVal username As String, ByVal password As String)
11: ' Check the login and password in the database.
12: Dim iResult As Integer
13: Dim sqlConn As ConnectionStringSettings
14: sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")
15: Dim objConn As New SqlConnection(sqlConn.ConnectionString)
16: Dim objCommand As SqlCommand
17: Dim objParam As SqlParameter
18: Try
19: objConn.Open()
20: objCommand = New SqlCommand("DBAuthenticate", objConn)
21: objCommand.CommandType = Data.CommandType.StoredProcedure
22: objParam = objCommand.Parameters.AddWithValue("RETURN_VALUE", 8)
23: objParam.Direction = Data.ParameterDirection.ReturnValue
24: objCommand.Parameters.AddWithValue("@username", username)
25: objCommand.Parameters.AddWithValue("@password", password)
26: objCommand.ExecuteNonQuery()
27: iResult = objCommand.Parameters("RETURN_VALUE").Value
28: ' The return value is going to be either -2 for an incorrect password,
29: ' -1 for an incorrect username or the UserID if it validates.
30: If (iResult < 0) Then
31: If (iResult = -1) Then
32: Throw New System.Security.Authentication.InvalidCredentialException("Incorrect UserName, please try again.")
33: Else
34: Throw New System.Security.Authentication.InvalidCredentialException("Incorrect Password, please try again.")
35: End If
36: End If
37: Catch ex As Exception
38: Throw New System.Security.Authentication.AuthenticationException("Authentication Error : " & ex.Message)
39: Finally
40: objConn.Close()
41: End Try
42: End Sub
43:
44: <XmlRpcMethod("blogger.getUsersBlogs")> _
45: Public Function getUsersBlogs(ByVal appKey As String, ByVal username As String, ByVal password As String) As XmlRpcStruct()
46: ' This is hardcoded to return only the ID of LPC. As its the only blog on this server,
47: ' it makes sense to do it this way instead of accessing the database.
48: Authenticate(username, password)
49: Dim rpcstruct As XmlRpcStruct = New XmlRpcStruct
50: rpcstruct.Add("blogid", "2")
51: rpcstruct.Add("blogName", "LPC")
52: rpcstruct.Add("url", "http://davewhite.net")
53: Dim datarpcstruct As XmlRpcStruct() = New XmlRpcStruct() {rpcstruct}
54: Return datarpcstruct
55: End Function
56:
57: <XmlRpcMethod("metaWeblog.setTemplate")> _
58: 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
59: ' Unused - there's only one template
60: Authenticate(username, password)
61: Throw New System.NotImplementedException("SetTemplate is not implemented")
62: End Function
63:
64:
65: <XmlRpcMethod("metaWeblog.getCategories")> _
66: Public Function getCategories(ByVal blogid As String, ByVal username As String, ByVal password As String) As XmlRpcStruct()
67: ' This returns a list of categories. Although you don't see them on the front page, they are
68: ' actually there. They're fairly limited and I don't have any real use for them, but I may one day
69: ' expand their use. In looking through this I just found a huge error caused by writing this and then
70: ' re-using some of it without re-writing. Bad Dave, BAD. To be fixed.
71: Authenticate(username, password)
72: Dim sqlConn As ConnectionStringSettings
73: sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")
74: Dim objConnection As SqlConnection
75: Dim objRecords As SqlDataReader
76: Dim strSQL2 As String = "select count(iID) from Categories"
77: objConnection = New SqlConnection(sqlConn.ConnectionString)
78: objConnection.Open()
79: Dim strSQL As String = "select * from Categories"
80: Dim i As Integer = 0
81: Dim iRecCount As Integer
82: Dim objcommand2 As New SqlCommand(strSQL2, objConnection)
83: iRecCount = objcommand2.ExecuteScalar
84: Dim categories(iRecCount - 1) As XmlRpcStruct
85: Dim objCommand As SqlCommand
86: objCommand = New SqlCommand(strSQL, objConnection)
87: objRecords = objCommand.ExecuteReader()
88: Try
89: If Not objRecords.HasRows Then
90: Throw New Exception("Oh oh... no categories!")
91: Exit Try
92: End If
93: While objRecords.HasRows AndAlso i < iRecCount
94: objRecords.Read()
95: Dim rpcstruct As New XmlRpcStruct
96: rpcstruct.Add("categoryid", objRecords("iID"))
97: rpcstruct.Add("title", objRecords("strCategory"))
98: rpcstruct.Add("description", objRecords("strDescription"))
99: categories(i) = rpcstruct
100: System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
101: End While
102: Catch ex As Exception
103: If Not ex.Message = "Invalid attempt to read when no data is present." Then
104: Throw New Exception("Error : " & ex.Message)
105: End If
106: Finally
107: objRecords.Close()
108: objConnection.Close()
109: End Try
110: Return categories
111: End Function
112:
113: <XmlRpcMethod("metaWeblog.getRecentPosts")> _
114: Public Function getRecentPosts(ByVal blogid As String, ByVal username As String, ByVal password As String, ByVal numberOfPosts As Integer) As XmlRpcStruct()
115: ' This is the routine that is called when WLW opens the Recent Posts from the blog. Firstly we need
116: ' to authenticate that the username and password are indeed authorised...
117: Authenticate(username, password)
118: ' Then open the database and get the last numberOfPosts entries from the table.
119: Dim sqlConn As ConnectionStringSettings
120: sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")
121: Dim objConn As New SqlConnection(sqlConn.ConnectionString)
122: objConn.Open()
123: Dim objRecords As SqlDataReader
124: ' Here we need posts of type 0 and 1, which are Drafts and Published Posts. There's a type 2 which
125: ' is deleted posts, but you never get to see that.
126: Dim objCommand As New SqlCommand("select top " & numberOfPosts & " * from Blog where PostType in (0,1) order by ID desc")
127: objCommand.Connection = objConn
128: objRecords = objCommand.ExecuteReader()
129: Dim posts(numberOfPosts - 1) As XmlRpcStruct
130: Dim i As Integer = 0
131: Try
132: While objRecords.Read AndAlso i < numberOfPosts
133: ' Loop and build out the XML structure
134: Dim rpcstruct As XmlRpcStruct = New XmlRpcStruct
135: rpcstruct.Add("title", objRecords("Title"))
136: rpcstruct.Add("link", "http://davewhite.net/default.aspx?id=" & objRecords("ID"))
137: rpcstruct.Add("description", LPC.Functions.TextFromDBToLiveWriter(objRecords("Text")))
138: rpcstruct.Add("dateCreated", LPC.Functions.GetDateTimeforBlogs(objRecords("DateAdded")))
139: If objRecords("Guid") Is DBNull.Value Then
140: rpcstruct.Add("guid", Guid.NewGuid.ToString)
141: Else
142: rpcstruct.Add("guid", objRecords("Guid").ToString)
143: End If
144: rpcstruct.Add("postid", objRecords("ID"))
145: rpcstruct.Add("author", "Dave White")
146: posts(i) = rpcstruct
147: System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
148: End While
149: Catch ex As Exception
150: Throw New Exception("oh oh..." & ex.Message)
151: Finally
152: objRecords.Close()
153: objConn.Close()
154: End Try
155: Return posts
156: End Function
157:
158: <XmlRpcMethod("metaWeblog.getTemplate")> _
159: Public Function getTemplate(ByVal appKey As Stri