Attribute VB_Name = "wordBlogger"
' Copyright (c) 2002 Simon Fell
'
' Permission is hereby granted, free of charge, to any person obtaining a copy of
' this software and associated documentation files (the "Software"), to deal in
' the Software without restriction, including without limitation the rights to
' use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
' of the Software, and to permit persons to whom the Software is furnished to do
' so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in all
' copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
' INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A
' PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
' HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
' OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
' SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
'
' **********************************************************************************
' BloggerAPI Blogging Macros for Word, Powered by PocketXML-RPC.
' see http://www.pocketsoap.com/weblog/stories/2002/05/15/wordBlogger.html
' for the latest version
' **********************************************************************************
' 05/14/02  SZF Initial port of SOAP/Radio version see
'           http://www.pocketsoap.com/weblog/stories/2002/04/11/radioBloggingFromWord.html
'           indcludes addition suggestions/code from
'           Omar Shahine [http://www.shahine.com/omar/]
' **********************************************************************************

' WordBlogger App Key for the BloggerAPI
Const WB_KEY = "814C859D0F62E461DC22F869560DA6666496B65C27"

' If you run Word on a separate box to Radio, then you'll need to change
' the server Name in this URL, if you're using Blogger, then this should
' be http://plant.blogger.com/api/RPC2
Const RADIO_URL = "http://localhost:5335/RPC2"

' If you need to connect via a HTTP proxy server, then
' enter the name of the proxy server, and port number here
Const PROXY_SERVER = ""
Const PROXY_PORT = 7070

' enter your blogger Username & Password here, for Radio this is the
' username and password you set up in the "Remote Access & Security"
' page of the pref's
Const BLOG_USERNAME = "fred"
Const BLOG_PASSWORD = "radio"

' this is your BlogID, in Radio this must be "home" not sure how you get one of these
' for Blogger
Const BLOG_ID = "home"

' this keeps track of the lastPostID used, this allows us to default
' the postID when doing updated, to the last new blog entry
Dim lastPostId

' posts the contents of the current document as a new blog entry
Sub PostNewBlogEntry()
    lastPostId = blogger.newPost(WB_KEY, BLOG_ID, BLOG_USERNAME, BLOG_PASSWORD, getCurrentDocAsSimpleHtml, True)
    MsgBox "Done : postId = " & lastPostId
End Sub

' updates a blog entry with the current document
' postID defaults to last edit/post ID
Sub UpdateBlogEntry()
    Dim postId
    postId = InputBox("Enter PostID", "wordBlogger", lastPostId)
    If Len(postId) = "" Then Exit Sub
    
    blogger.editPost WB_KEY, postId, BLOG_USERNAME, BLOG_PASSWORD, getCurrentDocAsSimpleHtml, True
    
    lastPostId = postId
End Sub

Private Function blogger()
    Dim f
    Set f = CreateObject("PocketXMLRPC.Factory")
    Set blogger = f.Proxy(RADIO_URL, "blogger.", , , PROXY_SERVER, PROXY_PORT)
End Function

' helper function, generates a simple HTML rendering of the current
' doc, expanding links.
Private Function getCurrentDocAsSimpleHtml() As String
    ' save the current selection, so we can put it back later
    Dim ss As Long, se As Long
    ss = Selection.Start
    se = Selection.End
    
    ' expand the selection to the whole of the current doc
    While (Selection.MoveStart(wdParagraph, -1) <> 0)
    Wend
    While (Selection.MoveEnd(wdParagraph, 1) <> 0)
    Wend
    
    ' build a HTML formated version, with the links expanded
    Dim strText As String
    Dim w As Range, strUrl As String, bItalics As Boolean, bBold As Boolean
    For Each w In Selection.Characters
        If w.Hyperlinks.Count > 0 Then
            If strUrl <> w.Hyperlinks(1).Address Then
                strText = strText + "<a href=""" + w.Hyperlinks(1).Address + """>"
                strUrl = w.Hyperlinks(1).Address
            End If
        End If
        If Len(strUrl) > 0 And w.Hyperlinks.Count = 0 Then
            strText = strText + "</a>"
            strUrl = ""
        End If
        If w.Bold And Not bBold Then
            strText = strText + "<b>"
            bBold = True
        ElseIf Not w.Bold And bBold Then
            strText = strText + "</b>"
            bBold = False
        End If
        If w.Italic And Not bItalic Then
            strText = strText + "<i>"
            bItalic = True
        ElseIf Not w.Italic And bItalic Then
            strText = strText + "</i>"
            bItalic = False
        End If
        strText = strText + encode(w)
    Next
    If Right$(strText, 5) = "<br/>" Then strText = Left$(strText, Len(strText) - 5)
    getCurrentDocAsSimpleHtml = strText
    Selection.Start = ss
    Selection.End = se
End Function

' simple HTML entity encoder
Private Function encode(ByVal s As String) As String
    If s = "&" Then
        encode = "&amp;"
    ElseIf s = "<" Then
        encode = "&lt;"
    ElseIf s = ">" Then
        encode = "&gt;"
    ElseIf s = Chr(13) Then
        encode = "<br/>"
    Else
        encode = s
    End If
End Function