trash-area.com ≫ blog ≫ プログラミングvbscriptローカルにある画像をtumblrにPOSTするスクリプトを書いた

2009年09月21日 1

Tumblr のツールをいろいろ探してたのですが
どーにも見つけられなかったのがこれ。

「ローカルにある画像を Tumblr に投稿するだけのツール」

基本ブラウザで見てる画像やらテキストやらが対象だからでしょうか。
ブラウザ(Firefox)からなら Tombloo というのが最強のような気がしますし、
実際これひとつで全部済んでしまうんですけどね。

ただ、個人的には面白い画像とかテキストは2ちゃんねるのほうがずっと多い気がしていて、
ずーっと2chブラウザから投稿できないのがネックでした。

ということで(ブラウザ以外の)ローカル(キャッシュ)にある画像を
Tumblr にダイレクトにポストするスクリプトを書いてみました。

言語は WSH + VBScriptです。

スクリプトから HTTP で multipart/form-data なエンコードで
バイナリデータをPOSTするのってなかなか一筋縄ではいかないのですね。
こんなんなら違う言語を選択すればよかったなーと思います。

ちなみに、ADODB.Stream、MSXML2.XMLHTTP を使用しています。
画像の投稿自体は Tumblr にPOST用のAPIが用意されているのでそれを叩いているだけではあります。

'------------------------
EMAIL = "abc@def.com"
PASS  = "ぱすわーど"
TAGS  = "1"         ' 1 を指定するとPOST時に入力画面表示
TITLE = ""          ' 1 を指定するとPOST時に入力
'------------------------

Const adTypeBinary = 1
Const adTypeText = 2
BOUNDARY = "---------------------------9223d5ca69cc69903961a3c3126146c2"
END_BOUNDARY = vbCrLf + "--" + BOUNDARY + "--" + vbCrLf
 
If WScript.Arguments.Count < 1 Then
    WScript.Echo "ファイル名をフルパスで指定してください。"
    WScript.Quit
End If
 
If TAGS = "1"  Then TAGS  = InputBox("input tags", "")
If TITLE = "1" Then TITLE = InputBox("input title", "")
 
Dim fileName: fileName = WScript.Arguments(0)
Dim destUrl
If WScript.Arguments.Count > 1 Then
    destUrl = WScript.Arguments(1)
Else
    destUrl = "http://www.tumblr.com/api/write"
End If
 
Dim fileContents
Dim stream: Set stream = CreateObject("ADODB.Stream")
stream.Type = adTypeBinary
stream.Open
stream.LoadFromFile fileName
fileContents = stream.Read
stream.Close
 
Dim params: params = ""
params = END_BOUNDARY   ' *1
params = params + CreateNomarlParameter("type", "photo")
params = params + CreateNomarlParameter("generator", "trash-area.com")
params = params + CreateNomarlParameter("email", EMAIL)
params = params + CreateNomarlParameter("password", PASS)
params = params + CreateNomarlParameter("tags", TAGS)
params = params + CreateNomarlParameter("caption", TITLE)
params = params + CreateFileParmaterPrefix("data", fileName, "application/upload")
 
stream.Type = adTypeText
stream.Charset = "UTF-8"
stream.Open
 
' バイナリデータの前まで
ChangeStreamType stream, adTypeText
stream.WriteText params
 
' バイナリデータ
ChangeStreamType stream, adTypeBinary
stream.Write fileContents
 
' 最後
ChangeStreamType stream, adTypeText
stream.WriteText END_BOUNDARY
 
ChangeStreamType stream, adTypeBinary
stream.Position = 0
formData = stream.Read
stream.Close
 
' HTTP POST (multipart/form-data)
Dim http: Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "POST", destUrl, False
http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" + BOUNDARY
http.send formData
 
'msgbox http.responseText

WScript.Quit
 
Function ChangeStreamType(stream, t)
    p = stream.Position
    stream.Position = 0
    stream.Type = t
    stream.Position = p
    Set ChangeStreamType = stream
End Function
 
Function CreateNomarlParameter(fname, fvalue)
    s = ""
    If fvalue <> "" Then
        s = s + "--" + BOUNDARY + vbCrLf
        s = s + "Content-Disposition: form-data; name=""" + fname  + """" + vbCrLf
        s = s + vbCrLf
        s = s + fvalue
        s = s + END_BOUNDARY
    End If
    CreateNomarlParameter = s
End Function
 
Function CreateFileParmaterPrefix(fname, fvalue, fct)
    s = ""
    s = s + "--" + BOUNDARY + vbCrLf
    s = s + "Content-Disposition: form-data; name=""" + fname  + """; filename=""" + fvalue + """" + vbCrLf
    s = s + "Content-Type: " + fct + vbCrLf
    s = s + vbCrLf
    CreateFileParmaterPrefix = s
End Function

説明です。全般的にいまいちよくわかってないんですが、
まず普通のパラメータを multipart/form-data形式でガリガリ書いてます(String)。
画像ファイルはバイナリで読み込むんですけど String と Byte() なので結合できない為、バイナリデータの直前のバウンダリの開始まで Stringで生成→バイナリ化、画像データを連結、バウンダリの終了をStringで生成→バイナリ化して連結、という一連の流れを ADODB.Streamを利用して実行しています。

【】 をバウンダリとするとこんなイメージですね。

String Byte String
【name1=value1】【name2=value2】【name3= バイナリデータ

タグとかの日本語対応の為、ADODB.Streamを使用するついでにUTF-8に変換しています。
コメントに *1 とあるとこなのですが、本来こんなとこにバウンダリは不要です。
ただ、これが無いと先頭がずれる(?)ようでうまく動作しませんでした。
SJISのままなら問題なかったので、BOMとかそんなとこかと思うんですけどよくわかってません。(文字化けはしますが)

おまけですが、これを名前をつけて保存して、janeの画像ビューアの「ビューア設定」から「外部ビューア」として登録すると画像ビューアで見てる画像をダイレクトに Tumblr に投稿できます。

ソーシャルブックマーク
はてな Livedoor del.icio.us
関連してそうな記事
同じカテゴリーの別の記事
タグ
, , , , , , ,
トラックバックURL
コメント
1件のコメント
  1. ななし

    2015.04.1 @ 10:58 AM

    参考にさせていただきました。

    *1に関して、たしかに普通に書くと
    1個目の内容だけうまくPOSTされなかったのですが、
    「stream.Position = 3」にしてBOMを読み飛ばしてから
    「formData = stream.Read」すれば大丈夫でした。

Comment RSS

コメントをどうぞ

*反映されるまでに時間がかかることがあります。
*メールアドレスはアバターの使用に使います。