Imports Microsoft.WindowsLive.PublishPlugins
Imports System.Windows.Forms
Imports System.Xml

Public Class HatenaFotolifePlugin
    Implements IPublishPlugin

    Public Function ShowConfigurationSettings(ByVal parentWindow As IWin32Window, ByVal sessionXml As XmlDocument, ByVal persistXml As XmlDocument, ByVal publishProperties As IPublishProperties) As Boolean Implements IPublishPlugin.ShowConfigurationSettings
    End Function

    Public Function PublishItem(ByVal parentWindow As IWin32Window, ByVal mediaObjectId As String, ByVal stream As System.IO.Stream, ByVal sessionXml As XmlDocument, ByVal publishProperties As IPublishProperties, ByVal callback As IPublishProgressCallback, ByVal cancelEvent As System.Threading.EventWaitHandle) As Boolean Implements IPublishPlugin.PublishItem
    End Function

    Public Function HasPublishResults(ByVal sessionXml As XmlDocument) As Boolean Implements IPublishPlugin.HasPublishResults
    End Function

    Public Function HasSummaryInformation(ByVal sessionXml As XmlDocument) As Boolean Implements IPublishPlugin.HasSummaryInformation
    End Function

    Public Sub LaunchPublishResults(ByVal sessionXml As XmlDocument) Implements IPublishPlugin.LaunchPublishResults
    End Sub

    Public Sub ShowSummaryInformation(ByVal parentWindow As IWin32Window, ByVal sessionXml As XmlDocument) Implements IPublishPlugin.ShowSummaryInformation
    End Sub
End Class

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows Live\PublishPlugins\[任意の名前]

Imports <xmlns="http://purl.org/atom/ns#">
Imports <xmlns:hatena="http://www.hatena.ne.jp/info/xmlns#">
Imports <xmlns:dc="http://purl.org/dc/elements/1.1/">

Imports <xmlns:atom="http://purl.org/atom/ns#"> ' 変更
Imports <xmlns:hatena="http://www.hatena.ne.jp/info/xmlns#">
Imports <xmlns:dc="http://purl.org/dc/elements/1.1/">

' <link rel="service.post">要素の取得
' 以下へ変更 Dim elements = From e In document.<feed>.<link> Where e.@rel = "service.post"
Dim elements = From e In document.<atom:feed>.<atom:link> Where e.@rel = "service.post"

Protected Shared Sub PostPhoto(ByVal userName As String, ByVal password As String, _
                               ByVal postUri As String, ByVal title As String, ByVal contentType As String, ByVal photoStream As System.IO.Stream)
    ' リクエストの作成
    Dim request = DirectCast(WebRequest.Create(postUri), HttpWebRequest)
    With request
        .Method = "POST"

        ' WSSE認証用
        .Headers.Add(HttpRequestHeader.Authorization, "WSSE profile=""UsernameToken""")
        .Headers.Add("X-WSSE", CreateWsseHeaderValue(userName, password))

        .ContentType = "application/x.atom+xml"
        .Accept = "application/x.atom+xml, application/xml, text/xml, */*"
        .ServicePoint.Expect100Continue = False
    End With

    ' 写真をバイト配列として読み込み
    Dim photoBuffer = New Byte() {}
    Using reader = New System.IO.BinaryReader(photoStream)
        If photoStream.Length <= Integer.MaxValue Then
            photoBuffer = reader.ReadBytes(CInt(photoStream.Length))
        End If
    End Using

    ' <entry>要素
    Dim entry = <entry xmlns="http://purl.org/atom/ns#">
                    <title><%= title %></title>
                    <content mode="base64" type=<%= contentType %>><%= Convert.ToBase64String(photoBuffer) %></content>
                    <hatena:generator url="http://gihyo.jp/dev/serial/01/wl-sdk/" version="1.0">gihyo.jp sample tool</hatena:generator>
                </entry>

    ' <entry>要素をバイト配列へ変換
    Dim entryBuffer = System.Text.Encoding.UTF8.GetBytes(entry.ToString)
    request.ContentLength = entryBuffer.Length

    ' POSTデータ書き込み
    Using stream = request.GetRequestStream
        stream.Write(entryBuffer, 0, entryBuffer.Length)
    End Using

    ' レスポンス取得
    Dim document As XDocument ' （記事中では使用していません）
    Using response = DirectCast(request.GetResponse, HttpWebResponse), _
          reader = New System.IO.StreamReader(response.GetResponseStream, System.Text.Encoding.UTF8)
        document = XDocument.Load(reader)
    End Using
