VBScript でバッチ twitter 投稿

  本来は API を使うので、必要ありませんが mixi と同じでした



現在は動作しません

当時は試しにやってみたのは、API の無い mixi のテストのついでだったのですが、Twitter は API で
普通に投稿できるので以下を参照して下さい

VBScript : Twitter API を呼び出して投稿する

また、mixi ボイスのほうも試してみたら、少し問題があったので修正して動くようにしました

VBScript でバッチ mixi ボイス投稿




2010/05/26 更新

1) デバックフラグを追加
2) ログインをユーザ名に変更( ルートは混雑する可能性があります )
3) rfc3986_convert を追加


VBScript でバッチ mixi ボイス投稿 が動作したので、Twitter も試してみたら、基本的には同じでした。

ログインが https で、ログイン後、セッション用のクッキーを取得して、そのクッキーをセットして
投稿画面を呼び出すと、投稿用のキーが hidden のフィールドにセットされているので取り出して、
普通に POST します。

※ 環境によっては、lang=ja もセットする必要があるかもしれません
※ クッキーは無くても動作しました
※ アクセストークンを取得するページの仕様が変わると動作しなくなります
※ 現在 API で呼び出すテスト中です

関連する記事

PHP : CodeIgniter + Twitter API Library での oauth 投稿の具体的なポイント
Ruby + mechanize : mixi ボイスとTwitterへの同時投稿のプロトタイプ
Ruby + mechanize : mixi ボイスへの投稿を php と連携して行う




  Twitter.vbs ( 最新コード ) : 2010/05/26



1) デバックフラグを追加しました( テスト以外で実際に利用する場合は、False にします )
2) アクセストークンを取得する為のページをユーザページより取得する為に、ログインをユーザ名にしました
  ( ルートは混雑する可能性があります )
3) 次の段階として、正式な API でテストする予定なので rfc3986_convert を追加しました。

関連する記事

PHP/JavaScript/ASP/ps/py : 処理別の urlencode の結果の違い



  
' ***********************************************************
' Twittre 投稿
' ***********************************************************
bDebug = True
strText = "VBScriptから投稿しています"

Set objHTTP = Wscript.CreateObject("MSXML2.XMLHTTP")
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set Stream2 = Wscript.CreateObject("ADODB.Stream")
Set StreamBin = Wscript.CreateObject("ADODB.Stream")

strUser = "ユーザー名"
strPass = "パスワード"
strLoginTargetPath = "https://twitter.com/sessions"
strMainPagePath = "http://twitter.com/" & strUser
strTargetPath = "http://twitter.com/status/update"


Call objHTTP.Open( "POST",strLoginTargetPath, False )
Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
strData = ""
strData = strData & "session%5Busername_or_email%5D="&strUser
strData = strData & "&session%5Bpassword%5D="&strPass
Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
Call objHTTP.Send(strData)

' ***********************************************************
' 返されたヘッダー
' ***********************************************************
strHeaders = objHTTP.getAllResponseHeaders()

if bDebug then
	if 2 = MsgBox( strHeaders, 1 ) then
		Wscript.Quit
	end if
end if

' ***********************************************************
' ヘッダーを改行で分解
' ***********************************************************
aHeader = Split(strHeaders,vbCrLf)
strCookie = ""

' ***********************************************************
' Set-Cookie を取得
' ( これが無くても動くようです )
' ***********************************************************
For I = 0 to Ubound(aHeader)

	if Left(aHeader(I),10) = "Set-Cookie" then
		aCookie = Split( aHeader(I), ":" )
		strWork = Trim(aCookie(1))
		aCookie = Split( strWork, ";" )
		strWork = Trim(aCookie(0))
		if strCookie <> "" then
			strCookie = strCookie & " "
		end if
		if Left(strWork,8) = "_twitter" then
			strCookie = strCookie & strWork & ";"
		end if
	end if

Next

if bDebug then
	if 2 = MsgBox( strCookie, 1 ) then
		Wscript.Quit
	end if
end if

' ***********************************************************
' メインページへアクセス
' ***********************************************************
Call objHTTP.Open("GET",strMainPagePath,False)
' これが無くても動くようです
' ( アクセストークンの埋め込まれたページが取得できた )
Call objHTTP.setRequestHeader("Cookie", strCookie )
Call objHTTP.Send()

