MacBSの日常生活的日記

(5/6 15:47更新)
先日のAppleScript版に続き、VBScriptのほうも修正したので、更新して
再掲しておきます。
—

TwitterにURLを貼る場合、URL短縮サービスを使うことが多々あります。
最近のクライアントは自動でやってくれるものも多いですが、なぜか
うまくいかなかったりすることもありますよね。

というわけで、事前にクリップボードに入ったURLを短縮しちゃう
スクリプトを作ってみました。
Macではアップルスクリプトのものは先日掲載したので、次はVBScriptで。
ソースはこんな感じになりました。

s = GetClipText

if Left(s, 4) = “http” Then
    result = BitlyPost(s)
    If result = “” Then
        Msgbox “URLの短縮に失敗しました。”
        WScript.Quit
    End If
    SetClipText result
Else
    Msgbox “クリップボードにURLがセットされていません。”
End If

WScript.Quit

Function BitlyPost(url)

    sURL = “http://api.bit.ly/v3/shorten?login=★ユーザー名★&apiKey=★APIキー★&uri=” & url & “&format=txt”

    Set oHTTP = WScript.CreateObject(“Msxml2.XMLHTTP”)

    oHTTP.Open “GET”, sURL, False
    oHTTP.send

    BitlyPost = oHttp.responseText

End Function

Function GetClipText

    Set uf=CreateObject(“Forms.Form.1”)
    Set tb=uf.Controls.Add(“Forms.TextBox.1”).Object
    tb.MultiLine=True
    If tb.CanPaste Then
       tb.Paste
       GetClipText = tb.Text
    End If

    Set tb=Nothing
    Set uf=Nothing

End Function

Function SetClipText(s)

    Set uf=CreateObject(“Forms.Form.1”)
    Set tb=uf.Controls.Add(“Forms.TextBox.1”).Object
    tb.MultiLine=True
    tb.Text=s
    tb.SelStart=0
    tb.SelLength=tb.TextLength
    tb.Copy

    Set tb=Nothing
    Set uf=Nothing

End Function

クリップボードへのアクセスがWindows標準ではできないので、ここでは
Officeを利用しています。
IEでも可能なんですが、セキュリティ設定によっては動作しないことが
あるんですよねぇ。
ということで、しょぼいスクリプトのわりにはOffice必須です。(^^;

なお、クリップボードの取得・設定方法につきましては、以下のサイト様の
情報をそのまま利用させていただきました。感謝、感謝であります。
http://winscript.s41.xrea.com/wiki/index.php?[[FAQ]]#content_1_4

AppleScriptのほうはurlencode必須でしたが、Windowsのブラウザは
urlencodeした状態で返してくれるようなので、そのまま何もしていません。
一応うまくいってるようですが、あくまでもサンプルみたいなものですので、
自己責任でご利用いただければ幸いです。
なお、スクリプトファイルは下の場所にも置いておきました。
http://saramac.main.jp/fw/bitly.vbs

(当サイトでは、Amazonアソシエイトをはじめとした第三者配信のアフィリエイトプログラムにより商品をご紹介致しております。)