PHP : bit.ly を使用した自サイト経由の短縮URLサービス作成

  bit.ly でアカウントを作成



Shorten & Share | bit.ly | a simple URL shortener でアカウントを作成
することによって簡単に URL短縮サービスを利用する事ができます。

一度アカウントを作成すると削除できません(2010/06/02現在)が、
登録するメールアドレスによる本人確認もありませんし、特に気にせず利用すればいいと思います。


関連する記事

Seesaa の設定に登録する bit.ly の APIキーの取得場所


そのアカウントでアクセスの分析や検索ができます。
shorten.php のような PHP を自サイトに置いておけば、API キーを隠した状態で新たに別のサービスと
して利用する事も可能です。
( たぶんそれを想定してだと思いますが、他のユーザが経由する事が可能です )

※ API を使う時に、パスワードは必要ありません。パスワードは WEB 上で情報管理
※ する為にのみ利用されます( APIキーはリセットできます )

APIキーの取得リンク

Bitly

shorten.php
01.<?
02.// **********************************************************
03.// bit.ly /v3/shorten
04.// **********************************************************
05.header( "Content-Type: text/html; Charset=utf-8" );
06.header( "pragma: no-cache" );
07.header( "Expires: Wed, 31 May 2000 14:59:58 GMT" );
08.header( "Cache-control: no-cache" );
09. 
10.// **********************************************************
11.// API
12.// **********************************************************
13.$api_url = 'http://api.bit.ly/v3/shorten';
14. 
15.$param = array();
16.$param['login'] = 'ユーザーID';
17.$param['apiKey'] = 'APIキー';
18.$param['longUrl'] = $_GET['url'];
19.$param['format'] = 'json';
20. 
21.$api_url .= "?" . http_build_query( $param );
22. 
23.// *********************************************************
24.// curl 処理
25.// *********************************************************
26.$curl = curl_init();
27.curl_setopt($curl, CURLOPT_CONNECTTIMEOUT, 30);
28.curl_setopt($curl, CURLOPT_HEADER, false);
29.curl_setopt($curl, CURLOPT_RETURNTRANSFER, true);
30.curl_setopt($curl, CURLOPT_BINARYTRANSFER, true);
31.curl_setopt($curl, CURLOPT_URL, $api_url);
32. 
33.// *********************************************************
34.// https 用
35.// ※ 今回は必要無し
36.// *********************************************************
37.//curl_setopt($curl, CURLOPT_SSL_VERIFYPEER, false);
38.//curl_setopt($curl, CURLOPT_SSL_VERIFYHOST, 1);
39. 
40.// *********************************************************
41.// 送信
42.// *********************************************************
43.curl_setopt($curl, CURLOPT_VERBOSE, true);  // デバッグ
44.$handle = fopen("./debug.txt", "w");
45.curl_setopt($curl, CURLOPT_STDERR, $handle);
46.$handle2 = fopen("./ret_header.txt", "w");
47.curl_setopt($curl, CURLOPT_WRITEHEADER, $handle2);
48.$result = curl_exec($curl);
49. 
50. 
51.// *********************************************************
52.// 結果
53.// *********************************************************
54.if($result === false) {
55.    print 'error';
56.    exit();
57.}
58.else {
59.    $json = json_decode($result);
60.}
61.curl_close($curl);
62.fclose($handle2);
63.fclose($handle);
64. 
65.//print "<pre>";
66.//var_dump($json);
67.//print "</pre>";
68. 
69.if ( $json->status_code == 200 ) {
70.    print $json->data->url ;
71.}
72.else {
73.//  print $json->status_txt;
74.    print 'error';
75.}
76.?>

※ 送信部分の curl_setopt はデバッグ用です。




  VBScript : shorten.php を https で呼び出してサービスとして利用



shorten.php は、短縮 URL を返すか、エラーを返すかどちらかの単純なサービスですが、
少し改造すれば、自分専用のサービスとして利用可能ですし、URL を https にすれば、一般
公開でも問題無いと思います。

