Tween/ShortUrl.vb

   1 ' Tween - Client of Twitter
   2 ' Copyright (c) 2007-2011 kiri_feather (@kiri_feather) <kiri.feather@gmail.com>
   3 '           (c) 2008-2011 Moz (@syo68k)
   4 '           (c) 2008-2011 takeshik (@takeshik) <http://www.takeshik.org/>
   5 '           (c) 2010-2011 anis774 (@anis774) <http://d.hatena.ne.jp/anis774/>
   6 '           (c) 2010-2011 fantasticswallow (@f_swallow) <http://twitter.com/f_swallow>
   7 ' All rights reserved.
   8 '
   9 ' This file is part of Tween.
  10 '
  11 ' This program is free software; you can redistribute it and/or modify it
  12 ' under the terms of the GNU General Public License as published by the Free
  13 ' Software Foundation; either version 3 of the License, or (at your option)
  14 ' any later version.
  15 '
  16 ' This program is distributed in the hope that it will be useful, but
  17 ' WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  18 ' or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
  19 ' for more details.
  20 '
  21 ' You should have received a copy of the GNU General Public License along
  22 ' with this program. If not, see <http://www.gnu.org/licenses/>, or write to
  23 ' the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
  24 ' Boston, MA 02110-1301, USA.
  25
  26 Imports System.Text.RegularExpressions
  27 Imports System.Web
  28
  29 Public Class ShortUrl
  30     Private Shared _ShortUrlService() As String = { _
  31         "http://t.co/", _
  32         "http://tinyurl.com/", _
  33         "http://is.gd/", _
  34         "http://snipurl.com/", _
  35         "http://snurl.com/", _
  36         "http://nsfw.in/", _
  37         "http://qurlyq.com/", _
  38         "http://dwarfurl.com/", _
  39         "http://icanhaz.com/", _
  40         "http://tiny.cc/", _
  41         "http://urlenco.de/", _
  42         "http://bit.ly/", _
  43         "http://piurl.com/", _
  44         "http://linkbee.com/", _
  45         "http://traceurl.com/", _
  46         "http://twurl.nl/", _
  47         "http://cli.gs/", _
  48         "http://rubyurl.com/", _
  49         "http://budurl.com/", _
  50         "http://ff.im/", _
  51         "http://twitthis.com/", _
  52         "http://blip.fm/", _
  53         "http://tumblr.com/", _
  54         "http://www.qurl.com/", _
  55         "http://digg.com/", _
  56         "http://ustre.am/", _
  57         "http://pic.gd/", _
  58         "http://airme.us/", _
  59         "http://qurl.com/", _
  60         "http://bctiny.com/", _
  61         "http://j.mp/", _
  62         "http://goo.gl/", _
  63         "http://ow.ly/", _
  64         "http://bkite.com/", _
  65         "http://youtu.be/", _
  66         "http://dlvr.it/", _
  67         "http://p.tl/", _
  68         "http://ht.ly/", _
  69         "http://tl.gd/", _
  70         "http://htn.to/", _
  71         "http://amzn.to/", _
  72         "http://flic.kr/", _
  73         "http://ux.nu/", _
  74         "http://moi.st/" _
  75     }
  76
  77     Private Shared _bitlyId As String = ""
  78     Private Shared _bitlyKey As String = ""
  79     Private Shared _isresolve As Boolean = True
  80
  81     Private Shared ReadOnly _lockObj As New Object
  82
  83     Public Shared WriteOnly Property BitlyId() As String
  84         Set(ByVal value As String)
  85             _bitlyId = value
  86         End Set
  87     End Property
  88
  89     Public Shared WriteOnly Property BitlyKey() As String
  90         Set(ByVal value As String)
  91             _bitlyKey = value
  92         End Set
  93     End Property
  94
  95     Public Shared Property IsResolve As Boolean
  96         Get
  97             Return _isresolve
  98         End Get
  99         Set(ByVal value As Boolean)
 100             _isresolve = value
 101         End Set
 102     End Property
 103
 104     Public Shared Function Resolve(ByVal orgData As String) As String
 105         If _isresolve Then
 106             Static urlCache As New Dictionary(Of String, String)
 107             SyncLock _lockObj
 108                 If urlCache.Count > 500 Then
 109                     urlCache.Clear() '定期的にリセット
 110                 End If
 111             End SyncLock
 112
 113             Dim m As MatchCollection = Regex.Matches(orgData, "<a href=""(?<svc>http://.+?/)(?<path>[^""]+)""", RegexOptions.IgnoreCase)
 114             Dim urlList As New List(Of String)
 115             For Each orgUrlMatch As Match In m
 116                 Dim orgUrl As String = orgUrlMatch.Result("${svc}")
 117                 Dim orgUrlPath As String = orgUrlMatch.Result("${path}")
 118                 If Array.IndexOf(_ShortUrlService, orgUrl) > -1 AndAlso _
 119                    Not urlList.Contains(orgUrl + orgUrlPath) Then
 120                     SyncLock _lockObj
 121                         urlList.Add(orgUrl + orgUrlPath)
 122                     End SyncLock
 123                 End If
 124             Next
 125             For Each orgUrl As String In urlList
 126                 If urlCache.ContainsKey(orgUrl) Then
 127                     Try
 128                         orgData = orgData.Replace("<a href=""" + orgUrl + """", "<a href=""" + urlCache(orgUrl) + """")
 129                     Catch ex As Exception
 130                         'Through
 131                     End Try
 132                 Else
 133                     Try
 134                         'urlとして生成できない場合があるらしい
 135                         'Dim urlstr As String = New Uri(urlEncodeMultibyteChar(orgUrl)).GetLeftPart(UriPartial.Path)
 136                         Dim retUrlStr As String = ""
 137                         Dim tmpurlStr As String = New Uri(urlEncodeMultibyteChar(orgUrl)).GetLeftPart(UriPartial.Path)
 138                         Dim httpVar As New HttpVarious
 139                         retUrlStr = urlEncodeMultibyteChar(httpVar.GetRedirectTo(tmpurlStr))
 140                         If retUrlStr.StartsWith("http") Then
 141                             retUrlStr = retUrlStr.Replace("""", "%22")  'ダブルコーテーションがあるとURL終端と判断されるため、これだけ再エンコード
 142                             orgData = orgData.Replace("<a href=""" + orgUrl + """", "<a href=""" + retUrlStr + """")
 143                             SyncLock _lockObj
 144                                 urlCache.Add(orgUrl, retUrlStr)
 145                             End SyncLock
 146                         End If
 147                     Catch ex As Exception
 148                         'Through
 149                     End Try
 150                 End If
 151             Next
 152         End If
 153         Return orgData
 154     End Function
 155
 156     Public Shared Function Make(ByVal ConverterType As UrlConverter, ByVal SrcUrl As String) As String
 157         Dim src As String = urlEncodeMultibyteChar(SrcUrl)
 158         Dim param As New Dictionary(Of String, String)
 159         Dim content As String = ""
 160
 161         For Each svc As String In _ShortUrlService
 162             If SrcUrl.StartsWith(svc) Then
 163                 Return "Can't convert"
 164             End If
 165         Next
 166
 167         'nico.msは短縮しない
 168         If SrcUrl.StartsWith("http://nico.ms/") Then Return "Can't convert"
 169
 170         SrcUrl = HttpUtility.UrlEncode(SrcUrl)
 171
 172         Select Case ConverterType
 173             Case UrlConverter.TinyUrl       'tinyurl
 174                 If SrcUrl.StartsWith("http") Then
 175                     If "http://tinyurl.com/xxxxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
 176                         ' 明らかに長くなると推測できる場合は圧縮しない
 177                         content = src
 178                         Exit Select
 179                     End If
 180                     If Not (New HttpVarious).PostData("http://tinyurl.com/api-create.php?url=" + SrcUrl, Nothing, content) Then
 181                         Return "Can't convert"
 182                     End If
 183                 End If
 184                 If Not content.StartsWith("http://tinyurl.com/") Then
 185                     Return "Can't convert"
 186                 End If
 187             Case UrlConverter.Isgd
 188                 If SrcUrl.StartsWith("http") Then
 189                     If "http://is.gd/xxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
 190                         ' 明らかに長くなると推測できる場合は圧縮しない
 191                         content = src
 192                         Exit Select
 193                     End If
 194                     If Not (New HttpVarious).PostData("http://is.gd/api.php?longurl=" + SrcUrl, Nothing, content) Then
 195                         Return "Can't convert"
 196                     End If
 197                 End If
 198                 If Not content.StartsWith("http://is.gd/") Then
 199                     Return "Can't convert"
 200                 End If
 201             Case UrlConverter.Twurl
 202                 If SrcUrl.StartsWith("http") Then
 203                     If "http://twurl.nl/xxxxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
 204                         ' 明らかに長くなると推測できる場合は圧縮しない
 205                         content = src
 206                         Exit Select
 207                     End If
 208                     param.Add("link[url]", SrcUrl)
 209                     If Not (New HttpVarious).PostData("http://tweetburner.com/links", param, content) Then
 210                         Return "Can't convert"
 211                     End If
 212                 End If
 213                 If Not content.StartsWith("http://twurl.nl/") Then
 214                     Return "Can't convert"
 215                 End If
 216             Case UrlConverter.Bitly, UrlConverter.Jmp
 217                 Const BitlyLogin As String = "tweenapi"
 218                 Const BitlyApiKey As String = "R_c5ee0e30bdfff88723c4457cc331886b"
 219                 Const BitlyApiVersion As String = "3"
 220                 If SrcUrl.StartsWith("http") Then
 221                     If "http://bit.ly/xxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
 222                         ' 明らかに長くなると推測できる場合は圧縮しない
 223                         content = src
 224                         Exit Select
 225                     End If
 226                     Dim req As String = ""
 227                     req = "http://api.bitly.com/v" + BitlyApiVersion + "/shorten?"
 228                     req += "login=" + BitlyLogin + _
 229                         "&apiKey=" + BitlyApiKey + _
 230                         "&format=txt" + _
 231                         "&longUrl=" + SrcUrl
 232                     If _bitlyId <> "" AndAlso _bitlyKey <> "" Then req += "&x_login=" + _bitlyId + "&x_apiKey=" & _bitlyKey
 233                     If ConverterType = UrlConverter.Jmp Then req += "&domain=j.mp"
 234                     If Not (New HttpVarious).GetData(req, Nothing, content) Then
 235                         Return "Can't convert"
 236                     End If
 237                 End If
 238             Case UrlConverter.Uxnu
 239                 If SrcUrl.StartsWith("http") Then
 240                     If "http://ux.nx/xxxxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
 241                         ' 明らかに長くなると推測できる場合は圧縮しない
 242                         content = src
 243                         Exit Select
 244                     End If
 245                     If Not (New HttpVarious).PostData("http://ux.nu/api/short?url=" + SrcUrl + "&format=plain", Nothing, content) Then
 246                         Return "Can't convert"
 247                     End If
 248                 End If
 249                 If Not content.StartsWith("http://ux.nu/") Then
 250                     Return "Can't convert"
 251                 End If
 252         End Select
 253         '変換結果から改行を除去
 254         Dim ch As Char() = {ControlChars.Cr, ControlChars.Lf}
 255         content = content.TrimEnd(ch)
 256         If src.Length < content.Length Then content = src ' 圧縮の結果逆に長くなった場合は圧縮前のURLを返す
 257         Return content
 258     End Function
 259 End Class