2020-08-16 23:27:48 +02:00
Imports System . Net
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
Public Class CRD_List_Item
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-10-31 23:36:52 +01:00
Dim timeout As DateTime
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
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
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-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
#Region "Set UI"
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-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
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
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
2020-08-16 23:27:48 +02:00
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
2020-10-02 16:02:44 +02:00
Public Sub SetTargetReso ( ByVal Value As Integer )
TargetReso = 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
2020-08-16 23:27:48 +02:00
Dim p As PictureBox = sender
p . BackgroundImage = My . Resources . main_del_hover
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
2020-08-16 23:27:48 +02:00
Dim p As PictureBox = sender
p . BackgroundImage = My . Resources . main_del
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
2020-08-16 23:27:48 +02:00
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
2020-12-02 21:01:30 +01:00
Private Sub BT_pause_MouseLeave ( sender As Object , e As EventArgs ) Handles bt_pause . MouseLeave
2020-08-16 23:27:48 +02:00
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
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
StartDownload ( HistoryDL_URL , HistoryDL_Pfad , HistoryFilename , HybridMode )
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-10-07 22:40:58 +02:00
Else
StatusRunning = True
bt_pause . BackgroundImage = My . Resources . main_pause
End If
2020-11-21 14:56:27 +01:00
2020-10-07 22:40:58 +02:00
Else
If proc . HasExited = True Then
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
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
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
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
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
2020-08-16 23:27:48 +02:00
Dim locationY As Integer = 0
bt_del . SetBounds ( 775 , locationY + 10 , 35 , 29 )
bt_pause . SetBounds ( 740 , locationY + 15 , 25 , 20 )
PB_Thumbnail . SetBounds ( 11 , 20 , 168 , 95 )
PB_Thumbnail . BringToFront ( )
Label_website . Location = New Point ( 195 , locationY + 15 )
Label_Anime . Location = New Point ( 195 , locationY + 42 )
Label_Reso . Location = New Point ( 195 , locationY + 101 )
Label_Hardsub . Location = New Point ( 300 , locationY + 101 )
2020-10-31 23:36:52 +01:00
Label_percent . SetBounds ( 432 , locationY + 101 , 378 , 19 )
2020-08-16 23:27:48 +02:00
Label_percent . AutoSize = False
ProgressBar1 . SetBounds ( 195 , locationY + 70 , 601 , 20 )
2020-11-13 15:57:34 +01:00
PictureBox5 . Location = New Point ( 0 , 136 )
PictureBox5 . Height = 6
2020-08-16 23:27:48 +02:00
End Sub
Public Function GetTextBound ( )
Return Label_website . Location . Y
End Function
2020-11-13 15:57:34 +01:00
2020-08-16 23:27:48 +02:00
#Region "Download + Update UI"
2020-09-30 18:19:31 +02:00
Public Sub StartDownload ( ByVal DL_URL As String , ByVal DL_Pfad As String , ByVal Filename As String , ByVal DownloadHybridMode As Boolean )
2020-10-15 01:04:15 +02:00
'MsgBox(DL_URL)
2020-10-31 23:36:52 +01:00
DownloadPfad = DL_Pfad
HistoryDL_URL = DL_URL
HistoryDL_Pfad = DL_Pfad
HistoryFilename = Filename
2020-09-30 18:19:31 +02:00
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"
2020-12-02 21:01:30 +01:00
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
2020-09-30 18:19:31 +02:00
Try
2020-12-02 21:01:30 +01:00
'Dim wc_ts As New WebClient
WC_TS = New WebClient
WC_TS . DownloadFile ( New Uri ( DL_URL ) , DL_Pfad )
2020-09-30 18:19:31 +02:00
Catch ex As Exception
2020-10-10 23:23:10 +02:00
Try
Dim wc_ts As New WebClient
wc_ts . DownloadFile ( New Uri ( DL_URL ) , DL_Pfad )
Catch ex2 As Exception
Debug . WriteLine ( " Download error #2: " + DL_Pfad + vbNewLine + ex . ToString + vbNewLine + DL_URL )
End Try
Debug . WriteLine ( " Download error #1: " + DL_Pfad )
2020-09-30 18:19:31 +02:00
End Try
End Sub
2020-12-02 21:01:30 +01:00
Private Function TS_StatusAsync ( ByVal prozent As Integer , ByVal di As IO . DirectoryInfo , ByVal Filename As String , ByVal pausetime As Integer )
2020-09-30 18:19:31 +02:00
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 + 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 * 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 ( )
If prozent > 100 Then
prozent = 100
2020-10-02 16:02:44 +02:00
ElseIf prozent < 0 Then
prozent = 0
2020-09-30 18:19:31 +02:00
End If
2020-12-02 21:01:30 +01:00
Try
Me . Invoke ( New Action ( Function ( )
ProgressBar1 . Value = prozent
Label_percent . Text = DataRateString + " MB\s " + Math . Round ( FinishedSize , 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
2020-09-30 18:19:31 +02:00
'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
2020-10-21 23:03:24 +02:00
'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
2020-10-31 23:36:52 +01:00
Me . Invoke ( New Action ( Function ( )
Label_percent . Text = " Downloading Subtitles... "
Return Nothing
End Function ) )
2020-10-21 23:03:24 +02:00
For i As Integer = 1 To MergeSub . Count - 1
2020-11-13 15:57:34 +01:00
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 "
2020-10-31 23:36:52 +01:00
2020-11-13 15:57:34 +01:00
Dim retry As Boolean = True
Dim retryCount As Integer = 3
While retry
Try
SubsClient . DownloadFile ( SubsURL ( 0 ) , Pfad2 + " \ " + SubsFile )
2020-10-31 23:36:52 +01:00
retry = False
2020-11-13 15:57:34 +01:00
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
2020-10-21 23:03:24 +02:00
End If
2020-09-30 18:19:31 +02:00
Dim m3u8_url As String ( ) = DL_URL . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
2020-10-02 16:02:44 +02:00
Dim m3u8_url_1 As String = Nothing
Dim m3u8_url_3 As String = m3u8_url ( 1 )
2020-09-30 18:19:31 +02:00
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 = client0 . DownloadString ( m3u8_url ( 1 ) )
2020-10-02 16:02:44 +02:00
If InStr ( text , " RESOLUTION= " ) Then 'master m3u8 no fragments
Dim new_m3u8_2 ( ) As String = text . Split ( New String ( ) { vbLf } , System . StringSplitOptions . RemoveEmptyEntries )
If TargetReso = 42 Then
2020-10-20 19:32:58 +02:00
TargetReso = 1080
End If
2020-10-02 16:02:44 +02:00
2020-10-20 19:32:58 +02:00
For i As Integer = 0 To new_m3u8_2 . Count - 1
2020-10-02 16:02:44 +02:00
'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_1)
text = client0 . DownloadString ( m3u8_url_3 )
End If
2020-10-20 19:32:58 +02:00
End If
2020-10-10 23:23:10 +02:00
Dim LoadedKeys As New List ( Of String )
LoadedKeys . Add ( " Nothing " )
Dim KeyFileCache As String = Nothing
2020-09-30 18:19:31 +02:00
Dim textLenght ( ) As String = text . Split ( New String ( ) { vbLf } , System . StringSplitOptions . RemoveEmptyEntries )
2020-10-02 16:02:44 +02:00
Dim Fragments ( ) As String = text . Split ( New String ( ) { " .ts " } , System . StringSplitOptions . RemoveEmptyEntries )
2020-09-30 18:19:31 +02:00
Dim FragmentsInt As Integer = Fragments . Count - 2
Dim nummerint As Integer = 0 '-1
Dim m3u8FFmpeg As String = Nothing
Dim ts_dl As String = Nothing
2020-10-21 23:03:24 +02:00
2020-10-07 22:40:58 +02:00
HybridModePath = Pfad2
2020-09-30 18:19:31 +02:00
If Debug2 = True Then
MsgBox ( Pfad2 )
End If
Dim PauseTime As Integer = 0
2020-10-31 23:36:52 +01:00
Dim Threads As Integer = Environment . ProcessorCount / 2 - 1
If Threads < 2 Then
Threads = 2
End If
2020-09-30 18:19:31 +02:00
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
2020-10-31 23:36:52 +01:00
ElseIf ThreadList . Count > Threads Then
2020-09-30 18:19:31 +02:00
Thread . Sleep ( 125 )
2020-10-07 22:40:58 +02:00
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
2020-11-21 14:56:27 +01:00
Me . Invoke ( New Action ( Function ( )
ProgressBar1 . Value = 0
Label_percent . Text = " canceled -% "
bt_pause . BackgroundImage = My . Resources . main_pause_play
Return Nothing
End Function ) )
2020-10-07 22:40:58 +02:00
Exit For
End If
Next
Return Nothing
Exit Function
2020-12-02 21:01:30 +01:00
'ElseIf nummerint < Threads Then
' Thread.Sleep(2000)
' Exit For
2020-09-30 18:19:31 +02:00
Else
2020-12-02 21:01:30 +01:00
Thread . Sleep ( 1000 )
2020-09-30 18:19:31 +02:00
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
2020-10-02 16:02:44 +02:00
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 )
2020-09-30 18:19:31 +02:00
Else
2020-10-02 16:02:44 +02:00
Dim c ( ) As String = New Uri ( m3u8_url_3 ) . Segments
Dim path As String = " https:// " + New Uri ( m3u8_url_3 ) . Host
2020-09-30 18:19:31 +02:00
For i3 As Integer = 0 To c . Count - 2
path = path + c ( i3 )
Next
2020-10-07 22:40:58 +02:00
curi = path + textLenght ( i )
2020-09-30 18:19:31 +02:00
End If
2020-12-02 21:01:30 +01:00
Dim Evaluator = New Thread ( Sub ( ) Me . TS_DownloadAsync ( curi , Pfad2 + nummer4D + " .ts " ) )
2020-10-07 22:40:58 +02:00
Evaluator . Start ( )
ThreadList . Add ( Evaluator )
2020-12-02 21:01:30 +01:00
m3u8FFmpeg = m3u8FFmpeg + Pfad2 + nummer4D + " .ts " + vbLf '+ "#" + curi + vbLf
2020-10-07 22:40:58 +02:00
Dim FragmentsFinised = ( ThreadList . Count + nummerint ) / FragmentsInt * 100
2020-12-02 21:01:30 +01:00
TS_StatusAsync ( FragmentsFinised , di , Filename , PauseTime )
2020-10-07 22:40:58 +02:00
ElseIf textLenght ( i ) = " #EXT-X-PLAYLIST-TYPE:VOD " Then
2020-12-02 21:01:30 +01:00
2020-10-07 22:40:58 +02:00
ElseIf InStr ( textLenght ( i ) , " URI= " + Chr ( 34 ) ) Then
Dim KeyLine As String = textLenght ( i )
If InStr ( KeyLine , " https:// " ) Then
2020-10-10 23:23:10 +02:00
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
2020-11-13 15:57:34 +01:00
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
2020-10-10 23:23:10 +02:00
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
2020-10-07 22:40:58 +02:00
'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)
2020-10-10 23:23:10 +02:00
2020-09-30 18:19:31 +02:00
Else
2020-10-07 22:40:58 +02:00
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)
2020-10-10 23:23:10 +02:00
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
2020-11-13 15:57:34 +01:00
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)
2020-10-10 23:23:10 +02:00
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
2020-10-07 22:40:58 +02:00
End If
m3u8FFmpeg = m3u8FFmpeg + KeyLine + vbLf
Else
m3u8FFmpeg = m3u8FFmpeg + textLenght ( i ) + vbLf
2020-09-30 18:19:31 +02:00
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
2020-12-02 21:01:30 +01:00
TS_StatusAsync ( 100 , di , Filename , PauseTime )
2020-09-30 18:19:31 +02:00
DL_URL = DL_URL . Replace ( m3u8_url ( 1 ) , Pfad2 + " index " + Folder + " .m3u8 " )
2020-12-02 21:01:30 +01:00
Using sink3 As New StreamWriter ( Path . GetDirectoryName ( DL_Pfad . Replace ( Chr ( 34 ) , " " ) ) + " \hybridelog.log " , False , utf8WithoutBom )
sink3 . WriteLine ( HybrideLog )
End Using
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
2020-10-21 23:03:24 +02:00
Dim cmd As String = " -allowed_extensions ALL " + DL_URL + " " + DL_Pfad '+ " " + ffmpeg_command + " " + DL_Pfad 'start ffmpeg with command strFFCMD string
2020-12-02 21:01:30 +01:00
' 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) +
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
AddHandler proc . ErrorDataReceived , AddressOf ffmpegOutput
AddHandler proc . OutputDataReceived , AddressOf ffmpegOutput
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
#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
2020-10-20 19:32:58 +02:00
Dim cmd As String = " -headers " + Chr ( 34 ) + " User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:81.0) Gecko/20100101 Firefox/81.0 " + Chr ( 34 ) + " " + DLCommand + " " + DL_Pfad 'start ffmpeg with command strFFCMD string
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
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
AddHandler proc . ErrorDataReceived , AddressOf ffmpegOutput
AddHandler proc . OutputDataReceived , AddressOf ffmpegOutput
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. "
ProgressBar1 . Value = 100
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
2020-10-31 23:36:52 +01:00
'Me.Invoke(New Action(Function()
' Label_percent.Text = "Finished - event"
' Return Nothing
' End Function))
End Sub
2020-12-02 21:01:30 +01:00
Sub FFMPEGOutput ( ByVal sender As Object , ByVal e As DataReceivedEventArgs )
2020-10-31 23:36:52 +01:00
'timeout = DateTime.Now
'MsgBox(timeout)
2020-08-16 23:27:48 +02:00
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"
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 ( )
2020-08-27 14:01:05 +02:00
If percent > 100 Then
percent = 100
End If
2020-08-16 23:27:48 +02:00
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 ) )
2020-10-31 23:36:52 +01:00
ElseIf InStr ( e . Data , " Failed to open segment " ) Then
FailedCount = FailedCount + 1
2020-11-05 20:43:52 +01:00
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
2020-08-27 13:25:28 +02:00
ElseIf InStr ( e . Data , " muxing overhead: " ) Then
2020-11-04 19:11:38 +01:00
Finished = True
2020-08-27 13:25:28 +02:00
Me . Invoke ( New Action ( Function ( )
Dim Done As String ( ) = Label_percent . Text . Split ( New String ( ) { " MB " } , System . StringSplitOptions . RemoveEmptyEntries )
2020-08-27 14:44:38 +02:00
Label_percent . Text = " Finished - " + Done ( 0 ) + " MB "
2020-08-27 13:25:28 +02:00
Return Nothing
End Function ) )
2020-10-07 22:40:58 +02:00
If HybridMode = True Then
2020-10-31 23:36:52 +01:00
Thread . Sleep ( 5000 )
Try
2020-12-02 21:01:30 +01:00
'System.IO.Directory.Delete(HybridModePath, True)
2020-10-31 23:36:52 +01:00
Catch ex As Exception
End Try
2020-10-07 22:40:58 +02:00
End If
2020-08-16 23:27:48 +02:00
End If
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-10-20 19:32:58 +02:00
client . Headers . Add ( " User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:81.0) Gecko/20100101 Firefox/81.0 " )
2020-08-16 23:27:48 +02:00
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
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
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
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
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
2020-11-04 19:11:38 +01:00
2020-11-13 15:57:34 +01:00
Private Sub CRD_List_Item_Resize ( sender As Object , e As EventArgs ) Handles Me . Resize
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-12-02 21:01:30 +01:00
2020-08-16 23:27:48 +02:00
End Class