2021-09-20 20:37:57 +02:00
Option Strict On
Imports System . Net
2020-08-16 23:27:48 +02:00
Imports System . Text
Imports System . IO
2020-09-30 18:19:31 +02:00
Imports System . Threading
2020-08-16 23:27:48 +02:00
Imports Microsoft . Win32
Imports System . ComponentModel
2020-12-10 19:18:20 +01:00
Imports MetroFramework
Imports MetroFramework . Components
Imports MetroFramework . Forms
2021-02-28 13:22:00 +01:00
2020-08-16 23:27:48 +02:00
Public Class CRD_List_Item
2020-12-10 19:18:20 +01:00
Inherits Controls . MetroUserControl
2020-08-16 23:27:48 +02:00
Dim ZeitGesamtInteger As Integer = 0
Dim ListOfStreams As New List ( Of String )
Dim proc As Process
2020-09-30 18:19:31 +02:00
Dim ThreadList As New List ( Of Thread )
2020-11-05 20:43:52 +01:00
Dim Item_ErrorTolerance As Integer
2020-08-16 23:27:48 +02:00
Dim Canceld As Boolean = False
2020-11-04 19:11:38 +01:00
Dim Finished As Boolean = False
2020-08-16 23:27:48 +02:00
Dim Label_website_Text As String = Nothing
Dim StatusRunning As Boolean = True
2021-06-04 15:25:59 +02:00
'Dim ffmpeg_command As String = Nothing
2020-08-16 23:27:48 +02:00
Dim Debug2 As Boolean = False
Dim MergeSubstoMP4 As Boolean = False
2021-03-08 21:08:26 +01:00
2022-03-19 12:01:12 +01:00
Dim TempFolder As String = Nothing
2020-08-16 23:27:48 +02:00
Dim DownloadPfad As String = Nothing
2022-07-08 20:54:20 +02:00
Dim ThumbnailSource As String = Nothing
2020-08-16 23:27:48 +02:00
Dim ToDispose As Boolean = False
2020-10-31 23:36:52 +01:00
Dim Failed As Boolean = False
Dim FailedCount As Integer = 0
2020-08-16 23:27:48 +02:00
Dim HistoryDL_URL As String
Dim HistoryDL_Pfad As String
Dim HistoryFilename As String
Dim Retry As Boolean = False
2020-09-30 18:19:31 +02:00
Dim HybridMode As Boolean = False
2020-10-07 22:40:58 +02:00
Dim HybridModePath As String = Nothing
2020-09-30 18:19:31 +02:00
Dim HybridRunning As Boolean = False
2020-10-02 16:02:44 +02:00
Dim TargetReso As Integer = 1080
2020-12-02 21:01:30 +01:00
Dim HybrideLog As String = Nothing
2020-12-10 19:18:20 +01:00
Dim Service As String = " CR "
2020-12-12 16:21:29 +01:00
Dim ServiceSleep As Integer = 0
2021-07-04 17:22:46 +02:00
Dim KeepCacheFiles As Boolean = False
Dim NameP2 As String = Nothing
2020-12-02 21:01:30 +01:00
2020-12-12 16:21:29 +01:00
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
2020-12-02 21:01:30 +01:00
2020-12-13 16:11:43 +01:00
Dim FailedSegments As New List ( Of FailedSegemtsWithURL )
2020-12-24 16:56:45 +01:00
Dim LogText As New List ( Of String )
2021-04-24 20:51:34 +02:00
Dim PauseTime As Integer = 0
2021-09-20 20:37:57 +02:00
Dim Threads As Integer = CInt ( Environment . ProcessorCount / 2 - 1 )
2021-04-24 20:51:34 +02:00
2020-08-16 23:27:48 +02:00
#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
2020-12-24 16:56:45 +01:00
#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
2021-12-19 13:38:19 +01:00
If Service = " FM " Then
2020-12-24 16:56:45 +01:00
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
2020-08-16 23:27:48 +02:00
Public Sub SetLabelWebsite ( ByVal Text As String )
2020-10-31 23:36:52 +01:00
Label_website . Text = Text
Label_website_Text = Text
2020-08-16 23:27:48 +02:00
End Sub
2020-12-10 19:18:20 +01:00
Public Sub SetTheme ( ByVal Theme As MetroThemeStyle )
MetroStyleManager1 . Theme = Theme
End Sub
2021-07-04 17:22:46 +02:00
Public Sub SetCache ( ByVal value As Boolean )
KeepCacheFiles = value
End Sub
2020-12-10 19:18:20 +01:00
2020-11-05 20:43:52 +01:00
Public Sub SetTolerance ( ByVal value As Integer )
Item_ErrorTolerance = value
End Sub
2020-08-16 23:27:48 +02:00
Public Sub SetLabelAnimeTitel ( ByVal Text As String )
Label_Anime . Text = Text
2021-07-04 17:22:46 +02:00
NameP2 = Text
2020-08-16 23:27:48 +02:00
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
2022-07-08 20:54:20 +02:00
Public Sub SetThumbnailImage ( ByVal ThumbnialURL As String )
ThumbnailSource = ThumbnialURL
Dim Thumbnail As Image = My . Resources . main_del
Debug . WriteLine ( " ThumbnialURL: " + ThumbnialURL )
Try
Dim wc As New WebClient ( )
Dim bytes As Byte ( ) = wc . DownloadData ( ThumbnialURL )
Dim ms As New MemoryStream ( bytes )
Thumbnail = System . Drawing . Image . FromStream ( ms )
Catch ex As Exception
'MsgBox(ex.ToString)
End Try
2020-08-16 23:27:48 +02:00
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
2020-11-21 14:56:27 +01:00
If Canceld = True Then
Return True
ElseIf HybridRunning = True Then
2020-08-16 23:27:48 +02:00
Return False
2020-09-30 18:19:31 +02:00
Else
If proc . HasExited = True Then
Return True
Else
Return False
End If
2020-08-16 23:27:48 +02:00
End If
2020-09-30 18:19:31 +02:00
2022-07-08 20:54:20 +02:00
End Function
Public Function GetThumbnailSource ( ) As String
Try
Return ThumbnailSource
Catch ex As Exception
Return " 0 "
End Try
2020-08-16 23:27:48 +02:00
End Function
2021-09-20 20:37:57 +02:00
Public Function GetLabelPercent ( ) As String
2020-08-16 23:27:48 +02:00
Try
Return Label_percent . Text
Catch ex As Exception
2021-09-20 20:37:57 +02:00
Return " 0 "
2020-08-16 23:27:48 +02:00
End Try
End Function
2021-09-20 20:37:57 +02:00
Public Function GetPercentValue ( ) As Integer
2020-08-16 23:27:48 +02:00
Try
Return ProgressBar1 . Value
Catch ex As Exception
Return 0
End Try
End Function
2021-09-20 20:37:57 +02:00
Public Function GetNameAnime ( ) As String
2020-08-16 23:27:48 +02:00
Try
Return Label_Anime . Text
Catch ex As Exception
Return " error "
End Try
End Function
#End Region
#Region "Set Variables"
2021-06-04 15:25:59 +02:00
2020-08-16 23:27:48 +02:00
Public Sub SetMergeSubstoMP4 ( ByVal Value As Boolean )
MergeSubstoMP4 = Value
End Sub
Public Sub SetDebug2 ( ByVal Value As Boolean )
Debug2 = Value
End Sub
2021-03-08 21:08:26 +01:00
2020-10-02 16:02:44 +02:00
Public Sub SetTargetReso ( ByVal Value As Integer )
TargetReso = Value
End Sub
2020-12-10 19:18:20 +01:00
Public Sub SetService ( ByVal Value As String )
Service = Value
End Sub
2020-08-16 23:27:48 +02:00
#End Region
Public Sub KillRunningTask ( )
2020-10-21 23:03:24 +02:00
If HybridRunning = True Then
Canceld = True
2020-08-16 23:27:48 +02:00
Else
2020-10-21 23:03:24 +02:00
Try
If proc . HasExited Then
Else
proc . Kill ( )
proc . WaitForExit ( 500 )
Label_percent . Text = " canceled -% "
End If
Catch ex As Exception
End Try
2020-08-16 23:27:48 +02:00
End If
End Sub
2020-12-02 21:01:30 +01:00
Private Sub BT_del_MouseEnter ( sender As Object , e As EventArgs ) Handles bt_del . MouseEnter
2021-09-20 20:37:57 +02:00
bt_del . BackgroundImage = My . Resources . main_del
2020-08-16 23:27:48 +02:00
End Sub
2020-12-02 21:01:30 +01:00
Private Sub BT_del_MouseLeave ( sender As Object , e As EventArgs ) Handles bt_del . MouseLeave
2021-09-20 20:37:57 +02:00
bt_del . BackgroundImage = My . Resources . main_del
2020-08-16 23:27:48 +02:00
End Sub
2020-12-02 21:01:30 +01:00
Private Sub BT_pause_MouseEnter ( sender As Object , e As EventArgs ) Handles bt_pause . MouseEnter
2021-09-20 20:37:57 +02:00
2020-08-16 23:27:48 +02:00
If StatusRunning = True Then
2021-09-20 20:37:57 +02:00
bt_pause . BackgroundImage = My . Resources . main_pause_hover
2020-08-16 23:27:48 +02:00
Else
2021-09-20 20:37:57 +02:00
bt_pause . BackgroundImage = My . Resources . main_pause_play_hover
2020-08-16 23:27:48 +02:00
End If
End Sub
2020-12-02 21:01:30 +01:00
Private Sub BT_pause_MouseLeave ( sender As Object , e As EventArgs ) Handles bt_pause . MouseLeave
2021-09-20 20:37:57 +02:00
2020-08-16 23:27:48 +02:00
If StatusRunning = True Then
2021-09-20 20:37:57 +02:00
bt_pause . BackgroundImage = My . Resources . main_pause
2020-08-16 23:27:48 +02:00
Else
2021-09-20 20:37:57 +02:00
bt_pause . BackgroundImage = My . Resources . main_pause_play
2020-08-16 23:27:48 +02:00
End If
End Sub
2020-12-02 21:01:30 +01:00
Private Sub BT_pause_Click ( sender As Object , e As EventArgs ) Handles bt_pause . Click
2020-11-21 14:56:27 +01:00
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
2022-03-19 12:01:12 +01:00
StartDownload ( HistoryDL_URL , HistoryDL_Pfad , HistoryFilename , HybridMode , TempFolder )
2020-11-21 14:56:27 +01:00
StatusRunning = True
Label_website . Text = Label_website_Text
Exit Sub
ElseIf HybridRunning = True Then
2020-10-07 22:40:58 +02:00
If StatusRunning = True Then
2020-08-16 23:27:48 +02:00
StatusRunning = False
2020-10-07 22:40:58 +02:00
bt_pause . BackgroundImage = My . Resources . main_pause_play
2020-08-16 23:27:48 +02:00
2020-12-13 16:11:43 +01:00
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
2020-12-21 12:18:18 +01:00
Dim ii As Integer = i
2022-01-22 11:56:37 +01:00
Dim Evaluator = New Thread ( Sub ( ) Me . TS_DownloadAsync ( FailedSegments . Item ( ii ) . Url , FailedSegments . Item ( ii ) . Path ) )
2020-12-13 16:11:43 +01:00
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
2020-10-07 22:40:58 +02:00
Else
StatusRunning = True
2021-02-07 13:47:30 +01:00
bt_pause . BackgroundImage = My . Resources . main_pause
End If
2020-11-21 14:56:27 +01:00
2021-02-07 13:47:30 +01:00
Else
If proc . HasExited = True Then
2020-10-07 22:40:58 +02:00
If ProgressBar1 . Value < 100 Then
2020-10-31 23:36:52 +01:00
If Retry = True Then
If Main . RunningDownloads < Main . MaxDL Then
2020-10-07 22:40:58 +02:00
2020-10-31 23:36:52 +01:00
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
2020-10-07 22:40:58 +02:00
End If
2020-10-31 23:36:52 +01:00
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
2022-03-19 12:01:12 +01:00
StartDownload ( HistoryDL_URL , HistoryDL_Pfad , HistoryFilename , HybridMode , TempFolder )
2020-10-31 23:36:52 +01:00
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
2020-08-16 23:27:48 +02:00
End If
2020-10-31 23:36:52 +01:00
Else
2020-08-16 23:27:48 +02:00
End If
2020-10-07 22:40:58 +02:00
Exit Sub
End If
If StatusRunning = True Then
StatusRunning = False
bt_pause . BackgroundImage = My . Resources . main_pause_play
SuspendProcess ( proc )
Else
2020-10-31 23:36:52 +01:00
If Failed = True Then
2020-12-13 16:11:43 +01:00
'If HybridMode = True Then
2020-10-31 23:36:52 +01:00
2020-12-13 16:11:43 +01:00
'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
2020-10-31 23:36:52 +01:00
2021-02-07 13:47:30 +01:00
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
2022-03-19 12:01:12 +01:00
StartDownload ( HistoryDL_URL , HistoryDL_Pfad , HistoryFilename , HybridMode , TempFolder )
2020-10-31 23:36:52 +01:00
StatusRunning = True
2021-02-07 13:47:30 +01:00
Label_website . Text = Label_website_Text
2020-10-31 23:36:52 +01:00
bt_pause . BackgroundImage = My . Resources . main_pause
End If
2021-02-07 13:47:30 +01:00
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
2020-12-13 16:11:43 +01:00
' End If
2020-10-31 23:36:52 +01:00
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
2020-08-16 23:27:48 +02:00
End If
End If
2020-10-07 22:40:58 +02:00
2020-08-16 23:27:48 +02:00
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
2020-10-02 16:02:44 +02:00
Me . ContextMenuStrip = ContextMenuStrip1 '.ContextMenu
2021-04-24 20:51:34 +02:00
If Threads < 2 Then
Threads = 2
End If
2020-12-10 19:18:20 +01:00
'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
2020-08-16 23:27:48 +02:00
End Sub
2021-09-20 20:37:57 +02:00
Public Function GetTextBound ( ) As Integer
2020-12-10 19:18:20 +01:00
'Return Label_website.Location.Y
Return bt_del . Size . Height
2020-08-16 23:27:48 +02:00
End Function
2020-11-13 15:57:34 +01:00
2020-08-16 23:27:48 +02:00
#Region "Download + Update UI"
2022-03-19 12:01:12 +01:00
Public Sub StartDownload ( ByVal DL_URL As String , ByVal DL_Pfad As String , ByVal Filename As String , ByVal DownloadHybridMode As Boolean , ByVal TempFolder As String )
2020-10-15 01:04:15 +02:00
'MsgBox(DL_URL)
2020-12-10 19:18:20 +01:00
Me . StyleManager = MetroStyleManager1
2022-03-19 12:01:12 +01:00
Me . TempFolder = TempFolder
2020-10-31 23:36:52 +01:00
DownloadPfad = DL_Pfad
HistoryDL_URL = DL_URL
HistoryDL_Pfad = DL_Pfad
HistoryFilename = Filename
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( DL_URL , " -i [Subtitles only] " ) ) Then
Me . Invoke ( New Action ( Function ( ) As Object
2021-03-20 13:02:49 +01:00
ProgressBar1 . Value = 100
Label_percent . Text = " selected subtiles have been dowloaded "
Canceld = True
PlaybackVideoFileToolStripMenuItem . Enabled = False
LogTocClipboard . Enabled = False
SaveToFile . Enabled = False
Return Nothing
End Function ) )
ElseIf DownloadHybridMode = True Then
2020-09-30 18:19:31 +02:00
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"
2020-12-02 21:01:30 +01:00
2020-12-13 16:11:43 +01:00
2020-09-30 18:19:31 +02:00
2021-09-20 20:37:57 +02:00
Private Function TS_StatusAsync ( ByVal prozent As Integer , ByVal di As IO . DirectoryInfo , ByVal pausetime As Integer ) As Object
2020-09-30 18:19:31 +02:00
Dim FinishedSize As Double = 0
Dim AproxFinalSize As Double = 0
Try
2021-04-24 20:51:34 +02:00
Dim aryFi As IO . FileInfo ( ) = di . GetFiles ( " *.* " )
2020-09-30 18:19:31 +02:00
Dim fi As IO . FileInfo
For Each fi In aryFi
2021-04-25 16:26:45 +02:00
FinishedSize = FinishedSize + fi . Length
2020-09-30 18:19:31 +02:00
Next
Catch ex As Exception
End Try
If prozent > 0 Then
2021-09-20 20:37:57 +02:00
AproxFinalSize = Math . Round ( FinishedSize / 1048576 * 100 / prozent , 2 , MidpointRounding . AwayFromZero ) ' Math.Round( / 1048576, 2, MidpointRounding.AwayFromZero).ToString()
2020-09-30 18:19:31 +02:00
End If
2020-12-12 16:21:29 +01:00
Dim duration As TimeSpan = Date . Now - LastDate
Dim TimeinMilliSeconds As Integer = duration . Seconds * 1000 + duration . Milliseconds
2020-12-02 21:01:30 +01:00
2020-12-12 16:21:29 +01:00
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 ( )
If prozent > 100 Then
prozent = 100
ElseIf prozent < 0 Then
prozent = 0
End If
Try
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-12-12 16:21:29 +01:00
2020-12-18 13:47:55 +01:00
ProgressBar1 . Value = prozent 'ThreadList.Count.ToString + " " +
2020-12-12 16:21:29 +01:00
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
2020-09-30 18:19:31 +02:00
Return Nothing
End Function
2021-04-25 16:26:45 +02:00
#Region "ThreadChecker"
Private Sub CheckThreadCount ( )
2022-07-08 20:54:20 +02:00
'Try
' Me.Invoke(New Action(Function() As Object
' Label_Reso.Text = ThreadList.Count.ToString
' Return Nothing
' End Function))
'Catch ex As Exception
'End Try
2021-04-25 16:26:45 +02:00
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 )
Else
Thread . Sleep ( ServiceSleep )
Exit For
End If
Next
End Sub
#End Region
2021-09-20 20:37:57 +02:00
Private Function GetFullUri ( ByVal MainUri As String , ByVal CurrentPath As String ) As String
2021-05-01 13:56:48 +02:00
2021-04-24 20:51:34 +02:00
Dim path As String = Nothing
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( CurrentPath , " https:// " ) ) Then
2021-04-25 16:26:45 +02:00
path = CurrentPath
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( CurrentPath , " ../ " ) ) Then
2021-04-24 20:51:34 +02:00
Dim countDot ( ) As String = CurrentPath . Split ( New String ( ) { " ./ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim c ( ) As String = New Uri ( MainUri ) . Segments
path = " https:// " + New Uri ( MainUri ) . Host
For i3 As Integer = 0 To c . Count - ( 2 + countDot . Count - 1 )
path = path + c ( i3 )
Next
path = path + countDot ( countDot . Count - 1 )
Else
Dim c ( ) As String = New Uri ( MainUri ) . Segments
path = " https:// " + New Uri ( MainUri ) . Host
For i3 As Integer = 0 To c . Count - 2
path = path + c ( i3 )
Next
2021-05-01 13:56:48 +02:00
path = path + CurrentPath
2021-04-24 20:51:34 +02:00
End If
Return path
End Function
2021-04-25 16:26:45 +02:00
#Region "v4"
2021-04-24 20:51:34 +02:00
2021-04-25 16:26:45 +02:00
Private Function ProcessV4 ( ByVal url As String , ByVal InputData As String , ByVal Folder As String ) As String
2021-04-24 20:51:34 +02:00
If Not Directory . Exists ( Path . GetDirectoryName ( Folder ) ) Then
2020-10-21 23:03:24 +02:00
' Nein! Jetzt erstellen...
Try
2021-04-24 20:51:34 +02:00
Directory . CreateDirectory ( Path . GetDirectoryName ( Folder ) )
2020-10-21 23:03:24 +02:00
Catch ex As Exception
2021-04-24 20:51:34 +02:00
Debug . WriteLine ( " folder issue " )
Return " Error "
2020-10-21 23:03:24 +02:00
Exit Function
End Try
End If
2020-10-31 23:36:52 +01:00
2021-09-20 20:37:57 +02:00
Dim KeyFile As String = GeräteID ( ) + " .key "
Dim KeyFilePath As String = Folder + " \ " + KeyFile 'needs to be in the ffmpeg/downloader directory
2022-04-22 15:01:36 +02:00
KeyFilePath = KeyFilePath . Replace ( " \\ " , " \ " )
2021-04-24 20:51:34 +02:00
Dim Fragments ( ) As String = InputData . Split ( New String ( ) { " #EXT-X-BYTERANGE: " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FragmentsInt As Integer = Fragments . Count - 2
Dim di As New IO . DirectoryInfo ( Folder )
Dim m3u8FileContent As String = Nothing
Dim m3u8Text As String = InputData
Dim m3u8Key ( ) As String = m3u8Text . Split ( New String ( ) { " URI= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim m3u8Key2 ( ) As String = m3u8Key ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
2021-04-25 16:26:45 +02:00
Dim KeyFileDL = New Thread ( Sub ( ) Me . TS_DownloadAsync ( GetFullUri ( url , m3u8Key2 ( 0 ) ) , KeyFilePath ) )
KeyFileDL . Start ( )
Dim DownloadFile As String = Nothing
Dim FileUrl ( ) As String = InputData . Split ( New String ( ) { vbLf } , System . StringSplitOptions . RemoveEmptyEntries )
For line As Integer = 0 To FileUrl . Count - 1
If CBool ( InStr ( FileUrl ( line ) , " #EXT-X-BYTERANGE: " ) ) = True Then
DownloadFile = GetFullUri ( url , FileUrl ( line + 1 ) )
Exit For
End If
Next
'Dim StreamFile() As String = m3u8Text.Split(New String() {"https://"}, System.StringSplitOptions.RemoveEmptyEntries)
'Dim StreamFile2() As String = StreamFile(2).Split(New String() {vbLf}, System.StringSplitOptions.RemoveEmptyEntries)
'Dim DownloadFile As String = "https:\\" + StreamFile2(0)
2021-04-24 20:51:34 +02:00
Dim text ( ) As String = m3u8Text . Split ( New String ( ) { vbLf } , System . StringSplitOptions . RemoveEmptyEntries )
Dim zeile As String
Dim Count As Integer = 0
For i As Integer = 0 To text . Count - 1
zeile = text ( i )
2021-04-25 16:26:45 +02:00
CheckThreadCount ( )
2021-04-24 20:51:34 +02:00
2021-04-25 16:26:45 +02:00
If Canceld = True Then
For www As Integer = 0 To Integer . MaxValue
If ThreadList . Count > 0 Then
Thread . Sleep ( 250 )
Else
Try
2021-07-04 17:22:46 +02:00
If KeepCacheFiles = False Then
System . IO . Directory . Delete ( HybridModePath , True )
End If
2021-04-25 16:26:45 +02:00
Catch ex As Exception
End Try
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-04-25 16:26:45 +02:00
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 " Canceld "
Exit Function
End If
2021-04-24 20:51:34 +02:00
If zeile . Contains ( " #EXT-X-BYTERANGE: " ) Then
Dim Zeile2 As String = zeile . Replace ( " #EXT-X-BYTERANGE: " , " " )
Dim Zeile3 ( ) As String = Zeile2 . Split ( New String ( ) { " @ " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-02-07 13:47:30 +01:00
2021-04-24 20:51:34 +02:00
Dim CurrentSize As Integer = Integer . Parse ( Zeile3 ( 1 ) )
Dim NewBytes As Integer = Integer . Parse ( Zeile3 ( 0 ) )
Dim File As String = Folder + String . Format ( " {0:0000} " , Count )
Dim Evaluator = New Thread ( Sub ( ) Me . DownloadTSv4 ( DownloadFile , File , CurrentSize , NewBytes ) )
Evaluator . Start ( )
ThreadList . Add ( Evaluator )
m3u8FileContent = m3u8FileContent + File + vbNewLine
2021-02-20 18:25:49 +01:00
2021-04-24 20:51:34 +02:00
Count = Count + 1
Dim FragmentsFinised = Count * 100 / FragmentsInt
2021-02-07 13:47:30 +01:00
2021-09-20 20:37:57 +02:00
Dim Update = New Thread ( Sub ( ) Me . TS_StatusAsync ( CInt ( FragmentsFinised ) , di , PauseTime ) )
2021-04-24 20:51:34 +02:00
Update . Start ( )
2020-10-02 16:02:44 +02:00
2021-04-24 20:51:34 +02:00
ElseIf zeile . Contains ( " URI= " + Chr ( 34 ) ) Then
Dim Zeile2 ( ) As String = zeile . Split ( New String ( ) { " URI= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
m3u8FileContent = m3u8FileContent + Zeile2 ( 0 ) + " URI= " + Chr ( 34 ) + KeyFile + Chr ( 34 ) + vbNewLine ' a full path does not work here, that's why KeyFilePath is in the ffmpeg/downloader folder
ElseIf zeile . Contains ( " https:// " ) Then
'If zeile = DownloadFile Then
'Else
' DownloadFile = zeile
'End If
2020-12-10 19:18:20 +01:00
Else
2021-04-24 20:51:34 +02:00
m3u8FileContent = m3u8FileContent + zeile + vbNewLine
2020-12-10 19:18:20 +01:00
End If
2020-10-02 16:02:44 +02:00
2021-04-24 20:51:34 +02:00
Next
2020-10-02 16:02:44 +02:00
2021-04-24 20:51:34 +02:00
Dim utf8WithoutBom As New System . Text . UTF8Encoding ( False )
Using sink As New StreamWriter ( Folder + " \index.m3u8 " , False , utf8WithoutBom )
sink . WriteLine ( m3u8FileContent )
End Using
2020-10-21 23:03:24 +02:00
2021-04-24 20:51:34 +02:00
Return Folder + " \index.m3u8 "
2020-09-30 18:19:31 +02:00
2021-04-24 20:51:34 +02:00
End Function
2020-12-12 16:21:29 +01:00
2021-04-24 20:51:34 +02:00
Private Sub DownloadTSv4 ( ByVal DL_URL As String , ByVal DL_Pfad As String , ByVal CurrentSize As Integer , ByVal NewBytes As Integer )
Dim retryCount As Integer = 3
2021-09-20 20:37:57 +02:00
HybrideLog = HybrideLog + vbNewLine + Date . Now . ToString + " : " + DL_Pfad + " - " + DL_URL + " - " + CurrentSize . ToString
2021-11-02 21:49:34 +01:00
While CBool ( retryCount > 0 )
2021-04-24 20:51:34 +02:00
Try
2020-12-12 16:21:29 +01:00
2020-10-07 22:40:58 +02:00
2021-09-20 20:37:57 +02:00
Dim Request As HttpWebRequest = CType ( WebRequest . Create ( DL_URL ) , HttpWebRequest )
2021-04-25 16:26:45 +02:00
Dim Bytes ( NewBytes ) As Byte
Request . UserAgent = My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) . Replace ( " User-Agent: " , " " )
Request . Timeout = 30000
Request . Method = " GET "
Request . AddRange ( CurrentSize , CurrentSize + NewBytes )
2020-10-07 22:40:58 +02:00
2020-12-02 21:01:30 +01:00
2021-09-20 20:37:57 +02:00
Dim Response As Net . HttpWebResponse = CType ( Request . GetResponse ( ) , HttpWebResponse )
If CBool ( CType ( Response . StatusCode = Net . HttpStatusCode . PartialContent , HttpStatusCode ) Or HttpStatusCode . OK ) Then
2020-10-10 23:23:10 +02:00
2021-04-25 16:26:45 +02:00
Using binaryReader As New BinaryReader ( Response . GetResponseStream ( ) )
Bytes = binaryReader . ReadBytes ( NewBytes )
binaryReader . Close ( )
End Using
2020-11-13 15:57:34 +01:00
2021-04-25 16:26:45 +02:00
End If
2020-11-13 15:57:34 +01:00
2021-04-25 16:26:45 +02:00
File . WriteAllBytes ( DL_Pfad , Bytes )
2020-10-07 22:40:58 +02:00
2020-10-10 23:23:10 +02:00
2020-11-13 15:57:34 +01:00
2021-11-02 21:49:34 +01:00
retryCount = 0
2021-04-25 16:26:45 +02:00
Catch ex As Exception
If retryCount > 0 Then
retryCount = retryCount - 1
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-11-02 21:49:34 +01:00
'Label_percent.Text = "Access Error - retrying"
2021-04-25 16:26:45 +02:00
Debug . WriteLine ( ex . ToString )
2021-11-02 21:49:34 +01:00
Debug . WriteLine ( " retrying... " )
2021-04-25 16:26:45 +02:00
Return Nothing
End Function ) )
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-11-02 21:49:34 +01:00
'Label_percent.Text = "Access Error - download canceled"
2021-04-25 16:26:45 +02:00
Debug . WriteLine ( ex . ToString )
2021-11-02 21:49:34 +01:00
Debug . WriteLine ( " retrying failed... " )
2021-04-25 16:26:45 +02:00
Return Nothing
End Function ) )
End If
End Try
End While
End Sub
#End Region
#Region "v3/v5"
Public WithEvents WC_TS As WebClient
2021-07-04 17:22:46 +02:00
Private Function ProcessV3 ( ByVal url As String , ByVal InputData As String , ByVal Folder As String , ByVal DateiPfad As String , ByVal DL_URL As String ) As String
2022-01-22 11:56:37 +01:00
2021-07-04 17:22:46 +02:00
Debug . WriteLine ( Folder )
2021-04-25 16:26:45 +02:00
If Not Directory . Exists ( Path . GetDirectoryName ( Folder ) ) Then
' Nein! Jetzt erstellen...
Try
Directory . CreateDirectory ( Path . GetDirectoryName ( Folder ) )
Catch ex As Exception
Debug . WriteLine ( " folder issue " )
Return " Error "
Exit Function
End Try
End If
2021-04-24 20:51:34 +02:00
2021-07-04 17:22:46 +02:00
If Not Directory . Exists ( Path . GetDirectoryName ( Folder ) + " \Retry " ) Then
' Nein! Jetzt erstellen...
Try
Directory . CreateDirectory ( Path . GetDirectoryName ( Folder ) + " \Retry " )
Catch ex As Exception
Debug . WriteLine ( " folder issue " )
Return " Error "
Exit Function
End Try
End If
Dim utf8WithoutBom2 As New System . Text . UTF8Encoding ( False )
Using sink As New StreamWriter ( Folder + " Retry\retry.m3u8 " , False , utf8WithoutBom2 )
sink . WriteLine ( InputData )
End Using
2022-01-22 11:56:37 +01:00
Dim Label_websiteText As String = Nothing
Dim Label_AnimeText As String = Nothing
Dim Label_ResoText As String = Nothing
Dim Label_HardsubText As String = Nothing
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2022-01-22 11:56:37 +01:00
Label_websiteText = Label_website . Text
Label_AnimeText = Label_Anime . Text
Label_ResoText = Label_Reso . Text
Label_HardsubText = Label_Hardsub . Text
Try
PB_Thumbnail . BackgroundImage . Save ( Folder + " Retry\retry.jpg " )
Catch ex As Exception
End Try
2021-07-04 17:22:46 +02:00
Return Nothing
End Function ) )
2022-01-22 11:56:37 +01:00
Using sink As New StreamWriter ( Folder + " Retry\retry.txt " , False , utf8WithoutBom2 )
sink . WriteLine ( DL_URL )
sink . WriteLine ( Label_websiteText )
sink . WriteLine ( Label_AnimeText )
sink . WriteLine ( Label_ResoText )
sink . WriteLine ( Label_HardsubText )
sink . WriteLine ( DateiPfad )
End Using
2021-04-25 16:26:45 +02:00
Dim LoadedKeys As New List ( Of String )
LoadedKeys . Add ( " Nothing " )
Dim KeyFileCache As String = Nothing
Dim textLenght ( ) As String = InputData . Split ( New String ( ) { vbLf } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Fragments ( ) As String = InputData . Split ( New String ( ) { " .ts " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FragmentsInt As Integer = Fragments . Count - 2
Dim Count As Integer = 0
Dim m3u8FileContent As String = Nothing
Dim di As New IO . DirectoryInfo ( Folder )
For i As Integer = 0 To textLenght . Length - 1
CheckThreadCount ( )
If Canceld = True Then
For www As Integer = 0 To Integer . MaxValue
If ThreadList . Count > 0 Then
Thread . Sleep ( 250 )
2020-10-10 23:23:10 +02:00
Else
2021-04-25 16:26:45 +02:00
Try
2021-07-04 17:22:46 +02:00
If KeepCacheFiles = False Then
System . IO . Directory . Delete ( HybridModePath , True )
End If
2021-04-25 16:26:45 +02:00
Catch ex As Exception
End Try
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-04-25 16:26:45 +02:00
ProgressBar1 . Value = 0
Label_percent . Text = " canceled -% "
bt_pause . BackgroundImage = My . Resources . main_pause_play
2021-04-24 20:51:34 +02:00
Return Nothing
End Function ) )
2021-04-25 16:26:45 +02:00
Exit For
End If
Next
Return " Canceld "
Exit Function
End If
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( textLenght ( i ) , " .ts " ) ) Then
2021-04-25 16:26:45 +02:00
Dim File As String = Folder + String . Format ( " {0:00000} " , Count )
Dim curi As String = GetFullUri ( url , textLenght ( i ) )
2021-04-24 20:51:34 +02:00
2021-07-04 17:22:46 +02:00
If Not System . IO . File . Exists ( Folder + " Retry\ " + String . Format ( " {0:00000} " , Count ) ) Then
Dim Evaluator = New Thread ( Sub ( ) Me . TS_DownloadAsync ( curi , File ) )
Evaluator . Start ( )
ThreadList . Add ( Evaluator )
End If
2021-04-25 16:26:45 +02:00
2021-07-04 17:22:46 +02:00
m3u8FileContent = m3u8FileContent + File + vbLf
2021-04-25 16:26:45 +02:00
Dim FragmentsFinised = Count * 100 / FragmentsInt
2021-09-20 20:37:57 +02:00
Dim Update = New Thread ( Sub ( ) Me . TS_StatusAsync ( CInt ( FragmentsFinised ) , di , PauseTime ) )
2021-04-25 16:26:45 +02:00
Update . Start ( )
Count = Count + 1
2021-04-24 20:51:34 +02:00
2021-04-25 16:26:45 +02:00
ElseIf textLenght ( i ) = " #EXT-X-PLAYLIST-TYPE:VOD " Then
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( textLenght ( i ) , " URI= " + Chr ( 34 ) ) ) Then
2021-04-25 16:26:45 +02:00
Dim KeyLine As String = textLenght ( i )
Dim KeyFileUri ( ) As String = KeyLine . Split ( New String ( ) { " URI= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim KeyFileUri2 ( ) As String = KeyFileUri ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim KeyFileUri3 As String = GetFullUri ( url , KeyFileUri2 ( 0 ) )
If LoadedKeys . Item ( LoadedKeys . Count - 1 ) = KeyFileUri3 Then
KeyLine = KeyFileUri ( 0 ) + " URI= " + Chr ( 34 ) + KeyFileCache + Chr ( 34 )
Else
2021-09-20 20:37:57 +02:00
Dim KeyFile As String = GeräteID ( ) + " .key "
2021-04-25 16:26:45 +02:00
KeyFileCache = KeyFile
2022-04-22 15:01:36 +02:00
Dim KeyFilePath As String = Folder + " \ " + KeyFile
KeyFilePath = KeyFilePath . Replace ( " \\ " , " \ " )
Dim Evaluator = New Thread ( Sub ( ) Me . TS_DownloadAsync ( KeyFileUri3 , KeyFilePath ) )
2021-04-25 16:26:45 +02:00
Evaluator . Start ( )
LoadedKeys . Add ( KeyFileUri3 )
If KeyFileUri2 . Count > 1 Then
KeyLine = KeyFileUri ( 0 ) + " URI= " + Chr ( 34 ) + KeyFileCache + Chr ( 34 ) + KeyFileUri2 ( 1 )
Else
KeyLine = KeyFileUri ( 0 ) + " URI= " + Chr ( 34 ) + KeyFileCache + Chr ( 34 )
2020-10-10 23:23:10 +02:00
End If
2021-07-04 17:22:46 +02:00
If KeepCacheFiles = True Then
'Dim Bytes() As Byte = File.ReadAllBytes(Application.StartupPath + "\" + KeyFile)
'File.WriteAllBytes(Folder + "\" + KeyFile, Bytes)
Dim Evaluator2 = New Thread ( Sub ( ) Me . TS_DownloadAsync ( KeyFileUri3 , Folder + " \ " + KeyFile ) )
Evaluator2 . Start ( )
End If
2021-04-25 16:26:45 +02:00
End If
m3u8FileContent = m3u8FileContent + KeyLine + vbLf
2021-07-04 17:22:46 +02:00
2021-04-25 16:26:45 +02:00
Else
m3u8FileContent = m3u8FileContent + textLenght ( i ) + vbLf
End If
Next
Dim utf8WithoutBom As New System . Text . UTF8Encoding ( False )
Using sink As New StreamWriter ( Folder + " \index.m3u8 " , False , utf8WithoutBom )
sink . WriteLine ( m3u8FileContent )
End Using
2021-07-04 17:22:46 +02:00
'If File.Exists(Folder + "retry.m3u8") Then
' My.Computer.FileSystem.DeleteFile(Folder + "retry.m3u8")
'End If
If KeepCacheFiles = True Then
Using sink As New StreamWriter ( Folder + " \index-VLC.m3u8 " , False , utf8WithoutBom )
m3u8FileContent = m3u8FileContent . Replace ( Folder , " file:/// " + Folder . Replace ( " \ " , " / " ) )
m3u8FileContent = m3u8FileContent . Replace ( " URI= " + Chr ( 34 ) , " URI= " + Chr ( 34 ) + " file:/// " + Folder . Replace ( " \ " , " / " ) )
sink . WriteLine ( m3u8FileContent )
End Using
End If
2021-04-25 16:26:45 +02:00
Return Folder + " \index.m3u8 "
2022-01-22 11:56:37 +01:00
2021-04-25 16:26:45 +02:00
End Function
Private Sub TS_DownloadAsync ( ByVal DL_URL As String , ByVal DL_Pfad As String )
2021-09-20 20:37:57 +02:00
HybrideLog = HybrideLog + vbNewLine + Date . Now . ToString + " : " + DL_Pfad + " - " + DL_URL
2021-04-25 16:26:45 +02:00
Try
'Dim wc_ts As New WebClient
WC_TS = New WebClient
WC_TS . DownloadFile ( New Uri ( DL_URL ) , DL_Pfad )
2021-10-31 00:44:08 +02:00
If Not CBool ( InStr ( DL_Pfad , " Stream- " ) ) Then
2021-07-04 17:22:46 +02:00
Dim utf8WithoutBom2 As New System . Text . UTF8Encoding ( False )
Using sink As New StreamWriter ( Path . GetDirectoryName ( DL_Pfad ) + " \Retry\ " + Path . GetFileName ( DL_Pfad ) , False , utf8WithoutBom2 )
sink . WriteLine ( DL_Pfad )
End Using
End If
2021-04-25 16:26:45 +02:00
Catch ex As Exception
2021-05-01 13:56:48 +02:00
2021-04-25 16:26:45 +02:00
Debug . WriteLine ( " Download error #1: " + DL_Pfad )
Try
Dim wc_ts As New WebClient
wc_ts . DownloadFile ( New Uri ( DL_URL ) , DL_Pfad )
2021-07-04 17:22:46 +02:00
If Not CBool ( InStr ( DL_Pfad , Application . StartupPath ) ) Then
Dim utf8WithoutBom2 As New System . Text . UTF8Encoding ( False )
Using sink As New StreamWriter ( Path . GetDirectoryName ( DL_Pfad ) + " \Retry\ " + Path . GetFileName ( DL_Pfad ) , False , utf8WithoutBom2 )
sink . WriteLine ( DL_Pfad )
End Using
End If
2021-04-25 16:26:45 +02:00
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
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-04-25 16:26:45 +02:00
Label_percent . Text = " Missing segment detected, retry or resume with the play button "
Return Nothing
End Function ) )
End If
2021-04-24 20:51:34 +02:00
2021-04-25 16:26:45 +02:00
2021-07-04 17:22:46 +02:00
Debug . WriteLine ( " Download error #2: " + DL_URL + vbNewLine + DL_Pfad + vbNewLine + ex2 . ToString + vbNewLine + DL_URL )
2021-04-25 16:26:45 +02:00
End Try
End Try
2021-04-24 20:51:34 +02:00
2021-07-04 17:22:46 +02:00
2021-04-24 20:51:34 +02:00
End Sub
2021-04-25 16:26:45 +02:00
#End Region
2021-04-24 20:51:34 +02:00
Public Function DownloadHybrid ( ByVal DL_URL As String , ByVal DL_Pfad As String , ByVal Filename As String ) As String
2021-09-20 20:37:57 +02:00
LogText . Add ( Date . Now . ToString + " " + DL_URL )
Dim Folder As String = GeräteID ( )
2021-04-25 16:26:45 +02:00
Dim DL_URL_old As String = DL_URL
2021-04-24 20:51:34 +02:00
Dim PauseTime As Integer = 0
2022-03-19 12:01:12 +01:00
Dim Pfad2 As String = TempFolder + " \ " + Folder + " \ " 'Path.GetDirectoryName(DL_Pfad.Replace(Chr(34), "")) + "\" + Folder + "\"
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( DL_Pfad , " CRD-Temp-File- " ) ) Then
2021-07-04 17:22:46 +02:00
Pfad2 = DL_Pfad . Replace ( Chr ( 34 ) , " " ) + " \ "
Dim DL_PfadSplit ( ) As String = DL_Pfad . Split ( New String ( ) { " CRD-Temp-File- " } , System . StringSplitOptions . RemoveEmptyEntries )
DL_Pfad = Chr ( 34 ) + DL_PfadSplit ( 0 ) + Filename + Chr ( 34 )
End If
2021-04-24 20:51:34 +02:00
Dim di As New IO . DirectoryInfo ( Pfad2 )
Dim m3u8_url As String ( ) = DL_URL . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
Dim m3u8FFmpeg As String = Nothing
2021-04-25 16:26:45 +02:00
HybridModePath = Pfad2
2021-04-24 20:51:34 +02:00
Dim InuputStreams As String ( ) = DL_URL . Split ( New String ( ) { " -i " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-04-24 20:51:34 +02:00
Label_percent . Text = " Checking input... "
Return Nothing
2021-06-20 19:02:55 +02:00
End Function ) )
2021-04-24 20:51:34 +02:00
For i As Integer = 0 To InuputStreams . Count - 1
Dim int As Integer = i
2021-06-20 19:02:55 +02:00
Dim InputURL As String ( ) = InuputStreams ( int ) . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
2021-04-24 20:51:34 +02:00
Dim InputClient As New WebClient
InputClient . Encoding = Encoding . UTF8
2021-10-14 19:05:48 +02:00
2021-04-24 20:51:34 +02:00
If Main . WebbrowserCookie = Nothing Then
2020-10-07 22:40:58 +02:00
Else
2021-04-24 20:51:34 +02:00
InputClient . Headers . Add ( HttpRequestHeader . Cookie , Main . WebbrowserCookie )
2021-10-14 19:05:48 +02:00
2020-09-30 18:19:31 +02:00
End If
2021-09-20 20:37:57 +02:00
Dim SubsFile As String = Pfad2 + GeräteID ( ) + " .txt "
2021-04-24 20:51:34 +02:00
2021-06-20 19:02:55 +02:00
If File . Exists ( SubsFile ) Then
2021-09-20 20:37:57 +02:00
SubsFile = Pfad2 + GeräteID2 ( ) + " .txt "
2021-06-20 19:02:55 +02:00
End If
2021-04-24 20:51:34 +02:00
Try
2021-10-14 19:05:48 +02:00
Dim InputData As String = Nothing
Try
InputData = InputClient . DownloadString ( InputURL ( 0 ) )
Catch ex As Exception
InputClient . Headers . Add ( HttpRequestHeader . AcceptEncoding , " * " )
InputData = DecompressString ( InputClient . DownloadData ( InputURL ( 0 ) ) )
End Try
If InputData = Nothing Then
Throw New System . Exception ( " No Input Data... " )
End If
2021-04-25 16:26:45 +02:00
If CBool ( InStr ( InputData , " RESOLUTION= " ) ) = True And CBool ( InStr ( InputData , " #EXT-X-BYTERANGE: " ) ) = False Then 'master m3u8 no fragments
Dim index_m3u8 ( ) As String = InputData . Split ( New String ( ) { vbLf } , System . StringSplitOptions . RemoveEmptyEntries )
If TargetReso = 42 Then
TargetReso = 1080
End If
For line As Integer = 0 To index_m3u8 . Count - 1
If CBool ( InStr ( index_m3u8 ( line ) , " x " + TargetReso . ToString ) ) = True Then
InputData = InputClient . DownloadString ( GetFullUri ( InputURL ( 0 ) , index_m3u8 ( line + 1 ) ) )
InputURL ( 0 ) = index_m3u8 ( line + 1 )
Exit For
End If
Next
End If
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( InputData , " #EXT-X-VERSION:3 " ) ) Or CBool ( InStr ( InputData , " #EXT-X-VERSION:5 " ) ) Then
2021-04-25 16:26:45 +02:00
2021-07-04 17:22:46 +02:00
If KeepCacheFiles = True Then
Pfad2 = Path . GetDirectoryName ( DL_Pfad . Replace ( Chr ( 34 ) , " " ) ) + " \ " + NameP2 . Replace ( " " , " - " ) + " \ "
End If
ProcessV3 ( InputURL ( 0 ) , InputData , Pfad2 , DL_Pfad , DL_URL )
2021-04-25 16:26:45 +02:00
DL_URL = DL_URL . Replace ( " -i " + Chr ( 34 ) + InputURL ( 0 ) , " -allowed_extensions ALL " + " -i " + Chr ( 34 ) + Pfad2 + " index.m3u8 " )
2021-04-24 20:51:34 +02:00
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( InputData , " #EXT-X-VERSION:4 " ) ) Then
2021-04-25 16:26:45 +02:00
ProcessV4 ( InputURL ( 0 ) , InputData , Pfad2 + " Stream- " + int . ToString + " \ " )
2021-04-24 20:51:34 +02:00
DL_URL = DL_URL . Replace ( " -i " + Chr ( 34 ) + InputURL ( 0 ) , " -allowed_extensions ALL " + " -i " + Chr ( 34 ) + Pfad2 + " Stream- " + int . ToString + " \index.m3u8 " )
Else
'write string to file
2021-06-20 19:02:55 +02:00
If Not Directory . Exists ( Path . GetDirectoryName ( Pfad2 ) ) Then
' Nein! Jetzt erstellen...
Try
Directory . CreateDirectory ( Path . GetDirectoryName ( Pfad2 ) )
Catch ex As Exception
Debug . WriteLine ( " folder issue " )
Return " Error "
Exit Function
End Try
End If
2021-04-24 20:51:34 +02:00
Dim utf8WithoutBom2 As New System . Text . UTF8Encoding ( False )
Using sink As New StreamWriter ( SubsFile , False , utf8WithoutBom2 )
sink . WriteLine ( InputData )
End Using
'replace url with local file
DL_URL = DL_URL . Replace ( InputURL ( 0 ) , SubsFile )
End If
Catch ex As Exception
2021-04-25 16:26:45 +02:00
Debug . WriteLine ( ex . ToString )
DL_URL = DL_URL_old
2021-04-24 20:51:34 +02:00
End Try
2021-04-25 16:26:45 +02:00
If Canceld = True Then
Return Nothing
Exit Function
End If
2021-04-24 20:51:34 +02:00
2020-09-30 18:19:31 +02:00
Next
2021-04-24 20:51:34 +02:00
2020-09-30 18:19:31 +02:00
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
2021-04-24 20:51:34 +02:00
TS_StatusAsync ( 100 , di , PauseTime )
2020-12-10 19:18:20 +01:00
2020-12-02 21:01:30 +01:00
2021-04-25 16:26:45 +02:00
If CBool ( InStr ( DL_URL , " -headers " + My . Resources . ffmpeg_user_agend ) ) = True And CBool ( InStr ( DL_URL , " https:\\ " ) ) = False Then
2021-04-24 20:51:34 +02:00
DL_URL = DL_URL . Replace ( " -headers " + My . Resources . ffmpeg_user_agend , " " )
End If
2020-09-30 18:19:31 +02:00
'MsgBox(DL_URL)
2020-08-16 23:27:48 +02:00
Dim exepath As String = Application . StartupPath + " \ffmpeg.exe "
Dim startinfo As New System . Diagnostics . ProcessStartInfo
2020-08-27 13:25:28 +02:00
2021-04-24 20:51:34 +02:00
Dim cmd As String = DL_URL + " " + DL_Pfad
2021-09-20 20:37:57 +02:00
LogText . Add ( Date . Now . ToString + " " + cmd )
2020-08-16 23:27:48 +02:00
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
2020-10-31 23:36:52 +01:00
proc . EnableRaisingEvents = True
2020-12-10 19:18:20 +01:00
AddHandler proc . ErrorDataReceived , AddressOf FFMPEGOutput
AddHandler proc . OutputDataReceived , AddressOf FFMPEGOutput
2020-10-31 23:36:52 +01:00
AddHandler proc . Exited , AddressOf ProcessClosed
2020-08-16 23:27:48 +02:00
proc . StartInfo = startinfo
2020-09-30 18:19:31 +02:00
proc . Start ( ) ' start the process
proc . BeginOutputReadLine ( )
proc . BeginErrorReadLine ( )
HybridRunning = False
Return Nothing
End Function
2021-04-24 20:51:34 +02:00
2020-09-30 18:19:31 +02:00
#End Region
Public Function DownloadFFMPEG ( ByVal DLCommand As String , ByVal DL_Pfad As String , ByVal Filename As String ) As String
2020-10-31 23:36:52 +01:00
2020-09-30 18:19:31 +02:00
Dim exepath As String = Application . StartupPath + " \ffmpeg.exe "
Dim startinfo As New System . Diagnostics . ProcessStartInfo
2022-01-22 11:56:37 +01:00
Dim cmd As String = " -user_agent " + My . Resources . ffmpeg_user_agend . Replace ( " User-Agent: " , " " ) + " -headers " + Chr ( 34 ) + " ACCEPT-ENCODING: * " + Chr ( 34 ) + " " + DLCommand + " " + DL_Pfad 'start ffmpeg with command strFFCMD string
2021-09-20 20:37:57 +02:00
LogText . Add ( Date . Now . ToString + " " + cmd )
2020-09-30 18:19:31 +02:00
If Debug2 = True Then
MsgBox ( cmd )
End If
'all parameters required to run the process
startinfo . FileName = exepath
startinfo . Arguments = cmd
startinfo . UseShellExecute = False
2021-02-07 13:47:30 +01:00
startinfo . WindowStyle = ProcessWindowStyle . Hidden
2020-09-30 18:19:31 +02:00
startinfo . RedirectStandardError = True
startinfo . RedirectStandardInput = True
startinfo . RedirectStandardOutput = True
startinfo . CreateNoWindow = True
proc = New Process
2020-10-31 23:36:52 +01:00
proc . EnableRaisingEvents = True
2020-12-10 19:18:20 +01:00
AddHandler proc . ErrorDataReceived , AddressOf FFMPEGOutput
AddHandler proc . OutputDataReceived , AddressOf FFMPEGOutput
2020-10-31 23:36:52 +01:00
AddHandler proc . Exited , AddressOf ProcessClosed
2020-09-30 18:19:31 +02:00
proc . StartInfo = startinfo
2020-08-16 23:27:48 +02:00
proc . Start ( ) ' start the process
proc . BeginOutputReadLine ( )
proc . BeginErrorReadLine ( )
Return Nothing
End Function
2020-10-31 23:36:52 +01:00
Sub ProcessClosed ( ByVal sender As Object , ByVal e As System . EventArgs )
2020-11-04 19:11:38 +01:00
Try
2020-11-13 15:57:34 +01:00
Pause ( 5 )
2020-11-04 19:11:38 +01:00
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. "
2020-12-24 16:56:45 +01:00
ProgressBar1 . Value = 0
2020-11-04 19:11:38 +01:00
Retry = True
StatusRunning = False
End If
2020-10-31 23:36:52 +01:00
End If
2020-11-04 19:11:38 +01:00
Catch ex As Exception
2020-10-31 23:36:52 +01:00
2020-11-04 19:11:38 +01:00
End Try
2021-06-20 19:02:55 +02:00
2020-10-31 23:36:52 +01:00
End Sub
2020-12-02 21:01:30 +01:00
Sub FFMPEGOutput ( ByVal sender As Object , ByVal e As DataReceivedEventArgs )
2020-08-16 23:27:48 +02:00
Try
2021-09-20 20:37:57 +02:00
LogText . Add ( Date . Now . ToString + " " + e . Data )
2020-12-24 16:56:45 +01:00
Catch ex As Exception
End Try
2020-08-16 23:27:48 +02:00
#Region "Detect Auto resolution"
2021-01-14 18:06:42 +01:00
Try
2020-08-16 23:27:48 +02:00
2021-01-14 18:06:42 +01:00
If MergeSubstoMP4 = False Then
If CBool ( InStr ( e . Data , " Stream # " ) ) And CBool ( InStr ( e . Data , " Video " ) ) = True Then
'MsgBox(True.ToString + vbNewLine + e.Data)
2021-09-20 20:37:57 +02:00
'MsgBox(InStr(e.Data, "Stream #").ToString + vbNewLine + CBool(InStr(e.Data, "Video").ToString)
2021-01-14 18:06:42 +01:00
'MsgBox("with CBool" + vbNewLine + CBool(InStr(e.Data, "Stream #")).ToString + vbNewLine + CBool(InStr(e.Data, "Video")).ToString)
ListOfStreams . Add ( e . Data )
End If
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( e . Data , " Stream # " ) ) And CBool ( InStr ( e . Data , " -> " ) ) Then
2021-01-14 18:06:42 +01:00
'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 )
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-02-20 18:25:49 +01:00
If Label_Reso . Text = " 1080p+ " Then
Else
Label_Reso . Text = ResoSearch2 ( 0 ) + " p "
End If
2021-01-14 18:06:42 +01:00
Return Nothing
End Function ) )
End If
2020-08-16 23:27:48 +02:00
End If
2021-01-14 18:06:42 +01:00
Next
End If
2020-08-16 23:27:48 +02:00
End If
#End Region
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( e . Data , " Duration: N/A, bitrate: N/A " ) ) Then
2020-11-05 20:43:52 +01:00
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( e . Data , " Duration: " ) ) Then
2021-01-14 18:06:42 +01:00
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 ) )
2020-11-05 20:43:52 +01:00
2021-01-14 18:06:42 +01:00
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( e . Data , " time= " ) ) Then
2021-01-14 18:06:42 +01:00
'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 ) )
2021-09-20 20:37:57 +02:00
Dim bitrate3 As String = " 0 "
If CBool ( InStr ( e . Data , " bitrate= " ) ) Then
2021-01-14 18:06:42 +01:00
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 )
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( bitrate2 ( 0 ) , " . " ) ) Then
2021-01-14 18:06:42 +01:00
Dim bitrateTemo As String ( ) = bitrate2 ( 0 ) . Split ( New String ( ) { " . " } , System . StringSplitOptions . RemoveEmptyEntries )
bitrate3 = bitrateTemo ( 0 )
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( bitrate2 ( 0 ) , " , " ) ) Then
2021-01-14 18:06:42 +01:00
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
2021-09-20 20:37:57 +02:00
Dim percent As Integer = CInt ( ZeitFertigInteger / ZeitGesamtInteger * 100 )
Me . Invoke ( New Action ( Function ( ) As Object
2021-01-14 18:06:42 +01:00
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 + " % "
2020-11-05 20:43:52 +01:00
Return Nothing
End Function ) )
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( e . Data , " Failed to open segment " ) ) Then
2021-01-14 18:06:42 +01:00
FailedCount = FailedCount + 1
If Item_ErrorTolerance = 0 Then
2020-08-27 13:25:28 +02:00
2021-01-14 18:06:42 +01:00
ElseIf FailedCount >= Item_ErrorTolerance Then
Failed = True
StatusRunning = False
bt_pause . BackgroundImage = My . Resources . main_pause_play
SuspendProcess ( proc )
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-01-14 18:06:42 +01:00
Label_percent . Text = " Missing segment detected, retry or resume with the play button "
Return Nothing
End Function ) )
End If
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( e . Data , " muxing overhead: " ) ) Then
2021-01-14 18:06:42 +01:00
Finished = True
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-01-14 18:06:42 +01:00
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
2021-07-04 17:22:46 +02:00
If KeepCacheFiles = False Then
System . IO . Directory . Delete ( HybridModePath , True )
End If
2021-01-14 18:06:42 +01:00
Catch ex As Exception
End Try
End If
2020-10-07 22:40:58 +02:00
End If
2020-08-16 23:27:48 +02:00
2021-01-14 18:06:42 +01:00
Catch ex As Exception
Debug . WriteLine ( ex . ToString )
End Try
2020-08-16 23:27:48 +02:00
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 ( )
2020-12-10 19:18:20 +01:00
client . Headers . Add ( My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) )
2021-10-14 19:05:48 +02:00
client . Headers . Add ( HttpRequestHeader . AcceptEncoding , " * " )
2020-08-16 23:27:48 +02:00
client . DownloadFile ( BaseURL + SiteList ( i ) , Pfad_DL + " \ " + SiteList ( i ) )
Pause ( 1 )
End Using
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-08-16 23:27:48 +02:00
iWert = iWert + 1
2021-09-20 20:37:57 +02:00
Dim Prozent As Integer = CInt ( iWert / SiteList . Count * 100 )
2020-08-16 23:27:48 +02:00
Label_percent . Text = iWert . ToString + " / " + SiteList . Count . ToString + " " + Prozent . ToString + " % "
ProgressBar1 . Value = Prozent
Return Nothing
End Function ) )
Next
End Sub
#End Region
2020-12-02 21:01:30 +01:00
Private Sub BT_del_Click ( sender As Object , e As EventArgs ) Handles bt_del . Click
2020-11-21 14:56:27 +01:00
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
2020-08-16 23:27:48 +02:00
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
2020-10-07 22:40:58 +02:00
'KillRunningTask()
2020-11-21 14:56:27 +01:00
2020-10-07 22:40:58 +02:00
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
2020-08-16 23:27:48 +02:00
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
2021-09-20 20:37:57 +02:00
th = OpenThread ( ThreadAccess . SUSPEND_RESUME , False , CUInt ( t . Id ) )
2020-08-16 23:27:48 +02:00
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
2021-09-20 20:37:57 +02:00
th = OpenThread ( ThreadAccess . SUSPEND_RESUME , False , CUInt ( t . Id ) )
2020-08-16 23:27:48 +02:00
If th <> IntPtr . Zero Then
ResumeThread ( th )
CloseHandle ( th )
End If
Next
End Sub
2020-11-04 19:11:38 +01:00
2020-08-16 23:27:48 +02:00
2020-09-30 18:19:31 +02:00
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
2020-08-16 23:27:48 +02:00
2020-09-30 18:19:31 +02:00
End Try
End Sub
2020-10-02 16:02:44 +02:00
2021-09-20 20:37:57 +02:00
'Private Sub Label_Anime_Click(sender As Object, ByVal e As MouseEventArgs) Handles Label_Anime.MouseUp, PB_Thumbnail.MouseUp, Label_Reso.MouseUp, Label_percent.MouseUp, ProgressBar1.MouseUp, Label_website.MouseUp, Me.MouseUp
' If e.Button = MouseButtons.Right Then
' 'MsgBox("Right Button Clicked")
2020-10-02 16:02:44 +02:00
2021-09-20 20:37:57 +02:00
' ContextMenuStrip1.ContextMenu.Show(Me, MousePosition)
' End If
'End Sub
2020-10-02 16:02:44 +02:00
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
2020-11-04 19:11:38 +01:00
2020-12-24 16:56:45 +01:00
Private Sub SaveToFile_Click ( sender As Object , e As EventArgs ) Handles SaveToFile . Click
2021-09-20 20:37:57 +02:00
Try
If HybridMode = True Then
Try
Dim logfile As String = DownloadPfad . Replace ( Main . VideoFormat , " .log " ) . Replace ( Chr ( 34 ) , " " )
2022-01-22 11:56:37 +01:00
'File.WriteAllText(logfile, HybrideLog)
WriteText ( logfile , HybrideLog )
2021-09-20 20:37:57 +02:00
Catch ex As Exception
MsgBox ( ex . ToString )
End Try
End If
Catch ex As Exception
End Try
2020-12-24 16:56:45 +01:00
Try
2020-11-13 15:57:34 +01:00
2021-03-08 21:08:26 +01:00
Dim logfile As String = DownloadPfad . Replace ( Main . VideoFormat , " .log " ) . Replace ( Chr ( 34 ) , " " )
2021-05-01 13:56:48 +02:00
2020-12-24 16:56:45 +01:00
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
2020-12-02 21:01:30 +01:00
2020-12-24 16:56:45 +01:00
End Using
2021-05-01 13:56:48 +02:00
2020-12-24 16:56:45 +01:00
Catch ex As Exception
MsgBox ( ex . ToString )
End Try
2021-05-01 13:56:48 +02:00
2020-12-04 20:22:22 +01:00
End Sub
2020-12-02 21:01:30 +01:00
2020-12-24 16:56:45 +01:00
Private Sub LogTocClipboard_Click ( sender As Object , e As EventArgs ) Handles LogTocClipboard . Click
Try
2021-09-20 20:37:57 +02:00
Dim Text As String = HybrideLog + vbNewLine + LogText . Item ( 0 ) + vbNewLine
2020-12-24 16:56:45 +01:00
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
2020-12-04 20:22:22 +01:00
End Sub
2021-02-07 13:47:30 +01:00
2021-09-20 20:37:57 +02:00
2020-08-16 23:27:48 +02:00
End Class
2021-02-28 13:22:00 +01:00
2020-12-13 16:11:43 +01:00
Public Class FailedSegemtsWithURL
2021-09-20 20:37:57 +02:00
Public Path As String
Public Url As String
2020-12-13 16:11:43 +01:00
2021-09-20 20:37:57 +02:00
Public Sub New ( ByVal Path As String , ByVal Url As String )
Me . Path = Path
Me . Url = Url
2020-12-13 16:11:43 +01:00
End Sub
Public Overrides Function ToString ( ) As String
2022-01-22 11:56:37 +01:00
Return String . Format ( " {0}, {1} " , Me . Path , Me . Url )
2020-12-13 16:11:43 +01:00
End Function
End Class