shorten.wsf
001.<JOB>
002.<COMMENT>
003.************************************************************
004. bit.ly : shorten.wsf
005.        : shorten.php を呼び出して url を得る
006. 
007.          ?url=URLエンコードされたURL
008.  戻り値 : URL
009.         : エラーの場合は error という文字列が返ります
010.************************************************************
011.</COMMENT>
012. 
013.<OBJECT id="Stream" progid="ADODB.Stream" />
014.<OBJECT id="Stream2" progid="ADODB.Stream" />
015.<OBJECT id="StreamBin" progid="ADODB.Stream" />
016.<OBJECT id="objHTTP" progid="Msxml2.XMLHTTP" />
017. 
018.<SCRIPT language=VBScript>
019.' ***********************************************************
020.' 処理開始
021.' ***********************************************************
022.strUrl = "http://lightbox.on.coocan.jp/"
023. 
024.' ソース内テキストデータの表示
025.str = "https://自ドメイン/shorten.php?url="
026.str = str & rfc3986_convert(URLEncode(strUrl))
027. 
028.Call objHTTP.Open( "GET",str, False )
029.Call objHTTP.Send(str)
030. 
031.strUrl = objHTTP.responseText
032. 
033.Wscript.Echo strUrl
034. 
035.' GUI
036.MsgBox( "処理が終了しました   " )
037. 
038.' ***********************************************************
039.' SHIFT_JIS を UTF-8 に変換して URLエンコード
040.' ※ 全ての文字をパーセントエンコーディングします
041.' ***********************************************************
042.Function URLEncode(str)
043. 
044.    Stream.Open
045.    Stream.Charset = "shift_jis"
046.    ' shift_jis で入力文字を書き込む
047.    Stream.WriteText str
048.    ' コピーの為にデータポインタを先頭にセット
049.    Stream.Position = 0
050.  
051.    Stream2.Open
052.    Stream2.Charset = "utf-8"
053.    ' shift_jis を utf-8 に変換
054.    Stream.CopyTo Stream2
055.    Stream.Close
056. 
057.    ' コピーの為にデータポインタを先頭にセット
058.    Stream2.Position = 0
059. 
060.    ' バイナリで開く
061.    StreamBin.Open
062.    StreamBin.Type = 1
063. 
064.    ' テキストをバイナリに変換
065.    Stream2.CopyTo StreamBin
066.    Stream2.Close
067. 
068.    ' 読み込みの為にデータポインタを先頭にセット
069.    StreamBin.Position = 0
070. 
071.    Buffer = ""
072.    StreamBin.Read(3)
073.    Do while not StreamBin.EOS
074.        LineBuffer = StreamBin.Read(16)
075.  
076.        For i = 1 to LenB( LineBuffer )
077.            CWork = MidB(LineBuffer,i,1)
078.            Cwork = AscB(Cwork)
079.            Cwork = Hex(Cwork)
080.            Cwork = Ucase(Cwork)
081.            if Len(Cwork) = 1 then
082.                Buffer = Buffer & "%0" & Cwork
083.            else
084.                Buffer = Buffer & "%" & Cwork
085.            end if
086.        Next
087.  
088.    Loop
089. 
090.    StreamBin.Close
091. 
092.    URLEncode = Buffer
093. 
094.End Function
095. 
096.' ***********************************************************
097.' 仕様を明確にする為に単純変換
098.' ***********************************************************
099.Function rfc3986_convert(str)
100. 
101.    Dim strResult,I,strWork
102. 
103.    strResult = str
104. 
105.    strResult = Replace(strResult,"%2D", "-")
106.    strResult = Replace(strResult,"%2E", ".")
107. 
108.    ' 0~9
109.    For I = &H30 to &H39
110.        strWork = Hex(I)
111.        strWork = "%" & Ucase(strWork)
112.        strResult = Replace(strResult,strWork, Chr(I))
113.    Next
114. 
115.    ' A~Z
116.    For I = &H41 to &H5A
117.        strWork = Hex(I)
118.        strWork = "%" & Ucase(strWork)
119.        strResult = Replace(strResult,strWork, Chr(I))
120.    Next
121. 
122.    strResult = Replace(strResult,"%5F", "_")
123. 
124.    ' a~z
125.    For I = &H61 to &H7A
126.        strWork = Hex(I)
127.        strWork = "%" & Ucase(strWork)
128.        strResult = Replace(strResult,strWork, Chr(I))
129.    Next
130. 
131.    strResult = Replace(strResult,"%7E", "~")
132.     
133.    rfc3986_convert = strResult
134. 
135.End Function
136. 
137.</SCRIPT>
138.</JOB>














   SQLの窓    create:2010/06/02  update:2018/02/18   管理者用(要ログイン)





フリーフォントWEBサービス

SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