VBScript : Twitpic に画像をアップロード

  概要



VBScript から Twitter への投稿の部品は、VBS : TwitterAPIを呼び出して投稿 でそろったので、VBScript からの ファイルのアップロードをテストして完成させて以前 PHP で書いた PHP + Twitpic API v2 で画像アップ を移植しました。

JavaScript のライブラリの力を借りています。それについてもVBScript : Twitter API を呼び出して投稿する にあります

すぐテストしてみたい場合は、ソースコードに書いてあるライブラリはそのままホスティングしていますので使って下さい


関連する記事


IE専用( IE拡張 ) : TwitLink : リンクデータを基本に
Twitter へ投稿するツール

Twitlink9






  ソースコード



<JOB>
<COMMENT>
************************************************************
 URLEncodeとファイルアップロードとcharset変換用
************************************************************
</COMMENT>
<OBJECT id="Stream" progid="ADODB.Stream" />
<OBJECT id="Stream2" progid="ADODB.Stream" />
<OBJECT id="StreamWorkBin" progid="ADODB.Stream" />
<OBJECT id="StreamBin" progid="ADODB.Stream" />
<OBJECT id="StreamUTF8" progid="ADODB.Stream" />
<COMMENT>
************************************************************
 HTTP通信用
   ServerXMLHTTP でうまくいかない場合は、MSXML2.XMLHTTP
   を使います。それでもうまく行かない場合は、さらに
   IE設定のドメイン間のデータソースのアクセスを有効にします
************************************************************
</COMMENT>
<OBJECT id="objHTTP" progid="Msxml2.ServerXMLHTTP" />

<SCRIPT language="JavaScript" src="http://lightbox.on.coocan.jp/js/2.0.0-crypto-sha1.js"></SCRIPT> 
<SCRIPT language="JavaScript" src="http://lightbox.on.coocan.jp/js/2.0.0-hmac-min.js"></SCRIPT> 
<SCRIPT language="JavaScript"> 
// *********************************************************
// JavaScript メソッドのラッパー
// *********************************************************
function hash_hmac(str1,str2) {

	// ここで使用します
	return Crypto.HMAC(Crypto.SHA1, str1, str2,{ asString: true } ); 

}
function hash_hmac_bin(str1,str2) {

	// ここでは使用しません( 整数の配列が戻されます )
	return Crypto.HMAC(Crypto.SHA1, str1, str2,{ asBytes: true } ); 

}
// stringToBytes の結果を渡します
function bytesToBase64(data) {
	return Crypto.util.bytesToBase64(data); 
}

function stringToBytes(data) {
	return Crypto.charenc.Binary.stringToBytes(data)
}

</SCRIPT>
<SCRIPT language=VBScript>

' **********************************************************
' twitpic への投稿データ
' **********************************************************
apikey = "TwitpicのAPIキー"
twitpic_url = "http://api.twitpic.com/2/upload.json"
twitter_url = "https://api.twitter.com/1/account/verify_credentials.json"

' **********************************************************
' 登録した自分のアプリケーションから取得するアクセス用のデータ
' ※ この部分を公開してはいけません
' **********************************************************
oauth_consumer_key = "Consumer key"
oauth_consumer_secret = "Consumer secret"
oauth_token = "Access Token"
oauth_secret = "Access Token Secret"

' **********************************************************
' ランダムな文字列
' **********************************************************
oauth_nonce = Nonce()

' **********************************************************
' Unix タイムスタンプ
' **********************************************************
oauth_timestamp = DateDiff("s", "1970/1/1 0:00:00",DateAdd("h",-9,now))

' **********************************************************
' その他設定値
' **********************************************************
oauth_signature_method = "HMAC-SHA1"
oauth_version = "1.0"

' **********************************************************
' シグネチャ用ベース文字列作成
' 厳密には、もっと URLエンコードが必要ですが、
' 実行しても変わらないものは省略しています
'
' 【Twitpic が使うアカウントチェック用】
' **********************************************************
base_s = "GET"
base_s = base_s & "&" & rfc3986_convert(URLEncode(twitter_url))
base_s = base_s & "&"

' %3D は =
base_s = base_s & "oauth_consumer_key" & "%3D" & oauth_consumer_key
' %26 は &
base_s = base_s & "%26"

