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
<?
// **********************************************************
// bit.ly /v3/shorten
// **********************************************************
header( "Content-Type: text/html; Charset=utf-8" );
header( "pragma: no-cache" );
header( "Expires: Wed, 31 May 2000 14:59:58 GMT" );
header( "Cache-control: no-cache" );

// **********************************************************
// API
// **********************************************************
$api_url = 'http://api.bit.ly/v3/shorten';

$param = array();
$param['login'] = 'ユーザーID';
$param['apiKey'] = 'APIキー';
$param['longUrl'] = $_GET['url'];
$param['format'] = 'json';

$api_url .= "?" . http_build_query( $param );

// *********************************************************
// curl 処理
// *********************************************************
$curl = curl_init();
curl_setopt($curl, CURLOPT_CONNECTTIMEOUT, 30);
curl_setopt($curl, CURLOPT_HEADER, false);
curl_setopt($curl, CURLOPT_RETURNTRANSFER, true);
curl_setopt($curl, CURLOPT_BINARYTRANSFER, true);
curl_setopt($curl, CURLOPT_URL, $api_url);

// *********************************************************
// https 用
// ※ 今回は必要無し
// *********************************************************
//curl_setopt($curl, CURLOPT_SSL_VERIFYPEER, false);
//curl_setopt($curl, CURLOPT_SSL_VERIFYHOST, 1);

// *********************************************************
// 送信
// *********************************************************
curl_setopt($curl, CURLOPT_VERBOSE, true);	// デバッグ
$handle = fopen("./debug.txt", "w");
curl_setopt($curl, CURLOPT_STDERR, $handle);
$handle2 = fopen("./ret_header.txt", "w");
curl_setopt($curl, CURLOPT_WRITEHEADER, $handle2);
$result = curl_exec($curl);


// *********************************************************
// 結果
// *********************************************************
if($result === false) {
	print 'error';
	exit();
}
else {
	$json = json_decode($result);
}
curl_close($curl);
fclose($handle2);
fclose($handle);

//print "<pre>";
//var_dump($json);
//print "</pre>";

if ( $json->status_code == 200 ) {
	print $json->data->url ;
}
else {
//	print $json->status_txt;
	print 'error';
}
?>


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




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



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

shorten.wsf
<JOB>
<COMMENT>
************************************************************
 bit.ly : shorten.wsf
        : shorten.php を呼び出して url を得る

          ?url=URLエンコードされたURL
  戻り値 : URL
         : エラーの場合は error という文字列が返ります
************************************************************
</COMMENT>

<OBJECT id="Stream" progid="ADODB.Stream" />
<OBJECT id="Stream2" progid="ADODB.Stream" />
<OBJECT id="StreamBin" progid="ADODB.Stream" />
<OBJECT id="objHTTP" progid="Msxml2.XMLHTTP" />

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************
strUrl = "http://lightbox.on.coocan.jp/"

' ソース内テキストデータの表示
str = "https://自ドメイン/shorten.php?url="
str = str & rfc3986_convert(URLEncode(strUrl))

Call objHTTP.Open( "GET",str, False )
Call objHTTP.Send(str)

strUrl = objHTTP.responseText

Wscript.Echo strUrl

' GUI 
MsgBox( "処理が終了しました   " )

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

</SCRIPT>
</JOB>















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





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

SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