if bDebug then
	if 2 = MsgBox( objHTTP.responseText, 1 ) then
		Wscript.Quit
	end if
end if


' ***********************************************************
' アクセス用のトークンを取得
' ***********************************************************
Set regEx = New RegExp
 
regEx.IgnoreCase = True
regEx.Global = True
 
regEx.Pattern = "authenticity_token"" type=""hidden"" value=""([^""]+)"""
 
Set Matches = regEx.Execute( objHTTP.responseText )
For Each Match in Matches
	strPostKey = Match.SubMatches(0)
	Exit For
Next

if bDebug then
	if 2 = MsgBox( strPostKey, 1 ) then
		Wscript.Quit
	end if
end if


' ***********************************************************
' 投稿
' ***********************************************************
Call objHTTP.Open("POST",strTargetPath,False)
Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
strData = "status=" & rfc3986_convert(URLEncode(strText))
strData = strData & "&authenticity_token=" & strPostKey
Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
Call objHTTP.Send(strData)

'Wscript.Echo objHTTP.responseText
Wscript.Echo "OK"

' ***********************************************************
' 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 = ""
	' BOMを取り去る
	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
  



  Twitter.vbs ( 旧コード )

データを追って行くと、何故か同名フィールドが二つあったり、クッキーエントリが同じのが二つ
あったりして、トラップかと思いましたが、無視して動きました。作成側のチェック漏れでしょうね。

※ デバッグ用のコードをコメントで残しています

  
' ***********************************************************
' ( 連続実行を想定しているので、クライアント用オブジェクト )
' ***********************************************************
Set objHTTP = Wscript.CreateObject("MSXML2.XMLHTTP")
' ***********************************************************
' キャラクタセット変換用
' ***********************************************************
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set Stream2 = Wscript.CreateObject("ADODB.Stream")
' ***********************************************************
' URLエンコード用
' ***********************************************************
Set StreamBin = Wscript.CreateObject("ADODB.Stream")

Call objHTTP.Open("POST","https://twitter.com/sessions",False)
Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
strData = ""
strData = strData & "session%5Busername_or_email%5D=メールアドレス"
strData = strData & "&session%5Bpassword%5D=パスワード"
Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
Call objHTTP.Send(strData)

strHeaders = objHTTP.getAllResponseHeaders()

'Wscript.Echo strHeaders
'Wscript.Quit

aHeader = Split(strHeaders,vbCrLf)
strCookie = ""

For I = 0 to Ubound(aHeader)

	if Left(aHeader(I),10) = "Set-Cookie" then
		aCookie = Split( aHeader(I), ":" )
		strWork = Trim(aCookie(1))
		aCookie = Split( strWork, ";" )
		strWork = Trim(aCookie(0))
		if strCookie <> "" then
			strCookie = strCookie & " "
		end if
		if Left(strWork,8) = "_twitter" then
			strCookie = strCookie & strWork & ";"
		end if
	end if

Next

'Wscript.Echo strCookie
'Wscript.Quit

Call objHTTP.Open("GET","http://twitter.com/",False)
Call objHTTP.setRequestHeader("Cookie", strCookie )
Call objHTTP.Send()

'Wscript.Echo objHTTP.responseText
'Wscript.Quit

Set regEx = New RegExp
 
regEx.IgnoreCase = True
regEx.Global = True
 
regEx.Pattern = "authenticity_token"" type=""hidden"" value=""([^""]+)"""
 
Set Matches = regEx.Execute( objHTTP.responseText )
For Each Match in Matches
	strPostKey = Match.SubMatches(0)
	Exit For
Next

'Wscript.Echo strPostKey
'Wscript.Quit

Call objHTTP.Open("POST","http://twitter.com/status/update",False)
Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
strData = "status=" & URLEncode("いつまで有効が解りませんが、" & _
	"VBScript でアプリケーションのバッチ投稿が可能です")
strData = strData & "&authenticity_token=" & strPostKey
Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
Call objHTTP.Send(strData)

'Wscript.Echo objHTTP.responseText
Wscript.Echo "OK"


' ***********************************************************
' 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 = ""
	' BOMを取り去る
	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
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加




SQLの窓  天気  IT用語辞典
Yahoo!ニュース  マルチ辞書
PHP マニュアル  Google URL短縮 


フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