End Sub

' ユーザー名
Public ReadOnly Property UserName() As String
    Get
        Return UserNameTextBox.Text
    End Get
End Property

' パスワード
Public ReadOnly Property Password() As String
    Get
        Return PasswordTextBox.Text
    End Get
End Property

' コンストラクタ
Public Sub New(ByVal userName As String)
    Me.InitializeComponent()
    UserNameTextBox.Text = userName ' ユーザー名をTextBoxに設定
    PublishButton.Enabled = False ' 投稿ボタン無効化
    Me.StartPosition = Windows.Forms.FormStartPosition.CenterParent ' 親ウィンドウの中央に表示
End Sub

' TextBoxに値が入力されている場合、投稿ボタンを有効にする
Private Sub UserNameComboBox_Or_PasswordTextBox_TextChanged( _
    ByVal sender As Object, ByVal e As System.EventArgs) _
    Handles UserNameTextBox.TextChanged, _
            PasswordTextBox.TextChanged
    ' 投稿ボタンの有効・無効化
    PublishButton.Enabled = CBool(UserNameTextBox.Text <> "" AndAlso PasswordTextBox.Text <> "")
End Sub

' 投稿ボタンクリック
Private Sub PublishButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PublishButton.Click
    Me.DialogResult = Windows.Forms.DialogResult.OK
End Sub

' キャンセルボタンクリック
Private Sub CancelButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CancelButton.Click
    Me.DialogResult = Windows.Forms.DialogResult.Cancel
End Sub

<UserName>[ユーザー名]</UserName>

' XDocument へ変換
Dim persist As XDocument
Try
    If persistXml.InnerXml <> "" Then
        persist = XDocument.Parse(persistXml.InnerXml)
    Else
        persist = New XDocument
    End If
Catch xmlEx As Xml.XmlException
    persist = New XDocument
End Try

Dim userName As String
Dim password As String

' ConfigureForm 表示
Dim result As DialogResult
Using frm = New ConfigureForm(persist.<UserName>.Value) ' <UserName>要素を指定
    result = frm.ShowDialog(parentWindow)
    If result = Windows.Forms.DialogResult.OK Then
        ' 投稿ボタンをクリックした場合
        userName = frm.UserName
        password = frm.Password
    Else
        ' キャンセルボタンをクリックした場合
        Return False
    End If
End Using

' PostURI 取得
Dim title As String = Nothing
Dim postUri As String
Try
    postUri = GetPostUri(userName, password, title)
Catch webEx As WebException
    MessageBox.Show(webEx.Message, "Error")
    Return False
End Try

<PhotoGalleryPublishSession>
  <PublishParameters>
    <PostUri>[PostURI]</PostUri>
    <UserName>[ユーザー名]</UserName>
    <Password>[パスワード]</Password>
  </PublishParameters>
</PhotoGalleryPublishSession>

' Session XML にユーザー情報とPostURI 保存
Dim session = XDocument.Parse(sessionXml.InnerXml)
With session.<PhotoGalleryPublishSession>.<PublishParameters>.First
    .Add(<PostUri><%= postUri %></PostUri>)
    .Add(<UserName><%= userName %></UserName>)
    .Add(<Password><%= password %></Password>)
End With

