From ca80bae80596bf82afb8fc7ce3b7193cc9d30a4c Mon Sep 17 00:00:00 2001 From: syo68k Date: Thu, 2 Sep 2010 14:39:11 +0000 Subject: [PATCH] =?utf8?q?=E3=83=BB=E3=82=B5=E3=83=A0=E3=83=8D=E3=82=A4?= =?utf8?q?=E3=83=AB=E5=91=A8=E3=82=8A=E3=82=92=E5=88=A5=E3=82=AF=E3=83=A9?= =?utf8?q?=E3=82=B9=E3=81=B8=E5=88=86=E9=9B=A2=20=E3=83=BB=E3=83=8B?= =?utf8?q?=E3=82=B3=E3=83=8B=E3=82=B3=E5=8B=95=E7=94=BBAPI=E3=81=AB?= =?utf8?q?=E3=82=A2=E3=82=AF=E3=82=BB=E3=82=B9=E3=81=99=E3=82=8B=E9=9A=9B?= =?utf8?q?=E3=81=AEUser-Agent=E4=BF=AE=E6=AD=A3(see=20also=20http://www.st?= =?utf8?q?udyinghttp.net/header#Product=5FTokens=5FFormat)?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit git-svn-id: http://svn.sourceforge.jp/svnroot/tween/trunk@800 e39ad16e-3079-482e-bb30-4b4d378143b6 --- Tween/Thumbnail.vb | 763 +++++++++++++++++++++++++++++++++++++++++++++++++++ Tween/Tween.vb | 786 ++--------------------------------------------------- Tween/Tween.vbproj | 1 + 3 files changed, 794 insertions(+), 756 deletions(-) create mode 100644 Tween/Thumbnail.vb diff --git a/Tween/Thumbnail.vb b/Tween/Thumbnail.vb new file mode 100644 index 00000000..f9cea459 --- /dev/null +++ b/Tween/Thumbnail.vb @@ -0,0 +1,763 @@ +Imports System.Text.RegularExpressions +Imports System.ComponentModel +Imports System.Text +Imports System.Xml + +Public Class Thumbnail + + Private lckPrev As New Object + Private _prev As PreviewData + Private Class PreviewData + Implements IDisposable + + Public statusId As Long + Public urls As List(Of KeyValuePair(Of String, String)) + Public pics As New List(Of KeyValuePair(Of String, Image)) + Public tooltiptext As New List(Of KeyValuePair(Of String, String)) + Public Sub New(ByVal id As Long, ByVal urlList As List(Of KeyValuePair(Of String, String))) + statusId = id + urls = urlList + End Sub + + Public IsError As Boolean + Public AdditionalErrorMessage As String + + Private disposedValue As Boolean = False ' 重複する呼び出しを検出するには + + ' IDisposable + Protected Overridable Sub Dispose(ByVal disposing As Boolean) + If Not Me.disposedValue Then + If disposing Then + ' TODO: 明示的に呼び出されたときにマネージ リソースを解放します + End If + + ' TODO: 共有のアンマネージ リソースを解放します + For Each pic As KeyValuePair(Of String, Image) In pics + If pic.Value IsNot Nothing Then pic.Value.Dispose() + Next + End If + Me.disposedValue = True + End Sub + +#Region " IDisposable Support " + ' このコードは、破棄可能なパターンを正しく実装できるように Visual Basic によって追加されました。 + Public Sub Dispose() Implements IDisposable.Dispose + ' このコードを変更しないでください。クリーンアップ コードを上の Dispose(ByVal disposing As Boolean) に記述します。 + Dispose(True) + GC.SuppressFinalize(Me) + End Sub +#End Region + + End Class + Private Owner As TweenMain + + Public Sub New(ByVal Owner As TweenMain) + Me.Owner = Owner + + AddHandler Owner.PreviewScrollBar.Scroll, AddressOf PreviewScrollBar_Scroll + AddHandler Owner.PreviewPicture.MouseLeave, AddressOf PreviewPicture_MouseLeave + AddHandler Owner.PreviewPicture.DoubleClick, AddressOf PreviewPicture_DoubleClick + End Sub + + Private ReadOnly Property _curPost As PostClass + Get + Return Owner.CurPost() + End Get + End Property + + Private Function IsDirectLink(ByVal url As String) As Boolean + Return Regex.Match(url, "^http://.*(\.jpg|\.jpeg|\.gif|\.png|\.bmp)$", RegexOptions.IgnoreCase).Success + End Function + + Public Sub thumbnail(ByVal id As Long, ByVal links As List(Of String)) + If Not Owner.IsPreviewEnable Then + Owner.SplitContainer3.Panel2Collapsed = True + Exit Sub + End If + If Not Owner.PreviewPicture.Image Is Nothing Then + Owner.PreviewPicture.Image.Dispose() + Owner.PreviewPicture.Image = Nothing + Owner.SplitContainer3.Panel2Collapsed = True + End If + 'SyncLock lckPrev + ' If _prev IsNot Nothing Then + ' _prev.Dispose() + ' _prev = Nothing + ' End If + 'End SyncLock + + If links.Count = 0 Then + Owner.PreviewScrollBar.Maximum = 0 + Owner.PreviewScrollBar.Enabled = False + Owner.SplitContainer3.Panel2Collapsed = True + Exit Sub + End If + + Dim imglist As New List(Of KeyValuePair(Of String, String)) + + For Each url As String In links + 'Dim re As Regex + Dim mc As Match + 'imgur + mc = Regex.Match(url, "^http://imgur\.com/(\w+)\.jpg$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://i.imgur.com/${1}l.jpg"))) + Continue For + End If + '画像拡張子で終わるURL（直リンク） + If IsDirectLink(url) Then + imglist.Add(New KeyValuePair(Of String, String)(url, url)) + Continue For + End If + 'twitpic + mc = Regex.Match(url, "^http://(www\.)?twitpic\.com/(?\w+)(/full/?)?$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://twitpic.com/show/thumb/${photoId}"))) + Continue For + End If + 'yfrog + mc = Regex.Match(url, "^http://yfrog\.com/(\w+)$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, url + ".th.jpg")) + Continue For + End If + 'tweetphoto + Const comp As String = "http://TweetPhotoAPI.com/api/TPAPI.svc/imagefromurl?size=thumbnail&url=" + If Regex.IsMatch(url, "^(http://tweetphoto\.com/[0-9]+|http://pic\.gd/[a-z0-9]+)$", RegexOptions.IgnoreCase) Then + imglist.Add(New KeyValuePair(Of String, String)(url, comp + url)) + Continue For + End If + 'Mobypicture + mc = Regex.Match(url, "^http://moby\.to/(\w+)$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://mobypicture.com/?${1}:small"))) + Continue For + End If + '携帯百景 + mc = Regex.Match(url, "^http://movapic\.com/pic/(\w+)$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://image.movapic.com/pic/s_${1}.jpeg"))) + Continue For + End If + 'はてなフォトライフ + mc = Regex.Match(url, "^http://f\.hatena\.ne\.jp/(([a-z])[a-z0-9_-]{1,30}[a-z0-9])/((\d{8})\d+)$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://img.f.hatena.ne.jp/images/fotolife/${2}/${1}/${4}/${3}_120.jpg"))) + Continue For + End If + 'PhotoShare + mc = Regex.Match(url, "^http://(?:www\.)?bcphotoshare\.com/photos/\d+/(\d+)$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://images.bcphotoshare.com/storages/${1}/thumb180.jpg"))) + Continue For + End If + 'PhotoShare の短縮 URL + mc = Regex.Match(url, "^http://bctiny\.com/p(\w+)$", RegexOptions.IgnoreCase) + If mc.Success Then + Try + imglist.Add(New KeyValuePair(Of String, String)(url, "http://images.bcphotoshare.com/storages/" + RadixConvert.ToInt32(mc.Result("${1}"), 32).ToString + "/thumb180.jpg")) + Continue For + Catch ex As ArgumentOutOfRangeException + End Try + End If + 'img.ly + mc = Regex.Match(url, "^http://img\.ly/(\w+)$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://img.ly/show/thumb/${1}"))) + Continue For + End If + 'brightkite + mc = Regex.Match(url, "^http://brightkite\.com/objects/((\w{2})(\w{2})\w+)$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://cdn.brightkite.com/${2}/${3}/${1}-feed.jpg"))) + Continue For + End If + 'Twitgoo + mc = Regex.Match(url, "^http://twitgoo\.com/(\w+)$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://twitgoo.com/${1}/mini"))) + Continue For + End If + 'pic.im + mc = Regex.Match(url, "^http://pic\.im/(\w+)$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://pic.im/website/thumbnail/${1}"))) + Continue For + End If + 'youtube + mc = Regex.Match(url, "^http://www\.youtube\.com/watch\?v=([\w\-]+)", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://i.ytimg.com/vi/${1}/default.jpg"))) + Continue For + End If + mc = Regex.Match(url, "^http://youtu\.be/([\w\-]+)", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://i.ytimg.com/vi/${1}/default.jpg"))) + Continue For + End If + 'ニコニコ + mc = Regex.Match(url, "^http://(?:(www|ext)\.nicovideo\.jp/watch|nico\.ms)/(?:sm|nm)?([0-9]+)(\?.+)?$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) + Continue For + End If + 'pixiv + '参考: http://tail.s68.xrea.com/blog/2009/02/pixivflash.html Pixivの画像をFlashとかで取得する方法など:しっぽのブログ + 'ユーザー向けの画像ページ http://www.pixiv.net/member_illust.php?mode=medium&illust_id=[ID番号] + '非ログインユーザー向けの画像ページ http://www.pixiv.net/index.php?mode=medium&illust_id=[ID番号] + 'サムネイルURL http://img[サーバー番号].pixiv.net/img/[ユーザー名]/[サムネイルID]_s.[拡張子] + 'サムネイルURLは画像ページから抽出する + mc = Regex.Match(url, "^http://www\.pixiv\.net/(member_illust|index)\.php\?mode=(medium|big)&(amp;)?illust_id=(?[0-9]+)(&(amp;)?tag=(?.+)?)*$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url.Replace("amp;", ""), mc.Value)) + Continue For + End If + 'flickr + '参考: http://tanarky.blogspot.com/2010/03/flickr-urlunavailable.html アグレッシブエンジニア: flickr の画像URL仕様についてまとめ(Unavailable画像) + '画像URL仕様　http://farm{farm}.static.flickr.com/{server}/{id}_{secret}_{size}.{extension} + 'photostreamなど複数の画像がある場合先頭の一つのみ認識と言うことにする + '(二つ目のキャプチャ 一つ目の画像はユーザーアイコン） + mc = Regex.Match(url, "^http://www.flickr.com/", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) + Continue For + End If + 'TwitVideo + mc = Regex.Match(url, "^http://twitvideo\.jp/(\w+)$", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://twitvideo.jp/img/thumb/${1}"))) + Continue For + End If + 'piapro + mc = Regex.Match(url, "^http://piapro\.jp/content/(?[0-9a-z]+)", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) + Continue For + End If + 'フォト蔵 + mc = Regex.Match(url, "^http://photozou\.jp/photo/show/(?[0-9]+)/(?[0-9]+)", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) + Continue For + End If + 'tumblr + mc = Regex.Match(url, "^http://.+\.tumblr\.com/.+/?", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) + Continue For + End If + 'ついっぷるフォト + mc = Regex.Match(url, "^http://p\.twipple\.jp/(?[0-9a-z]+)", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) + Continue For + End If + 'mypix/shamoji + mc = Regex.Match(url, "^http://(www\.mypix\.jp|www\.shamoji\.info)/app\.php/picture/(?[0-9a-z]+)", RegexOptions.IgnoreCase) + If mc.Success Then + imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value + "/thumb.jpg")) + Continue For + End If + Next + + If imglist.Count = 0 Then + Owner.PreviewScrollBar.Maximum = 0 + Owner.PreviewScrollBar.Enabled = False + Owner.SplitContainer3.Panel2Collapsed = True + Exit Sub + End If + + ThumbnailProgressChanged(0) + Dim bgw As BackgroundWorker + bgw = New BackgroundWorker() + AddHandler bgw.DoWork, AddressOf bgw_DoWork + AddHandler bgw.RunWorkerCompleted, AddressOf bgw_Completed + bgw.RunWorkerAsync(New PreviewData(id, imglist)) + + End Sub + + Private Sub ThumbnailProgressChanged(ByVal ProgressPercentage As Integer, Optional ByVal AddMsg As String = "") + If ProgressPercentage = 0 Then '開始 + Owner.SetStatusLabel("Thumbnail generating...") + ElseIf ProgressPercentage = 100 Then '正常終了 + Owner.SetStatusLabel("Thumbnail generated.") + Else ' エラー + If String.IsNullOrEmpty(AddMsg) Then + Owner.SetStatusLabel("can't get Thumbnail.") + Else + Owner.SetStatusLabel("can't get Thumbnail." + AddMsg) + End If + End If + End Sub + + Private Sub bgw_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) + Dim arg As PreviewData = DirectCast(e.Argument, PreviewData) + Dim worker As BackgroundWorker = DirectCast(sender, BackgroundWorker) + Dim addMsg As String = "" + arg.AdditionalErrorMessage = "" + + ' pixiv,Flickr,piapro,フォト蔵,tumblrの解析もこちらでやる + For Each url As KeyValuePair(Of String, String) In arg.urls + Dim http As New HttpVarious + + If IsDirectLink(url.Key) Then + ' 画像直リンク + Dim img As Image = http.GetImage(url.Value, url.Key) + If img Is Nothing Then Continue For + arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, img)) + arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) + ElseIf url.Key.StartsWith("http://www.pixiv.net/") Then + Dim src As String = "" + 'illustIDをキャプチャ + Dim mc As Match = Regex.Match(url.Key, "^http://www\.pixiv\.net/(member_illust|index)\.php\?mode=(medium|big)&(amp;)?illust_id=(?[0-9]+)(&(amp;)?tag=(?.+)?)*$", RegexOptions.IgnoreCase) + If mc.Groups("tag").Value = "R-18" OrElse mc.Groups("tag").Value = "R-18G" Then + arg.IsError = True + arg.AdditionalErrorMessage = "(NeedLogin.NotSupported)" + Else + If (New HttpVarious).GetData(Regex.Replace(mc.Groups(0).Value, "amp;", ""), Nothing, src, 5000) Then + Dim _mc As Match = Regex.Match(src, mc.Result("http://img([0-9]+)\.pixiv\.net/img/.+/${illustId}_s\.([a-zA-Z]+)")) + If _mc.Success Then + Dim _img As Image = http.GetImage(_mc.Value, url.Key) + If _img Is Nothing Then Continue For + arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) + arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) + End If + End If + End If + ElseIf url.Key.StartsWith("http://www.flickr.com/") Then + Dim mc As Match = Regex.Match(url.Key, "^http://www.flickr.com/", RegexOptions.IgnoreCase) + If mc.Success Then + Dim src As String = "" + If (New HttpVarious).GetData(url.Key, Nothing, src, 5000) Then + Dim _mc As MatchCollection = Regex.Matches(src, mc.Result("http://farm[0-9]+\.static\.flickr\.com/[0-9]+/.+?\.([a-zA-Z]+)")) + '二つ以上キャプチャした場合先頭の一つだけ 一つだけの場合はユーザーアイコンしか取れなかった + If _mc.Count > 1 Then + Dim _img As Image = http.GetImage(_mc.Item(1).Value, url.Key) + If _img Is Nothing Then Continue For + arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) + arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) + End If + End If + Continue For + End If + ElseIf url.Key.StartsWith("http://piapro.jp/") Then + Dim mc As Match = Regex.Match(url.Key, "^http://piapro\.jp/content/(?[0-9a-z]+)", RegexOptions.IgnoreCase) + If mc.Success Then + Dim src As String = "" + If (New HttpVarious).GetData(url.Key, Nothing, src, 5000) Then + Dim _mc As Match = Regex.Match(src, mc.Result("http://c1\.piapro\.jp/timg/${contentId}_\d{14}_\d{4}_\d{4}\.(jpg|png|gif)")) + If _mc.Success Then + '各画像には120x120のサムネイルがある（多分）ので、URLを置き換える。元々ページに埋め込まれている画像は500x500 + Dim r As New System.Text.RegularExpressions.Regex("_\d{4}_\d{4}") + Dim min_img_url As String = r.Replace(_mc.Value, "_0120_0120") + Dim _img As Image = http.GetImage(min_img_url, url.Key) + If _img Is Nothing Then Continue For + arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) + arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) + End If + End If + End If + Continue For + ElseIf url.Key.StartsWith("http://photozou.jp/") Then + Dim mc As Match = Regex.Match(url.Key, "^http://photozou\.jp/photo/show/(?[0-9]+)/(?[0-9]+)", RegexOptions.IgnoreCase) + If mc.Success Then + Dim src As String = "" + Dim show_info As String = mc.Result("http://api.photozou.jp/rest/photo_info?photo_id=${photoId}") + If (New HttpVarious).GetData(show_info, Nothing, src, 5000) Then + Dim xdoc As New XmlDocument + Dim thumbnail_url As String = "" + Try + xdoc.LoadXml(src) + thumbnail_url = xdoc.SelectSingleNode("/rsp/info/photo/thumbnail_image_url").InnerText + Catch ex As Exception + thumbnail_url = "" + End Try + If String.IsNullOrEmpty(thumbnail_url) Then Continue For + Dim _img As Image = http.GetImage(thumbnail_url, url.Key) + If _img Is Nothing Then Continue For + arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) + arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) + Continue For + End If + End If + Continue For + ElseIf Regex.Match(url.Key, "^http://.+\.tumblr\.com/.+/?", RegexOptions.IgnoreCase).Success Then + Dim TargetUrl As String = (New HttpVarious).GetRedirectTo(url.Key) + Dim mc As Match = Regex.Match(TargetUrl, "(?http://.+?\.tumblr\.com/)post/(?[0-9]+)(/(?.+?)/)?", RegexOptions.IgnoreCase) + Dim apiurl As String = mc.Groups("base").Value + "api/read?id=" + mc.Groups("postID").Value + Dim src As String = "" + Dim imgurl As String = Nothing + If (New HttpVarious).GetData(apiurl, Nothing, src, 5000) Then + Dim xdoc As New XmlDocument + Try + xdoc.LoadXml(src) + + Dim type As String = xdoc.SelectSingleNode("/tumblr/posts/post").Attributes("type").Value + If type = "photo" Then + imgurl = xdoc.SelectSingleNode("/tumblr/posts/post/photo-url").InnerText + Else + arg.AdditionalErrorMessage = "(PostType:" + type + ")" + arg.IsError = True + imgurl = "" + End If + + Catch ex As Exception + imgurl = "" + End Try + + If Not String.IsNullOrEmpty(imgurl) Then + Dim _img As Image = http.GetImage(imgurl, url.Key) + If _img Is Nothing Then Continue For + arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) + arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) + End If + End If + Continue For + ElseIf Regex.Match(url.Value, "^http://(?:(www|ext)\.nicovideo\.jp/watch|nico\.ms)/(?:sm|nm)?([0-9]+)(\?.+)?$", RegexOptions.IgnoreCase).Success Then + Dim mc As Match = Regex.Match(url.Value, "^http://(?:(www|ext)\.nicovideo\.jp/watch|nico\.ms)/(?(?:sm|nm)?([0-9]+))(\?.+)?$", RegexOptions.IgnoreCase) + Dim apiurl As String = "http://www.nicovideo.jp/api/getthumbinfo/" + mc.Groups("id").Value + Dim src As String = "" + Dim imgurl As String = "" + Dim headers As New Dictionary(Of String, String) + headers.Add("User-Agent", "Tween/" + fileVersion) + If (New HttpVarious).GetData(apiurl, headers, src, 5000) Then + Dim sb As New StringBuilder + Dim xdoc As New XmlDocument + Try + xdoc.LoadXml(src) + Dim status As String = xdoc.SelectSingleNode("/nicovideo_thumb_response").Attributes("status").Value + If status = "ok" Then + imgurl = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/thumbnail_url").InnerText + + 'ツールチップに動画情報をセットする + Dim tmp As String + + Try + tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/title").InnerText + If Not String.IsNullOrEmpty(tmp) Then + sb.Append(My.Resources.NiconicoInfoText1) + sb.Append(tmp) + sb.AppendLine() + End If + Catch ex As Exception + + End Try + + Try + tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/length").InnerText + If Not String.IsNullOrEmpty(tmp) Then + sb.Append(My.Resources.NiconicoInfoText2) + sb.Append(tmp) + sb.AppendLine() + End If + Catch ex As Exception + + End Try + + Try + Dim tm As New DateTime + tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/first_retrieve").InnerText + If DateTime.TryParse(tmp, tm) Then + sb.Append(My.Resources.NiconicoInfoText3) + sb.Append(tm.ToString) + sb.AppendLine() + End If + Catch ex As Exception + + End Try + + Try + tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/view_counter").InnerText + If Not String.IsNullOrEmpty(tmp) Then + sb.Append(My.Resources.NiconicoInfoText4) + sb.Append(tmp) + sb.AppendLine() + End If + Catch ex As Exception + + End Try + + Try + tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/comment_num").InnerText + If Not String.IsNullOrEmpty(tmp) Then + sb.Append(My.Resources.NiconicoInfoText5) + sb.Append(tmp) + sb.AppendLine() + End If + Catch ex As Exception + + End Try + Try + tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/mylist_counter").InnerText + If Not String.IsNullOrEmpty(tmp) Then + sb.Append(My.Resources.NiconicoInfoText6) + sb.Append(tmp) + sb.AppendLine() + End If + Catch ex As Exception + + End Try + + ElseIf status = "fail" Then + Dim errcode As String = xdoc.SelectSingleNode("/nicovideo_thumb_response/error/code").InnerText + arg.AdditionalErrorMessage = "(" + errcode + ")" + arg.IsError = True + imgurl = "" + Else + arg.AdditionalErrorMessage = "(UnknownResponse)" + arg.IsError = True + imgurl = "" + End If + + Catch ex As Exception + imgurl = "" + arg.AdditionalErrorMessage = "(Invalid XML)" + arg.IsError = True + End Try + + If Not String.IsNullOrEmpty(imgurl) Then + Dim _img As Image = http.GetImage(imgurl, url.Key) + If _img Is Nothing Then Continue For + arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) + arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, sb.ToString.Trim())) + End If + End If + ElseIf url.Key.StartsWith("http://p.twipple.jp/") Then + Dim mc As Match = Regex.Match(url.Key, "^http://p.twipple.jp/(?[0-9a-z]+)", RegexOptions.IgnoreCase) + If mc.Success Then + Dim src As String = "" + If (New HttpVarious).GetData(url.Key, Nothing, src, 5000) Then + Dim thumbnail_url As String = "" + Dim ContentId As String = mc.Groups("contentId").Value + Dim DataDir As New StringBuilder + + ' DataDir作成 + DataDir.Append("data") + For i As Integer = 0 To ContentId.Length - 1 + DataDir.Append("/") + DataDir.Append(ContentId.Chars(i)) + Next + + ' サムネイルURL抽出 + thumbnail_url = Regex.Match(src, "http://p\.twipple\.jp/" + DataDir.ToString() + "_s\.([a-zA-Z]+)").Value + + If String.IsNullOrEmpty(thumbnail_url) Then Continue For + Dim _img As Image = http.GetImage(thumbnail_url, url.Key) + If _img Is Nothing Then Continue For + arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) + arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) + Continue For + End If + End If + Continue For + ElseIf url.Key.StartsWith("http://www.youtube.com/", StringComparison.CurrentCultureIgnoreCase) _ + OrElse url.Key.StartsWith("http://youtu.be/", StringComparison.InvariantCultureIgnoreCase) Then + ' YouTube + ' 参考 + ' http://code.google.com/intl/ja/apis/youtube/2.0/developers_guide_protocol_video_entries.html + ' デベロッパー ガイド: Data API プロトコル - 単独の動画情報の取得 - YouTube の API とツール - Google Code + ' http://code.google.com/intl/ja/apis/youtube/2.0/developers_guide_protocol_understanding_video_feeds.html#Understanding_Feeds_and_Entries + ' デベロッパー ガイド: Data API プロトコル - 動画のフィードとエントリについて - YouTube の API とツール - Google Code + Dim videourl As String = (New HttpVarious).GetRedirectTo(url.Key) + Dim mc As Match = Regex.Match(videourl, "^http://(?:(www\.youtube\.com)|(youtu\.be))/(watch\?v=)?(?([\w\-]+))", RegexOptions.IgnoreCase) + If videourl.StartsWith("http://www.youtube.com/index?ytsession=") Then + videourl = url.Key + mc = Regex.Match(videourl, "^http://(?:(www\.youtube\.com)|(youtu\.be))/(watch\?v=)?(?([\w\-]+))", RegexOptions.IgnoreCase) + End If + If mc.Success Then + Dim apiurl As String = "http://gdata.youtube.com/feeds/api/videos/" + mc.Groups("videoid").Value + Dim imgurl As String = url.Value + Dim src As String = "" + If (New HttpVarious).GetData(apiurl, Nothing, src, 5000) Then + Dim sb As New StringBuilder + Dim xdoc As New XmlDocument + Try + xdoc.LoadXml(src) + Dim nsmgr As New XmlNamespaceManager(xdoc.NameTable) + nsmgr.AddNamespace("root", "http://www.w3.org/2005/Atom") + nsmgr.AddNamespace("app", "http://purl.org/atom/app#") + nsmgr.AddNamespace("media", "http://search.yahoo.com/mrss/") + + Dim xentryNode As XmlNode = xdoc.DocumentElement.SelectSingleNode("/root:entry/media:group", nsmgr) + Dim xentry As XmlElement = CType(xentryNode, XmlElement) + Dim tmp As String = "" + Try + tmp = xentry.Item("media:title").InnerText + If Not String.IsNullOrEmpty(tmp) Then + sb.Append("タイトル:") + sb.Append(tmp) + sb.AppendLine() + End If + Catch ex As Exception + + End Try + + Try + Dim sec As Integer = 0 + + If Integer.TryParse(xentry.Item("yt:duration").Attributes("seconds").Value, sec) Then + sb.Append("再生時間:") + sb.AppendFormat("{0:d}:{1:d2}", sec \ 60, sec Mod 60) + sb.AppendLine() + End If + Catch ex As Exception + + End Try + + Try + Dim tmpdate As New DateTime + + xentry = CType(xdoc.DocumentElement.SelectSingleNode("/root:entry", nsmgr), XmlElement) + If DateTime.TryParse(xentry.Item("published").InnerText, tmpdate) Then + sb.Append("投稿日時:") + sb.Append(tmpdate) + sb.AppendLine() + End If + Catch ex As Exception + + End Try + + Try + Dim count As Integer = 0 + xentry = CType(xdoc.DocumentElement.SelectSingleNode("/root:entry", nsmgr), XmlElement) + tmp = xentry.Item("yt:statistics").Attributes("viewCount").Value + + If Integer.TryParse(tmp, count) Then + sb.Append("再生数:") + sb.Append(tmp) + sb.AppendLine() + End If + Catch ex As Exception + + End Try + + Try + xentry = CType(xdoc.DocumentElement.SelectSingleNode("/root:entry/app:control", nsmgr), XmlElement) + If xentry IsNot Nothing Then + sb.Append(xentry.Item("yt:state").Attributes("name").Value) + sb.Append(":") + sb.Append(xentry.Item("yt:state").InnerText) + sb.AppendLine() + End If + Catch ex As Exception + + End Try + + mc = Regex.Match(videourl, "^http://www\.youtube\.com/watch\?v=([\w\-]+)", RegexOptions.IgnoreCase) + If mc.Success Then + imgurl = mc.Result("http://i.ytimg.com/vi/${1}/default.jpg") + End If + mc = Regex.Match(videourl, "^http://youtu\.be/([\w\-]+)", RegexOptions.IgnoreCase) + If mc.Success Then + imgurl = mc.Result("http://i.ytimg.com/vi/${1}/default.jpg") + End If + + Catch ex As Exception + + End Try + + If Not String.IsNullOrEmpty(imgurl) Then + Dim _img As Image = http.GetImage(imgurl, videourl) + If _img Is Nothing Then Continue For + arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) + arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, sb.ToString.Trim())) + End If + End If + + End If + Else + ' 直リンクでなく、パターンに合致しない + Dim img As Image = http.GetImage(url.Value, url.Key) + If img Is Nothing Then Continue For + arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, img)) + arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) + End If + Next + If arg.pics.Count = 0 Then + arg.IsError = True + Else + arg.IsError = False + End If + e.Result = arg + End Sub + + Private Sub bgw_Completed(ByVal sender As System.Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) + Dim prv As PreviewData = TryCast(e.Result, PreviewData) + If prv Is Nothing OrElse prv.IsError Then + Owner.PreviewScrollBar.Maximum = 0 + Owner.PreviewScrollBar.Enabled = False + Owner.SplitContainer3.Panel2Collapsed = True + If prv IsNot Nothing AndAlso Not String.IsNullOrEmpty(prv.AdditionalErrorMessage) Then + ThumbnailProgressChanged(-1, prv.AdditionalErrorMessage) + Else + ThumbnailProgressChanged(-1) + End If + Exit Sub + End If + SyncLock lckPrev + If prv IsNot Nothing AndAlso _curPost IsNot Nothing AndAlso prv.statusId = _curPost.Id Then + _prev = prv + Owner.SplitContainer3.Panel2Collapsed = False + Owner.PreviewScrollBar.Maximum = _prev.pics.Count - 1 + If Owner.PreviewScrollBar.Maximum > 0 Then + Owner.PreviewScrollBar.Enabled = True + Else + Owner.PreviewScrollBar.Enabled = False + End If + Owner.PreviewScrollBar.Value = 0 + Owner.PreviewPicture.Image = _prev.pics(0).Value + If Not String.IsNullOrEmpty(_prev.tooltiptext(0).Value) Then + Owner.ToolTip1.SetToolTip(Owner.PreviewPicture, _prev.tooltiptext(0).Value) + Else + Owner.ToolTip1.SetToolTip(Owner.PreviewPicture, "") + End If + ElseIf _curPost Is Nothing OrElse (_prev IsNot Nothing AndAlso _curPost.Id <> _prev.statusId) Then + Owner.PreviewScrollBar.Maximum = 0 + Owner.PreviewScrollBar.Enabled = False + Owner.SplitContainer3.Panel2Collapsed = True + End If + End SyncLock + ThumbnailProgressChanged(100) + End Sub + + Public Sub ScrollThumbnail(ByVal forward As Boolean) + If forward Then + Owner.PreviewScrollBar.Value = Math.Min(Owner.PreviewScrollBar.Value + 1, Owner.PreviewScrollBar.Maximum) + PreviewScrollBar_Scroll(Owner.PreviewScrollBar, New ScrollEventArgs(ScrollEventType.SmallIncrement, Owner.PreviewScrollBar.Value)) + Else + Owner.PreviewScrollBar.Value = Math.Max(Owner.PreviewScrollBar.Value - 1, Owner.PreviewScrollBar.Minimum) + PreviewScrollBar_Scroll(Owner.PreviewScrollBar, New ScrollEventArgs(ScrollEventType.SmallDecrement, Owner.PreviewScrollBar.Value)) + End If + End Sub + + Private Sub PreviewScrollBar_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) + SyncLock lckPrev + If _prev IsNot Nothing AndAlso _curPost IsNot Nothing AndAlso _prev.statusId = _curPost.Id Then + If _prev.pics.Count > e.NewValue Then + Owner.PreviewPicture.Image = _prev.pics(e.NewValue).Value + If Not String.IsNullOrEmpty(_prev.tooltiptext(e.NewValue).Value) Then + Owner.ToolTip1.Hide(Owner.PreviewPicture) + Owner.ToolTip1.SetToolTip(Owner.PreviewPicture, _prev.tooltiptext(e.NewValue).Value) + Else + Owner.ToolTip1.SetToolTip(Owner.PreviewPicture, "") + Owner.ToolTip1.Hide(Owner.PreviewPicture) + End If + End If + End If + End SyncLock + End Sub + + Private Sub PreviewPicture_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) + Owner.ToolTip1.Hide(Owner.PreviewPicture) + End Sub + Private Sub PreviewPicture_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) + OpenPicture() + End Sub + Public Sub OpenPicture() + If _prev IsNot Nothing Then + If Owner.PreviewScrollBar.Value < _prev.pics.Count Then + Owner.OpenUriAsync(_prev.pics(Owner.PreviewScrollBar.Value).Key) + End If + End If + End Sub +End Class diff --git a/Tween/Tween.vb b/Tween/Tween.vb index 89657441..8bee9e0f 100644 --- a/Tween/Tween.vb +++ b/Tween/Tween.vb @@ -187,7 +187,7 @@ Public Class TweenMain Private cMode As Integer Private shield As New ShieldIcon Private SecurityManager As InternetSecurityManager - + Private Thumbnail As Thumbnail Private _homeCounter As Integer = 0 Private _homeCounterAdjuster As Integer = 0 @@ -493,6 +493,7 @@ Public Class TweenMain _ignoreConfigSave = True Me.Visible = False SecurityManager = New InternetSecurityManager(PostBrowser) + Thumbnail = New Thumbnail(Me) AddHandler TwitterApiInfo.Changed, AddressOf SetStatusLabelApiHandler @@ -1286,7 +1287,7 @@ Public Class TweenMain isMention OrElse dmCount <> _statuses.GetTabByType(TabUsageType.DirectMessage).AllCount) SetMainWindowTitle() - If Not StatusLabelUrl.Text.StartsWith("http") Then SetStatusLabel() + If Not StatusLabelUrl.Text.StartsWith("http") Then SetStatusLabelUrl() HashSupl.AddRangeItem(tw.GetHashList) @@ -3490,7 +3491,7 @@ Public Class TweenMain '_curList.Refresh() DispSelectedPost() SetMainWindowTitle() - SetStatusLabel() + SetStatusLabelUrl() If ListTab.Focused OrElse DirectCast(ListTab.SelectedTab.Tag, Control).Focused Then Me.Tag = ListTab.Tag TabMenuControl(ListTab.SelectedTab.Text) End Sub @@ -3532,7 +3533,7 @@ Public Class TweenMain StatusLabelUrl.Text = PostBrowser.StatusText.Replace("&", "&&") End If If PostBrowser.StatusText = "" Then - SetStatusLabel() + SetStatusLabelUrl() End If End Sub @@ -4166,7 +4167,7 @@ RETRY: SettingDialog.DispLatestPost <> DispTitleEnum.OwnStatus Then SetMainWindowTitle() End If - If Not StatusLabelUrl.Text.StartsWith("http") Then SetStatusLabel() + If Not StatusLabelUrl.Text.StartsWith("http") Then SetStatusLabelUrl() For Each tb As TabPage In ListTab.TabPages If _statuses.Tabs(tb.Text).UnreadCount = 0 Then If SettingDialog.TabIconDisp Then @@ -4259,7 +4260,7 @@ RETRY: For Each lnk As Match In Regex.Matches(dTxt, "http[^""]+)""", RegexOptions.IgnoreCase) lnks.Add(lnk.Result("${url}")) Next - thumbnail(_curPost.Id, lnks) + Thumbnail.thumbnail(_curPost.Id, lnks) End If Catch ex As System.Runtime.InteropServices.COMException '原因不明 @@ -4513,14 +4514,14 @@ RETRY: ' ALT+SHIFTキーが押されている場合 If e.KeyCode = Keys.R Then doReTweetUnofficial() If e.KeyCode = Keys.Up Then - ScrollThumbnail(False) + Thumbnail.ScrollThumbnail(False) End If If e.KeyCode = Keys.Down Then - ScrollThumbnail(True) + Thumbnail.ScrollThumbnail(True) End If If e.KeyCode = Keys.Enter Then If Not Me.SplitContainer3.Panel2Collapsed Then - PreviewPicture_DoubleClick(PreviewPicture, EventArgs.Empty) + Thumbnail.OpenPicture() End If e.Handled = True e.SuppressKeyPress = True @@ -4579,16 +4580,6 @@ RETRY: End If End Sub - Private Sub ScrollThumbnail(ByVal forward As Boolean) - If forward Then - PreviewScrollBar.Value = Math.Min(PreviewScrollBar.Value + 1, PreviewScrollBar.Maximum) - PreviewScrollBar_Scroll(PreviewScrollBar, New ScrollEventArgs(ScrollEventType.SmallIncrement, PreviewScrollBar.Value)) - Else - PreviewScrollBar.Value = Math.Max(PreviewScrollBar.Value - 1, PreviewScrollBar.Minimum) - PreviewScrollBar_Scroll(PreviewScrollBar, New ScrollEventArgs(ScrollEventType.SmallDecrement, PreviewScrollBar.Value)) - End If - End Sub - Private Sub GoNextTab(ByVal forward As Boolean) Dim idx As Integer = ListTab.SelectedIndex If forward Then @@ -5940,7 +5931,7 @@ RETRY: End If SetMainWindowTitle() - SetStatusLabel() + SetStatusLabelUrl() If Not SettingDialog.TabIconDisp Then ListTab.Refresh() End Sub @@ -6388,7 +6379,7 @@ RETRY: If Not SettingDialog.TabIconDisp Then ListTab.Refresh() SetMainWindowTitle() - SetStatusLabel() + SetStatusLabelUrl() End Sub Private Sub SetMainWindowTitle() @@ -6510,10 +6501,14 @@ RETRY: End If End Sub - Private Sub SetStatusLabel() + Private Sub SetStatusLabelUrl() StatusLabelUrl.Text = GetStatusLabelText() End Sub + Public Sub SetStatusLabel(ByVal text As String) + StatusLabel.Text = text + End Sub + Private Sub SetNotifyIconText() ' タスクトレイアイコンのツールチップテキスト書き換え ' Tween [未読/@] @@ -7635,7 +7630,7 @@ RETRY: tmp = My.Resources.ApiInfo1 + args.info.MaxCount.ToString() + Environment.NewLine + _ My.Resources.ApiInfo2 + args.info.RemainCount.ToString + Environment.NewLine + _ My.Resources.ApiInfo3 + args.info.ResetTime.ToString() - SetStatusLabel() + SetStatusLabelUrl() Else tmp = My.Resources.ApiInfo5 End If @@ -8288,739 +8283,6 @@ RETRY: End Get End Property -#Region "イメージプレビュー" - Private lckPrev As New Object - Private _prev As PreviewData - Private Class PreviewData - Implements IDisposable - - Public statusId As Long - Public urls As List(Of KeyValuePair(Of String, String)) - Public pics As New List(Of KeyValuePair(Of String, Image)) - Public tooltiptext As New List(Of KeyValuePair(Of String, String)) - Public Sub New(ByVal id As Long, ByVal urlList As List(Of KeyValuePair(Of String, String))) - statusId = id - urls = urlList - End Sub - - Public IsError As Boolean - Public AdditionalErrorMessage As String - - Private disposedValue As Boolean = False ' 重複する呼び出しを検出するには - - ' IDisposable - Protected Overridable Sub Dispose(ByVal disposing As Boolean) - If Not Me.disposedValue Then - If disposing Then - ' TODO: 明示的に呼び出されたときにマネージ リソースを解放します - End If - - ' TODO: 共有のアンマネージ リソースを解放します - For Each pic As KeyValuePair(Of String, Image) In pics - If pic.Value IsNot Nothing Then pic.Value.Dispose() - Next - End If - Me.disposedValue = True - End Sub - -#Region " IDisposable Support " - ' このコードは、破棄可能なパターンを正しく実装できるように Visual Basic によって追加されました。 - Public Sub Dispose() Implements IDisposable.Dispose - ' このコードを変更しないでください。クリーンアップ コードを上の Dispose(ByVal disposing As Boolean) に記述します。 - Dispose(True) - GC.SuppressFinalize(Me) - End Sub -#End Region - - End Class - - Private Function IsDirectLink(ByVal url As String) As Boolean - Return Regex.Match(url, "^http://.*(\.jpg|\.jpeg|\.gif|\.png|\.bmp)$", RegexOptions.IgnoreCase).Success - End Function - - Private Sub thumbnail(ByVal id As Long, ByVal links As List(Of String)) - If Not SettingDialog.PreviewEnable Then - Me.SplitContainer3.Panel2Collapsed = True - Exit Sub - End If - If Not PreviewPicture.Image Is Nothing Then - PreviewPicture.Image.Dispose() - PreviewPicture.Image = Nothing - Me.SplitContainer3.Panel2Collapsed = True - End If - 'SyncLock lckPrev - ' If _prev IsNot Nothing Then - ' _prev.Dispose() - ' _prev = Nothing - ' End If - 'End SyncLock - - If links.Count = 0 Then - Me.PreviewScrollBar.Maximum = 0 - Me.PreviewScrollBar.Enabled = False - Me.SplitContainer3.Panel2Collapsed = True - Exit Sub - End If - - Dim imglist As New List(Of KeyValuePair(Of String, String)) - - For Each url As String In links - 'Dim re As Regex - Dim mc As Match - 'imgur - mc = Regex.Match(url, "^http://imgur\.com/(\w+)\.jpg$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://i.imgur.com/${1}l.jpg"))) - Continue For - End If - '画像拡張子で終わるURL（直リンク） - If IsDirectLink(url) Then - imglist.Add(New KeyValuePair(Of String, String)(url, url)) - Continue For - End If - 'twitpic - mc = Regex.Match(url, "^http://(www\.)?twitpic\.com/(?\w+)(/full/?)?$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://twitpic.com/show/thumb/${photoId}"))) - Continue For - End If - 'yfrog - mc = Regex.Match(url, "^http://yfrog\.com/(\w+)$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, url + ".th.jpg")) - Continue For - End If - 'tweetphoto - Const comp As String = "http://TweetPhotoAPI.com/api/TPAPI.svc/imagefromurl?size=thumbnail&url=" - If Regex.IsMatch(url, "^(http://tweetphoto\.com/[0-9]+|http://pic\.gd/[a-z0-9]+)$", RegexOptions.IgnoreCase) Then - imglist.Add(New KeyValuePair(Of String, String)(url, comp + url)) - Continue For - End If - 'Mobypicture - mc = Regex.Match(url, "^http://moby\.to/(\w+)$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://mobypicture.com/?${1}:small"))) - Continue For - End If - '携帯百景 - mc = Regex.Match(url, "^http://movapic\.com/pic/(\w+)$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://image.movapic.com/pic/s_${1}.jpeg"))) - Continue For - End If - 'はてなフォトライフ - mc = Regex.Match(url, "^http://f\.hatena\.ne\.jp/(([a-z])[a-z0-9_-]{1,30}[a-z0-9])/((\d{8})\d+)$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://img.f.hatena.ne.jp/images/fotolife/${2}/${1}/${4}/${3}_120.jpg"))) - Continue For - End If - 'PhotoShare - mc = Regex.Match(url, "^http://(?:www\.)?bcphotoshare\.com/photos/\d+/(\d+)$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://images.bcphotoshare.com/storages/${1}/thumb180.jpg"))) - Continue For - End If - 'PhotoShare の短縮 URL - mc = Regex.Match(url, "^http://bctiny\.com/p(\w+)$", RegexOptions.IgnoreCase) - If mc.Success Then - Try - imglist.Add(New KeyValuePair(Of String, String)(url, "http://images.bcphotoshare.com/storages/" + RadixConvert.ToInt32(mc.Result("${1}"), 32).ToString + "/thumb180.jpg")) - Continue For - Catch ex As ArgumentOutOfRangeException - End Try - End If - 'img.ly - mc = Regex.Match(url, "^http://img\.ly/(\w+)$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://img.ly/show/thumb/${1}"))) - Continue For - End If - 'brightkite - mc = Regex.Match(url, "^http://brightkite\.com/objects/((\w{2})(\w{2})\w+)$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://cdn.brightkite.com/${2}/${3}/${1}-feed.jpg"))) - Continue For - End If - 'Twitgoo - mc = Regex.Match(url, "^http://twitgoo\.com/(\w+)$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://twitgoo.com/${1}/mini"))) - Continue For - End If - 'pic.im - mc = Regex.Match(url, "^http://pic\.im/(\w+)$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://pic.im/website/thumbnail/${1}"))) - Continue For - End If - 'youtube - mc = Regex.Match(url, "^http://www\.youtube\.com/watch\?v=([\w\-]+)", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://i.ytimg.com/vi/${1}/default.jpg"))) - Continue For - End If - mc = Regex.Match(url, "^http://youtu\.be/([\w\-]+)", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://i.ytimg.com/vi/${1}/default.jpg"))) - Continue For - End If - 'ニコニコ - mc = Regex.Match(url, "^http://(?:(www|ext)\.nicovideo\.jp/watch|nico\.ms)/(?:sm|nm)?([0-9]+)(\?.+)?$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) - Continue For - End If - 'pixiv - '参考: http://tail.s68.xrea.com/blog/2009/02/pixivflash.html Pixivの画像をFlashとかで取得する方法など:しっぽのブログ - 'ユーザー向けの画像ページ http://www.pixiv.net/member_illust.php?mode=medium&illust_id=[ID番号] - '非ログインユーザー向けの画像ページ http://www.pixiv.net/index.php?mode=medium&illust_id=[ID番号] - 'サムネイルURL http://img[サーバー番号].pixiv.net/img/[ユーザー名]/[サムネイルID]_s.[拡張子] - 'サムネイルURLは画像ページから抽出する - mc = Regex.Match(url, "^http://www\.pixiv\.net/(member_illust|index)\.php\?mode=(medium|big)&(amp;)?illust_id=(?[0-9]+)(&(amp;)?tag=(?.+)?)*$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url.Replace("amp;", ""), mc.Value)) - Continue For - End If - 'flickr - '参考: http://tanarky.blogspot.com/2010/03/flickr-urlunavailable.html アグレッシブエンジニア: flickr の画像URL仕様についてまとめ(Unavailable画像) - '画像URL仕様　http://farm{farm}.static.flickr.com/{server}/{id}_{secret}_{size}.{extension} - 'photostreamなど複数の画像がある場合先頭の一つのみ認識と言うことにする - '(二つ目のキャプチャ 一つ目の画像はユーザーアイコン） - mc = Regex.Match(url, "^http://www.flickr.com/", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) - Continue For - End If - 'TwitVideo - mc = Regex.Match(url, "^http://twitvideo\.jp/(\w+)$", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Result("http://twitvideo.jp/img/thumb/${1}"))) - Continue For - End If - 'piapro - mc = Regex.Match(url, "^http://piapro\.jp/content/(?[0-9a-z]+)", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) - Continue For - End If - 'フォト蔵 - mc = Regex.Match(url, "^http://photozou\.jp/photo/show/(?[0-9]+)/(?[0-9]+)", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) - Continue For - End If - 'tumblr - mc = Regex.Match(url, "^http://.+\.tumblr\.com/.+/?", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) - Continue For - End If - 'ついっぷるフォト - mc = Regex.Match(url, "^http://p\.twipple\.jp/(?[0-9a-z]+)", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value)) - Continue For - End If - 'mypix/shamoji - mc = Regex.Match(url, "^http://(www\.mypix\.jp|www\.shamoji\.info)/app\.php/picture/(?[0-9a-z]+)", RegexOptions.IgnoreCase) - If mc.Success Then - imglist.Add(New KeyValuePair(Of String, String)(url, mc.Value + "/thumb.jpg")) - Continue For - End If - Next - - If imglist.Count = 0 Then - Me.PreviewScrollBar.Maximum = 0 - Me.PreviewScrollBar.Enabled = False - Me.SplitContainer3.Panel2Collapsed = True - Exit Sub - End If - - ThumbnailProgressChanged(0) - Dim bgw As BackgroundWorker - bgw = New BackgroundWorker() - AddHandler bgw.DoWork, AddressOf bgw_DoWork - AddHandler bgw.RunWorkerCompleted, AddressOf bgw_Completed - bgw.RunWorkerAsync(New PreviewData(id, imglist)) - - End Sub - - Private Sub ThumbnailProgressChanged(ByVal ProgressPercentage As Integer, Optional ByVal AddMsg As String = "") - If ProgressPercentage = 0 Then '開始 - StatusLabel.Text = "Thumbnail generating..." - ElseIf ProgressPercentage = 100 Then '正常終了 - StatusLabel.Text = "Thumbnail generated." - Else ' エラー - If String.IsNullOrEmpty(AddMsg) Then - StatusLabel.Text = "can't get Thumbnail." - Else - StatusLabel.Text = "can't get Thumbnail." + AddMsg - End If - End If - End Sub - - Private Sub bgw_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) - Dim arg As PreviewData = DirectCast(e.Argument, PreviewData) - Dim worker As BackgroundWorker = DirectCast(sender, BackgroundWorker) - Dim addMsg As String = "" - arg.AdditionalErrorMessage = "" - - ' pixiv,Flickr,piapro,フォト蔵,tumblrの解析もこちらでやる - For Each url As KeyValuePair(Of String, String) In arg.urls - Dim http As New HttpVarious - - If IsDirectLink(url.Key) Then - ' 画像直リンク - Dim img As Image = http.GetImage(url.Value, url.Key) - If img Is Nothing Then Continue For - arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, img)) - arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) - ElseIf url.Key.StartsWith("http://www.pixiv.net/") Then - Dim src As String = "" - 'illustIDをキャプチャ - Dim mc As Match = Regex.Match(url.Key, "^http://www\.pixiv\.net/(member_illust|index)\.php\?mode=(medium|big)&(amp;)?illust_id=(?[0-9]+)(&(amp;)?tag=(?.+)?)*$", RegexOptions.IgnoreCase) - If mc.Groups("tag").Value = "R-18" OrElse mc.Groups("tag").Value = "R-18G" Then - arg.IsError = True - arg.AdditionalErrorMessage = "(NeedLogin.NotSupported)" - Else - If (New HttpVarious).GetData(Regex.Replace(mc.Groups(0).Value, "amp;", ""), Nothing, src, 5000) Then - Dim _mc As Match = Regex.Match(src, mc.Result("http://img([0-9]+)\.pixiv\.net/img/.+/${illustId}_s\.([a-zA-Z]+)")) - If _mc.Success Then - Dim _img As Image = http.GetImage(_mc.Value, url.Key) - If _img Is Nothing Then Continue For - arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) - arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) - End If - End If - End If - ElseIf url.Key.StartsWith("http://www.flickr.com/") Then - Dim mc As Match = Regex.Match(url.Key, "^http://www.flickr.com/", RegexOptions.IgnoreCase) - If mc.Success Then - Dim src As String = "" - If (New HttpVarious).GetData(url.Key, Nothing, src, 5000) Then - Dim _mc As MatchCollection = Regex.Matches(src, mc.Result("http://farm[0-9]+\.static\.flickr\.com/[0-9]+/.+?\.([a-zA-Z]+)")) - '二つ以上キャプチャした場合先頭の一つだけ 一つだけの場合はユーザーアイコンしか取れなかった - If _mc.Count > 1 Then - Dim _img As Image = http.GetImage(_mc.Item(1).Value, url.Key) - If _img Is Nothing Then Continue For - arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) - arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) - End If - End If - Continue For - End If - ElseIf url.Key.StartsWith("http://piapro.jp/") Then - Dim mc As Match = Regex.Match(url.Key, "^http://piapro\.jp/content/(?[0-9a-z]+)", RegexOptions.IgnoreCase) - If mc.Success Then - Dim src As String = "" - If (New HttpVarious).GetData(url.Key, Nothing, src, 5000) Then - Dim _mc As Match = Regex.Match(src, mc.Result("http://c1\.piapro\.jp/timg/${contentId}_\d{14}_\d{4}_\d{4}\.(jpg|png|gif)")) - If _mc.Success Then - '各画像には120x120のサムネイルがある（多分）ので、URLを置き換える。元々ページに埋め込まれている画像は500x500 - Dim r As New System.Text.RegularExpressions.Regex("_\d{4}_\d{4}") - Dim min_img_url As String = r.Replace(_mc.Value, "_0120_0120") - Dim _img As Image = http.GetImage(min_img_url, url.Key) - If _img Is Nothing Then Continue For - arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) - arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) - End If - End If - End If - Continue For - ElseIf url.Key.StartsWith("http://photozou.jp/") Then - Dim mc As Match = Regex.Match(url.Key, "^http://photozou\.jp/photo/show/(?[0-9]+)/(?[0-9]+)", RegexOptions.IgnoreCase) - If mc.Success Then - Dim src As String = "" - Dim show_info As String = mc.Result("http://api.photozou.jp/rest/photo_info?photo_id=${photoId}") - If (New HttpVarious).GetData(show_info, Nothing, src, 5000) Then - Dim xdoc As New XmlDocument - Dim thumbnail_url As String = "" - Try - xdoc.LoadXml(src) - thumbnail_url = xdoc.SelectSingleNode("/rsp/info/photo/thumbnail_image_url").InnerText - Catch ex As Exception - thumbnail_url = "" - End Try - If String.IsNullOrEmpty(thumbnail_url) Then Continue For - Dim _img As Image = http.GetImage(thumbnail_url, url.Key) - If _img Is Nothing Then Continue For - arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) - arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) - Continue For - End If - End If - Continue For - ElseIf Regex.Match(url.Key, "^http://.+\.tumblr\.com/.+/?", RegexOptions.IgnoreCase).Success Then - Dim TargetUrl As String = (New HttpVarious).GetRedirectTo(url.Key) - Dim mc As Match = Regex.Match(TargetUrl, "(?http://.+?\.tumblr\.com/)post/(?[0-9]+)(/(?.+?)/)?", RegexOptions.IgnoreCase) - Dim apiurl As String = mc.Groups("base").Value + "api/read?id=" + mc.Groups("postID").Value - Dim src As String = "" - Dim imgurl As String = Nothing - If (New HttpVarious).GetData(apiurl, Nothing, src, 5000) Then - Dim xdoc As New XmlDocument - Try - xdoc.LoadXml(src) - - Dim type As String = xdoc.SelectSingleNode("/tumblr/posts/post").Attributes("type").Value - If type = "photo" Then - imgurl = xdoc.SelectSingleNode("/tumblr/posts/post/photo-url").InnerText - Else - arg.AdditionalErrorMessage = "(PostType:" + type + ")" - arg.IsError = True - imgurl = "" - End If - - Catch ex As Exception - imgurl = "" - End Try - - If Not String.IsNullOrEmpty(imgurl) Then - Dim _img As Image = http.GetImage(imgurl, url.Key) - If _img Is Nothing Then Continue For - arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) - arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) - End If - End If - Continue For - ElseIf Regex.Match(url.Value, "^http://(?:(www|ext)\.nicovideo\.jp/watch|nico\.ms)/(?:sm|nm)?([0-9]+)(\?.+)?$", RegexOptions.IgnoreCase).Success Then - Dim mc As Match = Regex.Match(url.Value, "^http://(?:(www|ext)\.nicovideo\.jp/watch|nico\.ms)/(?(?:sm|nm)?([0-9]+))(\?.+)?$", RegexOptions.IgnoreCase) - Dim apiurl As String = "http://www.nicovideo.jp/api/getthumbinfo/" + mc.Groups("id").Value - Dim src As String = "" - Dim imgurl As String = "" - Dim headers As New Dictionary(Of String, String) - headers.Add("User-Agent", "Tween " + fileVersion) - If (New HttpVarious).GetData(apiurl, headers, src, 5000) Then - Dim sb As New StringBuilder - Dim xdoc As New XmlDocument - Try - xdoc.LoadXml(src) - Dim status As String = xdoc.SelectSingleNode("/nicovideo_thumb_response").Attributes("status").Value - If status = "ok" Then - imgurl = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/thumbnail_url").InnerText - - 'ツールチップに動画情報をセットする - Dim tmp As String - - Try - tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/title").InnerText - If Not String.IsNullOrEmpty(tmp) Then - sb.Append(My.Resources.NiconicoInfoText1) - sb.Append(tmp) - sb.AppendLine() - End If - Catch ex As Exception - - End Try - - Try - tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/length").InnerText - If Not String.IsNullOrEmpty(tmp) Then - sb.Append(My.Resources.NiconicoInfoText2) - sb.Append(tmp) - sb.AppendLine() - End If - Catch ex As Exception - - End Try - - Try - Dim tm As New DateTime - tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/first_retrieve").InnerText - If DateTime.TryParse(tmp, tm) Then - sb.Append(My.Resources.NiconicoInfoText3) - sb.Append(tm.ToString) - sb.AppendLine() - End If - Catch ex As Exception - - End Try - - Try - tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/view_counter").InnerText - If Not String.IsNullOrEmpty(tmp) Then - sb.Append(My.Resources.NiconicoInfoText4) - sb.Append(tmp) - sb.AppendLine() - End If - Catch ex As Exception - - End Try - - Try - tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/comment_num").InnerText - If Not String.IsNullOrEmpty(tmp) Then - sb.Append(My.Resources.NiconicoInfoText5) - sb.Append(tmp) - sb.AppendLine() - End If - Catch ex As Exception - - End Try - Try - tmp = xdoc.SelectSingleNode("/nicovideo_thumb_response/thumb/mylist_counter").InnerText - If Not String.IsNullOrEmpty(tmp) Then - sb.Append(My.Resources.NiconicoInfoText6) - sb.Append(tmp) - sb.AppendLine() - End If - Catch ex As Exception - - End Try - - ElseIf status = "fail" Then - Dim errcode As String = xdoc.SelectSingleNode("/nicovideo_thumb_response/error/code").InnerText - arg.AdditionalErrorMessage = "(" + errcode + ")" - arg.IsError = True - imgurl = "" - Else - arg.AdditionalErrorMessage = "(UnknownResponse)" - arg.IsError = True - imgurl = "" - End If - - Catch ex As Exception - imgurl = "" - arg.AdditionalErrorMessage = "(Invalid XML)" - arg.IsError = True - End Try - - If Not String.IsNullOrEmpty(imgurl) Then - Dim _img As Image = http.GetImage(imgurl, url.Key) - If _img Is Nothing Then Continue For - arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) - arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, sb.ToString.Trim())) - End If - End If - ElseIf url.Key.StartsWith("http://p.twipple.jp/") Then - Dim mc As Match = Regex.Match(url.Key, "^http://p.twipple.jp/(?[0-9a-z]+)", RegexOptions.IgnoreCase) - If mc.Success Then - Dim src As String = "" - If (New HttpVarious).GetData(url.Key, Nothing, src, 5000) Then - Dim thumbnail_url As String = "" - Dim ContentId As String = mc.Groups("contentId").Value - Dim DataDir As New StringBuilder - - ' DataDir作成 - DataDir.Append("data") - For i As Integer = 0 To ContentId.Length - 1 - DataDir.Append("/") - DataDir.Append(ContentId.Chars(i)) - Next - - ' サムネイルURL抽出 - thumbnail_url = Regex.Match(src, "http://p\.twipple\.jp/" + DataDir.ToString() + "_s\.([a-zA-Z]+)").Value - - If String.IsNullOrEmpty(thumbnail_url) Then Continue For - Dim _img As Image = http.GetImage(thumbnail_url, url.Key) - If _img Is Nothing Then Continue For - arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) - arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) - Continue For - End If - End If - Continue For - ElseIf url.Key.StartsWith("http://www.youtube.com/", StringComparison.CurrentCultureIgnoreCase) _ - OrElse url.Key.StartsWith("http://youtu.be/", StringComparison.InvariantCultureIgnoreCase) Then - ' YouTube - ' 参考 - ' http://code.google.com/intl/ja/apis/youtube/2.0/developers_guide_protocol_video_entries.html - ' デベロッパー ガイド: Data API プロトコル - 単独の動画情報の取得 - YouTube の API とツール - Google Code - ' http://code.google.com/intl/ja/apis/youtube/2.0/developers_guide_protocol_understanding_video_feeds.html#Understanding_Feeds_and_Entries - ' デベロッパー ガイド: Data API プロトコル - 動画のフィードとエントリについて - YouTube の API とツール - Google Code - Dim videourl As String = (New HttpVarious).GetRedirectTo(url.Key) - Dim mc As Match = Regex.Match(videourl, "^http://(?:(www\.youtube\.com)|(youtu\.be))/(watch\?v=)?(?([\w\-]+))", RegexOptions.IgnoreCase) - If videourl.StartsWith("http://www.youtube.com/index?ytsession=") Then - videourl = url.Key - mc = Regex.Match(videourl, "^http://(?:(www\.youtube\.com)|(youtu\.be))/(watch\?v=)?(?([\w\-]+))", RegexOptions.IgnoreCase) - End If - If mc.Success Then - Dim apiurl As String = "http://gdata.youtube.com/feeds/api/videos/" + mc.Groups("videoid").Value - Dim imgurl As String = url.Value - Dim src As String = "" - If (New HttpVarious).GetData(apiurl, Nothing, src, 5000) Then - Dim sb As New StringBuilder - Dim xdoc As New XmlDocument - Try - xdoc.LoadXml(src) - Dim nsmgr As New XmlNamespaceManager(xdoc.NameTable) - nsmgr.AddNamespace("root", "http://www.w3.org/2005/Atom") - nsmgr.AddNamespace("app", "http://purl.org/atom/app#") - nsmgr.AddNamespace("media", "http://search.yahoo.com/mrss/") - - Dim xentryNode As XmlNode = xdoc.DocumentElement.SelectSingleNode("/root:entry/media:group", nsmgr) - Dim xentry As XmlElement = CType(xentryNode, XmlElement) - Dim tmp As String = "" - Try - tmp = xentry.Item("media:title").InnerText - If Not String.IsNullOrEmpty(tmp) Then - sb.Append("タイトル:") - sb.Append(tmp) - sb.AppendLine() - End If - Catch ex As Exception - - End Try - - Try - Dim sec As Integer = 0 - - If Integer.TryParse(xentry.Item("yt:duration").Attributes("seconds").Value, sec) Then - sb.Append("再生時間:") - sb.AppendFormat("{0:d}:{1:d2}", sec \ 60, sec Mod 60) - sb.AppendLine() - End If - Catch ex As Exception - - End Try - - Try - Dim tmpdate As New DateTime - - xentry = CType(xdoc.DocumentElement.SelectSingleNode("/root:entry", nsmgr), XmlElement) - If DateTime.TryParse(xentry.Item("published").InnerText, tmpdate) Then - sb.Append("投稿日時:") - sb.Append(tmpdate) - sb.AppendLine() - End If - Catch ex As Exception - - End Try - - Try - Dim count As Integer = 0 - xentry = CType(xdoc.DocumentElement.SelectSingleNode("/root:entry", nsmgr), XmlElement) - tmp = xentry.Item("yt:statistics").Attributes("viewCount").Value - - If Integer.TryParse(tmp, count) Then - sb.Append("再生数:") - sb.Append(tmp) - sb.AppendLine() - End If - Catch ex As Exception - - End Try - - Try - xentry = CType(xdoc.DocumentElement.SelectSingleNode("/root:entry/app:control", nsmgr), XmlElement) - If xentry IsNot Nothing Then - sb.Append(xentry.Item("yt:state").Attributes("name").Value) - sb.Append(":") - sb.Append(xentry.Item("yt:state").InnerText) - sb.AppendLine() - End If - Catch ex As Exception - - End Try - - mc = Regex.Match(videourl, "^http://www\.youtube\.com/watch\?v=([\w\-]+)", RegexOptions.IgnoreCase) - If mc.Success Then - imgurl = mc.Result("http://i.ytimg.com/vi/${1}/default.jpg") - End If - mc = Regex.Match(videourl, "^http://youtu\.be/([\w\-]+)", RegexOptions.IgnoreCase) - If mc.Success Then - imgurl = mc.Result("http://i.ytimg.com/vi/${1}/default.jpg") - End If - - Catch ex As Exception - - End Try - - If Not String.IsNullOrEmpty(imgurl) Then - Dim _img As Image = http.GetImage(imgurl, videourl) - If _img Is Nothing Then Continue For - arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, _img)) - arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, sb.ToString.Trim())) - End If - End If - - End If - Else - ' 直リンクでなく、パターンに合致しない - Dim img As Image = http.GetImage(url.Value, url.Key) - If img Is Nothing Then Continue For - arg.pics.Add(New KeyValuePair(Of String, Image)(url.Key, img)) - arg.tooltiptext.Add(New KeyValuePair(Of String, String)(url.Key, "")) - End If - Next - If arg.pics.Count = 0 Then - arg.IsError = True - Else - arg.IsError = False - End If - e.Result = arg - End Sub - - Private Sub bgw_Completed(ByVal sender As System.Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) - Dim prv As PreviewData = TryCast(e.Result, PreviewData) - If prv Is Nothing OrElse prv.IsError Then - Me.PreviewScrollBar.Maximum = 0 - Me.PreviewScrollBar.Enabled = False - Me.SplitContainer3.Panel2Collapsed = True - If prv IsNot Nothing AndAlso Not String.IsNullOrEmpty(prv.AdditionalErrorMessage) Then - ThumbnailProgressChanged(-1, prv.AdditionalErrorMessage) - Else - ThumbnailProgressChanged(-1) - End If - Exit Sub - End If - SyncLock lckPrev - If prv IsNot Nothing AndAlso _curPost IsNot Nothing AndAlso prv.statusId = _curPost.Id Then - _prev = prv - Me.SplitContainer3.Panel2Collapsed = False - Me.PreviewScrollBar.Maximum = _prev.pics.Count - 1 - If Me.PreviewScrollBar.Maximum > 0 Then - Me.PreviewScrollBar.Enabled = True - Else - Me.PreviewScrollBar.Enabled = False - End If - Me.PreviewScrollBar.Value = 0 - Me.PreviewPicture.Image = _prev.pics(0).Value - If Not String.IsNullOrEmpty(_prev.tooltiptext(0).Value) Then - Me.ToolTip1.SetToolTip(Me.PreviewPicture, _prev.tooltiptext(0).Value) - Else - Me.ToolTip1.SetToolTip(Me.PreviewPicture, "") - End If - ElseIf _curPost Is Nothing OrElse (_prev IsNot Nothing AndAlso _curPost.Id <> _prev.statusId) Then - Me.PreviewScrollBar.Maximum = 0 - Me.PreviewScrollBar.Enabled = False - Me.SplitContainer3.Panel2Collapsed = True - End If - End SyncLock - ThumbnailProgressChanged(100) - End Sub - - Private Sub PreviewScrollBar_Scroll(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ScrollEventArgs) Handles PreviewScrollBar.Scroll - SyncLock lckPrev - If _prev IsNot Nothing AndAlso _curPost IsNot Nothing AndAlso _prev.statusId = _curPost.Id Then - If _prev.pics.Count > e.NewValue Then - Me.PreviewPicture.Image = _prev.pics(e.NewValue).Value - If Not String.IsNullOrEmpty(_prev.tooltiptext(e.NewValue).Value) Then - Me.ToolTip1.Hide(Me.PreviewPicture) - Me.ToolTip1.SetToolTip(Me.PreviewPicture, _prev.tooltiptext(e.NewValue).Value) - Else - Me.ToolTip1.SetToolTip(Me.PreviewPicture, "") - Me.ToolTip1.Hide(Me.PreviewPicture) - End If - End If - End If - End SyncLock - End Sub - - Private Sub PreviewPicture_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles PreviewPicture.MouseEnter - - End Sub - - Private Sub PreviewPicture_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles PreviewPicture.MouseLeave - Me.ToolTip1.Hide(Me.PreviewPicture) - End Sub - Private Sub PreviewPicture_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles PreviewPicture.DoubleClick - If _prev IsNot Nothing Then - If Me.PreviewScrollBar.Value < _prev.pics.Count Then - OpenUriAsync(_prev.pics(Me.PreviewScrollBar.Value).Key) - End If - End If - End Sub -#End Region Private Sub SplitContainer3_SplitterMoved(ByVal sender As System.Object, ByVal e As System.Windows.Forms.SplitterEventArgs) Handles SplitContainer3.SplitterMoved If Me.WindowState = FormWindowState.Normal AndAlso Not _initialLayout Then @@ -9252,6 +8514,18 @@ RETRY: Me.MultiLineMenuItem.PerformClick() End Sub + Public ReadOnly Property CurPost As PostClass + Get + Return _curPost + End Get + End Property + + Public ReadOnly Property IsPreviewEnable As Boolean + Get + Return SettingDialog.PreviewEnable + End Get + End Property + #Region "画像投稿" Private Sub ImageSelectMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ImageSelectMenuItem.Click If ImageSelectionPanel.Visible = True Then diff --git a/Tween/Tween.vbproj b/Tween/Tween.vbproj index 241eea1b..14fb3e7e 100644 --- a/Tween/Tween.vbproj +++ b/Tween/Tween.vbproj @@ -239,6 +239,7 @@ Form + Component -- 2.11.0