base_s = base_s & "oauth_nonce" & "%3D" & oauth_nonce & "%26"
base_s = base_s & "oauth_signature_method" & "%3D" & oauth_signature_method & "%26"
base_s = base_s & "oauth_timestamp" & "%3D" & oauth_timestamp & "%26"
base_s = base_s & "oauth_token" & "%3D" & oauth_token & "%26"
base_s = base_s & "oauth_version" & "%3D" & oauth_version


' *********************************************************
' シグネチャ作成
' *********************************************************
str = hash_hmac(base_s,oauth_consumer_secret & "&" & oauth_secret)
oauth_signature = bytesToBase64(stringToBytes(str))


' *********************************************************
' API へ向けて送信準備
' *********************************************************
Call objHTTP.Open( "POST",twitpic_url, False )
' File Upload 用 HTTP ヘッダ
strBoundary = DateDiff("s", "1970/1/1 0:00:00",DateAdd("h",-9,now))
Call objHTTP.setRequestHeader("Content-Type", "multipart/form-data; boundary="&strBoundary)

' バイナリ変換用ストリーム
StreamWorkBin.Open
StreamWorkBin.Type = 1

' 最終バイナリストリーム
StreamBin.Open
StreamBin.Type = 1

' テキストストリーム
Stream.Open
Stream.Charset = "shift_jis"
StreamUTF8.Open
StreamUTF8.Charset = "utf-8"

' 開始セクション
Stream.WriteText "--" & strBoundary & vbLf
Stream.WriteText "Content-Disposition: form-data; name=""key""" & vbLf & vbLf
Stream.WriteText apikey & vbLf
Stream.WriteText "--" & strBoundary & vbLf
Stream.WriteText "Content-Disposition: form-data; name=""message""" & vbLf & vbLf
Stream.WriteText "VBScript(WSF) からアップロードしています" & vbLf
Stream.WriteText "--" & strBoundary & vbLf
Stream.WriteText "Content-Disposition: form-data; name=""media""; filename=""uploadtest.png""" & vbLf
Stream.WriteText "Content-Type: image/png" & vbLf
Stream.WriteText vbLf
Stream.Position = 0

Stream.CopyTo StreamUTF8
StreamUTF8.Position = 0

' テキストをバイナリに変換
StreamUTF8.CopyTo StreamWorkBin

' 第一セクションを書き込み
StreamWorkBin.Position = 0
StreamWorkBin.Read(3)
StreamBin.Write StreamWorkBin.Read(StreamWorkBin.Size-3)

' 画像を読み込む
StreamWorkBin.LoadFromFile("1252328628672351.png")

' 画像を書き込み
StreamBin.Write StreamWorkBin.Read(StreamWorkBin.Size)

' バイナリワークをいったん閉じる
StreamWorkBin.Close
StreamWorkBin.Open
StreamWorkBin.Type = 1

' テキストをいったん閉じる( 日本語が無いので Stream を使う )
Stream.Close
Stream.Open
Stream.Charset = "shift_jis"

' 終了セクション
Stream.WriteText vbLf & "--" & strBoundary & "--" & vbLf
Stream.Position = 0

' テキストをバイナリに変換
Stream.CopyTo StreamWorkBin

' 終了セクションを書き込み
StreamWorkBin.Position = 0
StreamBin.Write StreamWorkBin.Read(StreamWorkBin.Size)

' 送信データを取得
nLen = StreamBin.Size
StreamBin.Position = 0
strData = StreamBin.Read(nLen)

'Call StreamBin.SaveToFile( "result.dat", 2 )

Stream.Close
StreamUTF8.Close
StreamBin.Close
StreamWorkBin.Close

' *********************************************************
' 投稿データとその長さ
' *********************************************************
Call objHTTP.SetRequestHeader("Content-Length",nLen)