' XmlDocument へ反映
persistXml.LoadXml(<UserName><%= userName %></UserName>.ToString)
sessionXml.LoadXml(session.ToString)
Return True

<PhotoGalleryPublishSession versionMajor="1" versionMinor="0">
  <PublishParameters>
    <MaxWidth>1024</MaxWidth>
    <MaxHeight>1024</MaxHeight>
  </PublishParameters>
  <ItemSet>
    <Item id="19">
      <FullFilePath>C:\Users\UserName\Pictures\background.jpg</FullFilePath>
      <OriginalFileName>background.jpg</OriginalFileName>
      <OriginalFileExtension>.jpg</OriginalFileExtension>
      <PerceivedType>image</PerceivedType>
      <Title></Title>
      <OriginalWidth>2560</OriginalWidth>
      <OriginalHeight>1920</OriginalHeight>
      <LengthMS>0</LengthMS>
      <FileSize>1620000</FileSize>
      <KeywordSet>
        <Keyword>meatball</Keyword>
        <Keyword>double tooth</Keyword>
      </KeywordSet>
      <PeopleRegionSet>
        <PersonRegion left="0.6" top="0.1" width="0.1" height="0.2">M.K</PersonRegion>
      </PeopleRegionSet>
    </Item>
    <Item id="20">
      ...
    </Item>
    <Item id="21">
      ...
    </Item>
  </ItemSet>
</PhotoGalleryPublishSession>

' XDocument へ変換
Dim session = XDocument.Parse(sessionXml.InnerXml)

' <Item id="mediaObjectId">要素取得
Dim item = (From e In session.<PhotoGalleryPublishSession>.<ItemSet>.<Item> _
            Where e.@id = mediaObjectId).First

' <PerceivedType>要素がimageの場合は処理を抜ける
If item.<PerceivedType>.Value <> "image" Then
    Return False
End If

' 拡張子から ContentType 文字列作成
Dim contentType As String
Select Case item.<OriginalFileExtension>.Value.ToLower
    Case ".jpg", ".jpeg"
        contentType = "image/jpeg"
    Case ".gif"
        contentType = "image/gif"
    Case ".png"
        contentType = "image/png"
    Case ".bmp"
        contentType = "image/bmp"
    Case Else
        Return False ' サポート外の拡張子
End Select

' 写真名にはタイトルまたはファイル名を使用する
Dim title As String
If item.<Title>.Value <> "" Then
    title = item.<Title>.Value
Else
    title = item.<OriginalFileName>.Value
End If

Try
    ' アップロード
    Dim params = session.<PhotoGalleryPublishSession>.<PublishParameters>
    PostPhoto(params.<UserName>.Value, params.<Password>.Value, params.<PostUri>.Value, title, contentType, stream)
    Return True
Catch webEx As WebException
    Return False
End Try

Public Function HasPublishResults(ByVal sessionXml As XmlDocument) As Boolean Implements IPublishPlugin.HasPublishResults
    ' 表示ボタン有効
    Return True
End Function

Public Function HasSummaryInformation(ByVal sessionXml As XmlDocument) As Boolean Implements IPublishPlugin.HasSummaryInformation
    ' 詳細情報リンク無効
    Return False
End Function

Public Sub LaunchPublishResults(ByVal sessionXml As XmlDocument) Implements IPublishPlugin.LaunchPublishResults
    Dim session = XDocument.Parse(sessionXml.InnerXml)
    Dim userName = session.<PhotoGalleryPublishSession>.<PublishParameters>.<UserName>.Value
    Try
        ' はてなフォトライフのユーザーページを開く
        Process.Start("http://f.hatena.ne.jp/" & userName)
    Catch ex As Exception
        ' Do nothing
    End Try
End Sub

Public Sub ShowSummaryInformation(ByVal parentWindow As IWin32Window, ByVal sessionXml As XmlDocument) Implements IPublishPlugin.ShowSummaryInformation
    ' 呼ばれない
End Sub