Crunchyroll-Downloader-v3.0/Crunchyroll Downloader/Main.vb

1368 lines
62 KiB
VB.net
Raw Normal View History

2019-11-10 00:16:12 +01:00
Imports System.Net
Imports System.Text
Imports System.IO
Imports Microsoft.Win32
Imports System.ComponentModel
Public Class Main
Public gIndexH As Integer = -1
Public DialogTaskString As String
Public UserCloseDialog As Boolean = False
Dim Aktuell As String
Dim Gesamt As String
Public LabelUpdate As String = "Status: idle"
Public LabelEpisode As String = "..."
Public b As Boolean = True
Public LoginOnly As String = "False"
Public CreditsOnly As Boolean = False
Public Pfad As String = My.Computer.FileSystem.CurrentDirectory
Dim ffmpeg_command As String
Public Resu As Integer
Dim Resu2 As String
Public ResuSave As String = "6666x6666"
Public SubSprache As String
Public Unlock As Integer = 0
Public Unlock2 As Integer
Public SubFolder As Integer
Public SoftSubs As New List(Of String)
Public AbourtList As New List(Of String)
Public watingList As New List(Of String)
Dim SoftSubsString As String
Dim CR_Unlock_Error As String
Dim versuch2 As Integer = 0
Public keks As String = Nothing
Dim SubSprache2 As String
Dim URL_DL As String
Dim Pfad_DL As String
Public Grapp_RDY As Boolean = True
Public Grapp_Abord As Boolean = False
Public MaxDL As Integer
Public TaskCount As Integer = 0
Public Event UpdateUI(ByVal sender As String, ByVal Int As Integer)
Public ResoNotFoundString As String
Public ResoBackString As String
Dim PB_list As New List(Of PictureBox)
Public bt_dl As New List(Of PictureBox)
Public WebbrowserURL As String = Nothing
Public WebbrowserText As String = Nothing
Public WebbrowserTitle As String = Nothing
Public UserBowser As Boolean = False
#Region "Sprachen Vairablen"
Public URL_Invaild As String = "invalid URL, this Downloader is only for crunchyroll.com"
Public SubFolder_automatic As String = "[automatic : Series/Season]"
Public SubFolder_Nothing As String = "[ ignore subfolder ]"
Dim DL_Path_String As String = "Please choose download directory."
Public CR_Premium_Failed As String = "Can not verify the active premium membership."
Public No_Stream As String = "Please make sure that the URL is correct."
Dim TaskNotCompleed As String = "Please wait until the current task is completed."
Dim Premium_Stream As String = "Please make sure that you logged in for this premium episode."
Dim Error_Mass_DL As String = "We run into a problem here." + vbNewLine + "You can try to download every episode individually."
Dim User_Fault_NoName As String = "no name, fallback solution : "
Dim Sub_language_NotFound As String = "Could not find the sub language" + vbNewLine + "please make sure the language is available: "
Dim Resolution_NotFound As String = "Could not find any resolution."
Dim Error_unknown As String = "We run into a unknown problem here." + vbNewLine + "Do you like to send an Bug report?"
Public CR_Unlock_Error_String As String = "unable to get an CR-US cookie."
Dim ErrorNoPermisson As String = "Access is denied."
'UI Variablen
Public GB_Resolution_Text As String = "Resolution"
Public GB_SubLanguage_Text As String = "Hardsub language"
Public GB_Sub_Path_Text As String = "Sub directory"
Public UL_US_Text As String = "enable US Cookie"
Public RBAnime_Text As String = "series name"
Public RBStaffel_Text As String = "series name + season"
Public NewStart_String As String = "to adopt all the settings, a restart is necessary."
Public DL_Count_simultaneousText As String = "Simultaneous Downloads"
Public GB_Sub_FormatText As String = "extended Sub Settings"
Public LabelResoNotFoundText As String = "resolution not found" + vbNewLine + "Select another one below"
Public LabelLangNotFoundText As String = "language not found" + vbNewLine + "Select another one below"
Public ButtonResoNotFoundText As String = "Submit"
Public CB_SuB_Nothing As String = "[ without (none) ]"
Dim StatusToolTip As ToolTip = New ToolTip()
Dim StatusToolTipText As String
Public RunGecko As String = "Startup"
#End Region
#Region "UI"
Private Sub pictureBox1_MouseHover(sender As Object, e As EventArgs) Handles pictureBox1.MouseMove
pictureBox1.BackColor = SystemColors.Control
End Sub
Private Sub pictureBox1_MouseLeave(sender As Object, e As EventArgs) Handles pictureBox1.MouseLeave
pictureBox1.BackColor = Color.Transparent
End Sub
Private Sub pictureBox2_MouseHover(sender As Object, e As EventArgs) Handles pictureBox2.MouseMove
pictureBox2.BackColor = SystemColors.Control
End Sub
Private Sub pictureBox2_MouseLeave(sender As Object, e As EventArgs) Handles pictureBox2.MouseLeave
pictureBox2.BackColor = Color.Transparent
End Sub
Private Sub pictureBox3_MouseEnter(sender As Object, e As EventArgs) Handles pictureBox3.MouseEnter
pictureBox3.BackColor = SystemColors.Control
End Sub
Private Sub pictureBox3_MouseLeave(sender As Object, e As EventArgs) Handles pictureBox3.MouseLeave
pictureBox3.BackColor = Color.Transparent
End Sub
Private Sub pictureBox4_MouseHover(sender As Object, e As EventArgs) Handles pictureBox4.MouseMove
pictureBox4.BackColor = SystemColors.Control
End Sub
Private Sub pictureBox4_MouseLeave(sender As Object, e As EventArgs) Handles pictureBox4.MouseLeave
pictureBox4.BackColor = Color.Transparent
End Sub
#End Region
Private Sub Form8_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ServicePointManager.Expect100Continue = True
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
Me.Icon = My.Resources.icon
Try
Dim rkg As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\CRDownloader")
keks = rkg.GetValue("keks").ToString
Catch ex As Exception
End Try
#Region "Startup IU"
StatusToolTip.Active = True
#End Region
Try
Dim rkg As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\CRDownloader")
ffmpeg_command = rkg.GetValue("ffmpeg_command").ToString
Catch ex As Exception
ffmpeg_command = "-c copy -bsf:a aac_adtstoasc -movflags +faststart"
End Try
Try
Dim rkg As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\CRDownloader")
Resu = Integer.Parse(rkg.GetValue("Resu").ToString)
'MsgBox(Resu)
Catch ex As Exception
End Try
Try
Dim rkg As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\CRDownloader")
SubSprache = rkg.GetValue("Sub").ToString
Catch ex As Exception
End Try
Try
Dim rkg As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\CRDownloader")
SubFolder = Integer.Parse(rkg.GetValue("SubFolder").ToString)
Catch ex As Exception
SubFolder = 1
End Try
Try
Dim rkg As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\CRDownloader")
MaxDL = Integer.Parse(rkg.GetValue("SL_DL").ToString)
Catch ex As Exception
MaxDL = 1
End Try
Try
Dim rkg As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\CRDownloader")
SoftSubsString = rkg.GetValue("AddedSubs").ToString
If SoftSubsString = "none" Then
Else
Dim SoftSubsStringSplit() As String = SoftSubsString.Split(New String() {","}, System.StringSplitOptions.RemoveEmptyEntries)
For i As Integer = 0 To SoftSubsStringSplit.Count - 1
SoftSubs.Add(SoftSubsStringSplit(i))
Next
End If
Catch ex As Exception
End Try
'Label10.TextAlign = ContentAlignment.MiddleCenter
If Resu = Nothing Then
Resu = 1080
End If
If SubSprache = Nothing Then
SubSprache = "enUS"
End If
End Sub
Public Sub ListAdd(ByVal NameKomplett As String, ByVal NameP1 As String, ByVal NameP2 As String, ByVal Reso As String, ByVal HardSub As String, ByVal SoftSubs As String, ByVal ThumbnialURL As String, ByVal VideoURL As String)
Dim b As New Bitmap(838, 142, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim g As Graphics = Graphics.FromImage(b)
Dim ZeroPoint As Point = New Point(0, 0)
Dim TextPoint As Point = New Point(195, 15)
Dim TextPointL2 As Point = New Point(195, 42)
Dim TextPointL3 As Point = New Point(773, 95)
Dim TextPointL4 As Point = New Point(195, 101)
Dim TextPointL4A2 As Point = New Point(300, 101)
Dim ThumbnialPoint As Point = New Point(11, 20)
Dim ProgressbarPoint As Point = New Point(195, 70)
Dim newImage As Image = My.Resources.backgroud
Dim img As Image = My.Resources.main_del
Try
Dim wc As New WebClient()
Dim bytes As Byte() = wc.DownloadData(ThumbnialURL)
Dim ms As New MemoryStream(bytes)
img = System.Drawing.Image.FromStream(ms)
Catch ex As Exception
MsgBox(ex.ToString)
MsgBox(ThumbnialURL)
End Try
g.DrawImage(newImage, ZeroPoint)
Dim Thumnail As New Bitmap(168, 95, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim gr_dest As Graphics = Graphics.FromImage(Thumnail)
gr_dest.DrawImage(img, 0, 0,
Thumnail.Width + 1,
Thumnail.Height + 1)
g.DrawImage(Thumnail, ThumbnialPoint)
g.DrawString(NameP1, FontLabel.Font, Brushes.Black, TextPoint)
g.DrawString(NameP2, FontLabel.Font, Brushes.Black, TextPointL2)
g.DrawRectangle(Pens.Black, ProgressbarPoint.X, ProgressbarPoint.Y, 601, 20)
Dim brGradient As Brush = New SolidBrush(Color.FromArgb(247, 140, 37))
g.FillRectangle(brGradient, ProgressbarPoint.X + 1, ProgressbarPoint.Y + 1, 0, 19)
g.DrawString("0%", FontLabel2.Font, Brushes.Black, TextPointL3)
g.DrawString(Reso, FontLabel.Font, Brushes.Black, TextPointL4)
g.DrawString(HardSub, FontLabel.Font, Brushes.Black, TextPointL4A2)
g.Dispose()
gIndexH = gIndexH + 1
With ListView1.Items.Add(0)
LVPictureBox(ListView1, gIndexH, b, "Softsubs: " + SoftSubs, NameKomplett)
bt_del(ListView1, gIndexH, NameKomplett)
End With
End Sub
Public Function bt_del(ByVal pListView As ListView, ByVal ItemIndex As Integer, ByVal NameKomplett As String) As PictureBox
'btn erstellen funktion
Dim r As Rectangle
Dim bt_r As New PictureBox
Dim c As Integer = ListView1.Items.Count - 1
r = pListView.Items(c).Bounds()
bt_r.Parent = pListView
bt_r.SetBounds(755, r.Y + 20, 50, 40)
bt_dl.Add(bt_r)
bt_r.Name = NameKomplett
'bt_r.FlatStyle = FlatStyle.System
bt_r.Visible = True
bt_r.BringToFront()
bt_r.Enabled = True
bt_r.Image = My.Resources.main_close
bt_r.Image = My.Resources.main_del
bt_r.BackgroundImageLayout = ImageLayout.Center
ToolTip1.SetToolTip(bt_r, NameKomplett)
'bt_r.FlatAppearance.BorderSize = 1
'bt_r.FlatAppearance.BorderColor = Color.Black
AddHandler bt_r.Click, AddressOf Me.bt_r_click
AddHandler bt_r.MouseEnter, AddressOf Me.bt_r_ME
AddHandler bt_r.MouseLeave, AddressOf Me.bt_r_ML
Return Nothing
End Function
Private Sub bt_r_click(ByVal sender As Object, ByVal e As EventArgs)
Dim b As PictureBox = sender
b.Image = My.Resources.main_close
If MessageBox.Show("Cancel this Download?", "Cancel?", MessageBoxButtons.YesNo) = DialogResult.Yes Then
AbourtList.Add(b.Name)
b.Enabled = False
TaskCount = TaskCount - 1
Else
b.Image = My.Resources.main_del
End If
End Sub
Private Sub bt_r_ME(ByVal sender As Object, ByVal e As EventArgs)
Dim b As PictureBox = sender
b.Image = My.Resources.main_del_hover
End Sub
Private Sub bt_r_ML(ByVal sender As Object, ByVal e As EventArgs)
Dim b As PictureBox = sender
b.Image = My.Resources.main_del
End Sub
Public Function LVPictureBox(ByVal pListView As ListView, ByVal ItemIndex As Integer, ByVal img As Bitmap, ByVal SoftSubs As String, ByVal NameKomplett As String) As PictureBox
'btn erstellen funktion
Dim r As Rectangle
Dim bt_d As New PictureBox
Dim TT As New ToolTip
Dim c As Integer = ListView1.Items.Count - 1
r = pListView.Items(c).Bounds()
r.Width = 838
r.Height = 142
bt_d.Parent = pListView
bt_d.SetBounds(r.X, r.Y, r.Width, r.Height)
bt_d.Name = NameKomplett
bt_d.BackgroundImage = img
PB_list.Add(bt_d)
ToolTip1.SetToolTip(bt_d, SoftSubs)
bt_d.BackgroundImageLayout = ImageLayout.Center
'bt_d.FlatAppearance.BorderColor = Color.Orange
bt_d.Visible = True
bt_d.Enabled = True
' AddHandler LVPictureBox., AddressOf Me.LVPictureBox_MouseHover
Return Nothing
End Function
Public Sub Pause(ByVal pau As Single)
'Programmausführung verzögern *******************************************************
Dim start, finish As Single
start = Microsoft.VisualBasic.DateAndTime.Timer
finish = start + pau
Do While Microsoft.VisualBasic.DateAndTime.Timer < finish
Application.DoEvents()
Loop
End Sub
#Region "Season DL"
Public Sub MassGrapp()
Anime_Add.groupBox2.Visible = True
Anime_Add.PictureBox1.Enabled = True
Anime_Add.PictureBox1.Visible = True
Anime_Add.groupBox1.Visible = False
Anime_Add.comboBox3.Items.Clear()
Anime_Add.comboBox4.Items.Clear()
Anime_Add.comboBox3.Enabled = True
Anime_Add.comboBox4.Enabled = True
Dim Anzahl As String() = WebbrowserText.Split(New String() {"wrapper container-shadow hover-classes"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim Titel As String() = Anzahl(0).Split(New String() {"<meta content=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim Titel2 As String() = Titel(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
'Label10.Text = Titel2(0)
Dim c As Integer = Anzahl.Count - 1
' FolgenZahl.Text = c.ToString + " Folgen gefunden."
Array.Reverse(Anzahl)
For i As Integer = 0 To Anzahl.Count - 2
Dim URLGrapp As String() = Anzahl(i).Split(New String() {"title=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
'MsgBox("1" + Chr(34))
Dim URLGrapp2 As String() = URLGrapp(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Anime_Add.comboBox3.Items.Add(URLGrapp2(0))
Anime_Add.comboBox4.Items.Add(URLGrapp2(0))
Next
End Sub
Public Sub SeasonDropdownGrapp()
Anime_Add.groupBox2.Visible = True
Anime_Add.PictureBox1.Enabled = True
Anime_Add.PictureBox1.Visible = True
Anime_Add.groupBox1.Visible = False
Anime_Add.ComboBox1.Items.Clear()
Anime_Add.comboBox3.Items.Clear()
Anime_Add.comboBox4.Items.Clear()
Anime_Add.ComboBox1.Enabled = True
Anime_Add.comboBox3.Enabled = True
Anime_Add.comboBox4.Enabled = True
Dim Anzahl As String() = WebbrowserText.Split(New String() {"season-dropdown content-menu block"}, System.StringSplitOptions.RemoveEmptyEntries)
Array.Reverse(Anzahl)
For i As Integer = 0 To Anzahl.Count - 2
Dim Titel As String() = Anzahl(i).Split(New String() {"</a>"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim Titel2 As String() = Titel(0).Split(New String() {">"}, System.StringSplitOptions.RemoveEmptyEntries)
'MsgBox(Titel2(0))
Anime_Add.ComboBox1.Items.Add(Titel2(1))
Next
End Sub
Public Async Sub MassDL()
If Anime_Add.comboBox3.Text = Nothing Then
Exit Sub
End If
Anime_Add.Add_Display.Text = "preparing ..."
Dim Website As String = WebbrowserText
If Anime_Add.ComboBox1.Enabled = True Then
Dim SeasonDropdownAnzahl As String() = Website.Split(New String() {"season-dropdown content-menu block"}, System.StringSplitOptions.RemoveEmptyEntries)
Array.Reverse(SeasonDropdownAnzahl)
Dim SDV As Integer = 0
For i As Integer = 0 To SeasonDropdownAnzahl.Count - 1
If InStr(SeasonDropdownAnzahl(i), Chr(34) + ">" + Anime_Add.ComboBox1.SelectedItem.ToString + "</a>") Then
SDV = i
End If
Next
Website = SeasonDropdownAnzahl(SDV)
End If
Try
Dim Anzahl As String() = Website.Split(New String() {"wrapper container-shadow hover-classes"}, System.StringSplitOptions.RemoveEmptyEntries)
Array.Reverse(Anzahl)
Dim c As Integer = Anime_Add.comboBox4.SelectedIndex - Anime_Add.comboBox3.SelectedIndex + 1
'AnzahlGesamt.Text = c.ToString
Gesamt = c.ToString
Aktuell = "0"
If Anime_Add.comboBox4.SelectedIndex > Anime_Add.comboBox3.SelectedIndex Then
For i As Integer = Anime_Add.comboBox3.SelectedIndex To Anime_Add.comboBox4.SelectedIndex
For e As Integer = 0 To Integer.MaxValue
If Grapp_RDY = True Then
If TaskCount < MaxDL Then
Exit For
Else
'MsgBox(e)
Await Task.Delay(2000)
End If
Else
Await Task.Delay(2000)
End If
Next
If Anime_Add.Mass_DL_Cancel = False Then
b = True
Exit For
Grapp_Abord = True
'MsgBox("dl_abourd")
End If
Dim d As Integer = i - Anime_Add.comboBox3.SelectedIndex + 1
Dim URLGrapp As String() = Anzahl(i).Split(New String() {"<a href=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim URLGrapp2 As String() = URLGrapp(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
'MsgBox("https://www.crunchyroll.com" + URLGrapp2(0))
Grapp_RDY = False
b = False
GeckoFX.WebBrowser1.Navigate("https://www.crunchyroll.com" + URLGrapp2(0))
'Await Task.Delay(500)
'GrappURL()
Aktuell = d.ToString
' AnzahlFertig.Text = d.ToString
Anime_Add.Add_Display.Text = Aktuell + " / " + Gesamt
If CBool(InStr(WebbrowserText, Chr(34) + "premium_status" + Chr(34) + ":" + Chr(34) + "premium" + Chr(34))) Then
ElseIf CBool(InStr(WebbrowserText, Chr(34) + "premium_status" + Chr(34) + ":" + Chr(34) + "free_trial" + Chr(34))) Then
'Else
' MsgBox(CR_Premium_Failed, MsgBoxStyle.Information)
' Anime_Add.groupBox1.Visible = True
' Anime_Add.groupBox2.Visible = False
' Anime_Add.GroupBox3.Visible = False
' Anime_Add.Mass_DL_Cancel = False
' Anime_Add.pictureBox4.Image = My.Resources.main_button_download_default
' Exit Sub
End If
Next
End If
Catch ex As Exception
Anime_Add.comboBox4.Items.Clear()
Anime_Add.comboBox3.Items.Clear()
' MsgBox(Error_Mass_DL, MsgBoxStyle.Information)
'MsgBox(ex.ToString)
Aktuell = 0.ToString
Gesamt = 0.ToString
Anime_Add.groupBox1.Visible = True
Anime_Add.groupBox2.Visible = False
Anime_Add.GroupBox3.Visible = False
Anime_Add.Mass_DL_Cancel = False
Anime_Add.pictureBox4.Image = My.Resources.main_button_download_default
End Try
Pause(5)
Anime_Add.groupBox1.Visible = True
Anime_Add.groupBox2.Visible = False
Anime_Add.GroupBox3.Visible = False
Anime_Add.Mass_DL_Cancel = False
Anime_Add.pictureBox4.Image = My.Resources.main_button_download_default
End Sub
#End Region
#Region "Sub to display"
Public Function SubValuesToDisplay() As String
Try
Dim deDE As Boolean = False
Dim enUS As Boolean = False
Dim ptBR As Boolean = False
Dim esLA As Boolean = False
Dim frFR As Boolean = False
Dim arME As Boolean = False
Dim ruRU As Boolean = False
Dim itIT As Boolean = False
Dim esES As Boolean = False
Dim ListReturn As String = Nothing
For i As Integer = 0 To SoftSubs.Count - 1
If SoftSubs(i) = "deDE" Then
deDE = True
ElseIf SoftSubs(i) = "enUS" Then
enUS = True
ElseIf SoftSubs(i) = "ptBR" Then
ptBR = True
ElseIf SoftSubs(i) = "esLA" Then
esLA = True
ElseIf SoftSubs(i) = "frFR" Then
frFR = True
ElseIf SoftSubs(i) = "arME" Then
arME = True
ElseIf SoftSubs(i) = "ruRU" Then
ruRU = True
ElseIf SoftSubs(i) = "itIT" Then
itIT = True
ElseIf SoftSubs(i) = "esES" Then
esES = True
End If
Next
If deDE = True Then
If ListReturn = Nothing Then
ListReturn = "Deutsch"
Else
ListReturn = ListReturn + ", Deutsch"
End If
End If
If enUS = True Then
If ListReturn = Nothing Then
ListReturn = "English"
Else
ListReturn = ListReturn + ", English"
End If
End If
If esLA = True Then
If ListReturn = Nothing Then
ListReturn = "Español (LA)"
Else
ListReturn = ListReturn + ", Español (LA)"
End If
End If
If ptBR = True Then
If ListReturn = Nothing Then
ListReturn = "Português (Brasil)"
Else
ListReturn = ListReturn + ", Português (Brasil)"
End If
End If
If frFR = True Then
If ListReturn = Nothing Then
ListReturn = "Français (France)"
Else
ListReturn = ListReturn + ", Français (France)"
End If
End If
If arME = True Then
If ListReturn = Nothing Then
ListReturn = "العربية (Arabic)"
Else
ListReturn = ListReturn + ", العربية (Arabic)"
End If
End If
If ruRU = True Then
If ListReturn = Nothing Then
ListReturn = "Русский (Russian)"
Else
ListReturn = ListReturn + ", Русский (Russian)"
End If
End If
If itIT = True Then
If ListReturn = Nothing Then
ListReturn = "Italiano (Italian)"
Else
ListReturn = ListReturn + ", Italiano (Italian)"
End If
End If
If esES = True Then
If ListReturn = Nothing Then
ListReturn = "Español (España)"
Else
ListReturn = ListReturn + ", Español (España)"
End If
End If
Return ListReturn
Catch ex As Exception
Return Nothing
End Try
End Function
Public Function HardSubValuesToDisplay(ByVal HardSub As String) As String
Try
If HardSub = Chr(34) + "deDE" + Chr(34) Then
Return "Deutsch"
ElseIf HardSub = Chr(34) + "enUS" + Chr(34) Then
Return "English"
ElseIf HardSub = Chr(34) + "ptBR" + Chr(34) Then
Return "Português (Brasil)"
ElseIf HardSub = Chr(34) + "esLA" + Chr(34) Then
Return "Español (LA)"
ElseIf HardSub = Chr(34) + "frFR" + Chr(34) Then
Return "Français (France)"
ElseIf HardSub = Chr(34) + "arME" + Chr(34) Then
Return "العربية (Arabic)"
ElseIf HardSub = Chr(34) + "ruRU" + Chr(34) Then
Return "Русский (Russian)"
ElseIf HardSub = Chr(34) + "itIT" + Chr(34) Then
Return "Italiano (Italian)"
ElseIf HardSub = Chr(34) + "esES" + Chr(34) Then
Return "Español (España)"
End If
Return CB_SuB_Nothing
Catch ex As Exception
Return Nothing
End Try
End Function
#End Region
Public Sub GrappURL()
Try
Grapp_RDY = False
TaskCount = TaskCount + 1
Dim CR_Anime_Titel As String = Nothing
Dim CR_Anime_Staffel As String = Nothing
Dim CR_Anime_Folge As String = Nothing
#Region "Name + Pfad"
Dim Pfad2 As String
Dim CR_FilenName As String = Nothing
Dim Bug_Deutsch As String = "-"
'Dim CR_Anime_Titel As String
'Dim CR_Anime_Staffel As String
'Dim CR_Anime_Folge As String
'Dim CR_Name_by_Titel As String() = GeckoFX.WebBrowser1.Document.Body.OuterHtml.Split(New String() {"<title>"}, System.StringSplitOptions.RemoveEmptyEntries)
'Dim CR_Name_by_Titel_2_Patch As String =CR_Name_by_Titel(1).Split(New String() {"</title>"}, System.StringSplitOptions.RemoveEmptyEntries)
If CBool(InStr(WebbrowserTitle, "Anschauen auf Crunchyroll")) Then
Bug_Deutsch = ":"
'Throw New System.Exception("Test")
Else
End If
Dim CR_Name_by_Titel_2 As String() = WebbrowserTitle.Split(New String() {Bug_Deutsch}, System.StringSplitOptions.RemoveEmptyEntries)
'Dim CR_Name_by_Script As String() = WebbrowserText.Split(New String() {Chr(34) + "name" + Chr(34) + ": " + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
'Dim CR_Name_by_Script2 As String() = CR_Name_by_Script(1).Split(New [Char]() {Chr(34)})
CR_FilenName = CR_Name_by_Titel_2(0).Trim() '+ " " + CR_Name_by_Script2(0).Trim
Dim CR_FilenName_Backup As String = Nothing
Dim SubfolderValue As String = Nothing
If CBool(InStr(WebbrowserText, "<h4>")) Then ' Film statt Serie
Dim CR_Name_1 As String() = WebbrowserText.Split(New String() {"<h4>"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim CR_Name_2 As String() = CR_Name_1(1).Split(New String() {"</h4>"}, System.StringSplitOptions.RemoveEmptyEntries) '(New [Char]() {"-"})
Dim CR_Name_Staffel0_Folge1 As String()
If CBool(InStr(CR_Name_2(0), ",")) Then
CR_Name_Staffel0_Folge1 = CR_Name_2(0).Split(New [Char]() {System.Convert.ToChar(",")}, System.StringSplitOptions.RemoveEmptyEntries)
CR_Anime_Staffel = CR_Name_Staffel0_Folge1(0).Trim()
CR_Anime_Folge = CR_Name_Staffel0_Folge1(1).Trim()
CR_Anime_Folge = System.Text.RegularExpressions.Regex.Replace(CR_Anime_Folge, "[^\w\\-]", " ")
Else
CR_Anime_Staffel = ""
CR_Anime_Folge = CR_Name_2(0).Trim()
CR_Anime_Folge = System.Text.RegularExpressions.Regex.Replace(CR_Anime_Folge, "[^\w\\-]", " ")
End If
Dim CR_Name_4 As String() = CR_Name_1(0).Split(New String() {"class=" + Chr(34) + "text-link" + Chr(34) + ">"}, System.StringSplitOptions.RemoveEmptyEntries) '(New [Char]() {"-"})
Dim CR_Name_Anime0 As String() = CR_Name_4(CR_Name_4.Length - 1).Split(New String() {"</a>"}, System.StringSplitOptions.RemoveEmptyEntries)
CR_Name_Anime0(0) = System.Text.RegularExpressions.Regex.Replace(CR_Name_Anime0(0), "[^\w\\-]", " ")
CR_Anime_Titel = CR_Name_Anime0(0).Trim
If CR_Anime_Staffel = Nothing Then
CR_FilenName = CR_Anime_Titel + " " + CR_Anime_Folge
Else
CR_FilenName = CR_Anime_Titel + " " + CR_Anime_Staffel + " " + CR_Anime_Folge
End If
CR_FilenName_Backup = RemoveExtraSpaces(CR_FilenName)
Me.Invoke(New Action(Function()
If Anime_Add.ComboBox2.Text = SubFolder_automatic Then
If SubFolder = 2 Then
SubfolderValue = CR_Anime_Titel + "\" + CR_Anime_Staffel + "\"
ElseIf SubFolder = 1 Then
SubfolderValue = CR_Anime_Titel + "\"
End If
ElseIf Anime_Add.ComboBox2.Text = SubFolder_Nothing Then
Else
SubfolderValue = Anime_Add.ComboBox2.Text + "\"
End If
Return Nothing
End Function))
End If
CR_FilenName = System.Text.RegularExpressions.Regex.Replace(CR_FilenName, "[^\w\\-]", " ")
CR_FilenName = RemoveExtraSpaces(CR_FilenName)
If SubfolderValue = Nothing Then
Pfad2 = Pfad + "\" + CR_FilenName + ".mp4"
Else
Pfad2 = Pfad + "\" + SubfolderValue + CR_FilenName + ".mp4"
End If
If Not Directory.Exists(Path.GetDirectoryName(Pfad2)) Then
' Nein! Jetzt erstellen...
Try
Directory.CreateDirectory(Path.GetDirectoryName(Pfad2))
Catch ex As Exception
' Ordner wurde nich erstellt
Pfad2 = Pfad + "\" + CR_FilenName_Backup + ".mp4"
End Try
End If
Pfad2 = Chr(34) + Pfad2 + Chr(34)
#End Region
#Region "Subs"
Dim SoftSubs2 As New List(Of String)
If SoftSubs.Count > 0 Then
For i As Integer = 0 To SoftSubs.Count - 1
If CBool(InStr(WebbrowserText, Chr(34) + "language" + Chr(34) + ":" + Chr(34) + SoftSubs(i) + Chr(34) + ",")) Then
SoftSubs2.Add(SoftSubs(i))
Else
'MsgBox("Softsubtitle for " + SoftSubs(i) + " is not avalible.", MsgBoxStyle.Information)
End If
Next
End If
If SubSprache = "None" Then
If CBool(InStr(WebbrowserText, Chr(34) + "hardsub_lang" + Chr(34) + ":null")) Then
SubSprache2 = "null"
Else
ResoNotFoundString = WebbrowserText
DialogTaskString = "Language"
Reso.ShowDialog()
If UserCloseDialog = True Then
Throw New System.Exception(Chr(34) + "UserAbort" + Chr(34))
Else
If ResoBackString = Nothing Then
Else
SubSprache2 = ResoBackString
End If
End If
'Throw New System.Exception("Could not find the sub language")
End If
Else
If CBool(InStr(WebbrowserText, Chr(34) + "hardsub_lang" + Chr(34) + ":" + Chr(34) + SubSprache + Chr(34) + ",")) Then
SubSprache2 = Chr(34) + SubSprache + Chr(34)
ElseIf CBool(InStr(WebbrowserText, Chr(34) + "language" + Chr(34) + ":" + Chr(34) + SubSprache + Chr(34) + ",")) Then
If MessageBox.Show("It look like only Softsubtitle are avalibe." + vbNewLine + "Are you want to use Softsubtitle this time instead?", "No Hardsubtitle", MessageBoxButtons.YesNo) = DialogResult.Yes Then
SubSprache2 = "null"
SoftSubs2.Add(SubSprache)
Else
Throw New System.Exception("Could not find the sub language")
End If
Else
ResoNotFoundString = WebbrowserText
DialogTaskString = "Language"
Reso.ShowDialog()
If UserCloseDialog = True Then
Throw New System.Exception(Chr(34) + "UserAbort" + Chr(34))
Else
If ResoBackString = Nothing Then
Else
SubSprache2 = ResoBackString
End If
End If
End If
End If
#End Region
If Grapp_Abord = True Then
Grapp_RDY = True
Grapp_Abord = False
TaskCount = TaskCount - 1
'MsgBox("grapp_abourd")
Exit Sub
End If
#Region "m3u8 suche"
Dim ii As Integer = 0
'MsgBox(Chr(34) + "hardsub_lang" + Chr(34) + ":" + SubSprache2 + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34))
Dim CR_URI_Master As String = Nothing
Dim CR_URI_Master_Split1 As String() = WebbrowserText.Split(New String() {My.Resources.hls_Value}, System.StringSplitOptions.RemoveEmptyEntries)
Dim hls_List As New List(Of String)
For i As Integer = 0 To CR_URI_Master_Split1.Count - 1
If InStr(CR_URI_Master_Split1(i), My.Resources.hls_endString) Then
Dim s As String() = CR_URI_Master_Split1(i).Split(New String() {My.Resources.hls_endString}, System.StringSplitOptions.RemoveEmptyEntries)
hls_List.Add(s(0))
End If
Next
'Dim CR_URI_Master_Split1 As String() = WebbrowserText.Split(New String() {Chr(34) + "hardsub_lang" + Chr(34) + ":" + SubSprache2 + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
For i As Integer = 0 To hls_List.Count - 1
If InStr(hls_List(i), Chr(34) + "hardsub_lang" + Chr(34) + ":" + SubSprache2 + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34)) Then
Dim s() As String = hls_List(i).Split(New String() {Chr(34) + "hardsub_lang" + Chr(34) + ":" + SubSprache2 + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
CR_URI_Master = s(1).Replace("\/", "/")
'MsgBox(CR_URI_Master)
End If
'Dim CR_URI_Master_Split2 As String() = CR_URI_Master_Split1(i).Split(New [Char]() {Chr(34)})
'If CBool(InStr(CR_URI_Master_Split2(0), "master.m3u8")) Then 'If CBool(InStr(CR_URI_Master_Split2(0), "master.m3u8")) Then
' CR_URI_Master = CR_URI_Master_Split2(0).Replace("\/", "/")
' ii = i
' Exit For
'ElseIf CBool(InStr(CR_URI_Master_Split2(0), "index.m3u8")) Then
' 'MsgBox("Premnium Episode")
' Throw New System.Exception("Premnium Episode")
' Exit For
'End If
Next
If CBool(InStr(CR_URI_Master, "master.m3u8")) Then
Me.Invoke(New Action(Function()
Anime_Add.StatusLabel.Text = "Status: m3u8 found, looking for resolution"
Return Nothing
End Function))
Else
Throw New System.Exception("Premnium Episode")
End If
#End Region
#Region "Download softsub file"
If SoftSubs2.Count > 0 Then
For i As Integer = 0 To SoftSubs2.Count - 1
'EpisodeLabel.Text = SoftSubs2(i)
'StatusLabel.Text = "Status: downloading subtitle file"
LabelUpdate = "Status: downloading subtitle file"
LabelEpisode = SoftSubs2(i)
Dim SoftSub As String() = WebbrowserText.Split(New String() {Chr(34) + "language" + Chr(34) + ":" + Chr(34) + SoftSubs2(i) + Chr(34) + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim SoftSub_2 As String() = SoftSub(1).Split(New [Char]() {Chr(34)})
Dim SoftSub_3 As String = SoftSub_2(0).Replace("\/", "/")
Dim client0 As New WebClient
client0.Encoding = Encoding.UTF8
Dim str0 As String = client0.DownloadString(SoftSub_3)
Dim Pfad3 As String = Pfad2.Replace(Chr(34), "")
Dim FN As String = Path.ChangeExtension(Path.Combine(Path.GetFileNameWithoutExtension(Pfad3) + " " + SoftSubs2(i) + Path.GetExtension(Pfad3)), "ass")
'MsgBox(FN)
If i = 0 Then
FN = Path.ChangeExtension(Path.GetFileName(Pfad3), "ass")
'MsgBox(FN)
End If
Dim Pfad4 As String = Path.Combine(Path.GetDirectoryName(Pfad3), FN)
'MsgBox(Pfad4)
File.WriteAllText(Pfad4, str0, Encoding.UTF8)
Pause(1)
Next
End If
#End Region
#Region "lösche doppel download"
Dim Pfad5 As String = Pfad2.Replace(Chr(34), "")
If My.Computer.FileSystem.FileExists(Pfad5) Then 'Pfad = Kompeltter Pfad mit Dateinamen + ENdung
If MessageBox.Show("The file " + Pfad5 + " already exists." + vbNewLine + "You want to override it?", "File exists!", MessageBoxButtons.OKCancel) = DialogResult.OK Then
Try
My.Computer.FileSystem.DeleteFile(Pfad5)
Catch ex As Exception
End Try
Else
Grapp_RDY = True
Exit Sub
TaskCount = TaskCount - 1
End If
End If
#End Region
Dim client As New System.Net.WebClient
client.Encoding = Encoding.UTF8
'MsgBox(CR_URI_Master)
Dim str As String = client.DownloadString(CR_URI_Master)
'MsgBox(str)
If CBool(InStr(str, "x" + Resu.ToString + ",")) Then
Resu2 = "x" + Resu.ToString
Else
If CBool(InStr(str, ResuSave + ",")) Then
Resu2 = Resu2
Else
ResoNotFoundString = str
DialogTaskString = "Resolution"
Reso.ShowDialog()
'MsgBox(ResoBackString)
If UserCloseDialog = True Then
Throw New System.Exception(Chr(34) + "UserAbort" + Chr(34))
Else
Resu2 = ResoBackString
End If
End If
End If
'MsgBox(Resu2)
Dim VLC_URI_1 As String() = str.Split(New String() {Resu2 + ","}, System.StringSplitOptions.RemoveEmptyEntries)
Dim VLC_URI_2 As String() = VLC_URI_1(1).Split(New [Char]() {Chr(34)})
Dim VLC_URI_3 As String() = VLC_URI_2(2).Split(New [Char]() {System.Convert.ToChar("#")})
' For i As Integer = 0 To 3
' Try
' CR_URI_Master = GetPage(CR_URI_Master)
' Exit For
' Catch ex As Exception
' End Try
' Next
' MsgBox(CR_URI_Master)
' Dim FFMPEG_ResoBack As String = FFMPEG_Reso(CR_URI_Master)
' 'MsgBox(FFMPEG_ResoBack)
' Dim FFMPEG_Back() As String = FFMPEG_ResoBack.Split(New String() {"#1"}, System.StringSplitOptions.RemoveEmptyEntries)
#Region "thumbnail"
Dim thumbnail As String() = WebbrowserText.Split(New String() {My.Resources.thumbnailString}, System.StringSplitOptions.RemoveEmptyEntries)
Dim thumbnail2 As String() = thumbnail(1).Split(New String() {Chr(34) + "}"}, System.StringSplitOptions.RemoveEmptyEntries) '(New [Char]() {"-"})
Dim thumbnail3 As String = thumbnail2(0).Replace("\/", "/")
#End Region
#Region "<li> constructor"
Dim Subsprache3 As String = HardSubValuesToDisplay(SubSprache2)
Dim ResoHTMLDisplay As String = Nothing
If ResoBackString = Nothing Then
ResoHTMLDisplay = Resu.ToString + "p"
ResoBackString = Nothing
Else
Dim ResoHTML As String() = ResoBackString.Split(New String() {"x"}, System.StringSplitOptions.RemoveEmptyEntries)
If ResoHTML.Count > 1 Then
ResoHTMLDisplay = ResoHTML(1) + "p"
Else
ResoHTMLDisplay = ResoHTML(0) + "p"
End If
End If
Me.Invoke(New Action(Function()
ListAdd(CR_FilenName, CR_Anime_Titel, CR_Anime_Staffel + " " + CR_Anime_Folge, ResoHTMLDisplay, Subsprache3, SubValuesToDisplay(), thumbnail3, URL_DL)
Return Nothing
End Function))
' liList.Add(My.Resources.htmlvorThumbnail + thumbnail3 + My.Resources.htmlnachTumbnail + CR_Anime_Titel + " <br> " + CR_Anime_Staffel + " " + CR_Anime_Folge + My.Resources.htmlvorAufloesung + ResoHTMLDisplay + My.Resources.htmlvorSoftSubs + vbNewLine + SubValuesToDisplay() + My.Resources.htmlvorHardSubs + Subsprache3 + My.Resources.htmlnachHardSubs + "<!-- " + CR_FilenName + "-->")
#End Region
'MsgBox(liList(0))
URL_DL = VLC_URI_3(0).Trim()
' URL_DL = Chr(34) + GetPage(CR_URI_Master) + Chr(34) + " -map 0:a " + "-map " + FFMPEG_Back(1)
'MsgBox(URL_DL)
Pfad_DL = Pfad2
AsyncWorkerX.RunAsync(AddressOf DownloadFFMPEG, URL_DL, Pfad_DL, CR_FilenName)
'GeckoWebBrowser1.LoadHtml(My.Resources.htmlTop + vbNewLine + liList.Last + vbNewLine + My.Resources.ulEnd + My.Resources.htmlEnd)
Grapp_RDY = True
Me.Invoke(New Action(Function()
Anime_Add.StatusLabel.Text = "Status: idle"
Return Nothing
End Function))
' ManageWorker(URL_DL, Pfad_DL, CR_FilenName)()
Catch ex As Exception
TaskCount = TaskCount - 1
Me.Invoke(New Action(Function()
Anime_Add.StatusLabel.Text = "Status: idle"
Return Nothing
End Function))
'StatusLabel.Text = "Status: idle"
Grapp_RDY = True
'MsgBox(ex.ToString)
If CBool(InStr(ex.ToString, "Could not find the sub language")) Then
MsgBox(Sub_language_NotFound + SubSprache)
ElseIf CBool(InStr(ex.ToString, "RESOLUTION Not Found")) Then
MsgBox(Resolution_NotFound)
ElseIf CBool(InStr(ex.ToString, "Premnium Episode")) Then
MsgBox(Premium_Stream, MsgBoxStyle.Information)
ElseIf CBool(InStr(ex.ToString, "System.UnauthorizedAccessException")) Then
MsgBox(ErrorNoPermisson + vbNewLine + ex.ToString, MsgBoxStyle.Information)
ElseIf CBool(InStr(ex.ToString, Chr(34) + "UserAbort" + Chr(34))) Then
MsgBox(ex.ToString, MsgBoxStyle.Information)
Else
' MsgBox(ex.ToString, MsgBoxStyle.Information)
If MessageBox.Show(Error_unknown, "Error!", MessageBoxButtons.YesNo) = DialogResult.Yes Then
Dim CCC As String() = WebbrowserText.Split(New String() {Chr(34) + "country_code" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim CCC1 As String() = CCC(1).Split(New String() {Chr(34) + "});"}, System.StringSplitOptions.RemoveEmptyEntries)
'MsgBox(CCC1(0))
Dim SaveString As String = "Operating System: " + My.Computer.Info.OSFullName + vbNewLine + vbNewLine + "Crunchyroll URL: " + WebbrowserURL + vbNewLine + vbNewLine + "subtitle language: " + SubSprache + vbNewLine + vbNewLine + "video resolution: " + Resu.ToString + vbNewLine + vbNewLine + "error message: " + ex.ToString + vbNewLine + ex.StackTrace.ToString + vbNewLine + vbNewLine + "softsubs enabled?: " + SoftSubs.ToString + vbNewLine + vbNewLine + "Crunchyroll Downloader Version: " + Application.ProductVersion + vbNewLine + vbNewLine + "detected location from Crunchyroll: " + CCC1(0)
'MsgBox(SaveString)
File.WriteAllText("Error " + DateTime.Now.ToString("dd.MM.yyyy HH.mm") + ".txt", SaveString)
Dim Request As HttpWebRequest = CType(WebRequest.Create("https://docs.google.com/forms/d/e/1FAIpQLSdR1QI19Lh-c-XO_iXNkDwsTUZhCMEu84boQkgW5AOBUxyiyA/formResponse"), HttpWebRequest)
Request.Method = "POST"
Request.ContentType = "application/x-www-form-urlencoded"
Dim Post As String = "entry.240217066=" + My.Computer.Info.OSFullName + "&entry.358200455=" + WebbrowserURL + "&entry.618751432=" + SubSprache + "&entry.924054550=" + Resu.ToString + "&entry.679000538=" + ex.ToString + "&entry.1789515979=" + SoftSubsString + "&entry.683247287=" + Application.ProductVersion + "&entry.377264428=" + CCC1(0) + "&fvv=1&draftResponse=[null,null," + Chr(34) + "-3005021683493723280" + Chr(34) + "] &pageHistory=0&fbzx=-3005021683493723280"
Dim byteArray() As Byte = Encoding.UTF8.GetBytes(Post)
Request.ContentLength = byteArray.Length
Dim DataStream As Stream = Request.GetRequestStream()
DataStream.Write(byteArray, 0, byteArray.Length)
DataStream.Close()
Dim Response As HttpWebResponse = Request.GetResponse()
DataStream = Response.GetResponseStream()
Dim reader As New StreamReader(DataStream)
Dim ServerResponse As String = reader.ReadToEnd()
reader.Close()
DataStream.Close()
Response.Close()
Dim Version_Check As String() = ServerResponse.Split(New String() {"<div class=" + Chr(34) + "freebirdFormviewerViewResponseConfirmationMessage" + Chr(34) + ">"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim Version_Check2 As String() = Version_Check(1).Split(New String() {"</div>"}, System.StringSplitOptions.RemoveEmptyEntries)
If Application.ProductVersion = Version_Check2(0) Then
Else
MsgBox("A newer version is available: v" + Version_Check2(0))
End If
End If
End If
End Try
End Sub
Private Function DownloadFFMPEG(ByVal DL_URL As String, ByVal DL_Pfad As String, ByVal Filename As String) As String
Dim proc As New Process
Control.CheckForIllegalCrossThreadCalls = False
'Dim input As String = Me.dlgOpen.FileName
'Dim output As String = Me.dlgSave.FileName
Dim exepath As String = Application.StartupPath + "\ffmpeg.exe"
Dim startinfo As New System.Diagnostics.ProcessStartInfo
Dim sr As StreamReader
' Dim cmd As String = "-i " + Chr(34) + URL_DL + Chr(34) + " -c copy -bsf:a aac_adtstoasc " + Pfad_DL 'start ffmpeg with command strFFCMD string
'-bsf:a aac_adtstoasc
Dim cmd As String = "-i " + DL_URL + " " + ffmpeg_command + " " + DL_Pfad 'start ffmpeg with command strFFCMD string
2019-11-10 00:26:45 +01:00
'MsgBox(cmd)
2019-11-10 00:16:12 +01:00
'22050
'
Dim ffmpegOutput As String = Nothing
Dim ffmpegOutput2 As String = Nothing
'all parameters required to run the process
startinfo.FileName = exepath
startinfo.Arguments = cmd
startinfo.UseShellExecute = False
startinfo.WindowStyle = ProcessWindowStyle.Hidden
startinfo.RedirectStandardError = True
startinfo.RedirectStandardOutput = True
startinfo.CreateNoWindow = True
proc.StartInfo = startinfo
proc.Start() ' start the process
sr = proc.StandardError 'standard error is used by ffmpeg
Dim x As Boolean = False
Dim Grundwert As Integer
Do
'If BG.CancellationPending Then 'check if a cancellation request was made
' proc.Kill()
' Return Nothing
' Exit Function
'End If
ffmpegOutput = ffmpegOutput + vbNewLine + sr.ReadLine
ffmpegOutput2 = sr.ReadLine
Try
If x = False Then
Dim ZeitGesamt As String() = ffmpegOutput.Split(New String() {"Duration: "}, System.StringSplitOptions.RemoveEmptyEntries)
Dim ZeitGesamt2 As String() = ZeitGesamt(1).Split(New [Char]() {System.Convert.ToChar(".")})
Dim ZeitGesamtSplit() As String = ZeitGesamt2(0).Split(New [Char]() {System.Convert.ToChar(":")})
Dim ZeitGesamtInteger As Integer = CInt(ZeitGesamtSplit(0)) * 3600 + CInt(ZeitGesamtSplit(1)) * 60 + CInt(ZeitGesamtSplit(2))
Grundwert = ZeitGesamtInteger
x = True
End If
If Me.Visible = False Or AbourtList.Contains(Filename) Then
proc.Kill()
RaiseEvent UpdateUI(Filename, 200)
Return Nothing
Exit Function
End If
Dim ZeitFertig As String() = sr.ReadLine.Split(New String() {"time="}, System.StringSplitOptions.RemoveEmptyEntries)
Dim ZeitFertig2 As String() = ZeitFertig(1).Split(New [Char]() {System.Convert.ToChar(".")})
Dim ZeitFertigSplit() As String = ZeitFertig2(0).Split(New [Char]() {System.Convert.ToChar(":")})
Dim ZeitFertigInteger As Integer = CInt(ZeitFertigSplit(0)) * 3600 + CInt(ZeitFertigSplit(1)) * 60 + CInt(ZeitFertigSplit(2))
Dim percent As Integer = (CInt(ZeitFertigInteger / Grundwert * 100))
RaiseEvent UpdateUI(Filename, percent)
'AsyncWorkerX.RunAsync(AddressOf Main_Update_Gecko, Filename, percent)
Catch ex As Exception
End Try
Loop Until proc.HasExited And ffmpegOutput2 = Nothing Or ffmpegOutput2 = ""
'AsyncWorkerX.RunAsync(AddressOf Main_Update_Gecko, Filename, 100)
RaiseEvent UpdateUI(Filename, 100)
TaskCount = TaskCount - 1
'MsgBox(ffmpegOutput)
Return Nothing
End Function
Private Sub Main_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
Try
Me.Visible = False
Pause(2)
Catch ex As Exception
End Try
End Sub
Private Sub Main_UpdateUI(sender As String, ByVal int As Integer) Handles Me.UpdateUI
For i As Integer = 0 To PB_list.Count - 1
If PB_list(i).Name = sender Then
If int = 200 Then
Dim p As PictureBox = PB_list(i)
Dim c As Integer = CInt(ListView1.Items.Item(i).Text)
ListView1.Items.Item(i).Text = int
p.Image = p.BackgroundImage
Dim g As Graphics = Graphics.FromImage(p.Image)
Dim ProgressbarPoint As Point = New Point(195, 70)
Dim WeißeBox As Point = New Point(750, 93)
Dim ProzentText As Point = New Point(773, 95)
Dim Weiß As Brush = New SolidBrush(Color.FromArgb(242, 242, 242))
g.FillRectangle(Weiß, WeißeBox.X + 1, WeißeBox.Y + 1, 50, 20)
g.DrawString("-%", FontLabel2.Font, Brushes.Black, ProzentText)
Dim brGradient As Brush = New SolidBrush(Color.FromArgb(125, 0, 0))
g.FillRectangle(brGradient, ProgressbarPoint.X + 1, ProgressbarPoint.Y + 1, 600, 19)
g.Dispose()
Else
Dim p As PictureBox = PB_list(i)
Dim c As Integer = CInt(ListView1.Items.Item(i).Text)
ListView1.Items.Item(i).Text = int
p.Image = p.BackgroundImage
Dim g As Graphics = Graphics.FromImage(p.Image)
Dim ProgressbarPoint As Point = New Point(195, 70)
Dim WeißeBox As Point = New Point(750, 93)
Dim ProzentText As Point = New Point(755, 95)
Dim Weiß As Brush = New SolidBrush(Color.FromArgb(242, 242, 242))
If int < 10 Then
ProzentText = New Point(773, 95)
ElseIf int < 100 Then
ProzentText = New Point(768, 95)
End If
g.FillRectangle(Weiß, WeißeBox.X + 1, WeißeBox.Y + 1, 50, 20)
g.DrawString(int.ToString + "%", FontLabel2.Font, Brushes.Black, ProzentText)
Dim brGradient As Brush = New SolidBrush(Color.FromArgb(247, 140, 37))
g.FillRectangle(brGradient, ProgressbarPoint.X + 1, ProgressbarPoint.Y + 1, int * 6, 19)
g.Dispose()
End If
End If
Next
End Sub
Private Sub pictureBox3_Click(sender As Object, e As EventArgs) Handles pictureBox3.Click
If TaskCount > 0 Then
If MessageBox.Show("Are you sure you want close the program and end all active downloads?", "confirm?", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.Yes Then
Me.Close()
End If
Else
Me.Close()
End If
End Sub
Private Sub pictureBox4_Click(sender As Object, e As EventArgs) Handles pictureBox4.Click
Anime_Add.Show()
End Sub
Private Sub pictureBox2_Click(sender As Object, e As EventArgs) Handles pictureBox2.Click
einstellungen.Show()
End Sub
Private Sub pictureBox1_Click(sender As Object, e As EventArgs) Handles pictureBox1.Click
UserBowser = True
GeckoFX.Show()
End Sub
#Region " Move Form "
' [ Move Form ]
'
' // By Elektro
Public MoveForm As Boolean
Public MoveForm_MousePosition As Point
Public Sub MoveForm_MouseDown(sender As Object, e As MouseEventArgs) Handles _
MyBase.MouseDown ' Add more handles here (Example: PictureBox1.MouseDown)
If e.Button = MouseButtons.Left Then
MoveForm = True
Me.Cursor = Cursors.NoMove2D
MoveForm_MousePosition = e.Location
End If
End Sub
Public Sub MoveForm_MouseMove(sender As Object, e As MouseEventArgs) Handles _
MyBase.MouseMove ' Add more handles here (Example: PictureBox1.MouseMove)
If MoveForm Then
Me.Location = Me.Location + (e.Location - MoveForm_MousePosition)
End If
End Sub
Public Sub MoveForm_MouseUp(sender As Object, e As MouseEventArgs) Handles _
MyBase.MouseUp ' Add more handles here (Example: PictureBox1.MouseUp)
If e.Button = MouseButtons.Left Then
MoveForm = False
Me.Cursor = Cursors.Default
End If
End Sub
#End Region
Private Sub PictureBox5_Click(sender As Object, e As EventArgs)
Startup.ShowDialog()
End Sub
Public Function RemoveExtraSpaces(input_text As String) As String
Dim rsRegEx As System.Text.RegularExpressions.Regex
rsRegEx = New System.Text.RegularExpressions.Regex("\s+")
Return rsRegEx.Replace(input_text, " ").Trim()
End Function
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
Try
For s As Integer = 0 To ListView1.Items.Count - 1
Dim r As Rectangle = ListView1.Items.Item(s).Bounds
PB_list(s).SetBounds(r.X, r.Y, r.Width, r.Height)
bt_dl(s).SetBounds(755, r.Y + 20, 50, 40)
Next
Catch ex As Exception
End Try
End Sub
Public Shared Function GetPage(url As String) As String
Try
Dim ourUri As New Uri(url)
Dim myHttpWebRequest As HttpWebRequest = CType(WebRequest.Create(ourUri), HttpWebRequest)
myHttpWebRequest.Timeout = 10000
Dim myHttpWebResponse As HttpWebResponse = CType(myHttpWebRequest.GetResponse(), HttpWebResponse)
Return myHttpWebResponse.ResponseUri.ToString
myHttpWebResponse.Close()
Catch e As Exception
'MsgBox(e.Message.ToString)
Return url
End Try
End Function
Public Function FFMPEG_Reso(ByVal DL_URL As String) As String
Dim proc As New Process
Dim exepath As String = Application.StartupPath + "\ffmpeg.exe"
Dim startinfo As New System.Diagnostics.ProcessStartInfo
Dim sr As StreamReader
' Dim cmd As String = "-i " + Chr(34) + URL_DL + Chr(34) + " -c copy -bsf:a aac_adtstoasc " + Pfad_DL 'start ffmpeg with command strFFCMD string
'-bsf:a aac_adtstoasc
Dim cmd As String = "-i " + Chr(34) + DL_URL + Chr(34) 'start ffmpeg with command strFFCMD string
'MsgBox(cmd)
'22050
'
Dim ffmpegOutput As String = Nothing
Dim ffmpegOutput2 As String = Nothing
'all parameters required to run the process
startinfo.FileName = exepath
startinfo.Arguments = cmd
startinfo.UseShellExecute = False
startinfo.WindowStyle = ProcessWindowStyle.Hidden
startinfo.RedirectStandardError = True
startinfo.RedirectStandardOutput = True
startinfo.CreateNoWindow = True
proc.StartInfo = startinfo
proc.Start() ' start the process
sr = proc.StandardError 'standard error is used by ffmpeg
Dim ZeitAnzeige As String = Nothing
Dim StreamNR As String = Nothing
Dim x As Boolean = False
Do
ffmpegOutput = ffmpegOutput + vbNewLine + sr.ReadLine
ffmpegOutput2 = sr.ReadLine
Try
If x = False Then
If InStr(ffmpegOutput, "Duration: ") Then
x = True
Dim ZeitGesamt As String() = ffmpegOutput.Split(New String() {"Duration: "}, System.StringSplitOptions.RemoveEmptyEntries)
Dim ZeitGesamt2 As String() = ZeitGesamt(1).Split(New [Char]() {System.Convert.ToChar(".")})
Dim ZeitGesamtSplit() As String = ZeitGesamt2(0).Split(New [Char]() {System.Convert.ToChar(":")})
For i As Integer = 0 To ZeitGesamtSplit.Count - 1
If ZeitGesamtSplit(i) = "00" Then
Else
If ZeitAnzeige = Nothing Then
ZeitAnzeige = ZeitGesamtSplit(i)
Else
ZeitAnzeige = ZeitAnzeige + ":" + ZeitGesamtSplit(i)
End If
End If
Next
End If
End If
Catch ex As Exception
End Try
Pause(1)
Loop Until proc.HasExited And ffmpegOutput2 = Nothing Or InStr(ffmpegOutput, "At least one output file must be specified") 'And ffmpegOutput2 = Nothing Or ffmpegOutput2 = ""
If InStr(ffmpegOutput, "Server returned 401 Unauthorized") Then
End If
Dim Zeilen() As String = ffmpegOutput.Split(New String() {vbNewLine}, System.StringSplitOptions.RemoveEmptyEntries)
For i As Integer = 0 To Zeilen.Count - 1
If InStr(Zeilen(i), "x" + Resu.ToString + " [") Then
Dim ZeileReso() As String = Zeilen(i).Split(New String() {": Video:"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim ZeileReso2() As String = ZeileReso(0).Split(New String() {"Stream #"}, System.StringSplitOptions.RemoveEmptyEntries)
StreamNR = ZeileReso2(1)
End If
Next
If StreamNR = Nothing Then
MsgBox(cmd + vbNewLine + ffmpegOutput)
ResoNotFoundString = ffmpegOutput
DialogTaskString = "Resolution"
Reso.ShowDialog()
'MsgBox(ResoBackString)
If UserCloseDialog = True Then
Throw New System.Exception(Chr(34) + "UserAbort" + Chr(34))
Else
For i As Integer = 0 To Zeilen.Count - 1
If InStr(Zeilen(i), ResoBackString) Then
Dim ZeileReso() As String = Zeilen(i).Split(New String() {": Video:"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim ZeileReso2() As String = ZeileReso(0).Split(New String() {"Stream #"}, System.StringSplitOptions.RemoveEmptyEntries)
StreamNR = ZeileReso2(1)
End If
Next
End If
End If
Return ZeitAnzeige + "#1" + StreamNR
End Function
'If CBool(InStr(str, "x" + Resu.ToString + ",")) Then
' Resu2 = "x" + Resu.ToString
'Else
' If CBool(InStr(str, ResuSave + ",")) Then
' Resu2 = Resu2
' Else
' ResoNotFoundString = str
' DialogTaskString = "Resolution"
' Reso.ShowDialog()
' 'MsgBox(ResoBackString)
' If UserCloseDialog = True Then
' Throw New System.Exception(Chr(34) + "UserAbort" + Chr(34))
' Else
' Resu2 = ResoBackString
' End If
' End If
'End If
''MsgBox(Resu2)
'Dim VLC_URI_1 As String() = str.Split(New String() {Resu2 + ","}, System.StringSplitOptions.RemoveEmptyEntries)
'Dim VLC_URI_2 As String() = VLC_URI_1(1).Split(New [Char]() {Chr(34)})
'Dim VLC_URI_3 As String() = VLC_URI_2(2).Split(New [Char]() {System.Convert.ToChar("#")})
End Class