--- /dev/null
+Imports System.Text.RegularExpressions
+Imports System.Web
+
+Public Class ShortUrl
+ Private Shared _ShortUrlService() As String = { _
+ "http://tinyurl.com/", _
+ "http://is.gd/", _
+ "http://snipurl.com/", _
+ "http://snurl.com/", _
+ "http://nsfw.in/", _
+ "http://qurlyq.com/", _
+ "http://dwarfurl.com/", _
+ "http://icanhaz.com/", _
+ "http://tiny.cc/", _
+ "http://urlenco.de/", _
+ "http://bit.ly/", _
+ "http://piurl.com/", _
+ "http://linkbee.com/", _
+ "http://traceurl.com/", _
+ "http://twurl.nl/", _
+ "http://cli.gs/", _
+ "http://rubyurl.com/", _
+ "http://budurl.com/", _
+ "http://ff.im/", _
+ "http://twitthis.com/", _
+ "http://blip.fm/", _
+ "http://tumblr.com/", _
+ "http://www.qurl.com/", _
+ "http://digg.com/", _
+ "http://u.nu/", _
+ "http://ustre.am/", _
+ "http://pic.gd/", _
+ "http://airme.us/", _
+ "http://qurl.com/", _
+ "http://bctiny.com/", _
+ "http://j.mp/", _
+ "http://goo.gl/", _
+ "http://ow.ly/", _
+ "http://bkite.com/", _
+ "http://youtu.be/", _
+ "http://dlvr.it/", _
+ "http://p.tl/", _
+ "http://ht.ly/", _
+ "http://tl.gd/", _
+ "http://htn.to/", _
+ "http://amzn.to/", _
+ "http://flic.kr/", _
+ "http://moi.st/" _
+ }
+
+ Private Shared _bitlyId As String = ""
+ Private Shared _bitlyKey As String = ""
+ Private Shared _isresolve As Boolean = True
+
+ Public Shared WriteOnly Property BitlyId() As String
+ Set(ByVal value As String)
+ _bitlyId = value
+ End Set
+ End Property
+
+ Public Shared WriteOnly Property BitlyKey() As String
+ Set(ByVal value As String)
+ _bitlyKey = value
+ End Set
+ End Property
+
+ Public Shared Property IsResolve As Boolean
+ Get
+ Return _isresolve
+ End Get
+ Set(ByVal value As Boolean)
+ _isresolve = value
+ End Set
+ End Property
+
+ Public Shared Function Resolve(ByVal orgData As String) As String
+ If _isresolve Then
+ Static urlCache As New Dictionary(Of String, String)
+ If urlCache.Count > 500 Then urlCache.Clear() '定期的にリセット
+
+ Dim m As MatchCollection = Regex.Matches(orgData, "<a href=""(?<svc>http://.+?/)(?<path>[^""]+)""", RegexOptions.IgnoreCase)
+ Dim urlList As New List(Of String)
+ For Each orgUrlMatch As Match In m
+ Dim orgUrl As String = orgUrlMatch.Result("${svc}")
+ Dim orgUrlPath As String = orgUrlMatch.Result("${path}")
+ If Array.IndexOf(_ShortUrlService, orgUrl) > -1 AndAlso _
+ Not urlList.Contains(orgUrl + orgUrlPath) Then
+ urlList.Add(orgUrl + orgUrlPath)
+ End If
+ Next
+ For Each orgUrl As String In urlList
+ If urlCache.ContainsKey(orgUrl) Then
+ Try
+ orgData = orgData.Replace("<a href=""" + orgUrl + """", "<a href=""" + urlCache(orgUrl) + """")
+ Catch ex As Exception
+ 'Through
+ End Try
+ Else
+ Try
+ 'urlとして生成できない場合があるらしい
+ 'Dim urlstr As String = New Uri(urlEncodeMultibyteChar(orgUrl)).GetLeftPart(UriPartial.Path)
+ Dim retUrlStr As String = ""
+ Dim tmpurlStr As String = New Uri(urlEncodeMultibyteChar(orgUrl)).GetLeftPart(UriPartial.Path)
+ Dim httpVar As New HttpVarious
+ retUrlStr = urlEncodeMultibyteChar(httpVar.GetRedirectTo(tmpurlStr))
+ If retUrlStr.StartsWith("http") Then
+ retUrlStr = retUrlStr.Replace("""", "%22") 'ダブルコーテーションがあるとURL終端と判断されるため、これだけ再エンコード
+ orgData = orgData.Replace("<a href=""" + orgUrl + """", "<a href=""" + retUrlStr + """")
+ urlCache.Add(orgUrl, retUrlStr)
+ End If
+ Catch ex As Exception
+ 'Through
+ End Try
+ End If
+ Next
+ End If
+ Return orgData
+ End Function
+
+ Public Shared Function Make(ByVal ConverterType As UrlConverter, ByVal SrcUrl As String) As String
+ Dim src As String = urlEncodeMultibyteChar(SrcUrl)
+ Dim param As New Dictionary(Of String, String)
+ Dim content As String = ""
+
+ For Each svc As String In _ShortUrlService
+ If SrcUrl.StartsWith(svc) Then
+ Return "Can't convert"
+ End If
+ Next
+
+ 'nico.msは短縮しない
+ If SrcUrl.StartsWith("http://nico.ms/") Then Return "Can't convert"
+
+ SrcUrl = HttpUtility.UrlEncode(SrcUrl)
+
+ Select Case ConverterType
+ Case UrlConverter.TinyUrl 'tinyurl
+ If SrcUrl.StartsWith("http") Then
+ If "http://tinyurl.com/xxxxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
+ ' 明らかに長くなると推測できる場合は圧縮しない
+ content = src
+ Exit Select
+ End If
+ If Not (New HttpVarious).PostData("http://tinyurl.com/api-create.php?url=" + SrcUrl, Nothing, content) Then
+ Return "Can't convert"
+ End If
+ End If
+ If Not content.StartsWith("http://tinyurl.com/") Then
+ Return "Can't convert"
+ End If
+ Case UrlConverter.Isgd
+ If SrcUrl.StartsWith("http") Then
+ If "http://is.gd/xxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
+ ' 明らかに長くなると推測できる場合は圧縮しない
+ content = src
+ Exit Select
+ End If
+ If Not (New HttpVarious).PostData("http://is.gd/api.php?longurl=" + SrcUrl, Nothing, content) Then
+ Return "Can't convert"
+ End If
+ End If
+ If Not content.StartsWith("http://is.gd/") Then
+ Return "Can't convert"
+ End If
+ Case UrlConverter.Twurl
+ If SrcUrl.StartsWith("http") Then
+ If "http://twurl.nl/xxxxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
+ ' 明らかに長くなると推測できる場合は圧縮しない
+ content = src
+ Exit Select
+ End If
+ param.Add("link[url]", SrcUrl)
+ If Not (New HttpVarious).PostData("http://tweetburner.com/links", param, content) Then
+ Return "Can't convert"
+ End If
+ End If
+ If Not content.StartsWith("http://twurl.nl/") Then
+ Return "Can't convert"
+ End If
+ Case UrlConverter.Unu
+ If SrcUrl.StartsWith("http") Then
+ If "http://u.nu/xxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
+ ' 明らかに長くなると推測できる場合は圧縮しない
+ content = src
+ Exit Select
+ End If
+ If Not (New HttpVarious).PostData("http://u.nu/unu-api-simple?url=" + SrcUrl, Nothing, content) Then
+ Return "Can't convert"
+ End If
+ End If
+ If Not content.StartsWith("http://u.nu") Then
+ Return "Can't convert"
+ End If
+ Case UrlConverter.Bitly, UrlConverter.Jmp
+ Dim BitlyLogin As String = "tweenapi"
+ Dim BitlyApiKey As String = "R_c5ee0e30bdfff88723c4457cc331886b"
+ If _bitlyId <> "" AndAlso BitlyApiKey <> "" Then
+ BitlyLogin = _bitlyId
+ BitlyApiKey = _bitlyKey
+ End If
+ Const BitlyApiVersion As String = "2.0.1"
+ If SrcUrl.StartsWith("http") Then
+ If "http://bit.ly/xxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
+ ' 明らかに長くなると推測できる場合は圧縮しない
+ content = src
+ Exit Select
+ End If
+ Dim req As String = ""
+ If ConverterType = UrlConverter.Bitly Then
+ req = "http://api.bit.ly/shorten?version="
+ Else
+ req = "http://api.j.mp/shorten?version="
+ End If
+ req += BitlyApiVersion + _
+ "&login=" + BitlyLogin + _
+ "&apiKey=" + BitlyApiKey + _
+ "&longUrl=" + SrcUrl
+ If BitlyLogin <> "tweenapi" Then req += "&history=1"
+ If Not (New HttpVarious).PostData(req, Nothing, content) Then
+ Return "Can't convert"
+ Else
+ 'Dim rx As Regex = New Regex("""shortUrl"": ""(?<ShortUrl>.*?)""")
+ If Regex.Match(content, """shortUrl"": ""(?<ShortUrl>.*?)""").Success Then
+ content = Regex.Match(content, """shortUrl"": ""(?<ShortUrl>.*?)""").Groups("ShortUrl").Value
+ End If
+ End If
+ End If
+ End Select
+ '変換結果から改行を除去
+ Dim ch As Char() = {ControlChars.Cr, ControlChars.Lf}
+ content = content.TrimEnd(ch)
+ If src.Length < content.Length Then content = src ' 圧縮の結果逆に長くなった場合は圧縮前のURLを返す
+ Return content
+ End Function
+End Class
Dim webtext As String
Dim jumpto As String
webtext = MyOwner.TwitterInstance.PreProcessUrl("<a href=""" + data + """>Dummy</a>")
- webtext = MyOwner.TwitterInstance.ShortUrlResolve(webtext)
+ webtext = ShortUrl.Resolve(webtext)
jumpto = Regex.Match(webtext, "<a href=""(?<url>.*?)""").Groups.Item("url").Value
ToolTip1.SetToolTip(LinkLabelWeb, jumpto)
LinkLabelWeb.Tag = jumpto
tw.RestrictFavCheck = SettingDialog.RestrictFavCheck
tw.ReadOwnPost = SettingDialog.ReadOwnPost
tw.UseSsl = SettingDialog.UseSsl
- tw.BitlyId = SettingDialog.BitlyUser
- tw.BitlyKey = SettingDialog.BitlyPwd
+ ShortUrl.BitlyId = SettingDialog.BitlyUser
+ ShortUrl.BitlyKey = SettingDialog.BitlyPwd
HttpTwitter.TwitterUrl = _cfgCommon.TwitterUrl
HttpTwitter.TwitterSearchUrl = _cfgCommon.TwitterSearchUrl
tw.RestrictFavCheck = SettingDialog.RestrictFavCheck
tw.ReadOwnPost = SettingDialog.ReadOwnPost
tw.UseSsl = SettingDialog.UseSsl
- tw.BitlyId = SettingDialog.BitlyUser
- tw.BitlyKey = SettingDialog.BitlyPwd
+ ShortUrl.BitlyId = SettingDialog.BitlyUser
+ ShortUrl.BitlyKey = SettingDialog.BitlyPwd
HttpTwitter.TwitterUrl = _cfgCommon.TwitterUrl
HttpTwitter.TwitterSearchUrl = _cfgCommon.TwitterSearchUrl
End SyncLock
End Sub
- 'Private Sub SaveConfigsTab(ByVal DeleteBefore As Boolean)
- ' If _ignoreConfigSave Then Exit Sub
- ' Dim cnt As Integer = 0
- ' If ListTab IsNot Nothing AndAlso _
- ' ListTab.TabPages IsNot Nothing AndAlso _
- ' ListTab.TabPages.Count > 0 Then
- ' If DeleteBefore Then SettingTab.DeleteConfigFile() '旧設定ファイル削除
- ' For cnt = 0 To ListTab.TabPages.Count - 1
- ' SaveConfigsTab(ListTab.TabPages(cnt).Text)
- ' Next
- ' End If
- 'End Sub
-
- 'Private Sub SaveConfigsTab(ByVal tabName As String)
- ' If _ignoreConfigSave Then Exit Sub
- ' SyncLock _syncObject
- ' Dim tabSetting As New SettingTab
- ' tabSetting.Tab = _statuses.Tabs(tabName)
- ' tabSetting.Save()
- ' End SyncLock
- 'End Sub
-
Private Sub SaveConfigsTabs()
Dim tabSetting As New SettingTabs
For i As Integer = 0 To ListTab.TabPages.Count - 1
result = nicoms.Shorten(tmp)
ElseIf Converter_Type <> UrlConverter.Nicoms Then
'短縮URL変換 日本語を含むかもしれないのでURLエンコードする
- result = tw.MakeShortUrl(Converter_Type, tmp)
+ result = ShortUrl.Make(Converter_Type, tmp)
If result.Equals("Can't convert") Then
StatusLabel.Text = result.Insert(0, Converter_Type.ToString() + ":")
Return False
result = nicoms.Shorten(tmp)
ElseIf Converter_Type <> UrlConverter.Nicoms Then
'短縮URL変換 日本語を含むかもしれないのでURLエンコードする
- result = tw.MakeShortUrl(Converter_Type, tmp)
+ result = ShortUrl.Make(Converter_Type, tmp)
If result.Equals("Can't convert") Then
StatusLabel.Text = result.Insert(0, Converter_Type.ToString() + ":")
Continue For
<Compile Include="Setting\SettingFollower.vb" />
<Compile Include="Setting\SettingTabs.vb" />
<Compile Include="ShieldIcon.vb" />
+ <Compile Include="ShortUrl.vb" />
<Compile Include="ShowUserInfo.Designer.vb">
<DependentUpon>ShowUserInfo.vb</DependentUpon>
</Compile>
Private _bio As String = ""
Private _userinfoxml As String = ""
Private _protocol As String = "https://"
- Private _bitlyId As String = ""
- Private _bitlyKey As String = ""
'プロパティからアクセスされる共通情報
Private _uid As String
'共通で使用する状態
Private _remainCountApi As Integer = -1
- Private _ShortUrlService() As String = { _
- "http://tinyurl.com/", _
- "http://is.gd/", _
- "http://snipurl.com/", _
- "http://snurl.com/", _
- "http://nsfw.in/", _
- "http://qurlyq.com/", _
- "http://dwarfurl.com/", _
- "http://icanhaz.com/", _
- "http://tiny.cc/", _
- "http://urlenco.de/", _
- "http://bit.ly/", _
- "http://piurl.com/", _
- "http://linkbee.com/", _
- "http://traceurl.com/", _
- "http://twurl.nl/", _
- "http://cli.gs/", _
- "http://rubyurl.com/", _
- "http://budurl.com/", _
- "http://ff.im/", _
- "http://twitthis.com/", _
- "http://blip.fm/", _
- "http://tumblr.com/", _
- "http://www.qurl.com/", _
- "http://digg.com/", _
- "http://u.nu/", _
- "http://ustre.am/", _
- "http://pic.gd/", _
- "http://airme.us/", _
- "http://qurl.com/", _
- "http://bctiny.com/", _
- "http://j.mp/", _
- "http://goo.gl/", _
- "http://ow.ly/", _
- "http://bkite.com/", _
- "http://youtu.be/", _
- "http://dlvr.it/", _
- "http://p.tl/", _
- "http://ht.ly/", _
- "http://tl.gd/", _
- "http://htn.to/", _
- "http://amzn.to/", _
- "http://flic.kr/", _
- "http://moi.st/" _
- }
-
-
Private op As New Outputz
'max_idで古い発言を取得するために保持（lists分は個別タブで管理）
Private minHomeTimeline As Long = Long.MaxValue
Return orgData
End Function
- Public Function ShortUrlResolve(ByVal orgData As String) As String
- If _tinyUrlResolve Then
- Static urlCache As New Dictionary(Of String, String)
- If urlCache.Count > 500 Then urlCache.Clear() '定期的にリセット
-
- Dim m As MatchCollection = Regex.Matches(orgData, "<a href=""(?<svc>http://.+?/)(?<path>[^""]+)""", RegexOptions.IgnoreCase)
- Dim urlList As New List(Of String)
- For Each orgUrlMatch As Match In m
- Dim orgUrl As String = orgUrlMatch.Result("${svc}")
- Dim orgUrlPath As String = orgUrlMatch.Result("${path}")
- If Array.IndexOf(_ShortUrlService, orgUrl) > -1 AndAlso _
- Not urlList.Contains(orgUrl + orgUrlPath) Then
- urlList.Add(orgUrl + orgUrlPath)
- End If
- Next
- For Each orgUrl As String In urlList
- If urlCache.ContainsKey(orgUrl) Then
- Try
- orgData = orgData.Replace("<a href=""" + orgUrl + """", "<a href=""" + urlCache(orgUrl) + """")
- Catch ex As Exception
- 'Through
- End Try
- Else
- Try
- 'urlとして生成できない場合があるらしい
- 'Dim urlstr As String = New Uri(urlEncodeMultibyteChar(orgUrl)).GetLeftPart(UriPartial.Path)
- Dim retUrlStr As String = ""
- Dim tmpurlStr As String = New Uri(urlEncodeMultibyteChar(orgUrl)).GetLeftPart(UriPartial.Path)
- Dim httpVar As New HttpVarious
- retUrlStr = urlEncodeMultibyteChar(httpVar.GetRedirectTo(tmpurlStr))
- If retUrlStr.StartsWith("http") Then
- retUrlStr = retUrlStr.Replace("""", "%22") 'ダブルコーテーションがあるとURL終端と判断されるため、これだけ再エンコード
- orgData = orgData.Replace("<a href=""" + orgUrl + """", "<a href=""" + retUrlStr + """")
- urlCache.Add(orgUrl, retUrlStr)
- End If
- Catch ex As Exception
- 'Through
- End Try
- End If
- Next
- End If
- Return orgData
- End Function
-
Private Function GetPlainText(ByVal orgData As String) As String
Return HttpUtility.HtmlDecode(Regex.Replace(orgData, "(?<tagStart><a [^>]+>)(?<text>[^<]+)(?<tagEnd></a>)", "${text}"))
End Function
End Set
End Property
- Public Function MakeShortUrl(ByVal ConverterType As UrlConverter, ByVal SrcUrl As String) As String
- Dim src As String = urlEncodeMultibyteChar(SrcUrl)
- Dim param As New Dictionary(Of String, String)
- Dim content As String = ""
-
- For Each svc As String In _ShortUrlService
- If SrcUrl.StartsWith(svc) Then
- Return "Can't convert"
- End If
- Next
-
- 'nico.msは短縮しない
- If SrcUrl.StartsWith("http://nico.ms/") Then Return "Can't convert"
-
- SrcUrl = HttpUtility.UrlEncode(SrcUrl)
-
- Select Case ConverterType
- Case UrlConverter.TinyUrl 'tinyurl
- If SrcUrl.StartsWith("http") Then
- If "http://tinyurl.com/xxxxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
- ' 明らかに長くなると推測できる場合は圧縮しない
- content = src
- Exit Select
- End If
- If Not (New HttpVarious).PostData("http://tinyurl.com/api-create.php?url=" + SrcUrl, Nothing, content) Then
- Return "Can't convert"
- End If
- End If
- If Not content.StartsWith("http://tinyurl.com/") Then
- Return "Can't convert"
- End If
- Case UrlConverter.Isgd
- If SrcUrl.StartsWith("http") Then
- If "http://is.gd/xxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
- ' 明らかに長くなると推測できる場合は圧縮しない
- content = src
- Exit Select
- End If
- If Not (New HttpVarious).PostData("http://is.gd/api.php?longurl=" + SrcUrl, Nothing, content) Then
- Return "Can't convert"
- End If
- End If
- If Not content.StartsWith("http://is.gd/") Then
- Return "Can't convert"
- End If
- Case UrlConverter.Twurl
- If SrcUrl.StartsWith("http") Then
- If "http://twurl.nl/xxxxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
- ' 明らかに長くなると推測できる場合は圧縮しない
- content = src
- Exit Select
- End If
- param.Add("link[url]", SrcUrl)
- If Not (New HttpVarious).PostData("http://tweetburner.com/links", param, content) Then
- Return "Can't convert"
- End If
- End If
- If Not content.StartsWith("http://twurl.nl/") Then
- Return "Can't convert"
- End If
- Case UrlConverter.Unu
- If SrcUrl.StartsWith("http") Then
- If "http://u.nu/xxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
- ' 明らかに長くなると推測できる場合は圧縮しない
- content = src
- Exit Select
- End If
- If Not (New HttpVarious).PostData("http://u.nu/unu-api-simple?url=" + SrcUrl, Nothing, content) Then
- Return "Can't convert"
- End If
- End If
- If Not content.StartsWith("http://u.nu") Then
- Return "Can't convert"
- End If
- Case UrlConverter.Bitly, UrlConverter.Jmp
- Dim BitlyLogin As String = "tweenapi"
- Dim BitlyApiKey As String = "R_c5ee0e30bdfff88723c4457cc331886b"
- If _bitlyId <> "" AndAlso BitlyApiKey <> "" Then
- BitlyLogin = _bitlyId
- BitlyApiKey = _bitlyKey
- End If
- Const BitlyApiVersion As String = "2.0.1"
- If SrcUrl.StartsWith("http") Then
- If "http://bit.ly/xxxx".Length > src.Length AndAlso Not src.Contains("?") AndAlso Not src.Contains("#") Then
- ' 明らかに長くなると推測できる場合は圧縮しない
- content = src
- Exit Select
- End If
- Dim req As String = ""
- If ConverterType = UrlConverter.Bitly Then
- req = "http://api.bit.ly/shorten?version="
- Else
- req = "http://api.j.mp/shorten?version="
- End If
- req += BitlyApiVersion + _
- "&login=" + BitlyLogin + _
- "&apiKey=" + BitlyApiKey + _
- "&longUrl=" + SrcUrl
- If BitlyLogin <> "tweenapi" Then req += "&history=1"
- If Not (New HttpVarious).PostData(req, Nothing, content) Then
- Return "Can't convert"
- Else
- 'Dim rx As Regex = New Regex("""shortUrl"": ""(?<ShortUrl>.*?)""")
- If Regex.Match(content, """shortUrl"": ""(?<ShortUrl>.*?)""").Success Then
- content = Regex.Match(content, """shortUrl"": ""(?<ShortUrl>.*?)""").Groups("ShortUrl").Value
- End If
- End If
- End If
- 'If Not content.StartsWith("http://bit.ly") AndAlso Not content.StartsWith("http://j.mp") Then
- ' Return "Can't convert"
- 'End If
- End Select
- '変換結果から改行を除去
- Dim ch As Char() = {ControlChars.Cr, ControlChars.Lf}
- content = content.TrimEnd(ch)
- If src.Length < content.Length Then content = src ' 圧縮の結果逆に長くなった場合は圧縮前のURLを返す
- Return content
- End Function
-
#Region "バージョンアップ"
Public Function GetVersionInfo() As String
Dim content As String = ""
End Set
End Property
- Public WriteOnly Property BitlyId() As String
- Set(ByVal value As String)
- _bitlyId = value
- End Set
- End Property
-
- Public WriteOnly Property BitlyKey() As String
- Set(ByVal value As String)
- _bitlyKey = value
- End Set
- End Property
-
Public Function GetTimelineApi(ByVal read As Boolean, _
ByVal gType As WORKERTYPE, _
ByVal more As Boolean) As String
retStr = retStr.Replace("<<<<<tweenだいなり>>>>>", ">").Replace("<<<<<tweenしょうなり>>>>>", "<")
- retStr = AdjustHtml(ShortUrlResolve(PreProcessUrl(retStr))) 'IDN置換、短縮Uri解決、@リンクを相対→絶対にしてtarget属性付与
+ retStr = AdjustHtml(ShortUrl.Resolve(PreProcessUrl(retStr))) 'IDN置換、短縮Uri解決、@リンクを相対→絶対にしてtarget属性付与
Return retStr
End Function
OSDN Git Service
