lpc and wlw

   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 String, ByVal blogid As String, ByVal username As String, ByVal password As String, ByVal templateType As String) As String

 160:     ' Returns the template to whatever needs it.  You know, I actually have no idea what purpose this

 161:     ' routine server for a WLW implementation.  I have to check that.

 162:     Authenticate(username, password)

 163:     Dim template As String = "<HTML>" & Microsoft.VisualBasic.Chr(13) & "" & Microsoft.Visual... and lots more...

 164:     Return template

 165:   End Function

 166:  

 167:   <XmlRpcMethod("metaWeblog.newPost")> _

 168:   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

 169:     ' Publishing a new post with this one, and I've found something else I need to improve.  I think

 170:     ' that I'm going to re-write this entire class after I post this entry.

 171:     Authenticate(username, password)

 172:     Dim iResult As Integer

 173:     Dim sqlConn As ConnectionStringSettings

 174:     sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")

 175:     Dim objConn As New SqlConnection(sqlConn.ConnectionString)

 176:     Dim objCommand As SqlCommand

 177:     Dim objParam As SqlParameter

 178:     Try

 179:       objConn.Open()

 180:       objCommand = New SqlCommand("AddEntryFromService", objConn)

 181:       objCommand.CommandType = Data.CommandType.StoredProcedure

 182:       objCommand.Parameters.Add("@Title", SqlDbType.NVarChar)

 183:       objCommand.Parameters.Add("@Guid", SqlDbType.UniqueIdentifier)

 184:       objCommand.Parameters.Add("@Text", SqlDbType.NText)

 185:       objCommand.Parameters.Add("@PostType", SqlDbType.Int)

 186:       objCommand.Parameters.Add("@PostTime", SqlDbType.SmallDateTime)

 187:       ' Values

 188:       objCommand.Parameters("@Title").Value = rpcstruct("title").ToString

 189:       objCommand.Parameters("@Guid").Value = System.Guid.NewGuid

 190:       ' The line below used to munch through the post text and format it in such a way that it worked

 191:       ' properly in the blog, and was also valid HTML / XHTML.  The new version of WLW actually posts

 192:       ' valid XHTML now, so it just isn't needed anymore.

 193:       'objCommand.Parameters("@Text").Value = LPC.Functions.TextToDBFromLiveWriter(rpcstruct("description"))

 194:       objCommand.Parameters("@Text").Value = rpcstruct("description")

 195:       ' Check if this is a draft, or a post for publishing.

 196:       If publish = True Then

 197:         objCommand.Parameters("@PostType").Value = 1

 198:       Else

 199:         objCommand.Parameters("@PostType").Value = 0

 200:       End If

 201:       ' Check if the date has been specified.  If not then set to UTC.

 202:       If Not rpcstruct("dateCreated") Is Nothing Then

 203:         objCommand.Parameters("@PostTime").Value = rpcstruct("dateCreated")

 204:       Else

 205:         objCommand.Parameters("@PostTime").Value = Now.ToUniversalTime

 206:       End If

 207:       objParam = objCommand.Parameters.AddWithValue("RETURN_VALUE", 8)

 208:       objParam.Direction = Data.ParameterDirection.ReturnValue

 209:       objCommand.ExecuteNonQuery()

 210:       iResult = objCommand.Parameters("RETURN_VALUE").Value

 211:     Catch ex As Exception

 212:       Throw New System.Security.Authentication.InvalidCredentialException("Error adding post : " & ex.Message)

 213:     Finally

 214:       objConn.Close()

 215:     End Try

 216:     Return iResult

 217:   End Function

 218:  

 219:   <XmlRpcMethod("metaWeblog.editPost")> _

 220:   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

 221:     ' This is the same as posting a new blog, except it takes the blog ID as a parameter.

 222:     Authenticate(username, password)

 223:     Dim Title, Blog As String

 224:     Dim sqlConn As ConnectionStringSettings

 225:     sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")

 226:     Dim objConn As New SqlConnection(sqlConn.ConnectionString)

 227:     objConn.Open()

 228:     Dim objCommand As New SqlCommand("Update Blog set Title=@Title, Text=@Text, PostType=@PostType where ID=@iID", objConn)

 229:     Title = LPC.Functions.TextToDBFromLiveWriter(rpcstruct("title"))

 230:     Blog = LPC.Functions.TextToDBFromLiveWriter(rpcstruct("description"))

 231:     objCommand.Parameters.AddWithValue("@Title", Title)

 232:     objCommand.Parameters.AddWithValue("@Text", Blog)

 233:     objCommand.Parameters.AddWithValue("@iID", postid)

 234:     objCommand.Parameters.Add("@PostType", SqlDbType.Int)

 235:     If publish = True Then

 236:       objCommand.Parameters("@PostType").Value = 1

 237:     Else

 238:       objCommand.Parameters("@PostType").Value = 0

 239:     End If

 240:     Try

 241:       objCommand.ExecuteNonQuery()

 242:       Return True

 243:     Catch ex As Exception

 244:       Throw New Exception("There was a problem editing your post. (PostID : " & postid & ") Message (" & ex.Message & ")")

 245:       Return ex.Message

 246:     Finally

 247:       objConn.Close()

 248:     End Try

 249:     Return True

 250:   End Function

 251:  

 252:   <XmlRpcMethod("metaWeblog.getPost")> _

 253:   Public Function getPost(ByVal postid As String, ByVal username As String, ByVal password As String) As XmlRpcStruct

 254:     ' Reads a specific post from the database.

 255:     Authenticate(username, password)

 256:     Dim sqlConn As ConnectionStringSettings

 257:     sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")

 258:     Dim objConn As New SqlConnection(sqlConn.ConnectionString)

 259:     objConn.Open()

 260:     Dim objRecords As SqlDataReader

 261:     Dim objCommand As New SqlCommand("select * from Blog where ID=@ID", objConn)

 262:     objCommand.Parameters.Add("@ID", SqlDbType.Int)

 263:     objCommand.Parameters("@ID").Value = CInt(postid)

 264:     Dim rpcstruct As XmlRpcStruct = New XmlRpcStruct

 265:     Try

 266:       objRecords = objCommand.ExecuteReader()

 267:       objRecords.Read()

 268:       rpcstruct.Add("title", objRecords("Title"))

 269:       rpcstruct.Add("link", "http://davewhite.net/default.aspx?id=" & objRecords("ID"))

 270:       rpcstruct.Add("description", LPC.Functions.TextFromDBToLiveWriter(objRecords("Text")))

 271:       rpcstruct.Add("dateCreated", LPC.Functions.GetDateTimeforBlogs(objRecords("DateAdded")))

 272:       If objRecords("Guid") Is DBNull.Value Then

 273:         rpcstruct.Add("guid", Guid.NewGuid.ToString)

 274:       Else

 275:         rpcstruct.Add("guid", objRecords("Guid").ToString)

 276:       End If

 277:       rpcstruct.Add("postid", objRecords("ID"))

 278:       rpcstruct.Add("author", "Dave White")

 279:       objRecords.Close()

 280:     Catch ex As Exception

 281:       Throw New Exception("What happened?")

 282:     Finally

 283:       objConn.Close()

 284:     End Try

 285:     Return rpcstruct

 286:   End Function

 287:  

 288:   <XmlRpcMethod("blogger.deletePost")> _

 289:   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

 290:     ' Kills a post

 291:     Authenticate(username, password)

 292:     Dim sqlConn As ConnectionStringSettings

 293:     sqlConn = ConfigurationManager.ConnectionStrings("SQLServer")

 294:     Dim objConn As New SqlConnection(sqlConn.ConnectionString)

 295:     objConn.Open()

 296:     Dim objCommand As New SqlCommand("update Blog set PostType=2 where ID=@iID", objConn)

 297:     objCommand.Parameters.AddWithValue("@iID", postid)

 298:     Try

 299:       objCommand.ExecuteNonQuery()

 300:     Catch ex As Exception

 301:       Throw New Exception("There was a problem deleting your post. (PostID : " & postid & ") Message (" & ex.Message & ")")

 302:       objConn.Close()

 303:       Return False

 304:     Finally

 305:       objConn.Close()

 306:     End Try

 307:     Return True

 308:   End Function

 309:  

 310:   <XmlRpcMethod("metaWeblog.newMediaObject")> _

 311:   Public Function newMediaObject(ByVal blogid As String, ByVal username As String, ByVal password As String, ByVal rpcstruct As XmlRpcStruct) As XmlRpcStruct

 312:     Authenticate(username, password)

 313:     ' 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.

 314:     ' This truncates that down and checks for redundancy.  If a file is there already, we'll use a GUID for the name instead.

 315:     Dim name As String = rpcstruct("name").ToString

 316:     Dim type As String = rpcstruct("type").ToString

 317:     Dim media As Byte() = CType(rpcstruct("bits"), Byte())

 318:     Dim index As Integer = name.LastIndexOf("/") + 1

 319:     Dim strFileName As String = name.Substring(index)

 320:     ' Check for the file existing.

 321:     If File.Exists(HttpContext.Current.Server.MapPath("/photos/posted/") & strFileName) Then

 322:       ' File Exists, so lets use a GUID as the filename.

 323:       Dim strFileNameOnServer As String = HttpContext.Current.Server.MapPath("/photos/posted") & strFileName

 324:       Dim iIndex As Integer = strFileNameOnServer.LastIndexOf(".")

 325:       Dim sExt As String = strFileNameOnServer.Substring(iIndex)

 326:       strFileName = Guid.NewGuid.ToString & sExt

 327:     End If

 328:     ' Write the file and return the URL.

 329:     Dim stream As FileStream = File.Create(HttpContext.Current.Server.MapPath("/photos/posted/") & strFileName)

 330:     stream.Write(media, 0, media.Length)

 331:     stream.Flush()

 332:     stream.Close()

 333:     stream.Dispose()

 334:     Dim rstruct As XmlRpcStruct = New XmlRpcStruct

 335:     rstruct.Add("url", "http://davewhite.net/photos/posted/" & strFileName)

 336:     Return rstruct

 337:   End Function

 338:     

 339: End Class