<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>