fenrirからTwitterにPOSTしたりするVBScript

使用に関しては自己責任でお願いします！
何かあっても責任とれません。
自分が必要な機能を追加したら更新していますので、たまに見るとコードが変わっているかもしれません。

単純に自分が欲しいから作ったというだけ。
パスワードを平文送信しているのでその辺が嫌な人は絶対に使わないでください。
というかこれ解決する方法あったら教えてください。
続きを見るでソースが見れます。コピペとかして使ってください。
fenrirって何？って人は「ランチャ fenrir」ぐぐれ。
Do Untilやってる部分がブサイクだなぁって思ってるけどどうやって解決したらいいだろう。

以下のページを参考にさせて(コピペもした)頂きました。

Scripting Weblog - [Twitter][WSH]Twitterにポストする
http://blogs.wankuma.com/mutaguchi/archive/2008/07/02/146863.aspx

SO NOTE そうのて (；^ω^)  - VBAでJSONファイルをパースする
http://d.hatena.ne.jp/so_blue/20090326/1238084885

Frown Wiki - fenrir Tips
http://fw.ampll.org/index.php?fenrir%20%2F%20Tips#sb7f332c

※2009/11/19 公式RT取得・APIの状態取得を追加
※2009/11/21 vbs部分をコピペミスで重複定義していたので修正

fenrirのinstant.iniに追加する中身

;TwitterにPOSTする
/tp=%cmddir\twitterAccess.vbs POST "%A"
;TLの取得
/tt=%cmddir\twitterAccess.vbs TL_VIEW
;Replyの取得
/tre=%cmddir\twitterAccess.vbs REPLY_VIEW
;ReTweetの取得
/trt=%cmddir\twitterAccess.vbs REPLY_TO_ME
/trb=%cmddir\twitterAccess.vbs REPLY_BY_ME
/tro=%cmddir\twitterAccess.vbs REPLY_OF_ME
;APIの状態取得
/ta=%cmddir\twitterAccess.vbs API_LIMIT

vbsの中身(fenrirのcmdフォルダにtwitterAccess.vbsで作成, 保存はSJISで)

Option Explicit

'fenrirからの引数
Const PROC_POST = "POST"
Const PROC_TLGET = "TL_VIEW"
Const PROC_REPLY = "REPLY_VIEW"
Const PROC_REPLY_TO_ME = "REPLY_TO_ME"
Const PROC_REPLY_BY_ME = "REPLY_BY_ME"
Const PROC_REPLY_OF_ME = "REPLY_OF_ME"
Const PROC_API_LIMIT = "API_LIMIT"
'ユーザーID
Const USER_NAME = "********"
'パスワード
Const PASSWORD = "********"
'POSTのURL
Const POST_URL = "http://twitter.com/statuses/update.json"
'TL取得のURL
Const HOME_TL_URL = "http://twitter.com/statuses/home_timeline.json"
'menrionsのURL
Const MENTIONS_URL = "http://twitter.com/statuses/mentions.json"
'RTのURL
Const REPLY_TO_ME_URL = "http://twitter.com/statuses/retweeted_to_me.json"
Const REPLY_BY_ME_URL = "http://twitter.com/statuses/retweeted_by_me.json"
Const REPLY_OF_ME_URL = "http://twitter.com/statuses/retweeted_of_me.json"
'API limitのURL
Const API_LIMIT_URL = "http://twitter.com/account/rate_limit_status.json"
'Tweetの取得数(200が限界)
Const GET_POST_COUNT = 60

Select Case WScript.Arguments(0)
    Case PROC_POST
        '引数が足りない場合は処理しない
        If WScript.Arguments.Count > 1 Then
            Call Post(Trim(WScript.Arguments(1)))
        End If
    Case PROC_TLGET
        Call GetTimeLine(HOME_TL_URL)
    Case PROC_REPLY
        Call GetTimeLine(MENTIONS_URL)
    Case PROC_REPLY_TO_ME
    	Call GetTimeLine(REPLY_TO_ME_URL)
    Case PROC_REPLY_BY_ME
    	Call GetTimeLine(REPLY_BY_ME_URL)
    Case PROC_REPLY_OF_ME
    	Call GetTimeLine(REPLY_OF_ME_URL)
    Case PROC_API_LIMIT
    	Call GetAPILimit
End Select

