gooブログ 保存/投稿スクリプト(05/07/03)

※これは、gooブログへの記事を保存・投稿するスクリプトです。
拡張子vbsで保存し、実行する必要があります。

これは古いバージョンです。こちら の次のバージョンをお試し下さい。

--------------------

' gooブログ 保存/投稿スクリプト(05/07/03)



' クリップボードへ保存するか、ファイルへ保存するか、
' もしくは両方に保存するかを設定します。
' クリップボードへのみ保存する場合は、1 を
' ファイルへのみ保存する場合は、2 を
' 両方へ保存する場合は、3 を設定して下さい。
iSaveMode = 3


' ファイルへ保存する場合は、このファイル名で保存します。
' iSaveMode が 2 か 3 の時に必要になります。
sLogFilename = "gooblog.txt"


' スクリプトを実行することで、保存と投稿を同時に行います。
' スクリプトの役割は保存だけに専念させて、
' 投稿ボタンは自分でクリックする場合には、bSubmit = False にします。
bSubmit = True


' 『クリップボードをgooブログに新規投稿するスクリプト』との互換性を設定します。
' 互換性を無視する場合は、トラックバックURLを3つ全て保存できます。
' この場合は、iSaveTb = 3 を設定して下さい。
' 互換性を保持する場合は、トラックバックURLを1つまで保存できます。
' この場合は、iSaveTb = 1 を設定して下さい。
' また、iSaveTb = 0 を設定することでトラックバックURLを保存しません。
' 保存した記事データを再利用した時に、意図しない二重トラックバックを
' 予防することが目的です。
iSaveTb = 0


' カテゴリーチェック。この部分は少々複雑です。この値を True に
' セットすることで、カテゴリー名も保存します。
' bCheckCategory = True に設定した場合、スクリプト末尾に記述してある
' 関数 saveCategory 内に正しくデータを設定する必要があります。
bCheckCategory = False




' ファイルへ保存する際の、記事の区切りです。
sHorizon = "========================================"

' トラックバックURLの区切り文字です。
' iSaveTb = 3 の時に必要になります。
sTbChr = vbNewLine


' ■■■ 設定ここまで ■■■






Set oSh = CreateObject("Shell.Application")

ii = 0
iGooEdit = -1
bGooEdit = False
For Each oIE In oSh.Windows
  If TypeName(oIE.document) = "HTMLDocument" Then
    If oIE.document.URL = "http://blog.goo.ne.jp/admin.php?fid=newentry" Or Left(oIE.document.URL, 45) = "http://blog.goo.ne.jp/admin.php?fid=editentry" Then
      If iGooEdit = -1 Then
        iGooEdit = ii
      Else
        bGooEdit = True
      End If
    End If
  End If
  ii = ii + 1
Next

If iGooEdit = -1 Or bGooEdit Then
  MsgBox "編集ウィンドウが無いか、もしくは複数見つかりました。" & vbNewLine & "編集ウィンドウを一つだけ起動した状態でスクリプトを実行して下さい。"
Else
  Set oIE = oSh.Windows(iGooEdit)
  sTitle = oIE.document.forms("entryForm").all.title.value
  sText = oIE.document.forms("entryForm").all.text.value
  sTime = oIE.document.forms("entryForm").all.time.value

  For ii = 0 To oIE.document.forms("entryForm").all.draft.length - 1
    If oIE.document.forms("entryForm").all.comment(ii).checked Then iComment = ii
  Next
  For ii = 0 To oIE.document.forms("entryForm").all.draft.length - 1
    If oIE.document.forms("entryForm").all.draft(ii).checked Then iDraft = ii
  Next

  If bCheckCategory Then
    Set dCate = CreateObject("Scripting.Dictionary")
    saveCategory()
    sCategory = oIE.document.forms("entryForm").all.category.value
    sCategory = dCate.Item(sCategory)
  Else
    sCategory = ""
  End If

  Select Case iSaveTb
  Case 0
    sTrackback = ""
    sOpt = ";" & sCategory & saveOption(iComment, iDraft)
  Case 1
    If oIE.document.forms("entryForm").all.trackback_url.value <> "" Then
      sTrackback = "tb" & oIE.document.forms("entryForm").all.trackback_url.value & vbNewLine
    Else
      sTrackback = ""
    End If
    sOpt = ";" & sCategory & saveOption(iComment, iDraft)
  Case 3
    If oIE.document.forms("entryForm").all.trackback_url.value <> "" Then _
        sTrackback = oIE.document.forms("entryForm").all.trackback_url.value & sTbChr
    If oIE.document.forms("entryForm").all.trackback_url2.value <> "" Then _
        sTrackback = sTrackback & oIE.document.forms("entryForm").all.trackback_url2.value & sTbChr
    If oIE.document.forms("entryForm").all.trackback_url3.value <> "" Then _
        sTrackback = sTrackback & oIE.document.forms("entryForm").all.trackback_url3.value & sTbChr
    sOpt = sCategory
  End Select

  sClip = sOpt & vbNewLine & sTitle & vbNewLine & sTrackback & sText & vbNewLine

  If iSaveMode = 1 Or iSaveMode = 3 Then
    Set oIEA = CreateObject("InternetExplorer.Application")
    oIEA.Navigate "about:blank"
    Set oClip = oIEA.Document.ParentWindow.ClipboardData
    oClip.setData "text", sClip
    Set oClip = Nothing
    Set oIEA = Nothing
  End If
  If iSaveMode = 2 Or iSaveMode = 3 Then
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFSOw = oFSO.OpenTextFile(sLogFilename, 8, True)
    oFSOw.Write sHorizon & vbNewLine
    oFSOw.Write sClip
    oFSOw.Close
    Set oFSOw = Nothing
    Set oFSO = Nothing
  End If

  If bSubmit Then
    oIE.document.forms("entryForm").Submit()
  End If
End If

WScript.Quit



Function saveOption(iComment, iDraft)
  ' 『クリップボードをgooブログに新規投稿するスクリプト』用のオプション
  saveOption = ";"
  If iComment = 1 Then saveOption = saveOption & "c"
  If iDraft = 0 Then saveOption = saveOption & "d"
  saveOption = saveOption & "p"
End Function



Function saveCategory()
  ' 「カテゴリー」を設定します。gooブログ編集画面のソースを参考に、
  ' ご自分のカテゴリー名とその値を設定して下さい。
  dCate.Add "aa11bb22cc33dd44ee55ff66gg77hh88", "Weblog"
  dCate.Add "ii99jj00kk11ll22mm33nn44oo55pp66", "ユーティリティ"
End Function