IE11 Webbrowser заставил программу внезапно завершить работу, VB6

Код загружает видео с Youtube, а скомпилированный exe хорошо работает в IE9 и 10, но вчера я обновился до IE11, Win7 x64.

Запускаю программу на VB6 кнопкой F5, программа работает плавно. Но когда я компилирую его в EXE, как только я использую веб-браузер, открываю страницу YouTube, программа внезапно закрывается.

В чем разница между отладочным запуском программы в режиме VB6 IDE и в режиме EXE? Могу я исправить проблему?

Private Sub wb2_DocumentComplete(ByVal pDisp As Object, URL As Variant)

При ошибке Возобновить Далее

Если wbStop = True, то выйдите из Sub

Если (pDisp Is wb2.Object), то

Dim xxx As Integer










Dim tmpFmt As String

If strHD = "&fmt=22" Then
    tmpFmt = "18|"
ElseIf strHD = "&fmt=" Then
    tmpFmt = "22|"
Else
    tmpFmt = ",5|"
End If




timer39.Enabled = True


Dim bb As Boolean
bb = True
Dim sstr As String

Dim coolstr As String

Dim ccstr As String
Dim ddstr As String

urlstr = ""

Dim url18 As String
Dim url22 As String
Dim url34 As String
Dim url35 As String
Dim url37 As String
Dim url38 As String

Dim itag As String
Dim itagB As Boolean



Dim hd As Integer

Dim bbb As Boolean
Dim mmm As Long

Dim aaa As Boolean

aaa = False

Dim tType As String

tType = ""



    bbb = False

wb2.Silent = True


Dim xbb As Boolean




Dim strSig As String

Dim BoolSig As Boolean






strSig = ""