' *********************************************************
' Twitpic 用ヘッダ
' *********************************************************
OAuthCheck = "OAuth realm=""http://api.twitter.com/""," & _
rfc3986_convert(URLEncode("oauth_consumer_key")) & "=""" & rfc3986_convert(URLEncode(oauth_consumer_key)) & """," & _
rfc3986_convert(URLEncode("oauth_signature_method")) & "=""" & rfc3986_convert(URLEncode(oauth_signature_method)) &"""," & _
rfc3986_convert(URLEncode("oauth_token")) & "=""" & rfc3986_convert(URLEncode(oauth_token)) &"""," & _
rfc3986_convert(URLEncode("oauth_timestamp")) & "=""" & rfc3986_convert(URLEncode(oauth_timestamp)) &"""," & _
rfc3986_convert(URLEncode("oauth_nonce")) & "=""" & rfc3986_convert(URLEncode(oauth_nonce)) &"""," & _
rfc3986_convert(URLEncode("oauth_version")) & "=""" & rfc3986_convert(URLEncode(oauth_version)) &"""," & _
rfc3986_convert(URLEncode("oauth_signature")) & "=""" & rfc3986_convert(URLEncode(oauth_signature)) & """"

Call objHTTP.SetRequestHeader("X-Verify-Credentials-Authorization",OAuthCheck)

Call objHTTP.SetRequestHeader("X-Auth-Service-Provider",twitter_url)


' *********************************************************
' API へ向けて送信
' *********************************************************
Call objHTTP.Send(strData)

Wscript.Echo(objHTTP.responseText)


' ***********************************************************
' ランダムな文字列
' ***********************************************************
Function Nonce(  )

	Dim base_str,str,I,nLen,Random
	base_str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
	base_str = base_str & "abcdefghijklmnopqrstuvwxyz0123456789"

	nLen = Len(base_str)

	str = ""
	For I = 1 to 32
		Randomize
		Random = 1 + Int(Rnd * nLen)
		str = str & Mid(base_str,Random,1)
	Next

	Nonce = str

End function

' ***********************************************************
' SHIFT_JIS を UTF-8 に変換して URLエンコード
' ※ 全ての文字をパーセントエンコーディングします
' ***********************************************************
Function URLEncode(str)

	Stream.Open
	Stream.Charset = "shift_jis"
	' shift_jis で入力文字を書き込む
	Stream.WriteText str
	' コピーの為にデータポインタを先頭にセット
	Stream.Position = 0
 
	Stream2.Open
	Stream2.Charset = "utf-8"
	' shift_jis を utf-8 に変換
	Stream.CopyTo Stream2
	Stream.Close

	' コピーの為にデータポインタを先頭にセット
	Stream2.Position = 0

	' バイナリで開く
	StreamBin.Open
 	StreamBin.Type = 1

	' テキストをバイナリに変換
	Stream2.CopyTo StreamBin
	Stream2.Close

	' 読み込みの為にデータポインタを先頭にセット
	StreamBin.Position = 0

	Buffer = ""
	StreamBin.Read(3)
	Do while not StreamBin.EOS
		LineBuffer = StreamBin.Read(16)
 
		For i = 1 to LenB( LineBuffer )
			CWork = MidB(LineBuffer,i,1)
			Cwork = AscB(Cwork)
			Cwork = Hex(Cwork)
			Cwork = Ucase(Cwork)
			if Len(Cwork) = 1 then
				Buffer = Buffer & "%0" & Cwork
			else
				Buffer = Buffer & "%" & Cwork
			end if
		Next
 
	Loop

	StreamBin.Close

	URLEncode = Buffer

End Function

' ***********************************************************
' 仕様を明確にする為に単純変換
' ***********************************************************
Function rfc3986_convert(str)

	Dim strResult,I,strWork

	strResult = str

	strResult = Replace(strResult,"%2D", "-")
	strResult = Replace(strResult,"%2E", ".")

	' 0〜9
	For I = &H30 to &H39
		strWork = Hex(I)
		strWork = "%" & Ucase(strWork)
		strResult = Replace(strResult,strWork, Chr(I))
	Next

	' A〜Z
	For I = &H41 to &H5A
		strWork = Hex(I)
		strWork = "%" & Ucase(strWork)
		strResult = Replace(strResult,strWork, Chr(I))
	Next

	strResult = Replace(strResult,"%5F", "_")

	' a〜z
	For I = &H61 to &H7A
		strWork = Hex(I)
		strWork = "%" & Ucase(strWork)
		strResult = Replace(strResult,strWork, Chr(I))
	Next

	strResult = Replace(strResult,"%7E", "~")
	
	rfc3986_convert = strResult

End Function

</SCRIPT>
</JOB>














   SQLの窓    create:2010/06/09  update:2015/11/02   管理者用(要ログイン)





フリーフォントWEBサービス

SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