Changeset 34152

Show
Ignore:
Timestamp:
06/26/09 11:07:46 (4 years ago)
Author:
syo68k
Message:

一つの書き込みに圧縮されたURLが複数含まれている場合に最初のURLだけしか展開できないバグを修正

Location:
lang/vb2005/Tween/trunk/Tween
Files:
2 modified

Legend:

Unmodified
Added
Removed

  • lang/vb2005/Tween/trunk/Tween/Resources/ChangeLog.txt

    r34097 r34152  
    44-一部URLの取り扱いの変更 
    55-ReTweetの際に<br>タグが紛れ込んでしまうバグを再修正 
     6-一つの書き込みに圧縮されたURLが複数含まれている場合に最初のURLだけしか展開できないバグを修正 
    67***Ver 0.5.0.0(2009/6/15) 
    78-発言詳細の選択文字列クリップボードコピーの不具合修正 

  • lang/vb2005/Tween/trunk/Tween/Twitter.vb

    r33994 r34152  
    10411041    End Function 
    10421042 
     1043    Private Function doShortUrlResolve(ByRef orgData As String) As Boolean 
     1044        Dim replaced As Boolean = False 
     1045        For Each _svc As String In _ShortUrlService 
     1046            Dim svc As String = _svc 
     1047            Dim posl1 As Integer 
     1048            Dim posl2 As Integer = 0 
     1049 
     1050            Do While True 
     1051                If orgData.IndexOf("<a href=""" + svc, posl2, StringComparison.Ordinal) > -1 Then 
     1052                    Dim urlStr As String = "" 
     1053                    Try 
     1054                        posl1 = orgData.IndexOf("<a href=""" + svc, posl2, StringComparison.Ordinal) 
     1055                        posl1 = orgData.IndexOf(svc, posl1, StringComparison.Ordinal) 
     1056                        posl2 = orgData.IndexOf("""", posl1, StringComparison.Ordinal) 
     1057                        urlStr = orgData.Substring(posl1, posl2 - posl1) 
     1058                        Dim Response As String = "" 
     1059                        Dim retUrlStr As String = "" 
     1060                        Dim tmpurlStr As String = urlStr 
     1061                        Dim SchemeAndDomain As Regex = New Regex("http://.+?/+?") 
     1062                        Dim tmpSchemeAndDomain As String = "" 
     1063                        For i As Integer = 0 To 4   'とりあえず5回試す 
     1064                            retUrlStr = urlEncodeMultibyteChar(DirectCast(CreateSocket.GetWebResponse(tmpurlStr, Response, MySocket.REQ_TYPE.ReqGETForwardTo), String)) 
     1065                            If retUrlStr.Length > 0 Then 
     1066                                ' 転送先URLが返された (まだ転送されるかもしれないので返値を引数にしてもう一度) 
     1067                                ' 取得試行回数オーバーの場合は取得結果を転送先とする 
     1068                                Dim scd As Match = SchemeAndDomain.Match(retUrlStr) 
     1069                                If scd.Success AndAlso scd.Value <> svc Then 
     1070                                    svc = scd.Value() 
     1071                                End If 
     1072                                tmpurlStr = retUrlStr 
     1073                                Continue For 
     1074                            Else 
     1075                                ' 転送先URLが返されなかった 
     1076                                If tmpurlStr <> urlStr Then 
     1077                                    '少なくとも一度以上転送されている (前回の結果を転送先とする) 
     1078                                    retUrlStr = tmpurlStr 
     1079                                Else 
     1080                                    ' 一度も転送されていない 
     1081                                    retUrlStr = "" 
     1082                                End If 
     1083                                Exit For 
     1084                            End If 
     1085                        Next 
     1086                        If retUrlStr.Length > 0 Then 
     1087                            If Not retUrlStr.StartsWith("http") Then 
     1088                                If retUrlStr.StartsWith("/") Then 
     1089                                    retUrlStr = urlEncodeMultibyteChar(svc + retUrlStr.Substring(1)) 
     1090                                ElseIf retUrlStr.StartsWith("data:") Then 
     1091                                    ' 
     1092                                Else 
     1093                                    retUrlStr = urlEncodeMultibyteChar(retUrlStr.Insert(0, svc)) 
     1094                                End If 
     1095                            Else 
     1096                                retUrlStr = urlEncodeMultibyteChar(retUrlStr) 
     1097                            End If 
     1098                            orgData = orgData.Replace("<a href=""" + urlStr, "<a href=""" + retUrlStr) 
     1099                            posl2 = 0   '置換した場合は頭から再探索（複数同時置換での例外対応） 
     1100                            replaced = True 
     1101                        End If 
     1102                    Catch ex As Exception 
     1103                        '_signed = False 
     1104                        'Return "GetTimeline -> Err: Can't get tinyurl." 
     1105                    End Try 
     1106                Else 
     1107                    Exit Do 
     1108                End If 
     1109            Loop 
     1110        Next 
     1111        Return replaced 
     1112    End Function 
     1113 
     1114 
    10431115    Private Function ShortUrlResolve(ByVal orgData As String) As String 
    10441116        If _tinyUrlResolve Then 
    1045             For Each svc As String In _ShortUrlService 
    1046                 Dim posl1 As Integer 
    1047                 Dim posl2 As Integer = 0 
    1048  
    1049                 Do While True 
    1050                     If orgData.IndexOf("<a href=""" + svc, posl2, StringComparison.Ordinal) > -1 Then 
    1051                         Dim urlStr As String = "" 
    1052                         Try 
    1053                             posl1 = orgData.IndexOf("<a href=""" + svc, posl2, StringComparison.Ordinal) 
    1054                             posl1 = orgData.IndexOf(svc, posl1, StringComparison.Ordinal) 
    1055                             posl2 = orgData.IndexOf("""", posl1, StringComparison.Ordinal) 
    1056                             urlStr = orgData.Substring(posl1, posl2 - posl1) 
    1057                             Dim Response As String = "" 
    1058                             Dim retUrlStr As String = "" 
    1059                             Dim tmpurlStr As String = urlStr 
    1060                             Dim SchemeAndDomain As Regex = New Regex("http://.+?/+?") 
    1061                             Dim tmpSchemeAndDomain As String = "" 
    1062                             For i As Integer = 0 To 4   'とりあえず5回試す 
    1063                                 retUrlStr = urlEncodeMultibyteChar(DirectCast(CreateSocket.GetWebResponse(tmpurlStr, Response, MySocket.REQ_TYPE.ReqGETForwardTo), String)) 
    1064                                 If retUrlStr.Length > 0 Then 
    1065                                     ' 転送先URLが返された (まだ転送されるかもしれないので返値を引数にしてもう一度) 
    1066                                     ' 取得試行回数オーバーの場合は取得結果を転送先とする 
    1067                                     Dim scd As Match = SchemeAndDomain.Match(retUrlStr) 
    1068                                     If scd.Success AndAlso scd.Value <> svc Then 
    1069                                         svc = scd.Value() 
    1070                                     End If 
    1071                                     tmpurlStr = retUrlStr 
    1072                                     Continue For 
    1073                                 Else 
    1074                                     ' 転送先URLが返されなかった 
    1075                                     If tmpurlStr <> urlStr Then 
    1076                                         '少なくとも一度以上転送されている (前回の結果を転送先とする) 
    1077                                         retUrlStr = tmpurlStr 
    1078                                     Else 
    1079                                         ' 一度も転送されていない 
    1080                                         retUrlStr = "" 
    1081                                     End If 
    1082                                     Exit For 
    1083                                 End If 
    1084                             Next 
    1085                             If retUrlStr.Length > 0 Then 
    1086                                 If Not retUrlStr.StartsWith("http") Then 
    1087                                     If retUrlStr.StartsWith("/") Then 
    1088                                         retUrlStr = urlEncodeMultibyteChar(svc + retUrlStr.Substring(1)) 
    1089                                     ElseIf retUrlStr.StartsWith("data:") Then 
    1090                                         ' 
    1091                                     Else 
    1092                                         retUrlStr = urlEncodeMultibyteChar(retUrlStr.Insert(0, svc)) 
    1093                                     End If 
    1094                                 Else 
    1095                                     retUrlStr = urlEncodeMultibyteChar(retUrlStr) 
    1096                                 End If 
    1097                                 orgData = orgData.Replace("<a href=""" + urlStr, "<a href=""" + retUrlStr) 
    1098                                 posl2 = 0   '置換した場合は頭から再探索（複数同時置換での例外対応） 
    1099                             End If 
    1100                         Catch ex As Exception 
    1101                             '_signed = False 
    1102                             'Return "GetTimeline -> Err: Can't get tinyurl." 
    1103                         End Try 
    1104                     Else 
    1105                         Exit Do 
    1106                     End If 
    1107                 Loop 
    1108             Next 
     1117            Do 
     1118 
     1119            Loop While doShortUrlResolve(orgData) 
    11091120        End If 
    11101121        Return orgData