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