Crunchyroll-Downloader-v3.0/Crunchyroll Downloader/CRD_List_Item.vb
hama3254 6b41f2571b fixes + version checker
fix funimation hardsub dfxp issue
fix download count wrong
fix unicode characters
added version checker in about via github releases
2021-01-14 18:06:42 +01:00

1312 lines
55 KiB
VB.net

Imports System.Net
Imports System.Text
Imports System.IO
Imports System.Threading
Imports Microsoft.Win32
Imports System.ComponentModel
Imports MetroFramework
Imports MetroFramework.Components
Imports MetroFramework.Forms
Public Class CRD_List_Item
Inherits Controls.MetroUserControl
Dim ZeitGesamtInteger As Integer = 0
Dim ListOfStreams As New List(Of String)
Dim proc As Process
Dim ThreadList As New List(Of Thread)
Dim Item_ErrorTolerance As Integer
Dim Canceld As Boolean = False
Dim Finished As Boolean = False
Dim Label_website_Text As String = Nothing
Dim StatusRunning As Boolean = True
Dim ffmpeg_command As String = Nothing
Dim Debug2 As Boolean = False
Dim MergeSubstoMP4 As Boolean = False
Dim SaveLog As Boolean = False
Dim DownloadPfad As String = Nothing
Dim ToDispose As Boolean = False
Dim Failed As Boolean = False
Dim FailedCount As Integer = 0
Dim HistoryDL_URL As String
Dim HistoryDL_Pfad As String
Dim HistoryFilename As String
Dim Retry As Boolean = False
Dim HybridMode As Boolean = False
Dim HybridModePath As String = Nothing
Dim HybridRunning As Boolean = False
Dim TargetReso As Integer = 1080
Dim HybrideLog As String = Nothing
Dim Service As String = "CR"
Dim ServiceSleep As Integer = 0
Dim LastDate As Date = Date.Now
Dim LastSize As Double = 0
Dim LastDataRate1 As Double = 0
Dim LastDataRate2 As Double = 0
Dim LastDataRate3 As Double = 0
Dim FailedSegments As New List(Of FailedSegemtsWithURL)
Dim LogText As New List(Of String)
#Region "Remove from list"
Public Sub DisposeItem(ByVal Dispose As Boolean)
If Dispose = True Then
Me.Dispose()
End If
End Sub
Public Function GetToDispose() As Boolean
Return ToDispose
End Function
#End Region
#Region "UI"
Private Sub CRD_List_Item_Resize(sender As Object, e As EventArgs) Handles Me.Resize
bt_del.SetBounds(775, 10, 35, 29)
bt_pause.SetBounds(740, 15, 25, 20)
PB_Thumbnail.SetBounds(11, 20, 168, 95)
PB_Thumbnail.BringToFront()
Label_website.Location = New Point(195, 12)
Label_Anime.Location = New Point(195, 40)
Label_Reso.Location = New Point(195, 97)
Label_Hardsub.Location = New Point(265, 97)
Label_percent.SetBounds(Me.Width - 400, 97, 378, 27)
Label_percent.AutoSize = False
ProgressBar1.SetBounds(195, 70, 601, 20)
PictureBox5.Location = New Point(0, 136)
PictureBox5.Height = 6
If Service = "AoD" Then
MetroStyleManager1.Style = MetroColorStyle.LightGreen
ServiceSleep = 1000
ElseIf Service = "FM" Then
MetroStyleManager1.Style = MetroColorStyle.DarkPurple
Else
MetroStyleManager1.Style = MetroColorStyle.Orange
End If
MetroStyleManager1.Theme = Main.Manager.Theme
MetroStyleManager1.Owner = Me
Me.StyleManager = MetroStyleManager1
PictureBox5.Width = Me.Width - 40
bt_del.Location = New Point(Me.Width - 63, 10)
bt_pause.Location = New Point(Me.Width - 98, 15)
ProgressBar1.Width = Me.Width - 223
End Sub
Public Sub SetLabelWebsite(ByVal Text As String)
Label_website.Text = Text
Label_website_Text = Text
End Sub
Public Sub SetTheme(ByVal Theme As MetroThemeStyle)
MetroStyleManager1.Theme = Theme
End Sub
Public Sub SetTolerance(ByVal value As Integer)
Item_ErrorTolerance = value
End Sub
Public Sub SetLabelAnimeTitel(ByVal Text As String)
Label_Anime.Text = Text
End Sub
Public Sub SetLabelResolution(ByVal Text As String)
Label_Reso.Text = Text
End Sub
Public Sub SetLabelHardsub(ByVal Text As String)
Label_Hardsub.Text = Text
End Sub
Public Sub SetLabelPercent(ByVal Text As String)
Label_percent.Text = Text
End Sub
Public Sub SetThumbnailImage(ByVal Thumbnail As Image)
PB_Thumbnail.BackgroundImage = Thumbnail
End Sub
#End Region
#Region "Get Variables"
Public Function GetPauseStatus() As Boolean
Return StatusRunning
End Function
Public Function GetIsStatusFinished() As Boolean
If Canceld = True Then
Return True
ElseIf HybridRunning = True Then
Return False
Else
If proc.HasExited = True Then
Return True
Else
Return False
End If
End If
End Function
Public Function GetLabelPercent()
Try
Return Label_percent.Text
Catch ex As Exception
Return 0
End Try
End Function
Public Function GetPercentValue()
Try
Return ProgressBar1.Value
Catch ex As Exception
Return 0
End Try
End Function
Public Function GetNameAnime()
Try
Return Label_Anime.Text
Catch ex As Exception
Return "error"
End Try
End Function
#End Region
#Region "Set Variables"
Public Sub Setffmpeg_command(ByVal Value As String)
ffmpeg_command = Value
End Sub
Public Sub SetMergeSubstoMP4(ByVal Value As Boolean)
MergeSubstoMP4 = Value
End Sub
Public Sub SetDebug2(ByVal Value As Boolean)
Debug2 = Value
End Sub
Public Sub SetSaveLog(ByVal Value As Boolean)
SaveLog = Value
End Sub
Public Sub SetTargetReso(ByVal Value As Integer)
TargetReso = Value
End Sub
Public Sub SetService(ByVal Value As String)
Service = Value
End Sub
#End Region
Public Sub KillRunningTask()
If HybridRunning = True Then
Canceld = True
Else
Try
If proc.HasExited Then
Else
proc.Kill()
proc.WaitForExit(500)
Label_percent.Text = "canceled -%"
End If
Catch ex As Exception
End Try
End If
End Sub
Private Sub BT_del_MouseEnter(sender As Object, e As EventArgs) Handles bt_del.MouseEnter
Dim p As PictureBox = sender
p.BackgroundImage = My.Resources.main_del_hover
End Sub
Private Sub BT_del_MouseLeave(sender As Object, e As EventArgs) Handles bt_del.MouseLeave
Dim p As PictureBox = sender
p.BackgroundImage = My.Resources.main_del
End Sub
Private Sub BT_pause_MouseEnter(sender As Object, e As EventArgs) Handles bt_pause.MouseEnter
Dim p As PictureBox = sender
If StatusRunning = True Then
p.BackgroundImage = My.Resources.main_pause_hover
Else
p.BackgroundImage = My.Resources.main_pause_play_hover
End If
End Sub
Private Sub BT_pause_MouseLeave(sender As Object, e As EventArgs) Handles bt_pause.MouseLeave
Dim p As PictureBox = sender
If StatusRunning = True Then
p.BackgroundImage = My.Resources.main_pause
Else
p.BackgroundImage = My.Resources.main_pause_play
End If
End Sub
Private Sub BT_pause_Click(sender As Object, e As EventArgs) Handles bt_pause.Click
If Canceld = True And HybridRunning = True Then
If Main.RunningDownloads < Main.MaxDL Then
Else
If MessageBox.Show("You have currtenly on your set Download limit." + vbNewLine + " You can Press OK to ignore it.", "Download maximum reached", MessageBoxButtons.OKCancel) = DialogResult.Cancel Then
Exit Sub
End If
End If
Canceld = False
'If My.Computer.FileSystem.FileExists(HistoryDL_Pfad.Replace(Chr(34), "")) Then 'Pfad = Kompeltter Pfad mit Dateinamen + ENdung
' Try
' My.Computer.FileSystem.DeleteFile(HistoryDL_Pfad.Replace(Chr(34), ""))
' Catch ex As Exception
' End Try
'End If
StartDownload(HistoryDL_URL, HistoryDL_Pfad, HistoryFilename, HybridMode)
StatusRunning = True
Label_website.Text = Label_website_Text
Exit Sub
ElseIf HybridRunning = True Then
If StatusRunning = True Then
StatusRunning = False
bt_pause.BackgroundImage = My.Resources.main_pause_play
ElseIf Failed = True Then
Dim Result As DialogResult = MessageBox.Show("The hybride mode has failed to download a fragment." + vbNewLine + "Press 'Retry' to retry the fragment or 'Ignore' to continue.", "Download Error", MessageBoxButtons.AbortRetryIgnore) '= DialogResult.Ignore Then
If Result = DialogResult.Ignore Then
Failed = False
StatusRunning = True
bt_pause.BackgroundImage = My.Resources.main_pause
FailedSegments.Clear()
ElseIf Result = DialogResult.Retry Then
If FailedSegments.Count > 0 Then
For i As Integer = 0 To FailedSegments.Count - 1
Dim ii As Integer = i
Dim Evaluator = New Thread(Sub() Me.TS_DownloadAsync(FailedSegments.Item(ii).url, FailedSegments.Item(ii).path))
FailedSegments.RemoveAt(i)
Evaluator.Start()
ThreadList.Add(Evaluator)
Next
Failed = False
StatusRunning = True
bt_pause.BackgroundImage = My.Resources.main_pause
End If
ElseIf Result = DialogResult.Abort Then
If MessageBox.Show("Are you sure you want to cancel the Download?", "Cancel Download!", MessageBoxButtons.YesNo) = DialogResult.No Then
Exit Sub
End If
Canceld = True
End If
Else
StatusRunning = True
bt_pause.BackgroundImage = My.Resources.main_pause
End If
Else
If proc.HasExited = True Then
If ProgressBar1.Value < 100 Then
If Retry = True Then
If Main.RunningDownloads < Main.MaxDL Then
Else
If MessageBox.Show("You have currtenly on your set Download limit." + vbNewLine + " You can Press OK to ignore it.", "Download maximum reached", MessageBoxButtons.OKCancel) = DialogResult.Cancel Then
Exit Sub
End If
End If
If My.Computer.FileSystem.FileExists(HistoryDL_Pfad.Replace(Chr(34), "")) Then 'Pfad = Kompeltter Pfad mit Dateinamen + ENdung
Try
My.Computer.FileSystem.DeleteFile(HistoryDL_Pfad.Replace(Chr(34), ""))
Catch ex As Exception
End Try
End If
StartDownload(HistoryDL_URL, HistoryDL_Pfad, HistoryFilename, HybridMode)
StatusRunning = True
Label_website.Text = Label_website_Text
Else
MsgBox("The download process seems to have crashed", MsgBoxStyle.Exclamation)
Label_percent.Text = "Press the play button again to retry."
ProgressBar1.Value = 0
Retry = True
StatusRunning = False
End If
Else
End If
Exit Sub
End If
If StatusRunning = True Then
StatusRunning = False
bt_pause.BackgroundImage = My.Resources.main_pause_play
SuspendProcess(proc)
Else
If Failed = True Then
'If HybridMode = True Then
'Else
Dim Result As DialogResult = MessageBox.Show("The download has " + FailedCount.ToString + " failded segments" + vbNewLine + "Press 'Ignore' to continue", "Download Error", MessageBoxButtons.AbortRetryIgnore) '= DialogResult.Ignore Then
If Result = DialogResult.Ignore Then
Failed = False
StatusRunning = True
bt_pause.BackgroundImage = My.Resources.main_pause
ResumeProcess(proc)
ElseIf Result = DialogResult.Retry Then
Try
proc.Kill()
proc.WaitForExit(500)
Label_percent.Text = "retrying -%"
Label_website.Text = Label_website_Text
Catch ex As Exception
End Try
If proc.HasExited Then
StartDownload(HistoryDL_URL, HistoryDL_Pfad, HistoryFilename, HybridMode)
StatusRunning = True
Label_website.Text = Label_website_Text
bt_pause.BackgroundImage = My.Resources.main_pause
End If
ElseIf Result = DialogResult.Abort Then
Try
proc.Kill()
proc.WaitForExit(500)
Label_percent.Text = "canceled -%"
Label_website.Text = Label_website_Text
Catch ex As Exception
End Try
End If
' End If
Else
If StatusRunning = True Then
StatusRunning = False
bt_pause.BackgroundImage = My.Resources.main_pause_play
SuspendProcess(proc)
Else
StatusRunning = True
bt_pause.BackgroundImage = My.Resources.main_pause
ResumeProcess(proc)
End If
End If
End If
End If
End Sub
Public Sub SetToolTip(ByVal Text As String)
ToolTip1.SetToolTip(Me, Text)
End Sub
Private Sub Item_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.ContextMenuStrip = ContextMenuStrip1 '.ContextMenu
'bt_del.SetBounds(775, 10, 35, 29)
'bt_pause.SetBounds(740, 15, 25, 20)
'PB_Thumbnail.SetBounds(11, 20, 168, 95)
'PB_Thumbnail.BringToFront()
'Label_website.Location = New Point(195, 15)
'Label_Anime.Location = New Point(195, 37)
'Label_Reso.Location = New Point(195, 97)
'Label_Hardsub.Location = New Point(265, 97)
'Label_percent.SetBounds(432, 97, 378, 27)
'Label_percent.AutoSize = False
'ProgressBar1.SetBounds(195, 70, 601, 20)
'PictureBox5.Location = New Point(0, 136)
'PictureBox5.Height = 6
'MetroStyleManager1.Theme = Main.Manager.Theme
End Sub
Public Function GetTextBound()
'Return Label_website.Location.Y
Return bt_del.Size.Height
End Function
#Region "Download + Update UI"
Public Sub StartDownload(ByVal DL_URL As String, ByVal DL_Pfad As String, ByVal Filename As String, ByVal DownloadHybridMode As Boolean)
'MsgBox(DL_URL)
Me.StyleManager = MetroStyleManager1
DownloadPfad = DL_Pfad
HistoryDL_URL = DL_URL
HistoryDL_Pfad = DL_Pfad
HistoryFilename = Filename
If DownloadHybridMode = True Then
Dim Evaluator = New Thread(Sub() DownloadHybrid(DL_URL, DL_Pfad, Filename))
Evaluator.Start()
HybridMode = True
HybridRunning = True
Else
DownloadFFMPEG(DL_URL, DL_Pfad, Filename)
End If
End Sub
#Region "Download Cache"
Public WithEvents WC_TS As WebClient
Private Sub TS_DownloadAsync(ByVal DL_URL As String, ByVal DL_Pfad As String)
HybrideLog = HybrideLog + vbNewLine + DL_Pfad + " - " + DL_URL
Try
'Dim wc_ts As New WebClient
WC_TS = New WebClient
WC_TS.DownloadFile(New Uri(DL_URL), DL_Pfad)
Catch ex As Exception
Debug.WriteLine("Download error #1: " + DL_Pfad)
Try
Dim wc_ts As New WebClient
wc_ts.DownloadFile(New Uri(DL_URL), DL_Pfad)
Catch ex2 As Exception
FailedCount = FailedCount + 1
If Item_ErrorTolerance = 0 Then
ElseIf FailedCount >= Item_ErrorTolerance Then
FailedSegments.Add(New FailedSegemtsWithURL(DL_Pfad, DL_URL))
Failed = True
StatusRunning = False
bt_pause.BackgroundImage = My.Resources.main_pause_play
Me.Invoke(New Action(Function()
Label_percent.Text = "Missing segment detected, retry or resume with the play button"
Return Nothing
End Function))
End If
Debug.WriteLine("Download error #2: " + DL_Pfad + vbNewLine + ex.ToString + vbNewLine + DL_URL)
End Try
End Try
End Sub
Private Function TS_StatusAsync(ByVal prozent As Integer, ByVal di As IO.DirectoryInfo, ByVal Filename As String, ByVal pausetime As Integer)
'Dim Now As Date = Date.Now
Dim FinishedSize As Double = 0
Dim AproxFinalSize As Double = 0
Try
Dim aryFi As IO.FileInfo() = di.GetFiles("*.ts")
Dim fi As IO.FileInfo
For Each fi In aryFi
FinishedSize = FinishedSize + fi.Length 'Math.Round(fi.Length / 1048576, 2, MidpointRounding.AwayFromZero).ToString()
Next
Catch ex As Exception
End Try
''Thread.Sleep(1000)
''Pause(1)
If prozent > 0 Then
AproxFinalSize = Math.Round((FinishedSize / 1048576) * 100 / prozent, 2, MidpointRounding.AwayFromZero).ToString() ' Math.Round( / 1048576, 2, MidpointRounding.AwayFromZero).ToString()
End If
'Dim duration As TimeSpan = Date.Now - di.CreationTime
'Dim TimeinSeconds As Integer = duration.Hours * 3600 + duration.Minutes * 60 + duration.Seconds
'TimeinSeconds = TimeinSeconds - pausetime
'Dim DataRate As Double = FinishedSize / TimeinSeconds
'Dim DataRateString As String = Math.Round(DataRate, 2, MidpointRounding.AwayFromZero).ToString()
Dim duration As TimeSpan = Date.Now - LastDate
Dim TimeinMilliSeconds As Integer = duration.Seconds * 1000 + duration.Milliseconds
If FinishedSize = LastSize Then
ElseIf TimeinMilliSeconds < 250 Then
Else
LastDate = Date.Now
'TimeinSeconds = TimeinSeconds - pausetime
Dim SinceLast = FinishedSize - LastSize
LastSize = FinishedSize
Dim DataRate As Double = (SinceLast / 1048576) / (TimeinMilliSeconds / 1000)
Dim DataRateFinal As Double = (DataRate + LastDataRate1 + LastDataRate2 + LastDataRate3) / 4
LastDataRate3 = LastDataRate2
LastDataRate2 = LastDataRate1
LastDataRate1 = DataRate
Dim DataRateString As String = Math.Round(DataRateFinal, 2, MidpointRounding.AwayFromZero).ToString()
'Debug.WriteLine("----------------")
'Debug.WriteLine(SinceLast)
'Debug.WriteLine(TimeinMilliSeconds)
'Debug.WriteLine(DataRate)
If prozent > 100 Then
prozent = 100
ElseIf prozent < 0 Then
prozent = 0
End If
Try
Me.Invoke(New Action(Function()
ProgressBar1.Value = prozent 'ThreadList.Count.ToString + " " +
Label_percent.Text = DataRateString + "MB\s " + Math.Round(FinishedSize / 1048576, 2, MidpointRounding.AwayFromZero).ToString + "MB/" + Math.Round(AproxFinalSize, 2, MidpointRounding.AwayFromZero).ToString + "MB " + prozent.ToString + "%"
Return Nothing
End Function))
Catch ex As Exception
End Try
End If
'RaiseEvent UpdateUI(Filename, prozent, FinishedSize, AproxFinalSize, Color.FromArgb(247, 140, 37), DataRateString + "MB\s")
Return Nothing
End Function
Public Function DownloadHybrid(ByVal DL_URL As String, ByVal DL_Pfad As String, ByVal Filename As String) As String
'MsgBox(DL_URL)
Dim Folder As String = Einstellungen.GeräteID()
Dim Pfad2 As String = Path.GetDirectoryName(DL_Pfad.Replace(Chr(34), "")) + "\" + Folder + "\"
If Not Directory.Exists(Path.GetDirectoryName(Pfad2)) Then
' Nein! Jetzt erstellen...
Try
Directory.CreateDirectory(Path.GetDirectoryName(Pfad2))
Catch ex As Exception
MsgBox("Temp folder creation failed")
Return Nothing
Exit Function
' Ordner wurde nich erstellt
'Pfad2 = Pfad + "\" + CR_FilenName_Backup + ".mp4"
End Try
End If
Dim MergeSub As String() = DL_URL.Split(New String() {"-i " + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
If MergeSub.Count > 1 Then
Me.Invoke(New Action(Function()
Label_percent.Text = "Downloading Subtitles..."
Return Nothing
End Function))
For i As Integer = 1 To MergeSub.Count - 1
Dim SubsURL As String() = MergeSub(i).Split(New [Char]() {Chr(34)})
Dim SubsClient As New WebClient
SubsClient.Encoding = Encoding.UTF8
If Main.WebbrowserCookie = Nothing Then
Else
SubsClient.Headers.Add(HttpRequestHeader.Cookie, Main.WebbrowserCookie)
End If
Dim SubsFile As String = Einstellungen.GeräteID() + ".txt"
Dim retry As Boolean = True
Dim retryCount As Integer = 3
While retry
Try
SubsClient.DownloadFile(SubsURL(0), Pfad2 + "\" + SubsFile)
retry = False
Catch ex As Exception
If retryCount > 0 Then
retryCount = retryCount - 1
Me.Invoke(New Action(Function()
Label_percent.Text = "Error Downloading Subtitles - retrying"
Return Nothing
End Function))
Else
Dim utf8WithoutBom2 As New System.Text.UTF8Encoding(False)
Using sink As New StreamWriter(SubsFile, False, utf8WithoutBom2)
sink.WriteLine(My.Resources.ass_template)
End Using
retry = False
End If
End Try
End While
DL_URL = DL_URL.Replace(SubsURL(0), Pfad2 + "\" + SubsFile)
Next
End If
Dim m3u8_url As String() = DL_URL.Split(New [Char]() {Chr(34)})
Dim m3u8_url_1 As String = Nothing
Dim m3u8_url_3 As String = m3u8_url(1)
If Debug2 = True Then
MsgBox(m3u8_url(1) + vbNewLine + DL_Pfad + vbNewLine + Filename)
End If
Dim client0 As New WebClient
client0.Encoding = Encoding.UTF8
Dim text As String = Nothing
Try
text = client0.DownloadString(m3u8_url(1))
Catch ex As Exception
Me.Invoke(New Action(Function()
Label_website.Text = "Hybrid mode error"
Label_percent.Text = ex.ToString
Return Nothing
End Function))
Return Nothing
Exit Function
End Try
If InStr(text, "RESOLUTION=") Then 'master m3u8 no fragments
'My.Computer.FileSystem.WriteAllText(Application.StartupPath + "\log.txt", text, False)
Dim new_m3u8_2() As String = text.Split(New String() {vbLf}, System.StringSplitOptions.RemoveEmptyEntries)
If TargetReso = 42 Then
TargetReso = 1080
End If
For i As Integer = 0 To new_m3u8_2.Count - 1
'MsgBox("x" + Main.Resu.ToString)
If CBool(InStr(new_m3u8_2(i), "x" + TargetReso.ToString)) = True Then
m3u8_url_1 = new_m3u8_2(i + 1)
Exit For
End If
Next
If InStr(m3u8_url_1, "https://") Then
text = client0.DownloadString(m3u8_url_1)
Else
Dim c() As String = New Uri(m3u8_url_3).Segments
Dim path As String = "https://" + New Uri(m3u8_url_3).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
m3u8_url_3 = path + m3u8_url_1
'MsgBox(m3u8_url_3)
text = client0.DownloadString(m3u8_url_3)
End If
End If
Dim LoadedKeys As New List(Of String)
LoadedKeys.Add("Nothing")
Dim KeyFileCache As String = Nothing
Dim textLenght() As String = text.Split(New String() {vbLf}, System.StringSplitOptions.RemoveEmptyEntries)
Dim Fragments() As String = text.Split(New String() {".ts"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim FragmentsInt As Integer = Fragments.Count - 2
Dim nummerint As Integer = 0 '-1
Dim m3u8FFmpeg As String = Nothing
Dim ts_dl As String = Nothing
HybridModePath = Pfad2
If Debug2 = True Then
MsgBox(Pfad2)
End If
Dim PauseTime As Integer = 0
Dim Threads As Integer = Environment.ProcessorCount / 2 - 1
If Threads < 2 Then
Threads = 2
End If
'Threads = textLenght.Length / 20
Dim di As New IO.DirectoryInfo(Pfad2)
For i As Integer = 0 To textLenght.Length - 1
If InStr(textLenght(i), ".ts") Then
For w As Integer = 0 To Integer.MaxValue
If StatusRunning = False Then
'MsgBox(True.ToString)
Thread.Sleep(5000)
PauseTime = PauseTime + 5
ElseIf ThreadList.Count > Threads Then
Thread.Sleep(50)
ElseIf Canceld = True Then
For www As Integer = 0 To Integer.MaxValue
If ThreadList.Count > 0 Then
Thread.Sleep(250)
Else
Try
System.IO.Directory.Delete(HybridModePath, True)
Catch ex As Exception
End Try
Me.Invoke(New Action(Function()
ProgressBar1.Value = 0
Label_percent.Text = "canceled -%"
bt_pause.BackgroundImage = My.Resources.main_pause_play
Return Nothing
End Function))
Exit For
End If
Next
Return Nothing
Exit Function
'ElseIf nummerint < Threads Then
' Thread.Sleep(2000)
' Exit For
Else
Thread.Sleep(ServiceSleep)
Exit For
End If
Next
nummerint = nummerint + 1
Dim nummer4D As String = String.Format("{0:0000}", nummerint)
Dim curi As String = textLenght(i)
If InStr(curi, "https://") Then
ElseIf InStr(curi, "../") Then
Dim countDot() As String = curi.Split(New String() {"./"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim c() As String = New Uri(m3u8_url_3).Segments
Dim path As String = "https://" + New Uri(m3u8_url_3).Host
For i3 As Integer = 0 To c.Count - (2 + countDot.Count - 1)
path = path + c(i3)
Next
curi = path + countDot(countDot.Count - 1)
Else
Dim c() As String = New Uri(m3u8_url_3).Segments
Dim path As String = "https://" + New Uri(m3u8_url_3).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
curi = path + textLenght(i)
End If
Dim Evaluator = New Thread(Sub() Me.TS_DownloadAsync(curi, Pfad2 + nummer4D + ".ts"))
Evaluator.Start()
ThreadList.Add(Evaluator)
m3u8FFmpeg = m3u8FFmpeg + Pfad2 + nummer4D + ".ts" + vbLf '+ "#" + curi + vbLf
Dim FragmentsFinised = nummerint / FragmentsInt * 100 '(ThreadList.Count + nummerint) / FragmentsInt * 100
Dim Update = New Thread(Sub() Me.TS_StatusAsync(FragmentsFinised, di, Filename, PauseTime))
Update.Start()
ElseIf textLenght(i) = "#EXT-X-PLAYLIST-TYPE:VOD" Then
ElseIf InStr(textLenght(i), "URI=" + Chr(34)) Then
Dim KeyLine As String = textLenght(i)
If InStr(KeyLine, "https://") Then
Dim KeyFile() As String = KeyLine.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim KeyFile2() As String = KeyFile(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
If LoadedKeys.Item(LoadedKeys.Count - 1) = KeyFile2(0) Then
Else
Dim KeyClient As New WebClient
KeyClient.Encoding = Encoding.UTF8
If Main.WebbrowserCookie = Nothing Then
Else
KeyClient.Headers.Add(HttpRequestHeader.Cookie, Main.WebbrowserCookie)
End If
Dim KeyFile3 As String = Einstellungen.GeräteID() + ".key"
KeyFileCache = KeyFile3
Dim retry As Boolean = True
Dim retryCount As Integer = 3
While retry
Try
KeyClient.DownloadFile(KeyFile2(0), Application.StartupPath + "\" + KeyFile3)
retry = False
Catch ex As Exception
If retryCount > 0 Then
retryCount = retryCount - 1
Me.Invoke(New Action(Function()
Label_percent.Text = "Access Error - retrying"
Return Nothing
End Function))
Else
'retry = False
Me.Invoke(New Action(Function()
Label_percent.Text = "Access Error - download canceled"
Return Nothing
End Function))
Return Nothing
Exit Function
End If
End Try
End While
LoadedKeys.Add(KeyFile2(0))
End If
If KeyFile2.Count > 1 Then
KeyLine = KeyFile(0) + "URI=" + Chr(34) + KeyFileCache + Chr(34) + KeyFile2(1)
Else
KeyLine = KeyFile(0) + "URI=" + Chr(34) + KeyFileCache + Chr(34)
End If
'ElseIf InStr(KeyLine, "../") Then
' Dim countDot() As String = KeyLine.Split(New String() {"./"}, System.StringSplitOptions.RemoveEmptyEntries)
' Dim c() As String = New Uri(m3u8_url_3).Segments
' Dim path As String = "https://" + New Uri(m3u8_url_3).Host
' For i3 As Integer = 0 To c.Count - (2 + countDot.Count - 1)
' path = path + c(i3)
' Next
' KeyLine = path + countDot(countDot.Count - 1)
Else
Dim c() As String = New Uri(m3u8_url_3).Segments
Dim path As String = "https://" + New Uri(m3u8_url_3).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
KeyLine = KeyLine.Replace("URI=" + Chr(34), "URI=" + Chr(34) + path) 'path + textLenght(i)
Dim KeyFile() As String = KeyLine.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim KeyFile2() As String = KeyFile(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
If LoadedKeys.Item(LoadedKeys.Count - 1) = KeyFile2(0) Then
Else
Dim KeyClient As New WebClient
KeyClient.Encoding = Encoding.UTF8
If Main.WebbrowserCookie = Nothing Then
Else
KeyClient.Headers.Add(HttpRequestHeader.Cookie, Main.WebbrowserCookie)
End If
Dim KeyFile3 As String = Einstellungen.GeräteID() + ".key"
KeyFileCache = KeyFile3
Dim retry As Boolean = True
Dim retryCount As Integer = 3
Try
KeyClient.DownloadFile(KeyFile2(0), Application.StartupPath + "\" + KeyFile3)
retry = False
Catch ex As Exception
If retryCount > 0 Then
retryCount = retryCount - 1
Me.Invoke(New Action(Function()
Label_percent.Text = "Access Error - retrying"
Return Nothing
End Function))
Else
Me.Invoke(New Action(Function()
Label_percent.Text = "Access Error - download canceled"
Return Nothing
End Function))
Return Nothing
Exit Function
'Dim utf8WithoutBom2 As New System.Text.UTF8Encoding(False)
'Using sink As New StreamWriter(SubsFile, False, utf8WithoutBom2)
' sink.WriteLine(My.Resources.ass_template)
'End Using
'Retry = False
End If
End Try
'KeyClient.DownloadFile(KeyFile2(0), Application.StartupPath + "\" + KeyFile3)
LoadedKeys.Add(KeyFile2(0))
End If
If KeyFile2.Count > 1 Then
KeyLine = KeyFile(0) + "URI=" + Chr(34) + KeyFileCache + Chr(34) + KeyFile2(1)
Else
KeyLine = KeyFile(0) + "URI=" + Chr(34) + KeyFileCache + Chr(34)
End If
End If
m3u8FFmpeg = m3u8FFmpeg + KeyLine + vbLf
Else
m3u8FFmpeg = m3u8FFmpeg + textLenght(i) + vbLf
End If
Next
Dim utf8WithoutBom As New System.Text.UTF8Encoding(False)
Using sink As New StreamWriter(Pfad2 + "\index" + Folder + ".m3u8", False, utf8WithoutBom)
sink.WriteLine(m3u8FFmpeg)
End Using
For w As Integer = 0 To Integer.MaxValue
If ThreadList.Count > 0 Then
Thread.Sleep(250)
Else
Thread.Sleep(250)
Exit For
End If
Next
TS_StatusAsync(100, di, Filename, PauseTime)
DL_URL = DL_URL.Replace(m3u8_url(1), Pfad2 + "index" + Folder + ".m3u8")
If InStr(DL_URL, "-headers " + My.Resources.ffmpeg_user_agend) Then
DL_URL = DL_URL.Replace("-headers " + My.Resources.ffmpeg_user_agend, "")
End If
'Using sink3 As New StreamWriter(Path.GetDirectoryName(DL_Pfad.Replace(Chr(34), "")) + "\hybridelog.log", False, utf8WithoutBom)
' sink3.WriteLine(HybrideLog)
'End Using
'MsgBox(DL_URL)
Dim exepath As String = Application.StartupPath + "\ffmpeg.exe"
Dim startinfo As New System.Diagnostics.ProcessStartInfo
Dim cmd As String = "-allowed_extensions ALL " + DL_URL + " " + DL_Pfad '+ " " + ffmpeg_command + " " + DL_Pfad 'start ffmpeg with command strFFCMD string
' MsgBox(cmd) -headers " + Chr(34) + "User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:81.0) Gecko/20100101 Firefox/81.0" + Chr(34) +
If Debug2 = True Then
MsgBox(cmd)
End If
'all parameters required to run the process
startinfo.FileName = exepath
startinfo.Arguments = cmd
startinfo.UseShellExecute = False
startinfo.WindowStyle = ProcessWindowStyle.Normal
startinfo.RedirectStandardError = True
startinfo.RedirectStandardInput = True
startinfo.RedirectStandardOutput = True
startinfo.CreateNoWindow = True
proc = New Process
proc.EnableRaisingEvents = True
AddHandler proc.ErrorDataReceived, AddressOf FFMPEGOutput
AddHandler proc.OutputDataReceived, AddressOf FFMPEGOutput
AddHandler proc.Exited, AddressOf ProcessClosed
proc.StartInfo = startinfo
proc.Start() ' start the process
proc.BeginOutputReadLine()
proc.BeginErrorReadLine()
HybridRunning = False
Return Nothing
End Function
#End Region
Public Function DownloadFFMPEG(ByVal DLCommand As String, ByVal DL_Pfad As String, ByVal Filename As String) As String
Dim exepath As String = Application.StartupPath + "\ffmpeg.exe"
Dim startinfo As New System.Diagnostics.ProcessStartInfo
Dim cmd As String = "-headers " + My.Resources.ffmpeg_user_agend + " " + DLCommand + " " + DL_Pfad 'start ffmpeg with command strFFCMD string
LogText.Add(Date.Now + " " + cmd)
If Debug2 = True Then
MsgBox(cmd)
End If
'all parameters required to run the process
startinfo.FileName = exepath
startinfo.Arguments = cmd
startinfo.UseShellExecute = False
startinfo.WindowStyle = ProcessWindowStyle.Normal
startinfo.RedirectStandardError = True
startinfo.RedirectStandardInput = True
startinfo.RedirectStandardOutput = True
startinfo.CreateNoWindow = True
proc = New Process
proc.EnableRaisingEvents = True
AddHandler proc.ErrorDataReceived, AddressOf FFMPEGOutput
AddHandler proc.OutputDataReceived, AddressOf FFMPEGOutput
AddHandler proc.Exited, AddressOf ProcessClosed
proc.StartInfo = startinfo
proc.Start() ' start the process
proc.BeginOutputReadLine()
proc.BeginErrorReadLine()
Return Nothing
End Function
Sub ProcessClosed(ByVal sender As Object, ByVal e As System.EventArgs)
Try
Pause(5)
If Finished = False Then
If Canceld = False Then
Label_website.Text = "The download process seems to have crashed"
Label_percent.Text = "Press the play button again to retry."
ProgressBar1.Value = 0
Retry = True
StatusRunning = False
End If
End If
Catch ex As Exception
End Try
'Me.Invoke(New Action(Function()
' Label_percent.Text = "Finished - event"
' Return Nothing
' End Function))
End Sub
Sub FFMPEGOutput(ByVal sender As Object, ByVal e As DataReceivedEventArgs)
Try
LogText.Add(Date.Now + " " + e.Data)
Catch ex As Exception
End Try
Try
Dim logfile As String = DownloadPfad.Replace(".mp4", ".log").Replace(Chr(34), "")
If SaveLog = True Then
If File.Exists(logfile) Then
Using sw As StreamWriter = File.AppendText(logfile)
sw.Write(vbNewLine)
sw.Write(Date.Now + e.Data)
End Using
Else
File.WriteAllText(logfile, Date.Now + " " + e.Data)
End If
End If
Catch ex As Exception
End Try
#Region "Detect Auto resolution"
Try
If MergeSubstoMP4 = False Then
If CBool(InStr(e.Data, "Stream #")) And CBool(InStr(e.Data, "Video")) = True Then
'MsgBox(True.ToString + vbNewLine + e.Data)
'MsgBox(InStr(e.Data, "Stream #").ToString + vbNewLine + InStr(e.Data, "Video").ToString)
'MsgBox("with CBool" + vbNewLine + CBool(InStr(e.Data, "Stream #")).ToString + vbNewLine + CBool(InStr(e.Data, "Video")).ToString)
ListOfStreams.Add(e.Data)
End If
If InStr(e.Data, "Stream #") And InStr(e.Data, " -> ") Then
'UsesStreams.Add(e.Data)
'MsgBox(e.Data)
Dim StreamSearch() As String = e.Data.Split(New String() {" -> "}, System.StringSplitOptions.RemoveEmptyEntries)
Dim StreamSearch2 As String = StreamSearch(0) + ":"
For i As Integer = 0 To ListOfStreams.Count - 1
If CBool(InStr(ListOfStreams(i), StreamSearch2)) Then 'And CBool(InStr(ListOfStreams(i), " Video:")) Then
'MsgBox(ListOfStreams(i))
Dim ResoSearch() As String = ListOfStreams(i).Split(New String() {"x"}, System.StringSplitOptions.RemoveEmptyEntries)
'MsgBox(ResoSearch(1))
If CBool(InStr(ResoSearch(2), " [")) = True Then
Dim ResoSearch2() As String = ResoSearch(2).Split(New String() {" ["}, System.StringSplitOptions.RemoveEmptyEntries)
Me.Invoke(New Action(Function()
Label_Reso.Text = ResoSearch2(0) + "p"
Return Nothing
End Function))
End If
End If
Next
End If
End If
#End Region
If InStr(e.Data, "Duration: N/A, bitrate: N/A") Then
ElseIf InStr(e.Data, "Duration: ") Then
Dim ZeitGesamt As String() = e.Data.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(":")})
'MsgBox(ZeitGesamt2(0))
ZeitGesamtInteger = CInt(ZeitGesamtSplit(0)) * 3600 + CInt(ZeitGesamtSplit(1)) * 60 + CInt(ZeitGesamtSplit(2))
ElseIf InStr(e.Data, " time=") Then
'MsgBox(e.Data)
Dim ZeitFertig As String() = e.Data.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 bitrate3 As String = 0
If InStr(e.Data, "bitrate=") Then
Dim bitrate As String() = e.Data.Split(New String() {"bitrate="}, System.StringSplitOptions.RemoveEmptyEntries)
Dim bitrate2 As String() = bitrate(1).Split(New String() {"kbits/s"}, System.StringSplitOptions.RemoveEmptyEntries)
If InStr(bitrate2(0), ".") Then
Dim bitrateTemo As String() = bitrate2(0).Split(New String() {"."}, System.StringSplitOptions.RemoveEmptyEntries)
bitrate3 = bitrateTemo(0)
ElseIf InStr(bitrate2(0), ",") Then
Dim bitrateTemo As String() = bitrate2(0).Split(New String() {","}, System.StringSplitOptions.RemoveEmptyEntries)
bitrate3 = bitrateTemo(0)
End If
End If
Dim bitrateInt As Double = CInt(bitrate3) / 1024
Dim FileSize As Double = ZeitGesamtInteger * bitrateInt / 8
Dim DownloadFinished As Double = ZeitFertigInteger * bitrateInt / 8
Dim percent As Integer = ZeitFertigInteger / ZeitGesamtInteger * 100
Me.Invoke(New Action(Function()
If percent > 100 Then
percent = 100
End If
ProgressBar1.Value = percent
Label_percent.Text = Math.Round(DownloadFinished, 2, MidpointRounding.AwayFromZero).ToString + "MB/" + Math.Round(FileSize, 2, MidpointRounding.AwayFromZero).ToString + "MB " + percent.ToString + "%"
Return Nothing
End Function))
ElseIf InStr(e.Data, "Failed to open segment") Then
FailedCount = FailedCount + 1
If Item_ErrorTolerance = 0 Then
ElseIf FailedCount >= Item_ErrorTolerance Then
Failed = True
StatusRunning = False
bt_pause.BackgroundImage = My.Resources.main_pause_play
SuspendProcess(proc)
Me.Invoke(New Action(Function()
Label_percent.Text = "Missing segment detected, retry or resume with the play button"
Return Nothing
End Function))
End If
ElseIf InStr(e.Data, "muxing overhead:") Then
Finished = True
Me.Invoke(New Action(Function()
Dim Done As String() = Label_percent.Text.Split(New String() {"MB"}, System.StringSplitOptions.RemoveEmptyEntries)
Label_percent.Text = "Finished - " + Done(0) + "MB"
Return Nothing
End Function))
If HybridMode = True Then
Thread.Sleep(5000)
Try
System.IO.Directory.Delete(HybridModePath, True)
Catch ex As Exception
End Try
End If
End If
Catch ex As Exception
Debug.WriteLine(ex.ToString)
End Try
End Sub
#Region "Manga DL"
Public Sub DownloadMangaPages(ByVal Pfad As String, ByVal BaseURL As String, ByVal SiteList As List(Of String), ByVal FolderName As String)
Dim Pfad_DL As String = Pfad + "\" + FolderName
If Debug2 = True Then
MsgBox(BaseURL + SiteList(0))
End If
Try
Directory.CreateDirectory(Pfad_DL)
'MsgBox(True.ToString)
Catch ex As Exception
End Try
For i As Integer = 0 To SiteList.Count - 1
'MsgBox(BaseURL + SiteList(i) + vbNewLine + Pfad_DL + "\" + SiteList(i))
Dim iWert As Integer = i
Using client As New WebClient()
client.Headers.Add(My.Resources.ffmpeg_user_agend.Replace(Chr(34), ""))
client.DownloadFile(BaseURL + SiteList(i), Pfad_DL + "\" + SiteList(i))
Pause(1)
End Using
Me.Invoke(New Action(Function()
iWert = iWert + 1
Dim Prozent As Integer = iWert / SiteList.Count * 100
Label_percent.Text = iWert.ToString + "/" + SiteList.Count.ToString + " " + Prozent.ToString + "%"
ProgressBar1.Value = Prozent
Return Nothing
End Function))
Next
End Sub
#End Region
Private Sub BT_del_Click(sender As Object, e As EventArgs) Handles bt_del.Click
If Canceld = True Then
If MessageBox.Show("The Download is not running anymore, press ok to remove it from the list.", "Remove from list!", MessageBoxButtons.OKCancel) = DialogResult.Cancel Then
Exit Sub
End If
ToDispose = True
ElseIf HybridRunning = True Then
If MessageBox.Show("Are you sure you want to cancel the Download?", "Cancel Download!", MessageBoxButtons.YesNo) = DialogResult.No Then
Exit Sub
End If
Canceld = True
'KillRunningTask()
Else
If proc.HasExited Then
If MessageBox.Show("The Download is not running anymore, press ok to remove it from the list.", "Remove from list!", MessageBoxButtons.OKCancel) = DialogResult.Cancel Then
Exit Sub
End If
ToDispose = True
Else
If MessageBox.Show("Are you sure you want to cancel the Download?", "Cancel Download!", MessageBoxButtons.YesNo) = DialogResult.No Then
Exit Sub
End If
Canceld = True
KillRunningTask()
End If
End If
End Sub
#End Region
Private Sub SuspendProcess(ByVal process As System.Diagnostics.Process)
For Each t As ProcessThread In process.Threads
Dim th As IntPtr
th = OpenThread(ThreadAccess.SUSPEND_RESUME, False, t.Id)
If th <> IntPtr.Zero Then
SuspendThread(th)
CloseHandle(th)
End If
Next
End Sub
Private Sub ResumeProcess(ByVal process As System.Diagnostics.Process)
For Each t As ProcessThread In process.Threads
Dim th As IntPtr
th = OpenThread(ThreadAccess.SUSPEND_RESUME, False, t.Id)
If th <> IntPtr.Zero Then
ResumeThread(th)
CloseHandle(th)
End If
Next
End Sub
Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick
Try
For tlc As Integer = 0 To ThreadList.Count - 1
If ThreadList.Item(tlc).IsAlive Then
Else
ThreadList.Remove(ThreadList.Item(tlc))
End If
Next
Catch ex As Exception
End Try
End Sub
Private Sub Label_Anime_Click(sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Label_Anime.Click, PB_Thumbnail.Click, Label_Reso.Click, Label_percent.Click, ProgressBar1.Click, Label_website.Click, Me.Click
If e.Button = MouseButtons.Right Then
' MsgBox("Right Button Clicked")
ContextMenuStrip1.ContextMenu.Show(Me, MousePosition)
End If
End Sub
Private Sub ViewInExplorerToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ViewInExplorerToolStripMenuItem.Click
Process.Start(Path.GetDirectoryName(DownloadPfad.Replace(Chr(34), "")))
End Sub
Private Sub PlaybackVideoFileToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles PlaybackVideoFileToolStripMenuItem.Click
If GetIsStatusFinished() = True Then
PlaybackVideoFileToolStripMenuItem.Enabled = True
Else
PlaybackVideoFileToolStripMenuItem.Enabled = False
End If
Process.Start(DownloadPfad.Replace(Chr(34), ""))
End Sub
Private Sub SaveToFile_Click(sender As Object, e As EventArgs) Handles SaveToFile.Click
Try
Dim logfile As String = DownloadPfad.Replace(".mp4", ".log").Replace(Chr(34), "")
'If File.Exists(logfile) Then
Using sw As StreamWriter = File.AppendText(logfile)
sw.Write(LogText.Item(0))
sw.Write(vbNewLine)
For i As Integer = 1 To LogText.Count - 1
sw.Write(vbNewLine)
sw.Write(LogText.Item(i))
Next
End Using
'Else
'File.WriteAllText(logfile, Date.Now + " " + e.Data)
'End If
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Private Sub LogTocClipboard_Click(sender As Object, e As EventArgs) Handles LogTocClipboard.Click
Try
Dim Text As String = LogText.Item(0) + vbNewLine
For i As Integer = 1 To LogText.Count - 1
Text = Text + vbNewLine + LogText.Item(i)
Next
My.Computer.Clipboard.SetText(Text)
Catch ex As Exception
End Try
End Sub
End Class
Public Class FailedSegemtsWithURL
Public path As String
Public url As String
Public Sub New(ByVal path As String, ByVal url As Integer)
Me.path = path
Me.url = url
End Sub
Public Overrides Function ToString() As String
Return String.Format("{0}, {1}", Me.path, Me.url)
End Function
End Class