Attribute VB_Name = "WordRadio"
' 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.
'
' **********************************************************************************
' Radio Blogging Macros for Word, Powered by PocketSOAP.
' see http://www.pocketsoap.com/weblog/stories/2002/04/11/radioBloggingFromWord.html
' for the latest version
' **********************************************************************************
' 04/12/02  SZF added comments, fix for proxy in getTransport
'                               selection is now returned to its original state
'                               bold & italic formatting are now carried over
' 04/11/02  SZF Original Release
' **********************************************************************************

' If you run Word on a separate box to Radio, then you'll need to change
' the server Name in this URL
Const RADIO_URL = "http://localhost:5335/blogger"

' If you need to connect to Radio 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 = "joe"
Const BLOG_PASSWORD = "joe"

' 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()
    Dim e, t

    Set e = CreateObject("PocketSOAP.Envelope.2")
    e.methodName = "newPost"
    e.parameters.create "appkey", ""
    e.parameters.create "blogid", "home"
    e.parameters.create "username", BLOG_USERNAME
    e.parameters.create "password", BLOG_PASSWORD
    e.parameters.create "content", getCurrentDocAsSimpleHtml
    e.parameters.create "publish", True

    Set t = getTransport
    t.SOAPAction = "/blogger"
    t.send RADIO_URL, e.serialize

    e.parse t
    lastPostId = e.parameters.Item(0).Value
    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
    
    Dim e, t
    Set e = CreateObject("PocketSOAP.Envelope.2")
    e.methodName = "editPost"
    e.parameters.create "appkey", ""
    e.parameters.create "postid", postId
    e.parameters.create "username", BLOG_USERNAME
    e.parameters.create "password", BLOG_PASSWORD
    e.parameters.create "content", getCurrentDocAsSimpleHtml
    e.parameters.create "publish", True

    Set t = getTransport
    t.SOAPAction = "/blogger"
    t.send RADIO_URL, e.serialize

    e.parse t
    lastPostId = postId
End Sub

' helper function, creates and configures a HTTP transport object
Private Function getTransport() As Object
    Dim t
    Set t = CreateObject("pocketSOAP.HTTPTransport")
    If Len(PROXY_SERVER) > 0 Then
        t.SetProxy PROXY_SERVER, PROXY_PORT
    End If
    Set getTransport = t
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
    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;"
    Else
        encode = s
    End If
End Function