root/lang/vb2005/Tween/Tween/Twitter.vb @ 29481

Revision 29481, 176.4 kB (checked in by kiri_feather, 4 years ago)

0.2.4.0&0.2.5.0。構造変更後の初リリース

Line 
1' Tween - Client of Twitter
2' Copyright © 2007-2009 kiri_feather (@kiri_feather) <kiri_feather@gmail.com>
3'           © 2008-2009 Moz (@syo68k) <http://iddy.jp/profile/moz/>
4'           © 2008-2009 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
24Imports System.Web
25Imports System.Xml
26Imports System.Text
27Imports System.Threading
28Imports System.IO
29Imports System.Text.RegularExpressions
30
31Public Module Twitter
32    Delegate Sub GetIconImageDelegate(ByVal post As PostClass)
33    Delegate Function GetTimelineDelegate(ByVal page As Integer, _
34                                ByVal read As Boolean, _
35                                ByRef endPage As Integer, _
36                                ByVal gType As WORKERTYPE, _
37                                ByRef getDM As Boolean) As String
38    Delegate Function GetDirectMessageDelegate(ByVal page As Integer, _
39                                    ByVal read As Boolean, _
40                                    ByVal endPage As Integer, _
41                                    ByVal gType As WORKERTYPE) As String
42    Private ReadOnly LockObj As New Object
43    Private GetTmSemaphore As New Threading.Semaphore(8, 8)
44
45    'Private links As New List(Of Long)
46    Private follower As New Collections.Specialized.StringCollection
47    Private tmpFollower As New Collections.Specialized.StringCollection
48
49    'プロパティからアクセスされる共通情報
50    Private _uid As String
51    Private _pwd As String
52    Private _proxyType As ProxyTypeEnum
53    Private _proxyAddress As String
54    Private _proxyPort As Integer
55    Private _proxyUser As String
56    Private _proxyPassword As String
57
58    Private _nextThreshold As Integer
59    Private _nextPages As Integer
60
61    Private _iconSz As Integer
62    Private _getIcon As Boolean
63    Private _lIcon As ImageList
64    Private _dIcon As Dictionary(Of String, Image)
65
66    Private _tinyUrlResolve As Boolean
67    Private _restrictFavCheck As Boolean
68    Private _useAPI As Boolean
69
70    Private _hubServer As String
71
72    'Private _owner As TweenMain
73
74    '共通で使用する状態
75    Private _authKey As String              'StatusUpdate、発言削除で使用
76    Private _authKeyDM As String              'DM送信、DM削除で使用
77    Private _signed As Boolean
78    Private _endingFlag As Boolean
79    Private _infoTwitter As String = ""
80    Private _dmCount As Integer
81    Private _getDm As Boolean
82
83    Private _ShortUrlService() As String = { _
84            "http://tinyurl.com/", _
85            "http://is.gd/", _
86            "http://snipurl.com/", _
87            "http://snurl.com/", _
88            "http://nsfw.in/", _
89            "http://qurlyq.com/", _
90            "http://dwarfurl.com/", _
91            "http://icanhaz.com/", _
92            "http://tiny.cc/", _
93            "http://urlenco.de/", _
94            "http://bit.ly/", _
95            "http://piurl.com/", _
96            "http://linkbee.com/", _
97            "http://traceurl.com/", _
98            "http://twurl.nl/", _
99            "http://cli.gs/", _
100            "http://rubyurl.com/", _
101            "http://budurl.com/" _
102        }
103
104    Private Const _baseUrlStr As String = "twitter.com"
105    Private Const _loginPath As String = "/sessions"
106    Private Const _homePath As String = "/home"
107    Private Const _replyPath As String = "/replies"
108    Private Const _DMPathRcv As String = "/direct_messages"
109    Private Const _DMPathSnt As String = "/direct_messages/sent"
110    Private Const _DMDestroyPath As String = "/direct_messages/destroy/"
111    Private Const _StDestroyPath As String = "/status/destroy/"
112    Private Const _uidHeader As String = "session[username_or_email]="
113    Private Const _pwdHeader As String = "session[password]="
114    Private Const _pageQry As String = "?page="
115    Private Const _statusHeader As String = "status="
116    Private Const _statusUpdatePath As String = "/status/update?page=1&tab=home"
117    Private Const _statusUpdatePathAPI As String = "/statuses/update.xml"
118    Private Const _linkToOld As String = "class=""section_links"" rel=""prev"""
119    Private Const _postFavAddPath As String = "/favourings/create/"
120    Private Const _postFavRemovePath As String = "/favourings/destroy/"
121    Private Const _authKeyHeader As String = "authenticity_token="
122    Private Const _parseLink1 As String = "<a href="""
123    Private Const _parseLink2 As String = """>"
124    Private Const _parseLink3 As String = "</a>"
125    Private Const _GetFollowers As String = "/statuses/followers.xml"
126    Private Const _ShowStatus As String = "/statuses/show/"
127
128
129    '''Wedata対応
130    Private Const wedataUrl As String = "http://wedata.net/databases/Tween/items.json"
131    'テーブル
132    Private Const tbGetMsgDM As String = "GetMsgDM"
133    Private Const tbSplitDM As String = "SplitDM"
134    Private Const tbFollower As String = "Follower"
135    Private Const tbGetStar As String = "GetStar"
136    Private Const tbIsReply As String = "IsReply"
137    Private Const tbGetDate As String = "GetDate"
138    Private Const tbGetMsg As String = "GetMsg"
139    Private Const tbIsProtect As String = "IsProtect"
140    Private Const tbGetImagePath As String = "GetImagePath"
141    Private Const tbGetNick As String = "GetNick"
142    Private Const tbGetName As String = "GetName"
143    'Private Const tbGetSiv As String = "GetSiv"
144    Private Const tbStatusID As String = "StatusID"
145    Private Const tbSplitPostRecent As String = "SplitPostRecent"
146    Private Const tbAuthKey As String = "AuthKey"
147    Private Const tbInfoTwitter As String = "InfoTwitter"
148    Private Const tbSplitPostReply As String = "SplitPostReply"
149    Private Const tbGetDMCount As String = "GetDMCount"
150    '属性
151    Private Const tbTagFrom As String = "tagfrom"
152    Private Const tbTagTo As String = "tagto"
153    Private Const tbTag As String = "tag"
154    Private Const tbTagMbrFrom As String = "tagmbrfrom"
155    Private Const tbTagMbrFrom2 As String = "tagmbrfrom2"
156    Private Const tbTagMbrTo As String = "tagmbrto"
157    Private Const tbTagStatus As String = "status"
158    Private Const tbTagJpnFrom As String = "tagjpnfrom"
159    Private Const tbTagEngFrom As String = "tagengfrom"
160
161    'Public Sub New(ByVal Username As String, _
162    '            ByVal Password As String, _
163    '            ByVal ProxyType As ProxyTypeEnum, _
164    '            ByVal ProxyAddress As String, _
165    '            ByVal ProxyPort As Integer, _
166    '            ByVal ProxyUser As String, _
167    '            ByVal ProxyPassword As String)
168    '    _mySock = New MySocket("UTF-8", Username, Password, ProxyType, ProxyAddress, ProxyPort, ProxyUser, ProxyPassword)
169    '    _uid = Username
170    '    _pwd = Password
171    '    'follower.Add(_uid)
172    '    _proxyType = ProxyType
173    '    _proxyAddress = ProxyAddress
174    '    _proxyPort = ProxyPort
175    '    _proxyUser = ProxyUser
176    '    _proxyPassword = ProxyPassword
177
178    '    '発言保持クラス
179    '    _statuses = TabInformations.GetInstance()
180    'End Sub
181
182    Private Function SignIn() As String
183        If _endingFlag Then Return ""
184
185        'ユーザー情報からデータ部分の生成
186        Dim account As String = ""
187
188        SyncLock LockObj
189            If _signed Then Return ""
190
191            '未認証
192            _signed = False
193
194            MySocket.ResetCookie()
195
196            Dim resStatus As String = ""
197            Dim resMsg As String = ""
198
199            resMsg = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + "/", resStatus, MySocket.REQ_TYPE.ReqGET), String)
200            If resMsg.Length = 0 Then
201                Return "SignIn -> " + resStatus
202            End If
203            Dim authToken As String = ""
204            Dim rg As New Regex("authenticity_token"" type=""hidden"" value=""(?<auth>[a-z0-9]+)""")
205            Dim m As Match = rg.Match(resMsg)
206            If m.Success Then
207                authToken = m.Result("${auth}")
208            Else
209                Return "SignIn -> Can't get token."
210            End If
211
212            account = _authKeyHeader + authToken + "&" + _uidHeader + _uid + "&" + _pwdHeader + _pwd + "&" + "remember_me=1"
213
214            resMsg = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _loginPath, resStatus, MySocket.REQ_TYPE.ReqPOST, account), String)
215            If resMsg.Length = 0 Then
216                Return "SignIn -> " + resStatus
217            End If
218
219            _signed = True
220            Return ""
221        End SyncLock
222    End Function
223
224    Public Function GetTimeline(ByVal page As Integer, _
225                                ByVal read As Boolean, _
226                                ByRef endPage As Integer, _
227                                ByVal gType As WORKERTYPE, _
228                                ByRef getDM As Boolean) As String
229
230        If endPage = 0 Then
231            '通常モード
232            Dim epage As Integer = page
233            GetTmSemaphore.WaitOne()
234            Dim trslt As String = ""
235            trslt = GetTimelineThread(page, read, epage, gType, getDM)
236            If trslt.Length > 0 Then Return trslt
237            page += 1
238            If epage < page OrElse gType = WORKERTYPE.Reply Then Return ""
239            endPage = epage
240        End If
241        '起動時モード or 通常モードの読み込み継続 -> 複数ページ同時取得
242        Dim num As Integer = endPage - page
243        Dim ar(num) As IAsyncResult
244        Dim dlgt(num) As GetTimelineDelegate
245
246        For idx As Integer = 0 To num
247            dlgt(idx) = New GetTimelineDelegate(AddressOf GetTimelineThread)
248            GetTmSemaphore.WaitOne()
249            ar(idx) = dlgt(idx).BeginInvoke(page + idx, read, endPage + idx, gType, getDM, Nothing, Nothing)
250        Next
251        Dim rslt As String = ""
252        For idx As Integer = 0 To num
253            Dim epage As Integer = 0
254            Dim dm As Boolean = False
255            Dim trslt As String = ""
256            Try
257                trslt = dlgt(idx).EndInvoke(epage, dm, ar(idx))
258            Catch ex As Exception
259                '最後までendinvoke回す(ゾンビ化回避)
260                ExceptionOut(ex)
261                rslt = "GetTimelineErr"
262            End Try
263            If trslt.Length > 0 AndAlso rslt.Length = 0 Then rslt = trslt
264            If dm Then getDM = True
265        Next
266        Return rslt
267    End Function
268
269    Private Function GetTimelineThread(ByVal page As Integer, _
270                                ByVal read As Boolean, _
271                                ByRef endPage As Integer, _
272                                ByVal gType As WORKERTYPE, _
273                                ByRef getDM As Boolean) As String
274        Try
275            If _endingFlag Then Return ""
276
277            Dim retMsg As String = ""
278            Dim resStatus As String = ""
279
280            If _signed = False Then
281                retMsg = SignIn()
282                If retMsg.Length > 0 Then
283                    Return retMsg
284                End If
285            End If
286
287            'リクエストメッセージを作成する
288            Dim pageQuery As String
289
290            If page = 1 Then
291                pageQuery = ""
292            Else
293                pageQuery = _pageQry + page.ToString
294            End If
295
296            If gType = WORKERTYPE.Timeline Then
297                retMsg = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _homePath + pageQuery, resStatus), String)
298            Else
299                retMsg = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _replyPath + pageQuery, resStatus), String)
300            End If
301
302            If retMsg.Length = 0 Then
303                _signed = False
304                Return resStatus
305            End If
306
307            ' tr 要素の class 属性を消去
308            Do
309                Dim idx As Integer = retMsg.IndexOf(" class=""hentry", StringComparison.Ordinal)
310                If idx = -1 Then Exit Do
311                retMsg = retMsg.Remove(idx, retMsg.IndexOf("""", idx + 14, StringComparison.Ordinal) - idx + 1) ' 11 = "<tr class=""".Length
312            Loop
313
314            If _endingFlag Then Return ""
315
316            '各メッセージに分割可能か?
317            Dim strSepTmp As String
318            If gType = WORKERTYPE.Timeline Then
319                strSepTmp = _splitPostRecent
320            Else
321                strSepTmp = _splitPost
322            End If
323
324            Dim pos1 As Integer
325            Dim pos2 As Integer
326
327            pos1 = retMsg.IndexOf(strSepTmp, StringComparison.Ordinal)
328            If pos1 = -1 Then
329                '0件 or 取得失敗
330                _signed = False
331                Return "GetTimeline -> Err: tweets count is 0."
332            End If
333
334            Dim strSep() As String = {strSepTmp}
335            Dim posts() As String = retMsg.Split(strSep, StringSplitOptions.RemoveEmptyEntries)
336            Dim intCnt As Integer = 0
337            Dim listCnt As Integer = 0
338            SyncLock LockObj
339                listCnt = TabInformations.GetInstance.ItemCount
340            End SyncLock
341            Dim dlgt(20) As GetIconImageDelegate
342            Dim ar(20) As IAsyncResult
343            Dim arIdx As Integer = -1
344
345            For Each strPost As String In posts
346                intCnt += 1
347
348                If intCnt = 1 Then
349                    If page = 1 And gType = WORKERTYPE.Timeline Then
350                        ''siv取得
351                        'pos1 = strPost.IndexOf(_getSiv, 0)
352                        'If pos1 > 0 Then
353                        '    pos2 = strPost.IndexOf(_getSivTo, pos1 + _getSiv.Length)
354                        '    If pos2 > -1 Then
355                        '        _authSiv = strPost.Substring(pos1 + _getSiv.Length, pos2 - pos1 - _getSiv.Length)
356                        '    Else
357                        '        '取得失敗
358                        '        _signed = False
359                        '        Return "GetTimeline -> Err: Can't get Siv."
360                        '    End If
361                        'Else
362                        '    '取得失敗
363                        '    _signed = False
364                        '    Return "GetTimeline -> Err: Can't get Siv."
365                        'End If
366
367                        'AuthKeyの取得
368                        If GetAuthKey(retMsg) < 0 Then
369                            _signed = False
370                            Return "GetTimeline -> Err: Can't get auth token."
371                        End If
372
373                        'TwitterInfoの取得
374                        pos1 = retMsg.IndexOf(_getInfoTwitter, StringComparison.Ordinal)
375                        If pos1 > -1 Then
376                            pos2 = retMsg.IndexOf(_getInfoTwitterTo, pos1, StringComparison.Ordinal)
377                            If pos2 > -1 Then
378                                _infoTwitter = retMsg.Substring(pos1 + _getInfoTwitter.Length, pos2 - pos1 - _getInfoTwitter.Length)
379                            Else
380                                _infoTwitter = ""
381                            End If
382                        Else
383                            _infoTwitter = ""
384                        End If
385                    End If
386                Else
387
388                    Dim post As New PostClass
389
390                    Try
391                        'Get ID
392                        pos1 = 0
393                        pos2 = strPost.IndexOf(_statusIdTo, 0, StringComparison.Ordinal)
394                        post.Id = Long.Parse(HttpUtility.HtmlDecode(strPost.Substring(0, pos2)))
395                    Catch ex As Exception
396                        _signed = False
397                        TraceOut("TM-ID:" + strPost)
398                        Return "GetTimeline -> Err: Can't get ID."
399                    End Try
400                    'Get Name
401                    Try
402                        pos1 = strPost.IndexOf(_parseName, pos2, StringComparison.Ordinal)
403                        pos2 = strPost.IndexOf(_parseNameTo, pos1, StringComparison.Ordinal)
404                        post.Name = HttpUtility.HtmlDecode(strPost.Substring(pos1 + _parseName.Length, pos2 - pos1 - _parseName.Length))
405                    Catch ex As Exception
406                        _signed = False
407                        TraceOut("TM-Name:" + strPost)
408                        Return "GetTimeline -> Err: Can't get Name."
409                    End Try
410                    'Get Nick
411                    '''バレンタイン対応
412                    If strPost.IndexOf("twitter.com/images/heart.png", pos2, StringComparison.Ordinal) > -1 Then
413                        post.Nickname = post.Name
414                    Else
415                        Try
416                            pos1 = strPost.IndexOf(_parseNick, pos2, StringComparison.Ordinal)
417                            pos2 = strPost.IndexOf(_parseNickTo, pos1 + _parseNick.Length, StringComparison.Ordinal)
418                            post.Nickname = HttpUtility.HtmlDecode(strPost.Substring(pos1 + _parseNick.Length, pos2 - pos1 - _parseNick.Length))
419                        Catch ex As Exception
420                            _signed = False
421                            TraceOut("TM-Nick:" + strPost)
422                            Return "GetTimeline -> Err: Can't get Nick."
423                        End Try
424                    End If
425
426                    '二重取得回避
427                    SyncLock LockObj
428                        If TabInformations.GetInstance.ContainsKey(post.Id) Then Continue For
429                    End SyncLock
430
431                    Dim orgData As String = ""
432                    'バレンタイン
433                    If strPost.IndexOf("<form action=""/status/update"" id=""heartForm", 0, StringComparison.Ordinal) > -1 Then
434                        Try
435                            pos1 = strPost.IndexOf("<strong>", 0, StringComparison.Ordinal)
436                            pos2 = strPost.IndexOf("</strong>", pos1, StringComparison.Ordinal)
437                            orgData = strPost.Substring(pos1 + 8, pos2 - pos1 - 8)
438                        Catch ex As Exception
439                            _signed = False
440                            TraceOut("TM-VBody:" + strPost)
441                            Return "GetTimeline -> Err: Can't get Valentine body."
442                        End Try
443                    End If
444
445
446                    'Get ImagePath
447                    Try
448                        pos1 = strPost.IndexOf(_parseImg, pos2, StringComparison.Ordinal)
449                        pos2 = strPost.IndexOf(_parseImgTo, pos1 + _parseImg.Length, StringComparison.Ordinal)
450                        post.ImageUrl = HttpUtility.HtmlDecode(strPost.Substring(pos1 + _parseImg.Length, pos2 - pos1 - _parseImg.Length))
451                    Catch ex As Exception
452                        _signed = False
453                        TraceOut("TM-Img:" + strPost)
454                        Return "GetTimeline -> Err: Can't get ImagePath."
455                    End Try
456
457                    'Protect
458                    If strPost.IndexOf(_isProtect, pos2, StringComparison.Ordinal) > -1 Then
459                        post.IsProtect = True
460                    End If
461
462                    'Get Message
463                    pos1 = strPost.IndexOf(_parseMsg1, pos2, StringComparison.Ordinal)
464                    If pos1 < 0 Then
465                        'Valentine対応その2
466                        Try
467                            If strPost.IndexOf("<div id=""doyouheart", pos2, StringComparison.Ordinal) > -1 Then
468                                'バレンタイン
469                                orgData += " <3 you! Do you <3 "
470                                pos1 = strPost.IndexOf("<a href", pos2, StringComparison.Ordinal)
471                                pos2 = strPost.IndexOf("?", pos1, StringComparison.Ordinal)
472                                orgData += strPost.Substring(pos1, pos2 - pos1 + 1)
473                            Else
474                                pos1 = strPost.IndexOf(_parseProtectMsg1, pos2, StringComparison.Ordinal)
475                                If pos1 = -1 Then
476                                    'バレンタイン
477                                    orgData += " <3 's "
478                                    pos1 = strPost.IndexOf("<a href", pos2, StringComparison.Ordinal)
479                                    If pos1 > -1 Then
480                                        pos2 = strPost.IndexOf("!", pos1, StringComparison.Ordinal)
481                                        orgData += strPost.Substring(pos1, pos2 - pos1 + 1)
482                                    End If
483                                Else
484                                    'プロテクトメッセージ
485                                    pos2 = strPost.IndexOf(_parseProtectMsg2, pos1, StringComparison.Ordinal)
486                                    orgData = strPost.Substring(pos1 + _parseProtectMsg1.Length, pos2 - pos1 - _parseProtectMsg1.Length).Trim()
487                                End If
488                            End If
489                        Catch ex As Exception
490                            _signed = False
491                            TraceOut("TM-VBody2:" + strPost)
492                            Return "GetTimeline -> Err: Can't get Valentine body2."
493                        End Try
494                    Else
495                        '通常メッセージ
496                        Try
497                            pos2 = strPost.IndexOf(_parseMsg2, pos1, StringComparison.Ordinal)
498                            orgData = strPost.Substring(pos1 + _parseMsg1.Length, pos2 - pos1 - _parseMsg1.Length).Trim()
499                        Catch ex As Exception
500                            _signed = False
501                            TraceOut("TM-Body:" + strPost)
502                            Return "GetTimeline -> Err: Can't get body."
503                        End Try
504                        '原文リンク削除
505                        orgData = Regex.Replace(orgData, "<a href=""https://twitter\.com/" + post.Name + "/status/[0-9]+"">\.\.\.</a>$", "")
506                        'ハート変換
507                        orgData = orgData.Replace("&lt;3", "♡")
508                    End If
509
510                    '短縮URL解決処理(orgData書き換え)
511                    orgData = ShortUrlResolve(orgData)
512
513                    '表示用にhtml整形
514                    post.OriginalData = AdjustHtml(orgData)
515
516                    '単純テキストの取り出し(リンクタグ除去)
517                    Try
518                        post.Data = GetPlainText(orgData)
519                    Catch ex As Exception
520                        _signed = False
521                        TraceOut("TM-Link:" + strPost)
522                        Return "GetTimeline -> Err: Can't parse links."
523                    End Try
524
525                    ' Imageタグ除去(ハロウィン)
526                    Dim ImgTag As New Regex("<img src=.*?/>", RegexOptions.IgnoreCase)
527                    If ImgTag.IsMatch(post.Data) Then post.Data = ImgTag.Replace(post.Data, "<img>")
528
529                    'Get Date
530                    Try
531                        pos1 = strPost.IndexOf(_parseDate, pos2, StringComparison.Ordinal)
532                        pos2 = strPost.IndexOf(_parseDateTo, pos1 + _parseDate.Length, StringComparison.Ordinal)
533                        post.PDate = DateTime.ParseExact(strPost.Substring(pos1 + _parseDate.Length, pos2 - pos1 - _parseDate.Length), "yyyy'-'MM'-'dd'T'HH':'mm':'sszzz", System.Globalization.DateTimeFormatInfo.InvariantInfo, Globalization.DateTimeStyles.None)
534                    Catch ex As Exception
535                        _signed = False
536                        TraceOut("TM-Date:" + strPost)
537                        Return "GetTimeline -> Err: Can't get date."
538                    End Try
539
540                    'from Sourceの取得
541                    Try
542                        pos1 = strPost.IndexOf(_parseSourceFrom, pos2, StringComparison.Ordinal)
543                        If pos1 > -1 Then
544                            pos1 = strPost.IndexOf(_parseSource2, pos1 + 19, StringComparison.Ordinal)
545                            pos2 = strPost.IndexOf(_parseSourceTo, pos1 + 2, StringComparison.Ordinal)
546                            post.Source = HttpUtility.HtmlDecode(strPost.Substring(pos1 + 2, pos2 - pos1 - 2))
547                        Else
548                            post.Source = "Web"
549                        End If
550                    Catch ex As Exception
551                        _signed = False
552                        TraceOut("TM-Src:" + strPost)
553                        Return "GetTimeline -> Err: Can't get src."
554                    End Try
555
556                    'Get Reply(in_reply_to_user/id)
557                    Dim rg As New Regex("<a href=""https?:\/\/twitter\.com\/(?<name>[a-zA-Z0-9_]+)\/status\/(?<id>[0-9]+)"">(?:in reply to |u8fd4u4fe1: )")
558                    Dim m As Match = rg.Match(strPost)
559                    If m.Success Then
560                        post.InReplyToUser = m.Result("${name}")
561                        post.InReplyToId = Long.Parse(m.Result("${id}"))
562                        post.IsReply = post.InReplyToUser.Equals(_uid, StringComparison.OrdinalIgnoreCase)
563                    End If
564
565                    '@先リスト作成
566                    rg = New Regex("@<a href=""\/(?<1>[a-zA-Z0-9_]+)[^a-zA-Z0-9_]")
567                    m = rg.Match(orgData)
568                    While m.Success
569                        post.ReplyToList.Add(m.Groups(1).Value.ToLower())
570                        m = m.NextMatch
571                    End While
572                    If Not post.IsReply Then post.IsReply = post.ReplyToList.Contains(_uid.ToLower())
573
574                    If gType = WORKERTYPE.Reply Then post.IsReply = True
575
576                    'Get Fav
577                    pos1 = strPost.IndexOf(_parseStar, pos2, StringComparison.Ordinal)
578                    If pos1 > -1 Then
579                        Try
580                            pos2 = strPost.IndexOf(_parseStarTo, pos1 + _parseStar.Length, StringComparison.Ordinal)
581                            If strPost.Substring(pos1 + _parseStar.Length, pos2 - pos1 - _parseStar.Length) = _parseStarEmpty Then
582                                post.IsFav = False
583                            Else
584                                post.IsFav = True
585                            End If
586                        Catch ex As Exception
587                            _signed = False
588                            TraceOut("TM-Fav:" + strPost)
589                            Return "GetTimeline -> Err: Can't get fav status."
590                        End Try
591                    Else
592                        post.IsFav = False
593                    End If
594
595
596                    If _endingFlag Then Return ""
597
598                    post.IsMe = post.Name.Equals(_uid, StringComparison.OrdinalIgnoreCase)
599                    SyncLock LockObj
600                        If follower.Count > 1 Then
601                            post.IsOwl = Not follower.Contains(post.Name.ToLower())
602                        Else
603                            post.IsOwl = False
604                        End If
605                    End SyncLock
606                    post.IsRead = read
607
608                    arIdx += 1
609                    dlgt(arIdx) = New GetIconImageDelegate(AddressOf GetIconImage)
610                    ar(arIdx) = dlgt(arIdx).BeginInvoke(post, Nothing, Nothing)
611
612                End If
613
614                'テスト実装:DMカウント取得
615                If intCnt = posts.Length AndAlso gType = WORKERTYPE.Timeline AndAlso page = 1 Then
616                    pos1 = strPost.IndexOf(_parseDMcountFrom, pos2, StringComparison.Ordinal)
617                    If pos1 > -1 Then
618                        Try
619                            pos2 = strPost.IndexOf(_parseDMcountTo, pos1 + _parseDMcountFrom.Length, StringComparison.Ordinal)
620                            Dim dmCnt As Integer = Integer.Parse(strPost.Substring(pos1 + _parseDMcountFrom.Length, pos2 - pos1 - _parseDMcountFrom.Length))
621                            If dmCnt > _dmCount Then
622                                _dmCount = dmCnt
623                                _getDm = True
624                            End If
625                        Catch ex As Exception
626                            Return "GetTimeline -> Err: Can't get DM count."
627                        End Try
628                    End If
629                End If
630                getDM = _getDm
631            Next
632
633            For i As Integer = 0 To arIdx
634                Try
635                    dlgt(i).EndInvoke(ar(i))
636                Catch ex As Exception
637                    '最後までendinvoke回す(ゾンビ化回避)
638                    ExceptionOut(ex)
639                End Try
640            Next
641
642            SyncLock LockObj
643                If page = 1 AndAlso (TabInformations.GetInstance.ItemCount - listCnt) >= _nextThreshold Then
644                    '新着が閾値の件数以上なら、次のページも念のため読み込み
645                    endPage = _nextPages + 1
646                End If
647            End SyncLock
648
649            Return ""
650        Finally
651            GetTmSemaphore.Release()
652        End Try
653    End Function
654
655    Public Function GetDirectMessage(ByVal page As Integer, _
656                                    ByVal read As Boolean, _
657                                    ByVal endPage As Integer, _
658                                    ByVal gType As WORKERTYPE) As String
659        If endPage = 0 Then
660            '通常モード(DMはモード関係なし)
661            endPage = 1
662        End If
663        '起動時モード
664        Dim num As Integer = endPage - page
665        Dim ar(num) As IAsyncResult
666        Dim dlgt(num) As GetDirectMessageDelegate
667
668        For idx As Integer = 0 To num
669            gType = WORKERTYPE.DirectMessegeRcv
670            dlgt(idx) = New GetDirectMessageDelegate(AddressOf GetDirectMessageThread)
671            GetTmSemaphore.WaitOne()
672            ar(idx) = dlgt(idx).BeginInvoke(page + idx, read, endPage + idx, gType, Nothing, Nothing)
673        Next
674        Dim rslt As String = ""
675        For idx As Integer = 0 To num
676            Dim trslt As String = ""
677            Try
678                trslt = dlgt(idx).EndInvoke(ar(idx))
679            Catch ex As Exception
680                '最後までendinvoke回す(ゾンビ化回避)
681                ExceptionOut(ex)
682                rslt = "GetDirectMessageErr"
683            End Try
684            If trslt.Length > 0 AndAlso rslt.Length = 0 Then rslt = trslt
685        Next
686        For idx As Integer = 0 To num
687            gType = WORKERTYPE.DirectMessegeSnt
688            dlgt(idx) = New GetDirectMessageDelegate(AddressOf GetDirectMessageThread)
689            GetTmSemaphore.WaitOne()
690            ar(idx) = dlgt(idx).BeginInvoke(page + idx, read, endPage + idx, gType, Nothing, Nothing)
691        Next
692        For idx As Integer = 0 To num
693            Dim trslt As String = ""
694            Try
695                trslt = dlgt(idx).EndInvoke(ar(idx))
696            Catch ex As Exception
697                '最後までendinvoke回す(ゾンビ化回避)
698                ExceptionOut(ex)
699                rslt = "GetDirectMessageErr"
700            End Try
701            If trslt.Length > 0 AndAlso rslt.Length = 0 Then rslt = trslt
702        Next
703        Return rslt
704    End Function
705
706    Private Function GetDirectMessageThread(ByVal page As Integer, _
707                                    ByVal read As Boolean, _
708                                    ByVal endPage As Integer, _
709                                    ByVal gType As WORKERTYPE) As String
710        Try
711            If _endingFlag Then Return ""
712
713            Dim retMsg As String = ""
714            Dim resStatus As String = ""
715
716            _getDm = False
717            'endPage = page
718
719            If _signed = False Then
720                retMsg = SignIn()
721                If retMsg.Length > 0 Then
722                    Return retMsg
723                End If
724            End If
725
726            If _endingFlag Then Return ""
727
728            'リクエストメッセージを作成する
729            Dim pageQuery As String = _pageQry + page.ToString
730
731            If gType = WORKERTYPE.DirectMessegeRcv Then
732                retMsg = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _DMPathRcv + pageQuery, resStatus), String)
733            Else
734                retMsg = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _DMPathSnt + pageQuery, resStatus), String)
735            End If
736
737            If retMsg.Length = 0 Then
738                _signed = False
739                Return resStatus
740            End If
741
742            ' tr 要素の class 属性を消去
743            Do
744                Dim idx As Integer = retMsg.IndexOf(" class=""hentry", StringComparison.Ordinal)
745                If idx = -1 Then Exit Do
746                retMsg = retMsg.Remove(idx, retMsg.IndexOf("""", idx + 14, StringComparison.Ordinal) - idx + 1) ' 11 = "<tr class=""".Length
747            Loop
748
749            If _endingFlag Then Return ""
750
751            ''AuthKeyの取得
752            'If GetAuthKeyDM(retMsg) < 0 Then
753            '    _signed = False
754            '    Return "GetDirectMessage -> Err: Busy(1)"
755            'End If
756
757            Dim pos1 As Integer
758            Dim pos2 As Integer
759
760            ''Followerの抽出(Webのあて先リストがおかしいのでコメントアウト)
761            'If page = 1 And gType = GetTypes.GET_DMRCV Then
762            '    pos1 = retMsg.IndexOf(_followerList)
763            '    If pos1 = -1 Then
764            '        If follower.Count = 0 Then follower.Add(_uid)
765            '        '取得失敗
766            '        _signed = False
767            '        Return "GetDirectMessage -> Err: Busy(3)"
768            '    End If
769            '    follower.Clear()
770            '    follower.Add(_uid)
771            '    pos1 += _followerList.Length
772            '    pos1 = retMsg.IndexOf(_followerMbr1, pos1)
773            '    Try
774            '        Do While pos1 > -1
775            '            pos2 = retMsg.IndexOf(_followerMbr2, pos1)
776            '            pos1 = retMsg.IndexOf(_followerMbr3, pos2)
777            '            follower.Add(retMsg.Substring(pos2 + _followerMbr2.Length, pos1 - pos2 - _followerMbr2.Length))
778            '            pos1 = retMsg.IndexOf(_followerMbr1, pos1)
779            '        Loop
780            '        follower.RemoveAt(follower.Count - 1)
781            '    Catch ex As Exception
782            '        _signed = False
783            '        Return "GetDirectMessage -> Err: Can't get followers"
784            '    End Try
785            'End If
786
787            '各メッセージに分割可能か?
788            pos1 = retMsg.IndexOf(_splitDM, StringComparison.Ordinal)
789            If pos1 = -1 Then
790                '0件(メッセージなし。エラーの場合もありうるが判別できないので正常として戻す)
791                Return ""
792            End If
793
794            Dim strSep() As String = {_splitDM}
795            Dim posts() As String = retMsg.Split(strSep, StringSplitOptions.RemoveEmptyEntries)
796            Dim intCnt As Integer = 0   'カウンタ
797            Dim listCnt As Integer = 0
798            SyncLock LockObj
799                listCnt = TabInformations.GetInstance.ItemCount
800            End SyncLock
801            Dim dlgt(20) As GetIconImageDelegate
802            Dim ar(20) As IAsyncResult
803            Dim arIdx As Integer = -1
804
805            For Each strPost As String In posts
806                intCnt += 1
807
808                If intCnt > 1 Then  '1件目はヘッダなので無視
809                    'Dim lItem As New MyListItem
810                    Dim post As New PostClass()
811
812                    'Get ID
813                    Try
814                        pos1 = 0
815                        pos2 = strPost.IndexOf("""", 0, StringComparison.Ordinal)
816                        post.Id = Long.Parse(HttpUtility.HtmlDecode(strPost.Substring(0, pos2)))
817                    Catch ex As Exception
818                        _signed = False
819                        TraceOut("DM-ID:" + strPost)
820                        Return "GetDirectMessage -> Err: Can't get ID"
821                    End Try
822
823                    'Get Name
824                    Try
825                        pos1 = strPost.IndexOf(_parseName, pos2, StringComparison.Ordinal)
826                        pos2 = strPost.IndexOf(_parseNameTo, pos1, StringComparison.Ordinal)
827                        post.Name = HttpUtility.HtmlDecode(strPost.Substring(pos1 + _parseName.Length, pos2 - pos1 - _parseName.Length))
828                    Catch ex As Exception
829                        _signed = False
830                        TraceOut("DM-Name:" + strPost)
831                        Return "GetDirectMessage -> Err: Can't get Name"
832                    End Try
833
834                    'Get Nick
835                    Try
836                        pos1 = strPost.IndexOf(_parseNick, pos2, StringComparison.Ordinal)
837                        pos2 = strPost.IndexOf(_parseNickTo, pos1 + _parseNick.Length, StringComparison.Ordinal)
838                        post.Nickname = HttpUtility.HtmlDecode(strPost.Substring(pos1 + _parseNick.Length, pos2 - pos1 - _parseNick.Length))
839                    Catch ex As Exception
840                        _signed = False
841                        TraceOut("DM-Nick:" + strPost)
842                        Return "GetDirectMessage -> Err: Can't get Nick."
843                    End Try
844
845                    SyncLock LockObj
846                        If TabInformations.GetInstance.ContainsKey(post.Id) Then Continue For
847                    End SyncLock
848
849                    'Get ImagePath
850                    Try
851                        pos1 = strPost.IndexOf(_parseImg, pos2, StringComparison.Ordinal)
852                        pos2 = strPost.IndexOf(_parseImgTo, pos1 + _parseImg.Length, StringComparison.Ordinal)
853                        post.ImageUrl = HttpUtility.HtmlDecode(strPost.Substring(pos1 + _parseImg.Length, pos2 - pos1 - _parseImg.Length))
854                    Catch ex As Exception
855                        _signed = False
856                        TraceOut("DM-Img:" + strPost)
857                        Return "GetDirectMessage -> Err: Can't get ImagePath"
858                    End Try
859
860                    'Get Protect
861                    Try
862                        pos1 = strPost.IndexOf(_isProtect, pos2, StringComparison.Ordinal)
863                        If pos1 > -1 Then post.IsProtect = True
864                    Catch ex As Exception
865                        _signed = False
866                        TraceOut("DM-Protect:" + strPost)
867                        Return "GetDirectMessage -> Err: Can't get Protect"
868                    End Try
869
870                    Dim orgData As String = ""
871
872                    'Get Message
873                    Try
874                        pos1 = strPost.IndexOf(_parseDM1, pos2, StringComparison.Ordinal)
875                        If pos1 > -1 Then
876                            pos2 = strPost.IndexOf(_parseDM2, pos1, StringComparison.Ordinal)
877                            orgData = strPost.Substring(pos1 + _parseDM1.Length, pos2 - pos1 - _parseDM1.Length).Trim()
878                        Else
879                            pos1 = strPost.IndexOf(_parseDM11, pos2, StringComparison.Ordinal)
880                            pos2 = strPost.IndexOf(_parseDM2, pos1, StringComparison.Ordinal)
881                            orgData = strPost.Substring(pos1 + _parseDM11.Length, pos2 - pos1 - _parseDM11.Length).Trim()
882                        End If
883                        orgData = Regex.Replace(orgData, "<a href=""https://twitter\.com/" + post.Name + "/status/[0-9]+"">\.\.\.</a>$", "")
884                        orgData = orgData.Replace("&lt;3", "♡")
885                    Catch ex As Exception
886                        _signed = False
887                        TraceOut("DM-Body:" + strPost)
888                        Return "GetDirectMessage -> Err: Can't get body"
889                    End Try
890
891                    '短縮URL解決処理(orgData書き換え)
892                    orgData = ShortUrlResolve(orgData)
893
894                    '表示用にhtml整形
895                    post.OriginalData = AdjustHtml(orgData)
896
897                    '単純テキストの取り出し(リンクタグ除去)
898                    Try
899                        post.Data = GetPlainText(orgData)
900                    Catch ex As Exception
901                        _signed = False
902                        TraceOut("DM-Link:" + strPost)
903                        Return "GetDirectMessage -> Err: Can't parse links"
904                    End Try
905
906                    'Get Date
907                    Try
908                        pos1 = strPost.IndexOf(_parseDate, pos2, StringComparison.Ordinal)
909                        pos2 = strPost.IndexOf(_parseDateTo, pos1 + _parseDate.Length, StringComparison.Ordinal)
910                        post.PDate = DateTime.ParseExact(strPost.Substring(pos1 + _parseDate.Length, pos2 - pos1 - _parseDate.Length), "yyyy'-'MM'-'dd'T'HH':'mm':'sszzz", System.Globalization.DateTimeFormatInfo.InvariantInfo, Globalization.DateTimeStyles.None)
911                    Catch ex As Exception
912                        _signed = False
913                        TraceOut("DM-Date:" + strPost)
914                        Return "GetDirectMessage -> Err: Can't get date."
915                    End Try
916
917
918                    'Get Fav
919                    'pos1 = strPost.IndexOf(_parseStar, pos2)
920                    'pos2 = strPost.IndexOf("""", pos1 + _parseStar.Length)
921                    'If strPost.Substring(pos1 + _parseStar.Length, pos2 - pos1 - _parseStar.Length) = "empty" Then
922                    '    lItem.Fav = False
923                    'Else
924                    '    lItem.Fav = True
925                    'End If
926                    post.IsFav = False
927
928
929                    If _endingFlag Then Return ""
930
931                    '受信DMかの判定で使用
932                    If gType = WORKERTYPE.DirectMessegeRcv Then
933                        post.IsOwl = False
934                    Else
935                        post.IsOwl = True
936                    End If
937
938                    post.IsRead = read
939                    post.IsDm = True
940
941                    'Imageの取得
942                    arIdx += 1
943                    dlgt(arIdx) = New GetIconImageDelegate(AddressOf GetIconImage)
944                    ar(arIdx) = dlgt(arIdx).BeginInvoke(post, Nothing, Nothing)
945                End If
946            Next
947
948            For i As Integer = 0 To arIdx
949                Try
950                    dlgt(i).EndInvoke(ar(i))
951                Catch ex As Exception
952                    ExceptionOut(ex)
953                End Try
954            Next
955
956            Return ""
957
958        Finally
959            GetTmSemaphore.Release()
960        End Try
961    End Function
962
963    Private Function ShortUrlResolve(ByVal orgData As String) As String
964        If _tinyUrlResolve Then
965            For Each svc As String In _ShortUrlService
966                Dim posl1 As Integer
967                Dim posl2 As Integer = 0
968
969                Do While True
970                    If orgData.IndexOf("<a href=""" + svc, posl2, StringComparison.Ordinal) > -1 Then
971                        Dim urlStr As String = ""
972                        Try
973                            posl1 = orgData.IndexOf("<a href=""" + svc, posl2, StringComparison.Ordinal)
974                            posl1 = orgData.IndexOf(svc, posl1, StringComparison.Ordinal)
975                            posl2 = orgData.IndexOf("""", posl1, StringComparison.Ordinal)
976                            urlStr = orgData.Substring(posl1, posl2 - posl1)
977                            Dim Response As String = ""
978                            Dim retUrlStr As String = ""
979                            retUrlStr = DirectCast(CreateSocket.GetWebResponse(urlStr, Response, MySocket.REQ_TYPE.ReqGETForwardTo), String)
980                            If retUrlStr.Length > 0 Then
981                                If Not retUrlStr.StartsWith("http") Then Exit Do
982                                Dim uri As Uri = New Uri(retUrlStr)
983                                Dim sb As StringBuilder = New StringBuilder(uri.Scheme + uri.SchemeDelimiter + uri.Host + uri.AbsolutePath, 256)
984                                For Each c As Char In retUrlStr.Substring(sb.Length)
985                                    If Convert.ToInt32(c) > 127 Then
986                                        sb.Append("%" + Convert.ToInt16(c).ToString("X2"))
987                                    Else
988                                        sb.Append(c)
989                                    End If
990                                Next
991                                orgData = orgData.Replace("<a href=""" + urlStr, "<a href=""" + sb.ToString())
992                            End If
993                        Catch ex As Exception
994                            '_signed = False
995                            'Return "GetTimeline -> Err: Can't get tinyurl."
996                        End Try
997                    Else
998                        Exit Do
999                    End If
1000                Loop
1001            Next
1002        End If
1003        Return orgData
1004    End Function
1005
1006    Private Function GetPlainText(ByVal orgData As String) As String
1007        Dim retStr As String
1008
1009        '単純テキストの取り出し(リンクタグ除去)
1010        If orgData.IndexOf(_parseLink1, StringComparison.Ordinal) = -1 Then
1011            retStr = HttpUtility.HtmlDecode(orgData)
1012        Else
1013            Dim posl1 As Integer
1014            Dim posl2 As Integer
1015            Dim posl3 As Integer = 0
1016
1017            retStr = ""
1018
1019            posl3 = 0
1020            Do While True
1021                posl1 = orgData.IndexOf(_parseLink1, posl3, StringComparison.Ordinal)
1022                If posl1 = -1 Then Exit Do
1023
1024                If (posl3 + _parseLink3.Length <> posl1) Or posl3 = 0 Then
1025                    If posl3 <> 0 Then
1026                        retStr += HttpUtility.HtmlDecode(orgData.Substring(posl3 + _parseLink3.Length, posl1 - posl3 - _parseLink3.Length))
1027                    Else
1028                        retStr += HttpUtility.HtmlDecode(orgData.Substring(0, posl1))
1029                    End If
1030                End If
1031                posl2 = orgData.IndexOf(_parseLink2, posl1, StringComparison.Ordinal)
1032                posl3 = orgData.IndexOf(_parseLink3, posl2, StringComparison.Ordinal)
1033                retStr += HttpUtility.HtmlDecode(orgData.Substring(posl2 + _parseLink2.Length, posl3 - posl2 - _parseLink2.Length))
1034            Loop
1035            retStr += HttpUtility.HtmlDecode(orgData.Substring(posl3 + _parseLink3.Length))
1036        End If
1037
1038        Return retStr
1039    End Function
1040
1041    Private Function AdjustHtml(ByVal orgData As String) As String
1042        Dim retStr As String = orgData
1043        retStr = retStr.Replace("<a href=""/", "<a href=""https://twitter.com/")
1044        retStr = retStr.Replace("<a href=", "<a target=""_self"" href=")
1045        retStr = retStr.Replace(vbLf, "<br>")
1046        Return retStr
1047    End Function
1048
1049    Private Sub GetIconImage(ByVal post As PostClass)
1050        If Not _getIcon Then
1051            post.ImageIndex = -1
1052            TabInformations.GetInstance.AddPost(post)
1053            Exit Sub
1054        End If
1055
1056        'Dim dlgt As New TweenMain.GetImageIndexDelegate(AddressOf _owner.GetImageIndex)
1057        'Try
1058        '    If Not _endingFlag Then
1059        '        post.ImageIndex = DirectCast(_owner.Invoke(dlgt, post), Integer)
1060        '    Else
1061        '        Exit Sub
1062        '    End If
1063        'Catch ex As Exception
1064        '    Exit Sub
1065        'End Try
1066        SyncLock LockObj
1067            post.ImageIndex = _lIcon.Images.IndexOfKey(post.ImageUrl)
1068        End SyncLock
1069
1070        If post.ImageIndex > -1 Then
1071            TabInformations.GetInstance.AddPost(post)
1072            Exit Sub
1073        End If
1074
1075        Dim resStatus As String = ""
1076        Dim img As Image = DirectCast(CreateSocket.GetWebResponse(post.ImageUrl, resStatus, MySocket.REQ_TYPE.ReqGETBinary), System.Drawing.Image)
1077        If img Is Nothing Then
1078            post.ImageIndex = -1
1079            TabInformations.GetInstance.AddPost(post)
1080            Exit Sub
1081        End If
1082
1083        If _endingFlag Then Exit Sub
1084
1085        Dim bmp2 As New Bitmap(_iconSz, _iconSz)
1086        Using g As Graphics = Graphics.FromImage(bmp2)
1087            g.InterpolationMode = Drawing2D.InterpolationMode.High
1088            g.DrawImage(img, 0, 0, _iconSz, _iconSz)
1089        End Using
1090
1091        'Dim dlgt2 As New TweenMain.SetImageDelegate(AddressOf _owner.SetImage)
1092        'Try
1093        '    If Not _endingFlag Then
1094        '        _owner.Invoke(dlgt2, New Object() {post, img, bmp2})
1095        '    Else
1096        '        Exit Sub
1097        '    End If
1098        'Catch ex As Exception
1099        '    Exit Sub
1100        'End Try
1101        SyncLock LockObj
1102            post.ImageIndex = _lIcon.Images.IndexOfKey(post.ImageUrl)
1103            If post.ImageIndex = -1 Then
1104                _dIcon.Add(post.ImageUrl, img)  '詳細表示用ディクショナリに追加
1105                _lIcon.Images.Add(post.ImageUrl, bmp2)
1106                post.ImageIndex = _lIcon.Images.IndexOfKey(post.ImageUrl)
1107            End If
1108        End SyncLock
1109        TabInformations.GetInstance.AddPost(post)
1110    End Sub
1111
1112    Private Function GetAuthKey(ByVal resMsg As String) As Integer
1113        Dim pos1 As Integer
1114        Dim pos2 As Integer
1115
1116        pos1 = resMsg.IndexOf(_getAuthKey, StringComparison.Ordinal)
1117        If pos1 < 0 Then
1118            'データ不正?
1119            Return -7
1120        End If
1121        pos2 = resMsg.IndexOf(_getAuthKeyTo, pos1 + _getAuthKey.Length, StringComparison.Ordinal)
1122        If pos2 > -1 Then
1123            _authKey = resMsg.Substring(pos1 + _getAuthKey.Length, pos2 - pos1 - _getAuthKey.Length)
1124        Else
1125            Return -7
1126        End If
1127
1128        Return 0
1129    End Function
1130
1131    Private Function GetAuthKeyDM(ByVal resMsg As String) As Integer
1132        Dim pos1 As Integer
1133        Dim pos2 As Integer
1134
1135        pos1 = resMsg.IndexOf(_getAuthKey, StringComparison.Ordinal)
1136        If pos1 < 0 Then
1137            'データ不正?
1138            Return -7
1139        End If
1140        pos2 = resMsg.IndexOf("""", pos1 + _getAuthKey.Length, StringComparison.Ordinal)
1141        _authKeyDM = resMsg.Substring(pos1 + _getAuthKey.Length, pos2 - pos1 - _getAuthKey.Length)
1142
1143        Return 0
1144    End Function
1145
1146    Private Structure PostInfo
1147        Public CreatedAt As String
1148        Public Id As String
1149        Public Text As String
1150        Public Sub New(ByVal Created As String, ByVal IdStr As String, ByVal txt As String)
1151            CreatedAt = Created
1152            Id = IdStr
1153            Text = txt
1154        End Sub
1155        Public Shadows Function Equals(ByVal dst As PostInfo) As Boolean
1156            If Me.CreatedAt = dst.CreatedAt AndAlso Me.Id = dst.Id AndAlso Me.Text = dst.Text Then
1157                Return True
1158            Else
1159                Return False
1160            End If
1161        End Function
1162    End Structure
1163
1164    Private Function IsPostRestricted(ByRef resMsg As String) As Boolean
1165        Static _prev As New PostInfo("", "", "")
1166        Dim _current As New PostInfo("", "", "")
1167
1168
1169        Dim xd As XmlDocument = New XmlDocument()
1170        Try
1171            xd.LoadXml(resMsg)
1172            _current.CreatedAt = xd.SelectSingleNode("/status/created_at/text()").Value
1173            _current.Id = xd.SelectSingleNode("/status/id/text()").Value
1174            _current.Text = xd.SelectSingleNode("/status/text/text()").Value
1175
1176            If _current.Equals(_prev) Then
1177                Return True
1178            End If
1179            _prev.CreatedAt = _current.CreatedAt
1180            _prev.Id = _current.Id
1181            _prev.Text = _current.Text
1182        Catch ex As XmlException
1183            Return False
1184        End Try
1185
1186        Return False
1187    End Function
1188
1189    Public Function PostStatus(ByVal postStr As String, ByVal reply_to As Long) As String
1190
1191        If _endingFlag Then Return ""
1192
1193        postStr = postStr.Trim()
1194
1195        'データ部分の生成
1196        Dim dataStr As String
1197        If reply_to = 0 Then
1198            dataStr = _statusHeader + HttpUtility.UrlEncode(postStr) + "&source=Tween"
1199        Else
1200            dataStr = _statusHeader + HttpUtility.UrlEncode(postStr) + "&source=Tween" + "&in_reply_to_status_id=" + HttpUtility.UrlEncode(reply_to.ToString)
1201        End If
1202
1203        Dim resStatus As String = ""
1204        Dim resMsg As String = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _statusUpdatePathAPI, resStatus, MySocket.REQ_TYPE.ReqPOSTAPI, dataStr), String)
1205
1206        If resStatus.StartsWith("OK") Then
1207            If Not postStr.StartsWith("D ", StringComparison.OrdinalIgnoreCase) AndAlso _
1208                    Not postStr.StartsWith("DM ", StringComparison.OrdinalIgnoreCase) AndAlso _
1209                    IsPostRestricted(resMsg) Then
1210                Return "Err:POST規制?"
1211            End If
1212            resStatus = Outputz.Post(CreateSocket, postStr.Length)
1213            If resStatus.Length > 0 Then
1214                Return "Outputz:" + resStatus
1215            Else
1216                Return ""
1217            End If
1218        Else
1219            Return resStatus
1220        End If
1221    End Function
1222
1223    Public Function RemoveStatus(ByVal id As Long) As String
1224        If _endingFlag Then Return ""
1225
1226        'データ部分の生成
1227        Dim resStatus As String = ""
1228        Dim resMsg As String = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _StDestroyPath + id.ToString + ".xml", resStatus, MySocket.REQ_TYPE.ReqPOSTAPI), String)
1229
1230        If resMsg.StartsWith("<?xml") = False OrElse resStatus.StartsWith("OK") = False Then
1231            Return resStatus
1232        End If
1233
1234        Return ""
1235    End Function
1236
1237    Public Function RemoveDirectMessage(ByVal id As Long) As String
1238        If _endingFlag Then Return ""
1239
1240        'データ部分の生成
1241        Dim dataStr As String = _authKeyHeader + HttpUtility.UrlEncode(_authKey)
1242        Dim resStatus As String = ""
1243        Dim resMsg As String = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _DMDestroyPath + id.ToString, resStatus, MySocket.REQ_TYPE.ReqPOSTEncodeProtoVer3, dataStr, "https://" + _baseUrlStr + _DMPathRcv), String)
1244
1245        If resMsg <> " " OrElse resStatus.StartsWith("OK") = False Then
1246            Return resStatus
1247        End If
1248
1249        Return ""
1250    End Function
1251
1252    ' Contributed by shuyoko <http://twitter.com/shuyoko> BEGIN:
1253    Public Function GetBlackFavId(ByVal id As Long, ByRef blackid As Long) As String
1254        Dim dataStr As String = _authKeyHeader + HttpUtility.UrlEncode(_authKey)
1255        Dim resStatus As String = ""
1256        Dim resMsg As String = DirectCast(CreateSocket.GetWebResponse("http://blavotter.hocha.org/blackfav/getblack.php?format=simple&id=" + id.ToString(), resStatus, MySocket.REQ_TYPE.ReqGET), String)
1257
1258        If resStatus.StartsWith("OK") = False Then
1259            Return resStatus
1260        End If
1261
1262        blackid = Long.Parse(resMsg)
1263
1264        Return ""
1265
1266    End Function
1267    ' Contributed by shuyoko <http://twitter.com/shuyoko> END.
1268
1269    Public Function PostFavAdd(ByVal id As Long) As String
1270        If _endingFlag Then Return ""
1271
1272        'データ部分の生成
1273        Dim dataStr As String = _authKeyHeader + HttpUtility.UrlEncode(_authKey)
1274        Dim resStatus As String = ""
1275        Dim resMsg As String = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _postFavAddPath + id.ToString(), resStatus, MySocket.REQ_TYPE.ReqPOSTEncodeProtoVer2, dataStr), String)
1276
1277        If resMsg.StartsWith("$") = False And resMsg <> " " Then
1278            Return resStatus
1279        End If
1280
1281        If _restrictFavCheck = False Then Return ""
1282
1283        'http://twitter.com/statuses/show/id.xml APIを発行して本文を取得
1284
1285        resMsg = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _ShowStatus + id.ToString() + ".xml", resStatus, MySocket.REQ_TYPE.ReqPOSTEncodeProtoVer2), String)
1286
1287        Try
1288            Using rd As Xml.XmlTextReader = New Xml.XmlTextReader(New System.IO.StringReader(resMsg))
1289                rd.Read()
1290                While rd.EOF = False
1291                    If rd.IsStartElement("favorited") Then
1292                        If rd.ReadElementContentAsBoolean() = True Then
1293                            Return ""  '正常にふぁぼれている
1294                        Else
1295                            Return "NG(Restricted?)"  '正常応答なのにふぁぼれてないので制限っぽい
1296                        End If
1297                    Else
1298                        rd.Read()
1299                    End If
1300                End While
1301                rd.Close()
1302            End Using
1303        Catch ex As XmlException
1304            '
1305        End Try
1306
1307        Return ""
1308    End Function
1309
1310    Public Function PostFavRemove(ByVal id As Long) As String
1311        If _endingFlag Then Return ""
1312
1313        'データ部分の生成
1314        Dim dataStr As String = _authKeyHeader + HttpUtility.UrlEncode(_authKey)
1315        Dim resStatus As String = ""
1316        Dim resMsg As String = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _postFavRemovePath + id.ToString(), resStatus, MySocket.REQ_TYPE.ReqPOSTEncodeProtoVer2, dataStr), String)
1317
1318        If resMsg.StartsWith("$") = False And resMsg <> " " Then
1319            Return resStatus
1320        End If
1321
1322        Return ""
1323    End Function
1324
1325    Delegate Function GetFollowersDelegate(ByVal Query As Integer) As String
1326
1327    Private Function GetFollowersMethod(ByVal Query As Integer) As String
1328        Dim resStatus As String = ""
1329        Dim resMsg As String = ""
1330
1331        Try
1332            resMsg = DirectCast(CreateSocket.GetWebResponse("https://" + _hubServer + _GetFollowers + _pageQry + Query.ToString, resStatus, MySocket.REQ_TYPE.ReqPOSTAPI), String)
1333            If resStatus.StartsWith("OK") = False Then
1334                IsThreadError = True
1335                Return resStatus
1336            End If
1337            Using rd As Xml.XmlTextReader = New Xml.XmlTextReader(New System.IO.StringReader(resMsg))
1338                Dim lc As Integer = 0
1339                rd.Read()
1340                While rd.EOF = False
1341                    If rd.IsStartElement("screen_name") Then
1342                        Dim tmp As String = rd.ReadElementString("screen_name").ToLower()
1343                        SyncLock LockObj
1344                            If Not tmpFollower.Contains(tmp) Then
1345                                tmpFollower.Add(tmp)
1346                            End If
1347                        End SyncLock
1348                        lc += 1
1349                    Else
1350                        rd.Read()
1351                    End If
1352                End While
1353            End Using
1354        Catch ex As XmlException
1355            IsThreadError = True
1356            TraceOut("NG(XmlException)")
1357            Return "NG(XmlException)"
1358        End Try
1359
1360        Return ""
1361    End Function
1362
1363    Private _threadErr As Boolean = False
1364
1365    Private Property IsThreadError() As Boolean
1366        Get
1367            Return _threadErr
1368        End Get
1369        Set(ByVal value As Boolean)
1370            _threadErr = value
1371        End Set
1372    End Property
1373
1374    Private Sub GetFollowersCallback(ByVal ar As IAsyncResult)
1375        Dim dlgt As GetFollowersDelegate = DirectCast(ar.AsyncState, GetFollowersDelegate)
1376
1377        Try
1378            Dim ret As String = dlgt.EndInvoke(ar)
1379            If Not ret.Equals("") AndAlso Not IsThreadError Then
1380                TraceOut(ret)
1381                IsThreadError = True
1382            End If
1383        Catch ex As Exception
1384            IsThreadError = True
1385            ExceptionOut(ex)
1386        Finally
1387            semaphore.Release()                     ' セマフォから出る
1388            Interlocked.Decrement(threadNum)        ' スレッド数カウンタを-1
1389        End Try
1390
1391    End Sub
1392
1393    ' キャッシュの検証と読み込み -1を渡した場合は読み込みのみ行う(APIエラーでFollowersCountが取得できなかったとき)
1394
1395    Private Function ValidateCache(ByVal _FollowersCount As Integer) As Integer
1396        Dim CacheFileName As String = Path.Combine(Path.GetDirectoryName(Application.ExecutablePath), "FollowersCache")
1397
1398        If Not File.Exists(CacheFileName) Then
1399            ' 存在しない場合はそのまま帰る
1400            Return _FollowersCount
1401        End If
1402
1403        Dim serializer As Xml.Serialization.XmlSerializer = New Xml.Serialization.XmlSerializer(tmpFollower.GetType())
1404
1405        Try
1406            Using fs As New IO.FileStream(CacheFileName, FileMode.Open)
1407                tmpFollower = CType(serializer.Deserialize(fs), Specialized.StringCollection)
1408            End Using
1409        Catch ex As XmlException
1410            ' 不正なxmlの場合は読み直し
1411            tmpFollower.Clear()
1412            tmpFollower.Add(_uid.ToLower())
1413            Return _FollowersCount
1414        End Try
1415
1416        If _FollowersCount = -1 Then Return tmpFollower.Count
1417
1418        If (_FollowersCount + 1) = tmpFollower.Count Then
1419            '変動がないので読み込みの必要なし
1420            Return 0
1421        ElseIf (_FollowersCount + 1) < tmpFollower.Count Then
1422            '減っている場合はどこが抜けているのかわからないので全部破棄して読み直し
1423            tmpFollower.Clear()
1424            tmpFollower.Add(_uid.ToLower())
1425            Return _FollowersCount
1426        End If
1427
1428        ' 増えた場合は差分だけ読む
1429
1430        Return _FollowersCount - tmpFollower.Count
1431
1432    End Function
1433
1434    Private Sub UpdateCache()
1435        Dim CacheFileName As String = Path.Combine(Path.GetDirectoryName(Application.ExecutablePath), "FollowersCache")
1436
1437        Dim serializer As Xml.Serialization.XmlSerializer = New Xml.Serialization.XmlSerializer(follower.GetType())
1438
1439        Using fs As New IO.FileStream(CacheFileName, FileMode.Create)
1440            serializer.Serialize(fs, follower)
1441        End Using
1442
1443    End Sub
1444
1445    Private semaphore As Threading.Semaphore = Nothing
1446    Private threadNum As Integer = 0
1447
1448    Private Function doGetFollowers(ByVal CacheInvalidate As Boolean) As String
1449#If DEBUG Then
1450        Dim sw As New System.Diagnostics.Stopwatch
1451        sw.Start()
1452#End If
1453        Dim resStatus As String = ""
1454        Dim resMsg As String = ""
1455        Dim i As Integer = 0
1456        Dim DelegateInstance As GetFollowersDelegate = New GetFollowersDelegate(AddressOf GetFollowersMethod)
1457        Dim threadMax As Integer = 4            ' 最大スレッド数
1458        Dim followersCount As Integer = 0
1459
1460        Interlocked.Exchange(threadNum, 0)      ' スレッド数カウンタ初期化
1461        IsThreadError = False
1462        follower.Clear()
1463        tmpFollower.Clear()
1464        follower.Add(_uid.ToLower())
1465        tmpFollower.Add(_uid.ToLower())
1466
1467        resMsg = DirectCast(CreateSocket.GetWebResponse("https://twitter.com/users/show/" + _uid + ".xml", resStatus, MySocket.REQ_TYPE.ReqPOSTAPI), String)
1468        Dim xd As XmlDocument = New XmlDocument()
1469        Try
1470            xd.LoadXml(resMsg)
1471            followersCount = Integer.Parse(xd.SelectSingleNode("/user/followers_count/text()").Value)
1472        Catch ex As XmlException
1473            If CacheInvalidate OrElse ValidateCache(-1) < 0 Then
1474                ' FollowersカウントがAPIで取得できず、なおかつキャッシュから読めなかった
1475                Return "NG"
1476            Else
1477                'キャッシュを読み出せたのでキャッシュを使う
1478                follower = tmpFollower
1479                Return ""
1480            End If
1481        End Try
1482
1483        Dim tmp As Integer
1484
1485        If CacheInvalidate Then
1486            tmp = followersCount
1487        Else
1488            tmp = ValidateCache(followersCount)
1489        End If
1490
1491
1492        If tmp <> 0 Then
1493            i = (tmp + 100) \ 100 - 1 ' Followersカウント取得しページ単位に切り上げる
1494        Else
1495            ' キャッシュの件数に変化がなかった
1496#If DEBUG Then
1497            sw.Stop()
1498            Console.WriteLine(sw.ElapsedMilliseconds)
1499#End If
1500            follower = tmpFollower
1501            Return ""
1502        End If
1503
1504
1505        semaphore = New System.Threading.Semaphore(threadMax, threadMax) 'スレッド最大数
1506
1507        For cnt As Integer = 0 To i
1508            semaphore.WaitOne()                     'セマフォ取得 threadMax以上ならここでブロックされる
1509            Interlocked.Increment(threadNum)        'スレッド数カウンタを+1
1510            DelegateInstance.BeginInvoke(cnt + 1, New System.AsyncCallback(AddressOf GetFollowersCallback), DelegateInstance)
1511        Next
1512
1513        '全てのスレッドの終了を待つ(スレッド数カウンタが0になるまで待機)
1514        Do
1515            Thread.Sleep(50)
1516        Loop Until Interlocked.Add(threadNum, 0) = 0
1517
1518        semaphore.Close()
1519
1520        ' エラーが発生しているならFollowersリストクリア
1521
1522        If IsThreadError Then
1523            ' エラーが発生しているならFollowersリストクリア
1524            SyncLock LockObj
1525                follower.Clear()
1526                follower.Add(_uid.ToLower())
1527            End SyncLock
1528            Return "NG"
1529        End If
1530
1531        follower = tmpFollower
1532        UpdateCache()
1533
1534#If DEBUG Then
1535        sw.Stop()
1536        Console.WriteLine(sw.ElapsedMilliseconds)
1537#End If
1538
1539        Return ""
1540    End Function
1541
1542    Public Function GetFollowers(ByVal CacheInvalidate As Boolean) As String
1543        'Dim retMsg As String = ""
1544        'If _signed = False Then
1545        '    retMsg = SignIn()
1546        '    If retMsg.Length > 0 Then
1547        '        Return retMsg
1548        '    End If
1549        'End If
1550
1551        Return doGetFollowers(CacheInvalidate)
1552    End Function
1553
1554    Public Property Username() As String
1555        Get
1556            Return _uid
1557        End Get
1558        Set(ByVal value As String)
1559            _uid = value
1560        End Set
1561    End Property
1562
1563    Public Property Password() As String
1564        Get
1565            Return _pwd
1566        End Get
1567        Set(ByVal value As String)
1568            _pwd = value
1569        End Set
1570    End Property
1571
1572    Public Property NextThreshold() As Integer
1573        Get
1574            Return _nextThreshold
1575        End Get
1576        Set(ByVal value As Integer)
1577            _nextThreshold = value
1578        End Set
1579    End Property
1580
1581    Public Property NextPages() As Integer
1582        Get
1583            Return _nextPages
1584        End Get
1585        Set(ByVal value As Integer)
1586            _nextPages = value
1587        End Set
1588    End Property
1589
1590    Public Property Ending() As Boolean
1591        Get
1592            Return _endingFlag
1593        End Get
1594        Set(ByVal value As Boolean)
1595            _endingFlag = value
1596        End Set
1597    End Property
1598
1599    Public ReadOnly Property InfoTwitter() As String
1600        Get
1601            Return _infoTwitter
1602        End Get
1603    End Property
1604
1605    Public Property UseAPI() As Boolean
1606        Get
1607            Return _useAPI
1608        End Get
1609        Set(ByVal value As Boolean)
1610            _useAPI = value
1611        End Set
1612    End Property
1613
1614    Public Property HubServer() As String
1615        Get
1616            Return _hubServer
1617        End Get
1618        Set(ByVal value As String)
1619            _hubServer = value
1620        End Set
1621    End Property
1622
1623    Public Sub GetWedata()
1624        Dim resStatus As String = ""
1625        Dim resMsg As String = ""
1626
1627        resMsg = DirectCast(CreateSocket.GetWebResponse(wedataUrl, resStatus, timeOut:=10 * 1000), String) 'タイムアウト時間を10秒に設定
1628        If resMsg.Length = 0 Then Exit Sub
1629
1630        Dim rs As New System.IO.StringReader(resMsg)
1631
1632        Dim mode As Integer = 0 '0:search name 1:search data 2:read data
1633        Dim name As String = ""
1634
1635        'ストリームの末端まで繰り返す
1636        Dim ln As String
1637        While rs.Peek() > -1
1638            ln = rs.ReadLine
1639
1640            Select Case mode
1641                Case 0
1642                    If ln.StartsWith("    ""name"": ") Then
1643                        name = ln.Substring(13, ln.Length - 2 - 13)
1644                        mode += 1
1645                    End If
1646                Case 1
1647                    If ln = "    ""data"": {" Then
1648                        mode += 1
1649                    End If
1650                Case 2
1651                    If ln = "    }," Then
1652                        mode = 0
1653                    Else
1654                        If ln.EndsWith(",") Then ln = ln.Substring(0, ln.Length - 1)
1655                        Select Case name
1656                            Case "SplitPostReply"
1657                                If ln.StartsWith("      ""tagfrom"": """) Then
1658                                    _splitPost = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1659                                End If
1660                            Case "SplitPostRecent"
1661                                If ln.StartsWith("      ""tagfrom"": """) Then
1662                                    _splitPostRecent = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1663                                End If
1664                            Case "StatusID"
1665                                If ln.StartsWith("      ""tagto"": """) Then
1666                                    _statusIdTo = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1667                                End If
1668                            Case "IsProtect"
1669                                If ln.StartsWith("      ""tagfrom"": """) Then
1670                                    _isProtect = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1671                                End If
1672                            Case "IsReply"
1673                                If ln.StartsWith("      ""tagfrom"": """) Then
1674                                    _isReplyEng = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1675                                End If
1676                                If ln.StartsWith("      ""tagfrom2"": """) Then
1677                                    _isReplyJpn = ln.Substring(19, ln.Length - 1 - 19).Replace("\", "")
1678                                End If
1679                                If ln.StartsWith("      ""tagto"": """) Then
1680                                    _isReplyTo = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1681                                End If
1682                            Case "GetStar"
1683                                If ln.StartsWith("      ""tagfrom"": """) Then
1684                                    _parseStar = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1685                                End If
1686                                If ln.StartsWith("      ""tagfrom2"": """) Then
1687                                    _parseStarEmpty = ln.Substring(19, ln.Length - 1 - 19).Replace("\", "")
1688                                End If
1689                                If ln.StartsWith("      ""tagto"": """) Then
1690                                    _parseStarTo = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1691                                End If
1692                            Case "Follower"
1693                                If ln.StartsWith("      ""tagfrom"": """) Then
1694                                    _followerList = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1695                                End If
1696                                If ln.StartsWith("      ""tagfrom2"": """) Then
1697                                    _followerMbr1 = ln.Substring(19, ln.Length - 1 - 19).Replace("\", "")
1698                                End If
1699                                If ln.StartsWith("      ""tagfrom3"": """) Then
1700                                    _followerMbr2 = ln.Substring(19, ln.Length - 1 - 19).Replace("\", "")
1701                                End If
1702                                If ln.StartsWith("      ""tagto"": """) Then
1703                                    _followerMbr3 = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1704                                End If
1705                            Case "SplitDM"
1706                                If ln.StartsWith("      ""tagfrom"": """) Then
1707                                    _splitDM = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1708                                End If
1709                            Case "GetMsgDM"
1710                                If ln.StartsWith("      ""tagfrom"": """) Then
1711                                    _parseDM1 = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1712                                End If
1713                                If ln.StartsWith("      ""tagfrom2"": """) Then
1714                                    _parseDM11 = ln.Substring(19, ln.Length - 1 - 19).Replace("\", "")
1715                                End If
1716                                If ln.StartsWith("      ""tagto"": """) Then
1717                                    _parseDM2 = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1718                                End If
1719                            Case "GetDate"
1720                                If ln.StartsWith("      ""tagfrom"": """) Then
1721                                    _parseDate = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1722                                End If
1723                                If ln.StartsWith("      ""tagto"": """) Then
1724                                    _parseDateTo = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1725                                End If
1726                            Case "GetMsg"
1727                                If ln.StartsWith("      ""tagfrom"": """) Then
1728                                    _parseMsg1 = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1729                                End If
1730                                If ln.StartsWith("      ""tagto"": """) Then
1731                                    _parseMsg2 = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1732                                End If
1733                            Case "GetImagePath"
1734                                If ln.StartsWith("      ""tagfrom"": """) Then
1735                                    _parseImg = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1736                                End If
1737                                If ln.StartsWith("      ""tagto"": """) Then
1738                                    _parseImgTo = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1739                                End If
1740                            Case "GetNick"
1741                                If ln.StartsWith("      ""tagfrom"": """) Then
1742                                    _parseNick = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1743                                End If
1744                                If ln.StartsWith("      ""tagto"": """) Then
1745                                    _parseNickTo = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1746                                End If
1747                            Case "GetName"
1748                                If ln.StartsWith("      ""tagfrom"": """) Then
1749                                    _parseName = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1750                                End If
1751                                If ln.StartsWith("      ""tagto"": """) Then
1752                                    _parseNameTo = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1753                                End If
1754                                'Case "GetSiv"
1755                                '    If ln.StartsWith("      ""tagfrom"": """) Then
1756                                '        _getSiv = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1757                                '    End If
1758                                '    If ln.StartsWith("      ""tagto"": """) Then
1759                                '        _getSivTo = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1760                                '    End If
1761                            Case "AuthKey"
1762                                If ln.StartsWith("      ""tagfrom"": """) Then
1763                                    _getAuthKey = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1764                                End If
1765                                If ln.StartsWith("      ""tagto"": """) Then
1766                                    _getAuthKeyTo = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1767                                End If
1768                            Case "InfoTwitter"
1769                                If ln.StartsWith("      ""tagfrom"": """) Then
1770                                    _getInfoTwitter = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1771                                End If
1772                                If ln.StartsWith("      ""tagto"": """) Then
1773                                    _getInfoTwitterTo = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1774                                End If
1775                            Case "GetProtectMsg"
1776                                If ln.StartsWith("      ""tagfrom"": """) Then
1777                                    _parseProtectMsg1 = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1778                                End If
1779                                If ln.StartsWith("      ""tagto"": """) Then
1780                                    _parseProtectMsg2 = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1781                                End If
1782                            Case "GetDMCount"
1783                                If ln.StartsWith("      ""tagfrom"": """) Then
1784                                    _parseDMcountFrom = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1785                                End If
1786                                If ln.StartsWith("      ""tagto"": """) Then
1787                                    _parseDMcountTo = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1788                                End If
1789                            Case "GetSource"
1790                                If ln.StartsWith("      ""tagfrom"": """) Then
1791                                    _parseSourceFrom = ln.Substring(18, ln.Length - 1 - 18).Replace("\", "")
1792                                End If
1793                                If ln.StartsWith("      ""tagfrom2"": """) Then
1794                                    _parseSource2 = ln.Substring(19, ln.Length - 1 - 19).Replace("\", "")
1795                                End If
1796                                If ln.StartsWith("      ""tagto"": """) Then
1797                                    _parseSource2 = ln.Substring(16, ln.Length - 1 - 16).Replace("\", "")
1798                                End If
1799                        End Select
1800                    End If
1801            End Select
1802        End While
1803
1804        rs.Close()
1805
1806#If DEBUG Then
1807        GenerateAnalyzeKey()
1808#End If
1809    End Sub
1810
1811    Public WriteOnly Property GetIcon() As Boolean
1812        Set(ByVal value As Boolean)
1813            _getIcon = value
1814        End Set
1815    End Property
1816
1817    Public WriteOnly Property TinyUrlResolve() As Boolean
1818        Set(ByVal value As Boolean)
1819            _tinyUrlResolve = value
1820        End Set
1821    End Property
1822
1823    Public WriteOnly Property ProxyType() As ProxyTypeEnum
1824        Set(ByVal value As ProxyTypeEnum)
1825            _proxyType = value
1826        End Set
1827    End Property
1828
1829    Public WriteOnly Property ProxyAddress() As String
1830        Set(ByVal value As String)
1831            _proxyAddress = value
1832        End Set
1833    End Property
1834
1835    Public WriteOnly Property ProxyPort() As Integer
1836        Set(ByVal value As Integer)
1837            _proxyPort = value
1838        End Set
1839    End Property
1840
1841    Public WriteOnly Property ProxyUser() As String
1842        Set(ByVal value As String)
1843            _proxyUser = value
1844        End Set
1845    End Property
1846
1847    Public WriteOnly Property ProxyPassword() As String
1848        Set(ByVal value As String)
1849            _proxyPassword = value
1850        End Set
1851    End Property
1852
1853    Public WriteOnly Property RestrictFavCheck() As Boolean
1854        Set(ByVal value As Boolean)
1855            _restrictFavCheck = value
1856        End Set
1857    End Property
1858
1859    Public WriteOnly Property IconSize() As Integer
1860        Set(ByVal value As Integer)
1861            _iconSz = value
1862        End Set
1863    End Property
1864
1865    Public Function MakeShortUrl(ByVal ConverterType As UrlConverter, ByVal SrcUrl As String) As String
1866        Dim ret As String = ""
1867        Dim resStatus As String = ""
1868
1869        For Each svc As String In _ShortUrlService
1870            If SrcUrl.StartsWith(svc) Then
1871                Return "Can't convert"
1872            End If
1873        Next
1874
1875        SrcUrl = HttpUtility.UrlEncode(SrcUrl)
1876        Select Case ConverterType
1877            Case UrlConverter.TinyUrl       'tinyurl
1878                If SrcUrl.StartsWith("http") Then
1879                    If SrcUrl.StartsWith("http://tinyurl.com/") Then
1880                        Return "Can't convert"
1881                    End If
1882                    Try
1883                        ret = DirectCast(CreateSocket.GetWebResponse("http://tinyurl.com/api-create.php?url=" + SrcUrl, resStatus, MySocket.REQ_TYPE.ReqPOSTEncode), String)
1884                    Catch ex As Exception
1885                        Return "Can't convert"
1886                    End Try
1887                End If
1888                If Not ret.StartsWith("http://tinyurl.com/") Then
1889                    Return "Can't convert"
1890                End If
1891            Case UrlConverter.Isgd
1892                If SrcUrl.StartsWith("http") Then
1893                    If SrcUrl.StartsWith("http://is.gd/") Then
1894                        Return "Can't convert"
1895                    End If
1896                    Try
1897                        ret = DirectCast(CreateSocket.GetWebResponse("http://is.gd/api.php?longurl=" + SrcUrl, resStatus, MySocket.REQ_TYPE.ReqPOSTEncode), String)
1898                    Catch ex As Exception
1899                        Return "Can't convert"
1900                    End Try
1901                End If
1902                If Not ret.StartsWith("http://is.gd/") Then
1903                    Return "Can't convert"
1904                End If
1905        End Select
1906
1907        Return ret
1908    End Function
1909
1910    Public Function GetVersionInfo() As String
1911        Dim resStatus As String = ""
1912        Return DirectCast(CreateSocket.GetWebResponse("http://tween.sourceforge.jp/version2.txt?" + Now.ToString("yyMMddHHmmss") + Environment.TickCount.ToString(), resStatus), String)
1913    End Function
1914
1915    Public Function GetTweenBinary(ByVal strVer As String) As String
1916        Dim resStatus As String = ""
1917        Dim ret As String = ""
1918        ret = DirectCast(CreateSocket.GetWebResponse("http://tween.sourceforge.jp/Tween" + strVer + ".gz?" + Now.ToString("yyMMddHHmmss") + Environment.TickCount.ToString(), resStatus, MySocket.REQ_TYPE.ReqGETFile), String)
1919        If ret.Length = 0 Then
1920            '取得OKなら、続いてresources.dllダウンロード
1921            Return GetTweenResourcesDll(strVer)
1922        Else
1923            Return ret
1924        End If
1925    End Function
1926
1927    Public Function GetTweenUpBinary() As String
1928        Dim resStatus As String = ""
1929        Return DirectCast(CreateSocket.GetWebResponse("http://tween.sourceforge.jp/TweenUp.gz?" + Now.ToString("yyMMddHHmmss") + Environment.TickCount.ToString(), resStatus, MySocket.REQ_TYPE.ReqGETFileUp), String)
1930    End Function
1931
1932    Public Function GetTweenResourcesDll(ByVal strver As String) As String
1933        Dim resStatus As String = ""
1934        Return DirectCast(CreateSocket.GetWebResponse("http://tween.sourceforge.jp/TweenRes" + strver + ".gz?" + Now.ToString("yyMMddHHmmss") + Environment.TickCount.ToString(), resStatus, MySocket.REQ_TYPE.ReqGETFileRes), String)
1935    End Function
1936
1937    Private Function CreateSocket() As MySocket
1938        Return New MySocket("UTF-8", _uid, _pwd, _proxyType, _proxyAddress, _proxyPort, _proxyUser, _proxyPassword)
1939    End Function
1940
1941    'Public WriteOnly Property Owner() As TweenMain
1942    '    Set(ByVal value As TweenMain)
1943    '        _owner = value
1944    '    End Set
1945    'End Property
1946
1947    Public WriteOnly Property ListIcon() As ImageList
1948        Set(ByVal value As ImageList)
1949            _lIcon = value
1950        End Set
1951    End Property
1952
1953    Public WriteOnly Property DetailIcon() As Dictionary(Of String, Image)
1954        Set(ByVal value As Dictionary(Of String, Image))
1955            _dIcon = value
1956        End Set
1957    End Property
1958
1959#If DEBUG Then
1960    Public Sub GenerateAnalyzeKey()
1961        '解析キー情報部分のソースをwedataから作成する
1962        '生成したソースはプロジェクトのディレクトリにコピーする
1963        Dim sw As New System.IO.StreamWriter(".\AnalyzeKey.vb", _
1964            False, _
1965            System.Text.Encoding.UTF8)
1966
1967        sw.WriteLine("Public Module AnalyzeKey")
1968        sw.WriteLine("'    このファイルはデバッグビルドのTweenにより自動作成されました   作成日時  " + DateAndTime.Now.ToString())
1969        sw.WriteLine("")
1970
1971        sw.WriteLine("    Public _splitPost As String = " + Chr(34) + _splitPost.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1972        sw.WriteLine("    Public _splitPostRecent As String = " + Chr(34) + _splitPostRecent.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1973        sw.WriteLine("    Public _statusIdTo As String = " + Chr(34) + _statusIdTo.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1974        sw.WriteLine("    Public _splitDM As String = " + Chr(34) + _splitDM.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1975        sw.WriteLine("    Public _parseName As String = " + Chr(34) + _parseName.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1976        sw.WriteLine("    Public _parseNameTo As String = " + Chr(34) + _parseNameTo.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1977        sw.WriteLine("    Public _parseNick As String = " + Chr(34) + _parseNick.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1978        sw.WriteLine("    Public _parseNickTo As String = " + Chr(34) + _parseNickTo.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1979        sw.WriteLine("    Public _parseImg As String = " + Chr(34) + _parseImg.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1980        sw.WriteLine("    Public _parseImgTo As String = " + Chr(34) + _parseImgTo.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1981        sw.WriteLine("    Public _parseMsg1 As String = " + Chr(34) + _parseMsg1.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1982        sw.WriteLine("    Public _parseMsg2 As String = " + Chr(34) + _parseMsg2.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1983        sw.WriteLine("    Public _parseDM1 As String = " + Chr(34) + _parseDM1.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1984        sw.WriteLine("    Public _parseDM11 As String = " + Chr(34) + _parseDM11.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1985        sw.WriteLine("    Public _parseDM2 As String = " + Chr(34) + _parseDM2.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1986        sw.WriteLine("    Public _parseDate As String = " + Chr(34) + _parseDate.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1987        sw.WriteLine("    Public _parseDateTo As String = " + Chr(34) + _parseDateTo.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1988        sw.WriteLine("    Public _getAuthKey As String = " + Chr(34) + _getAuthKey.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1989        sw.WriteLine("    Public _getAuthKeyTo As String = " + Chr(34) + _getAuthKeyTo.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1990        sw.WriteLine("    Public _parseStar As String = " + Chr(34) + _parseStar.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1991        sw.WriteLine("    Public _parseStarTo As String = " + Chr(34) + _parseStarTo.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1992        sw.WriteLine("    Public _parseStarEmpty As String = " + Chr(34) + _parseStarEmpty.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1993        sw.WriteLine("    Public _followerList As String = " + Chr(34) + _followerList.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1994        sw.WriteLine("    Public _followerMbr1 As String = " + Chr(34) + _followerMbr1.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1995        sw.WriteLine("    Public _followerMbr2 As String = " + Chr(34) + _followerMbr2.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1996        sw.WriteLine("    Public _followerMbr3 As String = " + Chr(34) + _followerMbr3.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1997        sw.WriteLine("    Public _getInfoTwitter As String = " + Chr(34) + _getInfoTwitter.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1998        sw.WriteLine("    Public _getInfoTwitterTo As String = " + Chr(34) + _getInfoTwitterTo.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
1999        sw.WriteLine("    Public _isProtect As String = " + Chr(34) + _isProtect.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
2000        sw.WriteLine("    Public _isReplyEng As String = " + Chr(34) + _isReplyEng.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
2001        sw.WriteLine("    Public _isReplyJpn As String = " + Chr(34) + _isReplyJpn.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
2002        sw.WriteLine("    Public _isReplyTo As String = " + Chr(34) + _isReplyTo.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
2003        sw.WriteLine("    Public _parseProtectMsg1 As String = " + Chr(34) + _parseProtectMsg1.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
2004        sw.WriteLine("    Public _parseProtectMsg2 As String = " + Chr(34) + _parseProtectMsg2.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
2005        sw.WriteLine("    Public _parseDMcountFrom As String = " + Chr(34) + _parseDMcountFrom.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
2006        sw.WriteLine("    Public _parseDMcountTo As String = " + Chr(34) + _parseDMcountTo.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
2007        sw.WriteLine("    Public _parseSourceFrom As String = " + Chr(34) + _parseSourceFrom.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
2008        sw.WriteLine("    Public _parseSource2 As String = " + Chr(34) + _parseSource2.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
2009        sw.WriteLine("    Public _parseSourceTo As String = " + Chr(34) + _parseSourceTo.Replace(Chr(34), Chr(34) + Chr(34)) + Chr(34))
2010        sw.WriteLine("End Module")
2011
2012        sw.Close()
2013        'MessageBox.Show("解析キー情報定義ファイル AnalyzeKey.vbを生成しました")
2014
2015    End Sub
2016#End If
2017End Module
Note: See TracBrowser for help on using the browser.