VBScript でバッチ mixi ボイス投稿

  正しい手順での応答処理



2011/07/10 : 更新しました

Msxml2.ServerXMLHTTP でないと動かなかったので、修正してテストするとまだ投稿可能でした。
また、サーバーオブジェクトの為、クッキーのやりとりが自動で行われるようなので、手動でやっていた
部分をコメントにしました


1) ログイン( ここは https が使えます )
2) クッキーが返されるので、そのクッキーをセットして mixi ボイス投稿画面へ移動
3) その画面に投稿用の post_key が埋め込まれているので取り出す
4) そのキーを使って POST 投稿

mixi 側の仕様変更で動かなくなりますが、現在は結構単純な投稿プロトコルです。
複雑にすると、多くのユーザに影響が出るおそれもあるのでそんなに変わらないとは思います

MSXML2.XMLHTTP は、IE と同じ処理になるはずなので、https も使えるだろうと
テストしたら特に問題なかったので、その先普通に想像できる手順で処理できました。

この方法で、通常投稿や、足跡のログを取りだす事もできるはずです。
( ※ 正規表現が必要になって来ますが )


関連する記事

PHP+VBScript : WEB上のDBをローカルPCから更新する




  mixi ボイス投稿コード



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

' ***********************************************************
' 初回のログイン
' この戻りで、セッション用のクッキーが取得できます
' ***********************************************************
Call objHTTP.Open("POST","https://mixi.jp/login.pl?from=login1",False)
Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
strData = "next_url=" & EUC_URLEncode("/") & "home.pl"
strData = strData & "&email=メールアドレス"
strData = strData & "&password=パスワード"
Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
Call objHTTP.Send(strData)

' ***********************************************************
' 全てのヘッダ( クッキーが含まれる )
' ***********************************************************
'strHeaders = objHTTP.getAllResponseHeaders()

' ***********************************************************
' クッキーを取得( 2つセットされています )
' ***********************************************************
'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
'		strCookie = strCookie & strWork & ";"
'	end if
'
'Next

' ***********************************************************
' ボイス画面の呼び出し
' ***********************************************************
Call objHTTP.Open("GET","https://mixi.jp/recent_voice.pl",False)
'Call objHTTP.setRequestHeader("Cookie", strCookie )
Call objHTTP.Send()

' ***********************************************************
' post_key を正規表現で取得
' ***********************************************************
Set regEx = New RegExp
 
regEx.IgnoreCase = True
regEx.Global = True
 
regEx.Pattern = "post_key"" value=""([^""]+)"""
 
Set Matches = regEx.Execute( objHTTP.responseText )
For Each Match in Matches
	strPostKey = Match.SubMatches(0)
	Exit For
Next

' ***********************************************************
' 投稿
' ***********************************************************
Call objHTTP.Open("POST","http://mixi.jp/add_voice.pl",False)
Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
strData = "body=" & EUC_URLEncode("いつまで有効が解りませんが、アプリケーションのバッチ投稿が可能です")
strData = strData & "&post_key=" & strPostKey
Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
Call objHTTP.Send(strData)

' ***********************************************************
' SHIFT_JIS を EUC-JP に変換して URLエンコード
' ***********************************************************
Function EUC_URLEncode(str)

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

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

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

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

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

	Buffer = ""
	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

	EUC_URLEncode = Buffer

End Function
  










  infoboard   管理者用   





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

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