0
Код загружает видео Youtube, а скомпилированный exe хорошо работает на IE9 и 10, но я обновляюсь до IE11 вчера, Win7 x64.IE11 Webbrowser сделал программу quit suddently, VB6
Я запускаю программу в VB6 с помощью кнопки F5, программа работает плавно. Но когда я скомпилирую его в EXE, после использования веб-браузера откройте страницу YouTube, программа отключится.
Какая разница между отладкой запуска программы в режиме VB6 IDE и в режиме EXE? Могу ли я исправить проблему?
Private Sub wb2_DocumentComplete(ByVal pDisp As Object, URL As Variant)
On Error Resume Next
If wbStop = True Then Exit 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
End If
End Sub