ソース掲示板




すべてから検索

キーワード   条件 表示 現行ログ 過去ログ トピックス 名前 本文
WSH : VBScript から JavaScript で書かれた crypto-js を使って投稿する
日時: 2014/03/08 15:01
名前: lightbox



<JOB>
<COMMENT>
************************************************************
■著作権その他

このプログラムはフリーです。どうぞ自由に御使用ください。
著作権は作者である私(lightbox)が保有しています。
また、本ソフトを運用した結果については、作者は一切責任を
負えせんのでご了承ください。
************************************************************
</COMMENT>

<OBJECT id="objHTTP" progid="Msxml2.ServerXMLHTTP" />
<OBJECT id="Stream1" progid="ADODB.Stream" />
<OBJECT id="Stream2" progid="ADODB.Stream" />
<OBJECT id="StreamBin" progid="ADODB.Stream" />

<COMMENT>
************************************************************
 HMAC-SHA1 と Base64用
************************************************************
</COMMENT>
<SCRIPT language="JavaScript" src="hmac-sha1.js"></SCRIPT> 
<SCRIPT language="JavaScript" src="enc-base64-min.js"></SCRIPT> 
<SCRIPT language="JavaScript"> 
// *********************************************************
// JavaScript メソッドのラッパー
// *********************************************************
function hash_hmac(str1,str2) {

	// ここで使用します
	var hash = CryptoJS.HmacSHA1(str1, str2);
	return hash.toString(CryptoJS.enc.Base64);

}
</SCRIPT>

<SCRIPT language="VBScript">

' ***********************************************************
' ▼▼▼ こちらにご自分の API データをセットします ▼▼▼
' ***********************************************************
oauth_consumer_key = ""
oauth_consumer_secret = ""
oauth_token = ""
oauth_secret = ""
' ***********************************************************
' ▲▲▲ こちらにご自分の API データをセットします ▲▲▲
' ***********************************************************

strPost = WScript.Arguments(0)

PostTwitter(strPost)

' **********************************************************
' Twitter に自分のアプリケーションで投稿
' **********************************************************
Function PostTwitter( postdata )

	Dim twitter_url
	Dim oauth_nonce,oauth_timestamp,oauth_signature_method,oauth_version
	Dim str,oauth_signature,headerAuth,strData,strRet

	' **************************************
	' Twitter 投稿用 API URL
	' **************************************
	twitter_url = "https://api.twitter.com/1.1/statuses/update.json"

	oauth_nonce = Nonce()
	oauth_timestamp = DateDiff("s", "1970/1/1 0:00:00",DateAdd("h",-9,now))
	oauth_signature_method = "HMAC-SHA1"
	oauth_version = "1.0"

	base_s = "POST"
	base_s = base_s & "&" & rfc3986_convert(URLEncode(twitter_url))
	base_s = base_s & "&"
	base_s = base_s & "oauth_consumer_key" & "%3D" & oauth_consumer_key
	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 & "%26"
	base_s = base_s & "status" & "%3D" & _
	rfc3986_convert(URLEncode(rfc3986_convert(URLEncode(postdata))))

	oauth_signature = hash_hmac(base_s,oauth_consumer_secret & "&" & oauth_secret)
	Call objHTTP.Open( "POST",twitter_url, False )
	Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
'	Call objHTTP.setRequestHeader("Expect", "")
	headerAuth = "OAuth " & _
	"oauth_consumer_key="""&oauth_consumer_key&"""," & _
	"oauth_token="""&oauth_token&"""," & _
	"oauth_nonce="""&oauth_nonce&"""," & _
	"oauth_timestamp="""&oauth_timestamp&"""," & _
	"oauth_signature_method="""&oauth_signature_method&"""," & _
	"oauth_version="""&oauth_version&"""," & _
	"oauth_signature="""&rfc3986_convert(URLEncode(oauth_signature))&""""
	Call objHTTP.setRequestHeader("Authorization", headerAuth)
	strData = "status=" & rfc3986_convert(URLEncode(postdata))
	Call objHTTP.SetRequestHeader("Content-Length",Len(strData))

	Dim lResolve : lResolve = 60 * 1000
	Dim lConnect : lConnect = 60 * 1000
	Dim lSend : lSend = 60 * 1000
	Dim lReceive : lReceive = 60 * 1000
	Call objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
	Call objHTTP.Send(strData)
	PostTwitter = objHTTP.responseText

End Function

' ***********************************************************
' ランダムな文字列
' ***********************************************************
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)

	Stream1.Open
	Stream1.Charset = "shift_jis"
	' shift_jis で入力文字を書き込む
	Stream1.WriteText str
	' コピーの為にデータポインタを先頭にセット
	Stream1.Position = 0
 
	Stream2.Open
	Stream2.Charset = "utf-8"
	' shift_jis を utf-8 に変換
	Stream1.CopyTo Stream2
	Stream1.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>
メンテナンス


日時: 2014/03/08 15:01
名前: lightbox