| ' ***********************************************************
' ( 連続実行を想定しているので、クライアント用オブジェクト )
' ***********************************************************
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
| |