'Postする
Sub Post(postString)
    Dim oHTTP, sc, js, isLonger
    
    '文字数チェック
    isLonger = True
    Do while isLonger = True
        If Len(postString) = 0 Then
            Exit Sub
        ElseIf Len(postString) > 140 then
            postString = InputBox("Message Length Over." & vbcrlf & "Edit for Input String" , "TwitterAccessAPI", postString)
        Else
            isLonger = False
        End If
    Loop

    Set oHTTP = WScript.CreateObject("Msxml2.XMLHTTP")
    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"
    Set js = sc.CodeObject
    
    'API呼び出し
    oHTTP.Open "POST", POST_URL, False, USER_NAME, PASSWORD
    oHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    oHTTP.setRequestHeader "X-Twitter-Client", "twitterAccess.vbs"
    oHTTP.setRequestHeader "X-Twitter-Client-Version", "1.0"
    oHTTP.send "status=" & js.encodeURIComponent(postString)
    '反応を待たないとそのまま処理を続行してプロセスが残るため待機
    Do Until oHTTP.readyState = "4"
    Loop
    '失敗したときだけエラーを表示
    If oHttp.status <> "200" Then
        WScript.Echo "Post Error! Error Code : " & oHttp.status
    End If
    Set js = Nothing
    Set sc = Nothing
    Set oHTTP = Nothing
End Sub

'TLを取得する
Sub GetTimeLine(API_URL)
    Dim oHTTP, sc, js, strFunc, resp, respJson, dispStr
    Set oHTTP = WScript.CreateObject("Msxml2.XMLHTTP")
    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"
    'jsonにパースする関数文字列
    strFunc = "function jsonParse(s) { return eval('(' + s + ')'); }"
    '関数を追加
    sc.AddCode strFunc
    Set js = sc.CodeObject

    'API呼び出し
    oHTTP.Open "GET", API_URL & "?count=" & GET_POST_COUNT, False, USER_NAME, PASSWORD
    oHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    oHTTP.setRequestHeader "X-Twitter-Client", "twitterAccess.vbs"
    oHTTP.setRequestHeader "X-Twitter-Client-Version", "1.0"
    oHTTP.send null
    '反応を待たないとそのまま処理を続行してプロセスが残るため待機
    Do Until oHTTP.readyState = "4"
    Loop
    'ステータスの確認
    If oHTTP.status = 200 Then
        Set respJson = js.jsonParse(oHTTP.responseText)
        dispStr = ""
        For Each resp In respJson
            dispStr = dispStr & "[ " & resp.user.screen_name & " ] " & resp.text & vbcrlf
        Next
    Else
        dispStr = "Error! Error Code = " & oHTTP.status
    End If
    '内容の表示
    WScript.Echo dispStr
    Set respJson = Nothing
    Set resp = Nothing
    Set js = Nothing
    Set sc = Nothing
    Set oHTTP = Nothing
End Sub

'API使用回数とかの取得
Sub GetAPILimit
    Dim oHTTP, sc, js, strFunc, respJson, dispStr
    Set oHTTP = WScript.CreateObject("Msxml2.XMLHTTP")
    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"
    'jsonにパースする関数文字列
    strFunc = "function jsonParse(s) { return eval('(' + s + ')'); }"
    '関数を追加
    sc.AddCode strFunc
    Set js = sc.CodeObject

    'API呼び出し
    oHTTP.Open "GET", API_LIMIT_URL, False, USER_NAME, PASSWORD
    oHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    oHTTP.setRequestHeader "X-Twitter-Client", "twitterAccess.vbs"
    oHTTP.setRequestHeader "X-Twitter-Client-Version", "1.0"
    oHTTP.send null
    '反応を待たないとそのまま処理を続行してプロセスが残るため待機
    Do Until oHTTP.readyState = "4"
    Loop
    'ステータスの確認
    If oHTTP.status = 200 Then
        Set respJson = js.jsonParse(oHTTP.responseText)
        dispStr = ""
        dispStr = dispStr & "[ remaining_hits ] = " & respJson.remaining_hits& vbcrlf
        dispStr = dispStr & "[ hourly_limit ] = " & respJson.hourly_limit& vbcrlf
        dispStr = dispStr & "[ reset_time ] = " & respJson.reset_time& vbcrlf
        dispStr = dispStr & "[ reset_time_in_seconds ] = " & respJson.reset_time_in_seconds& vbcrlf
    Else
        dispStr = "Error! Error Code = " & oHTTP.status
    End If
    '内容の表示
    WScript.Echo dispStr
    Set respJson = Nothing
    Set js = Nothing
    Set sc = Nothing
    Set oHTTP = Nothing
End Sub