Tumblr のツールをいろいろ探してたのですが
どーにも見つけられなかったのがこれ。
「ローカルにある画像を Tumblr に投稿するだけのツール」
基本ブラウザで見てる画像やらテキストやらが対象だからでしょうか。
ブラウザ(Firefox)からなら Tombloo というのが最強のような気がしますし、
実際これひとつで全部済んでしまうんですけどね。
ただ、個人的には面白い画像とかテキストは２ちゃんねるのほうがずっと多い気がしていて、
ずーっと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 に投稿できます。
