OSDN Git Service

Stream関連のAPI仕様書に合わせた修正(UserAgent,420エラー)
[opentween/open-tween.git] / Tween / Twitter.vb
1 ' Tween - Client of Twitter
2 ' Copyright (c) 2007-2010 kiri_feather (@kiri_feather) <kiri_feather@gmail.com>
3 '           (c) 2008-2010 Moz (@syo68k) <http://iddy.jp/profile/moz/>
4 '           (c) 2008-2010 takeshik (@takeshik) <http://www.takeshik.org/>
5 ' All rights reserved.
6
7 ' This file is part of Tween.
8
9 ' This program is free software; you can redistribute it and/or modify it
10 ' under the terms of the GNU General Public License as published by the Free
11 ' Software Foundation; either version 3 of the License, or (at your option)
12 ' any later version.
13
14 ' This program is distributed in the hope that it will be useful, but
15 ' WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
16 ' or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 ' for more details. 
18
19 ' You should have received a copy of the GNU General Public License along
20 ' with this program. If not, see <http://www.gnu.org/licenses/>, or write to
21 ' the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor,
22 ' Boston, MA 02110-1301, USA.
23
24 Imports System.Web
25 Imports System.Xml
26 Imports System.Text
27 Imports System.Threading
28 Imports System.IO
29 Imports System.Text.RegularExpressions
30 Imports System.Globalization
31 Imports System.Diagnostics
32 Imports System.Net
33 Imports System.Reflection
34 Imports System.Reflection.MethodBase
35 Imports System.Runtime.Serialization.Json
36 Imports System.Linq
37 Imports System.Xml.Linq
38 Imports System.Runtime.Serialization
39 Imports System.Net.NetworkInformation
40
41 Public Class Twitter
42     Implements IDisposable
43
44     Delegate Sub GetIconImageDelegate(ByVal post As PostClass)
45     Private ReadOnly LockObj As New Object
46     Private followerId As New List(Of Long)
47     Private _GetFollowerResult As Boolean = False
48
49     Private _followersCount As Integer = 0
50     Private _friendsCount As Integer = 0
51     Private _statusesCount As Integer = 0
52     Private _location As String = ""
53     Private _bio As String = ""
54     Private _protocol As String = "https://"
55
56     'プロパティからアクセスされる共通情報
57     Private _uid As String
58     Private _iconSz As Integer
59     Private _getIcon As Boolean
60     Private _dIcon As IDictionary(Of String, Image)
61
62     Private _tinyUrlResolve As Boolean
63     Private _restrictFavCheck As Boolean
64
65     Private _hubServer As String
66     'Private _countApi As Integer
67     'Private _countApiReply As Integer
68     Private _readOwnPost As Boolean
69     Private _hashList As New List(Of String)
70
71     '共通で使用する状態
72     Private _remainCountApi As Integer = -1
73
74     Private op As New Outputz
75     'max_idで古い発言を取得するために保持(lists分は個別タブで管理)
76     Private minHomeTimeline As Long = Long.MaxValue
77     Private minMentions As Long = Long.MaxValue
78     Private minDirectmessage As Long = Long.MaxValue
79     Private minDirectmessageSent As Long = Long.MaxValue
80
81     Private twCon As New HttpTwitter
82
83     Private _deletemessages As New List(Of PostClass)
84
85     Public Function Authenticate(ByVal username As String, ByVal password As String) As String
86
87         Dim res As HttpStatusCode
88         Dim content As String = ""
89
90         TwitterApiInfo.Initialize()
91         Try
92             res = twCon.AuthUserAndPass(username, password, content)
93         Catch ex As Exception
94             Return "Err:" + ex.Message
95         End Try
96
97         Select Case res
98             Case HttpStatusCode.OK
99                 Twitter.AccountState = ACCOUNT_STATE.Valid
100                 _uid = username.ToLower
101                 Me.ReconnectUserStream()
102                 Return ""
103             Case HttpStatusCode.Unauthorized
104                 Twitter.AccountState = ACCOUNT_STATE.Invalid
105                 Dim errMsg As String = GetErrorMessageJson(content)
106                 If String.IsNullOrEmpty(errMsg) Then
107                     Return "Check your Username/Password." + Environment.NewLine + content
108                 Else
109                     Return "Auth error:" + errMsg
110                 End If
111             Case HttpStatusCode.Forbidden
112                 Dim errMsg As String = GetErrorMessageJson(content)
113                 If String.IsNullOrEmpty(errMsg) Then
114                     Return "Err:Forbidden"
115                 Else
116                     Return "Err:" + errMsg
117                 End If
118             Case Else
119                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
120         End Select
121
122     End Function
123
124     Public Sub ClearAuthInfo()
125         Twitter.AccountState = ACCOUNT_STATE.Invalid
126         TwitterApiInfo.Initialize()
127         twCon.ClearAuthInfo()
128         _UserIdNo = ""
129     End Sub
130
131     Private Function GetErrorMessageJson(ByVal content As String) As String
132         Try
133             If Not String.IsNullOrEmpty(content) Then
134                 Using jsonReader As XmlDictionaryReader = JsonReaderWriterFactory.CreateJsonReader(Encoding.UTF8.GetBytes(content), XmlDictionaryReaderQuotas.Max)
135                     Dim xElm As XElement = XElement.Load(jsonReader)
136                     If xElm.Element("error") IsNot Nothing Then
137                         Return xElm.Element("error").Value
138                     Else
139                         Return ""
140                     End If
141                 End Using
142             Else
143                 Return ""
144             End If
145         Catch ex As Exception
146             Return ""
147         End Try
148     End Function
149
150     Public Sub Initialize(ByVal token As String, ByVal tokenSecret As String, ByVal username As String)
151         'xAuth認証
152         If String.IsNullOrEmpty(token) OrElse String.IsNullOrEmpty(tokenSecret) OrElse String.IsNullOrEmpty(username) Then
153             Twitter.AccountState = ACCOUNT_STATE.Invalid
154         End If
155         TwitterApiInfo.Initialize()
156         twCon.Initialize(token, tokenSecret, username)
157         _uid = username.ToLower
158         _UserIdNo = ""
159     End Sub
160
161     Public Sub Initialize(ByVal username As String, ByVal password As String)
162         'BASIC認証
163         If String.IsNullOrEmpty(username) OrElse String.IsNullOrEmpty(password) Then
164             Twitter.AccountState = ACCOUNT_STATE.Invalid
165         End If
166         TwitterApiInfo.Initialize()
167         twCon.Initialize(username, password)
168         _uid = username.ToLower
169         _UserIdNo = ""
170     End Sub
171
172     Public Function PreProcessUrl(ByVal orgData As String) As String
173         Dim posl1 As Integer
174         Dim posl2 As Integer = 0
175         'Dim IDNConveter As IdnMapping = New IdnMapping()
176         Dim href As String = "<a href="""
177
178         Do While True
179             If orgData.IndexOf(href, posl2, StringComparison.Ordinal) > -1 Then
180                 Dim urlStr As String = ""
181                 ' IDN展開
182                 posl1 = orgData.IndexOf(href, posl2, StringComparison.Ordinal)
183                 posl1 += href.Length
184                 posl2 = orgData.IndexOf("""", posl1, StringComparison.Ordinal)
185                 urlStr = orgData.Substring(posl1, posl2 - posl1)
186
187                 If Not urlStr.StartsWith("http://") AndAlso Not urlStr.StartsWith("https://") AndAlso Not urlStr.StartsWith("ftp://") Then
188                     Continue Do
189                 End If
190
191                 Dim replacedUrl As String = IDNDecode(urlStr)
192                 If replacedUrl Is Nothing Then Continue Do
193                 If replacedUrl = urlStr Then Continue Do
194
195                 orgData = orgData.Replace("<a href=""" + urlStr, "<a href=""" + replacedUrl)
196                 posl2 = 0
197             Else
198                 Exit Do
199             End If
200         Loop
201         Return orgData
202     End Function
203
204     Private Function GetPlainText(ByVal orgData As String) As String
205         Return HttpUtility.HtmlDecode(Regex.Replace(orgData, "(?<tagStart><a [^>]+>)(?<text>[^<]+)(?<tagEnd></a>)", "${text}"))
206     End Function
207
208     ' htmlの簡易サニタイズ(詳細表示に不要なタグの除去)
209
210     Private Function SanitizeHtml(ByVal orgdata As String) As String
211         Dim retdata As String = orgdata
212
213         retdata = Regex.Replace(retdata, "<(script|object|applet|image|frameset|fieldset|legend|style).*" & _
214             "</(script|object|applet|image|frameset|fieldset|legend|style)>", "", RegexOptions.IgnoreCase)
215
216         retdata = Regex.Replace(retdata, "<(frame|link|iframe|img)>", "", RegexOptions.IgnoreCase)
217
218         Return retdata
219     End Function
220
221     Private Function AdjustHtml(ByVal orgData As String) As String
222         Dim retStr As String = orgData
223         Dim m As Match = Regex.Match(retStr, "<a [^>]+>[#|#](?<1>[a-zA-Z0-9_]+)</a>")
224         While m.Success
225             SyncLock LockObj
226                 _hashList.Add("#" + m.Groups(1).Value)
227             End SyncLock
228             m = m.NextMatch
229         End While
230         retStr = Regex.Replace(retStr, "<a [^>]*href=""/", "<a href=""" + _protocol + "twitter.com/")
231         retStr = retStr.Replace("<a href=", "<a target=""_self"" href=")
232         retStr = retStr.Replace(vbLf, "<br>")
233
234         '半角スペースを置換(Thanks @anis774)
235         Dim ret As Boolean = False
236         Do
237             ret = EscapeSpace(retStr)
238         Loop While Not ret
239
240         Return SanitizeHtml(retStr)
241     End Function
242
243     Private Function EscapeSpace(ByRef html As String) As Boolean
244         '半角スペースを置換(Thanks @anis774)
245         Dim isTag As Boolean = False
246         For i As Integer = 0 To html.Length - 1
247             If html(i) = "<"c Then
248                 isTag = True
249             End If
250             If html(i) = ">"c Then
251                 isTag = False
252             End If
253
254             If (Not isTag) AndAlso (html(i) = " "c) Then
255                 html = html.Remove(i, 1)
256                 html = html.Insert(i, "&nbsp;")
257                 Return False
258             End If
259         Next
260         Return True
261     End Function
262
263     'Private Sub GetIconImage(ByVal post As PostClass)
264     '    Dim img As Image
265
266     '    Try
267     '        If Not _getIcon Then
268     '            post.ImageUrl = Nothing
269     '            TabInformations.GetInstance.AddPost(post)
270     '            Exit Sub
271     '        End If
272
273     '        If _dIcon.ContainsKey(post.ImageUrl) AndAlso _dIcon(post.ImageUrl) IsNot Nothing Then
274     '            TabInformations.GetInstance.AddPost(post)
275     '            Exit Sub
276     '        End If
277
278     '        Dim httpVar As New HttpVarious
279     '        img = httpVar.GetImage(post.ImageUrl, 10000)
280     '        If img Is Nothing Then
281     '            _dIcon.Add(post.ImageUrl, Nothing)
282     '            TabInformations.GetInstance.AddPost(post)
283     '            Exit Sub
284     '        End If
285
286     '        If _endingFlag Then Exit Sub
287
288     '        SyncLock LockObj
289     '            If Not _dIcon.ContainsKey(post.ImageUrl) Then
290     '                Try
291     '                    _dIcon.Add(post.ImageUrl, img)
292     '                Catch ex As InvalidOperationException
293     '                    'タイミングにより追加できない場合がある?(キー重複ではない)
294     '                    post.ImageUrl = Nothing
295     '                Catch ex As System.OverflowException
296     '                    '不正なアイコン?DrawImageに失敗する場合あり
297     '                    post.ImageUrl = Nothing
298     '                Catch ex As OutOfMemoryException
299     '                    'DrawImageで発生
300     '                    post.ImageUrl = Nothing
301     '                End Try
302     '            End If
303     '        End SyncLock
304     '        TabInformations.GetInstance.AddPost(post)
305     '    Catch ex As ArgumentException
306     '        'タイミングによってはキー重複
307     '    Finally
308     '        img = Nothing
309     '        post = Nothing
310     '    End Try
311     'End Sub
312
313     Private Structure PostInfo
314         Public CreatedAt As String
315         Public Id As String
316         Public Text As String
317         Public UserId As String
318         Public Sub New(ByVal Created As String, ByVal IdStr As String, ByVal txt As String, ByVal uid As String)
319             CreatedAt = Created
320             Id = IdStr
321             Text = txt
322             UserId = uid
323         End Sub
324         Public Shadows Function Equals(ByVal dst As PostInfo) As Boolean
325             If Me.CreatedAt = dst.CreatedAt AndAlso Me.Id = dst.Id AndAlso Me.Text = dst.Text AndAlso Me.UserId = dst.UserId Then
326                 Return True
327             Else
328                 Return False
329             End If
330         End Function
331     End Structure
332
333     Private Function IsPostRestricted(ByVal status As TwitterDataModel.Status) As Boolean
334         Static _prev As New PostInfo("", "", "", "")
335         Dim _current As New PostInfo("", "", "", "")
336
337         _current.CreatedAt = status.CreatedAt
338         _current.Id = status.IdStr
339         If status.Text Is Nothing Then
340             _current.Text = ""
341         Else
342             _current.Text = status.Text
343         End If
344         _current.UserId = status.User.IdStr
345
346         If _current.Equals(_prev) Then
347             Return True
348         End If
349         _prev.CreatedAt = _current.CreatedAt
350         _prev.Id = _current.Id
351         _prev.Text = _current.Text
352         _prev.UserId = _current.UserId
353
354         Return False
355     End Function
356
357     Public Function PostStatus(ByVal postStr As String, ByVal reply_to As Long) As String
358
359         If _endingFlag Then Return ""
360
361         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
362
363         postStr = postStr.Trim()
364
365         If Regex.Match(postStr, "^DM? +(?<id>[a-zA-Z0-9_]+) +(?<body>.+)", RegexOptions.IgnoreCase Or RegexOptions.Singleline).Success Then
366             Return SendDirectMessage(postStr)
367         End If
368
369         Dim res As HttpStatusCode
370         Dim content As String = ""
371         Try
372             res = twCon.UpdateStatus(postStr, reply_to, content)
373         Catch ex As Exception
374             Return "Err:" + ex.Message
375         End Try
376
377         Select Case res
378             Case HttpStatusCode.OK
379                 Twitter.AccountState = ACCOUNT_STATE.Valid
380                 Dim status As TwitterDataModel.Status
381                 Try
382                     status = CreateDataFromJson(Of TwitterDataModel.Status)(content)
383                 Catch ex As SerializationException
384                     TraceOut(ex.Message + Environment.NewLine + content)
385                     Return "Err:Json Parse Error(DataContractJsonSerializer)"
386                 Catch ex As Exception
387                     TraceOut(content)
388                     Return "Err:Invalid Json!"
389                 End Try
390                 _followersCount = status.User.FollowersCount
391                 _friendsCount = status.User.FriendsCount
392                 _statusesCount = status.User.StatusesCount
393                 _location = status.User.Location
394                 _bio = status.User.Description
395                 _UserIdNo = status.User.IdStr
396
397                 If IsPostRestricted(status) Then
398                     Return "OK:Delaying?"
399                 End If
400                 If op.Post(postStr.Length) Then
401                     Return ""
402                 Else
403                     Return "Outputz:Failed"
404                 End If
405             Case HttpStatusCode.Forbidden, HttpStatusCode.BadRequest
406                 Dim errMsg As String = GetErrorMessageJson(content)
407                 If String.IsNullOrEmpty(errMsg) Then
408                     Return "Warn:" + res.ToString
409                 Else
410                     Return "Warn:" + errMsg
411                 End If
412             Case HttpStatusCode.Conflict, _
413                 HttpStatusCode.ExpectationFailed, _
414                 HttpStatusCode.Gone, _
415                 HttpStatusCode.LengthRequired, _
416                 HttpStatusCode.MethodNotAllowed, _
417                 HttpStatusCode.NotAcceptable, _
418                 HttpStatusCode.NotFound, _
419                 HttpStatusCode.PaymentRequired, _
420                 HttpStatusCode.PreconditionFailed, _
421                 HttpStatusCode.RequestedRangeNotSatisfiable, _
422                 HttpStatusCode.RequestEntityTooLarge, _
423                 HttpStatusCode.RequestTimeout, _
424                 HttpStatusCode.RequestUriTooLong
425                 '仕様書にない400系エラー。サーバまでは到達しているのでリトライしない
426                 Return "Warn:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
427             Case HttpStatusCode.Unauthorized
428                 Twitter.AccountState = ACCOUNT_STATE.Invalid
429                 Dim errMsg As String = GetErrorMessageJson(content)
430                 If String.IsNullOrEmpty(errMsg) Then
431                     Return "Check your Username/Password."
432                 Else
433                     Return "Auth err:" + errMsg
434                 End If
435             Case Else
436                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
437         End Select
438     End Function
439
440     Public Function SendDirectMessage(ByVal postStr As String) As String
441
442         If _endingFlag Then Return ""
443
444         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
445
446         postStr = postStr.Trim()
447
448         Dim res As HttpStatusCode
449         Dim content As String = ""
450
451         Dim mc As Match = Regex.Match(postStr, "^DM? +(?<id>[a-zA-Z0-9_]+) +(?<body>.+)", RegexOptions.IgnoreCase Or RegexOptions.Singleline)
452
453         Try
454             res = twCon.SendDirectMessage(mc.Groups("body").Value, mc.Groups("id").Value, content)
455         Catch ex As Exception
456             Return "Err:" + ex.Message
457         End Try
458
459         Select Case res
460             Case HttpStatusCode.OK
461                 Twitter.AccountState = ACCOUNT_STATE.Valid
462                 Dim status As TwitterDataModel.Directmessage
463                 Try
464                     status = CreateDataFromJson(Of TwitterDataModel.Directmessage)(content)
465                 Catch ex As SerializationException
466                     TraceOut(ex.Message + Environment.NewLine + content)
467                     Return "Err:Json Parse Error(DataContractJsonSerializer)"
468                 Catch ex As Exception
469                     TraceOut(content)
470                     Return "Err:Invalid Json!"
471                 End Try
472                 _followersCount = status.Sender.FollowersCount
473                 _friendsCount = status.Sender.FriendsCount
474                 _statusesCount = status.Sender.StatusesCount
475                 _location = status.Sender.Location
476                 _bio = status.Sender.Description
477                 _UserIdNo = status.Sender.IdStr
478
479                 If op.Post(postStr.Length) Then
480                     Return ""
481                 Else
482                     Return "Outputz:Failed"
483                 End If
484             Case HttpStatusCode.Forbidden, HttpStatusCode.BadRequest
485                 Dim errMsg As String = GetErrorMessageJson(content)
486                 If String.IsNullOrEmpty(errMsg) Then
487                     Return "Warn:" + res.ToString
488                 Else
489                     Return "Warn:" + errMsg
490                 End If
491             Case HttpStatusCode.Conflict, _
492                 HttpStatusCode.ExpectationFailed, _
493                 HttpStatusCode.Gone, _
494                 HttpStatusCode.LengthRequired, _
495                 HttpStatusCode.MethodNotAllowed, _
496                 HttpStatusCode.NotAcceptable, _
497                 HttpStatusCode.NotFound, _
498                 HttpStatusCode.PaymentRequired, _
499                 HttpStatusCode.PreconditionFailed, _
500                 HttpStatusCode.RequestedRangeNotSatisfiable, _
501                 HttpStatusCode.RequestEntityTooLarge, _
502                 HttpStatusCode.RequestTimeout, _
503                 HttpStatusCode.RequestUriTooLong
504                 '仕様書にない400系エラー。サーバまでは到達しているのでリトライしない
505                 Return "Warn:" + res.ToString
506             Case HttpStatusCode.Unauthorized
507                 Twitter.AccountState = ACCOUNT_STATE.Invalid
508                 Dim errMsg As String = GetErrorMessageJson(content)
509                 If String.IsNullOrEmpty(errMsg) Then
510                     Return "Check your Username/Password."
511                 Else
512                     Return "Auth err:" + errMsg
513                 End If
514             Case Else
515                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
516         End Select
517     End Function
518
519     Public Function RemoveStatus(ByVal id As Long) As String
520         If _endingFlag Then Return ""
521
522         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
523
524         Dim res As HttpStatusCode
525
526         Try
527             res = twCon.DestroyStatus(id)
528         Catch ex As Exception
529             Return "Err:" + ex.Message
530         End Try
531
532         Select Case res
533             Case HttpStatusCode.OK
534                 Twitter.AccountState = ACCOUNT_STATE.Valid
535                 Return ""
536             Case HttpStatusCode.Unauthorized
537                 Twitter.AccountState = ACCOUNT_STATE.Invalid
538                 Return "Check your Username/Password."
539             Case HttpStatusCode.NotFound
540                 Return ""
541             Case Else
542                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
543         End Select
544
545     End Function
546
547     Public Function PostRetweet(ByVal id As Long, ByVal read As Boolean) As String
548         If _endingFlag Then Return ""
549         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
550
551         'データ部分の生成
552         Dim target As Long = id
553         If TabInformations.GetInstance.Item(id).RetweetedId > 0 Then
554             target = TabInformations.GetInstance.Item(id).RetweetedId '再RTの場合は元発言をRT
555         End If
556
557         Dim res As HttpStatusCode
558         Dim content As String = ""
559         Try
560             res = twCon.RetweetStatus(target, content)
561         Catch ex As Exception
562             Return "Err:" + ex.Message
563         End Try
564
565         Select Case res
566             Case HttpStatusCode.Unauthorized
567                 Twitter.AccountState = ACCOUNT_STATE.Invalid
568                 Return "Check your Username/Password."
569             Case Is <> HttpStatusCode.OK
570                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
571         End Select
572
573         Twitter.AccountState = ACCOUNT_STATE.Valid
574
575         'Dim dlgt As GetIconImageDelegate    'countQueryに合わせる
576         'Dim ar As IAsyncResult              'countQueryに合わせる
577         Dim xdoc As New XmlDocument
578         Try
579             xdoc.LoadXml(content)
580         Catch ex As Exception
581             TraceOut(content)
582             'MessageBox.Show("不正なXMLです。(TL-LoadXml)")
583             Return "Invalid XML!"
584         End Try
585
586         'ReTweetしたものをTLに追加
587         Dim xentryNode As XmlNode = xdoc.DocumentElement.SelectSingleNode("/status")
588         If xentryNode Is Nothing Then Return "Invalid XML!"
589         Dim xentry As XmlElement = CType(xentryNode, XmlElement)
590         Dim post As New PostClass
591         Try
592             post.Id = Long.Parse(xentry.Item("id").InnerText)
593             '二重取得回避
594             SyncLock LockObj
595                 If TabInformations.GetInstance.ContainsKey(post.Id) Then Return ""
596             End SyncLock
597             'Retweet判定
598             Dim xRnode As XmlNode = xentry.SelectSingleNode("./retweeted_status")
599             If xRnode Is Nothing Then Return "Invalid XML!"
600
601             Dim xRentry As XmlElement = CType(xRnode, XmlElement)
602             post.PDate = DateTime.ParseExact(xRentry.Item("created_at").InnerText, "ddd MMM dd HH:mm:ss zzzz yyyy", System.Globalization.DateTimeFormatInfo.InvariantInfo, System.Globalization.DateTimeStyles.None)
603             'Id
604             post.RetweetedId = Long.Parse(xRentry.Item("id").InnerText)
605             '本文
606             post.Data = xRentry.Item("text").InnerText
607             'Source取得(htmlの場合は、中身を取り出し)
608             post.Source = xRentry.Item("source").InnerText
609             'Reply先
610             Long.TryParse(xRentry.Item("in_reply_to_status_id").InnerText, post.InReplyToId)
611             post.InReplyToUser = xRentry.Item("in_reply_to_screen_name").InnerText
612             post.IsFav = TabInformations.GetInstance.GetTabByType(TabUsageType.Favorites).Contains(post.RetweetedId)
613
614             '以下、ユーザー情報
615             Dim xRUentry As XmlElement = CType(xRentry.SelectSingleNode("./user"), XmlElement)
616             post.Uid = Long.Parse(xRUentry.Item("id").InnerText)
617             post.Name = xRUentry.Item("screen_name").InnerText
618             post.Nickname = xRUentry.Item("name").InnerText
619             post.ImageUrl = xRUentry.Item("profile_image_url").InnerText
620             post.IsProtect = Boolean.Parse(xRUentry.Item("protected").InnerText)
621             post.IsMe = True
622
623             'Retweetした人(自分のはず)
624             Dim xUentry As XmlElement = CType(xentry.SelectSingleNode("./user"), XmlElement)
625             post.RetweetedBy = xUentry.Item("screen_name").InnerText
626
627             'HTMLに整形
628             post.OriginalData = CreateHtmlAnchor(post.Data, post.ReplyToList)
629             post.Data = HttpUtility.HtmlDecode(post.Data)
630             post.Data = post.Data.Replace("<3", "♡")
631             'Source整形
632             CreateSource(post)
633
634             post.IsRead = read
635             post.IsReply = post.ReplyToList.Contains(_uid)
636             post.IsExcludeReply = False
637
638             If post.IsMe Then
639                 post.IsOwl = False
640             Else
641                 If followerId.Count > 0 Then post.IsOwl = Not followerId.Contains(post.Uid)
642             End If
643             If post.IsMe AndAlso _readOwnPost Then post.IsRead = True
644
645             post.IsDm = False
646         Catch ex As Exception
647             TraceOut(content)
648             'MessageBox.Show("不正なXMLです。(TL-Parse)")
649             Return "Invalid XML!"
650         End Try
651
652         'Me._dIcon.Add(post.ImageUrl, Nothing)
653         TabInformations.GetInstance.AddPost(post)
654
655         ''非同期アイコン取得&StatusDictionaryに追加
656         'dlgt = New GetIconImageDelegate(AddressOf GetIconImage)
657         'ar = dlgt.BeginInvoke(post, Nothing, Nothing)
658
659         ''アイコン取得完了待ち
660         'Try
661         '    dlgt.EndInvoke(ar)
662         'Catch ex As Exception
663         '    '最後までendinvoke回す(ゾンビ化回避)
664         '    ex.Data("IsTerminatePermission") = False
665         '    Throw
666         'End Try
667
668         Return ""
669     End Function
670
671     Public Function RemoveDirectMessage(ByVal id As Long, ByVal post As PostClass) As String
672         If _endingFlag Then Return ""
673
674         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
675
676         Dim res As HttpStatusCode
677
678         If post.IsMe Then
679             _deletemessages.Add(post)
680         End If
681         Try
682             res = twCon.DestroyDirectMessage(id)
683         Catch ex As Exception
684             Return "Err:" + ex.Message
685         End Try
686
687         Select Case res
688             Case HttpStatusCode.OK
689                 Twitter.AccountState = ACCOUNT_STATE.Valid
690                 Return ""
691             Case HttpStatusCode.Unauthorized
692                 Twitter.AccountState = ACCOUNT_STATE.Invalid
693                 Return "Check your Username/Password."
694             Case HttpStatusCode.NotFound
695                 Return ""
696             Case Else
697                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
698         End Select
699     End Function
700
701     Public Function PostFollowCommand(ByVal screenName As String) As String
702
703         If _endingFlag Then Return ""
704
705         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
706
707         Dim res As HttpStatusCode
708         Dim content As String = ""
709
710         Try
711             res = twCon.CreateFriendships(screenName, content)
712         Catch ex As Exception
713             Return "Err:" + ex.Message
714         End Try
715
716         Select Case res
717             Case HttpStatusCode.OK
718                 Twitter.AccountState = ACCOUNT_STATE.Valid
719                 Return ""
720             Case HttpStatusCode.Unauthorized
721                 Twitter.AccountState = ACCOUNT_STATE.Invalid
722                 Return "Check your Username/Password."
723             Case HttpStatusCode.Forbidden
724                 Dim xd As XmlDocument = New XmlDocument
725                 Try
726                     xd.LoadXml(content)
727                     Dim xNode As XmlNode = Nothing
728                     xNode = xd.SelectSingleNode("/hash/error")
729                     Return "Err:" + xNode.InnerText + "(" + GetCurrentMethod.Name + ")"
730                 Catch ex As Exception
731                     Return "Err:Forbidden" + "(" + GetCurrentMethod.Name + ")"
732                 End Try
733             Case Else
734                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
735         End Select
736     End Function
737
738     Public Function PostRemoveCommand(ByVal screenName As String) As String
739
740         If _endingFlag Then Return ""
741
742         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
743
744         Dim res As HttpStatusCode
745         Dim content As String = ""
746
747         Try
748             res = twCon.DestroyFriendships(screenName, content)
749         Catch ex As Exception
750             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
751         End Try
752
753         Select Case res
754             Case HttpStatusCode.OK
755                 Twitter.AccountState = ACCOUNT_STATE.Valid
756                 Return ""
757             Case HttpStatusCode.Unauthorized
758                 Twitter.AccountState = ACCOUNT_STATE.Invalid
759                 Return "Check your Username/Password."
760             Case HttpStatusCode.Forbidden
761                 Dim xd As XmlDocument = New XmlDocument
762                 Try
763                     xd.LoadXml(content)
764                     Dim xNode As XmlNode = Nothing
765                     xNode = xd.SelectSingleNode("/hash/error")
766                     Return "Err:" + xNode.InnerText + "(" + GetCurrentMethod.Name + ")"
767                 Catch ex As Exception
768                     Return "Err:Forbidden" + "(" + GetCurrentMethod.Name + ")"
769                 End Try
770             Case Else
771                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
772         End Select
773     End Function
774
775     Public Function PostCreateBlock(ByVal screenName As String) As String
776
777         If _endingFlag Then Return ""
778
779         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
780
781         Dim res As HttpStatusCode
782         Dim content As String = ""
783
784         Try
785             res = twCon.CreateBlock(screenName, content)
786         Catch ex As Exception
787             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
788         End Try
789
790         Select Case res
791             Case HttpStatusCode.OK
792                 Twitter.AccountState = ACCOUNT_STATE.Valid
793                 Return ""
794             Case HttpStatusCode.Unauthorized
795                 Twitter.AccountState = ACCOUNT_STATE.Invalid
796                 Return "Check your Username/Password."
797             Case HttpStatusCode.Forbidden
798                 Dim xd As XmlDocument = New XmlDocument
799                 Try
800                     xd.LoadXml(content)
801                     Dim xNode As XmlNode = Nothing
802                     xNode = xd.SelectSingleNode("/hash/error")
803                     Return "Err:" + xNode.InnerText + "(" + GetCurrentMethod.Name + ")"
804                 Catch ex As Exception
805                     Return "Err:Forbidden" + "(" + GetCurrentMethod.Name + ")"
806                 End Try
807             Case Else
808                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
809         End Select
810     End Function
811
812     Public Function PostDestroyBlock(ByVal screenName As String) As String
813
814         If _endingFlag Then Return ""
815
816         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
817
818         Dim res As HttpStatusCode
819         Dim content As String = ""
820
821         Try
822             res = twCon.DestroyBlock(screenName, content)
823         Catch ex As Exception
824             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
825         End Try
826
827         Select Case res
828             Case HttpStatusCode.OK
829                 Twitter.AccountState = ACCOUNT_STATE.Valid
830                 Return ""
831             Case HttpStatusCode.Unauthorized
832                 Twitter.AccountState = ACCOUNT_STATE.Invalid
833                 Return "Check your Username/Password."
834             Case HttpStatusCode.Forbidden
835                 Dim xd As XmlDocument = New XmlDocument
836                 Try
837                     xd.LoadXml(content)
838                     Dim xNode As XmlNode = Nothing
839                     xNode = xd.SelectSingleNode("/hash/error")
840                     Return "Err:" + xNode.InnerText + "(" + GetCurrentMethod.Name + ")"
841                 Catch ex As Exception
842                     Return "Err:Forbidden" + "(" + GetCurrentMethod.Name + ")"
843                 End Try
844             Case Else
845                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
846         End Select
847     End Function
848
849     Public Function PostReportSpam(ByVal screenName As String) As String
850
851         If _endingFlag Then Return ""
852
853         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
854
855         Dim res As HttpStatusCode
856         Dim content As String = ""
857
858         Try
859             res = twCon.ReportSpam(screenName, content)
860         Catch ex As Exception
861             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
862         End Try
863
864         Select Case res
865             Case HttpStatusCode.OK
866                 Twitter.AccountState = ACCOUNT_STATE.Valid
867                 Return ""
868             Case HttpStatusCode.Unauthorized
869                 Twitter.AccountState = ACCOUNT_STATE.Invalid
870                 Return "Check your Username/Password."
871             Case HttpStatusCode.Forbidden
872                 Dim xd As XmlDocument = New XmlDocument
873                 Try
874                     xd.LoadXml(content)
875                     Dim xNode As XmlNode = Nothing
876                     xNode = xd.SelectSingleNode("/hash/error")
877                     Return "Err:" + xNode.InnerText + "(" + GetCurrentMethod.Name + ")"
878                 Catch ex As Exception
879                     Return "Err:Forbidden" + "(" + GetCurrentMethod.Name + ")"
880                 End Try
881             Case Else
882                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
883         End Select
884     End Function
885
886     Public Function GetFriendshipInfo(ByVal screenName As String, ByRef isFollowing As Boolean, ByRef isFollowed As Boolean) As String
887
888         If _endingFlag Then Return ""
889
890         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
891
892         Dim res As HttpStatusCode
893         Dim content As String = ""
894         Try
895             res = twCon.ShowFriendships(_uid, screenName, content)
896         Catch ex As Exception
897             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
898         End Try
899
900         Select Case res
901             Case HttpStatusCode.OK
902                 Dim xdoc As New XmlDocument
903                 Dim result As String = ""
904                 Twitter.AccountState = ACCOUNT_STATE.Valid
905                 Try
906                     xdoc.LoadXml(content)
907                     isFollowing = Boolean.Parse(xdoc.SelectSingleNode("/relationship/source/following").InnerText)
908                     isFollowed = Boolean.Parse(xdoc.SelectSingleNode("/relationship/source/followed_by").InnerText)
909                 Catch ex As Exception
910                     result = "Err:Invalid XML."
911                 End Try
912                 Return result
913             Case HttpStatusCode.BadRequest
914                 Return "Err:API Limits?"
915             Case HttpStatusCode.Unauthorized
916                 Twitter.AccountState = ACCOUNT_STATE.Invalid
917                 Return "Check your Username/Password."
918             Case Else
919                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
920         End Select
921     End Function
922
923     Public Function GetUserInfo(ByVal screenName As String, ByRef user As TwitterDataModel.User) As String
924
925         If _endingFlag Then Return ""
926
927         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
928
929         Dim res As HttpStatusCode
930         Dim content As String = ""
931         user = Nothing
932         Try
933             res = twCon.ShowUserInfo(screenName, content)
934         Catch ex As Exception
935             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
936         End Try
937
938         Select Case res
939             Case HttpStatusCode.OK
940                 Twitter.AccountState = ACCOUNT_STATE.Valid
941                 Try
942                     user = CreateDataFromJson(Of TwitterDataModel.User)(content)
943                 Catch ex As SerializationException
944                     TraceOut(ex.Message + Environment.NewLine + content)
945                     Return "Err:Json Parse Error(DataContractJsonSerializer)"
946                 Catch ex As Exception
947                     TraceOut(content)
948                     Return "Err:Invalid Json!"
949                 End Try
950                 Return ""
951             Case HttpStatusCode.BadRequest
952                 Return "Err:API Limits?"
953             Case HttpStatusCode.Unauthorized
954                 Twitter.AccountState = ACCOUNT_STATE.Invalid
955                 Dim errMsg As String = GetErrorMessageJson(content)
956                 If String.IsNullOrEmpty(errMsg) Then
957                     Return "Check your Username/Password."
958                 Else
959                     Return "Auth err:" + errMsg
960                 End If
961             Case Else
962                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
963         End Select
964     End Function
965
966     Public Function GetStatus_Retweeted_Count(ByVal StatusId As Long, ByRef retweeted_count As Integer) As String
967
968         If _endingFlag Then Return ""
969
970         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
971
972         Dim res As HttpStatusCode
973         Dim content As String = ""
974         Dim xmlBuf As String = ""
975
976         retweeted_count = 0
977
978         ' 注:dev.twitter.comに記述されているcountパラメータは間違い。100が正しい
979         For i As Integer = 1 To 100
980
981             Try
982                 res = twCon.Statusid_retweeted_by_ids(StatusId, 100, i, content)
983             Catch ex As Exception
984                 Return "Err:" + ex.Message
985             End Try
986
987             Select Case res
988                 Case HttpStatusCode.OK
989                     Dim xdoc As New XmlDocument
990                     Dim xnode As XmlNodeList
991                     Dim result As String = ""
992                     Twitter.AccountState = ACCOUNT_STATE.Valid
993                     Try
994                         xdoc.LoadXml(content)
995                         xnode = xdoc.GetElementsByTagName("ids")
996                         retweeted_count += xnode.ItemOf(0).ChildNodes.Count
997                         If xnode.ItemOf(0).ChildNodes.Count < 100 Then Exit For
998                     Catch ex As Exception
999                         retweeted_count = -1
1000                         result = "Err:Invalid XML."
1001                         xmlBuf = Nothing
1002                     End Try
1003                 Case HttpStatusCode.BadRequest
1004                     retweeted_count = -1
1005                     Return "Err:API Limits?"
1006                 Case HttpStatusCode.Unauthorized
1007                     retweeted_count = -1
1008                     Twitter.AccountState = ACCOUNT_STATE.Invalid
1009                     Return "Check your Username/Password."
1010                 Case Else
1011                     retweeted_count = -1
1012                     Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
1013             End Select
1014         Next
1015         Return ""
1016     End Function
1017
1018     Public Function PostFavAdd(ByVal id As Long) As String
1019         If _endingFlag Then Return ""
1020
1021         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
1022
1023         Dim res As HttpStatusCode
1024         Dim content As String = ""
1025         Try
1026             res = twCon.CreateFavorites(id, content)
1027         Catch ex As Exception
1028             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
1029         End Try
1030
1031         Select Case res
1032             Case HttpStatusCode.OK
1033                 Twitter.AccountState = ACCOUNT_STATE.Valid
1034                 If Not _restrictFavCheck Then Return ""
1035             Case HttpStatusCode.Unauthorized
1036                 Twitter.AccountState = ACCOUNT_STATE.Invalid
1037                 Return "Check your Username/Password."
1038             Case HttpStatusCode.Forbidden
1039                 Dim xd As XmlDocument = New XmlDocument
1040                 Try
1041                     xd.LoadXml(content)
1042                     Dim xNode As XmlNode = Nothing
1043                     xNode = xd.SelectSingleNode("/hash/error")
1044                     Return "Err:" + xNode.InnerText + "(" + GetCurrentMethod.Name + ")"
1045                 Catch ex As Exception
1046                     Return "Err:Forbidden" + "(" + GetCurrentMethod.Name + ")"
1047                 End Try
1048             Case Else
1049                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
1050         End Select
1051
1052         'http://twitter.com/statuses/show/id.xml APIを発行して本文を取得
1053
1054         'Dim content As String = ""
1055         content = ""
1056         Try
1057             res = twCon.ShowStatuses(id, content)
1058         Catch ex As Exception
1059             Return "Err:" + ex.Message
1060         End Try
1061
1062         Select Case res
1063             Case HttpStatusCode.OK
1064                 Twitter.AccountState = ACCOUNT_STATE.Valid
1065                 Try
1066                     Using rd As Xml.XmlTextReader = New Xml.XmlTextReader(New System.IO.StringReader(content))
1067                         rd.Read()
1068                         While rd.EOF = False
1069                             If rd.IsStartElement("favorited") Then
1070                                 If rd.ReadElementContentAsBoolean() = True Then
1071                                     Return ""  '正常にふぁぼれている
1072                                 Else
1073                                     Return "NG(Restricted?)"  '正常応答なのにふぁぼれてないので制限っぽい
1074                                 End If
1075                             Else
1076                                 rd.Read()
1077                             End If
1078                         End While
1079                         rd.Close()
1080                         Return "Err:Invalid XML!"
1081                     End Using
1082                 Catch ex As XmlException
1083                     Return ""
1084                 End Try
1085             Case HttpStatusCode.Unauthorized
1086                 Twitter.AccountState = ACCOUNT_STATE.Invalid
1087                 Return "Check your Username/Password."
1088             Case HttpStatusCode.BadRequest
1089                 Return "Err:API Limits?"
1090             Case Else
1091                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
1092         End Select
1093
1094     End Function
1095
1096     Public Function PostFavRemove(ByVal id As Long) As String
1097         If _endingFlag Then Return ""
1098
1099         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
1100
1101         Dim res As HttpStatusCode
1102         Dim content As String = ""
1103         Try
1104             res = twCon.DestroyFavorites(id, content)
1105         Catch ex As Exception
1106             Return "Err:" + ex.Message
1107         End Try
1108
1109         Select Case res
1110             Case HttpStatusCode.OK
1111                 Twitter.AccountState = ACCOUNT_STATE.Valid
1112                 Return ""
1113             Case HttpStatusCode.Unauthorized
1114                 Twitter.AccountState = ACCOUNT_STATE.Invalid
1115                 Return "Check your Username/Password."
1116             Case HttpStatusCode.Forbidden
1117                 Dim xd As XmlDocument = New XmlDocument
1118                 Try
1119                     xd.LoadXml(content)
1120                     Dim xNode As XmlNode = Nothing
1121                     xNode = xd.SelectSingleNode("/hash/error")
1122                     Return "Err:" + xNode.InnerText
1123                 Catch ex As Exception
1124                     Return "Err:Forbidden"
1125                 End Try
1126             Case Else
1127                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
1128         End Select
1129     End Function
1130
1131     Public Function PostUpdateProfile(ByVal name As String, ByVal url As String, ByVal location As String, ByVal description As String) As String
1132         If _endingFlag Then Return ""
1133
1134         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
1135
1136         Dim res As HttpStatusCode
1137         Dim content As String = ""
1138         Try
1139             res = twCon.UpdateProfile(name, url, location, description, content)
1140         Catch ex As Exception
1141             Return "Err:" + ex.Message
1142         End Try
1143
1144         Select Case res
1145             Case HttpStatusCode.OK
1146                 Twitter.AccountState = ACCOUNT_STATE.Valid
1147                 Return ""
1148             Case HttpStatusCode.Unauthorized
1149                 Twitter.AccountState = ACCOUNT_STATE.Invalid
1150                 Return "Check your Username/Password."
1151             Case HttpStatusCode.Forbidden
1152                 Dim xd As XmlDocument = New XmlDocument
1153                 Try
1154                     xd.LoadXml(content)
1155                     Dim xNode As XmlNode = Nothing
1156                     xNode = xd.SelectSingleNode("/hash/error")
1157                     Return "Err:" + xNode.InnerText + "(" + GetCurrentMethod.Name + ")"
1158                 Catch ex As Exception
1159                     Return "Err:Forbidden" + "(" + GetCurrentMethod.Name + ")"
1160                 End Try
1161             Case Else
1162                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
1163         End Select
1164     End Function
1165
1166     Public Function PostUpdateProfileImage(ByVal filename As String) As String
1167         If _endingFlag Then Return ""
1168
1169         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
1170
1171         Dim res As HttpStatusCode
1172         Dim content As String = ""
1173         Try
1174             res = twCon.UpdateProfileImage(New FileInfo(filename), content)
1175         Catch ex As Exception
1176             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
1177         End Try
1178
1179         Select Case res
1180             Case HttpStatusCode.OK
1181                 Twitter.AccountState = ACCOUNT_STATE.Valid
1182                 Return ""
1183             Case HttpStatusCode.Unauthorized
1184                 Twitter.AccountState = ACCOUNT_STATE.Invalid
1185                 Return "Check your Username/Password."
1186             Case HttpStatusCode.Forbidden
1187                 Dim xd As XmlDocument = New XmlDocument
1188                 Try
1189                     xd.LoadXml(content)
1190                     Dim xNode As XmlNode = Nothing
1191                     xNode = xd.SelectSingleNode("/hash/error")
1192                     Return "Err:" + xNode.InnerText + "(" + GetCurrentMethod.Name + ")"
1193                 Catch ex As Exception
1194                     Return "Err:Forbidden" + "(" + GetCurrentMethod.Name + ")"
1195                 End Try
1196             Case Else
1197                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
1198         End Select
1199     End Function
1200
1201     Public ReadOnly Property Username() As String
1202         Get
1203             Return twCon.AuthenticatedUsername
1204         End Get
1205     End Property
1206
1207     Public ReadOnly Property Password() As String
1208         Get
1209             Return twCon.Password
1210         End Get
1211     End Property
1212
1213     Private Shared _accountState As ACCOUNT_STATE = ACCOUNT_STATE.Valid
1214     Public Shared Property AccountState() As ACCOUNT_STATE
1215         Get
1216             Return _accountState
1217         End Get
1218         Set(ByVal value As ACCOUNT_STATE)
1219             _accountState = value
1220         End Set
1221     End Property
1222
1223     Public WriteOnly Property GetIcon() As Boolean
1224         Set(ByVal value As Boolean)
1225             _getIcon = value
1226         End Set
1227     End Property
1228
1229     Public WriteOnly Property TinyUrlResolve() As Boolean
1230         Set(ByVal value As Boolean)
1231             _tinyUrlResolve = value
1232         End Set
1233     End Property
1234
1235     Public WriteOnly Property RestrictFavCheck() As Boolean
1236         Set(ByVal value As Boolean)
1237             _restrictFavCheck = value
1238         End Set
1239     End Property
1240
1241     Public WriteOnly Property IconSize() As Integer
1242         Set(ByVal value As Integer)
1243             _iconSz = value
1244         End Set
1245     End Property
1246
1247 #Region "バージョンアップ"
1248     Public Function GetVersionInfo() As String
1249         Dim content As String = ""
1250         If Not (New HttpVarious).GetData("http://tween.sourceforge.jp/version2.txt?" + Now.ToString("yyMMddHHmmss") + Environment.TickCount.ToString(), Nothing, content) Then
1251             Throw New Exception("GetVersionInfo Failed")
1252         End If
1253         Return content
1254     End Function
1255
1256     Public Function GetTweenBinary(ByVal strVer As String) As String
1257         Try
1258             If Not (New HttpVarious).GetDataToFile("http://tween.sourceforge.jp/Tween" + strVer + ".gz?" + Now.ToString("yyMMddHHmmss") + Environment.TickCount.ToString(), _
1259                                                 Path.Combine(Application.StartupPath(), "TweenNew.exe")) Then
1260                 Return "Err:Download failed"
1261             End If
1262             If Directory.Exists(Path.Combine(Application.StartupPath(), "en")) = False Then
1263                 Directory.CreateDirectory(Path.Combine(Application.StartupPath(), "en"))
1264             End If
1265             If Not (New HttpVarious).GetDataToFile("http://tween.sourceforge.jp/TweenRes" + strVer + ".gz?" + Now.ToString("yyMMddHHmmss") + Environment.TickCount.ToString(), _
1266                                                 Path.Combine(Application.StartupPath(), "en\Tween.resourcesNew.dll")) Then
1267                 Return "Err:Download failed"
1268             End If
1269             If Not (New HttpVarious).GetDataToFile("http://tween.sourceforge.jp/TweenUp.gz?" + Now.ToString("yyMMddHHmmss") + Environment.TickCount.ToString(), _
1270                                                 Path.Combine(Application.StartupPath(), "TweenUp.exe")) Then
1271                 Return "Err:Download failed"
1272             End If
1273             If Not (New HttpVarious).GetDataToFile("http://tween.sourceforge.jp/TweenDll" + strVer + ".gz?" + Now.ToString("yyMMddHHmmss") + Environment.TickCount.ToString(), _
1274                                                 Path.Combine(Application.StartupPath(), "TweenNew.XmlSerializers.dll")) Then
1275                 Return "Err:Download failed"
1276             End If
1277             Return ""
1278         Catch ex As Exception
1279             Return "Err:Download failed"
1280         End Try
1281     End Function
1282 #End Region
1283
1284     Public Property DetailIcon() As IDictionary(Of String, Image)
1285         Get
1286             Return _dIcon
1287         End Get
1288         Set(ByVal value As IDictionary(Of String, Image))
1289             _dIcon = value
1290         End Set
1291     End Property
1292
1293     'Public WriteOnly Property CountApi() As Integer
1294     '    'API時の取得件数
1295     '    Set(ByVal value As Integer)
1296     '        _countApi = value
1297     '    End Set
1298     'End Property
1299
1300     'Public WriteOnly Property CountApiReply() As Integer
1301     '    'API時のMentions取得件数
1302     '    Set(ByVal value As Integer)
1303     '        _countApiReply = value
1304     '    End Set
1305     'End Property
1306
1307     Public Property ReadOwnPost() As Boolean
1308         Get
1309             Return _readOwnPost
1310         End Get
1311         Set(ByVal value As Boolean)
1312             _readOwnPost = value
1313         End Set
1314     End Property
1315
1316     Public ReadOnly Property FollowersCount() As Integer
1317         Get
1318             Return _followersCount
1319         End Get
1320     End Property
1321
1322     Public ReadOnly Property FriendsCount() As Integer
1323         Get
1324             Return _friendsCount
1325         End Get
1326     End Property
1327
1328     Public ReadOnly Property StatusesCount() As Integer
1329         Get
1330             Return _statusesCount
1331         End Get
1332     End Property
1333
1334     Public ReadOnly Property Location() As String
1335         Get
1336             Return _location
1337         End Get
1338     End Property
1339
1340     Public ReadOnly Property Bio() As String
1341         Get
1342             Return _bio
1343         End Get
1344     End Property
1345
1346     Public WriteOnly Property UseSsl() As Boolean
1347         Set(ByVal value As Boolean)
1348             HttpTwitter.UseSsl = value
1349             If value Then
1350                 _protocol = "https://"
1351             Else
1352                 _protocol = "http://"
1353             End If
1354         End Set
1355     End Property
1356
1357     Public Function GetTimelineApi(ByVal read As Boolean, _
1358                             ByVal gType As WORKERTYPE, _
1359                             ByVal more As Boolean, _
1360                             ByVal startup As Boolean) As String
1361
1362         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
1363
1364         If _endingFlag Then Return ""
1365
1366         Dim res As HttpStatusCode
1367         Dim content As String = ""
1368         Dim count As Integer = Setting.Instance.CountApi
1369         If gType = WORKERTYPE.Reply Then count = Setting.Instance.CountApiReply
1370         If Setting.Instance.UseAdditionalCount Then
1371             If more AndAlso Setting.Instance.MoreCountApi <> 0 Then
1372                 count = Setting.Instance.MoreCountApi
1373             ElseIf startup AndAlso Setting.Instance.FirstCountApi <> 0 AndAlso gType = WORKERTYPE.Timeline Then
1374                 count = Setting.Instance.FirstCountApi
1375             End If
1376         End If
1377         Try
1378             If gType = WORKERTYPE.Timeline Then
1379                 If more Then
1380                     res = twCon.HomeTimeline(count, Me.minHomeTimeline, 0, content)
1381                 Else
1382                     res = twCon.HomeTimeline(count, 0, 0, content)
1383                 End If
1384             Else
1385                 If more Then
1386                     res = twCon.Mentions(count, Me.minMentions, 0, content)
1387                 Else
1388                     res = twCon.Mentions(count, 0, 0, content)
1389                 End If
1390             End If
1391         Catch ex As Exception
1392             Return "Err:" + ex.Message
1393         End Try
1394         Select Case res
1395             Case HttpStatusCode.OK
1396                 Twitter.AccountState = ACCOUNT_STATE.Valid
1397             Case HttpStatusCode.Unauthorized
1398                 Twitter.AccountState = ACCOUNT_STATE.Invalid
1399                 Return "Check your Username/Password."
1400             Case HttpStatusCode.BadRequest
1401                 Return "Err:API Limits?"
1402             Case Else
1403                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
1404         End Select
1405
1406         If gType = WORKERTYPE.Timeline Then
1407             Return CreatePostsFromJson(content, gType, Nothing, read, count, Me.minHomeTimeline)
1408         Else
1409             Return CreatePostsFromJson(content, gType, Nothing, read, count, Me.minMentions)
1410         End If
1411     End Function
1412
1413     Public Function GetUserTimelineApi(ByVal read As Boolean,
1414                                        ByVal count As Integer,
1415                                        ByVal userName As String,
1416                                        ByVal tab As TabClass) As String
1417
1418         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
1419
1420         If _endingFlag Then Return ""
1421
1422         Dim res As HttpStatusCode
1423         Dim content As String = ""
1424
1425         If count = 0 Then count = 20
1426         Try
1427             If String.IsNullOrEmpty(userName) Then
1428                 Dim target As PostClass = tab.RelationTargetPost
1429                 If target Is Nothing Then Return ""
1430                 res = twCon.UserTimeline(target.Uid, "", count, 0, 0, content)
1431             Else
1432                 res = twCon.UserTimeline(0, userName, count, 0, 0, content)
1433             End If
1434         Catch ex As Exception
1435             Return "Err:" + ex.Message
1436         End Try
1437         Select Case res
1438             Case HttpStatusCode.OK
1439                 Twitter.AccountState = ACCOUNT_STATE.Valid
1440             Case HttpStatusCode.Unauthorized
1441                 Twitter.AccountState = ACCOUNT_STATE.Invalid
1442                 Return "Check your Username/Password."
1443             Case HttpStatusCode.BadRequest
1444                 Return "Err:API Limits?"
1445             Case Else
1446                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
1447         End Select
1448
1449         Dim items As List(Of TwitterDataModel.Status)
1450         Try
1451             items = CreateDataFromJson(Of List(Of TwitterDataModel.Status))(content)
1452         Catch ex As SerializationException
1453             TraceOut(ex.Message + Environment.NewLine + content)
1454             Return "Json Parse Error(DataContractJsonSerializer)"
1455         Catch ex As Exception
1456             TraceOut(content)
1457             Return "Invalid Json!"
1458         End Try
1459
1460         For Each status As TwitterDataModel.Status In items
1461             Dim item As PostClass = CreatePostsFromStatusData(status)
1462             If item Is Nothing Then Continue For
1463             item.IsRead = read
1464             If item.IsMe AndAlso Not read AndAlso _readOwnPost Then item.IsRead = True
1465             If tab IsNot Nothing Then item.RelTabName = tab.TabName
1466             '非同期アイコン取得&StatusDictionaryに追加
1467             TabInformations.GetInstance.AddPost(item)
1468         Next
1469
1470         Return ""
1471     End Function
1472
1473     Private Function CreatePostsFromStatusData(ByVal status As TwitterDataModel.Status) As PostClass
1474         Dim post As New PostClass
1475
1476         post.Id = status.Id
1477         If status.RetweetedStatus IsNot Nothing Then
1478             Dim retweeted As TwitterDataModel.RetweetedStatus = status.RetweetedStatus
1479
1480             post.PDate = DateTimeParse(retweeted.CreatedAt)
1481
1482             'Id
1483             post.RetweetedId = retweeted.Id
1484             '本文
1485             post.Data = retweeted.Text
1486             'Source取得(htmlの場合は、中身を取り出し)
1487             post.Source = retweeted.Source
1488             'Reply先
1489             Long.TryParse(retweeted.InReplyToStatusId, post.InReplyToId)
1490             post.InReplyToUser = retweeted.InReplyToScreenName
1491             post.IsFav = TabInformations.GetInstance.GetTabByType(TabUsageType.Favorites).Contains(post.RetweetedId)
1492
1493             '以下、ユーザー情報
1494             Dim user As TwitterDataModel.User = retweeted.User
1495
1496             post.Uid = user.Id
1497             post.Name = user.ScreenName
1498             post.Nickname = user.Name
1499             post.ImageUrl = user.ProfileImageUrl
1500             post.IsProtect = user.Protected
1501             If post.IsMe Then _UserIdNo = post.Uid.ToString()
1502
1503             'Retweetした人
1504             post.RetweetedBy = status.User.ScreenName
1505         Else
1506             post.PDate = DateTimeParse(status.CreatedAt)
1507             '本文
1508             post.Data = status.Text
1509             'Source取得(htmlの場合は、中身を取り出し)
1510             post.Source = status.Source
1511             Long.TryParse(status.InReplyToStatusId, post.InReplyToId)
1512             post.InReplyToUser = status.InReplyToScreenName
1513
1514             post.IsFav = status.Favorited
1515
1516             '以下、ユーザー情報
1517             Dim user As TwitterDataModel.User = status.User
1518
1519             post.Uid = user.Id
1520             post.Name = user.ScreenName
1521             post.Nickname = user.Name
1522             post.ImageUrl = user.ProfileImageUrl
1523             post.IsProtect = user.Protected
1524             post.IsMe = post.Name.ToLower.Equals(_uid)
1525             If post.IsMe Then _UserIdNo = post.Uid.ToString
1526         End If
1527         'HTMLに整形
1528         post.OriginalData = CreateHtmlAnchor(post.Data, post.ReplyToList)
1529         post.Data = HttpUtility.HtmlDecode(post.Data)
1530         post.Data = post.Data.Replace("<3", "♡")
1531         'Source整形
1532         CreateSource(post)
1533
1534         post.IsReply = post.ReplyToList.Contains(_uid)
1535         post.IsExcludeReply = False
1536
1537         If post.IsMe Then
1538             post.IsOwl = False
1539         Else
1540             If followerId.Count > 0 Then post.IsOwl = Not followerId.Contains(post.Uid)
1541         End If
1542
1543         post.IsDm = False
1544         Return post
1545     End Function
1546
1547     Private Function CreatePostsFromJson(ByVal content As String, ByVal gType As WORKERTYPE, ByVal tab As TabClass, ByVal read As Boolean, ByVal count As Integer, ByRef minimumId As Long) As String
1548         Dim items As List(Of TwitterDataModel.Status)
1549         Try
1550             items = CreateDataFromJson(Of List(Of TwitterDataModel.Status))(content)
1551         Catch ex As SerializationException
1552             TraceOut(ex.Message + Environment.NewLine + content)
1553             Return "Json Parse Error(DataContractJsonSerializer)"
1554         Catch ex As Exception
1555             TraceOut(content)
1556             Return "Invalid Json!"
1557         End Try
1558
1559         For Each status As TwitterDataModel.Status In items
1560             Dim post As PostClass = Nothing
1561
1562             post = CreatePostsFromStatusData(status)
1563
1564             If minimumId > post.Id Then minimumId = post.Id
1565             '二重取得回避
1566             SyncLock LockObj
1567                 If tab Is Nothing Then
1568                     If TabInformations.GetInstance.ContainsKey(post.Id) Then Continue For
1569                 Else
1570                     If TabInformations.GetInstance.ContainsKey(post.Id, tab.TabName) Then Continue For
1571                 End If
1572             End SyncLock
1573
1574             post.IsRead = read
1575             If post.IsMe AndAlso Not read AndAlso _readOwnPost Then post.IsRead = True
1576
1577             If tab IsNot Nothing Then post.RelTabName = tab.TabName
1578             '非同期アイコン取得&StatusDictionaryに追加
1579             TabInformations.GetInstance.AddPost(post)
1580         Next
1581
1582         Return ""
1583     End Function
1584
1585     Public Overloads Function GetListStatus(ByVal read As Boolean, _
1586                             ByVal tab As TabClass, _
1587                             ByVal more As Boolean, _
1588                             ByVal startup As Boolean) As String
1589
1590         If _endingFlag Then Return ""
1591
1592         Dim res As HttpStatusCode
1593         Dim content As String = ""
1594         Dim page As Integer = 0
1595         Dim count As Integer = Setting.Instance.CountApi
1596         If Setting.Instance.UseAdditionalCount Then
1597             If more AndAlso Setting.Instance.MoreCountApi <> 0 Then
1598                 count = Setting.Instance.MoreCountApi
1599             ElseIf startup AndAlso Setting.Instance.FirstCountApi <> 0 Then
1600                 count = Setting.Instance.FirstCountApi
1601             End If
1602         End If
1603         Try
1604             If more Then
1605                 res = twCon.GetListsStatuses(tab.ListInfo.UserId.ToString, tab.ListInfo.Id.ToString, count, tab.OldestId, 0, content)
1606             Else
1607                 res = twCon.GetListsStatuses(tab.ListInfo.UserId.ToString, tab.ListInfo.Id.ToString, count, 0, 0, content)
1608             End If
1609         Catch ex As Exception
1610             Return "Err:" + ex.Message
1611         End Try
1612         Select Case res
1613             Case HttpStatusCode.OK
1614                 Twitter.AccountState = ACCOUNT_STATE.Valid
1615             Case HttpStatusCode.Unauthorized
1616                 Twitter.AccountState = ACCOUNT_STATE.Invalid
1617                 Return "Check your Username/Password."
1618             Case HttpStatusCode.BadRequest
1619                 Return "Err:API Limits?"
1620             Case Else
1621                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
1622         End Select
1623
1624         Return CreatePostsFromXml(content, WORKERTYPE.List, tab, read, count, tab.OldestId)
1625     End Function
1626
1627     Public Function GetRelatedResultsApi(ByVal read As Boolean, _
1628                             ByVal tab As TabClass) As String
1629
1630         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
1631
1632         If _endingFlag Then Return ""
1633
1634         Dim res As HttpStatusCode
1635         Dim content As String = ""
1636         Try
1637             res = twCon.GetRelatedResults(tab.RelationTargetPost.Id, content)
1638         Catch ex As Exception
1639             Return "Err:" + ex.Message
1640         End Try
1641         Select Case res
1642             Case HttpStatusCode.OK
1643                 Twitter.AccountState = ACCOUNT_STATE.Valid
1644             Case HttpStatusCode.Unauthorized
1645                 Twitter.AccountState = ACCOUNT_STATE.Invalid
1646                 Return "Check your Username/Password."
1647             Case HttpStatusCode.BadRequest
1648                 Return "Err:API Limits?"
1649             Case Else
1650                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
1651         End Select
1652
1653         Dim targetItem As PostClass = tab.RelationTargetPost
1654         If targetItem Is Nothing Then
1655             Return ""
1656         Else
1657             targetItem = targetItem.Copy()
1658         End If
1659         targetItem.RelTabName = tab.TabName
1660         TabInformations.GetInstance.AddPost(targetItem)
1661
1662         Dim replyToItem As PostClass = Nothing
1663         Dim replyToUserName As String = targetItem.InReplyToUser
1664         If targetItem.InReplyToId > 0 AndAlso TabInformations.GetInstance.Item(targetItem.InReplyToId) IsNot Nothing Then
1665             replyToItem = TabInformations.GetInstance.Item(targetItem.InReplyToId).Copy
1666             replyToItem.RelTabName = tab.TabName
1667         End If
1668
1669         Dim items As List(Of TwitterDataModel.RelatedResult)
1670         Try
1671             items = CreateDataFromJson(Of List(Of TwitterDataModel.RelatedResult))(content)
1672         Catch ex As SerializationException
1673             TraceOut(ex.Message + Environment.NewLine + content)
1674             Return "Json Parse Error(DataContractJsonSerializer)"
1675         Catch ex As Exception
1676             TraceOut(content)
1677             Return "Invalid Json!"
1678         End Try
1679
1680         For Each relatedData As TwitterDataModel.RelatedResult In items
1681             For Each result As TwitterDataModel.RelatedTweet In relatedData.Results
1682                 Dim item As PostClass = CreatePostsFromStatusData(result.Status)
1683                 If item Is Nothing Then Continue For
1684                 If targetItem.InReplyToId = item.Id Then replyToItem = Nothing
1685                 item.IsRead = read
1686                 If item.IsMe AndAlso Not read AndAlso _readOwnPost Then item.IsRead = True
1687                 If tab IsNot Nothing Then item.RelTabName = tab.TabName
1688                 '非同期アイコン取得&StatusDictionaryに追加
1689                 TabInformations.GetInstance.AddPost(item)
1690             Next
1691         Next
1692
1693         '発言者・返信先ユーザーの直近10発言取得
1694         'Dim rslt As String = Me.GetUserTimelineApi(read, 10, "", tab)
1695         'If Not String.IsNullOrEmpty(rslt) Then Return rslt
1696         'If Not String.IsNullOrEmpty(replyToUserName) Then
1697         '    rslt = Me.GetUserTimelineApi(read, 10, replyToUserName, tab)
1698         'End If
1699         'Return rslt
1700         Return ""
1701     End Function
1702
1703     Private Function CreatePostsFromXml(ByVal content As String, ByVal gType As WORKERTYPE, ByVal tab As TabClass, ByVal read As Boolean, ByVal count As Integer, ByRef minimumId As Long) As String
1704         Dim xdoc As New XmlDocument
1705         Try
1706             xdoc.LoadXml(content)
1707         Catch ex As Exception
1708             TraceOut(content)
1709             'MessageBox.Show("不正なXMLです。(TL-LoadXml)")
1710             Return "Invalid XML!"
1711         End Try
1712
1713         For Each xentryNode As XmlNode In xdoc.DocumentElement.SelectNodes("./status")
1714             Dim xentry As XmlElement = CType(xentryNode, XmlElement)
1715             Dim post As New PostClass
1716             Try
1717                 post.Id = Long.Parse(xentry.Item("id").InnerText)
1718                 If minimumId > post.Id Then minimumId = post.Id
1719                 '二重取得回避
1720                 SyncLock LockObj
1721                     If tab Is Nothing Then
1722                         If TabInformations.GetInstance.ContainsKey(post.Id) Then Continue For
1723                     Else
1724                         If TabInformations.GetInstance.ContainsKey(post.Id, tab.TabName) Then Continue For
1725                     End If
1726                 End SyncLock
1727                 'Retweet判定
1728                 Dim xRnode As XmlNode = xentry.SelectSingleNode("./retweeted_status")
1729                 If xRnode IsNot Nothing Then
1730                     Dim xRentry As XmlElement = CType(xRnode, XmlElement)
1731                     post.PDate = DateTime.ParseExact(xRentry.Item("created_at").InnerText, "ddd MMM dd HH:mm:ss zzzz yyyy", System.Globalization.DateTimeFormatInfo.InvariantInfo, System.Globalization.DateTimeStyles.None)
1732                     'Id
1733                     post.RetweetedId = Long.Parse(xRentry.Item("id").InnerText)
1734                     '本文
1735                     post.Data = xRentry.Item("text").InnerText
1736                     'Source取得(htmlの場合は、中身を取り出し)
1737                     post.Source = xRentry.Item("source").InnerText
1738                     'Reply先
1739                     Long.TryParse(xRentry.Item("in_reply_to_status_id").InnerText, post.InReplyToId)
1740                     post.InReplyToUser = xRentry.Item("in_reply_to_screen_name").InnerText
1741                     post.IsFav = TabInformations.GetInstance.GetTabByType(TabUsageType.Favorites).Contains(post.RetweetedId)
1742                     'post.IsFav = Boolean.Parse(xentry.Item("favorited").InnerText)
1743
1744                     '以下、ユーザー情報
1745                     Dim xRUentry As XmlElement = CType(xRentry.SelectSingleNode("./user"), XmlElement)
1746                     post.Uid = Long.Parse(xRUentry.Item("id").InnerText)
1747                     post.Name = xRUentry.Item("screen_name").InnerText
1748                     post.Nickname = xRUentry.Item("name").InnerText
1749                     post.ImageUrl = xRUentry.Item("profile_image_url").InnerText
1750                     post.IsProtect = Boolean.Parse(xRUentry.Item("protected").InnerText)
1751                     post.IsMe = post.Name.ToLower.Equals(_uid)
1752                     If post.IsMe Then _UserIdNo = post.Uid.ToString()
1753
1754                     'Retweetした人
1755                     Dim xUentry As XmlElement = CType(xentry.SelectSingleNode("./user"), XmlElement)
1756                     post.RetweetedBy = xUentry.Item("screen_name").InnerText
1757                 Else
1758                     post.PDate = DateTime.ParseExact(xentry.Item("created_at").InnerText, "ddd MMM dd HH:mm:ss zzzz yyyy", System.Globalization.DateTimeFormatInfo.InvariantInfo, System.Globalization.DateTimeStyles.None)
1759                     '本文
1760                     post.Data = xentry.Item("text").InnerText
1761                     'Source取得(htmlの場合は、中身を取り出し)
1762                     post.Source = xentry.Item("source").InnerText
1763                     Long.TryParse(xentry.Item("in_reply_to_status_id").InnerText, post.InReplyToId)
1764                     post.InReplyToUser = xentry.Item("in_reply_to_screen_name").InnerText
1765                     'in_reply_to_user_idを使うか?
1766                     post.IsFav = Boolean.Parse(xentry.Item("favorited").InnerText)
1767
1768                     '以下、ユーザー情報
1769                     Dim xUentry As XmlElement = CType(xentry.SelectSingleNode("./user"), XmlElement)
1770                     post.Uid = Long.Parse(xUentry.Item("id").InnerText)
1771                     post.Name = xUentry.Item("screen_name").InnerText
1772                     post.Nickname = xUentry.Item("name").InnerText
1773                     post.ImageUrl = xUentry.Item("profile_image_url").InnerText
1774                     post.IsProtect = Boolean.Parse(xUentry.Item("protected").InnerText)
1775                     post.IsMe = post.Name.ToLower.Equals(_uid)
1776                     If post.IsMe Then _UserIdNo = post.Uid.ToString()
1777                 End If
1778                 'HTMLに整形
1779                 post.OriginalData = CreateHtmlAnchor(post.Data, post.ReplyToList)
1780                 post.Data = HttpUtility.HtmlDecode(post.Data)
1781                 post.Data = post.Data.Replace("<3", "♡")
1782                 'Source整形
1783                 CreateSource(post)
1784
1785                 post.IsRead = read
1786                 If gType = WORKERTYPE.Timeline OrElse tab IsNot Nothing Then
1787                     post.IsReply = post.ReplyToList.Contains(_uid)
1788                 Else
1789                     post.IsReply = True
1790                 End If
1791                 post.IsExcludeReply = False
1792
1793                 If post.IsMe Then
1794                     post.IsOwl = False
1795                 Else
1796                     If followerId.Count > 0 Then post.IsOwl = Not followerId.Contains(post.Uid)
1797                 End If
1798                 If post.IsMe AndAlso Not read AndAlso _readOwnPost Then post.IsRead = True
1799
1800                 post.IsDm = False
1801                 If tab IsNot Nothing Then post.RelTabName = tab.TabName
1802             Catch ex As Exception
1803                 TraceOut(content)
1804                 'MessageBox.Show("不正なXMLです。(TL-Parse)")
1805                 Continue For
1806             End Try
1807
1808             TabInformations.GetInstance.AddPost(post)
1809
1810         Next
1811
1812         Return ""
1813     End Function
1814
1815     Public Function GetSearch(ByVal read As Boolean, _
1816                             ByVal tab As TabClass, _
1817                             ByVal more As Boolean) As String
1818
1819         If _endingFlag Then Return ""
1820
1821         Dim res As HttpStatusCode
1822         Dim content As String = ""
1823         Dim page As Integer = 0
1824         Dim sinceId As Long = 0
1825         Dim count As Integer = 100
1826         If Setting.Instance.UseAdditionalCount AndAlso
1827             Setting.Instance.SearchCountApi <> 0 Then
1828             count = Setting.Instance.SearchCountApi
1829         End If
1830         If more Then
1831             page = tab.GetSearchPage(count)
1832         Else
1833             sinceId = tab.SinceId
1834         End If
1835
1836         Try
1837             ' TODO:一時的に40>100件に 件数変更UI作成の必要あり
1838             res = twCon.Search(tab.SearchWords, tab.SearchLang, count, page, sinceId, content)
1839         Catch ex As Exception
1840             Return "Err:" + ex.Message
1841         End Try
1842         Select Case res
1843             Case HttpStatusCode.BadRequest
1844                 Return "Invalid query"
1845             Case HttpStatusCode.NotFound
1846                 Return "Invalid query"
1847             Case HttpStatusCode.PaymentRequired 'API Documentには420と書いてあるが、該当コードがないので402にしてある
1848                 Return "Search API Limit?"
1849             Case HttpStatusCode.OK
1850             Case Else
1851                 Return "Err:" + res.ToString + "(" + GetCurrentMethod.Name + ")"
1852         End Select
1853
1854         If Not TabInformations.GetInstance.ContainsTab(tab) Then Return ""
1855
1856         Dim xdoc As New XmlDocument
1857         Try
1858             xdoc.LoadXml(content)
1859         Catch ex As Exception
1860             TraceOut(content)
1861             Return "Invalid ATOM!"
1862         End Try
1863         Dim nsmgr As New XmlNamespaceManager(xdoc.NameTable)
1864         nsmgr.AddNamespace("search", "http://www.w3.org/2005/Atom")
1865         nsmgr.AddNamespace("twitter", "http://api.twitter.com/")
1866         For Each xentryNode As XmlNode In xdoc.DocumentElement.SelectNodes("/search:feed/search:entry", nsmgr)
1867             Dim xentry As XmlElement = CType(xentryNode, XmlElement)
1868             Dim post As New PostClass
1869             Try
1870                 post.Id = Long.Parse(xentry.Item("id").InnerText.Split(":"c)(2))
1871                 If TabInformations.GetInstance.ContainsKey(post.Id, tab.TabName) Then Continue For
1872                 post.PDate = DateTime.Parse(xentry.Item("published").InnerText)
1873                 '本文
1874                 post.Data = xentry.Item("title").InnerText
1875                 'Source取得(htmlの場合は、中身を取り出し)
1876                 post.Source = xentry.Item("twitter:source").InnerText
1877                 post.InReplyToId = 0
1878                 post.InReplyToUser = ""
1879                 post.IsFav = False
1880
1881                 '以下、ユーザー情報
1882                 Dim xUentry As XmlElement = CType(xentry.SelectSingleNode("./search:author", nsmgr), XmlElement)
1883                 post.Uid = 0
1884                 post.Name = xUentry.Item("name").InnerText.Split(" "c)(0).Trim
1885                 post.Nickname = xUentry.Item("name").InnerText.Substring(post.Name.Length).Trim
1886                 If post.Nickname.Length > 2 Then
1887                     post.Nickname = post.Nickname.Substring(1, post.Nickname.Length - 2)
1888                 Else
1889                     post.Nickname = post.Name
1890                 End If
1891                 post.ImageUrl = CType(xentry.SelectSingleNode("./search:link[@type='image/png']", nsmgr), XmlElement).GetAttribute("href")
1892                 post.IsProtect = False
1893                 post.IsMe = post.Name.ToLower.Equals(_uid)
1894
1895                 'HTMLに整形
1896                 post.OriginalData = CreateHtmlAnchor(HttpUtility.HtmlEncode(post.Data), post.ReplyToList)
1897                 post.Data = HttpUtility.HtmlDecode(post.Data)
1898                 'Source整形
1899                 CreateSource(post)
1900
1901                 post.IsRead = read
1902                 post.IsReply = post.ReplyToList.Contains(_uid)
1903                 post.IsExcludeReply = False
1904
1905                 post.IsOwl = False
1906                 If post.IsMe AndAlso Not read AndAlso _readOwnPost Then post.IsRead = True
1907                 post.IsDm = False
1908                 post.RelTabName = tab.TabName
1909                 If Not more AndAlso post.Id > tab.SinceId Then tab.SinceId = post.Id
1910             Catch ex As Exception
1911                 TraceOut(content)
1912                 Continue For
1913             End Try
1914
1915             'Me._dIcon.Add(post.ImageUrl, Nothing)
1916             TabInformations.GetInstance.AddPost(post)
1917
1918         Next
1919
1920         '' TODO
1921         '' 遡るための情報max_idやnext_pageの情報を保持する
1922
1923 #If 0 Then
1924         Dim xNode As XmlNode = xdoc.DocumentElement.SelectSingleNode("/search:feed/twitter:warning", nsmgr)
1925
1926         If xNode IsNot Nothing Then
1927             Return "Warn:" + xNode.InnerText + "(" + GetCurrentMethod.Name + ")"
1928         End If
1929 #End If
1930
1931         Return ""
1932     End Function
1933
1934     Private Function CreateDirectMessagesFromJson(ByVal content As String, ByVal gType As WORKERTYPE, ByVal read As Boolean) As String
1935         Dim item As List(Of TwitterDataModel.Directmessage)
1936         Try
1937             If gType = WORKERTYPE.UserStream Then
1938                 Dim itm As List(Of TwitterDataModel.DirectmessageEvent) = CreateDataFromJson(Of List(Of TwitterDataModel.DirectmessageEvent))(content)
1939                 item = New List(Of TwitterDataModel.Directmessage)
1940                 For Each dat As TwitterDataModel.DirectmessageEvent In itm
1941                     item.Add(dat.Directmessage)
1942                 Next
1943             Else
1944                 item = CreateDataFromJson(Of List(Of TwitterDataModel.Directmessage))(content)
1945             End If
1946         Catch ex As SerializationException
1947             TraceOut(ex.Message + Environment.NewLine + content)
1948             Return "Json Parse Error(DataContractJsonSerializer)"
1949         Catch ex As Exception
1950             TraceOut(content)
1951             Return "Invalid Json!"
1952         End Try
1953
1954         For Each message As TwitterDataModel.Directmessage In item
1955             Dim post As New PostClass
1956             Try
1957                 post.Id = message.Id
1958                 If gType <> WORKERTYPE.UserStream Then
1959                     If gType = WORKERTYPE.DirectMessegeRcv Then
1960                         If minDirectmessage > post.Id Then minDirectmessage = post.Id
1961                     Else
1962                         If minDirectmessageSent > post.Id Then minDirectmessageSent = post.Id
1963                     End If
1964                 End If
1965
1966                 '二重取得回避
1967                 SyncLock LockObj
1968                     If TabInformations.GetInstance.GetTabByType(TabUsageType.DirectMessage).Contains(post.Id) Then Continue For
1969                 End SyncLock
1970                 'sender_id
1971                 'recipient_id
1972                 post.PDate = DateTimeParse(message.CreatedAt)
1973                 '本文
1974                 post.Data = message.Text
1975                 'HTMLに整形
1976                 post.OriginalData = CreateHtmlAnchor(post.Data, post.ReplyToList)
1977                 post.Data = HttpUtility.HtmlDecode(post.Data)
1978                 post.Data = post.Data.Replace("<3", "♡")
1979                 post.IsFav = False
1980
1981                 '以下、ユーザー情報
1982                 Dim user As TwitterDataModel.User
1983                 If gType = WORKERTYPE.UserStream Then
1984                     If twCon.AuthenticatedUsername.Equals(message.Recipient.ScreenName, StringComparison.CurrentCultureIgnoreCase) Then
1985                         user = message.Sender
1986                         post.IsMe = False
1987                         post.IsOwl = True
1988                     Else
1989                         user = message.Recipient
1990                         post.IsMe = True
1991                         post.IsOwl = False
1992                     End If
1993                 Else
1994                     If gType = WORKERTYPE.DirectMessegeRcv Then
1995                         user = message.Sender
1996                         post.IsMe = False
1997                         post.IsOwl = True
1998                     Else
1999                         user = message.Recipient
2000                         post.IsMe = True
2001                         post.IsOwl = False
2002                     End If
2003                 End If
2004
2005                 post.Uid = user.id
2006                 post.Name = user.ScreenName
2007                 post.Nickname = user.Name
2008                 post.ImageUrl = user.ProfileImageUrl
2009                 post.IsProtect = user.protected
2010             Catch ex As Exception
2011                 TraceOut(content)
2012                 MessageBox.Show("Parse Error(CreateDirectMessagesFromJson)")
2013                 Continue For
2014             End Try
2015
2016             post.IsRead = read
2017             If post.IsMe AndAlso Not read AndAlso _readOwnPost Then post.IsRead = True
2018             post.IsReply = False
2019             post.IsExcludeReply = False
2020             post.IsDm = True
2021
2022             TabInformations.GetInstance.AddPost(post)
2023         Next
2024
2025         Return ""
2026
2027     End Function
2028
2029     Public Function GetDirectMessageApi(ByVal read As Boolean, _
2030                             ByVal gType As WORKERTYPE, _
2031                             ByVal more As Boolean) As String
2032         If _endingFlag Then Return ""
2033
2034         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
2035
2036         Dim res As HttpStatusCode
2037         Dim content As String = ""
2038
2039         Try
2040             If gType = WORKERTYPE.DirectMessegeRcv Then
2041                 If more Then
2042                     res = twCon.DirectMessages(20, minDirectmessage, 0, content)
2043                 Else
2044                     res = twCon.DirectMessages(20, 0, 0, content)
2045                 End If
2046             Else
2047                 If more Then
2048                     res = twCon.DirectMessagesSent(20, minDirectmessageSent, 0, content)
2049                 Else
2050                     res = twCon.DirectMessagesSent(20, 0, 0, content)
2051                 End If
2052             End If
2053         Catch ex As Exception
2054             Return "Err:" + ex.Message
2055         End Try
2056
2057         Select Case res
2058             Case HttpStatusCode.OK
2059                 Twitter.AccountState = ACCOUNT_STATE.Valid
2060             Case HttpStatusCode.Unauthorized
2061                 Twitter.AccountState = ACCOUNT_STATE.Invalid
2062                 Return "Check your Username/Password."
2063             Case HttpStatusCode.BadRequest
2064                 Return "Err:API Limits?"
2065             Case Else
2066                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
2067         End Select
2068
2069         Return CreateDirectMessagesFromJson(content, gType, read)
2070     End Function
2071
2072     Public Function GetFavoritesApi(ByVal read As Boolean, _
2073                         ByVal gType As WORKERTYPE) As String
2074
2075         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
2076
2077         If _endingFlag Then Return ""
2078
2079         Dim res As HttpStatusCode
2080         Dim content As String = ""
2081         Dim count As Integer = Setting.Instance.CountApi
2082         If Setting.Instance.UseAdditionalCount AndAlso
2083             Setting.Instance.FavoritesCountApi <> 0 Then
2084             count = Setting.Instance.FavoritesCountApi
2085         End If
2086         Try
2087             res = twCon.Favorites(count, content)
2088         Catch ex As Exception
2089             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
2090         End Try
2091
2092         Select Case res
2093             Case HttpStatusCode.OK
2094                 Twitter.AccountState = ACCOUNT_STATE.Valid
2095             Case HttpStatusCode.Unauthorized
2096                 Twitter.AccountState = ACCOUNT_STATE.Invalid
2097                 Return "Check your Username/Password."
2098             Case HttpStatusCode.BadRequest
2099                 Return "Err:API Limits?"
2100             Case Else
2101                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
2102         End Select
2103
2104         Dim serializer As New DataContractJsonSerializer(GetType(List(Of TwitterDataModel.Status)))
2105         Dim item As List(Of TwitterDataModel.Status)
2106
2107         Try
2108             item = CreateDataFromJson(Of List(Of TwitterDataModel.Status))(content)
2109         Catch ex As SerializationException
2110             TraceOut(ex.Message + Environment.NewLine + content)
2111             Return "Json Parse Error(DataContractJsonSerializer)"
2112         Catch ex As Exception
2113             TraceOut(content)
2114             Return "Invalid Json!"
2115         End Try
2116
2117         For Each status As TwitterDataModel.Status In item
2118             Dim post As New PostClass
2119             Try
2120                 post.Id = status.Id
2121                 '二重取得回避
2122                 SyncLock LockObj
2123                     If TabInformations.GetInstance.GetTabByType(TabUsageType.Favorites).Contains(post.Id) Then Continue For
2124                 End SyncLock
2125                 'Retweet判定
2126                 If status.RetweetedStatus IsNot Nothing Then
2127                     Dim retweeted As TwitterDataModel.RetweetedStatus = status.RetweetedStatus
2128                     post.PDate = DateTimeParse(retweeted.CreatedAt)
2129
2130                     'Id
2131                     post.RetweetedId = post.Id
2132                     '本文
2133                     post.Data = retweeted.text
2134                     'Source取得(htmlの場合は、中身を取り出し)
2135                     post.Source = retweeted.source
2136                     'Reply先
2137                     Long.TryParse(retweeted.InReplyToStatusId, post.InReplyToId)
2138                     post.InReplyToUser = retweeted.InReplyToScreenName
2139                     post.IsFav = retweeted.favorited
2140
2141                     '以下、ユーザー情報
2142                     Dim user As TwitterDataModel.User = retweeted.User
2143                     post.Uid = user.Id
2144                     post.Name = user.ScreenName
2145                     post.Nickname = user.Name
2146                     post.ImageUrl = user.ProfileImageUrl
2147                     post.IsProtect = user.Protected
2148                     post.IsMe = post.Name.ToLower.Equals(_uid)
2149                     If post.IsMe Then _UserIdNo = post.Uid.ToString()
2150
2151                     'Retweetした人
2152                     post.RetweetedBy = status.User.ScreenName
2153                 Else
2154                     post.PDate = DateTimeParse(status.CreatedAt)
2155
2156                     '本文
2157                     post.Data = status.Text
2158                     'Source取得(htmlの場合は、中身を取り出し)
2159                     post.Source = status.Source
2160                     Long.TryParse(status.InReplyToStatusId, post.InReplyToId)
2161                     post.InReplyToUser = status.InReplyToScreenName
2162
2163                     post.IsFav = status.Favorited
2164
2165                     '以下、ユーザー情報
2166                     Dim user As TwitterDataModel.User = status.User
2167                     post.Uid = user.Id
2168                     post.Name = user.ScreenName
2169                     post.Nickname = user.Name
2170                     post.ImageUrl = user.ProfileImageUrl
2171                     post.IsProtect = user.Protected
2172                     post.IsMe = post.Name.ToLower.Equals(_uid)
2173                     If post.IsMe Then _UserIdNo = post.Uid.ToString
2174                 End If
2175                 'HTMLに整形
2176                 post.OriginalData = CreateHtmlAnchor(post.Data, post.ReplyToList)
2177                 post.Data = HttpUtility.HtmlDecode(post.Data)
2178                 post.Data = post.Data.Replace("<3", "♡")
2179                 'Source整形
2180                 CreateSource(post)
2181
2182                 post.IsRead = read
2183                 post.IsReply = post.ReplyToList.Contains(_uid)
2184                 post.IsExcludeReply = False
2185
2186                 If post.IsMe Then
2187                     post.IsOwl = False
2188                 Else
2189                     If followerId.Count > 0 Then post.IsOwl = Not followerId.Contains(post.Uid)
2190                 End If
2191
2192                 post.IsDm = False
2193             Catch ex As Exception
2194                 TraceOut(content)
2195                 Continue For
2196             End Try
2197
2198             TabInformations.GetInstance.AddPost(post)
2199
2200         Next
2201
2202         Return ""
2203     End Function
2204
2205     Public Function GetFollowersApi() As String
2206         If _endingFlag Then Return ""
2207         Dim cursor As Long = -1
2208         Dim tmpFollower As New List(Of Long)(followerId)
2209
2210         followerId.Clear()
2211         Do
2212             Dim ret As String = FollowerApi(cursor)
2213             If Not String.IsNullOrEmpty(ret) Then
2214                 followerId.Clear()
2215                 followerId.AddRange(tmpFollower)
2216                 _GetFollowerResult = False
2217                 Return ret
2218             End If
2219         Loop While cursor > 0
2220
2221         TabInformations.GetInstance.RefreshOwl(followerId)
2222
2223         _GetFollowerResult = True
2224         Return ""
2225     End Function
2226
2227     Public ReadOnly Property GetFollowersSuccess() As Boolean
2228         Get
2229             Return _GetFollowerResult
2230         End Get
2231     End Property
2232
2233     Private Function FollowerApi(ByRef cursor As Long) As String
2234         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
2235
2236         Dim res As HttpStatusCode
2237         Dim content As String = ""
2238         Try
2239             res = twCon.FollowerIds(cursor, content)
2240         Catch ex As Exception
2241             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
2242         End Try
2243
2244         Select Case res
2245             Case HttpStatusCode.OK
2246                 Twitter.AccountState = ACCOUNT_STATE.Valid
2247             Case HttpStatusCode.Unauthorized
2248                 Twitter.AccountState = ACCOUNT_STATE.Invalid
2249                 Return "Check your Username/Password."
2250             Case HttpStatusCode.BadRequest
2251                 Return "Err:API Limits?"
2252             Case Else
2253                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
2254         End Select
2255
2256         Dim xdoc As New XmlDocument
2257         Try
2258             xdoc.LoadXml(content)
2259         Catch ex As Exception
2260             TraceOut(content)
2261             Return "Invalid XML!"
2262         End Try
2263
2264         Try
2265             For Each xentryNode As XmlNode In xdoc.DocumentElement.SelectNodes("/id_list/ids/id")
2266                 followerId.Add(Long.Parse(xentryNode.InnerText))
2267             Next
2268             cursor = Long.Parse(xdoc.DocumentElement.SelectSingleNode("/id_list/next_cursor").InnerText)
2269         Catch ex As Exception
2270             TraceOut(content)
2271             Return "Invalid XML!"
2272         End Try
2273
2274         Return ""
2275
2276     End Function
2277
2278     Public Function GetListsApi() As String
2279         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
2280
2281         Dim res As HttpStatusCode
2282         Dim content As String = ""
2283         Dim cursor As Long = -1
2284
2285         Dim lists As New List(Of ListElement)
2286         Do
2287             Try
2288                 res = twCon.GetLists(Me.Username, cursor, content)
2289             Catch ex As Exception
2290                 Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
2291             End Try
2292
2293             Select Case res
2294                 Case HttpStatusCode.OK
2295                     Twitter.AccountState = ACCOUNT_STATE.Valid
2296                 Case HttpStatusCode.Unauthorized
2297                     Twitter.AccountState = ACCOUNT_STATE.Invalid
2298                     Return "Check your Username/Password."
2299                 Case HttpStatusCode.BadRequest
2300                     Return "Err:API Limits?"
2301                 Case Else
2302                     Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
2303             End Select
2304
2305             Dim xdoc As New XmlDocument
2306             Try
2307                 xdoc.LoadXml(content)
2308             Catch ex As Exception
2309                 TraceOut(content)
2310                 Return "Invalid XML!"
2311             End Try
2312
2313             Try
2314                 For Each xentryNode As XmlNode In xdoc.DocumentElement.SelectNodes("/lists_list/lists/list")
2315                     lists.Add(New ListElement(xentryNode, Me))
2316                 Next
2317                 cursor = Long.Parse(xdoc.DocumentElement.SelectSingleNode("/lists_list/next_cursor").InnerText)
2318             Catch ex As Exception
2319                 TraceOut(content)
2320                 Return "Invalid XML!"
2321             End Try
2322         Loop While cursor <> 0
2323
2324         cursor = -1
2325         content = ""
2326         Do
2327             Try
2328                 res = twCon.GetListsSubscriptions(Me.Username, cursor, content)
2329             Catch ex As Exception
2330                 Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
2331             End Try
2332
2333             Select Case res
2334                 Case HttpStatusCode.OK
2335                     Twitter.AccountState = ACCOUNT_STATE.Valid
2336                 Case HttpStatusCode.Unauthorized
2337                     Twitter.AccountState = ACCOUNT_STATE.Invalid
2338                     Return "Check your Username/Password."
2339                 Case HttpStatusCode.BadRequest
2340                     Return "Err:API Limits?"
2341                 Case Else
2342                     Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
2343             End Select
2344
2345             Dim xdoc As New XmlDocument
2346             Try
2347                 xdoc.LoadXml(content)
2348             Catch ex As Exception
2349                 TraceOut(content)
2350                 Return "Invalid XML!"
2351             End Try
2352
2353             Try
2354                 For Each xentryNode As XmlNode In xdoc.DocumentElement.SelectNodes("/lists_list/lists/list")
2355                     lists.Add(New ListElement(xentryNode, Me))
2356                 Next
2357                 cursor = Long.Parse(xdoc.DocumentElement.SelectSingleNode("/lists_list/next_cursor").InnerText)
2358             Catch ex As Exception
2359                 TraceOut(content)
2360                 Return "Invalid XML!"
2361             End Try
2362         Loop While cursor <> 0
2363
2364         TabInformations.GetInstance.SubscribableLists = lists
2365         Return ""
2366     End Function
2367
2368     Public Function DeleteList(ByVal list_id As String) As String
2369         Dim res As HttpStatusCode
2370         Dim content As String = ""
2371
2372         Try
2373             res = twCon.DeleteListID(Me.Username, list_id, content)
2374         Catch ex As Exception
2375             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
2376         End Try
2377
2378         Select Case res
2379             Case HttpStatusCode.OK
2380                 Twitter.AccountState = ACCOUNT_STATE.Valid
2381             Case HttpStatusCode.Unauthorized
2382                 Twitter.AccountState = ACCOUNT_STATE.Invalid
2383                 Return "Check your Username/Password."
2384             Case HttpStatusCode.BadRequest
2385                 Return "Err:API Limits?"
2386             Case Else
2387                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
2388         End Select
2389
2390         Return ""
2391     End Function
2392
2393     Public Function EditList(ByVal list_id As String, ByVal new_name As String, ByVal isPrivate As Boolean, ByVal description As String, ByRef list As ListElement) As String
2394         Dim res As HttpStatusCode
2395         Dim content As String = ""
2396         Dim modeString As String = "public"
2397         If isPrivate Then
2398             modeString = "private"
2399         End If
2400
2401         Try
2402             res = twCon.PostListID(Me.Username, list_id, new_name, modeString, description, content)
2403         Catch ex As Exception
2404             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
2405         End Try
2406
2407         Select Case res
2408             Case HttpStatusCode.OK
2409                 Twitter.AccountState = ACCOUNT_STATE.Valid
2410             Case HttpStatusCode.Unauthorized
2411                 Twitter.AccountState = ACCOUNT_STATE.Invalid
2412                 Return "Check your Username/Password."
2413             Case HttpStatusCode.BadRequest
2414                 Return "Err:API Limits?"
2415             Case Else
2416                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
2417         End Select
2418
2419         Dim xdoc As New XmlDocument
2420         Try
2421             xdoc.LoadXml(content)
2422             Dim newList As New ListElement(xdoc.DocumentElement, Me)
2423             list.Description = newList.Description
2424             list.Id = newList.Id
2425             list.IsPublic = newList.IsPublic
2426             list.MemberCount = newList.MemberCount
2427             list.Name = newList.Name
2428             list.SubscriberCount = newList.SubscriberCount
2429             list.Slug = newList.Slug
2430             list.Nickname = newList.Nickname
2431             list.Username = newList.Username
2432             list.UserId = newList.UserId
2433         Catch ex As Exception
2434             TraceOut(content)
2435             Return "Invalid XML!"
2436         End Try
2437
2438         Return ""
2439     End Function
2440
2441     Public Function GetListMembers(ByVal list_id As String, ByVal lists As List(Of UserInfo), ByRef cursor As Long) As String
2442         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
2443
2444         Dim res As HttpStatusCode
2445         Dim content As String = ""
2446         'Dim cursor As Long = -1
2447
2448         'Do
2449         Try
2450             res = twCon.GetListMembers(Me.Username, list_id, cursor, content)
2451         Catch ex As Exception
2452             Return "Err:" + ex.Message
2453         End Try
2454
2455         Select Case res
2456             Case HttpStatusCode.OK
2457                 Twitter.AccountState = ACCOUNT_STATE.Valid
2458             Case HttpStatusCode.Unauthorized
2459                 Twitter.AccountState = ACCOUNT_STATE.Invalid
2460                 Return "Check your Username/Password."
2461             Case HttpStatusCode.BadRequest
2462                 Return "Err:API Limits?"
2463             Case Else
2464                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
2465         End Select
2466
2467         Dim xdoc As New XmlDocument
2468         Try
2469             xdoc.LoadXml(content)
2470         Catch ex As Exception
2471             TraceOut(content)
2472             Return "Invalid XML!"
2473         End Try
2474
2475         Try
2476             For Each xentryNode As XmlNode In xdoc.DocumentElement.SelectNodes("/users_list/users/user")
2477                 lists.Add(New UserInfo(xentryNode))
2478             Next
2479             cursor = Long.Parse(xdoc.DocumentElement.SelectSingleNode("/users_list/next_cursor").InnerText)
2480         Catch ex As Exception
2481             TraceOut(content)
2482             Return "Invalid XML!"
2483         End Try
2484         'Loop While cursor <> 0
2485
2486         Return ""
2487     End Function
2488
2489     Public Function CreateListApi(ByVal listName As String, ByVal isPrivate As Boolean, ByVal description As String) As String
2490         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
2491
2492         Dim res As HttpStatusCode
2493         Dim content As String = ""
2494
2495         Try
2496             res = twCon.PostLists(Me.Username, listName, isPrivate, description, content)
2497         Catch ex As Exception
2498             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
2499         End Try
2500
2501         Select Case res
2502             Case HttpStatusCode.OK
2503                 Twitter.AccountState = ACCOUNT_STATE.Valid
2504             Case HttpStatusCode.Unauthorized
2505                 Twitter.AccountState = ACCOUNT_STATE.Invalid
2506                 Return "Check your Username/Password."
2507             Case HttpStatusCode.BadRequest
2508                 Return "Err:API Limits?"
2509             Case Else
2510                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
2511         End Select
2512
2513         Dim xdoc As New XmlDocument
2514         Try
2515             xdoc.LoadXml(content)
2516
2517             TabInformations.GetInstance().SubscribableLists.Add(New ListElement(xdoc.DocumentElement, Me))
2518         Catch ex As Exception
2519             TraceOut(content)
2520             Return "Invalid XML!"
2521         End Try
2522
2523         Return ""
2524     End Function
2525
2526     Public Function ContainsUserAtList(ByVal list_name As String, ByVal user As String, ByRef value As Boolean) As String
2527         value = False
2528
2529         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return ""
2530
2531         Dim res As HttpStatusCode
2532         Dim content As String = ""
2533
2534         Try
2535             res = Me.twCon.GetListMembersID(Me.Username, list_name, user, content)
2536         Catch ex As Exception
2537             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
2538         End Try
2539
2540         Select Case res
2541             Case HttpStatusCode.OK
2542                 Twitter.AccountState = ACCOUNT_STATE.Valid
2543             Case HttpStatusCode.Unauthorized
2544                 Twitter.AccountState = ACCOUNT_STATE.Invalid
2545                 Return "Check your Username/Password."
2546             Case HttpStatusCode.BadRequest
2547                 Return "Err:API Limits?"
2548             Case HttpStatusCode.NotFound
2549                 value = False
2550                 Return ""
2551             Case Else
2552                 Return "Err:" + res.ToString() + "(" + GetCurrentMethod.Name + ")"
2553         End Select
2554
2555         Dim xdoc As New XmlDocument
2556         Try
2557             xdoc.LoadXml(content)
2558             value = xdoc.DocumentElement.Name = "user"
2559         Catch ex As Exception
2560             TraceOut(content)
2561             Return "Invalid XML!"
2562         End Try
2563
2564         Return ""
2565     End Function
2566
2567     Public Function AddUserToList(ByVal list_name As String, ByVal user As String) As String
2568         Dim content As String = ""
2569         Dim res As HttpStatusCode
2570
2571         Try
2572             res = twCon.PostListMembers(Me.Username, list_name, user, content)
2573         Catch ex As Exception
2574             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
2575         End Try
2576
2577         Return ""
2578     End Function
2579
2580     Public Function RemoveUserToList(ByVal list_name As String, ByVal user As String) As String
2581         Dim content As String = ""
2582         Dim res As HttpStatusCode
2583
2584         Try
2585             res = twCon.DeleteListMembers(Me.Username, list_name, user, content)
2586         Catch ex As Exception
2587             Return "Err:" + ex.Message + "(" + GetCurrentMethod.Name + ")"
2588         End Try
2589
2590         Return ""
2591     End Function
2592
2593     Private Class range
2594         Public Property fromIndex As Integer
2595         Public Property toIndex As Integer
2596         Public Sub New(ByVal fromIndex As Integer, ByVal toIndex As Integer)
2597             Me.fromIndex = fromIndex
2598             Me.toIndex = toIndex
2599         End Sub
2600     End Class
2601     Public Function CreateHtmlAnchor(ByVal Text As String, ByVal AtList As List(Of String)) As String
2602         Dim retStr As String = Text.Replace("&gt;", "<<<<<tweenだいなり>>>>>").Replace("&lt;", "<<<<<tweenしょうなり>>>>>")
2603         'uriの正規表現
2604         'Const rgUrl As String = "(?<before>(?:[^\""':!=]|^|\:))" + _
2605         '                            "(?<url>(?<protocol>https?://|www\.)" + _
2606         '                            "(?<domain>(?:[\.-]|[^\p{P}\s])+\.[a-z]{2,}(?::[0-9]+)?)" + _
2607         '                            "(?<path>/[a-z0-9!*'();:&=+$/%#\[\]\-_.,~@^]*[a-z0-9)=#/]?)?" + _
2608         '                            "(?<query>\?[a-z0-9!*'();:&=+$/%#\[\]\-_.,~]*[a-z0-9_&=#])?)"
2609         Const url_valid_general_path_chars As String = "[a-z0-9!*';:=+$/%#\[\]\-_,~]"
2610         Const url_valid_url_path_ending_chars As String = "[a-z0-9=#/]"
2611         Const pth As String = "(?<path>/(?:(?:\(" + url_valid_general_path_chars + "+\))" +
2612             "|@" + url_valid_general_path_chars + "+/" +
2613             "|[.,]?" + url_valid_general_path_chars +
2614             ")*" +
2615             url_valid_url_path_ending_chars + "?)?"
2616         Const qry As String = "(?<query>\?[a-z0-9!*'();:&=+$/%#\[\]\-_.,~]*[a-z0-9_&=#])?"
2617         Const rgUrl As String = "(?<before>(?:[^\""':!=]|^|\:))" +
2618                                     "(?<url>(?<protocol>https?://|www\.)" +
2619                                     "(?<domain>(?:[\.-]|[^\p{P}\s])+\.[a-z]{2,}(?::[0-9]+)?)" +
2620                                     pth +
2621                                     qry +
2622                                     ")"
2623         '絶対パス表現のUriをリンクに置換
2624         retStr = Regex.Replace(retStr,
2625                                rgUrl,
2626                                New MatchEvaluator(Function(mu As Match)
2627                                                       Dim sb As New StringBuilder(mu.Result("${before}<a href="""))
2628                                                       If mu.Result("${protocol}").StartsWith("w", StringComparison.OrdinalIgnoreCase) Then
2629                                                           sb.Append("http://")
2630                                                       End If
2631                                                       sb.Append(mu.Result("${url}"">")).Append(mu.Result("${url}")).Append("</a>")
2632                                                       Return sb.ToString
2633                                                   End Function),
2634                                RegexOptions.IgnoreCase)
2635
2636         '@先をリンクに置換(リスト)
2637         retStr = Regex.Replace(retStr,
2638                                "(^|[^a-zA-Z0-9_/])([@@]+)([a-zA-Z0-9_]{1,20}/[a-zA-Z][a-zA-Z0-9\p{IsLatin-1Supplement}\-]{0,79})",
2639                                "$1$2<a href=""/$3"">$3</a>")
2640
2641         Dim m As Match = Regex.Match(retStr, "(^|[^a-zA-Z0-9_])[@@]([a-zA-Z0-9_]{1,20})")
2642         While m.Success
2643             If Not AtList.Contains(m.Result("$2").ToLower) Then AtList.Add(m.Result("$2").ToLower)
2644             m = m.NextMatch
2645         End While
2646         '@先をリンクに置換
2647         retStr = Regex.Replace(retStr,
2648                                "(^|[^a-zA-Z0-9_/])([@@])([a-zA-Z0-9_]{1,20})",
2649                                "$1$2<a href=""/$3"">$3</a>")
2650
2651         'ハッシュタグを抽出し、リンクに置換
2652         Dim anchorRange As New List(Of range)
2653         For i As Integer = 0 To retStr.Length - 1
2654             Dim index As Integer = retStr.IndexOf("<a ", i)
2655             If index > -1 AndAlso index < retStr.Length Then
2656                 i = index
2657                 Dim toIndex As Integer = retStr.IndexOf("</a>", index)
2658                 If toIndex > -1 Then
2659                     anchorRange.Add(New range(index, toIndex + 3))
2660                     i = toIndex
2661                 End If
2662             End If
2663         Next
2664         retStr = Regex.Replace(retStr,
2665                                "(^|[^a-zA-Z0-9/&])([##])([0-9a-zA-Z_]*[a-zA-Z_]+[a-zA-Z0-9_\xc0-\xd6\xd8-\xf6\xf8-\xff]*)",
2666                                New MatchEvaluator(Function(mh As Match)
2667                                                       For Each rng As range In anchorRange
2668                                                           If mh.Index >= rng.fromIndex AndAlso
2669                                                            mh.Index <= rng.toIndex Then Return mh.Result("$0")
2670                                                       Next
2671                                                       If IsNumeric(mh.Result("$3")) Then Return mh.Result("$0")
2672                                                       SyncLock LockObj
2673                                                           _hashList.Add("#" + mh.Result("$3"))
2674                                                       End SyncLock
2675                                                       Return mh.Result("$1") + "<a href=""" & _protocol & "twitter.com/search?q=%23" + mh.Result("$3") + """>" + mh.Result("$2$3") + "</a>"
2676                                                   End Function),
2677                                               RegexOptions.IgnoreCase)
2678
2679         'Dim mhs As MatchCollection = Regex.Matches(retStr, "(^|[^a-zA-Z0-9/&])[##]([0-9a-zA-Z_]*[a-zA-Z_]+[a-zA-Z_\xc0-\xd6\xd8-\xf6\xf8-\xff]*)")
2680         'For Each mt As Match In mhs
2681         '    If Not IsNumeric(mt.Result("$2")) Then
2682         '        'retStr = retStr.Replace(mt.Result("$1") + mt.Result("$2"), "<a href=""" + _protocol + "twitter.com/search?q=%23" + mt.Result("$2") + """>#" + mt.Result("$2") + "</a>")
2683         '        SyncLock LockObj
2684         '            _hashList.Add("#" + mt.Result("$2"))
2685         '        End SyncLock
2686         '    End If
2687         'Next
2688         'retStr = Regex.Replace(retStr, "(^|[^a-zA-Z0-9/&])([##])([0-9a-zA-Z_]*[a-zA-Z_]+[a-zA-Z0-9_\xc0-\xd6\xd8-\xf6\xf8-\xff]*)", "$1<a href=""" & _protocol & "twitter.com/search?q=%23$3"">$2$3</a>")
2689
2690         retStr = Regex.Replace(retStr, "(^|[^a-zA-Z0-9_/&##@@>=.])(sm|nm)([0-9]{1,10})", "$1<a href=""http://www.nicovideo.jp/watch/$2$3"">$2$3</a>")
2691
2692         retStr = retStr.Replace("<<<<<tweenだいなり>>>>>", "&gt;").Replace("<<<<<tweenしょうなり>>>>>", "&lt;")
2693
2694         retStr = AdjustHtml(ShortUrl.Resolve(PreProcessUrl(retStr))) 'IDN置換、短縮Uri解決、@リンクを相対→絶対にしてtarget属性付与
2695         Return retStr
2696     End Function
2697
2698     'Source整形
2699     Private Sub CreateSource(ByRef post As PostClass)
2700         If post.Source.StartsWith("<") Then
2701             If Not post.Source.Contains("</a>") Then
2702                 post.Source += "</a>"
2703             End If
2704             Dim mS As Match = Regex.Match(post.Source, ">(?<source>.+)<")
2705             If mS.Success Then
2706                 post.SourceHtml = String.Copy(ShortUrl.Resolve(PreProcessUrl(post.Source)))
2707                 post.Source = HttpUtility.HtmlDecode(mS.Result("${source}"))
2708             Else
2709                 post.Source = ""
2710                 post.SourceHtml = ""
2711             End If
2712         Else
2713             If post.Source = "web" Then
2714                 post.SourceHtml = My.Resources.WebSourceString
2715             ElseIf post.Source = "Keitai Mail" Then
2716                 post.SourceHtml = My.Resources.KeitaiMailSourceString
2717             Else
2718                 post.SourceHtml = String.Copy(post.Source)
2719             End If
2720         End If
2721     End Sub
2722
2723     Public Function GetInfoApi(ByVal info As ApiInfo) As Boolean
2724         If Twitter.AccountState <> ACCOUNT_STATE.Valid Then Return True
2725
2726         If _endingFlag Then Return True
2727
2728         Dim res As HttpStatusCode
2729         Dim content As String = ""
2730         Try
2731             res = twCon.RateLimitStatus(content)
2732         Catch ex As Exception
2733             TwitterApiInfo.Initialize()
2734             Return False
2735         End Try
2736
2737         If res <> HttpStatusCode.OK Then Return False
2738
2739         Dim xdoc As New XmlDocument
2740         Try
2741             xdoc.LoadXml(content)
2742             Dim arg As New ApiInformationChangedEventArgs
2743
2744             arg.ApiInfo.MaxCount = Integer.Parse(xdoc.SelectSingleNode("/hash/hourly-limit").InnerText)
2745             arg.ApiInfo.RemainCount = Integer.Parse(xdoc.SelectSingleNode("/hash/remaining-hits").InnerText)
2746             arg.ApiInfo.ResetTime = DateTime.Parse(xdoc.SelectSingleNode("/hash/reset-time").InnerText)
2747             arg.ApiInfo.ResetTimeInSeconds = Integer.Parse(xdoc.SelectSingleNode("/hash/reset-time-in-seconds").InnerText)
2748             If info IsNot Nothing Then
2749                 arg.ApiInfo.UsingCount = info.UsingCount
2750
2751                 info.MaxCount = arg.ApiInfo.MaxCount
2752                 info.RemainCount = arg.ApiInfo.RemainCount
2753                 info.ResetTime = arg.ApiInfo.ResetTime
2754                 info.ResetTimeInSeconds = arg.ApiInfo.ResetTimeInSeconds
2755             End If
2756
2757             RaiseEvent ApiInformationChanged(Me, arg)
2758             TwitterApiInfo.WriteBackEventArgs(arg)
2759             Return True
2760         Catch ex As Exception
2761             TwitterApiInfo.Initialize()
2762             Return False
2763         End Try
2764     End Function
2765
2766     Public Function GetHashList() As String()
2767         Dim hashArray As String()
2768         SyncLock LockObj
2769             hashArray = _hashList.ToArray
2770             _hashList.Clear()
2771         End SyncLock
2772         Return hashArray
2773     End Function
2774
2775     Public ReadOnly Property AccessToken() As String
2776         Get
2777             Return twCon.AccessToken
2778         End Get
2779     End Property
2780
2781     Public ReadOnly Property AccessTokenSecret() As String
2782         Get
2783             Return twCon.AccessTokenSecret
2784         End Get
2785     End Property
2786
2787     Public Property UserIdNo As String
2788
2789     Public Event ApiInformationChanged(ByVal sender As Object, ByVal e As ApiInformationChangedEventArgs)
2790
2791     Private Sub Twitter_ApiInformationChanged(ByVal sender As Object, ByVal e As ApiInformationChangedEventArgs) Handles Me.ApiInformationChanged
2792     End Sub
2793
2794 #Region "UserStream"
2795     Public Property TrackWord As String = ""
2796     Public Property AllAtReply As Boolean = False
2797
2798     Public Event NewPostFromStream()
2799     Public Event UserStreamStarted()
2800     Public Event UserStreamStopped()
2801     Public Event UserStreamGetFriendsList()
2802     Public Event PostDeleted(ByVal id As Long, ByRef post As PostClass)
2803     Public Event UserStreamEventReceived(ByVal eventType As FormattedEvent)
2804     Private WithEvents userStream As TwitterUserstream
2805
2806     Public Class FormattedEvent
2807         Public Property CreatedAt As DateTime
2808         Public Property [Event] As String
2809         Public Property Username As String
2810         Public Property Target As String
2811
2812     End Class
2813
2814     Public Property StoredEvent As New List(Of FormattedEvent)
2815
2816     Private EventNameTable() As String = {
2817         "favorite",
2818         "unfavorite",
2819         "follow",
2820         "list_member_added",
2821         "list_member_removed",
2822         "block"
2823     }
2824
2825     Private Sub userStream_StatusArrived(ByVal line As String) Handles userStream.StatusArrived
2826         If String.IsNullOrEmpty(line) Then Exit Sub
2827
2828         Dim isDm As Boolean = False
2829
2830         Using jsonReader As XmlDictionaryReader = JsonReaderWriterFactory.CreateJsonReader(Encoding.UTF8.GetBytes(line), XmlDictionaryReaderQuotas.Max)
2831             Dim xElm As XElement = XElement.Load(jsonReader)
2832             If xElm.Element("friends") IsNot Nothing Then
2833                 Debug.Print("friends")
2834                 Exit Sub
2835             ElseIf xElm.Element("delete") IsNot Nothing Then
2836                 Debug.Print("delete")
2837                 Dim post As PostClass = Nothing
2838                 Dim id As Int64
2839                 If xElm.Element("delete").Element("direct_message") IsNot Nothing Then
2840                     id = CLng(xElm.Element("delete").Element("direct_message").Element("id").Value)
2841                     RaiseEvent PostDeleted(id, post)
2842                 Else
2843                     id = CLng(xElm.Element("delete").Element("status").Element("id").Value)
2844                     RaiseEvent PostDeleted(id, post)
2845                 End If
2846                 CreateDeleteEvent(DateTime.Now, id, post)
2847                 Exit Sub
2848             ElseIf xElm.Element("limit") IsNot Nothing Then
2849                 Debug.Print(line)
2850                 Exit Sub
2851             ElseIf xElm.Element("event") IsNot Nothing Then
2852                 Debug.Print("event: " + xElm.Element("event").Value)
2853                 CreateEventFromJson(line)
2854                 Exit Sub
2855             ElseIf xElm.Element("direct_message") IsNot Nothing Then
2856                 Debug.Print("direct_message")
2857                 isDm = True
2858             End If
2859         End Using
2860
2861         Dim res As New StringBuilder
2862         res.Length = 0
2863         res.Append("[")
2864         res.Append(line)
2865         res.Append("]")
2866
2867         If isDm Then
2868             CreateDirectMessagesFromJson(res.ToString, WORKERTYPE.UserStream, False)
2869         Else
2870             CreatePostsFromJson(res.ToString, WORKERTYPE.Timeline, Nothing, False, Nothing, Nothing)
2871         End If
2872
2873         RaiseEvent NewPostFromStream()
2874     End Sub
2875
2876     Private Sub CreateDeleteEvent(ByVal createdat As DateTime, ByVal id As Int64, ByVal post As PostClass)
2877         Dim evt As New FormattedEvent
2878         evt.CreatedAt = createdat
2879         If post Is Nothing Then
2880             Dim tmp As PostClass = (From p In _deletemessages Where p.Id = id).FirstOrDefault
2881             If tmp IsNot Nothing Then
2882                 post = tmp
2883                 _deletemessages.Remove(post)
2884             End If
2885         End If
2886         If post Is Nothing Then
2887             'evt.Event = "DELETE(UNKNOWN)"
2888             'evt.Username = "--UNKNOWN--"
2889             'evt.Target = "--UNKNOWN--"
2890             '保持していない発言に対しての削除イベントは無視
2891             Exit Sub
2892         Else
2893             If post.IsDm Then
2894                 evt.Event = "DELETE(DM)"
2895             Else
2896                 evt.Event = "DELETE(Post)"
2897             End If
2898             evt.Username = post.Name
2899             evt.Target = If(post.Data.Length > 5, post.Data.Substring(0, 5) + "...", post.Data) + " [" + post.PDate.ToString + "]"
2900         End If
2901         Me.StoredEvent.Insert(0, evt)
2902         RaiseEvent UserStreamEventReceived(evt)
2903     End Sub
2904
2905     Private Sub CreateEventFromJson(ByVal content As String)
2906         Dim eventData As TwitterDataModel.EventData = Nothing
2907         Try
2908             eventData = CreateDataFromJson(Of TwitterDataModel.EventData)(content)
2909         Catch ex As SerializationException
2910             TraceOut(ex, "Event Serialize Exception!" + Environment.NewLine + content)
2911         Catch ex As Exception
2912             TraceOut(ex, "Event Exception!" + Environment.NewLine + content)
2913         End Try
2914
2915         Dim evt As New FormattedEvent
2916         evt.CreatedAt = DateTimeParse(eventData.CreatedAt)
2917         evt.Event = eventData.Event
2918         evt.Username = eventData.Source.ScreenName
2919         Select Case eventData.Event
2920             Case "follow"
2921                 If eventData.Target.ScreenName.ToLower.Equals(_uid) Then
2922                     If Not Me.followerId.Contains(eventData.Source.Id) Then Me.followerId.Add(eventData.Source.Id)
2923                 Else
2924                     Exit Sub    'Block後のUndoをすると、SourceとTargetが逆転したfollowイベントが帰ってくるため。
2925                 End If
2926                 evt.Target = ""
2927             Case "favorite", "unfavorite"
2928                 evt.Target = eventData.TargetObject.Text
2929             Case "list_member_added", "list_member_removed"
2930                 evt.Target = eventData.TargetObject.Name
2931             Case "block"
2932                 evt.Target = ""
2933             Case "user_update"
2934                 evt.Target = ""
2935             Case Else
2936                 TraceOut("Unknown Event:" + evt.Event + Environment.NewLine + content)
2937         End Select
2938         Me.StoredEvent.Insert(0, evt)
2939         RaiseEvent UserStreamEventReceived(evt)
2940     End Sub
2941
2942     Private Function CreateDataFromJson(Of T)(ByVal content As String) As T
2943         Dim data As T
2944         Using stream As New MemoryStream()
2945             Dim buf As Byte() = Encoding.Unicode.GetBytes(content)
2946             stream.Write(Encoding.Unicode.GetBytes(content), offset:=0, count:=buf.Length)
2947             stream.Seek(offset:=0, loc:=SeekOrigin.Begin)
2948             data = DirectCast((New DataContractJsonSerializer(GetType(T))).ReadObject(stream), T)
2949         End Using
2950         Return data
2951     End Function
2952
2953     Private Sub userStream_Started() Handles userStream.Started
2954         RaiseEvent UserStreamStarted()
2955     End Sub
2956
2957     Private Sub userStream_Stopped() Handles userStream.Stopped
2958         RaiseEvent UserStreamStopped()
2959     End Sub
2960
2961     Public ReadOnly Property UserStreamEnabled As Boolean
2962         Get
2963             Return If(userStream Is Nothing, False, userStream.Enabled)
2964         End Get
2965     End Property
2966
2967     Public Sub StartUserStream()
2968         If userStream IsNot Nothing Then
2969             StopUserStream()
2970         End If
2971         userStream = New TwitterUserstream(twCon)
2972         userStream.Start(Me.AllAtReply, Me.TrackWord)
2973     End Sub
2974
2975     Public Sub StopUserStream()
2976         If userStream IsNot Nothing Then userStream.Dispose()
2977         userStream = Nothing
2978         If Not _endingFlag Then RaiseEvent UserStreamStopped()
2979     End Sub
2980
2981     Public Sub ReconnectUserStream()
2982         If userStream IsNot Nothing Then
2983             Me.StartUserStream()
2984         End If
2985     End Sub
2986
2987     Private Class TwitterUserstream
2988         Implements IDisposable
2989
2990         Public Event StatusArrived(ByVal status As String)
2991         Public Event Stopped()
2992         Public Event Started()
2993         Private twCon As HttpTwitter
2994
2995         Private _streamThread As Thread
2996         Private _streamActive As Boolean
2997
2998         Private _allAtreplies As Boolean = False
2999         Private _trackwords As String = ""
3000
3001         Public Sub New(ByVal twitterConnection As HttpTwitter)
3002             twCon = DirectCast(twitterConnection.Clone(), HttpTwitter)
3003         End Sub
3004
3005         Public Sub Start(ByVal allAtReplies As Boolean, ByVal trackwords As String)
3006             Me.AllAtReplies = allAtReplies
3007             Me.TrackWords = trackwords
3008             _streamActive = True
3009             If _streamThread IsNot Nothing AndAlso _streamThread.IsAlive Then Exit Sub
3010             _streamThread = New Thread(AddressOf UserStreamLoop)
3011             _streamThread.Name = "UserStreamReceiver"
3012             _streamThread.IsBackground = True
3013             _streamThread.Start()
3014         End Sub
3015
3016         Public ReadOnly Property Enabled() As Boolean
3017             Get
3018                 Return _streamActive
3019             End Get
3020         End Property
3021
3022         Public Property AllAtReplies As Boolean
3023             Get
3024                 Return _allAtreplies
3025             End Get
3026             Set(ByVal value As Boolean)
3027                 _allAtreplies = value
3028             End Set
3029         End Property
3030
3031         Public Property TrackWords As String
3032             Get
3033                 Return _trackwords
3034             End Get
3035             Set(ByVal value As String)
3036                 _trackwords = value
3037             End Set
3038         End Property
3039
3040         Private Sub UserStreamLoop()
3041             Dim st As Stream = Nothing
3042             Dim sr As StreamReader = Nothing
3043             Do
3044                 Try
3045                     If Not NetworkInterface.GetIsNetworkAvailable Then
3046                         Thread.Sleep(30 * 1000)
3047                         Continue Do
3048                     End If
3049
3050                     RaiseEvent Started()
3051
3052                     twCon.UserStream(st, _allAtreplies, _trackwords, My.Application.Info.ProductName + " v" + fileVersion)
3053                     sr = New StreamReader(st)
3054
3055                     Do While _streamActive AndAlso Not sr.EndOfStream
3056                         RaiseEvent StatusArrived(sr.ReadLine())
3057                         'Me.LastTime = Now
3058                     Loop
3059
3060                     If sr.EndOfStream Then
3061                         RaiseEvent Stopped()
3062                         'TraceOut("Stop:EndOfStream")
3063                         Thread.Sleep(10 * 1000)
3064                         Continue Do
3065                     End If
3066                     Exit Do
3067                 Catch ex As WebException
3068                     If Not Me._streamActive Then
3069                         Exit Do
3070                     ElseIf ex.Status = WebExceptionStatus.Timeout Then
3071                         RaiseEvent Stopped()
3072                         TraceOut("Stop:Timeout")
3073                         Thread.Sleep(10 * 1000)
3074                     ElseIf CType(ex.Response, HttpWebResponse).StatusCode = 420 Then
3075                         TraceOut("Stop:Connection Limit")
3076                         Exit Do
3077                     Else
3078                         RaiseEvent Stopped()
3079                         TraceOut("Stop:WebException " & ex.Status.ToString)
3080                         Thread.Sleep(10 * 1000)
3081                     End If
3082                 Catch ex As ThreadAbortException
3083                     Exit Do
3084                 Catch ex As IOException
3085                     If Not Me._streamActive Then
3086                         Exit Do
3087                     Else
3088                         RaiseEvent Stopped()
3089                         TraceOut("Stop:IOException with Active." + Environment.NewLine + ex.Message)
3090                         Thread.Sleep(10 * 1000)
3091                     End If
3092                 Catch ex As ArgumentException
3093                     'System.ArgumentException: ストリームを読み取れませんでした。
3094                     'サーバー側もしくは通信経路上で切断された場合?タイムアウト頻発後発生
3095                     RaiseEvent Stopped()
3096                     TraceOut(ex, "Stop:ArgumentException")
3097                     Thread.Sleep(10 * 1000)
3098                 Catch ex As Exception
3099                     TraceOut("Stop:Exception." + Environment.NewLine + ex.Message)
3100                     ExceptionOut(ex)
3101                 Finally
3102                     If sr IsNot Nothing Then
3103                         twCon.RequestAbort()
3104                         sr.BaseStream.Close()
3105                     End If
3106                 End Try
3107             Loop While True
3108
3109             If _streamActive Then RaiseEvent Stopped()
3110             TraceOut("Stop:EndLoop")
3111         End Sub
3112
3113 #Region "IDisposable Support"
3114         Private disposedValue As Boolean ' 重複する呼び出しを検出するには
3115
3116         ' IDisposable
3117         Protected Overridable Sub Dispose(ByVal disposing As Boolean)
3118             If Not Me.disposedValue Then
3119                 If disposing Then
3120                     ' TODO: マネージ状態を破棄します (マネージ オブジェクト)。
3121                     _streamActive = False
3122                     If _streamThread IsNot Nothing AndAlso _streamThread.IsAlive Then
3123                         _streamThread.Abort()
3124                         _streamThread.Join(1000)
3125                     End If
3126                 End If
3127
3128                 ' TODO: アンマネージ リソース (アンマネージ オブジェクト) を解放し、下の Finalize() をオーバーライドします。
3129                 ' TODO: 大きなフィールドを null に設定します。
3130             End If
3131             Me.disposedValue = True
3132         End Sub
3133
3134         ' TODO: 上の Dispose(ByVal disposing As Boolean) にアンマネージ リソースを解放するコードがある場合にのみ、Finalize() をオーバーライドします。
3135         'Protected Overrides Sub Finalize()
3136         '    ' このコードを変更しないでください。クリーンアップ コードを上の Dispose(ByVal disposing As Boolean) に記述します。
3137         '    Dispose(False)
3138         '    MyBase.Finalize()
3139         'End Sub
3140
3141         ' このコードは、破棄可能なパターンを正しく実装できるように Visual Basic によって追加されました。
3142         Public Sub Dispose() Implements IDisposable.Dispose
3143             ' このコードを変更しないでください。クリーンアップ コードを上の Dispose(ByVal disposing As Boolean) に記述します。
3144             Dispose(True)
3145             GC.SuppressFinalize(Me)
3146         End Sub
3147 #End Region
3148
3149     End Class
3150 #End Region
3151
3152 #Region "IDisposable Support"
3153     Private disposedValue As Boolean ' 重複する呼び出しを検出するには
3154
3155     ' IDisposable
3156     Protected Overridable Sub Dispose(ByVal disposing As Boolean)
3157         If Not Me.disposedValue Then
3158             If disposing Then
3159                 ' TODO: マネージ状態を破棄します (マネージ オブジェクト)。
3160                 Me.StopUserStream()
3161             End If
3162
3163             ' TODO: アンマネージ リソース (アンマネージ オブジェクト) を解放し、下の Finalize() をオーバーライドします。
3164             ' TODO: 大きなフィールドを null に設定します。
3165         End If
3166         Me.disposedValue = True
3167     End Sub
3168
3169     ' TODO: 上の Dispose(ByVal disposing As Boolean) にアンマネージ リソースを解放するコードがある場合にのみ、Finalize() をオーバーライドします。
3170     'Protected Overrides Sub Finalize()
3171     '    ' このコードを変更しないでください。クリーンアップ コードを上の Dispose(ByVal disposing As Boolean) に記述します。
3172     '    Dispose(False)
3173     '    MyBase.Finalize()
3174     'End Sub
3175
3176     ' このコードは、破棄可能なパターンを正しく実装できるように Visual Basic によって追加されました。
3177     Public Sub Dispose() Implements IDisposable.Dispose
3178         ' このコードを変更しないでください。クリーンアップ コードを上の Dispose(ByVal disposing As Boolean) に記述します。
3179         Dispose(True)
3180         GC.SuppressFinalize(Me)
3181     End Sub
3182 #End Region
3183
3184 End Class