'Download Video
    If onoff = True Then


        coolstr = ""



        For k = 0 To wb2.Document.All.Length - 1
            If wb2.Document.All.Item(k).tagName = "HEAD" Then
                hd = k
                Exit For
            End If
        Next k

        coolstr = wb2.Document.All.Item(hd).innerhtml & " " & wb2.Document.body.innerhtml
        'coolstr = wb2.Document.all.item(0).





        Text2.Text = "1"
        LV.ListItems(1).ListSubItems(1).Text = "Analysing HD Video URL 10%"
        Debug.Print coolstr

        coolstr = URLDecode(coolstr)

        coolstr = Replace(coolstr, "\u0026", "&")

        'coolstr = URLDecode(coolstr)
        'coolstr = URLDecode(coolstr)
        'coolstr = URLDecode(coolstr)
        'coolstr = URLDecode(coolstr)


        'Debug.Print coolstr

        Open "c:\ylog.txt" For Output As #3
        Print #3, coolstr
        Close #3



        urlstr = ""

        Text2.Text = "2"
        LV.ListItems(1).ListSubItems(1).Text = "Analysing HD Video URL 20%"



        itagB = False

        itag = "itag=37"


        Url_Encode_pos = 1
        For I = 1 To Len(coolstr) - 7
            If UCase(Mid(coolstr, I, 7)) = UCase(itag) Then
                Url_Encode_pos = I
                itagB = True
                Exit For
            End If
        Next I

        Text2.Text = itag


        If itagB = False Then
            itag = "itag=22"

            For I = 1 To Len(coolstr) - 7
                If UCase(Mid(coolstr, I, 7)) = UCase(itag) Then
                    Url_Encode_pos = I
                    itagB = True
                    Exit For
                End If
            Next I

        End If

         Text2.Text = itag


        If itagB = False Then
            itag = "itag=18"

            For I = 1 To Len(coolstr) - 7
                If UCase(Mid(coolstr, I, 7)) = UCase(itag) Then
                    Url_Encode_pos = I
                    itagB = True
                    Exit For
                End If
            Next I

        End If

        Text2.Text = itag

         If itagB = False Then Exit Sub



       For I = 1 To Len(coolstr) - 40
                If UCase(Mid(coolstr, I, 40)) = UCase("\/\/s.ytimg.com\/yts\/jsbin\/html5player") Then
                    For js = I + 40 To Len(coolstr) - 40
                        If Mid(coolstr, js, 1) <> Chr(34) Then
                            urlJs = urlJs & Mid(coolstr, js, 1)
                        Else
                            Exit For
                        End If
                    Next js
                    Exit For
                End If
            Next I

        urlJs = "http:\/\/s.ytimg.com\/yts\/jsbin\/html5player" & urlJs

       urlJs = Replace(urlJs, "\/", "/")
       Debug.Print urlJs

       LV.ListItems(1).ListSubItems(1).Text = "Analysing HD Video URL 30%"
        xbb = False


        Text2.Text = ""

                lstSig.Clear
                lstURL.Clear



        urlstr = ""
        For I = Url_Encode_pos To Len(coolstr)
            If Mid(coolstr, I, 1) <> "," Then
                urlstr = urlstr & Mid(coolstr, I, 1)
            Else
                Exit For
            End If


        Next I

        For I = Url_Encode_pos - 1 To 1 Step -1
            If Mid(coolstr, I, 1) <> "," Then
                urlstr = Mid(coolstr, I, 1) & urlstr
            Else
                Exit For
            End If


        Next I

            urlstr = URLDecode(urlstr)
            urlstr = URLDecode(urlstr)
            urlstr = URLDecode(urlstr)

            urlstr = Replace(urlstr, Chr(34) & "url_encoded_fmt_stream_map" & Chr(34) & ": " & Chr(34), "")
            urlstr = Replace(urlstr, Chr(38) & " ", "")
            urlstr = Replace(urlstr, Chr(38) & Chr(38), Chr(38))

            Debug.Print urlstr


            urlstr = Trim(urlstr)

            If Mid(urlstr, 1, 2) = "s=" Then urlstr = "signature=" & Right(urlstr, Len(urlstr) - 2)

            ss = ""
            For I = 1 To Len(urlstr)

                If Mid(urlstr, I, 4) <> "url=" Then

                    ss = ss & Mid(urlstr, I, 1)

                Else

                    urlstr = Right(urlstr, Len(urlstr) - I - 3)
                    Exit For

                End If

            Next I

            Debug.Print ss





            urlstr = urlstr & "&" & ss


            urlstr = Replace(urlstr, "sig=", "signature=")
            urlstr = Replace(urlstr, "&s=", "&signature=")
            urlstr = Replace(urlstr, "?s=", "?signature=")


            If InStr(1, urlstr, "signature=") = 0 Then Exit Sub


            urlstr = Replace(urlstr, "&" & itag, "")
            urlstr = Replace(urlstr, "?" & itag, "?")

            'If InStr(1, urlstr, "itag") = 0 Then urlstr = urlstr & "&" & itag


            urlstr = urlstr & "&" & itag




            Debug.Print urlstr

            Label2.Caption = "sig: " & lstSig.ListCount
            Label3.Caption = "URL: " & lstURL.ListCount


                Text2.Text = "&" & itag
                LV.ListItems(1).ListSubItems(1).Text = "Analysing HD Video URL 40%"


                'urlstr = Replace(urlstr, "\u0026", Chr(38))
                Debug.Print urlstr

                Open "c:\urllog.txt" For Output As #3
                Print #3, urlstr
                Close #3



                tmpstr = ""








            If urlstr = "" Then Exit Sub



                        Text2.Text = "&" & itag

                        LV.ListItems(1).ListSubItems(1).Text = "Analysing HD Video URL 70%"

        timerOut.Enabled = False

       TimerCheck.Enabled = False


        Debug.Print urlstr


        'Debug.Print urlstr

        'For I = 1 To Len(sstr) - 4
        '    If Mid(sstr, I, 4) = "amp;" Then
        '        sstr = Mid(sstr, 1, I - 1) & Mid(sstr, I + 4, Len(sstr) - 1)
        '
        '        Exit For
        '    End If
        'Next I

        'Debug.Print sstr


        Dim comd As String
        picPro.Visible = True
        psb.Value = 0
        Shape1.Visible = True
        imgPB.Visible = True
        'frmDrag.lblPro.Visible = True
        Label1.Caption = "Downloading..."
        LV.ListItems(1).ListSubItems(1).Text = "Downloading..."
        Label1.Visible = True


        asked = False













        bb = True

        sstr = ""
        For I = 1 To Len(wb2.LocationURL) - 2
            If Mid(wb2.LocationURL, I, 2) = "v=" Then
                bb = False

                For m = I + 2 To Len(wb2.LocationURL)
                    If Mid(wb2.LocationURL, m, 1) <> "=" And Mid(wb2.LocationURL, m, 1) <> "&" Then
                        sstr = sstr & Mid(wb2.LocationURL, m, 1)
                    Else
                        Exit For
                    End If
                    'Debug.Print sstr
                Next m
                Exit For
            End If
            'Debug.Print wb2.LocationURL
            'Debug.Print sstr
            'Debug.Print I
        Next I

        'Debug.Print sstr
        'Debug.Print wb2.LocationURL



        'If strHD = "&fmt=18" Then
        '    Debug.Print urlstr
        '    Debug.Print wbStop
        '    Debug.Print mmm
        'End If


        If bb = False Then

            videoid = sstr
        Else

        End If
        'Debug.Print videoid

        'urlstr = "http://www.youtube.com/get_video?asv=&video_id=" & videoid & "&t=" & urlstr
        'urlstr = "http://www.youtube.com/get_video?video_id=" & videoid & "&t=" & urlstr



        'If url38 <> "" Then urlstr = Right(url38, Len(url38) - 4)
        'If url34 <> "" Then urlstr = Right(url34, Len(url34) - 4)
        'If url35 <> "" Then urlstr = Right(url35, Len(url35) - 4)
        'If url18 <> "" Then urlstr = Right(url18, Len(url18) - 4)
        'If url22 <> "" Then urlstr = Right(url22, Len(url22) - 4)
        'If url37 <> "" Then urlstr = Right(url37, Len(url37) - 4)

        xcv = False

        Text2.Text = ""
        Debug.Print urlstr

        Text2.Text = Text2.Text & "urlstr: " & urlstr & vbCrLf

        'urlstr = Right(url18, Len(url18) - 4)

        'urlstr = Right(urlstr, Len(urlstr) - 4)

        If Bitag = False Then

            'urlstr = DecodeSigURL(urlstr)
             wbStop = True
            sigUrl = urlstr

            wb2.Navigate "http://www.google.com"
            wb2.Stop



            Debug.Print urlJs

            inetSig.URL = urlJs
            inetSig.Execute , "Get"



           Exit Sub
        End If

        Debug.Print urlstr
        wbStop = True


        wb2.Navigate "http://www.google.com"
        wb2.Stop
        'wb2.Navigate "about:blank"
        'wb2.Visible = False

        Label2.Caption = "document"



        Inet3.URL = urlstr
        Inet3.Execute , "Get"

        Exit Sub
    End If

Конец, если

Конец подписки


person SuperBerry    schedule 25.01.2014    source источник


Ответы (1)


Наконец-то я нашел проблему. Это VPN. Если я захожу на сайт по VPN, проблема будет решена.

person SuperBerry    schedule 13.11.2014