2021-09-20 20:37:57 +02:00
Option Strict On
Imports System . Net
2019-11-10 00:16:12 +01:00
Imports System . Text
Imports System . IO
Imports Microsoft . Win32
2020-08-16 23:27:48 +02:00
Imports System . Threading
Imports System . Net . WebUtility
Imports System . Net . Sockets
2020-11-13 15:57:34 +01:00
Imports MetroFramework . Forms
Imports MetroFramework
Imports MetroFramework . Components
2021-02-07 13:47:30 +01:00
Imports System . Globalization
2021-02-20 18:25:49 +01:00
Imports System . ComponentModel
2021-06-04 15:25:59 +02:00
Imports Newtonsoft . Json . Linq
2021-07-04 17:22:46 +02:00
Imports System . Runtime . InteropServices
2021-09-20 20:37:57 +02:00
Imports CefSharp . WinForms
Imports CefSharp
Imports MetroFramework . Controls
2020-09-30 18:19:31 +02:00
2019-11-10 00:16:12 +01:00
Public Class Main
2020-11-13 15:57:34 +01:00
Inherits MetroForm
2021-09-20 20:37:57 +02:00
Dim t As Thread
2021-02-20 18:25:49 +01:00
Dim HTML As String = Nothing
2021-04-05 19:08:42 +02:00
Public CrBetaMass As String = Nothing
Public CrBetaMassEpisodes As String = Nothing
Public CrBetaMassParameters As String = Nothing
2021-05-23 22:27:56 +02:00
Public CrBetaMassBaseURL As String = Nothing
2021-04-05 19:08:42 +02:00
Public BlockList As List ( Of String )
2021-02-20 18:25:49 +01:00
2021-09-20 20:37:57 +02:00
Public LoadedUrls As New List ( Of String )
Public VRVMass As String = Nothing
Public VRVMassEpisodes As String = Nothing
Public VRVMassParameters As String = Nothing
Public VRVMassBaseURL As String = Nothing
2021-05-23 22:27:56 +02:00
Public FunimationAPIRegion As String = Nothing
Public FunimationRegion As String = Nothing
Public FunimationShowPath As String = Nothing
Public FunimationEpisodeJSON As String = Nothing
Public FunimtaionAPISeasonID As New List ( Of String )
2021-07-04 17:22:46 +02:00
Public FunimationJsonBrowser As String = Nothing
2021-05-23 22:27:56 +02:00
2020-12-08 19:01:35 +01:00
Public Manager As New MetroStyleManager
2020-12-10 19:18:20 +01:00
Public DarkModeValue As Boolean = False
2021-01-14 18:06:42 +01:00
Public invalids As Char ( ) = System . IO . Path . GetInvalidFileNameChars ( )
2021-01-16 14:08:33 +01:00
Dim ServerThread As Thread
2020-12-08 19:01:35 +01:00
2021-05-23 22:27:56 +02:00
Public KodiNaming As Boolean = False
2020-11-05 20:43:52 +01:00
Public ErrorTolerance As Integer = 0
2020-11-04 19:11:38 +01:00
Public liList As New List ( Of String )
2020-08-16 23:27:48 +02:00
Public HTMLString As String = My . Resources . Startuphtml
2020-06-01 18:43:38 +02:00
Public ListBoxList As New List ( Of String )
2021-03-08 21:08:26 +01:00
Public ItemList As New List ( Of CRD_List_Item )
2020-08-16 23:27:48 +02:00
Public RunningDownloads As Integer = 0
2020-02-28 16:28:38 +01:00
Public UseQueue As Boolean = False
2021-02-12 13:44:17 +01:00
Public StartServer As Integer = 0
2020-02-20 21:39:47 +01:00
Public m3u8List As New List ( Of String )
Public txtList As New List ( Of String )
Public mpdList As New List ( Of String )
2020-02-28 16:28:38 +01:00
Public ResoAvalibe As String = Nothing
Public ResoSearchRunning As Boolean = False
Public UsedMap As String = Nothing
2020-02-14 17:22:54 +01:00
Public Debug1 As Boolean = False
Public Debug2 As Boolean = False
2020-06-10 17:34:27 +02:00
Public LogBrowserData As Boolean = False
2020-01-19 14:13:59 +01:00
Public Thumbnail As String = Nothing
2021-03-08 21:08:26 +01:00
Public MergeSubs As Boolean = False
2021-09-20 20:37:57 +02:00
Public IgnoreS1 As Boolean = False
2021-07-04 17:22:46 +02:00
Public KeepCache As Boolean = False
2021-03-20 13:02:49 +01:00
Public SubsOnly As Boolean = False
2021-03-08 21:08:26 +01:00
Public VideoFormat As String = " .mp4 "
Public MergeSubsFormat As String = " mov_text "
2020-06-10 17:34:27 +02:00
Public LoginDialog As Boolean = False
2021-03-08 21:08:26 +01:00
2020-01-12 16:25:55 +01:00
Public NonCR_Timeout As Integer = 5
Public NonCR_URL As String = Nothing
2020-02-02 16:39:54 +01:00
Public DlSoftSubsRDY As Boolean = True
2019-11-10 00:16:12 +01:00
Public DialogTaskString As String
Public UserCloseDialog As Boolean = False
Dim Aktuell As String
Dim Gesamt As String
Public LabelUpdate As String = " Status: idle "
Public LabelEpisode As String = " ... "
2021-09-20 20:37:57 +02:00
Public b As Boolean
2020-02-02 16:39:54 +01:00
Public c As Boolean = True
2019-11-10 00:16:12 +01:00
Public LoginOnly As String = " False "
Public Pfad As String = My . Computer . FileSystem . CurrentDirectory
2021-09-20 20:37:57 +02:00
Public ProfileFolder As String = Path . Combine ( My . Computer . FileSystem . SpecialDirectories . MyDocuments , " CRD-Profile " )
2020-02-12 22:08:02 +01:00
Public ffmpeg_command As String = " -c copy -bsf:a aac_adtstoasc " '" -c:v hevc_nvenc -preset fast -b:v 6M -bsf:a aac_adtstoasc "
2020-11-13 15:57:34 +01:00
Public Reso As Integer
Public AoD_Reso As Integer = 0
2021-02-07 13:47:30 +01:00
Public Season_Prefix As String = " [default season prefix] "
Public Episode_Prefix As String = " [default episode prefix] "
2020-11-13 15:57:34 +01:00
Dim Reso2 As String
Public ResoSave As String = " 6666x6666 "
2020-11-21 14:56:27 +01:00
Public ResoFunBackup As String = " 6666x6666 "
2019-11-10 00:16:12 +01:00
Public SubSprache As String
Public SoftSubs As New List ( Of String )
2021-09-20 20:37:57 +02:00
Public IncludeLangName As Boolean = False
2020-10-07 22:40:58 +02:00
Public TempSoftSubs As New List ( Of String )
2019-11-10 00:16:12 +01:00
Public AbourtList As New List ( Of String )
Public watingList As New List ( Of String )
2020-12-21 12:18:18 +01:00
Public GeckoLogFile As String = Nothing
2019-11-10 00:16:12 +01:00
Dim SoftSubsString As String
Dim CR_Unlock_Error As String
2019-12-22 16:15:17 +01:00
Public Startseite As String = " https://www.crunchyroll.com/ "
2019-11-10 00:16:12 +01:00
Dim SubSprache2 As String
Dim URL_DL As String
Dim Pfad_DL As String
Public Grapp_RDY As Boolean = True
2020-08-16 23:27:48 +02:00
Public Funimation_Grapp_RDY As Boolean = True
2019-12-21 14:40:47 +01:00
Public Grapp_non_cr_RDY As Boolean = True
2019-11-10 00:16:12 +01:00
Public Grapp_Abord As Boolean = False
2020-11-21 14:56:27 +01:00
Public CR_NameMethode As Integer = 0
2019-11-10 00:16:12 +01:00
Public MaxDL As Integer
Public ResoNotFoundString As String
Public ResoBackString As String
2020-08-16 23:27:48 +02:00
Public WebbrowserHeadText As String = Nothing
Public WebbrowserSoftSubURL As String = Nothing
2019-11-10 00:16:12 +01:00
Public WebbrowserURL As String = Nothing
2021-02-28 13:22:00 +01:00
Public SystemWebBrowserCookie As String = Nothing
2019-11-10 00:16:12 +01:00
Public WebbrowserText As String = Nothing
Public WebbrowserTitle As String = Nothing
2020-08-16 23:27:48 +02:00
Public WebbrowserCookie As String = Nothing
2019-11-10 00:16:12 +01:00
Public UserBowser As Boolean = False
2020-09-30 18:19:31 +02:00
Public HybridMode As Boolean = False
2020-11-19 22:28:42 +01:00
Public HardSubFunimation As String = " Disabled "
Public DubFunimation As String = " Disabled "
2020-11-21 14:56:27 +01:00
Public Funimation_srt As Boolean = False
Public Funimation_vtt As Boolean = False
Public Funimation_dfxp As Boolean = False
2020-11-19 22:28:42 +01:00
Public SubFunimationString As String = " en "
Public SubFunimation As New List ( Of String )
2021-02-20 18:25:49 +01:00
Public DefaultSubFunimation As String = " Disabled "
Public DefaultSubCR As String = " Disabled "
2019-11-10 00:16:12 +01:00
#Region "Sprachen Vairablen"
2020-11-04 19:11:38 +01:00
Public URL_Invaild As String = " something is wrong here... "
2019-11-10 00:16:12 +01:00
Dim DL_Path_String As String = " Please choose download directory. "
2020-08-16 23:27:48 +02:00
Public No_Stream As String = " Please make sure that the URL is correct or check if the Anime is available in your country. "
2019-11-10 00:16:12 +01:00
Dim TaskNotCompleed As String = " Please wait until the current task is completed. "
2021-05-23 22:27:56 +02:00
Dim Premium_Stream As String = " For Premium episodes you need a premium membership and be logged in the Downloader. "
2020-11-04 19:11:38 +01:00
Public LoginReminder As String = " Please make sure that you logged in. "
2019-11-10 00:16:12 +01:00
Dim Error_Mass_DL As String = " We run into a problem here. " + vbNewLine + " You can try to download every episode individually. "
Dim User_Fault_NoName As String = " no name, fallback solution : "
Dim Sub_language_NotFound As String = " Could not find the sub language " + vbNewLine + " please make sure the language is available: "
Dim Resolution_NotFound As String = " Could not find any resolution. "
Dim Error_unknown As String = " We run into a unknown problem here. " + vbNewLine + " Do you like to send an Bug report? "
Public CR_Unlock_Error_String As String = " unable to get an CR-US cookie. "
Dim ErrorNoPermisson As String = " Access is denied. "
'UI Variablen
Public GB_Resolution_Text As String = " Resolution "
Public GB_SubLanguage_Text As String = " Hardsub language "
Public GB_Sub_Path_Text As String = " Sub directory "
Public UL_US_Text As String = " enable US Cookie "
Public RBAnime_Text As String = " series name "
Public RBStaffel_Text As String = " series name + season "
Public NewStart_String As String = " to adopt all the settings, a restart is necessary. "
Public DL_Count_simultaneousText As String = " Simultaneous Downloads "
Public GB_Sub_FormatText As String = " extended Sub Settings "
Public LabelResoNotFoundText As String = " resolution not found " + vbNewLine + " Select another one below "
2021-02-28 13:22:00 +01:00
Public LabelLangNotFoundText As String = " subtitle language not found " + vbNewLine + " Select another one below "
2019-11-10 00:16:12 +01:00
Public ButtonResoNotFoundText As String = " Submit "
2020-08-16 23:27:48 +02:00
Public CB_SuB_Nothing As String = " [ null ] "
2019-11-10 00:16:12 +01:00
Dim StatusToolTip As ToolTip = New ToolTip ( )
Dim StatusToolTipText As String
Public RunGecko As String = " Startup "
2020-09-30 18:19:31 +02:00
2019-11-10 00:16:12 +01:00
#End Region
#Region "UI"
2020-11-13 15:57:34 +01:00
Private Sub Main_TextChanged ( sender As Object , e As EventArgs ) Handles Me . TextChanged
Me . Invalidate ( )
End Sub
2020-12-10 19:18:20 +01:00
Public CloseImg As Bitmap = My . Resources . main_del
2020-12-13 16:11:43 +01:00
Public MinImg As Bitmap = My . Resources . main_mini
2021-01-16 14:08:33 +01:00
Public BackColorValue As Color = Color . FromArgb ( 243 , 243 , 243 )
Public ForeColorValue As Color = SystemColors . WindowText
2020-12-10 19:18:20 +01:00
Public Sub DarkMode ( )
ListView1 . BackColor = Color . FromArgb ( 50 , 50 , 50 )
CloseImg = My . Resources . main_close_dark
2020-12-13 16:11:43 +01:00
MinImg = My . Resources . main_mini_dark
Btn_min . Image = MinImg
2020-12-10 19:18:20 +01:00
Btn_Close . Image = CloseImg
2021-01-16 14:08:33 +01:00
BackColorValue = Color . FromArgb ( 50 , 50 , 50 )
ForeColorValue = Color . FromArgb ( 243 , 243 , 243 )
2020-12-10 19:18:20 +01:00
End Sub
Public Sub LightMode ( )
2021-01-16 14:08:33 +01:00
BackColorValue = Color . FromArgb ( 243 , 243 , 243 )
ForeColorValue = SystemColors . WindowText
2020-12-10 19:18:20 +01:00
ListView1 . BackColor = SystemColors . Control
CloseImg = My . Resources . main_close
2020-12-13 16:11:43 +01:00
MinImg = My . Resources . main_mini
Btn_min . Image = MinImg
2020-12-10 19:18:20 +01:00
Btn_Close . Image = CloseImg
End Sub
2020-11-13 15:57:34 +01:00
Dim ListViewHeightOffset As Integer = 7
2021-09-20 20:37:57 +02:00
Private Sub Btn_add_MouseEnter ( sender As Object , e As EventArgs ) Handles Btn_add . MouseEnter , Btn_add . GotFocus
2020-12-10 19:18:20 +01:00
If Manager . Theme = MetroThemeStyle . Dark Then
2021-09-20 20:37:57 +02:00
Btn_add . Image = My . Resources . main_add_invert_dark
2020-12-10 19:18:20 +01:00
Else
2021-09-20 20:37:57 +02:00
Btn_add . Image = My . Resources . main_add_invert
2020-12-10 19:18:20 +01:00
End If
2020-11-13 15:57:34 +01:00
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Btn_add_MouseLeave ( sender As Object , e As EventArgs ) Handles Btn_add . MouseLeave , Btn_add . LostFocus
' Dim btn As Button = sender
' btn.Invalidate()
Btn_add . Image = My . Resources . main_add
2020-11-13 15:57:34 +01:00
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Btn_Browser_MouseEnter ( sender As Object , e As EventArgs ) Handles Btn_Browser . MouseEnter , Btn_Browser . GotFocus
'Dim btn As Button = sender
'btn.Invalidate()
2020-12-10 19:18:20 +01:00
If Manager . Theme = MetroThemeStyle . Dark Then
2021-09-20 20:37:57 +02:00
Btn_Browser . Image = My . Resources . main_browser_invert_dark
2020-12-10 19:18:20 +01:00
Else
2021-09-20 20:37:57 +02:00
Btn_Browser . Image = My . Resources . main_browser_invert
2020-12-10 19:18:20 +01:00
End If
2020-11-13 15:57:34 +01:00
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Btn_Browser_MouseLeave ( sender As Object , e As EventArgs ) Handles Btn_Browser . MouseLeave , Btn_Browser . LostFocus
Btn_Browser . Image = My . Resources . main_browser
2020-11-13 15:57:34 +01:00
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Btn_Settings_MouseEnter ( sender As Object , e As EventArgs ) Handles Btn_Settings . MouseEnter , Btn_Settings . GotFocus
2020-12-10 19:18:20 +01:00
If Manager . Theme = MetroThemeStyle . Dark Then
2021-09-20 20:37:57 +02:00
Btn_Settings . Image = My . Resources . main_setting_invert_dark
2020-12-10 19:18:20 +01:00
Else
2021-09-20 20:37:57 +02:00
Btn_Settings . Image = My . Resources . main_setting_invert
2020-12-10 19:18:20 +01:00
End If
2020-11-13 15:57:34 +01:00
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Btn_Settings_MouseLeave ( sender As Object , e As EventArgs ) Handles Btn_Settings . MouseLeave , Btn_Settings . LostFocus
Btn_Settings . Image = My . Resources . main_settings
2020-11-13 15:57:34 +01:00
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Btn_min_MouseEnter ( sender As Object , e As EventArgs ) Handles Btn_min . MouseEnter , Btn_min . GotFocus
If Manager . Theme = MetroThemeStyle . Dark Then
Btn_min . Image = My . Resources . main_mini_dark_hover
Else
Btn_min . Image = My . Resources . main_mini_red
End If
2020-12-13 16:11:43 +01:00
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Btn_min_MouseLeave ( sender As Object , e As EventArgs ) Handles Btn_min . MouseLeave , Btn_min . LostFocus
Btn_min . Image = MinImg
2020-12-13 16:11:43 +01:00
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Btn_Close_MouseEnter ( sender As Object , e As EventArgs ) Handles Btn_Close . MouseEnter , Btn_Close . GotFocus
If Manager . Theme = MetroThemeStyle . Dark Then
Btn_Close . Image = My . Resources . main_close_dark_hover
Else
Btn_Close . Image = My . Resources . main_close_hover
End If
2019-11-10 00:16:12 +01:00
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Btn_Close_MouseLeave ( sender As Object , e As EventArgs ) Handles Btn_Close . MouseLeave , Btn_Close . LostFocus
Btn_Close . Image = CloseImg
2019-11-10 00:16:12 +01:00
End Sub
2021-09-20 20:37:57 +02:00
2020-11-13 15:57:34 +01:00
Private Sub PictureBox6_Click ( sender As Object , e As EventArgs ) Handles PictureBox6 . Click
If TheTextBox . Visible = True Then
TheTextBox . Visible = False
ListViewHeightOffset = 7
PictureBox6 . Location = New Point ( 0 , Me . Height - ListViewHeightOffset )
TheTextBox . Location = New Point ( 1 , Me . Height - ListViewHeightOffset + 7 )
TheTextBox . Width = Me . Width - 2
Else
ListViewHeightOffset = 103
TheTextBox . Visible = True
PictureBox6 . Location = New Point ( 0 , Me . Height - ListViewHeightOffset )
2019-11-10 00:16:12 +01:00
2020-11-13 15:57:34 +01:00
TheTextBox . Location = New Point ( 1 , Me . Height - ListViewHeightOffset + 7 )
TheTextBox . Width = Me . Width - 2
End If
End Sub
Private Sub PictureBox6_MouseEnter ( sender As Object , e As EventArgs ) Handles PictureBox6 . MouseEnter
PictureBox6 . BackgroundImage = My . Resources . balken_console
End Sub
Private Sub PictureBox6_MouseLeave ( sender As Object , e As EventArgs ) Handles PictureBox6 . MouseLeave
PictureBox6 . BackgroundImage = My . Resources . balken
End Sub
Private Sub Main_Resize ( sender As Object , e As EventArgs ) Handles Me . Resize
ListView1 . Width = Me . Width - 2
ListView1 . Height = Me . Height - 71 - ListViewHeightOffset
PictureBox5 . Width = Me . Width - 40
2020-12-10 19:18:20 +01:00
2020-11-13 15:57:34 +01:00
PictureBox6 . Location = New Point ( 1 , Me . Height - ListViewHeightOffset )
PictureBox6 . Width = Me . Width - 40
TheTextBox . Location = New Point ( 1 , Me . Height - ListViewHeightOffset + 7 )
TheTextBox . Width = Me . Width - 2
2021-09-20 20:37:57 +02:00
Btn_Close . Location = New Point ( Me . Width - 41 , 1 )
Btn_min . Location = New Point ( Me . Width - 82 , 1 )
Btn_Settings . Location = New Point ( Me . Width - 190 , 17 )
2020-11-13 15:57:34 +01:00
Try
For s As Integer = 0 To ListView1 . Items . Count - 1
Dim r As Rectangle = ListView1 . Items . Item ( s ) . Bounds
ItemList ( s ) . SetBounds ( r . X , r . Y , ListView1 . Width - 2 , r . Height )
If ItemList ( s ) . GetToDispose ( ) = True Then
ItemList ( s ) . DisposeItem ( ItemList ( s ) . GetToDispose ( ) )
ItemList . RemoveAt ( s )
ListView1 . Items . RemoveAt ( s )
End If
Next
Catch ex As Exception
End Try
End Sub
2019-11-10 00:16:12 +01:00
#End Region
2021-04-24 20:51:34 +02:00
2020-01-12 16:25:55 +01:00
Public Declare Function waveOutSetVolume Lib " winmm.dll " ( ByVal uDeviceID As Integer , ByVal dwVolume As Integer ) As Integer
2019-11-10 00:16:12 +01:00
2021-07-04 17:22:46 +02:00
<FlagsAttribute()>
Public Enum EXECUTION_STATE As UInteger
ES_SYSTEM_REQUIRED = & H1
ES_DISPLAY_REQUIRED = & H2
ES_CONTINUOUS = & H80000000UI
End Enum
<DllImport("Kernel32.DLL", CharSet:=CharSet.Auto, SetLastError:=True)>
Public Shared Function SetThreadExecutionState ( ByVal state As EXECUTION_STATE ) As EXECUTION_STATE
End Function
2020-12-10 19:18:20 +01:00
Public Sub SetSettingsTheme ( )
Einstellungen . Theme = Manager . Theme
End Sub
2020-08-16 23:27:48 +02:00
2019-11-10 00:16:12 +01:00
Private Sub Form8_Load ( sender As Object , e As EventArgs ) Handles MyBase . Load
2021-09-20 20:37:57 +02:00
Me . ContextMenuStrip = ContextMenuStrip1
2020-11-13 15:57:34 +01:00
Dim tbtl As TextBoxTraceListener = New TextBoxTraceListener ( TheTextBox )
2021-09-20 20:37:57 +02:00
Trace . Listeners . Add ( tbtl )
b = True
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
ProfileFolder = rkg . GetValue ( " ProfilFolder " ) . ToString
Catch ex As Exception
End Try
Dim settings As CefSettings = New CefSettings ( )
If Not Directory . Exists ( Path . GetDirectoryName ( ProfileFolder ) ) Then
' Nein! Jetzt erstellen...
Try
Directory . CreateDirectory ( Path . GetDirectoryName ( ProfileFolder ) )
settings . CachePath = ProfileFolder
Catch ex As Exception
' Ordner wurde nich erstellt
settings . CachePath = Application . StartupPath + " \lib "
End Try
Else
settings . CachePath = ProfileFolder
End If
settings . CefCommandLineArgs . Add ( " disable-gpu " )
settings . CefCommandLineArgs . Add ( " disable-gpu-vsync " )
settings . CefCommandLineArgs . Add ( " disable-d3d11 " )
settings . CefCommandLineArgs . Add ( " disable-gpu-rasterization " )
settings . CefCommandLineArgs ( " autoplay-policy " ) = " no-user-gesture-required "
settings . LogFile = Path . Combine ( Application . StartupPath , " lib " , " browser.log " )
'Initialize Cef with the provided settings
Cef . Initialize ( settings )
2020-12-08 19:01:35 +01:00
2020-11-05 20:43:52 +01:00
'Try
' Dim SettingsDone As Boolean = False
' Dim rkg As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\CRDownloader")
' SettingsDone = CBool(Integer.Parse(rkg.GetValue("SettingsDone").ToString))
'Catch ex As Exception
' FirstStartup.ShowDialog()
'End Try
2020-12-08 19:01:35 +01:00
'Dim Style As New MetroStyleManager
2020-12-10 19:18:20 +01:00
'
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
DarkModeValue = CBool ( Integer . Parse ( rkg . GetValue ( " Dark_Mode " ) . ToString ) )
Catch ex As Exception
2020-12-08 19:01:35 +01:00
2020-12-10 19:18:20 +01:00
End Try
2020-12-08 19:01:35 +01:00
Manager . Style = MetroColorStyle . Orange
2020-12-10 19:18:20 +01:00
If DarkModeValue = True Then
Manager . Theme = MetroThemeStyle . Dark
DarkMode ( )
Else
Manager . Theme = MetroThemeStyle . Light
LightMode ( )
End If
2020-12-08 19:01:35 +01:00
Me . StyleManager = Manager
Manager . Owner = Me
2020-08-16 23:27:48 +02:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
2021-02-12 13:44:17 +01:00
StartServer = Integer . Parse ( rkg . GetValue ( " ServerPort " ) . ToString )
2020-08-16 23:27:48 +02:00
Catch ex As Exception
End Try
2021-02-12 13:44:17 +01:00
If StartServer > 0 Then
2021-01-14 18:06:42 +01:00
Timer3 . Enabled = True
2021-01-16 14:08:33 +01:00
ServerThread = New Thread ( AddressOf ServerStart )
ServerThread . Priority = ThreadPriority . Normal
ServerThread . IsBackground = True
ServerThread . Start ( )
2020-06-01 18:43:38 +02:00
End If
2020-08-16 23:27:48 +02:00
2020-01-12 16:25:55 +01:00
waveOutSetVolume ( 0 , 0 )
Try
Dim FileLocation As DirectoryInfo = New DirectoryInfo ( Application . StartupPath )
For Each File In FileLocation . GetFiles ( )
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( File . FullName , " gecko-network.txt " ) ) Then
2020-01-12 16:25:55 +01:00
My . Computer . FileSystem . DeleteFile ( Path . Combine ( Application . StartupPath , File . FullName ) )
Exit For
End If
Next
Catch ex As Exception
End Try
2019-11-10 00:16:12 +01:00
ServicePointManager . Expect100Continue = True
ServicePointManager . SecurityProtocol = SecurityProtocolType . Tls12
2020-11-13 15:57:34 +01:00
Try
Me . Icon = My . Resources . icon
Catch ex As Exception
End Try
2019-11-22 19:12:42 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
Pfad = rkg . GetValue ( " Ordner " ) . ToString
Catch ex As Exception
End Try
2021-09-20 20:37:57 +02:00
2021-02-07 13:47:30 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
Episode_Prefix = rkg . GetValue ( " Prefix_E " ) . ToString
Catch ex As Exception
End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
Season_Prefix = rkg . GetValue ( " Prefix_S " ) . ToString
Catch ex As Exception
End Try
2021-02-20 18:25:49 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
DefaultSubFunimation = rkg . GetValue ( " DefaultSubFunimation " ) . ToString
Catch ex As Exception
End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
DefaultSubCR = rkg . GetValue ( " DefaultSubCR " ) . ToString
Catch ex As Exception
End Try
2019-12-22 16:15:17 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
Startseite = rkg . GetValue ( " Startseite " ) . ToString
Catch ex As Exception
End Try
2019-11-10 00:16:12 +01:00
#Region "Startup IU"
StatusToolTip . Active = True
#End Region
2020-02-28 16:28:38 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
UseQueue = CBool ( Integer . Parse ( rkg . GetValue ( " QueueMode " ) . ToString ) )
2020-12-18 13:47:55 +01:00
'MsgBox(UseQueue.ToString)
2020-02-28 16:28:38 +01:00
Catch ex As Exception
2019-11-10 00:16:12 +01:00
2020-02-28 16:28:38 +01:00
End Try
2021-05-23 22:27:56 +02:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
KodiNaming = CBool ( Integer . Parse ( rkg . GetValue ( " KodiSupport " ) . ToString ) )
Catch ex As Exception
2019-11-10 00:16:12 +01:00
2021-07-04 17:22:46 +02:00
End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
KeepCache = CBool ( Integer . Parse ( rkg . GetValue ( " Keep_Cache " ) . ToString ) )
Catch ex As Exception
2021-05-23 22:27:56 +02:00
End Try
2020-02-12 22:08:02 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
ffmpeg_command = rkg . GetValue ( " ffmpeg_command " ) . ToString
Catch ex As Exception
ffmpeg_command = " -c copy -bsf:a aac_adtstoasc "
End Try
2019-11-10 00:16:12 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
2020-11-13 15:57:34 +01:00
Reso = Integer . Parse ( rkg . GetValue ( " Resu " ) . ToString )
2019-11-10 00:16:12 +01:00
'MsgBox(Resu)
Catch ex As Exception
End Try
2020-11-13 15:57:34 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
AoD_Reso = Integer . Parse ( rkg . GetValue ( " AoD_Reso " ) . ToString )
Catch ex As Exception
AoD_Reso = 0
End Try
2019-11-10 00:16:12 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
SubSprache = rkg . GetValue ( " Sub " ) . ToString
Catch ex As Exception
End Try
2020-11-19 22:28:42 +01:00
'Try
' Dim rkg As RegistryKey = Registry.CurrentUser.OpenSubKey("Software\CRDownloader")
' SubFunimation = rkg.GetValue("Fun_Sub").ToString
'Catch ex As Exception
'End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
SubFunimationString = rkg . GetValue ( " Fun_Sub " ) . ToString
If SubFunimationString = " none " Then
Else
Dim SoftSubsStringSplit ( ) As String = SubFunimationString . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
For i As Integer = 0 To SoftSubsStringSplit . Count - 1
SubFunimation . Add ( SoftSubsStringSplit ( i ) )
Next
End If
Catch ex As Exception
If SubFunimation . Count = 0 Then
SubFunimation . Add ( " en " )
End If
End Try
2019-11-10 00:16:12 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
2020-12-02 21:01:30 +01:00
SubFolder_Value = rkg . GetValue ( " SubFolder_Value " ) . ToString
2019-11-10 00:16:12 +01:00
Catch ex As Exception
2020-12-02 21:01:30 +01:00
SubFolder_Value = SubFolder_Nothing
2019-11-10 00:16:12 +01:00
End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
MaxDL = Integer . Parse ( rkg . GetValue ( " SL_DL " ) . ToString )
Catch ex As Exception
MaxDL = 1
End Try
2020-11-05 20:43:52 +01:00
2020-11-21 14:56:27 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
CR_NameMethode = Integer . Parse ( rkg . GetValue ( " CR_NameMethode " ) . ToString )
Catch ex As Exception
CR_NameMethode = 0
End Try
2020-11-05 20:43:52 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
ErrorTolerance = Integer . Parse ( rkg . GetValue ( " ErrorTolerance " ) . ToString )
Catch ex As Exception
ErrorTolerance = 0
End Try
2020-02-02 16:39:54 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
2021-03-08 21:08:26 +01:00
MergeSubs = CBool ( Integer . Parse ( rkg . GetValue ( " MergeSubs " ) . ToString ) )
2020-02-02 16:39:54 +01:00
Catch ex As Exception
2021-03-08 21:08:26 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
MergeSubs = CBool ( Integer . Parse ( rkg . GetValue ( " MergeMP4 " ) . ToString ) )
Catch ex2 As Exception
End Try
End Try
2021-09-20 20:37:57 +02:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
IncludeLangName = CBool ( Integer . Parse ( rkg . GetValue ( " IncludeLangName " ) . ToString ) )
Catch ex As Exception
End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
IgnoreS1 = CBool ( Integer . Parse ( rkg . GetValue ( " IgnoreS1 " ) . ToString ) )
Catch ex As Exception
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
IgnoreS1 = CBool ( Integer . Parse ( rkg . GetValue ( " IgnoreS1 " ) . ToString ) )
Catch ex2 As Exception
End Try
End Try
2021-03-08 21:08:26 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
Dim Format As String = rkg . GetValue ( " VideoFormat " ) . ToString
If Format = " .mkv " Then
VideoFormat = " .mkv "
MergeSubsFormat = " copy "
2021-06-04 15:25:59 +02:00
ElseIf Format = " .aac " Then
VideoFormat = " .aac "
MergeSubsFormat = " copy "
2021-03-08 21:08:26 +01:00
End If
Catch ex2 As Exception
2020-02-02 16:39:54 +01:00
2020-09-30 18:19:31 +02:00
End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
HybridMode = CBool ( Integer . Parse ( rkg . GetValue ( " HybridMode " ) . ToString ) )
Catch ex As Exception
2020-11-21 14:56:27 +01:00
End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
Funimation_srt = CBool ( Integer . Parse ( rkg . GetValue ( " Funimation_srt " ) . ToString ) )
Catch ex As Exception
End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
Funimation_vtt = CBool ( Integer . Parse ( rkg . GetValue ( " Funimation_vtt " ) . ToString ) )
Catch ex As Exception
End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
Funimation_dfxp = CBool ( Integer . Parse ( rkg . GetValue ( " Funimation_dfxp " ) . ToString ) )
Catch ex As Exception
2020-09-30 18:19:31 +02:00
End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
2020-11-19 22:28:42 +01:00
HardSubFunimation = rkg . GetValue ( " FunimationHardsub " ) . ToString
Catch ex As Exception
End Try
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
DubFunimation = rkg . GetValue ( " FunimationDub " ) . ToString
2020-09-30 18:19:31 +02:00
Catch ex As Exception
2020-06-10 17:34:27 +02:00
End Try
2020-01-31 16:00:49 +01:00
#Region "removed softsubtitle"
2020-01-31 16:30:08 +01:00
Try
Dim rkg As RegistryKey = Registry . CurrentUser . OpenSubKey ( " Software\CRDownloader " )
SoftSubsString = rkg . GetValue ( " AddedSubs " ) . ToString
If SoftSubsString = " none " Then
Else
Dim SoftSubsStringSplit ( ) As String = SoftSubsString . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
For i As Integer = 0 To SoftSubsStringSplit . Count - 1
SoftSubs . Add ( SoftSubsStringSplit ( i ) )
Next
End If
Catch ex As Exception
End Try
2019-11-10 00:16:12 +01:00
2020-01-31 16:00:49 +01:00
#End Region
2019-11-10 00:16:12 +01:00
2020-11-13 15:57:34 +01:00
If Reso = Nothing Then
Reso = 1080
2019-11-10 00:16:12 +01:00
End If
If SubSprache = Nothing Then
SubSprache = " enUS "
End If
2021-04-05 19:08:42 +02:00
BlockList = New List ( Of String )
BackgroundWorker1 . RunWorkerAsync ( )
2021-07-04 17:22:46 +02:00
RetryWithCachedFiles ( )
2021-09-20 20:37:57 +02:00
2021-04-05 19:08:42 +02:00
End Sub
Private Sub BackgroundWorker1_DoWork ( sender As Object , e As DoWorkEventArgs ) Handles BackgroundWorker1 . DoWork
Try
Dim fileEntries As String ( ) = Directory . GetFiles ( Application . StartupPath + " \AdBlock " , " *.txt " )
' Process the list of .txt files found in the directory. '
Dim fileName As String
For Each fileName In fileEntries
If ( System . IO . File . Exists ( fileName ) ) Then
BlockList . AddRange ( System . IO . File . ReadAllLines ( fileName ) . OrderBy ( Function ( x ) Asc ( x ) ) . ToList )
End If
Next
Catch ex As Exception
End Try
2019-11-10 00:16:12 +01:00
End Sub
2020-12-10 19:18:20 +01:00
Public Sub ListItemAdd ( ByVal NameKomplett As String , ByVal NameP1 As String , ByVal NameP2 As String , ByVal Reso As String , ByVal HardSub As String , ByVal SoftSubs As String , ByVal ThumbnialURL As String , ByVal URL_DL As String , ByVal Pfad_DL As String , Optional Service As String = " CR " ) ', ByVal AudioLang As String)
2020-08-16 23:27:48 +02:00
Dim Thumbnail As Image = My . Resources . main_del
2021-09-20 20:37:57 +02:00
Debug . WriteLine ( " ThumbnialURL: " + ThumbnialURL )
2020-08-16 23:27:48 +02:00
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)
2021-09-20 20:37:57 +02:00
2020-08-16 23:27:48 +02:00
End Try
2021-09-20 20:37:57 +02:00
With ListView1 . Items . Add ( " 0 " )
2021-07-04 17:22:46 +02:00
ItemConstructor ( NameKomplett , NameP1 , NameP2 , Reso , HardSub , SoftSubs , Thumbnail , URL_DL , Pfad_DL , Service )
2020-08-16 23:27:48 +02:00
End With
2019-11-10 00:16:12 +01:00
End Sub
2021-07-04 17:22:46 +02:00
Public Sub ItemConstructor ( ByVal NameKomplett As String , ByVal NameP1 As String , ByVal NameP2 As String , ByVal DisplayReso As String , ByVal HardSub As String , ByVal SoftSubs As String , ByVal Thumbnail As Image , ByVal URL_DL As String , ByVal Pfad_DL As String , ByVal Service As String )
2020-08-16 23:27:48 +02:00
Dim Item As New CRD_List_Item
Item . Visible = False
Item . Parent = ListView1
Item . Width = 838
Item . Height = 142
#Region "Set Variables"
2020-08-27 13:25:28 +02:00
'Item.SetUsedMap(UsedMap)
2021-06-04 15:25:59 +02:00
'Item.Setffmpeg_command(ffmpeg_command)
2021-07-04 17:22:46 +02:00
Item . SetCache ( KeepCache )
2021-03-08 21:08:26 +01:00
Item . SetMergeSubstoMP4 ( MergeSubs )
2020-08-16 23:27:48 +02:00
Item . SetDebug2 ( Debug2 )
2021-03-08 21:08:26 +01:00
2020-08-16 23:27:48 +02:00
#End Region
2019-11-10 00:16:12 +01:00
Dim r As Rectangle
Dim c As Integer = ListView1 . Items . Count - 1
2020-08-16 23:27:48 +02:00
r = ListView1 . Items ( c ) . Bounds ( )
r . Width = 838
r . Height = 142
2020-12-10 19:18:20 +01:00
Item . SetService ( Service )
2020-11-05 20:43:52 +01:00
Item . SetTolerance ( ErrorTolerance )
2020-11-13 15:57:34 +01:00
Item . SetTargetReso ( Reso )
2020-08-16 23:27:48 +02:00
Item . SetLabelWebsite ( NameP1 )
Item . SetLabelAnimeTitel ( NameP2 )
2020-11-13 15:57:34 +01:00
Item . SetLabelResolution ( DisplayReso )
2020-08-16 23:27:48 +02:00
Item . SetLabelHardsub ( HardSub )
Item . SetThumbnailImage ( Thumbnail )
Item . SetLabelPercent ( " 0% " )
Item . SetToolTip ( " Softsubs: " + SoftSubs )
'MsgBox(Item.GetTextBound.ToString)
ItemList . Add ( Item )
Item . SetBounds ( r . X , r . Y , r . Width , r . Height )
'Item.SetLocations(r.Y)
'MsgBox("test " + r.Y.ToString)
Item . Visible = True
2020-12-18 13:47:55 +01:00
Dim TempHybridMode As Boolean = HybridMode
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( URL_DL , " .mpd " ) ) Then
2020-12-18 13:47:55 +01:00
TempHybridMode = False
End If
2021-09-20 20:37:57 +02:00
'MsgBox(URL_DL + vbNewLine + Pfad_DL + vbNewLine + NameKomplett + vbNewLine + TempHybridMode.ToString)
2021-07-04 17:22:46 +02:00
Item . StartDownload ( URL_DL , Pfad_DL , NameKomplett , TempHybridMode )
2019-11-10 00:16:12 +01:00
End Sub
2020-08-16 23:27:48 +02:00
#Region "Manga DL"
Public Sub MangaListItemAdd ( ByVal NameP2 As String , ByVal ThumbnialURL As String , ByVal BaseURL As String , ByVal SiteList As List ( Of String ) )
Dim Thumbnail As Image = My . Resources . main_del
Try
Dim wc As New WebClient ( )
2020-12-10 19:18:20 +01:00
wc . Headers . Add ( My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) )
2020-08-16 23:27:48 +02:00
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)
'MsgBox(ThumbnialURL)
End Try
2021-09-20 20:37:57 +02:00
With ListView1 . Items . Add ( " 0 " )
2020-08-16 23:27:48 +02:00
MangaItemConstructor ( " proxer.me " , NameP2 , Thumbnail , BaseURL , SiteList )
End With
2019-11-10 00:16:12 +01:00
End Sub
2020-08-16 23:27:48 +02:00
Public Sub MangaItemConstructor ( ByVal NameP1 As String , ByVal NameP2 As String , ByVal Thumbnail As Image , ByVal BaseURL As String , ByVal SiteList As List ( Of String ) )
Dim Item As New CRD_List_Item
Item . Visible = False
Item . Parent = ListView1
Item . Width = 838
Item . Height = 142
#Region "Set Variables"
Item . SetDebug2 ( Debug2 )
#End Region
2019-11-10 00:16:12 +01:00
Dim r As Rectangle
Dim c As Integer = ListView1 . Items . Count - 1
2020-08-16 23:27:48 +02:00
r = ListView1 . Items ( c ) . Bounds ( )
2019-11-10 00:16:12 +01:00
r . Width = 838
r . Height = 142
2020-08-16 23:27:48 +02:00
Item . SetLabelWebsite ( NameP1 )
Item . SetLabelAnimeTitel ( NameP2 )
Item . SetLabelResolution ( " Manga " )
Item . SetLabelHardsub ( " Manga " )
Item . SetThumbnailImage ( Thumbnail )
Item . SetLabelPercent ( " 0% " )
'MsgBox(Item.GetTextBound.ToString)
ItemList . Add ( Item )
Item . SetBounds ( r . X , r . Y , r . Width , r . Height )
'Item.SetLocations(r.Y)
'MsgBox("test " + r.Y.ToString)
Item . Visible = True
Item . DownloadMangaPages ( Pfad , BaseURL , SiteList , NameP2 )
End Sub
#End Region
2019-11-10 00:16:12 +01:00
#Region "Season DL"
Public Sub MassGrapp ( )
Anime_Add . groupBox2 . Visible = True
Anime_Add . PictureBox1 . Enabled = True
Anime_Add . PictureBox1 . Visible = True
Anime_Add . groupBox1 . Visible = False
2019-11-17 21:15:06 +01:00
Anime_Add . ComboBox1 . Items . Clear ( )
2019-11-10 00:16:12 +01:00
Anime_Add . comboBox3 . Items . Clear ( )
Anime_Add . comboBox4 . Items . Clear ( )
2021-03-08 21:08:26 +01:00
Anime_Add . ComboBox1 . Text = Nothing
Anime_Add . comboBox3 . Text = Nothing
Anime_Add . comboBox4 . Text = Nothing
2019-11-17 21:15:06 +01:00
Anime_Add . ComboBox1 . Enabled = False
2019-11-10 00:16:12 +01:00
Anime_Add . comboBox3 . Enabled = True
Anime_Add . comboBox4 . Enabled = True
Dim Anzahl As String ( ) = WebbrowserText . Split ( New String ( ) { " wrapper container-shadow hover-classes " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Titel As String ( ) = Anzahl ( 0 ) . Split ( New String ( ) { " <meta content= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Titel2 As String ( ) = Titel ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
'Label10.Text = Titel2(0)
Dim c As Integer = Anzahl . Count - 1
' FolgenZahl.Text = c.ToString + " Folgen gefunden."
Array . Reverse ( Anzahl )
For i As Integer = 0 To Anzahl . Count - 2
Dim URLGrapp As String ( ) = Anzahl ( i ) . Split ( New String ( ) { " title= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
'MsgBox("1" + Chr(34))
Dim URLGrapp2 As String ( ) = URLGrapp ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Anime_Add . comboBox3 . Items . Add ( URLGrapp2 ( 0 ) )
Anime_Add . comboBox4 . Items . Add ( URLGrapp2 ( 0 ) )
Next
End Sub
Public Sub SeasonDropdownGrapp ( )
Anime_Add . groupBox2 . Visible = True
Anime_Add . PictureBox1 . Enabled = True
Anime_Add . PictureBox1 . Visible = True
Anime_Add . groupBox1 . Visible = False
Anime_Add . ComboBox1 . Items . Clear ( )
Anime_Add . comboBox3 . Items . Clear ( )
Anime_Add . comboBox4 . Items . Clear ( )
2021-03-08 21:08:26 +01:00
Anime_Add . ComboBox1 . Text = Nothing
Anime_Add . comboBox3 . Text = Nothing
Anime_Add . comboBox4 . Text = Nothing
2019-11-10 00:16:12 +01:00
Anime_Add . ComboBox1 . Enabled = True
2021-03-08 21:08:26 +01:00
Anime_Add . comboBox3 . Enabled = False
Anime_Add . comboBox4 . Enabled = False
2019-11-10 00:16:12 +01:00
Dim Anzahl As String ( ) = WebbrowserText . Split ( New String ( ) { " season-dropdown content-menu block " } , System . StringSplitOptions . RemoveEmptyEntries )
Array . Reverse ( Anzahl )
For i As Integer = 0 To Anzahl . Count - 2
Dim Titel As String ( ) = Anzahl ( i ) . Split ( New String ( ) { " </a> " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Titel2 As String ( ) = Titel ( 0 ) . Split ( New String ( ) { " > " } , System . StringSplitOptions . RemoveEmptyEntries )
'MsgBox(Titel2(0))
Anime_Add . ComboBox1 . Items . Add ( Titel2 ( 1 ) )
Next
End Sub
Public Async Sub MassDL ( )
If Anime_Add . comboBox3 . Text = Nothing Then
Exit Sub
End If
Anime_Add . Add_Display . Text = " preparing ... "
Dim Website As String = WebbrowserText
If Anime_Add . ComboBox1 . Enabled = True Then
Dim SeasonDropdownAnzahl As String ( ) = Website . Split ( New String ( ) { " season-dropdown content-menu block " } , System . StringSplitOptions . RemoveEmptyEntries )
Array . Reverse ( SeasonDropdownAnzahl )
Dim SDV As Integer = 0
For i As Integer = 0 To SeasonDropdownAnzahl . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( SeasonDropdownAnzahl ( i ) , Chr ( 34 ) + " > " + Anime_Add . ComboBox1 . SelectedItem . ToString + " </a> " ) ) Then
2019-11-10 00:16:12 +01:00
SDV = i
End If
Next
Website = SeasonDropdownAnzahl ( SDV )
End If
Try
Dim Anzahl As String ( ) = Website . Split ( New String ( ) { " wrapper container-shadow hover-classes " } , System . StringSplitOptions . RemoveEmptyEntries )
Array . Reverse ( Anzahl )
2020-02-14 17:22:54 +01:00
Dim c As Integer = 0
2019-11-10 00:16:12 +01:00
Aktuell = " 0 "
2020-02-14 17:22:54 +01:00
If Anime_Add . comboBox4 . SelectedIndex > Anime_Add . comboBox3 . SelectedIndex Or Anime_Add . comboBox4 . SelectedIndex = Anime_Add . comboBox3 . SelectedIndex Then
c = Anime_Add . comboBox4 . SelectedIndex - Anime_Add . comboBox3 . SelectedIndex + 1
Else
Dim TempCB3 As Integer = Anime_Add . comboBox3 . SelectedIndex
Dim TempCB4 As Integer = Anime_Add . comboBox4 . SelectedIndex
Anime_Add . comboBox3 . SelectedIndex = TempCB4
Anime_Add . comboBox4 . SelectedIndex = TempCB3
c = Anime_Add . comboBox4 . SelectedIndex - Anime_Add . comboBox3 . SelectedIndex + 1
End If
Gesamt = c . ToString
For i As Integer = Anime_Add . comboBox3 . SelectedIndex To Anime_Add . comboBox4 . SelectedIndex
2019-11-10 00:16:12 +01:00
2020-02-20 21:39:47 +01:00
For e As Integer = 0 To Integer . MaxValue
2020-06-01 18:43:38 +02:00
'FontLabel.Visible = True
2020-08-16 23:27:48 +02:00
'FontLabel.Text = RunningDownloads
2020-02-20 21:39:47 +01:00
If Grapp_RDY = True Then
2021-01-22 22:45:01 +01:00
Try
Dim ItemFinshedCount As Integer = 0
For i2 As Integer = 0 To ListView1 . Items . Count - 1
If ItemList ( i2 ) . GetIsStatusFinished ( ) = True Then
ItemFinshedCount = ItemFinshedCount + 1
End If
Next
RunningDownloads = ListView1 . Items . Count - ItemFinshedCount
Catch ex As Exception
RunningDownloads = ListView1 . Items . Count
End Try
2020-08-16 23:27:48 +02:00
If RunningDownloads < MaxDL Then
2020-02-20 21:39:47 +01:00
Exit For
2019-11-10 00:16:12 +01:00
Else
2020-02-20 21:39:47 +01:00
'MsgBox(e)
2020-12-18 13:47:55 +01:00
Await Task . Delay ( 1000 )
2019-11-10 00:16:12 +01:00
End If
2020-02-20 21:39:47 +01:00
Else
2020-12-18 13:47:55 +01:00
Await Task . Delay ( 5000 )
2020-02-14 17:22:54 +01:00
End If
2020-02-02 16:39:54 +01:00
Next
2020-02-20 21:39:47 +01:00
If Anime_Add . Mass_DL_Cancel = False Then
b = True
Exit For
Grapp_Abord = True
'MsgBox("dl_abourd")
End If
Dim d As Integer = i - Anime_Add . comboBox3 . SelectedIndex + 1
Dim URLGrapp As String ( ) = Anzahl ( i ) . Split ( New String ( ) { " <a href= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim URLGrapp2 As String ( ) = URLGrapp ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
If Debug2 = True Then
MsgBox ( " https://www.crunchyroll.com " + URLGrapp2 ( 0 ) )
End If
2020-02-28 16:28:38 +01:00
If UseQueue = True Then
Anime_Add . ListBox1 . Items . Add ( " https://www.crunchyroll.com " + URLGrapp2 ( 0 ) )
Anime_Add . Add_Display . ForeColor = Color . FromArgb ( 9248044 )
Pause ( 1 )
Anime_Add . Add_Display . ForeColor = Color . Black
Else
Grapp_RDY = False
b = False
2021-09-20 20:37:57 +02:00
Navigate ( " https://www.crunchyroll.com " + URLGrapp2 ( 0 ) )
2020-02-28 16:28:38 +01:00
End If
2020-02-20 21:39:47 +01:00
Aktuell = d . ToString
Anime_Add . Add_Display . Text = Aktuell + " / " + Gesamt
Next
2020-02-02 16:39:54 +01:00
Catch ex As Exception
2020-02-14 17:22:54 +01:00
If Debug2 = True Then
MsgBox ( ex . ToString )
End If
2020-02-02 16:39:54 +01:00
Anime_Add . comboBox4 . Items . Clear ( )
Anime_Add . comboBox3 . Items . Clear ( )
Aktuell = 0 . ToString
Gesamt = 0 . ToString
Anime_Add . groupBox1 . Visible = True
Anime_Add . groupBox2 . Visible = False
Anime_Add . GroupBox3 . Visible = False
Anime_Add . Mass_DL_Cancel = False
2021-09-20 20:37:57 +02:00
Anime_Add . btn_dl . Text = " Download " 'Anime_Add.btn_dl.BackgroundImage = My.Resources.main_button_download_default
2020-02-02 16:39:54 +01:00
End Try
Pause ( 5 )
Anime_Add . groupBox1 . Visible = True
Anime_Add . groupBox2 . Visible = False
Anime_Add . GroupBox3 . Visible = False
Anime_Add . Mass_DL_Cancel = False
2021-09-20 20:37:57 +02:00
Anime_Add . btn_dl . Text = " Download " ' Anime_Add.btn_dl.BackgroundImage = My.Resources.main_button_download_default
2020-02-02 16:39:54 +01:00
End Sub
#End Region
2019-11-10 00:16:12 +01:00
#Region "Sub to display"
Public Function SubValuesToDisplay ( ) As String
Try
Dim deDE As Boolean = False
Dim enUS As Boolean = False
Dim ptBR As Boolean = False
Dim esLA As Boolean = False
Dim frFR As Boolean = False
Dim arME As Boolean = False
Dim ruRU As Boolean = False
Dim itIT As Boolean = False
Dim esES As Boolean = False
Dim ListReturn As String = Nothing
For i As Integer = 0 To SoftSubs . Count - 1
If SoftSubs ( i ) = " deDE " Then
deDE = True
ElseIf SoftSubs ( i ) = " enUS " Then
enUS = True
ElseIf SoftSubs ( i ) = " ptBR " Then
ptBR = True
ElseIf SoftSubs ( i ) = " esLA " Then
esLA = True
ElseIf SoftSubs ( i ) = " frFR " Then
frFR = True
ElseIf SoftSubs ( i ) = " arME " Then
arME = True
ElseIf SoftSubs ( i ) = " ruRU " Then
ruRU = True
ElseIf SoftSubs ( i ) = " itIT " Then
itIT = True
ElseIf SoftSubs ( i ) = " esES " Then
esES = True
End If
Next
If deDE = True Then
If ListReturn = Nothing Then
ListReturn = " Deutsch "
Else
ListReturn = ListReturn + " , Deutsch "
End If
End If
If enUS = True Then
If ListReturn = Nothing Then
ListReturn = " English "
Else
ListReturn = ListReturn + " , English "
End If
End If
If esLA = True Then
If ListReturn = Nothing Then
ListReturn = " Español (LA) "
Else
ListReturn = ListReturn + " , Español (LA) "
End If
End If
If ptBR = True Then
If ListReturn = Nothing Then
ListReturn = " Português (Brasil) "
Else
ListReturn = ListReturn + " , Português (Brasil) "
End If
End If
If frFR = True Then
If ListReturn = Nothing Then
ListReturn = " Français (France) "
Else
ListReturn = ListReturn + " , Français (France) "
End If
End If
If arME = True Then
If ListReturn = Nothing Then
ListReturn = " العربية (Arabic) "
Else
ListReturn = ListReturn + " , العربية (Arabic) "
End If
End If
If ruRU = True Then
If ListReturn = Nothing Then
ListReturn = " Русский (Russian) "
Else
ListReturn = ListReturn + " , Русский (Russian) "
End If
End If
If itIT = True Then
If ListReturn = Nothing Then
ListReturn = " Italiano (Italian) "
Else
ListReturn = ListReturn + " , Italiano (Italian) "
End If
End If
If esES = True Then
If ListReturn = Nothing Then
ListReturn = " Español (España) "
Else
ListReturn = ListReturn + " , Español (España) "
End If
End If
Return ListReturn
Catch ex As Exception
Return Nothing
End Try
End Function
Public Function HardSubValuesToDisplay ( ByVal HardSub As String ) As String
Try
2021-04-05 19:08:42 +02:00
If HardSub = " deDE " Then
2019-11-10 00:16:12 +01:00
Return " Deutsch "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " enUS " Then
2019-11-10 00:16:12 +01:00
Return " English "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " ptBR " Then
2019-11-10 00:16:12 +01:00
Return " Português (Brasil) "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " esLA " Then
2019-11-10 00:16:12 +01:00
Return " Español (LA) "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " frFR " Then
2019-11-10 00:16:12 +01:00
Return " Français (France) "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " arME " Then
2019-11-10 00:16:12 +01:00
Return " العربية (Arabic) "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " ruRU " Then
2019-11-10 00:16:12 +01:00
Return " Русский (Russian) "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " itIT " Then
2019-11-10 00:16:12 +01:00
Return " Italiano (Italian) "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " esES " Then
2019-11-10 00:16:12 +01:00
Return " Español (España) "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " jaJP " Then
2020-11-19 22:28:42 +01:00
Return " Japanese "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " en " Then
2021-02-23 19:30:18 +01:00
Return " English "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " pt " Then
2021-02-23 19:30:18 +01:00
Return " Português (Brasil) "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " es " Then
2021-02-23 19:30:18 +01:00
Return " Español (LA) "
2021-04-05 19:08:42 +02:00
ElseIf HardSub = " de-DE " Then
Return " Deutsch "
ElseIf HardSub = " en-US " Then
Return " English "
ElseIf HardSub = " pt-BR " Then
Return " Português (Brasil) "
ElseIf HardSub = " es-LA " Then
Return " Español (LA) "
ElseIf HardSub = " fr-FR " Then
Return " Français (France) "
ElseIf HardSub = " ar-ME " Then
Return " العربية (Arabic) "
ElseIf HardSub = " ru-RU " Then
Return " Русский (Russian) "
ElseIf HardSub = " it-IT " Then
Return " Italiano (Italian) "
ElseIf HardSub = " es-ES " Then
Return " Español (España) "
ElseIf HardSub = " ja-JP " Then
Return " Japanese "
2020-10-07 22:40:58 +02:00
Else
Return CB_SuB_Nothing
2019-11-10 00:16:12 +01:00
End If
Catch ex As Exception
Return Nothing
End Try
End Function
2020-02-02 16:39:54 +01:00
Public Function CCtoMP4CC ( ByVal HardSub As String ) As String
2021-04-24 20:51:34 +02:00
2020-02-02 16:39:54 +01:00
Try
2021-05-23 22:27:56 +02:00
If HardSub = " deDE " Or HardSub = " de-DE " Then
2020-02-02 16:39:54 +01:00
Return " ger "
2021-05-23 22:27:56 +02:00
ElseIf HardSub = " enUS " Or HardSub = " en-US " Or HardSub = " en " Then
2020-02-02 16:39:54 +01:00
Return " eng "
2021-05-23 22:27:56 +02:00
ElseIf HardSub = " ptBR " Or HardSub = " pt-BR " Or HardSub = " pt " Then
2020-02-02 16:39:54 +01:00
Return " por "
2021-05-23 22:27:56 +02:00
ElseIf HardSub = " esLA " Or HardSub = " es-LA " Or HardSub = " es " Then
2020-02-02 16:39:54 +01:00
Return " spa "
2021-05-23 22:27:56 +02:00
ElseIf HardSub = " frFR " Or HardSub = " fr-FR " Then
2020-02-02 16:39:54 +01:00
Return " fre "
2021-05-23 22:27:56 +02:00
ElseIf HardSub = " arME " Or HardSub = " ar-ME " Then
2020-02-02 16:39:54 +01:00
Return " ara "
2021-05-23 22:27:56 +02:00
ElseIf HardSub = " ruRU " Or HardSub = " ru-RU " Then
2020-02-02 16:39:54 +01:00
Return " rus "
2021-05-23 22:27:56 +02:00
ElseIf HardSub = " itIT " Or HardSub = " it-IT " Then
2020-02-02 16:39:54 +01:00
Return " ita "
2021-05-23 22:27:56 +02:00
ElseIf HardSub = " esES " Or HardSub = " es-ES " Then
2020-02-02 16:39:54 +01:00
Return " spa "
2021-05-23 22:27:56 +02:00
ElseIf HardSub = " jaJP " Or HardSub = " ja-JP " Then
2020-08-27 14:01:05 +02:00
Return " jpn "
2021-04-05 19:08:42 +02:00
Else
Return " chi "
2020-02-02 16:39:54 +01:00
End If
2021-04-05 19:08:42 +02:00
2020-02-02 16:39:54 +01:00
Catch ex As Exception
Return Nothing
End Try
End Function
2019-11-10 00:16:12 +01:00
#End Region
Public Sub GrappURL ( )
2020-06-01 18:43:38 +02:00
2019-11-10 00:16:12 +01:00
Try
2020-01-02 15:13:38 +01:00
'Throw New System.Exception("Test")
2021-06-04 15:25:59 +02:00
Dim ffmpeg_command_temp As String = ffmpeg_command
If VideoFormat = " .aac " Then
Dim ffmpeg_command_Builder ( ) As String = ffmpeg_command . Split ( New String ( ) { " -c:a copy " } , System . StringSplitOptions . RemoveEmptyEntries )
ffmpeg_command_temp = " -c:a copy " + ffmpeg_command_Builder ( 1 )
End If
2019-11-10 00:16:12 +01:00
Grapp_RDY = False
Dim CR_Anime_Titel As String = Nothing
2020-08-27 13:25:28 +02:00
Dim CR_Anime_Dub As String = Nothing
2019-11-10 00:16:12 +01:00
Dim CR_Anime_Staffel As String = Nothing
Dim CR_Anime_Folge As String = Nothing
2020-11-21 14:56:27 +01:00
Dim CR_Anime_Name As String = Nothing
2021-02-07 13:47:30 +01:00
Dim CR_Anime_Staffel_int As String = Nothing
Dim CR_Anime_Folge_int As String = Nothing
2019-11-10 00:16:12 +01:00
#Region "Name + Pfad"
Dim Pfad2 As String
2020-01-02 15:13:38 +01:00
Dim TextBox2_Text As String = Nothing
2019-11-10 00:16:12 +01:00
Dim CR_FilenName As String = Nothing
2021-01-14 19:50:29 +01:00
2019-11-10 00:16:12 +01:00
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-02-07 13:47:30 +01:00
' My.Computer.Clipboard.SetText(WebbrowserText)
2020-01-02 15:13:38 +01:00
Return Nothing
End Function ) )
#Region "Name von Crunchyroll"
2020-12-02 21:01:30 +01:00
2020-08-16 23:27:48 +02:00
2020-12-03 19:29:44 +01:00
If CBool ( InStr ( WebbrowserText , " <h4> " ) ) Then ' false on movie true on series
Dim CR_Name_1 As String ( ) = WebbrowserText . Split ( New String ( ) { " <h4> " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim CR_Name_2 As String ( ) = CR_Name_1 ( 1 ) . Split ( New String ( ) { " </h4> " } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
Dim CR_Name_Staffel0_Folge1 As String ( )
If CBool ( InStr ( CR_Name_2 ( 0 ) , " , " ) ) Then
CR_Name_Staffel0_Folge1 = CR_Name_2 ( 0 ) . Split ( New [ Char ] ( ) { System . Convert . ToChar ( " , " ) } , System . StringSplitOptions . RemoveEmptyEntries )
CR_Anime_Staffel = CR_Name_Staffel0_Folge1 ( 0 ) . Trim ( )
2021-01-14 18:06:42 +01:00
CR_Anime_Folge = CR_Name_Staffel0_Folge1 ( 1 )
CR_Anime_Folge = String . Join ( " " , CR_Anime_Folge . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_Anime_Folge, "[^\w\\-]", " ")
2020-12-03 19:29:44 +01:00
Else
CR_Anime_Staffel = Nothing
CR_Anime_Folge = CR_Name_2 ( 0 ) . Trim ( )
2021-01-14 18:06:42 +01:00
'MsgBox(CR_Anime_Folge)
2020-01-02 15:13:38 +01:00
2021-01-14 18:06:42 +01:00
CR_Anime_Folge = String . Join ( " " , CR_Anime_Folge . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_Anime_Folge, "[^\w\\-]", " ")
2020-01-02 15:13:38 +01:00
2021-01-14 18:06:42 +01:00
End If
2020-12-03 19:29:44 +01:00
Dim CR_Name_4 As String ( ) = CR_Name_1 ( 0 ) . Split ( New String ( ) { " class= " + Chr ( 34 ) + " text-link " + Chr ( 34 ) + " > " } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
Dim CR_Name_Anime0 As String ( ) = CR_Name_4 ( CR_Name_4 . Length - 1 ) . Split ( New String ( ) { " </a> " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-01-14 18:06:42 +01:00
CR_Name_Anime0 ( 0 ) = String . Join ( " " , CR_Name_Anime0 ( 0 ) . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_Name_Anime0(0), "[^\w\\-]", " ")
2020-12-03 19:29:44 +01:00
CR_Anime_Titel = CR_Name_Anime0 ( 0 ) . Trim
2020-11-21 14:56:27 +01:00
2021-01-14 19:50:29 +01:00
'CR_FilenName_Backup = RemoveExtraSpaces(CR_FilenName)
2020-11-21 14:56:27 +01:00
2020-12-03 19:29:44 +01:00
End If
2021-02-07 13:47:30 +01:00
If CBool ( InStr ( WebbrowserText , My . Resources . CR_Episode_Nr ) ) Then
If CBool ( InStr ( WebbrowserText , My . Resources . CR_Episode_Nr + Chr ( 34 ) ) ) Then
Debug . WriteLine ( " No Episode Number in a movie " )
Else
Dim CR_Episode_1 As String ( ) = WebbrowserText . Split ( New String ( ) { My . Resources . CR_Episode_Nr } , System . StringSplitOptions . RemoveEmptyEntries )
Dim CR_Episode_2 As String ( ) = CR_Episode_1 ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
CR_Anime_Folge_int = String . Join ( " " , CR_Episode_2 ( 0 ) . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_Name_2(0), "[^\w\\-]", " ")
2021-05-23 22:27:56 +02:00
2021-02-07 13:47:30 +01:00
CR_Anime_Folge_int = RemoveExtraSpaces ( CR_Anime_Folge_int )
2021-03-08 21:08:26 +01:00
Dim CleanedNumber As String = Nothing
Dim myChars ( ) As Char = CR_Anime_Folge_int . ToCharArray ( )
For Each ch As Char In myChars
If Char . IsDigit ( ch ) Then
CleanedNumber = CleanedNumber + ch . ToString
ElseIf ch = " . " Then
CleanedNumber = CleanedNumber + ch . ToString
ElseIf ch = " , " Then
CleanedNumber = CleanedNumber + " . "
End If
Next
2021-05-23 22:27:56 +02:00
2021-03-08 21:08:26 +01:00
If CleanedNumber = Nothing Then
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( CleanedNumber , " . " ) ) Then
2021-03-08 21:08:26 +01:00
Dim Folge_Double As Double = Double . Parse ( CleanedNumber , CultureInfo . InvariantCulture )
2021-02-07 13:47:30 +01:00
If Folge_Double < 10 Then
CR_Anime_Folge_int = String . Format ( " {0:00.0} " , Folge_Double )
End If
2021-03-08 21:08:26 +01:00
ElseIf Integer . Parse ( CleanedNumber ) < 10 Then
CR_Anime_Folge_int = " 0 " + CleanedNumber
2021-02-07 13:47:30 +01:00
End If
2021-03-08 21:08:26 +01:00
End If
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( CR_Anime_Folge_int , " , " ) ) Then
2021-05-23 22:27:56 +02:00
CR_Anime_Folge_int = CR_Anime_Folge_int . Replace ( " , " , " . " )
End If
End If
2021-02-07 13:47:30 +01:00
If CBool ( InStr ( WebbrowserHeadText , My . Resources . CR_Season_Nr ) ) Then
If CBool ( InStr ( WebbrowserHeadText , My . Resources . CR_Season_Nr + Chr ( 34 ) ) ) Then
Debug . WriteLine ( " No Season Number in a movie " )
Else
Dim CR_Season_1 As String ( ) = WebbrowserHeadText . Split ( New String ( ) { My . Resources . CR_Season_Nr } , System . StringSplitOptions . RemoveEmptyEntries )
Dim CR_Season_2 As String ( ) = CR_Season_1 ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
CR_Anime_Staffel_int = String . Join ( " " , CR_Season_2 ( 0 ) . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_Name_2(0), "[^\w\\-]", " ")
CR_Anime_Staffel_int = RemoveExtraSpaces ( CR_Anime_Staffel_int )
End If
Else
2021-05-01 13:56:48 +02:00
2021-02-07 13:47:30 +01:00
Debug . WriteLine ( " Not found? " )
End If
2020-11-21 14:56:27 +01:00
2020-12-03 19:29:44 +01:00
If CBool ( InStr ( WebbrowserText , My . Resources . CR_MediaName ) ) = True Then ' And CBool(InStr(WebbrowserText, "”</h4>"))
Dim CR_Name_1 As String ( ) = WebbrowserText . Split ( New String ( ) { My . Resources . CR_MediaName } , System . StringSplitOptions . RemoveEmptyEntries )
Dim CR_Name_2 As String ( ) = CR_Name_1 ( 1 ) . Split ( New String ( ) { My . Resources . CR_MediaName2 } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
2021-01-14 18:06:42 +01:00
CR_Anime_Name = String . Join ( " " , CR_Name_2 ( 0 ) . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_Name_2(0), "[^\w\\-]", " ")
2020-12-03 19:29:44 +01:00
CR_Anime_Name = RemoveExtraSpaces ( CR_Anime_Name )
End If
2020-11-21 14:56:27 +01:00
2021-02-07 13:47:30 +01:00
If Season_Prefix = " [default season prefix] " Then
2020-11-21 14:56:27 +01:00
2021-02-07 13:47:30 +01:00
Else
If CR_Anime_Staffel_int = " 0 " Then
Else
CR_Anime_Staffel = Season_Prefix + CR_Anime_Staffel_int
2020-11-21 14:56:27 +01:00
End If
2021-02-07 13:47:30 +01:00
End If
If Episode_Prefix = " [default episode prefix] " Then
Else
CR_Anime_Folge = Episode_Prefix + CR_Anime_Folge_int
End If
If CR_Anime_Titel = Nothing Then
CR_FilenName = CR_Anime_Name
ElseIf CR_NameMethode = 0 Then
If CR_Anime_Staffel = Nothing Then
CR_FilenName = CR_Anime_Titel + " " + CR_Anime_Folge
Else
CR_FilenName = CR_Anime_Titel + " " + CR_Anime_Staffel + " " + CR_Anime_Folge
End If
ElseIf CR_NameMethode = 1 Then
If CR_Anime_Staffel = Nothing Then
CR_FilenName = CR_Anime_Titel + " " + CR_Anime_Name
Else
CR_FilenName = CR_Anime_Titel + " " + CR_Anime_Staffel + " " + CR_Anime_Name
End If
ElseIf CR_NameMethode = 2 Then
If CR_Anime_Staffel = Nothing Then
CR_FilenName = CR_Anime_Titel + " " + CR_Anime_Folge + " " + CR_Anime_Name
Else
CR_FilenName = CR_Anime_Titel + " " + CR_Anime_Staffel + " " + CR_Anime_Folge + " " + CR_Anime_Name
End If
ElseIf CR_NameMethode = 3 Then
If CR_Anime_Staffel = Nothing Then
CR_FilenName = CR_Anime_Titel + " " + CR_Anime_Name + " " + CR_Anime_Folge
Else
CR_FilenName = CR_Anime_Titel + " " + CR_Anime_Name + " " + CR_Anime_Staffel + " " + CR_Anime_Folge
End If
End If
2021-05-23 22:27:56 +02:00
If KodiNaming = True Then
Dim KodiString As String = " [S "
If CR_Anime_Staffel_int = " 0 " Then
CR_Anime_Staffel_int = " 01 "
Else
CR_Anime_Staffel_int = " 0 " + CR_Anime_Staffel_int
End If
KodiString = KodiString + CR_Anime_Staffel_int + " E " + CR_Anime_Folge_int
KodiString = KodiString + " ] "
CR_FilenName = KodiString + CR_FilenName
End If
2021-04-24 20:51:34 +02:00
'MsgBox(CR_FilenName)
2020-01-02 15:13:38 +01:00
2019-11-10 00:16:12 +01:00
2020-01-02 15:13:38 +01:00
#End Region
2021-08-07 23:49:09 +02:00
If TextBox2_Text = Nothing Or TextBox2_Text = " Use Custom Name " Then
2019-11-10 00:16:12 +01:00
2020-01-02 15:13:38 +01:00
Else
2021-01-14 18:06:42 +01:00
CR_FilenName = RemoveExtraSpaces ( String . Join ( " " , TextBox2_Text . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) ) 'System.Text.RegularExpressions.Regex.Replace(TextBox2_Text, "[^\w\\-]", " "))
2021-01-14 19:50:29 +01:00
2019-11-10 00:16:12 +01:00
End If
2021-05-01 13:56:48 +02:00
If CR_FilenName = Nothing Then
CR_FilenName = WebbrowserTitle
End If
2021-01-14 18:06:42 +01:00
CR_FilenName = String . Join ( " " , CR_FilenName . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_FilenName, "[^\w\\-]", " ")
2019-11-10 00:16:12 +01:00
CR_FilenName = RemoveExtraSpaces ( CR_FilenName )
2020-12-02 21:01:30 +01:00
2021-01-14 19:50:29 +01:00
'My.Computer.FileSystem.WriteAllText("log.log", WebbrowserText, False)
2021-01-14 18:06:42 +01:00
2020-12-02 21:01:30 +01:00
Pfad2 = UseSubfolder ( CR_Anime_Titel , CR_Anime_Staffel , Pfad )
2019-11-10 00:16:12 +01:00
If Not Directory . Exists ( Path . GetDirectoryName ( Pfad2 ) ) Then
' Nein! Jetzt erstellen...
Try
Directory . CreateDirectory ( Path . GetDirectoryName ( Pfad2 ) )
2021-04-05 19:08:42 +02:00
Pfad2 = Chr ( 34 ) + Pfad2 + CR_FilenName + VideoFormat + Chr ( 34 )
2019-11-10 00:16:12 +01:00
Catch ex As Exception
' Ordner wurde nich erstellt
2021-07-04 17:22:46 +02:00
Pfad2 = Chr ( 34 ) + Pfad + CR_FilenName + VideoFormat + Chr ( 34 )
2019-11-10 00:16:12 +01:00
End Try
2021-04-24 20:51:34 +02:00
Else
Pfad2 = Chr ( 34 ) + Pfad2 + CR_FilenName + VideoFormat + Chr ( 34 )
2019-11-10 00:16:12 +01:00
End If
2020-12-02 21:01:30 +01:00
2020-12-03 19:29:44 +01:00
2019-11-10 00:16:12 +01:00
#End Region
#Region "Subs"
2020-01-31 16:30:08 +01:00
Dim SoftSubs2 As New List ( Of String )
If SoftSubs . Count > 0 Then
For i As Integer = 0 To SoftSubs . Count - 1
If CBool ( InStr ( WebbrowserText , Chr ( 34 ) + " language " + Chr ( 34 ) + " : " + Chr ( 34 ) + SoftSubs ( i ) + Chr ( 34 ) + " , " ) ) Then
SoftSubs2 . Add ( SoftSubs ( i ) )
Else
'MsgBox("Softsubtitle for " + SoftSubs(i) + " is not avalible.", MsgBoxStyle.Information)
End If
Next
End If
2019-11-10 00:16:12 +01:00
If SubSprache = " None " Then
If CBool ( InStr ( WebbrowserText , Chr ( 34 ) + " hardsub_lang " + Chr ( 34 ) + " :null " ) ) Then
SubSprache2 = " null "
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2019-12-04 21:00:26 +01:00
ResoNotFoundString = WebbrowserText
DialogTaskString = " Language "
2020-11-13 15:57:34 +01:00
ErrorDialog . ShowDialog ( )
2019-12-04 21:00:26 +01:00
Return Nothing
End Function ) )
2019-11-10 00:16:12 +01:00
If UserCloseDialog = True Then
Throw New System . Exception ( Chr ( 34 ) + " UserAbort " + Chr ( 34 ) )
Else
If ResoBackString = Nothing Then
Else
SubSprache2 = ResoBackString
End If
End If
'Throw New System.Exception("Could not find the sub language")
End If
Else
If CBool ( InStr ( WebbrowserText , Chr ( 34 ) + " hardsub_lang " + Chr ( 34 ) + " : " + Chr ( 34 ) + SubSprache + Chr ( 34 ) + " , " ) ) Then
SubSprache2 = Chr ( 34 ) + SubSprache + Chr ( 34 )
2020-01-31 16:30:08 +01:00
ElseIf CBool ( InStr ( WebbrowserText , Chr ( 34 ) + " language " + Chr ( 34 ) + " : " + Chr ( 34 ) + SubSprache + Chr ( 34 ) + " , " ) ) Then
If MessageBox . Show ( " It look like only Softsubtitle are avalibe. " + vbNewLine + " Are you want to use Softsubtitle this time instead? " , " No Hardsubtitle " , MessageBoxButtons . YesNo ) = DialogResult . Yes Then
SubSprache2 = " null "
SoftSubs2 . Add ( SubSprache )
Else
Throw New System . Exception ( " Could not find the sub language " )
End If
2019-11-10 00:16:12 +01:00
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2019-12-04 21:00:26 +01:00
ResoNotFoundString = WebbrowserText
DialogTaskString = " Language "
2020-11-13 15:57:34 +01:00
ErrorDialog . ShowDialog ( )
2019-12-04 21:00:26 +01:00
Return Nothing
End Function ) )
2019-11-10 00:16:12 +01:00
If UserCloseDialog = True Then
Throw New System . Exception ( Chr ( 34 ) + " UserAbort " + Chr ( 34 ) )
Else
If ResoBackString = Nothing Then
Else
SubSprache2 = ResoBackString
End If
End If
End If
End If
#End Region
If Grapp_Abord = True Then
Grapp_RDY = True
Grapp_Abord = False
'MsgBox("grapp_abourd")
Exit Sub
End If
#Region "m3u8 suche"
Dim CR_URI_Master As String = Nothing
2021-03-20 13:02:49 +01:00
If SubsOnly = False Then
Dim ii As Integer = 0
'MsgBox(Chr(34) + "hardsub_lang" + Chr(34) + ":" + SubSprache2 + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34))
Dim CR_URI_Master_Split1 As String ( ) = WebbrowserText . Split ( New String ( ) { My . Resources . hls_Value } , System . StringSplitOptions . RemoveEmptyEntries )
Dim hls_List As New List ( Of String )
For i As Integer = 0 To CR_URI_Master_Split1 . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( CR_URI_Master_Split1 ( i ) , My . Resources . hls_endString ) ) Then
2021-03-20 13:02:49 +01:00
Dim s As String ( ) = CR_URI_Master_Split1 ( i ) . Split ( New String ( ) { My . Resources . hls_endString } , System . StringSplitOptions . RemoveEmptyEntries )
hls_List . Add ( s ( 0 ) )
End If
Next
'Dim CR_URI_Master_Split1 As String() = WebbrowserText.Split(New String() {Chr(34) + "hardsub_lang" + Chr(34) + ":" + SubSprache2 + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
2019-11-10 00:16:12 +01:00
2021-03-20 13:02:49 +01:00
For i As Integer = 0 To hls_List . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( hls_List ( i ) , Chr ( 34 ) + " hardsub_lang " + Chr ( 34 ) + " : " + SubSprache2 + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) ) ) Then
2019-11-10 00:16:12 +01:00
2021-03-20 13:02:49 +01:00
Dim s ( ) As String = hls_List ( i ) . Split ( New String ( ) { Chr ( 34 ) + " hardsub_lang " + Chr ( 34 ) + " : " + SubSprache2 + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
CR_URI_Master = s ( 1 ) . Replace ( " \/ " , " / " )
Dim dub ( ) As String = hls_List ( i ) . Split ( New String ( ) { Chr ( 34 ) + " audio_lang " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
2020-08-27 13:25:28 +02:00
2021-03-20 13:02:49 +01:00
Dim dub2 ( ) As String = dub ( 0 ) . Split ( New String ( ) { Chr ( 34 ) + " , " } , System . StringSplitOptions . RemoveEmptyEntries )
CR_Anime_Dub = dub2 ( 0 )
'MsgBox(CR_URI_Master)
End If
Next
If CBool ( InStr ( CR_URI_Master , " master.m3u8 " ) ) Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-03-20 13:02:49 +01:00
Anime_Add . StatusLabel . Text = " Status: m3u8 found, looking for resolution "
Me . Text = " Status: m3u8 found, looking for resolution "
Me . Invalidate ( )
Return Nothing
End Function ) )
Else
Throw New System . Exception ( " Premium Episode " )
2019-11-10 00:16:12 +01:00
End If
2021-03-20 13:02:49 +01:00
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-03-20 13:02:49 +01:00
Anime_Add . StatusLabel . Text = " Status: Substitles only mode - skipped video "
Me . Text = " Status: Substitles only mode - skipped video "
2020-11-13 15:57:34 +01:00
Me . Invalidate ( )
2019-11-10 00:16:12 +01:00
Return Nothing
End Function ) )
End If
#End Region
2020-02-02 16:39:54 +01:00
#Region "Download softsub file or build ffmpeg cmd"
Dim SoftSubMergeURLs As String = Nothing
Dim SoftSubMergeMaps As String = " -map 0:v -map 0:a "
Dim SoftSubMergeMetatata As String = Nothing
2020-01-31 16:30:08 +01:00
If SoftSubs2 . Count > 0 Then
2021-03-20 13:02:49 +01:00
If MergeSubs = True And SubsOnly = False Then
2021-02-20 18:25:49 +01:00
Dim DispositionIndex As Integer
2020-02-02 16:39:54 +01:00
For i As Integer = 0 To SoftSubs2 . Count - 1
2021-02-20 18:25:49 +01:00
Debug . WriteLine ( SoftSubs2 ( i ) )
If SoftSubs2 ( i ) = DefaultSubCR Then
DispositionIndex = i
End If
2020-02-02 16:39:54 +01:00
Dim SoftSub As String ( ) = WebbrowserText . Split ( New String ( ) { Chr ( 34 ) + " language " + Chr ( 34 ) + " : " + Chr ( 34 ) + SoftSubs2 ( i ) + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim SoftSub_2 As String ( ) = SoftSub ( 1 ) . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
Dim SoftSub_3 As String = SoftSub_2 ( 0 ) . Replace ( " \/ " , " / " )
If SoftSubMergeURLs = Nothing Then
SoftSubMergeURLs = " -i " + Chr ( 34 ) + SoftSub_3 + Chr ( 34 )
Else
SoftSubMergeURLs = SoftSubMergeURLs + " -i " + Chr ( 34 ) + SoftSub_3 + Chr ( 34 )
End If
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + ( i + 1 ) . ToString
If SoftSubMergeMetatata = Nothing Then
2021-04-05 19:08:42 +02:00
SoftSubMergeMetatata = " -metadata:s:s: " + i . ToString + " language= " + CCtoMP4CC ( SoftSubs2 ( i ) ) + " -metadata:s:s: " + i . ToString + " title= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 ) + " -metadata:s:s: " + i . ToString + " handler_name= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 )
2020-02-02 16:39:54 +01:00
Else
2021-04-05 19:08:42 +02:00
SoftSubMergeMetatata = SoftSubMergeMetatata + " -metadata:s:s: " + i . ToString + " language= " + CCtoMP4CC ( SoftSubs2 ( i ) ) + " -metadata:s:s: " + i . ToString + " title= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 ) + " -metadata:s:s: " + i . ToString + " handler_name= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 )
2020-02-02 16:39:54 +01:00
End If
Next
2021-02-20 18:25:49 +01:00
If DispositionIndex = Nothing Then
Else
2021-03-21 11:25:51 +01:00
SoftSubMergeMetatata = SoftSubMergeMetatata + " -disposition:s: " + DispositionIndex . ToString + " default "
2021-02-20 18:25:49 +01:00
End If
2020-02-02 16:39:54 +01:00
Else
For i As Integer = 0 To SoftSubs2 . Count - 1
2021-04-24 20:51:34 +02:00
Dim ii As Integer = i
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-04-24 20:51:34 +02:00
Anime_Add . StatusLabel . Text = " Status: downloading subtitle file " + HardSubValuesToDisplay ( SoftSubs2 ( ii ) )
Me . Text = " Status: downloading subtitle file " + HardSubValuesToDisplay ( SoftSubs2 ( ii ) )
2021-03-20 13:02:49 +01:00
Me . Invalidate ( )
Return Nothing
End Function ) )
2020-02-02 16:39:54 +01:00
Dim SoftSub As String ( ) = WebbrowserText . Split ( New String ( ) { Chr ( 34 ) + " language " + Chr ( 34 ) + " : " + Chr ( 34 ) + SoftSubs2 ( i ) + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim SoftSub_2 As String ( ) = SoftSub ( 1 ) . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
Dim SoftSub_3 As String = SoftSub_2 ( 0 ) . Replace ( " \/ " , " / " )
Dim client0 As New WebClient
client0 . Encoding = Encoding . UTF8
Dim str0 As String = client0 . DownloadString ( SoftSub_3 )
Dim Pfad3 As String = Pfad2 . Replace ( Chr ( 34 ) , " " )
2021-09-20 20:37:57 +02:00
Dim FN As String = Path . ChangeExtension ( Path . Combine ( Path . GetFileNameWithoutExtension ( Pfad3 ) + " . " + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Path . GetExtension ( Pfad3 ) ) , " ass " )
2020-01-31 16:30:08 +01:00
'MsgBox(FN)
2021-09-20 20:37:57 +02:00
If i = 0 And IncludeLangName = False Then
2020-02-02 16:39:54 +01:00
FN = Path . ChangeExtension ( Path . GetFileName ( Pfad3 ) , " ass " )
'MsgBox(FN)
End If
Dim Pfad4 As String = Path . Combine ( Path . GetDirectoryName ( Pfad3 ) , FN )
'MsgBox(Pfad4)
File . WriteAllText ( Pfad4 , str0 , Encoding . UTF8 )
2021-03-20 13:02:49 +01:00
Pause ( 3 )
2020-02-02 16:39:54 +01:00
Next
End If
2021-02-20 18:25:49 +01:00
2020-01-31 16:30:08 +01:00
End If
2019-11-10 00:16:12 +01:00
#End Region
#Region "lösche doppel download"
Dim Pfad5 As String = Pfad2 . Replace ( Chr ( 34 ) , " " )
If My . Computer . FileSystem . FileExists ( Pfad5 ) Then 'Pfad = Kompeltter Pfad mit Dateinamen + ENdung
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-10-15 13:49:06 +02:00
Anime_Add . StatusLabel . Text = " Status: The file video already exists. "
2020-11-13 15:57:34 +01:00
Me . Text = " Status: The file video already exists. "
Me . Invalidate ( )
2020-10-15 13:49:06 +02:00
Return Nothing
End Function ) )
2019-11-10 00:16:12 +01:00
If MessageBox . Show ( " The file " + Pfad5 + " already exists. " + vbNewLine + " You want to override it? " , " File exists! " , MessageBoxButtons . OKCancel ) = DialogResult . OK Then
Try
My . Computer . FileSystem . DeleteFile ( Pfad5 )
Catch ex As Exception
End Try
Else
Grapp_RDY = True
Exit Sub
End If
End If
#End Region
2021-03-20 13:02:49 +01:00
If SubsOnly = False Then
2019-11-10 00:16:12 +01:00
2021-03-20 13:02:49 +01:00
If Reso = 42 And HybridMode = False Then
If MergeSubs = True Then
URL_DL = " -i " + Chr ( 34 ) + CR_URI_Master + Chr ( 34 ) + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_Anime_Dub )
Else
2021-06-04 15:25:59 +02:00
URL_DL = " -i " + Chr ( 34 ) + CR_URI_Master + Chr ( 34 ) + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_Anime_Dub ) + " " + ffmpeg_command_temp
2021-03-20 13:02:49 +01:00
End If
'MsgBox(URL_DL)
Else
2019-11-10 00:16:12 +01:00
2019-12-29 16:44:16 +01:00
2021-03-20 13:02:49 +01:00
Dim client As New System . Net . WebClient
client . Encoding = Encoding . UTF8
'MsgBox(CR_URI_Master)
Dim str As String = client . DownloadString ( CR_URI_Master )
2019-12-29 16:44:16 +01:00
'MsgBox(str)
2021-03-20 13:02:49 +01:00
If CBool ( InStr ( str , " x " + Reso . ToString + " , " ) ) Then
Reso2 = " x " + Reso . ToString
2019-12-29 16:44:16 +01:00
Else
2021-03-20 13:02:49 +01:00
'MsgBox(str)
If CBool ( InStr ( str , ResoSave + " , " ) ) Then
Reso2 = Reso2
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-03-20 13:02:49 +01:00
DialogTaskString = " Resolution "
ResoNotFoundString = str
ErrorDialog . ShowDialog ( )
Return Nothing
End Function ) )
2019-11-10 00:16:12 +01:00
2019-12-04 21:00:26 +01:00
2021-03-20 13:02:49 +01:00
'MsgBox(ResoBackString)
If UserCloseDialog = True Then
Throw New System . Exception ( Chr ( 34 ) + " UserAbort " + Chr ( 34 ) )
Else
Reso2 = ResoBackString
ResoSave = ResoBackString
End If
2019-12-29 16:44:16 +01:00
End If
2019-11-10 00:16:12 +01:00
End If
2020-09-30 18:19:31 +02:00
2021-03-20 13:02:49 +01:00
Dim ffmpeg_url_1 As String ( ) = str . Split ( New String ( ) { Reso2 + " , " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ffmpeg_url_3 As String ( ) = Nothing
Dim ffmpeg_url_2 As String ( ) = ffmpeg_url_1 ( 1 ) . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
ffmpeg_url_3 = ffmpeg_url_2 ( 2 ) . Split ( New [ Char ] ( ) { System . Convert . ToChar ( " # " ) } )
2020-08-27 13:25:28 +02:00
2021-03-20 13:02:49 +01:00
If MergeSubs = True Then
URL_DL = " -i " + Chr ( 34 ) + ffmpeg_url_3 ( 0 ) . Trim ( ) + Chr ( 34 ) + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_Anime_Dub )
Else
2021-06-04 15:25:59 +02:00
URL_DL = " -i " + Chr ( 34 ) + ffmpeg_url_3 ( 0 ) . Trim ( ) + Chr ( 34 ) + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_Anime_Dub ) + " " + ffmpeg_command_temp
2021-03-20 13:02:49 +01:00
End If
2021-03-08 21:08:26 +01:00
2020-02-02 16:39:54 +01:00
End If
2021-03-08 21:08:26 +01:00
2019-11-10 00:16:12 +01:00
End If
#Region "thumbnail"
Dim thumbnail As String ( ) = WebbrowserText . Split ( New String ( ) { My . Resources . thumbnailString } , System . StringSplitOptions . RemoveEmptyEntries )
Dim thumbnail2 As String ( ) = thumbnail ( 1 ) . Split ( New String ( ) { Chr ( 34 ) + " } " } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
Dim thumbnail3 As String = thumbnail2 ( 0 ) . Replace ( " \/ " , " / " )
#End Region
#Region "<li> constructor"
2021-04-05 19:08:42 +02:00
Dim Subsprache3 As String = HardSubValuesToDisplay ( SubSprache2 . Replace ( Chr ( 34 ) , " " ) )
2019-11-10 00:16:12 +01:00
Dim ResoHTMLDisplay As String = Nothing
If ResoBackString = Nothing Then
2020-11-13 15:57:34 +01:00
ResoHTMLDisplay = Reso . ToString + " p "
2020-01-02 15:13:38 +01:00
ElseIf DialogTaskString = " Language " Then
2020-11-13 15:57:34 +01:00
ResoHTMLDisplay = Reso . ToString + " p "
2019-11-10 00:16:12 +01:00
Else
Dim ResoHTML As String ( ) = ResoBackString . Split ( New String ( ) { " x " } , System . StringSplitOptions . RemoveEmptyEntries )
If ResoHTML . Count > 1 Then
ResoHTMLDisplay = ResoHTML ( 1 ) + " p "
Else
ResoHTMLDisplay = ResoHTML ( 0 ) + " p "
End If
End If
2021-01-14 19:50:29 +01:00
Dim L2Name As String = String . Join ( " " , CR_FilenName . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_FilenName_Backup, "[^\w\\-]", " ")
2020-12-13 16:11:43 +01:00
If Reso = 42 And HybridMode = False Then
2019-12-29 16:44:16 +01:00
ResoHTMLDisplay = " [Auto] "
2020-12-13 16:11:43 +01:00
ElseIf Reso = 42 And HybridMode = False Then
ResoHTMLDisplay = Reso2
2019-12-29 16:44:16 +01:00
End If
Pfad_DL = Pfad2
2020-01-02 15:13:38 +01:00
Dim L1Name_Split As String ( ) = WebbrowserURL . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-04-05 19:08:42 +02:00
Dim L1Name As String = L1Name_Split ( 1 ) . Replace ( " www. " , " " ) + " | Dub : " + HardSubValuesToDisplay ( CR_Anime_Dub )
2021-03-20 13:02:49 +01:00
If SubsOnly = True Then
URL_DL = " -i [Subtitles only] "
End If
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-08-16 23:27:48 +02:00
ListItemAdd ( Pfad_DL , L1Name , L2Name , ResoHTMLDisplay , Subsprache3 , SubValuesToDisplay ( ) , thumbnail3 , URL_DL , Pfad_DL )
2019-11-10 00:16:12 +01:00
Return Nothing
End Function ) )
2020-08-16 23:27:48 +02:00
liList . Add ( My . Resources . htmlvorThumbnail + thumbnail3 + My . Resources . htmlnachTumbnail + CR_Anime_Titel + " <br> " + CR_Anime_Staffel + " " + CR_Anime_Folge + My . Resources . htmlvorAufloesung + ResoHTMLDisplay + My . Resources . htmlvorSoftSubs + vbNewLine + SubValuesToDisplay ( ) + My . Resources . htmlvorHardSubs + Subsprache3 + My . Resources . htmlnachHardSubs + " <!-- " + L2Name + " --> " )
'Form1.RichTextBox1.Text = My.Resources.htmlvorThumbnail + thumbnail3 + My.Resources.htmlnachTumbnail + CR_Anime_Titel + " <br> " + CR_Anime_Staffel + " " + CR_Anime_Folge + My.Resources.htmlvorAufloesung + ResoHTMLDisplay + My.Resources.htmlvorSoftSubs + vbNewLine + SubValuesToDisplay() + My.Resources.htmlvorHardSubs + Subsprache3 + My.Resources.htmlnachHardSubs + "<!-- " + L2Name + "-->"
2019-11-10 00:16:12 +01:00
#End Region
2020-02-02 16:39:54 +01:00
2019-11-10 00:16:12 +01:00
Grapp_RDY = True
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2019-11-10 00:16:12 +01:00
Anime_Add . StatusLabel . Text = " Status: idle "
2020-11-13 15:57:34 +01:00
Me . Text = " Crunchyroll Downloader "
Me . Invalidate ( )
2019-11-10 00:16:12 +01:00
Return Nothing
End Function ) )
Catch ex As Exception
2021-09-20 20:37:57 +02:00
'Me.Invoke(New Action(Function() As Object
2019-11-10 00:16:12 +01:00
2021-09-20 20:37:57 +02:00
' Anime_Add.StatusLabel.Text = "Status: idle"
' Me.Text = "Crunchyroll Downloader"
' Me.Invalidate()
' Return Nothing
' End Function))
2019-11-10 00:16:12 +01:00
Grapp_RDY = True
2020-01-02 15:13:38 +01:00
2019-11-10 00:16:12 +01:00
If CBool ( InStr ( ex . ToString , " Could not find the sub language " ) ) Then
MsgBox ( Sub_language_NotFound + SubSprache )
ElseIf CBool ( InStr ( ex . ToString , " RESOLUTION Not Found " ) ) Then
MsgBox ( Resolution_NotFound )
2020-01-19 14:13:59 +01:00
ElseIf CBool ( InStr ( ex . ToString , " Premium Episode " ) ) Then
2019-11-10 00:16:12 +01:00
MsgBox ( Premium_Stream , MsgBoxStyle . Information )
ElseIf CBool ( InStr ( ex . ToString , " System.UnauthorizedAccessException " ) ) Then
MsgBox ( ErrorNoPermisson + vbNewLine + ex . ToString , MsgBoxStyle . Information )
ElseIf CBool ( InStr ( ex . ToString , Chr ( 34 ) + " UserAbort " + Chr ( 34 ) ) ) Then
MsgBox ( ex . ToString , MsgBoxStyle . Information )
Else
2021-01-14 18:06:42 +01:00
MsgBox ( ex . ToString , MsgBoxStyle . Information )
2019-11-10 00:16:12 +01:00
End If
End Try
End Sub
2021-04-05 19:08:42 +02:00
#Region "CR-Beta"
Public Async Sub DownloadBetaSeasons ( )
Try
Dim ListOfEpisodes As New List ( Of String )
Dim EpisodeSplit ( ) As String = CrBetaMassEpisodes . Split ( New String ( ) { Chr ( 34 ) + " id " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
For i As Integer = 1 To EpisodeSplit . Count - 1
Dim EpisodeSplit2 ( ) As String = EpisodeSplit ( i ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
ListOfEpisodes . Add ( " https://beta.crunchyroll.com/watch/ " + EpisodeSplit2 ( 0 ) + " / " )
Next
Dim First As Integer = 0
Dim Last As Integer = 0
2021-05-23 22:27:56 +02:00
If Anime_Add . comboBox4 . SelectedIndex > Anime_Add . comboBox3 . SelectedIndex Or Anime_Add . comboBox4 . SelectedIndex = Anime_Add . comboBox3 . SelectedIndex Then
2021-04-05 19:08:42 +02:00
First = Anime_Add . comboBox3 . SelectedIndex
Last = Anime_Add . comboBox4 . SelectedIndex
2021-05-23 22:27:56 +02:00
ElseIf Anime_Add . comboBox3 . SelectedIndex > Anime_Add . comboBox4 . SelectedIndex Then
2021-04-05 19:08:42 +02:00
First = Anime_Add . comboBox4 . SelectedIndex
2021-05-23 22:27:56 +02:00
Last = Anime_Add . comboBox3 . SelectedIndex
2021-04-05 19:08:42 +02:00
End If
Dim Anzahl As Integer = Anime_Add . comboBox4 . SelectedIndex - Anime_Add . comboBox3 . SelectedIndex
For i As Integer = First To Last
For e As Integer = 0 To Integer . MaxValue
If Grapp_RDY = True Then
Try
Dim ItemFinshedCount As Integer = 0
For i2 As Integer = 0 To ListView1 . Items . Count - 1
If ItemList ( i2 ) . GetIsStatusFinished ( ) = True Then
ItemFinshedCount = ItemFinshedCount + 1
End If
Next
RunningDownloads = ListView1 . Items . Count - ItemFinshedCount
Catch ex As Exception
RunningDownloads = ListView1 . Items . Count
End Try
If RunningDownloads < MaxDL Then
Exit For
Else
'MsgBox(e)
Await Task . Delay ( 1000 )
End If
Else
Await Task . Delay ( 5000 )
End If
Next
If Anime_Add . Mass_DL_Cancel = False Then
b = True
Exit For
Grapp_Abord = True
'MsgBox("dl_abourd")
End If
If UseQueue = True Then
Anime_Add . ListBox1 . Items . Add ( ListOfEpisodes ( i ) )
Anime_Add . Add_Display . ForeColor = Color . FromArgb ( 9248044 )
Pause ( 1 )
Anime_Add . Add_Display . ForeColor = Color . Black
Else
Grapp_RDY = False
b = False
2021-09-20 20:37:57 +02:00
Debug . WriteLine ( " b: " + b . ToString )
Navigate ( ListOfEpisodes ( i ) )
2021-04-05 19:08:42 +02:00
End If
Anime_Add . Add_Display . Text = ( i - First + 1 ) . ToString + " / " + ( Last - First + 1 ) . ToString
Next
Catch ex As Exception
If Debug2 = True Then
2021-05-23 22:27:56 +02:00
MsgBox ( ex . ToString )
End If
Anime_Add . comboBox4 . Items . Clear ( )
Anime_Add . comboBox3 . Items . Clear ( )
Aktuell = 0 . ToString
Gesamt = 0 . ToString
2021-04-05 19:08:42 +02:00
2021-05-23 22:27:56 +02:00
Anime_Add . groupBox1 . Visible = True
Anime_Add . groupBox2 . Visible = False
Anime_Add . GroupBox3 . Visible = False
Anime_Add . Mass_DL_Cancel = False
2021-09-20 20:37:57 +02:00
Anime_Add . btn_dl . Text = " Download " 'btn_dl.BackgroundImage = My.Resources.main_button_download_default
2021-04-05 19:08:42 +02:00
End Try
Pause ( 5 )
Anime_Add . groupBox1 . Visible = True
Anime_Add . groupBox2 . Visible = False
Anime_Add . GroupBox3 . Visible = False
Anime_Add . Mass_DL_Cancel = False
2021-09-20 20:37:57 +02:00
Anime_Add . btn_dl . Text = " Download " 'Anime_Add.btn_dl.BackgroundImage = My.Resources.main_button_download_default
2021-04-05 19:08:42 +02:00
End Sub
Public Sub GetBetaSeasons ( ByVal JsonUrl As String )
2021-09-20 20:37:57 +02:00
2021-04-05 19:08:42 +02:00
Anime_Add . groupBox2 . Visible = True
Anime_Add . PictureBox1 . Enabled = True
Anime_Add . PictureBox1 . Visible = True
Anime_Add . groupBox1 . Visible = False
Anime_Add . ComboBox1 . Items . Clear ( )
Anime_Add . comboBox3 . Items . Clear ( )
Anime_Add . comboBox4 . Items . Clear ( )
Anime_Add . ComboBox1 . Text = Nothing
Anime_Add . comboBox3 . Text = Nothing
Anime_Add . comboBox4 . Text = Nothing
Anime_Add . ComboBox1 . Enabled = True
Anime_Add . comboBox3 . Enabled = True
Anime_Add . comboBox4 . Enabled = True
Dim SeasonJson As String = Nothing
Try
Using client As New WebClient ( )
client . Encoding = System . Text . Encoding . UTF8
client . Headers . Add ( My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) )
SeasonJson = client . DownloadString ( JsonUrl )
End Using
Catch ex As Exception
Debug . WriteLine ( " error- getting SeasonJson data " )
2021-07-04 17:22:46 +02:00
2021-04-05 19:08:42 +02:00
End Try
2021-07-04 17:22:46 +02:00
2021-04-05 19:08:42 +02:00
Dim ParameterSplit ( ) As String = JsonUrl . Split ( New String ( ) { " &locale= " } , System . StringSplitOptions . RemoveEmptyEntries )
CrBetaMassParameters = ParameterSplit ( 1 )
CrBetaMass = SeasonJson
2021-05-23 22:27:56 +02:00
Dim BaseURLBuilder ( ) As String = JsonUrl . Split ( New String ( ) { " seasons? " } , System . StringSplitOptions . RemoveEmptyEntries )
CrBetaMassBaseURL = BaseURLBuilder ( 0 )
2021-04-05 19:08:42 +02:00
Dim SeasonSplit ( ) As String = SeasonJson . Split ( New String ( ) { Chr ( 34 ) + " title " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
For i As Integer = 1 To SeasonSplit . Count - 1
Dim SeasonSplit2 ( ) As String = SeasonSplit ( i ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Anime_Add . ComboBox1 . Items . Add ( SeasonSplit2 ( 0 ) )
Next
End Sub
2021-06-04 15:25:59 +02:00
Public Sub GetBetaVideoProxy ( ByVal requesturl As String , ByVal WebsiteURL As String )
Dim Evaluator = New Thread ( Sub ( ) Me . GetBetaVideo ( requesturl , WebsiteURL ) )
Evaluator . Start ( )
End Sub
2021-04-05 19:08:42 +02:00
Public Sub GetBetaVideo ( ByVal Streams As String , ByVal WebsiteURL As String )
Try
Grapp_RDY = False
2021-06-04 15:25:59 +02:00
Dim ffmpeg_command_temp As String = ffmpeg_command
If VideoFormat = " .aac " Then
Dim ffmpeg_command_Builder ( ) As String = ffmpeg_command . Split ( New String ( ) { " -c:a copy " } , System . StringSplitOptions . RemoveEmptyEntries )
ffmpeg_command_temp = " -c:a copy " + ffmpeg_command_Builder ( 1 )
End If
2021-04-05 19:08:42 +02:00
Dim CR_series_title As String = Nothing
Dim CR_season_number As String = Nothing
Dim CR_episode As String = Nothing
2021-08-08 12:23:22 +02:00
Dim CR_Anime_Staffel_int As String = Nothing
Dim CR_episode_int As String = Nothing
2021-04-05 19:08:42 +02:00
Dim CR_title As String = Nothing
Dim CR_audio_locale As String = Nothing
#Region "Name + Pfad"
Dim Pfad2 As String
Dim TextBox2_Text As String = Nothing
Dim CR_FilenName As String = Nothing
Dim ObjectJson As String = Nothing
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
TextBox2_Text = Anime_Add . textBox2 . Text
2021-04-05 19:08:42 +02:00
Return Nothing
End Function ) )
#Region "Name von Crunchyroll"
2021-05-23 22:27:56 +02:00
Dim ObjectsURLBuilder ( ) As String = Streams . Split ( New String ( ) { " videos " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURLBuilder2 ( ) As String = ObjectsURLBuilder ( 1 ) . Split ( New String ( ) { " /streams " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURLBuilder3 ( ) As String = WebsiteURL . Split ( New String ( ) { " watch/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURLBuilder4 ( ) As String = ObjectsURLBuilder3 ( 1 ) . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-04-05 19:08:42 +02:00
2021-05-23 22:27:56 +02:00
Dim ObjectsURL As String = ObjectsURLBuilder ( 0 ) + " objects/ " + ObjectsURLBuilder4 ( 0 ) + ObjectsURLBuilder2 ( 1 )
2021-04-05 19:08:42 +02:00
2021-05-23 22:27:56 +02:00
Debug . WriteLine ( ObjectsURL )
Try
Using client As New WebClient ( )
client . Encoding = System . Text . Encoding . UTF8
client . Headers . Add ( My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) )
ObjectJson = client . DownloadString ( ObjectsURL )
End Using
Catch ex As Exception
Debug . WriteLine ( " error- getting name data " )
Exit Sub
End Try
2021-07-04 17:22:46 +02:00
Dim ser As JObject = JObject . Parse ( ObjectJson )
Dim data As List ( Of JToken ) = ser . Children ( ) . ToList
2021-05-23 22:27:56 +02:00
2021-08-07 23:49:09 +02:00
If TextBox2_Text = Nothing Or TextBox2_Text = " Use Custom Name " Then
2021-04-05 19:08:42 +02:00
2021-05-23 22:27:56 +02:00
2021-04-05 19:08:42 +02:00
2021-07-04 17:22:46 +02:00
For Each item As JProperty In data
item . CreateReader ( )
Select Case item . Name
Case " items " 'each record is inside the entries array
For Each Entry As JObject In item . Values
Try
2021-09-20 20:37:57 +02:00
Dim Title As String = Entry ( " title " ) . ToString
2021-07-04 17:22:46 +02:00
CR_title = String . Join ( " " , Title . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c )
Catch ex As Exception
End Try
Dim SubData As List ( Of JToken ) = Entry . Children ( ) . ToList
For Each SubItem As JProperty In SubData
'SubItem.CreateReader()
Select Case SubItem . Name
Case " episode_metadata "
For Each SubEntry As JProperty In SubItem . Values
Select Case SubEntry . Name
Case " series_title "
CR_series_title = SubEntry . Value . ToString
2021-08-07 23:49:09 +02:00
'Case "season_title"
' CR_season_title = SubEntry.Value.ToString
2021-07-04 17:22:46 +02:00
Case " season_number "
CR_season_number = SubEntry . Value . ToString
Case " episode "
CR_episode = SubEntry . Value . ToString
End Select
Next
End Select
Next
Next
End Select
Next
2021-04-05 19:08:42 +02:00
2021-04-24 20:51:34 +02:00
2021-07-04 17:22:46 +02:00
'My.Computer.Clipboard.SetText(ObjectJson)
2021-09-20 20:37:57 +02:00
2021-07-04 17:22:46 +02:00
'
2021-08-08 12:23:22 +02:00
CR_Anime_Staffel_int = CR_season_number
2021-09-20 20:37:57 +02:00
If IgnoreS1 = True Then
If CR_season_number = " 1 " Or CR_season_number = " 0 " Then
CR_season_number = Nothing
End If
End If
2021-08-08 12:23:22 +02:00
CR_episode_int = CR_episode
2021-08-07 23:49:09 +02:00
If Season_Prefix = " [default season prefix] " Then
If CR_episode = Nothing Then 'no episode number means most likey a movie
CR_season_number = Nothing
2021-09-20 20:37:57 +02:00
ElseIf CR_season_number = Nothing Then
2021-07-04 17:22:46 +02:00
Else
2021-09-20 20:37:57 +02:00
2021-08-07 23:49:09 +02:00
CR_season_number = " Season " + CR_season_number
2021-04-24 20:51:34 +02:00
End If
2021-05-23 22:27:56 +02:00
Else
2021-08-07 23:49:09 +02:00
If CR_episode = Nothing Then 'no episode number means most likey a movie
CR_season_number = Nothing
2021-09-20 20:37:57 +02:00
ElseIf CR_season_number = Nothing Then
2021-08-07 23:49:09 +02:00
Else
CR_season_number = Season_Prefix + CR_season_number
End If
2021-04-05 19:08:42 +02:00
End If
2021-07-04 17:22:46 +02:00
If CR_episode = Nothing Then
ElseIf Episode_Prefix = " [default episode prefix] " Then
2021-04-05 19:08:42 +02:00
CR_episode = " Episode " + CR_episode
Else
CR_episode = Episode_Prefix + CR_episode
End If
If CR_NameMethode = 0 Then 'nummer
If CR_season_number = Nothing Then
CR_FilenName = CR_series_title + " " + CR_episode
Else
2021-08-07 23:49:09 +02:00
CR_FilenName = CR_series_title + " " + CR_season_number + " " + CR_episode
2021-04-05 19:08:42 +02:00
End If
ElseIf CR_NameMethode = 1 Then 'name
If CR_season_number = Nothing Then
2021-09-20 20:37:57 +02:00
CR_FilenName = CR_series_title + " " + CR_series_title + " " + CR_title
2021-04-05 19:08:42 +02:00
Else
2021-08-07 23:49:09 +02:00
CR_FilenName = CR_series_title + " " + CR_season_number + " " + CR_title
2021-04-05 19:08:42 +02:00
End If
ElseIf CR_NameMethode = 2 Then ' nummer - name
If CR_season_number = Nothing Then
2021-09-20 20:37:57 +02:00
CR_FilenName = CR_series_title + " " + CR_series_title + " " + CR_episode + " " + CR_title
2021-04-05 19:08:42 +02:00
Else
2021-08-07 23:49:09 +02:00
CR_FilenName = CR_series_title + " " + CR_season_number + " " + CR_episode + " " + CR_title
2021-04-05 19:08:42 +02:00
End If
ElseIf CR_NameMethode = 3 Then ' name - nummer
If CR_season_number = Nothing Then
CR_FilenName = CR_series_title + " " + CR_title + " " + CR_episode
Else
CR_FilenName = CR_series_title + " " + CR_title + " " + CR_season_number + " " + CR_episode
End If
End If
2021-08-08 12:23:22 +02:00
If KodiNaming = True Then
Dim KodiString As String = " [S "
If CR_Anime_Staffel_int = " 0 " Then
CR_Anime_Staffel_int = " 01 "
Else
CR_Anime_Staffel_int = " 0 " + CR_Anime_Staffel_int
End If
KodiString = KodiString + CR_Anime_Staffel_int + " E " + CR_episode_int
KodiString = KodiString + " ] "
CR_FilenName = KodiString + CR_FilenName
End If
2021-04-05 19:08:42 +02:00
2021-09-20 20:37:57 +02:00
If KodiNaming = True Then
Dim KodiString As String = " [S "
If CR_Anime_Staffel_int = " 0 " Then
CR_Anime_Staffel_int = " 01 "
Else
CR_Anime_Staffel_int = " 0 " + CR_Anime_Staffel_int
End If
Dim CR_episode_nr As String = CR_episode_int
If CR_episode_nr . Length = 1 Then
CR_episode_nr = " 0 " + CR_episode_nr
End If
KodiString = KodiString + CR_Anime_Staffel_int + " E " + CR_episode_nr
KodiString = KodiString + " ] "
CR_FilenName = KodiString + CR_FilenName
End If
2021-04-05 19:08:42 +02:00
Debug . WriteLine ( CR_FilenName )
#End Region
Else
CR_FilenName = RemoveExtraSpaces ( String . Join ( " " , TextBox2_Text . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) ) 'System.Text.RegularExpressions.Regex.Replace(TextBox2_Text, "[^\w\\-]", " "))
End If
CR_FilenName = String . Join ( " " , CR_FilenName . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_FilenName, "[^\w\\-]", " ")
CR_FilenName = RemoveExtraSpaces ( CR_FilenName )
'My.Computer.FileSystem.WriteAllText("log.log", WebbrowserText, False)
2021-08-07 23:49:09 +02:00
Pfad2 = UseSubfolder ( CR_series_title , CR_season_number , Pfad )
2021-04-05 19:08:42 +02:00
If Not Directory . Exists ( Path . GetDirectoryName ( Pfad2 ) ) Then
' Nein! Jetzt erstellen...
Try
Directory . CreateDirectory ( Path . GetDirectoryName ( Pfad2 ) )
Pfad2 = Chr ( 34 ) + Pfad2 + CR_FilenName + VideoFormat + Chr ( 34 )
Catch ex As Exception
' Ordner wurde nich erstellt
2021-09-20 20:37:57 +02:00
Pfad2 = Chr ( 34 ) + Pfad + " \ " + CR_FilenName + VideoFormat + Chr ( 34 )
Pfad2 = Pfad2 . Replace ( " \\ " , " \ " )
2021-04-05 19:08:42 +02:00
End Try
2021-04-24 20:51:34 +02:00
Else
Pfad2 = Chr ( 34 ) + Pfad2 + CR_FilenName + VideoFormat + Chr ( 34 )
2021-04-05 19:08:42 +02:00
End If
#End Region
2021-04-24 20:51:34 +02:00
#Region "VideoJson"
2021-04-05 19:08:42 +02:00
Dim VideoJson As String = Nothing
Try
Using client As New WebClient ( )
client . Encoding = System . Text . Encoding . UTF8
client . Headers . Add ( My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) )
VideoJson = client . DownloadString ( Streams )
End Using
Catch ex As Exception
Debug . WriteLine ( " error- getting stream data " )
Exit Sub
End Try
2021-04-24 20:51:34 +02:00
Dim hls_type As String = Nothing
If CBool ( InStr ( VideoJson , Chr ( 34 ) + " adaptive_hls " ) ) = True Then
hls_type = " adaptive_hls "
ElseIf CBool ( InStr ( VideoJson , Chr ( 34 ) + " multitrack_adaptive_hls_v2 " ) ) = True Then
hls_type = " multitrack_adaptive_hls_v2 "
ElseIf CBool ( InStr ( VideoJson , Chr ( 34 ) + " vo_adaptive_hls " ) ) = True Then
hls_type = " vo_adaptive_hls "
Else
MsgBox ( " No download stream avalible " , MsgBoxStyle . Critical )
Exit Sub
End If
2021-05-23 22:27:56 +02:00
'My.Computer.Clipboard.SetText(VideoJson)
'MsgBox(SubSprache)
2021-04-24 20:51:34 +02:00
Dim LangNew As String = ConvertCC ( SubSprache )
#End Region
#Region "Download softsub file or build ffmpeg cmd"
Dim SoftSubs2 As New List ( Of String )
If SoftSubs . Count > 0 Then
For i As Integer = 0 To SoftSubs . Count - 1
If CBool ( InStr ( VideoJson , Chr ( 34 ) + " locale " + Chr ( 34 ) + " : " + Chr ( 34 ) + ConvertCC ( SoftSubs ( i ) ) + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) ) ) Then
SoftSubs2 . Add ( SoftSubs ( i ) )
Else
'MsgBox("Softsubtitle for " + SoftSubs(i) + " is not avalible.", MsgBoxStyle.Information)
End If
Next
End If
Dim SoftSubMergeURLs As String = Nothing
Dim SoftSubMergeMaps As String = " -map 0:v -map 0:a "
Dim SoftSubMergeMetatata As String = Nothing
If SoftSubs2 . Count > 0 Then
If MergeSubs = True And SubsOnly = False Then
Dim DispositionIndex As Integer
For i As Integer = 0 To SoftSubs2 . Count - 1
Debug . WriteLine ( SoftSubs2 ( i ) )
If SoftSubs2 ( i ) = DefaultSubCR Then
DispositionIndex = i
End If
Dim SoftSub As String ( ) = VideoJson . Split ( New String ( ) { Chr ( 34 ) + " locale " + Chr ( 34 ) + " : " + Chr ( 34 ) + ConvertCC ( SoftSubs2 ( i ) ) + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim SoftSub_2 As String ( ) = SoftSub ( 1 ) . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
Dim SoftSub_3 As String = SoftSub_2 ( 0 ) . Replace ( " & " , " & " ) . Replace ( " /u0026 " , " & " ) . Replace ( " \u002F " , " / " ) . Replace ( " \u0026 " , " & " )
If SoftSubMergeURLs = Nothing Then
SoftSubMergeURLs = " -i " + Chr ( 34 ) + SoftSub_3 + Chr ( 34 )
Else
SoftSubMergeURLs = SoftSubMergeURLs + " -i " + Chr ( 34 ) + SoftSub_3 + Chr ( 34 )
End If
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + ( i + 1 ) . ToString
If SoftSubMergeMetatata = Nothing Then
SoftSubMergeMetatata = " -metadata:s:s: " + i . ToString + " language= " + CCtoMP4CC ( SoftSubs2 ( i ) ) + " -metadata:s:s: " + i . ToString + " title= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 ) + " -metadata:s:s: " + i . ToString + " handler_name= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 )
Else
SoftSubMergeMetatata = SoftSubMergeMetatata + " -metadata:s:s: " + i . ToString + " language= " + CCtoMP4CC ( SoftSubs2 ( i ) ) + " -metadata:s:s: " + i . ToString + " title= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 ) + " -metadata:s:s: " + i . ToString + " handler_name= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 )
End If
Next
If DispositionIndex = Nothing Then
Else
SoftSubMergeMetatata = SoftSubMergeMetatata + " -disposition:s: " + DispositionIndex . ToString + " default "
End If
Else
For i As Integer = 0 To SoftSubs2 . Count - 1
Dim i2 As Integer = i
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-04-24 20:51:34 +02:00
Anime_Add . StatusLabel . Text = " Status: downloading subtitle file " + HardSubValuesToDisplay ( SoftSubs2 ( i2 ) )
Me . Text = " Status: downloading subtitle file " + HardSubValuesToDisplay ( SoftSubs2 ( i2 ) )
Me . Invalidate ( )
Return Nothing
End Function ) )
Dim SoftSub As String ( ) = VideoJson . Split ( New String ( ) { Chr ( 34 ) + " locale " + Chr ( 34 ) + " : " + Chr ( 34 ) + ConvertCC ( SoftSubs2 ( i ) ) + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim SoftSub_2 As String ( ) = SoftSub ( 1 ) . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
Dim SoftSub_3 As String = SoftSub_2 ( 0 ) . Replace ( " & " , " & " ) . Replace ( " /u0026 " , " & " ) . Replace ( " \u002F " , " / " ) . Replace ( " \u0026 " , " & " )
'MsgBox(SoftSub_3)
Dim client0 As New WebClient
client0 . Encoding = Encoding . UTF8
Dim str0 As String = client0 . DownloadString ( SoftSub_3 )
Dim Pfad3 As String = Pfad2 . Replace ( Chr ( 34 ) , " " )
2021-09-20 20:37:57 +02:00
Dim FN As String = Path . ChangeExtension ( Path . Combine ( Path . GetFileNameWithoutExtension ( Pfad3 ) + " . " + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Path . GetExtension ( Pfad3 ) ) , " ass " )
2021-04-24 20:51:34 +02:00
'MsgBox(FN)
2021-09-20 20:37:57 +02:00
If i = 0 And IncludeLangName = False Then
2021-04-24 20:51:34 +02:00
FN = Path . ChangeExtension ( Path . GetFileName ( Pfad3 ) , " ass " )
'MsgBox(FN)
End If
Dim Pfad4 As String = Path . Combine ( Path . GetDirectoryName ( Pfad3 ) , FN )
'MsgBox(Pfad4)
File . WriteAllText ( Pfad4 , str0 , Encoding . UTF8 )
Pause ( 3 )
Next
End If
End If
#End Region
#Region "m3u8 suche"
If CBool ( InStr ( VideoJson , " audio_locale " ) ) Then
2021-04-05 19:08:42 +02:00
Dim CR_audio As String ( ) = VideoJson . Split ( New String ( ) { " audio_locale " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim CR_audio2 As String ( ) = CR_audio ( 1 ) . Split ( New String ( ) { Chr ( 34 ) + " , " } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
CR_audio_locale = String . Join ( " " , CR_audio2 ( 0 ) . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c )
End If
Dim CR_URI_Master As String = Nothing
'If SubsOnly = False Then
Dim ii As Integer = 0
2021-04-24 20:51:34 +02:00
Dim CR_VideoJson As String ( ) = VideoJson . Split ( New String ( ) { hls_type } , System . StringSplitOptions . RemoveEmptyEntries )
2021-04-05 19:08:42 +02:00
Dim CR_VideoJsonHardSubs As String ( ) = CR_VideoJson ( 1 ) . Split ( New String ( ) { " hardsub_locale " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
2021-04-24 20:51:34 +02:00
2021-04-05 19:08:42 +02:00
Debug . WriteLine ( LangNew )
2021-05-23 22:27:56 +02:00
Debug . WriteLine ( CR_VideoJsonHardSubs . Count . ToString )
2021-04-05 19:08:42 +02:00
Dim hls_List As New List ( Of String )
For i As Integer = 0 To CR_VideoJsonHardSubs . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( CR_VideoJsonHardSubs ( i ) , LangNew + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) ) ) Then
2021-04-05 19:08:42 +02:00
CR_URI_Master = CR_VideoJsonHardSubs ( i ) . Replace ( LangNew + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) , " " ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) ( 0 )
Exit For
End If
Next
2021-05-23 22:27:56 +02:00
If CR_URI_Master = Nothing Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-05-23 22:27:56 +02:00
ResoNotFoundString = VideoJson
DialogTaskString = " Language_CR_Beta "
ErrorDialog . ShowDialog ( )
Return Nothing
End Function ) )
If UserCloseDialog = True Then
Throw New System . Exception ( Chr ( 34 ) + " UserAbort " + Chr ( 34 ) )
2021-04-05 19:08:42 +02:00
Else
2021-05-23 22:27:56 +02:00
LangNew = ResoBackString
ResoBackString = Nothing
For i As Integer = 0 To CR_VideoJsonHardSubs . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( CR_VideoJsonHardSubs ( i ) , LangNew + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) ) ) Then
2021-05-23 22:27:56 +02:00
CR_URI_Master = CR_VideoJsonHardSubs ( i ) . Replace ( LangNew + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) , " " ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) ( 0 )
Exit For
End If
Next
2021-04-05 19:08:42 +02:00
End If
2021-05-23 22:27:56 +02:00
End If
CR_URI_Master = CR_URI_Master . Replace ( " & " , " & " ) . Replace ( " /u0026 " , " & " ) . Replace ( " \u002F " , " / " ) . Replace ( " \u0026 " , " & " )
If CBool ( InStr ( CR_URI_Master , " master.m3u8 " ) ) Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-05-23 22:27:56 +02:00
Anime_Add . StatusLabel . Text = " Status: m3u8 found, looking for resolution "
Me . Text = " Status: m3u8 found, looking for resolution "
Me . Invalidate ( )
Return Nothing
End Function ) )
Else
Throw New System . Exception ( " Premium Episode " )
End If
2021-04-05 19:08:42 +02:00
'Else
2021-09-20 20:37:57 +02:00
' Me.Invoke(New Action(Function() As Object
2021-04-05 19:08:42 +02:00
' Anime_Add.StatusLabel.Text = "Status: Substitles only mode - skipped video"
' Me.Text = "Status: Substitles only mode - skipped video"
' Me.Invalidate()
' Return Nothing
' End Function))
'End If
#End Region
#Region "lösche doppel download"
Dim Pfad5 As String = Pfad2 . Replace ( Chr ( 34 ) , " " )
2021-05-23 22:27:56 +02:00
If My . Computer . FileSystem . FileExists ( Pfad5 ) And SubsOnly = False Then 'Pfad = Kompeltter Pfad mit Dateinamen + ENdung
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-04-05 19:08:42 +02:00
Anime_Add . StatusLabel . Text = " Status: The file video already exists. "
Me . Text = " Status: The file video already exists. "
Me . Invalidate ( )
Return Nothing
End Function ) )
If MessageBox . Show ( " The file " + Pfad5 + " already exists. " + vbNewLine + " You want to override it? " , " File exists! " , MessageBoxButtons . OKCancel ) = DialogResult . OK Then
Try
My . Computer . FileSystem . DeleteFile ( Pfad5 )
Catch ex As Exception
End Try
Else
Grapp_RDY = True
Exit Sub
End If
End If
#End Region
If SubsOnly = False Then
If Reso = 42 And HybridMode = False Then
If MergeSubs = True Then
2021-06-04 15:25:59 +02:00
URL_DL = " -i " + Chr ( 34 ) + CR_URI_Master + Chr ( 34 ) + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command_temp + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_audio_locale )
2021-04-05 19:08:42 +02:00
Else
2021-06-04 15:25:59 +02:00
URL_DL = " -i " + Chr ( 34 ) + CR_URI_Master + Chr ( 34 ) + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_audio_locale ) + " " + ffmpeg_command_temp
2021-04-05 19:08:42 +02:00
End If
'MsgBox(URL_DL)
Else
Dim client As New System . Net . WebClient
client . Encoding = Encoding . UTF8
'MsgBox(CR_URI_Master)
Dim str As String = client . DownloadString ( CR_URI_Master )
'MsgBox(str)
If CBool ( InStr ( str , " x " + Reso . ToString + " , " ) ) Then
Reso2 = " x " + Reso . ToString
Else
'MsgBox(str)
If CBool ( InStr ( str , ResoSave + " , " ) ) Then
Reso2 = Reso2
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-04-05 19:08:42 +02:00
DialogTaskString = " Resolution "
ResoNotFoundString = str
ErrorDialog . ShowDialog ( )
Return Nothing
End Function ) )
'MsgBox(ResoBackString)
If UserCloseDialog = True Then
Throw New System . Exception ( Chr ( 34 ) + " UserAbort " + Chr ( 34 ) )
Else
Reso2 = ResoBackString
ResoSave = ResoBackString
End If
End If
End If
Dim ffmpeg_url_1 As String ( ) = str . Split ( New String ( ) { Reso2 + " , " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ffmpeg_url_3 As String ( ) = Nothing
Dim ffmpeg_url_2 As String ( ) = ffmpeg_url_1 ( 1 ) . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
ffmpeg_url_3 = ffmpeg_url_2 ( 2 ) . Split ( New [ Char ] ( ) { System . Convert . ToChar ( " # " ) } )
2021-05-23 22:27:56 +02:00
Debug . WriteLine ( CR_audio_locale )
2021-04-05 19:08:42 +02:00
If MergeSubs = True Then
2021-05-23 22:27:56 +02:00
2021-04-24 20:51:34 +02:00
Debug . WriteLine ( ConvertCC ( CR_audio_locale ) )
2021-05-23 22:27:56 +02:00
URL_DL = " -i " + Chr ( 34 ) + ffmpeg_url_3 ( 0 ) . Trim ( ) + Chr ( 34 ) + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_audio_locale )
2021-04-24 20:51:34 +02:00
'URL_DL = "-i " + Chr(34) + ffmpeg_url_3(0).Trim() + Chr(34) + " -metadata:s:a:0 language=" + CCtoMP4CC(CR_audio_locale) + " " + ffmpeg_command
2021-04-05 19:08:42 +02:00
Else
2021-06-04 15:25:59 +02:00
URL_DL = " -i " + Chr ( 34 ) + ffmpeg_url_3 ( 0 ) . Trim ( ) + Chr ( 34 ) + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_audio_locale ) + " " + ffmpeg_command_temp
2021-04-05 19:08:42 +02:00
End If
End If
End If
#Region "thumbnail"
Dim thumbnail As String ( ) = ObjectJson . Split ( New String ( ) { " https:// " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim thumbnail2 As String ( ) = thumbnail ( 1 ) . Split ( New String ( ) { Chr ( 34 ) + " } " } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
Dim thumbnail3 As String = " https:// " + thumbnail2 ( 0 ) . Replace ( " \/ " , " / " )
#End Region
#Region "<li> constructor"
Dim Subsprache3 As String = " none " 'HardSubValuesToDisplay(SubSprache2.Replace(Chr(34), ""))
Dim ResoHTMLDisplay As String = Nothing
If ResoBackString = Nothing Then
ResoHTMLDisplay = Reso . ToString + " p "
ElseIf DialogTaskString = " Language " Then
ResoHTMLDisplay = Reso . ToString + " p "
Else
Dim ResoHTML As String ( ) = ResoBackString . Split ( New String ( ) { " x " } , System . StringSplitOptions . RemoveEmptyEntries )
If ResoHTML . Count > 1 Then
ResoHTMLDisplay = ResoHTML ( 1 ) + " p "
Else
ResoHTMLDisplay = ResoHTML ( 0 ) + " p "
End If
End If
Dim L2Name As String = String . Join ( " " , CR_FilenName . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_FilenName_Backup, "[^\w\\-]", " ")
If Reso = 42 And HybridMode = False Then
ResoHTMLDisplay = " [Auto] "
ElseIf Reso = 42 And HybridMode = False Then
ResoHTMLDisplay = Reso2
End If
Pfad_DL = Pfad2
Dim L1Name_Split As String ( ) = WebsiteURL . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim L1Name As String = L1Name_Split ( 1 ) . Replace ( " www. " , " " ) + " | Dub : " + HardSubValuesToDisplay ( CR_audio_locale )
If SubsOnly = True Then
URL_DL = " -i [Subtitles only] "
End If
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-07-04 17:22:46 +02:00
ListItemAdd ( Path . GetFileName ( Pfad_DL . Replace ( Chr ( 34 ) , " " ) ) , L1Name , L2Name , ResoHTMLDisplay , Subsprache3 , SubValuesToDisplay ( ) , thumbnail3 , URL_DL , Pfad_DL )
2021-04-05 19:08:42 +02:00
Return Nothing
End Function ) )
2021-08-07 23:49:09 +02:00
liList . Add ( My . Resources . htmlvorThumbnail + thumbnail3 + My . Resources . htmlnachTumbnail + CR_title + " <br> " + CR_season_number + " " + CR_episode + My . Resources . htmlvorAufloesung + ResoHTMLDisplay + My . Resources . htmlvorSoftSubs + vbNewLine + SubValuesToDisplay ( ) + My . Resources . htmlvorHardSubs + Subsprache3 + My . Resources . htmlnachHardSubs + " <!-- " + L2Name + " --> " )
2021-04-05 19:08:42 +02:00
'Form1.RichTextBox1.Text = My.Resources.htmlvorThumbnail + thumbnail3 + My.Resources.htmlnachTumbnail + CR_Anime_Titel + " <br> " + CR_Anime_Staffel + " " + CR_Anime_Folge + My.Resources.htmlvorAufloesung + ResoHTMLDisplay + My.Resources.htmlvorSoftSubs + vbNewLine + SubValuesToDisplay() + My.Resources.htmlvorHardSubs + Subsprache3 + My.Resources.htmlnachHardSubs + "<!-- " + L2Name + "-->"
#End Region
Grapp_RDY = True
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-04-05 19:08:42 +02:00
Anime_Add . StatusLabel . Text = " Status: idle "
Me . Text = " Crunchyroll Downloader "
Me . Invalidate ( )
Return Nothing
End Function ) )
Catch ex As Exception
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-04-05 19:08:42 +02:00
Anime_Add . StatusLabel . Text = " Status: idle "
Me . Text = " Crunchyroll Downloader "
Me . Invalidate ( )
Return Nothing
End Function ) )
Grapp_RDY = True
If CBool ( InStr ( ex . ToString , " Could not find the sub language " ) ) Then
MsgBox ( Sub_language_NotFound + SubSprache )
ElseIf CBool ( InStr ( ex . ToString , " RESOLUTION Not Found " ) ) Then
MsgBox ( Resolution_NotFound )
ElseIf CBool ( InStr ( ex . ToString , " Premium Episode " ) ) Then
MsgBox ( Premium_Stream , MsgBoxStyle . Information )
ElseIf CBool ( InStr ( ex . ToString , " System.UnauthorizedAccessException " ) ) Then
MsgBox ( ErrorNoPermisson + vbNewLine + ex . ToString , MsgBoxStyle . Information )
ElseIf CBool ( InStr ( ex . ToString , Chr ( 34 ) + " UserAbort " + Chr ( 34 ) ) ) Then
MsgBox ( ex . ToString , MsgBoxStyle . Information )
Else
MsgBox ( ex . ToString , MsgBoxStyle . Information )
End If
End Try
End Sub
2021-09-20 20:37:57 +02:00
Function ConvertCC ( ByVal CC As String ) As String
2021-04-05 19:08:42 +02:00
Try
If CC = " deDE " Then
Return " de-DE "
2021-05-23 22:27:56 +02:00
ElseIf CC = " enUS " Then
Return " en-US "
2021-04-05 19:08:42 +02:00
ElseIf CC = " ptBR " Then
Return " pt-BR "
ElseIf CC = " esLA " Then
Return " es-LA "
ElseIf CC = " frFR " Then
Return " fr-FR "
ElseIf CC = " arME " Then
Return " ar-ME "
ElseIf CC = " ruRU " Then
Return " ru-RU "
ElseIf CC = " itIT " Then
Return " it-IT "
ElseIf CC = " esES " Then
2021-05-23 22:27:56 +02:00
Return " es-ES "
2021-04-05 19:08:42 +02:00
ElseIf CC = " jaJP " Then
Return " ja-JP "
2021-04-24 20:51:34 +02:00
ElseIf CC = " None " Then
Return " "
2021-04-05 19:08:42 +02:00
Else
Return CB_SuB_Nothing
End If
Catch ex As Exception
Return Nothing
End Try
End Function
#End Region
2019-11-10 00:16:12 +01:00
2021-09-20 20:37:57 +02:00
#Region "vrv.co"
2019-11-10 00:16:12 +01:00
2021-07-04 17:22:46 +02:00
2021-09-20 20:37:57 +02:00
Public Sub Get_VRV_VideoProxy ( ByVal requesturl As String , ByVal WebsiteURL As String )
Dim Evaluator = New Thread ( Sub ( ) Me . Get_VRV_Video ( requesturl , WebsiteURL ) )
Evaluator . Start ( )
End Sub
2021-02-20 18:25:49 +01:00
2021-09-20 20:37:57 +02:00
Public Sub Get_VRV_Video ( ByVal Streams As String , ByVal WebsiteURL As String )
2021-07-04 17:22:46 +02:00
2021-09-20 20:37:57 +02:00
Try
Grapp_RDY = False
2021-02-20 18:25:49 +01:00
2021-09-20 20:37:57 +02:00
Dim ffmpeg_command_temp As String = ffmpeg_command
If VideoFormat = " .aac " Then
Dim ffmpeg_command_Builder ( ) As String = ffmpeg_command . Split ( New String ( ) { " -c:a copy " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-07-04 17:22:46 +02:00
2021-09-20 20:37:57 +02:00
ffmpeg_command_temp = " -c:a copy " + ffmpeg_command_Builder ( 1 )
End If
Dim CR_series_title As String = Nothing
Dim CR_season_number As String = Nothing
Dim CR_episode As String = Nothing
Dim CR_Anime_Staffel_int As String = Nothing
Dim CR_episode_int As String = Nothing
Dim CR_title As String = Nothing
Dim CR_audio_locale As String = Nothing
2021-07-04 17:22:46 +02:00
2021-09-20 20:37:57 +02:00
#Region "Name + Pfad"
Dim Pfad2 As String
Dim TextBox2_Text As String = Nothing
Dim CR_FilenName As String = Nothing
Dim ObjectJson As String = Nothing
2021-02-20 18:25:49 +01:00
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
TextBox2_Text = Anime_Add . textBox2 . Text
Return Nothing
End Function ) )
#Region "Name von Crunchyroll"
Dim ObjectsURLBuilder ( ) As String = Streams . Split ( New String ( ) { " videos " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURLBuilder2 ( ) As String = ObjectsURLBuilder ( 1 ) . Split ( New String ( ) { " /streams " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURLBuilder3 ( ) As String = WebsiteURL . Split ( New String ( ) { " watch/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURLBuilder4 ( ) As String = ObjectsURLBuilder3 ( 1 ) . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURL As String = ObjectsURLBuilder ( 0 ) + " objects/ " + ObjectsURLBuilder4 ( 0 ) + ObjectsURLBuilder2 ( 1 )
Debug . WriteLine ( ObjectsURL )
2019-11-10 00:16:12 +01:00
2021-07-04 17:22:46 +02:00
Try
2021-09-20 20:37:57 +02:00
Using client As New WebClient ( )
client . Encoding = System . Text . Encoding . UTF8
client . Headers . Add ( My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) )
ObjectJson = client . DownloadString ( ObjectsURL )
End Using
2021-07-04 17:22:46 +02:00
Catch ex As Exception
2021-09-20 20:37:57 +02:00
Debug . WriteLine ( " error- getting name data " )
Exit Sub
2021-07-04 17:22:46 +02:00
End Try
2021-09-20 20:37:57 +02:00
Dim ser As JObject = JObject . Parse ( ObjectJson )
Dim data As List ( Of JToken ) = ser . Children ( ) . ToList
2021-07-04 17:22:46 +02:00
2021-09-20 20:37:57 +02:00
If TextBox2_Text = Nothing Or TextBox2_Text = " Use Custom Name " Then
2021-07-04 17:22:46 +02:00
2021-09-20 20:37:57 +02:00
For Each item As JProperty In data
item . CreateReader ( )
Select Case item . Name
Case " items " 'each record is inside the entries array
For Each Entry As JObject In item . Values
Try
Dim Title As String = Entry ( " title " ) . ToString
CR_title = String . Join ( " " , Title . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c )
2021-07-04 17:22:46 +02:00
2021-09-20 20:37:57 +02:00
Catch ex As Exception
End Try
Dim SubData As List ( Of JToken ) = Entry . Children ( ) . ToList
For Each SubItem As JProperty In SubData
'SubItem.CreateReader()
Select Case SubItem . Name
Case " episode_metadata "
For Each SubEntry As JProperty In SubItem . Values
Select Case SubEntry . Name
Case " series_title "
CR_series_title = SubEntry . Value . ToString
'Case "season_title"
' CR_season_title = SubEntry.Value.ToString
Case " season_number "
CR_season_number = SubEntry . Value . ToString
Case " episode_number "
CR_episode = SubEntry . Value . ToString
End Select
Next
End Select
Next
Next
End Select
Next
'My.Computer.Clipboard.SetText(ObjectJson)
'
CR_Anime_Staffel_int = CR_season_number
If IgnoreS1 = True Then
If CR_season_number = " 1 " Or CR_season_number = " 0 " Then
CR_season_number = Nothing
End If
End If
CR_episode_int = CR_episode
If Season_Prefix = " [default season prefix] " Then
If CR_episode = Nothing Then 'no episode number means most likey a movie
CR_season_number = Nothing
ElseIf CR_season_number = Nothing Then
Else
CR_season_number = " Season " + CR_season_number
End If
Else
If CR_episode = Nothing Then 'no episode number means most likey a movie
CR_season_number = Nothing
ElseIf CR_season_number = Nothing Then
Else
CR_season_number = Season_Prefix + CR_season_number
End If
End If
If CR_episode = Nothing Then
ElseIf Episode_Prefix = " [default episode prefix] " Then
CR_episode = " Episode " + CR_episode
Else
CR_episode = Episode_Prefix + CR_episode
End If
If CR_NameMethode = 0 Then 'nummer
If CR_season_number = Nothing Then
CR_FilenName = CR_series_title + " " + CR_episode
Else
CR_FilenName = CR_series_title + " " + CR_season_number + " " + CR_episode
End If
ElseIf CR_NameMethode = 1 Then 'name
If CR_season_number = Nothing Then
CR_FilenName = CR_series_title + " " + CR_series_title + " " + CR_title
Else
CR_FilenName = CR_series_title + " " + CR_season_number + " " + CR_title
End If
ElseIf CR_NameMethode = 2 Then ' nummer - name
If CR_season_number = Nothing Then
CR_FilenName = CR_series_title + " " + CR_series_title + " " + CR_episode + " " + CR_title
Else
CR_FilenName = CR_series_title + " " + CR_season_number + " " + CR_episode + " " + CR_title
End If
ElseIf CR_NameMethode = 3 Then ' name - nummer
If CR_season_number = Nothing Then
CR_FilenName = CR_series_title + " " + CR_title + " " + CR_episode
Else
CR_FilenName = CR_series_title + " " + CR_title + " " + CR_season_number + " " + CR_episode
End If
End If
If KodiNaming = True Then
Dim KodiString As String = " [S "
If CR_Anime_Staffel_int = " 0 " Then
CR_Anime_Staffel_int = " 01 "
Else
CR_Anime_Staffel_int = " 0 " + CR_Anime_Staffel_int
End If
Dim CR_episode_nr As String = CR_episode_int
If CR_episode_nr . Length = 1 Then
CR_episode_nr = " 0 " + CR_episode_nr
End If
KodiString = KodiString + CR_Anime_Staffel_int + " E " + CR_episode_nr
KodiString = KodiString + " ] "
CR_FilenName = KodiString + CR_FilenName
End If
Debug . WriteLine ( CR_FilenName )
#End Region
Else
CR_FilenName = RemoveExtraSpaces ( String . Join ( " " , TextBox2_Text . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) ) 'System.Text.RegularExpressions.Regex.Replace(TextBox2_Text, "[^\w\\-]", " "))
End If
CR_FilenName = String . Join ( " " , CR_FilenName . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_FilenName, "[^\w\\-]", " ")
CR_FilenName = RemoveExtraSpaces ( CR_FilenName )
'My.Computer.FileSystem.WriteAllText("log.log", WebbrowserText, False)
Pfad2 = UseSubfolder ( CR_series_title , CR_season_number , Pfad )
If Not Directory . Exists ( Path . GetDirectoryName ( Pfad2 ) ) Then
' Nein! Jetzt erstellen...
Try
Directory . CreateDirectory ( Path . GetDirectoryName ( Pfad2 ) )
Pfad2 = Chr ( 34 ) + Pfad2 + CR_FilenName + VideoFormat + Chr ( 34 )
Catch ex As Exception
' Ordner wurde nich erstellt
Pfad2 = Chr ( 34 ) + Pfad + " \ " + CR_FilenName + VideoFormat + Chr ( 34 )
Pfad2 = Pfad2 . Replace ( " \\ " , " \ " )
End Try
Else
Pfad2 = Chr ( 34 ) + Pfad2 + CR_FilenName + VideoFormat + Chr ( 34 )
End If
#End Region
#Region "VideoJson"
Dim VideoJson As String = Nothing
Try
Using client As New WebClient ( )
client . Encoding = System . Text . Encoding . UTF8
client . Headers . Add ( My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) )
VideoJson = client . DownloadString ( Streams )
End Using
Catch ex As Exception
Debug . WriteLine ( " error- getting stream data " )
Exit Sub
End Try
Dim hls_type As String = Nothing
If CBool ( InStr ( VideoJson , Chr ( 34 ) + " adaptive_hls " ) ) = True Then
hls_type = " adaptive_hls "
ElseIf CBool ( InStr ( VideoJson , Chr ( 34 ) + " multitrack_adaptive_hls_v2 " ) ) = True Then
hls_type = " multitrack_adaptive_hls_v2 "
ElseIf CBool ( InStr ( VideoJson , Chr ( 34 ) + " vo_adaptive_hls " ) ) = True Then
hls_type = " vo_adaptive_hls "
Else
MsgBox ( " No download stream avalible " , MsgBoxStyle . Critical )
Exit Sub
End If
'My.Computer.Clipboard.SetText(VideoJson)
'MsgBox(SubSprache)
Dim LangNew As String = ConvertCC ( SubSprache )
#End Region
#Region "Download softsub file or build ffmpeg cmd"
Dim SoftSubs2 As New List ( Of String )
If SoftSubs . Count > 0 Then
For i As Integer = 0 To SoftSubs . Count - 1
If CBool ( InStr ( VideoJson , Chr ( 34 ) + " locale " + Chr ( 34 ) + " : " + Chr ( 34 ) + ConvertCC ( SoftSubs ( i ) ) + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) ) ) Then
SoftSubs2 . Add ( SoftSubs ( i ) )
Else
'MsgBox("Softsubtitle for " + SoftSubs(i) + " is not avalible.", MsgBoxStyle.Information)
End If
Next
End If
Dim SoftSubMergeURLs As String = Nothing
Dim SoftSubMergeMaps As String = " -map 0:v -map 0:a "
Dim SoftSubMergeMetatata As String = Nothing
If SoftSubs2 . Count > 0 Then
If MergeSubs = True And SubsOnly = False Then
Dim DispositionIndex As Integer
For i As Integer = 0 To SoftSubs2 . Count - 1
Debug . WriteLine ( SoftSubs2 ( i ) )
If SoftSubs2 ( i ) = DefaultSubCR Then
DispositionIndex = i
End If
Dim SoftSub As String ( ) = VideoJson . Split ( New String ( ) { Chr ( 34 ) + " locale " + Chr ( 34 ) + " : " + Chr ( 34 ) + ConvertCC ( SoftSubs2 ( i ) ) + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim SoftSub_2 As String ( ) = SoftSub ( 1 ) . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
Dim SoftSub_3 As String = SoftSub_2 ( 0 ) . Replace ( " & " , " & " ) . Replace ( " /u0026 " , " & " ) . Replace ( " \u002F " , " / " ) . Replace ( " \u0026 " , " & " )
If SoftSubMergeURLs = Nothing Then
SoftSubMergeURLs = " -i " + Chr ( 34 ) + SoftSub_3 + Chr ( 34 )
Else
SoftSubMergeURLs = SoftSubMergeURLs + " -i " + Chr ( 34 ) + SoftSub_3 + Chr ( 34 )
End If
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + ( i + 1 ) . ToString
If SoftSubMergeMetatata = Nothing Then
SoftSubMergeMetatata = " -metadata:s:s: " + i . ToString + " language= " + CCtoMP4CC ( SoftSubs2 ( i ) ) + " -metadata:s:s: " + i . ToString + " title= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 ) + " -metadata:s:s: " + i . ToString + " handler_name= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 )
Else
SoftSubMergeMetatata = SoftSubMergeMetatata + " -metadata:s:s: " + i . ToString + " language= " + CCtoMP4CC ( SoftSubs2 ( i ) ) + " -metadata:s:s: " + i . ToString + " title= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 ) + " -metadata:s:s: " + i . ToString + " handler_name= " + Chr ( 34 ) + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Chr ( 34 )
End If
Next
If DispositionIndex = Nothing Then
Else
SoftSubMergeMetatata = SoftSubMergeMetatata + " -disposition:s: " + DispositionIndex . ToString + " default "
End If
Else
For i As Integer = 0 To SoftSubs2 . Count - 1
Dim i2 As Integer = i
Me . Invoke ( New Action ( Function ( ) As Object
Anime_Add . StatusLabel . Text = " Status: downloading subtitle file " + HardSubValuesToDisplay ( SoftSubs2 ( i2 ) )
Me . Text = " Status: downloading subtitle file " + HardSubValuesToDisplay ( SoftSubs2 ( i2 ) )
Me . Invalidate ( )
Return Nothing
End Function ) )
Dim SoftSub As String ( ) = VideoJson . Split ( New String ( ) { Chr ( 34 ) + " locale " + Chr ( 34 ) + " : " + Chr ( 34 ) + ConvertCC ( SoftSubs2 ( i ) ) + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim SoftSub_2 As String ( ) = SoftSub ( 1 ) . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
Dim SoftSub_3 As String = SoftSub_2 ( 0 ) . Replace ( " & " , " & " ) . Replace ( " /u0026 " , " & " ) . Replace ( " \u002F " , " / " ) . Replace ( " \u0026 " , " & " )
'MsgBox(SoftSub_3)
Dim client0 As New WebClient
client0 . Encoding = Encoding . UTF8
Dim str0 As String = client0 . DownloadString ( SoftSub_3 )
Dim Pfad3 As String = Pfad2 . Replace ( Chr ( 34 ) , " " )
Dim FN As String = Path . ChangeExtension ( Path . Combine ( Path . GetFileNameWithoutExtension ( Pfad3 ) + " . " + HardSubValuesToDisplay ( SoftSubs2 ( i ) ) + Path . GetExtension ( Pfad3 ) ) , " ass " )
'MsgBox(FN)
If i = 0 And IncludeLangName = False Then
FN = Path . ChangeExtension ( Path . GetFileName ( Pfad3 ) , " ass " )
'MsgBox(FN)
End If
Dim Pfad4 As String = Path . Combine ( Path . GetDirectoryName ( Pfad3 ) , FN )
'MsgBox(Pfad4)
File . WriteAllText ( Pfad4 , str0 , Encoding . UTF8 )
Pause ( 3 )
Next
End If
End If
#End Region
#Region "m3u8 suche"
If CBool ( InStr ( VideoJson , " audio_locale " ) ) Then
Dim CR_audio As String ( ) = VideoJson . Split ( New String ( ) { " audio_locale " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim CR_audio2 As String ( ) = CR_audio ( 1 ) . Split ( New String ( ) { Chr ( 34 ) + " , " } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
CR_audio_locale = String . Join ( " " , CR_audio2 ( 0 ) . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c )
End If
Dim CR_URI_Master As String = Nothing
'If SubsOnly = False Then
Dim ii As Integer = 0
Dim CR_VideoJson As String ( ) = VideoJson . Split ( New String ( ) { hls_type } , System . StringSplitOptions . RemoveEmptyEntries )
Dim CR_VideoJsonHardSubs As String ( ) = CR_VideoJson ( 1 ) . Split ( New String ( ) { " hardsub_locale " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Debug . WriteLine ( LangNew )
Debug . WriteLine ( CR_VideoJsonHardSubs . Count . ToString )
Dim hls_List As New List ( Of String )
For i As Integer = 0 To CR_VideoJsonHardSubs . Count - 1
If CBool ( InStr ( CR_VideoJsonHardSubs ( i ) , LangNew + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) ) ) Then
CR_URI_Master = CR_VideoJsonHardSubs ( i ) . Replace ( LangNew + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) , " " ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) ( 0 )
Exit For
End If
Next
If CR_URI_Master = Nothing Then
Me . Invoke ( New Action ( Function ( ) As Object
ResoNotFoundString = VideoJson
DialogTaskString = " Language_CR_Beta "
ErrorDialog . ShowDialog ( )
Return Nothing
End Function ) )
If UserCloseDialog = True Then
Throw New System . Exception ( Chr ( 34 ) + " UserAbort " + Chr ( 34 ) )
Else
LangNew = ResoBackString
ResoBackString = Nothing
For i As Integer = 0 To CR_VideoJsonHardSubs . Count - 1
If CBool ( InStr ( CR_VideoJsonHardSubs ( i ) , LangNew + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) ) ) Then
CR_URI_Master = CR_VideoJsonHardSubs ( i ) . Replace ( LangNew + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) , " " ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) ( 0 )
Exit For
End If
Next
End If
End If
CR_URI_Master = CR_URI_Master . Replace ( " & " , " & " ) . Replace ( " /u0026 " , " & " ) . Replace ( " \u002F " , " / " ) . Replace ( " \u0026 " , " & " )
If CBool ( InStr ( CR_URI_Master , " master.m3u8 " ) ) Then
Me . Invoke ( New Action ( Function ( ) As Object
Anime_Add . StatusLabel . Text = " Status: m3u8 found, looking for resolution "
Me . Text = " Status: m3u8 found, looking for resolution "
Me . Invalidate ( )
Return Nothing
End Function ) )
Else
Throw New System . Exception ( " Premium Episode " )
End If
'Else
' Me.Invoke(New Action(Function() As Object
' Anime_Add.StatusLabel.Text = "Status: Substitles only mode - skipped video"
' Me.Text = "Status: Substitles only mode - skipped video"
' Me.Invalidate()
' Return Nothing
' End Function))
'End If
#End Region
#Region "lösche doppel download"
Dim Pfad5 As String = Pfad2 . Replace ( Chr ( 34 ) , " " )
If My . Computer . FileSystem . FileExists ( Pfad5 ) And SubsOnly = False Then 'Pfad = Kompeltter Pfad mit Dateinamen + ENdung
Me . Invoke ( New Action ( Function ( ) As Object
Anime_Add . StatusLabel . Text = " Status: The file video already exists. "
Me . Text = " Status: The file video already exists. "
Me . Invalidate ( )
Return Nothing
End Function ) )
If MessageBox . Show ( " The file " + Pfad5 + " already exists. " + vbNewLine + " You want to override it? " , " File exists! " , MessageBoxButtons . OKCancel ) = DialogResult . OK Then
Try
My . Computer . FileSystem . DeleteFile ( Pfad5 )
Catch ex As Exception
End Try
Else
Grapp_RDY = True
Exit Sub
End If
End If
#End Region
If SubsOnly = False Then
If Reso = 42 And HybridMode = False Then
If MergeSubs = True Then
URL_DL = " -i " + Chr ( 34 ) + CR_URI_Master + Chr ( 34 ) + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command_temp + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_audio_locale )
Else
URL_DL = " -i " + Chr ( 34 ) + CR_URI_Master + Chr ( 34 ) + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_audio_locale ) + " " + ffmpeg_command_temp
End If
'MsgBox(URL_DL)
Else
Dim client As New System . Net . WebClient
client . Encoding = Encoding . UTF8
'MsgBox(CR_URI_Master)
Dim str As String = client . DownloadString ( CR_URI_Master )
'MsgBox(str)
If CBool ( InStr ( str , " x " + Reso . ToString + " , " ) ) Then
Reso2 = " x " + Reso . ToString
Else
'MsgBox(str)
If CBool ( InStr ( str , ResoSave + " , " ) ) Then
Reso2 = Reso2
Else
Me . Invoke ( New Action ( Function ( ) As Object
DialogTaskString = " Resolution "
ResoNotFoundString = str
ErrorDialog . ShowDialog ( )
Return Nothing
End Function ) )
'MsgBox(ResoBackString)
If UserCloseDialog = True Then
Throw New System . Exception ( Chr ( 34 ) + " UserAbort " + Chr ( 34 ) )
Else
Reso2 = ResoBackString
ResoSave = ResoBackString
End If
End If
End If
Dim ffmpeg_url_1 As String ( ) = str . Split ( New String ( ) { Reso2 + " , " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ffmpeg_url_3 As String ( ) = Nothing
Dim ffmpeg_url_2 As String ( ) = ffmpeg_url_1 ( 1 ) . Split ( New [ Char ] ( ) { Chr ( 34 ) } )
ffmpeg_url_3 = ffmpeg_url_2 ( 2 ) . Split ( New [ Char ] ( ) { System . Convert . ToChar ( " # " ) } )
Debug . WriteLine ( CR_audio_locale )
If MergeSubs = True Then
Debug . WriteLine ( ConvertCC ( CR_audio_locale ) )
URL_DL = " -i " + Chr ( 34 ) + ffmpeg_url_3 ( 0 ) . Trim ( ) + Chr ( 34 ) + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_audio_locale )
'URL_DL = "-i " + Chr(34) + ffmpeg_url_3(0).Trim() + Chr(34) + " -metadata:s:a:0 language=" + CCtoMP4CC(CR_audio_locale) + " " + ffmpeg_command
Else
URL_DL = " -i " + Chr ( 34 ) + ffmpeg_url_3 ( 0 ) . Trim ( ) + Chr ( 34 ) + " -metadata:s:a:0 language= " + CCtoMP4CC ( CR_audio_locale ) + " " + ffmpeg_command_temp
End If
End If
End If
#Region "thumbnail"
Dim thumbnail As String ( ) = ObjectJson . Split ( New String ( ) { " https:// " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim thumbnail2 As String ( ) = thumbnail ( 1 ) . Split ( New String ( ) { Chr ( 34 ) + " } " } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
Dim thumbnail3 As String = " https:// " + thumbnail2 ( 0 ) . Replace ( " \/ " , " / " )
Debug . WriteLine ( thumbnail3 )
#End Region
#Region "<li> constructor"
Dim Subsprache3 As String = " none " 'HardSubValuesToDisplay(SubSprache2.Replace(Chr(34), ""))
Dim ResoHTMLDisplay As String = Nothing
If ResoBackString = Nothing Then
ResoHTMLDisplay = Reso . ToString + " p "
ElseIf DialogTaskString = " Language " Then
ResoHTMLDisplay = Reso . ToString + " p "
Else
Dim ResoHTML As String ( ) = ResoBackString . Split ( New String ( ) { " x " } , System . StringSplitOptions . RemoveEmptyEntries )
If ResoHTML . Count > 1 Then
ResoHTMLDisplay = ResoHTML ( 1 ) + " p "
Else
ResoHTMLDisplay = ResoHTML ( 0 ) + " p "
End If
End If
Dim L2Name As String = String . Join ( " " , CR_FilenName . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_FilenName_Backup, "[^\w\\-]", " ")
If Reso = 42 And HybridMode = False Then
ResoHTMLDisplay = " [Auto] "
ElseIf Reso = 42 And HybridMode = False Then
ResoHTMLDisplay = Reso2
End If
Pfad_DL = Pfad2
Dim L1Name_Split As String ( ) = WebsiteURL . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim L1Name As String = L1Name_Split ( 1 ) . Replace ( " www. " , " " ) + " | Dub : " + HardSubValuesToDisplay ( CR_audio_locale )
If SubsOnly = True Then
URL_DL = " -i [Subtitles only] "
End If
Me . Invoke ( New Action ( Function ( ) As Object
ListItemAdd ( Path . GetFileName ( Pfad_DL . Replace ( Chr ( 34 ) , " " ) ) , L1Name , L2Name , ResoHTMLDisplay , Subsprache3 , SubValuesToDisplay ( ) , thumbnail3 , URL_DL , Pfad_DL )
Return Nothing
End Function ) )
liList . Add ( My . Resources . htmlvorThumbnail + thumbnail3 + My . Resources . htmlnachTumbnail + CR_title + " <br> " + CR_season_number + " " + CR_episode + My . Resources . htmlvorAufloesung + ResoHTMLDisplay + My . Resources . htmlvorSoftSubs + vbNewLine + SubValuesToDisplay ( ) + My . Resources . htmlvorHardSubs + Subsprache3 + My . Resources . htmlnachHardSubs + " <!-- " + L2Name + " --> " )
'Form1.RichTextBox1.Text = My.Resources.htmlvorThumbnail + thumbnail3 + My.Resources.htmlnachTumbnail + CR_Anime_Titel + " <br> " + CR_Anime_Staffel + " " + CR_Anime_Folge + My.Resources.htmlvorAufloesung + ResoHTMLDisplay + My.Resources.htmlvorSoftSubs + vbNewLine + SubValuesToDisplay() + My.Resources.htmlvorHardSubs + Subsprache3 + My.Resources.htmlnachHardSubs + "<!-- " + L2Name + "-->"
#End Region
Grapp_RDY = True
Me . Invoke ( New Action ( Function ( ) As Object
Anime_Add . StatusLabel . Text = " Status: idle "
Me . Text = " Crunchyroll Downloader "
Me . Invalidate ( )
Return Nothing
End Function ) )
Catch ex As Exception
Me . Invoke ( New Action ( Function ( ) As Object
Anime_Add . StatusLabel . Text = " Status: idle "
Me . Text = " Crunchyroll Downloader "
Me . Invalidate ( )
Return Nothing
End Function ) )
Grapp_RDY = True
If CBool ( InStr ( ex . ToString , " Could not find the sub language " ) ) Then
MsgBox ( Sub_language_NotFound + SubSprache )
ElseIf CBool ( InStr ( ex . ToString , " RESOLUTION Not Found " ) ) Then
MsgBox ( Resolution_NotFound )
ElseIf CBool ( InStr ( ex . ToString , " Premium Episode " ) ) Then
MsgBox ( Premium_Stream , MsgBoxStyle . Information )
ElseIf CBool ( InStr ( ex . ToString , " System.UnauthorizedAccessException " ) ) Then
MsgBox ( ErrorNoPermisson + vbNewLine + ex . ToString , MsgBoxStyle . Information )
ElseIf CBool ( InStr ( ex . ToString , Chr ( 34 ) + " UserAbort " + Chr ( 34 ) ) ) Then
MsgBox ( ex . ToString , MsgBoxStyle . Information )
Else
MsgBox ( ex . ToString , MsgBoxStyle . Information )
End If
End Try
End Sub
Public Sub Get_VRV_Seasons ( ByVal JsonUrl As String )
Anime_Add . groupBox2 . Visible = True
Anime_Add . PictureBox1 . Enabled = True
Anime_Add . PictureBox1 . Visible = True
Anime_Add . groupBox1 . Visible = False
Anime_Add . ComboBox1 . Items . Clear ( )
Anime_Add . comboBox3 . Items . Clear ( )
Anime_Add . comboBox4 . Items . Clear ( )
Anime_Add . ComboBox1 . Text = Nothing
Anime_Add . comboBox3 . Text = Nothing
Anime_Add . comboBox4 . Text = Nothing
Anime_Add . ComboBox1 . Enabled = True
Anime_Add . comboBox3 . Enabled = True
Anime_Add . comboBox4 . Enabled = True
Dim SeasonJson As String = Nothing
Try
Using client As New WebClient ( )
client . Encoding = System . Text . Encoding . UTF8
client . Headers . Add ( My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) )
SeasonJson = client . DownloadString ( JsonUrl )
End Using
Catch ex As Exception
Debug . WriteLine ( " error- getting SeasonJson data " )
End Try
Dim ParameterSplit ( ) As String = JsonUrl . Split ( New String ( ) { " &Policy= " } , System . StringSplitOptions . RemoveEmptyEntries )
VRVMassParameters = ParameterSplit ( 1 )
VRVMass = SeasonJson
Dim BaseURLBuilder ( ) As String = JsonUrl . Split ( New String ( ) { " seasons? " } , System . StringSplitOptions . RemoveEmptyEntries )
VRVMassBaseURL = BaseURLBuilder ( 0 )
Dim ser As JObject = JObject . Parse ( SeasonJson )
Dim data As List ( Of JToken ) = ser . Children ( ) . ToList
For Each item As JProperty In data
item . CreateReader ( )
Select Case item . Name
Case " items " 'each record is inside the entries array
For Each Entry As JObject In item . Values
Dim title As String = Entry ( " title " ) . ToString
Anime_Add . ComboBox1 . Items . Add ( title )
Next
End Select
Next
'Dim SeasonSplit() As String = SeasonJson.Split(New String() {Chr(34) + "title" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
'For i As Integer = 1 To SeasonSplit.Count - 1
' Dim SeasonSplit2() As String = SeasonSplit(i).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
'Next
End Sub
Public Async Sub Download_VRV_Seasons ( )
Try
Dim ListOfEpisodes As New List ( Of String )
Dim EpisodeSplit ( ) As String = VRVMassEpisodes . Split ( New String ( ) { Chr ( 34 ) + " id " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
For i As Integer = 1 To EpisodeSplit . Count - 1
Dim EpisodeSplit2 ( ) As String = EpisodeSplit ( i ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
ListOfEpisodes . Add ( " https://vrv.co/watch/ " + EpisodeSplit2 ( 0 ) + " / " )
Debug . WriteLine ( " https://vrv.co/watch/ " + EpisodeSplit2 ( 0 ) + " / " )
Next
Dim First As Integer = 0
Dim Last As Integer = 0
If Anime_Add . comboBox4 . SelectedIndex > Anime_Add . comboBox3 . SelectedIndex Or Anime_Add . comboBox4 . SelectedIndex = Anime_Add . comboBox3 . SelectedIndex Then
First = Anime_Add . comboBox3 . SelectedIndex
Last = Anime_Add . comboBox4 . SelectedIndex
ElseIf Anime_Add . comboBox3 . SelectedIndex > Anime_Add . comboBox4 . SelectedIndex Then
First = Anime_Add . comboBox4 . SelectedIndex
Last = Anime_Add . comboBox3 . SelectedIndex
End If
Dim Anzahl As Integer = Anime_Add . comboBox4 . SelectedIndex - Anime_Add . comboBox3 . SelectedIndex
For i As Integer = First To Last
For e As Integer = 0 To Integer . MaxValue
If Grapp_RDY = True Then
Try
Dim ItemFinshedCount As Integer = 0
For i2 As Integer = 0 To ListView1 . Items . Count - 1
If ItemList ( i2 ) . GetIsStatusFinished ( ) = True Then
ItemFinshedCount = ItemFinshedCount + 1
End If
Next
RunningDownloads = ListView1 . Items . Count - ItemFinshedCount
Catch ex As Exception
RunningDownloads = ListView1 . Items . Count
End Try
If RunningDownloads < MaxDL Then
Exit For
Else
'MsgBox(e)
Await Task . Delay ( 1000 )
End If
Else
Await Task . Delay ( 5000 )
End If
Next
If Anime_Add . Mass_DL_Cancel = False Then
b = True
Exit For
Grapp_Abord = True
'MsgBox("dl_abourd")
End If
If UseQueue = True Then
Anime_Add . ListBox1 . Items . Add ( ListOfEpisodes ( i ) )
Anime_Add . Add_Display . ForeColor = Color . FromArgb ( 9248044 )
Pause ( 1 )
Anime_Add . Add_Display . ForeColor = Color . Black
Else
Grapp_RDY = False
b = False
Debug . WriteLine ( " b: " + b . ToString )
Navigate ( ListOfEpisodes ( i ) )
End If
Anime_Add . Add_Display . Text = ( i - First + 1 ) . ToString + " / " + ( Last - First + 1 ) . ToString
Next
Catch ex As Exception
If Debug2 = True Then
MsgBox ( ex . ToString )
End If
Anime_Add . comboBox4 . Items . Clear ( )
Anime_Add . comboBox3 . Items . Clear ( )
Aktuell = 0 . ToString
Gesamt = 0 . ToString
Anime_Add . groupBox1 . Visible = True
Anime_Add . groupBox2 . Visible = False
Anime_Add . GroupBox3 . Visible = False
Anime_Add . Mass_DL_Cancel = False
Anime_Add . btn_dl . Text = " Download " 'btn_dl.BackgroundImage = My.Resources.main_button_download_default
End Try
Pause ( 5 )
Anime_Add . groupBox1 . Visible = True
Anime_Add . groupBox2 . Visible = False
Anime_Add . GroupBox3 . Visible = False
Anime_Add . Mass_DL_Cancel = False
Anime_Add . btn_dl . Text = " Download " 'Anime_Add.btn_dl.BackgroundImage = My.Resources.main_button_download_default
End Sub
#End Region
Private Sub Btn_Close_Click ( sender As Object , e As EventArgs ) Handles Btn_Close . Click
If RunningDownloads > 0 Then
If MessageBox . Show ( " Are you sure you want close the program and end all active downloads? " , " confirm? " , MessageBoxButtons . YesNo , MessageBoxIcon . Question ) = DialogResult . Yes Then
For i As Integer = 0 To ListView1 . Items . Count - 1
ItemList ( i ) . KillRunningTask ( )
Next
RemoveTempFiles ( )
Me . Close ( )
End If
Else
Timer3 . Enabled = False
RemoveTempFiles ( )
Me . Close ( )
End If
End Sub
Private Sub RemoveTempFiles ( )
Try
Dim files ( ) As String = System . IO . Directory . GetFiles ( Application . StartupPath )
For Each file As String In files
If CBool ( InStr ( file , " CRD-Temp-File- " ) ) Then
System . IO . File . Delete ( file )
End If
Next
Catch ex As Exception
End Try
If KeepCache = False Then
Try
Dim di As New System . IO . DirectoryInfo ( Pfad )
For Each fi As System . IO . DirectoryInfo In di . EnumerateDirectories ( " *.* " , System . IO . SearchOption . TopDirectoryOnly )
If fi . Attributes . HasFlag ( System . IO . FileAttributes . Hidden ) Then
Else
If CBool ( InStr ( fi . Name , " CRD-Temp-File- " ) ) Then
System . IO . Directory . Delete ( fi . FullName , True )
End If
End If
Next
Catch ex As Exception
End Try
End If
End Sub
Private Sub RetryWithCachedFiles ( )
Try
Dim di As New System . IO . DirectoryInfo ( Pfad )
For Each fi As System . IO . DirectoryInfo In di . EnumerateDirectories ( " *.* " , System . IO . SearchOption . TopDirectoryOnly )
If fi . Attributes . HasFlag ( System . IO . FileAttributes . Hidden ) Then
Else
If CBool ( InStr ( fi . Name , " CRD-Temp-File- " ) ) Then
If File . Exists ( fi . FullName + " \Retry\retry.txt " ) Then
If MessageBox . Show ( " Cached data found, you can try to retry the download by pressing 'Yes' " , " Retry? " , MessageBoxButtons . YesNo ) = DialogResult . Yes Then
Dim L1Name As String = Nothing
Dim L2Name As String = Nothing
Dim ResoHTMLDisplay As String = Nothing
Dim Subsprache3 As String = Nothing
Dim thumbnail3 As String = " file:/// " + fi . FullName + " /Retry/retry.jpg "
Dim Pfad2 As String = fi . FullName
Dim URL2 As String = Nothing
Dim Filename As String = Nothing
Dim reader As StreamReader = My . Computer . FileSystem . OpenTextFileReader ( fi . FullName + " \Retry\retry.txt " )
Dim a As String
For i As Integer = 0 To 5
a = reader . ReadLine
If i = 0 Then
URL2 = a
ElseIf i = 1 Then
L1Name = a
ElseIf i = 2 Then
L2Name = a
ElseIf i = 3 Then
ResoHTMLDisplay = a
ElseIf i = 4 Then
Subsprache3 = a
ElseIf i = 5 Then
Filename = Path . GetFileName ( a . Replace ( Chr ( 34 ) , " " ) )
End If
Next
reader . Close ( )
Me . Invoke ( New Action ( Function ( ) As Object
ListItemAdd ( Filename , L1Name , L2Name , ResoHTMLDisplay , Subsprache3 , SubValuesToDisplay ( ) , thumbnail3 , URL2 , Pfad2 )
Return Nothing
End Function ) )
liList . Add ( My . Resources . htmlvorThumbnail + thumbnail3 + My . Resources . htmlnachTumbnail + L1Name + " <br> " + L2Name + My . Resources . htmlvorAufloesung + ResoHTMLDisplay + My . Resources . htmlvorSoftSubs + vbNewLine + SubValuesToDisplay ( ) + My . Resources . htmlvorHardSubs + Subsprache3 + My . Resources . htmlnachHardSubs + " <!-- " + L2Name + " --> " )
Else
Grapp_non_cr_RDY = True
System . IO . Directory . Delete ( fi . FullName , True )
Exit Sub
End If
Else
System . IO . Directory . Delete ( fi . FullName , True )
End If
End If
2020-09-30 18:19:31 +02:00
End If
2021-08-08 12:23:22 +02:00
Next
Catch ex As Exception
End Try
2021-07-04 17:22:46 +02:00
2020-09-30 18:19:31 +02:00
End Sub
2019-11-10 00:16:12 +01:00
2021-07-04 17:22:46 +02:00
2021-09-20 20:37:57 +02:00
Private Sub Btn_add_Click ( sender As Object , e As EventArgs ) Handles Btn_add . Click
2020-12-13 16:11:43 +01:00
If Anime_Add . WindowState = System . Windows . Forms . FormWindowState . Minimized Then
Anime_Add . WindowState = System . Windows . Forms . FormWindowState . Normal
Else
Anime_Add . Show ( )
End If
2019-11-10 00:16:12 +01:00
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Btn_Settings_Click ( sender As Object , ByVal e As EventArgs ) Handles Btn_Settings . Click
Einstellungen . Show ( )
End Sub
Private Sub ToggleDebugModeToolStripMenuItem_Click ( sender As Object , e As EventArgs ) Handles ToggleDebugModeToolStripMenuItem . Click
If Debug2 = True Then
Debug2 = False
MsgBox ( " Debug Mode Disabled " )
Else
Debug2 = True
MsgBox ( " Debug Mode Enabled " )
End If
End Sub
Private Sub OpenSettingsToolStripMenuItem_Click ( sender As Object , e As EventArgs ) Handles OpenSettingsToolStripMenuItem . Click
2021-02-07 13:47:30 +01:00
Einstellungen . Show ( )
2019-11-10 00:16:12 +01:00
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Btn_Settings_DoubleClick ( sender As Object , e As EventArgs ) Handles Btn_Settings . DoubleClick
Einstellungen . Close ( )
If Debug1 = True Then
If Debug2 = True Then
Einstellungen . Close ( )
Try
My . Computer . Clipboard . SetText ( WebbrowserText )
MsgBox ( " webbrowser text copyed to the clipboard " )
Catch ex As Exception
End Try
Else
Debug2 = True
Einstellungen . Close ( )
MsgBox ( " Debug activated " )
End If
Else
Debug1 = True
Einstellungen . Close ( )
'MsgBox("Debug activated")
End If
End Sub
Private Sub Btn_Browser_Click ( sender As Object , e As EventArgs ) Handles Btn_Browser . Click
If Application . OpenForms ( ) . OfType ( Of CefSharp_Browser ) . Any = True Then
CefSharp_Browser . Location = Me . Location
End If
2021-04-24 20:51:34 +02:00
Debug . WriteLine ( Date . Now . ToString + " . " + Date . Now . Millisecond . ToString )
2019-11-10 00:16:12 +01:00
UserBowser = True
2021-09-20 20:37:57 +02:00
CefSharp_Browser . Show ( )
2019-11-10 00:16:12 +01:00
End Sub
Public Function RemoveExtraSpaces ( input_text As String ) As String
Dim rsRegEx As System . Text . RegularExpressions . Regex
rsRegEx = New System . Text . RegularExpressions . Regex ( " \s+ " )
Return rsRegEx . Replace ( input_text , " " ) . Trim ( )
End Function
Private Sub Timer1_Tick ( sender As Object , e As EventArgs ) Handles Timer1 . Tick
Try
For s As Integer = 0 To ListView1 . Items . Count - 1
Dim r As Rectangle = ListView1 . Items . Item ( s ) . Bounds
2020-12-12 16:21:29 +01:00
ItemList ( s ) . SetBounds ( r . X , r . Y , ListView1 . Width , r . Height )
2020-12-18 13:47:55 +01:00
ItemList ( s ) . SetTheme ( Manager . Theme )
2020-08-16 23:27:48 +02:00
If ItemList ( s ) . GetToDispose ( ) = True Then
ItemList ( s ) . DisposeItem ( ItemList ( s ) . GetToDispose ( ) )
ItemList . RemoveAt ( s )
ListView1 . Items . RemoveAt ( s )
End If
2019-11-10 00:16:12 +01:00
Next
Catch ex As Exception
End Try
End Sub
2019-12-29 16:44:16 +01:00
#Region "unused"
'Public Shared Function GetPage(url As String) As String
' Try
' Dim ourUri As New Uri(url)
' Dim myHttpWebRequest As HttpWebRequest = CType(WebRequest.Create(ourUri), HttpWebRequest)
' myHttpWebRequest.Timeout = 10000
' Dim myHttpWebResponse As HttpWebResponse = CType(myHttpWebRequest.GetResponse(), HttpWebResponse)
' Return myHttpWebResponse.ResponseUri.ToString
' myHttpWebResponse.Close()
' Catch e As Exception
' 'MsgBox(e.Message.ToString)
' Return url
' End Try
'End Function
2020-02-28 16:28:38 +01:00
Sub FFMPEGResoBack ( ByVal sender As Object , ByVal e As DataReceivedEventArgs )
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( e . Data , " : Video: " ) ) Then
2020-02-28 16:28:38 +01:00
Dim ZeileReso ( ) As String = e . Data . Split ( New String ( ) { " [ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ZeileReso2 ( ) As String = ZeileReso ( 0 ) . Split ( New String ( ) { " x " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ZeileReso3 ( ) As String = e . Data . Split ( New String ( ) { " : Video: " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ZeileReso4 ( ) As String = ZeileReso3 ( 0 ) . Split ( New String ( ) { " Stream # " } , System . StringSplitOptions . RemoveEmptyEntries )
ResoAvalibe = ResoAvalibe + vbNewLine + ZeileReso2 ( ZeileReso2 . Count - 1 ) . Trim + " :--: " + ZeileReso4 ( 1 )
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( e . Data , " At least one output file must be specified " ) ) Then
2020-02-28 16:28:38 +01:00
ResoSearchRunning = False
End If
End Sub
2019-12-29 16:44:16 +01:00
2020-02-28 16:28:38 +01:00
Public Sub FFMPEG_Reso ( ByVal DL_URL As String )
ResoSearchRunning = True
Dim proc As New Process
Dim exepath As String = Application . StartupPath + " \ffmpeg.exe "
Dim startinfo As New System . Diagnostics . ProcessStartInfo
2019-12-29 16:44:16 +01:00
2020-02-28 16:28:38 +01:00
Dim cmd As String = " -i " + Chr ( 34 ) + DL_URL + Chr ( 34 ) 'start ffmpeg with command strFFCMD string
Dim ffmpegOutput As String = Nothing
Dim ffmpegOutput2 As String = Nothing
'all parameters required to run the process
startinfo . FileName = exepath
startinfo . Arguments = cmd
startinfo . UseShellExecute = False
startinfo . WindowStyle = ProcessWindowStyle . Hidden
startinfo . RedirectStandardError = True
startinfo . RedirectStandardOutput = True
startinfo . CreateNoWindow = True
AddHandler proc . ErrorDataReceived , AddressOf FFMPEGResoBack
AddHandler proc . OutputDataReceived , AddressOf FFMPEGResoBack
proc . StartInfo = startinfo
proc . Start ( ) ' start the process
proc . BeginOutputReadLine ( )
proc . BeginErrorReadLine ( )
'Dim ZeitAnzeige As String = Nothing
'Dim StreamNR As String = Nothing
''Math.Abs()
'Dim AllReso As String = "1080p720p480p360p"
'Dim AllResoArry() As String = AllReso.Split(New String() {"p"}, System.StringSplitOptions.RemoveEmptyEntries)
'Dim Zeilen() As String = ffmpegOutput.Split(New String() {vbNewLine}, System.StringSplitOptions.RemoveEmptyEntries)
'For i As Integer = 0 To Zeilen.Count - 1
2021-09-20 20:37:57 +02:00
' If CBool(InStr(Zeilen(i), "x" + Reso.ToString + " [") Then
2020-02-28 16:28:38 +01:00
' Dim ZeileReso() As String = Zeilen(i).Split(New String() {": Video:"}, System.StringSplitOptions.RemoveEmptyEntries)
' Dim ZeileReso2() As String = ZeileReso(0).Split(New String() {"Stream #"}, System.StringSplitOptions.RemoveEmptyEntries)
' StreamNR = ZeileReso2(1)
' End If
'Next
'Return ZeitAnzeige + "#1" + StreamNR
End Sub
2019-12-29 16:44:16 +01:00
#End Region
2019-12-21 14:40:47 +01:00
Public Sub Grapp_non_CR ( )
2021-06-04 15:25:59 +02:00
Dim ffmpeg_command_temp As String = ffmpeg_command
If VideoFormat = " .aac " Then
Dim ffmpeg_command_Builder ( ) As String = ffmpeg_command . Split ( New String ( ) { " -c:a copy " } , System . StringSplitOptions . RemoveEmptyEntries )
ffmpeg_command_temp = " -c:a copy " + ffmpeg_command_Builder ( 1 )
End If
2020-01-12 16:25:55 +01:00
If NonCR_URL = Nothing Then Exit Sub
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-01-12 16:25:55 +01:00
Anime_Add . StatusLabel . Text = " Status: m3u8 found, trying to start the download "
2020-11-13 15:57:34 +01:00
Me . Text = " Status: m3u8 found, trying to start the download "
Me . Invalidate ( )
2020-01-12 16:25:55 +01:00
Return Nothing
End Function ) )
2019-12-21 14:40:47 +01:00
Grapp_non_cr_RDY = False
2020-02-28 16:28:38 +01:00
For i As Integer = 0 To 30
If ResoSearchRunning = True Then
Pause ( 1 )
Else
Exit For
End If
Next
If Debug2 = True Then
MsgBox ( ResoSearchRunning . ToString )
End If
2019-12-29 16:44:16 +01:00
Dim Video_Title As String = WebbrowserTitle . Replace ( " - Watch on VRV " , " " ) . Replace ( " Free Streaming " , " " ) . Replace ( " Tubi " , " " )
Video_Title = RemoveExtraSpaces ( Video_Title )
2019-12-21 14:40:47 +01:00
#Region "Name + Pfad"
Dim Video_FilenName As String = Video_Title
2021-01-14 18:06:42 +01:00
Video_FilenName = String . Join ( " " , Video_FilenName . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(Video_FilenName, "[^\w\\-]", " ")
2021-03-08 21:08:26 +01:00
Video_FilenName = RemoveExtraSpaces ( Video_FilenName + VideoFormat )
2020-12-18 13:47:55 +01:00
Pfad_DL = Chr ( 34 ) + Pfad + " \ " + Video_FilenName + Chr ( 34 )
2019-12-21 14:40:47 +01:00
#End Region
2019-12-29 16:44:16 +01:00
#Region "thumbnail"
Dim thumbnail As String ( ) = Nothing
Dim thumbnail2 As String ( ) = Nothing
Dim thumbnail4 As String = " None, will usese fail image "
Try
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( WebbrowserText , " thumbnail " ) ) Then
2020-01-12 16:25:55 +01:00
thumbnail = WebbrowserText . Split ( New String ( ) { " thumbnail " } , System . StringSplitOptions . RemoveEmptyEntries )
2019-12-29 16:44:16 +01:00
End If
Catch ex As Exception
2020-01-12 16:25:55 +01:00
End Try
2019-12-29 16:44:16 +01:00
Try
For i As Integer = 0 To thumbnail . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( thumbnail ( i ) , " .jpg " ) ) Then
If CBool ( InStr ( thumbnail ( i ) , " https: " ) ) Then
2019-12-29 16:44:16 +01:00
thumbnail2 = thumbnail ( i ) . Split ( New String ( ) { " .jpg " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim thumbnail3 As String ( ) = thumbnail2 ( 0 ) . Split ( New String ( ) { " https: " } , System . StringSplitOptions . RemoveEmptyEntries )
thumbnail4 = " https: " + thumbnail3 ( thumbnail3 . Count - 1 ) . Replace ( " & " , " & " ) . Replace ( " /u0026 " , " & " ) . Replace ( " \u002F " , " / " ) . Replace ( " \/ " , " / " ) + " .jpg "
Exit For
End If
End If
2019-12-21 14:40:47 +01:00
Next
2019-12-29 16:44:16 +01:00
Catch ex As Exception
End Try
#End Region
2019-12-21 14:40:47 +01:00
#Region "lösche doppel download"
Dim Pfad5 As String = Path . Combine ( Pfad + Video_FilenName )
2019-12-29 16:44:16 +01:00
If My . Computer . FileSystem . FileExists ( Pfad5 ) Then 'Pfad = Kompeltter Pfad mit Dateinamen + ENdung
If MessageBox . Show ( " The file " + Pfad5 + " already exists. " + vbNewLine + " You want to override it? " , " File exists! " , MessageBoxButtons . OKCancel ) = DialogResult . OK Then
Try
My . Computer . FileSystem . DeleteFile ( Pfad5 )
Catch ex As Exception
End Try
Else
Grapp_non_cr_RDY = True
Exit Sub
2019-12-21 14:40:47 +01:00
End If
2019-12-29 16:44:16 +01:00
End If
2019-12-21 14:40:47 +01:00
#End Region
2020-01-12 16:25:55 +01:00
URL_DL = NonCR_URL . Replace ( " & " , " & " ) . Replace ( " /u0026 " , " & " ) . Replace ( " \u002F " , " / " ) 'hls_List.Item(i2).Replace("&", "&").Replace("/u0026", "&").Replace("\u002F", "/")
2019-12-21 14:40:47 +01:00
#Region "<li> constructor"
2021-04-05 19:08:42 +02:00
Dim Subsprache3 As String = " undefined " '
2020-01-12 16:25:55 +01:00
Dim ResoHTMLDisplay As String = " [Auto] "
2019-12-29 16:44:16 +01:00
Dim L2Name As String = Video_Title
2019-12-21 14:40:47 +01:00
Dim L1Name_Split As String ( ) = WebbrowserURL . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
2019-12-29 16:44:16 +01:00
Dim L1Name As String = L1Name_Split ( 1 )
2019-12-21 14:40:47 +01:00
Pfad_DL = Chr ( 34 ) + Pfad + " \ " + Video_FilenName + Chr ( 34 )
2020-08-27 13:25:28 +02:00
ResoHTMLDisplay = " [Auto] "
2021-04-05 19:08:42 +02:00
2021-06-04 15:25:59 +02:00
Dim cmd As String = " -i " + Chr ( 34 ) + URL_DL + Chr ( 34 ) + " " + ffmpeg_command_temp
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-08-27 13:25:28 +02:00
ListItemAdd ( Pfad_DL , L1Name , L2Name , ResoHTMLDisplay , Subsprache3 , SubValuesToDisplay ( ) , thumbnail4 , cmd , Pfad_DL )
2019-12-29 16:44:16 +01:00
Return Nothing
End Function ) )
2020-08-22 15:46:44 +02:00
2019-12-29 16:44:16 +01:00
#End Region
2021-03-08 21:08:26 +01:00
2019-12-21 14:40:47 +01:00
Grapp_non_cr_RDY = True
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2019-12-21 14:40:47 +01:00
2019-12-29 16:44:16 +01:00
Anime_Add . StatusLabel . Text = " Status: idle "
2020-11-13 15:57:34 +01:00
Me . Text = " Crunchyroll Downloader "
Me . Invalidate ( )
2019-12-29 16:44:16 +01:00
Return Nothing
End Function ) )
2020-01-12 16:25:55 +01:00
2019-12-21 14:40:47 +01:00
End Sub
2020-01-25 15:02:14 +01:00
2020-08-16 23:27:48 +02:00
Private Sub Timer2_Tick ( sender As Object , e As EventArgs ) Handles Timer2 . Tick
Try
2021-01-14 18:06:42 +01:00
Dim ItemFinshedCount As Integer = 0
2020-08-16 23:27:48 +02:00
For i As Integer = 0 To ListView1 . Items . Count - 1
2021-01-14 18:06:42 +01:00
If ItemList ( i ) . GetIsStatusFinished ( ) = True Then
ItemFinshedCount = ItemFinshedCount + 1
2020-08-16 23:27:48 +02:00
End If
Next
2021-01-14 18:06:42 +01:00
RunningDownloads = ListView1 . Items . Count - ItemFinshedCount
2021-07-04 17:22:46 +02:00
If RunningDownloads > 0 Then
SetThreadExecutionState ( EXECUTION_STATE . ES_SYSTEM_REQUIRED Or EXECUTION_STATE . ES_CONTINUOUS )
Else
SetThreadExecutionState ( EXECUTION_STATE . ES_CONTINUOUS )
End If
2020-08-16 23:27:48 +02:00
Catch ex As Exception
2021-01-22 22:45:01 +01:00
RunningDownloads = ListView1 . Items . Count
2020-08-16 23:27:48 +02:00
End Try
'FontLabel2.Text = RunningDownloads.ToString
2021-09-20 20:37:57 +02:00
'Debug.WriteLine("downloads.tick: " + RunningDownloads.ToString)
2020-08-16 23:27:48 +02:00
End Sub
2021-04-24 20:51:34 +02:00
2020-08-16 23:27:48 +02:00
Public Sub Funitmation_Grapp ( )
2021-09-20 20:37:57 +02:00
2020-08-16 23:27:48 +02:00
Try
2021-06-04 15:25:59 +02:00
Dim ffmpeg_command_temp As String = ffmpeg_command
If VideoFormat = " .aac " Then
Dim ffmpeg_command_Builder ( ) As String = ffmpeg_command . Split ( New String ( ) { " -c:a copy " } , System . StringSplitOptions . RemoveEmptyEntries )
ffmpeg_command_temp = " -c:a copy " + ffmpeg_command_Builder ( 1 )
End If
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-13 15:57:34 +01:00
Me . Text = " Status: looking for video file "
Me . Invalidate ( )
2020-09-30 18:19:31 +02:00
Return Nothing
End Function ) )
2020-08-16 23:27:48 +02:00
Funimation_Grapp_RDY = False
#Region "Name"
Dim DownloadPfad As String = Nothing
Dim FunimationSeason As String = Nothing
Dim FunimationEpisode As String = Nothing
Dim FunimationTitle As String = Nothing
2020-11-21 14:56:27 +01:00
Dim FunimationEpisodeTitle As String = Nothing
2020-08-16 23:27:48 +02:00
Dim FunimationDub As String = Nothing
2021-04-24 20:51:34 +02:00
Dim FunimationAudioMap As String = Nothing
2020-08-16 23:27:48 +02:00
Dim FunimationSeason1 ( ) As String = WebbrowserText . Split ( New String ( ) { " seasonNum: " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FunimationSeason2 ( ) As String = FunimationSeason1 ( 1 ) . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-02-07 13:47:30 +01:00
If Season_Prefix = " [default season prefix] " Then
FunimationSeason = " Season " + FunimationSeason2 ( 0 )
Else
FunimationSeason = Season_Prefix + FunimationSeason2 ( 0 )
End If
2020-08-16 23:27:48 +02:00
Dim FunimationEpisode1 ( ) As String = WebbrowserText . Split ( New String ( ) { " episodeNum: " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FunimationEpisode2 ( ) As String = FunimationEpisode1 ( 1 ) . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-02-07 13:47:30 +01:00
If Episode_Prefix = " [default episode prefix] " Then
FunimationEpisode = " Episode " + FunimationEpisode2 ( 0 )
Else
FunimationEpisode = Episode_Prefix + FunimationEpisode2 ( 0 )
End If
2020-08-16 23:27:48 +02:00
Dim FunimationTitle1 ( ) As String = WebbrowserText . Split ( New String ( ) { " .showName = ' " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FunimationTitle2 ( ) As String = FunimationTitle1 ( 1 ) . Split ( New String ( ) { " '; " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-01-14 18:06:42 +01:00
FunimationTitle = String . Join ( " " , FunimationTitle2 ( 0 ) . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(FunimationTitle2(0), "[^\w\\-]", " ").Trim(" ")
2020-08-16 23:27:48 +02:00
FunimationTitle = RemoveExtraSpaces ( FunimationTitle )
2020-11-21 14:56:27 +01:00
2020-08-16 23:27:48 +02:00
Dim FunimationDub1 ( ) As String = WebbrowserText . Split ( New String ( ) { " .showLanguage = ' " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FunimationDub2 ( ) As String = FunimationDub1 ( 1 ) . Split ( New String ( ) { " '; " } , System . StringSplitOptions . RemoveEmptyEntries )
FunimationDub = FunimationDub2 ( 0 )
2020-11-21 14:56:27 +01:00
Dim FunimationEpisodeTitle1 ( ) As String = WebbrowserText . Split ( New String ( ) { " .videoTitle = ' " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FunimationEpisodeTitle2 ( ) As String = FunimationEpisodeTitle1 ( 1 ) . Split ( New String ( ) { " '; " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-01-14 18:06:42 +01:00
FunimationEpisodeTitle2 ( 0 ) = HtmlDecode ( FunimationEpisodeTitle2 ( 0 ) )
FunimationEpisodeTitle = String . Join ( " " , FunimationEpisodeTitle2 ( 0 ) . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(FunimationEpisodeTitle2(0), "[^\w\\-]", " ").Trim(" ")
2020-11-21 14:56:27 +01:00
FunimationEpisodeTitle = RemoveExtraSpaces ( FunimationEpisodeTitle )
2020-08-16 23:27:48 +02:00
2020-08-27 13:25:28 +02:00
Dim DefaultName As String = RemoveExtraSpaces ( FunimationTitle + " " + FunimationSeason + " " + FunimationEpisode )
2020-04-01 20:55:47 +02:00
2021-09-20 20:37:57 +02:00
'If CR_NameMethode = 0 Then
' DefaultName = RemoveExtraSpaces(FunimationTitle + " " + FunimationSeason + " " + FunimationEpisode)
'Else
2020-11-21 14:56:27 +01:00
If CR_NameMethode = 1 Then
DefaultName = RemoveExtraSpaces ( FunimationTitle + " " + FunimationSeason + " " + FunimationEpisodeTitle )
ElseIf CR_NameMethode = 2 Then
DefaultName = RemoveExtraSpaces ( FunimationTitle + " " + FunimationSeason + " " + FunimationEpisode + " " + FunimationEpisodeTitle )
2021-02-07 13:47:30 +01:00
ElseIf CR_NameMethode = 3 Then
DefaultName = RemoveExtraSpaces ( FunimationTitle + " " + FunimationEpisodeTitle + " " + FunimationSeason + " " + FunimationEpisode )
2020-11-21 14:56:27 +01:00
End If
2021-04-24 20:51:34 +02:00
DefaultName = DefaultName . Replace ( " ' " , " ' " )
2020-11-21 14:56:27 +01:00
2021-03-08 21:08:26 +01:00
'Dim DefaultPath As String = Pfad + "\" + DefaultName + VideoFormat
2020-12-08 19:01:35 +01:00
'DefaultPath = DefaultPath.Replace("\\", "\")
2020-08-16 23:27:48 +02:00
#End Region
#Region "Pfad"
Dim TextBox2_Text As String = Nothing
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
TextBox2_Text = Anime_Add . textBox2 . Text
2020-08-16 23:27:48 +02:00
Return Nothing
End Function ) )
2021-08-07 23:49:09 +02:00
If TextBox2_Text = Nothing Or TextBox2_Text = " Use Custom Name " Then
2020-08-16 23:27:48 +02:00
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-12-02 21:01:30 +01:00
2020-08-16 23:27:48 +02:00
Return Nothing
End Function ) )
2020-04-01 20:55:47 +02:00
End If
2020-01-25 15:02:14 +01:00
2020-12-02 21:01:30 +01:00
2020-12-08 19:01:35 +01:00
DownloadPfad = UseSubfolder ( FunimationTitle , FunimationSeason , Pfad )
2020-12-02 21:01:30 +01:00
2020-08-16 23:27:48 +02:00
If Not Directory . Exists ( Path . GetDirectoryName ( DownloadPfad ) ) Then
' Nein! Jetzt erstellen...
Try
Directory . CreateDirectory ( Path . GetDirectoryName ( DownloadPfad ) )
Catch ex As Exception
' Ordner wurde nich erstellt
2021-07-04 17:22:46 +02:00
DownloadPfad = Pfad '+ "\" + DefaultName + VideoFormat
2020-08-16 23:27:48 +02:00
End Try
End If
2020-04-01 20:55:47 +02:00
2021-04-24 20:51:34 +02:00
DownloadPfad = DownloadPfad + DefaultName + VideoFormat
2020-12-02 21:01:30 +01:00
2020-09-30 18:19:31 +02:00
#Region "lösche doppel download"
Dim Pfad5 As String = DownloadPfad . Replace ( Chr ( 34 ) , " " )
If My . Computer . FileSystem . FileExists ( Pfad5 ) Then 'Pfad = Kompeltter Pfad mit Dateinamen + ENdung
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-13 15:57:34 +01:00
Me . Text = " Status: File already exists. "
Me . Invalidate ( )
2020-09-30 18:19:31 +02:00
Return Nothing
End Function ) )
If MessageBox . Show ( " The file " + Pfad5 + " already exists. " + vbNewLine + " You want to override it? " , " File exists! " , MessageBoxButtons . OKCancel ) = DialogResult . OK Then
Try
My . Computer . FileSystem . DeleteFile ( Pfad5 )
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-13 15:57:34 +01:00
Me . Text = " Status: Old file overwritten. "
Me . Invalidate ( )
2020-09-30 18:19:31 +02:00
Return Nothing
End Function ) )
Catch ex As Exception
End Try
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-13 15:57:34 +01:00
Me . Text = " Crunchyroll Downloader "
Me . Invalidate ( )
2020-09-30 18:19:31 +02:00
Return Nothing
End Function ) )
Funimation_Grapp_RDY = True
Exit Sub
End If
End If
#End Region
2020-04-01 20:55:47 +02:00
2020-08-16 23:27:48 +02:00
#End Region
#Region "m3u8 URL"
2021-03-20 13:02:49 +01:00
Dim client0 As New WebClient
client0 . Encoding = Encoding . UTF8
Dim Funimation_m3u8_final As String = Nothing
2021-05-01 13:56:48 +02:00
Dim Funimation_iFrame As String = Nothing
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( WebbrowserText , My . Resources . Funimation_Player_ID ) ) Then
2021-05-01 13:56:48 +02:00
Funimation_iFrame = My . Resources . Funimation_Player_ID
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( WebbrowserText , My . Resources . Funimation_Player_ID_2 ) ) Then
2021-05-01 13:56:48 +02:00
Funimation_iFrame = My . Resources . Funimation_Player_ID_2
End If
Dim Player_ID ( ) As String = WebbrowserText . Split ( New String ( ) { Funimation_iFrame } , System . StringSplitOptions . RemoveEmptyEntries )
2020-08-16 23:27:48 +02:00
Dim Player_ID2 ( ) As String = Player_ID ( 1 ) . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-03-20 13:02:49 +01:00
If SubsOnly = False Then
2020-08-16 23:27:48 +02:00
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-03-20 13:02:49 +01:00
' Anime_Add.StatusLabel.Text = iFrameURL
2020-04-01 20:55:47 +02:00
2021-03-20 13:02:49 +01:00
Return Nothing
End Function ) )
2020-08-16 23:27:48 +02:00
2021-09-20 20:37:57 +02:00
2021-04-24 20:51:34 +02:00
If Not WebbrowserCookie = Nothing Then
2021-03-20 13:02:49 +01:00
client0 . Headers . Add ( HttpRequestHeader . Cookie , WebbrowserCookie )
2021-04-24 20:51:34 +02:00
ElseIf Not SystemWebBrowserCookie = Nothing Then
client0 . Headers . Add ( HttpRequestHeader . Cookie , SystemWebBrowserCookie )
2020-08-16 23:27:48 +02:00
End If
2021-04-24 20:51:34 +02:00
2021-03-20 13:02:49 +01:00
Dim str0 As String = client0 . DownloadString ( " https://www.funimation.com/api/showexperience/ " + Player_ID2 ( 0 ) + " /?pinst_id=fzQc9p9f " )
2021-04-24 20:51:34 +02:00
'MsgBox("https://www.funimation.com/api/showexperience/" + Player_ID2(0) + "/?pinst_id=fzQc9p9f")
'MsgBox(str0)
2021-03-20 13:02:49 +01:00
Dim Funimation_m3u8 ( ) As String = str0 . Split ( New String ( ) { My . Resources . Funimation_src_string } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Funimation_m3u8_Main As String = Nothing
For i As Integer = 0 To Funimation_m3u8 . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( Funimation_m3u8 ( i ) , " m3u8? " ) ) Then
2021-03-20 13:02:49 +01:00
Dim Funimation_m3u8_split ( ) As String = Funimation_m3u8 ( i ) . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
Funimation_m3u8_Main = Funimation_m3u8_split ( 0 )
Exit For
End If
Next
If Funimation_m3u8_Main = Nothing Then
2020-08-16 23:27:48 +02:00
2021-03-20 13:02:49 +01:00
If MessageBox . Show ( " No media found in: " + vbNewLine + str0 , " No media " , MessageBoxButtons . RetryCancel ) = DialogResult . Retry Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
Navigate ( WebbrowserURL )
2021-03-20 13:02:49 +01:00
Try
Anime_Add . StatusLabel . Text = " retrying Funimation "
Me . Text = " retrying Funimation "
Me . Invalidate ( )
Catch ex As Exception
End Try
Return Nothing
End Function ) )
Exit Sub
Else
Funimation_Grapp_RDY = True
Exit Sub
End If
2020-08-16 23:27:48 +02:00
2021-03-20 13:02:49 +01:00
End If
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-03-20 13:02:49 +01:00
Me . Text = " Status: Video found! "
Me . Invalidate ( )
Return Nothing
End Function ) )
2020-09-30 18:19:31 +02:00
2021-03-20 13:02:49 +01:00
Dim str1 As String = client0 . DownloadString ( Funimation_m3u8_Main . Replace ( Chr ( 34 ) , " " ) )
2021-04-24 20:51:34 +02:00
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( str1 , " # AUDIO groups " ) ) Then
2021-04-24 20:51:34 +02:00
Dim FunimationAudio ( ) As String = str1 . Split ( New String ( ) { " # AUDIO groups " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FunimationAudio2 ( ) As String = FunimationAudio ( 1 ) . Split ( New String ( ) { " URI= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FunimationAudio3 ( ) As String = FunimationAudio2 ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
FunimationAudioMap = " -headers " + My . Resources . ffmpeg_user_agend + " -i " + Chr ( 34 ) + FunimationAudio3 ( 0 ) + Chr ( 34 )
End If
Dim Streams ( ) As String = str1 . Split ( New String ( ) { " RESOLUTION= " } , System . StringSplitOptions . RemoveEmptyEntries )
2020-09-30 18:19:31 +02:00
2021-03-20 13:02:49 +01:00
'MsgBox(Funimation_m3u8_Main)
Dim FunimationBackupm3u8 As String = Nothing
2021-04-24 20:51:34 +02:00
For i As Integer = 0 To Streams . Length - 1
2020-09-30 18:19:31 +02:00
2021-04-24 20:51:34 +02:00
Try
2020-09-30 18:19:31 +02:00
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( Streams ( i ) , " x " + Reso . ToString ) ) Then
2021-04-24 20:51:34 +02:00
Dim Streams2 ( ) As String = Streams ( i ) . Split ( New String ( ) { " https:// " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Streams3 ( ) As String = Streams2 ( 1 ) . Split ( New String ( ) { " #EXT- " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StreamURL As String = " https:// " + Streams3 ( 0 ) . Trim
Dim CheckClient As New WebClient
CheckClient . Encoding = Encoding . UTF8
If Not WebbrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , WebbrowserCookie )
ElseIf Not SystemWebBrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , SystemWebBrowserCookie )
End If
2020-09-30 18:19:31 +02:00
2021-04-24 20:51:34 +02:00
Dim m3u8String As String = CheckClient . DownloadString ( StreamURL )
'MsgBox(m3u8String)
Dim keyfileurl ( ) As String = m3u8String . Split ( New String ( ) { " URI= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl2 ( ) As String = keyfileurl ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl3 As String = keyfileurl2 ( 0 )
2020-09-30 18:19:31 +02:00
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( keyfileurl2 ( 0 ) , " https:// " ) ) Then
2020-11-21 14:56:27 +01:00
2021-04-24 20:51:34 +02:00
Else
Dim c ( ) As String = New Uri ( StreamURL ) . Segments
Dim path As String = " https:// " + New Uri ( StreamURL ) . Host
2020-11-21 14:56:27 +01:00
2021-04-24 20:51:34 +02:00
For i3 As Integer = 0 To c . Count - 2
path = path + c ( i3 )
Next
keyfileurl3 = path + keyfileurl2 ( 0 ) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
End If
2020-11-21 14:56:27 +01:00
2021-04-24 20:51:34 +02:00
'MsgBox(keyfileurl3)
Try
Dim CheckClient2 As New WebClient
CheckClient2 . Encoding = System . Text . Encoding . UTF8
Dim testdl As String = CheckClient2 . DownloadString ( keyfileurl3 )
Funimation_m3u8_final = StreamURL
FunimationBackupm3u8 = StreamURL
Exit For
Catch ex As Exception
Debug . WriteLine ( keyfileurl3 + vbNewLine + vbNewLine + ex . ToString )
End Try
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( Streams ( i ) , ResoFunBackup ) ) Then
2021-04-24 20:51:34 +02:00
Dim Streams2 ( ) As String = Streams ( i ) . Split ( New String ( ) { " https:// " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Streams3 ( ) As String = Streams2 ( 1 ) . Split ( New String ( ) { " #EXT- " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StreamURL As String = " https:// " + Streams3 ( 0 ) . Trim
Dim CheckClient As New WebClient
CheckClient . Encoding = Encoding . UTF8
If Not WebbrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , WebbrowserCookie )
ElseIf Not SystemWebBrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , SystemWebBrowserCookie )
End If
Dim m3u8String As String = CheckClient . DownloadString ( StreamURL )
Dim keyfileurl ( ) As String = m3u8String . Split ( New String ( ) { " URI= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl2 ( ) As String = keyfileurl ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl3 As String = keyfileurl2 ( 0 )
2020-11-21 14:56:27 +01:00
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( keyfileurl2 ( 0 ) , " https:// " ) ) Then
2020-09-30 18:19:31 +02:00
2021-04-24 20:51:34 +02:00
Else
Dim c ( ) As String = New Uri ( StreamURL ) . Segments
Dim path As String = " https:// " + New Uri ( StreamURL ) . Host
2020-10-07 22:40:58 +02:00
2021-04-24 20:51:34 +02:00
For i3 As Integer = 0 To c . Count - 2
path = path + c ( i3 )
Next
keyfileurl3 = path + keyfileurl2 ( 0 ) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
2021-03-20 13:02:49 +01:00
End If
2021-04-24 20:51:34 +02:00
'MsgBox(keyfileurl3)
Try
Dim CheckClient2 As New WebClient
CheckClient2 . Encoding = System . Text . Encoding . UTF8
Dim testdl As String = CheckClient2 . DownloadString ( keyfileurl3 )
FunimationBackupm3u8 = StreamURL
Exit For
Catch ex As Exception
Debug . WriteLine ( keyfileurl3 + vbNewLine + vbNewLine + ex . ToString )
End Try
2021-03-20 13:02:49 +01:00
End If
2021-04-24 20:51:34 +02:00
2021-03-20 13:02:49 +01:00
Catch ex As Exception
2020-08-16 23:27:48 +02:00
2021-03-20 13:02:49 +01:00
End Try
Next
2020-09-30 18:19:31 +02:00
2021-03-20 13:02:49 +01:00
If Funimation_m3u8_final = Nothing And FunimationBackupm3u8 = Nothing Then
2020-09-30 18:19:31 +02:00
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-03-20 13:02:49 +01:00
Me . Text = " Status: Resolution not found! "
Me . Invalidate ( )
DialogTaskString = " Funimation_Resolution "
ResoNotFoundString = str1
ErrorDialog . ShowDialog ( )
Return Nothing
End Function ) )
ResoFunBackup = ResoBackString
2021-04-24 20:51:34 +02:00
For i As Integer = 0 To Streams . Length - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( Streams ( i ) , ResoBackString ) ) Then
2021-04-24 20:51:34 +02:00
Dim Streams2 ( ) As String = Streams ( i ) . Split ( New String ( ) { " https:// " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Streams3 ( ) As String = Streams2 ( 1 ) . Split ( New String ( ) { " #EXT- " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StreamURL As String = " https:// " + Streams3 ( 0 ) . Trim
Dim CheckClient As New WebClient
CheckClient . Encoding = Encoding . UTF8
If Not WebbrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , WebbrowserCookie )
ElseIf Not SystemWebBrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , SystemWebBrowserCookie )
End If
2021-03-20 13:02:49 +01:00
2021-04-24 20:51:34 +02:00
Dim m3u8String As String = CheckClient . DownloadString ( StreamURL )
'MsgBox(textLenght(i))
Dim keyfileurl ( ) As String = m3u8String . Split ( New String ( ) { " URI= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl2 ( ) As String = keyfileurl ( 1 ) . Split ( New String ( ) { Chr ( 34 ) + " , " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl3 As String = keyfileurl2 ( 0 )
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( keyfileurl2 ( 0 ) , " https:// " ) ) Then
2021-04-24 20:51:34 +02:00
Else
Dim c ( ) As String = New Uri ( StreamURL ) . Segments
Dim path As String = " https:// " + New Uri ( StreamURL ) . Host
2020-09-30 18:19:31 +02:00
2021-04-24 20:51:34 +02:00
For i3 As Integer = 0 To c . Count - 2
path = path + c ( i3 )
Next
keyfileurl3 = path + keyfileurl2 ( 0 ) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
2020-09-30 18:19:31 +02:00
End If
2021-04-24 20:51:34 +02:00
Try
Dim CheckClient2 As New WebClient
CheckClient2 . Encoding = System . Text . Encoding . UTF8
Dim testdl As String = CheckClient2 . DownloadString ( keyfileurl3 )
Funimation_m3u8_final = StreamURL
Exit For
Catch ex As Exception
Debug . WriteLine ( keyfileurl3 + vbNewLine + ex . ToString )
End Try
'Funimation_m3u8_final = textLenght(i)
'Exit For
2020-08-16 23:27:48 +02:00
End If
2021-03-20 13:02:49 +01:00
Next
ElseIf Funimation_m3u8_final = Nothing Then
Funimation_m3u8_final = FunimationBackupm3u8
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-03-20 13:02:49 +01:00
Me . Text = " Status: Resolution found! "
Me . Invalidate ( )
Return Nothing
End Function ) )
End If
2020-09-30 18:19:31 +02:00
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-03-20 13:02:49 +01:00
Me . Text = " Status: Substitles only mode - skipped video "
2020-11-13 15:57:34 +01:00
Me . Invalidate ( )
2020-09-30 18:19:31 +02:00
Return Nothing
End Function ) )
2020-08-16 23:27:48 +02:00
End If
'MsgBox(FunimationName3)
'MsgBox(Funimation_m3u8_final)
#Region "thumbnail"
Dim thumbnail As String ( ) = WebbrowserHeadText . Split ( New String ( ) { My . Resources . Funimation_thumbnail } , System . StringSplitOptions . RemoveEmptyEntries )
Dim thumbnail2 As String ( ) = thumbnail ( 1 ) . Split ( New String ( ) { Chr ( 34 ) + " > " } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
Dim thumbnail3 As String = thumbnail2 ( 0 ) '.Replace("\/", "/")
#End Region
2020-11-13 15:57:34 +01:00
Dim ResoHTMLDisplay As String = Reso . ToString + " p "
2020-08-16 23:27:48 +02:00
#Region "Subs"
2020-11-19 22:28:42 +01:00
2020-08-16 23:27:48 +02:00
Dim SubsClient As New WebClient
SubsClient . Encoding = Encoding . UTF8
2021-04-24 20:51:34 +02:00
If Not WebbrowserCookie = Nothing Then
2020-08-16 23:27:48 +02:00
SubsClient . Headers . Add ( HttpRequestHeader . Cookie , WebbrowserCookie )
2021-04-24 20:51:34 +02:00
ElseIf Not SystemWebBrowserCookie = Nothing Then
SubsClient . Headers . Add ( HttpRequestHeader . Cookie , SystemWebBrowserCookie )
2020-08-16 23:27:48 +02:00
End If
Dim PlayerPage As String = SubsClient . DownloadString ( " https://www.funimation.com/player/ " + Player_ID2 ( 0 ) + " /?bdub=0&qid= " )
2020-11-19 22:28:42 +01:00
Dim Subs_in_srt As New List ( Of String )
Dim Subs_in_vtt As New List ( Of String )
Dim Subs_in_dfxp As New List ( Of String )
2020-08-16 23:27:48 +02:00
2020-11-19 22:28:42 +01:00
Dim SoftSubs2 As New List ( Of String )
2020-08-16 23:27:48 +02:00
2020-11-19 22:28:42 +01:00
If SubFunimation . Count > 0 Then
For i As Integer = 0 To SubFunimation . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String + SubFunimation ( i ) ) ) Then
2020-11-19 22:28:42 +01:00
SoftSubs2 . Add ( My . Resources . Funimation_Subtitle_String + SubFunimation ( i ) )
Continue For
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String2 + SubFunimation ( i ) ) ) Then
2020-11-19 22:28:42 +01:00
SoftSubs2 . Add ( My . Resources . Funimation_Subtitle_String2 + SubFunimation ( i ) )
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String3 + SubFunimation ( i ) ) ) Then
2021-04-24 20:51:34 +02:00
SoftSubs2 . Add ( My . Resources . Funimation_Subtitle_String3 + SubFunimation ( i ) )
2020-08-16 23:27:48 +02:00
End If
2020-11-19 22:28:42 +01:00
2020-08-16 23:27:48 +02:00
Next
2020-11-19 22:28:42 +01:00
If SoftSubs2 . Count = 0 Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-19 22:28:42 +01:00
Me . Text = " No Subtitles found... "
Me . Invalidate ( )
Return Nothing
End Function ) )
2021-03-08 21:08:26 +01:00
File . WriteAllText ( DownloadPfad . Replace ( VideoFormat , " -subtitle_error.log " ) , PlayerPage , Encoding . UTF8 )
2020-08-16 23:27:48 +02:00
End If
2020-11-19 22:28:42 +01:00
2020-09-30 18:19:31 +02:00
End If
2020-11-19 22:28:42 +01:00
Dim HardSubFound As Boolean = False
Dim HardSubSplittString As String = Nothing
Dim UsedSub As String = Nothing
Dim UsedSubs As New List ( Of String )
Dim ffmpeg_hardsub As String = Nothing
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String + HardSubFunimation ) ) Then
2020-11-19 22:28:42 +01:00
HardSubFound = True
HardSubSplittString = My . Resources . Funimation_Subtitle_String + HardSubFunimation
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String2 + HardSubFunimation ) ) Then
2020-11-19 22:28:42 +01:00
HardSubFound = True
HardSubSplittString = My . Resources . Funimation_Subtitle_String2 + HardSubFunimation
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String3 + HardSubFunimation ) ) Then
2021-04-24 20:51:34 +02:00
HardSubFound = True
HardSubSplittString = My . Resources . Funimation_Subtitle_String3 + HardSubFunimation
2020-08-16 23:27:48 +02:00
End If
2020-09-30 18:19:31 +02:00
2020-11-19 22:28:42 +01:00
If HardSubFound = True Then 'anyways not true if hardsub is "Disabled"
2020-08-16 23:27:48 +02:00
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( ffmpeg_command , " -c copy " ) ) Then
2020-09-30 18:19:31 +02:00
ffmpeg_hardsub = " -bsf:a aac_adtstoasc "
Else
ffmpeg_hardsub = ffmpeg_command
End If
2020-12-08 19:01:35 +01:00
'MsgBox(HardSubSplittString)
2020-11-19 22:28:42 +01:00
Dim HardSubTitle ( ) As String = PlayerPage . Split ( New String ( ) { HardSubSplittString } , System . StringSplitOptions . RemoveEmptyEntries )
2020-12-08 19:01:35 +01:00
2021-01-14 18:06:42 +01:00
For i As Integer = 0 To HardSubTitle . Count - 1
Dim HardSubTitle2 ( ) As String = HardSubTitle ( i ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( HardSubTitle2 ( HardSubTitle2 . Count - 1 ) , " .srt " ) ) Then
2021-01-14 18:06:42 +01:00
UsedSub = HardSubTitle2 ( HardSubTitle2 . Count - 1 )
Exit For
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( HardSubTitle2 ( HardSubTitle2 . Count - 1 ) , " .vtt " ) ) Then
2021-01-14 18:06:42 +01:00
UsedSub = HardSubTitle2 ( HardSubTitle2 . Count - 1 )
Exit For
End If
Next
If UsedSub = Nothing Then
Throw New System . Exception ( " Error - No valid Subtitle for hard-subtiles found " )
End If
2020-12-08 19:01:35 +01:00
'MsgBox(UsedSub)
2020-11-19 22:28:42 +01:00
Dim SubText As String = client0 . DownloadString ( UsedSub )
Dim SubtitelFormat As String = " .srt "
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( UsedSub , " .vtt " ) ) Then
2020-11-19 22:28:42 +01:00
SubtitelFormat = " .vtt "
2021-09-20 20:37:57 +02:00
'ElseIf CBool(InStr(UsedSub, ".dfxp") Then
2021-01-14 18:06:42 +01:00
' SubtitelFormat = ".dfxp"
2020-09-30 18:19:31 +02:00
End If
2021-09-20 20:37:57 +02:00
UsedSub = GeräteID ( ) + SubtitelFormat
2020-11-19 22:28:42 +01:00
File . WriteAllText ( Application . StartupPath + " \ " + UsedSub , SubText , Encoding . UTF8 )
ElseIf SoftSubs2 . Count > 0 Then
For i As Integer = 0 To SoftSubs2 . Count - 1
Dim SubTitle ( ) As String = PlayerPage . Split ( New String ( ) { SoftSubs2 . Item ( i ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FoundCount As Integer = 0
For ii As Integer = 0 To SubTitle . Count - 1
Dim SubTitle2 ( ) As String = SubTitle ( ii ) . Split ( New String ( ) { My . Resources . Funimation_subs_src } , System . StringSplitOptions . RemoveEmptyEntries )
For iii As Integer = 0 To SubTitle2 . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( SubTitle2 ( iii ) , " .srt " + Chr ( 34 ) ) ) Then
ElseIf CBool ( InStr ( SubTitle2 ( iii ) , " .vtt " + Chr ( 34 ) ) ) Then
ElseIf CBool ( InStr ( SubTitle2 ( iii ) , " .dfxp " + Chr ( 34 ) ) ) Then
ElseIf CBool ( InStr ( SubTitle2 ( iii ) , " .srt " ) ) Then
2020-11-19 22:28:42 +01:00
If Subs_in_srt . Contains ( SubTitle2 ( iii ) ) Then
Else
Subs_in_srt . Add ( SubTitle2 ( iii ) )
End If
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( SubTitle2 ( iii ) , " .vtt " ) ) Then
2020-11-19 22:28:42 +01:00
If Subs_in_vtt . Contains ( SubTitle2 ( iii ) ) Then
Else
Subs_in_vtt . Add ( SubTitle2 ( iii ) )
End If
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( SubTitle2 ( iii ) , " .dfxp " ) ) Then
2020-11-19 22:28:42 +01:00
If Subs_in_dfxp . Contains ( SubTitle2 ( iii ) ) Then
Else
Subs_in_dfxp . Add ( SubTitle2 ( iii ) )
End If
End If
Next
Next
2020-11-21 14:56:27 +01:00
Dim TempCount As Integer = UsedSubs . Count
2021-04-24 20:51:34 +02:00
Try
If Funimation_srt = True Then
UsedSubs . Add ( Subs_in_srt . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
End If
Catch ex As Exception
End Try
2020-11-21 14:56:27 +01:00
2021-04-24 20:51:34 +02:00
Try
If Funimation_vtt = True Then
UsedSubs . Add ( Subs_in_vtt . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
End If
Catch ex As Exception
End Try
Try
If Funimation_dfxp = True Then
UsedSubs . Add ( Subs_in_dfxp . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
End If
Catch ex As Exception
End Try
2020-11-21 14:56:27 +01:00
If TempCount = UsedSubs . Count Then
If Subs_in_srt . Count > 0 Then
2021-04-24 20:51:34 +02:00
UsedSubs . Add ( Subs_in_srt . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
2020-11-21 14:56:27 +01:00
ElseIf Subs_in_vtt . Count > 0 Then
2021-04-24 20:51:34 +02:00
UsedSubs . Add ( Subs_in_vtt . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
2020-11-21 14:56:27 +01:00
ElseIf Subs_in_dfxp . Count > 0 Then
2021-04-24 20:51:34 +02:00
UsedSubs . Add ( Subs_in_dfxp . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
2020-11-21 14:56:27 +01:00
End If
End If
2020-11-19 22:28:42 +01:00
Subs_in_srt . Clear ( )
Subs_in_vtt . Clear ( )
Subs_in_dfxp . Clear ( )
2020-11-21 14:56:27 +01:00
2020-11-19 22:28:42 +01:00
Next
End If
'
Dim SoftSubMergeURLs As String = Nothing
Dim SoftSubMergeMaps As String = " -map 0:v -map 0:a "
2021-04-24 20:51:34 +02:00
If Not FunimationAudioMap = Nothing Then
SoftSubMergeMaps = " -map 0:v -map 1:a "
End If
2020-11-19 22:28:42 +01:00
Dim SoftSubMergeMetatata As String = Nothing
If UsedSubs . Count > 0 Then
2021-03-20 13:02:49 +01:00
If MergeSubs = True And SubsOnly = False Then
2021-02-23 19:30:18 +01:00
Dim DispositionIndex As Integer = 999
Dim LastMerged As String = Nothing
2021-04-24 20:51:34 +02:00
Dim MapCount As Integer = - 1
2020-11-19 22:28:42 +01:00
For i As Integer = 0 To UsedSubs . Count - 1
Dim SoftSub As String ( ) = UsedSubs . Item ( i ) . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-02-23 19:30:18 +01:00
If CCtoMP4CC ( SoftSub ( 1 ) ) = LastMerged Then
Continue For
Else
LastMerged = CCtoMP4CC ( SoftSub ( 1 ) )
End If
2021-04-24 20:51:34 +02:00
MapCount = MapCount + 1
2021-02-20 18:25:49 +01:00
If DefaultSubFunimation = SoftSub ( 1 ) Then
2021-02-23 19:30:18 +01:00
'Debug.WriteLine(SoftSub(1))
2021-04-24 20:51:34 +02:00
DispositionIndex = MapCount
2021-02-20 18:25:49 +01:00
End If
2020-11-19 22:28:42 +01:00
If SoftSubMergeURLs = Nothing Then
2020-12-08 19:01:35 +01:00
SoftSubMergeURLs = " -headers " + My . Resources . ffmpeg_user_agend + " -i " + Chr ( 34 ) + SoftSub ( 0 ) + Chr ( 34 )
2020-11-19 22:28:42 +01:00
Else
2021-04-24 20:51:34 +02:00
SoftSubMergeURLs = SoftSubMergeURLs + " -headers " + My . Resources . ffmpeg_user_agend + " -i " + Chr ( 34 ) + SoftSub ( 0 ) + Chr ( 34 )
2020-11-19 22:28:42 +01:00
End If
2021-04-24 20:51:34 +02:00
If FunimationAudioMap = Nothing Then
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + ( MapCount + 1 ) . ToString
Else
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + ( MapCount + 2 ) . ToString
End If
2020-11-19 22:28:42 +01:00
If SoftSubMergeMetatata = Nothing Then
2021-01-14 18:06:42 +01:00
'SoftSubMergeMetatata = " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSub(1))
2021-04-24 20:51:34 +02:00
SoftSubMergeMetatata = " -metadata:s:s: " + MapCount . ToString + " language= " + CCtoMP4CC ( SoftSub ( 1 ) ) + " -metadata:s:s: " + MapCount . ToString + " title= " + Chr ( 34 ) + HardSubValuesToDisplay ( Chr ( 34 ) + SoftSub ( 1 ) + Chr ( 34 ) ) + Chr ( 34 ) + " -metadata:s:s: " + MapCount . ToString + " handler_name= " + Chr ( 34 ) + HardSubValuesToDisplay ( Chr ( 34 ) + SoftSub ( 1 ) + Chr ( 34 ) ) + Chr ( 34 )
2020-11-19 22:28:42 +01:00
Else
2021-04-24 20:51:34 +02:00
SoftSubMergeMetatata = SoftSubMergeMetatata + " -metadata:s:s: " + MapCount . ToString + " language= " + CCtoMP4CC ( SoftSub ( 1 ) ) + " -metadata:s:s: " + MapCount . ToString + " title= " + Chr ( 34 ) + HardSubValuesToDisplay ( Chr ( 34 ) + SoftSub ( 1 ) + Chr ( 34 ) ) + Chr ( 34 ) + " -metadata:s:s: " + MapCount . ToString + " handler_name= " + Chr ( 34 ) + HardSubValuesToDisplay ( Chr ( 34 ) + SoftSub ( 1 ) + Chr ( 34 ) ) + Chr ( 34 )
2021-01-14 18:06:42 +01:00
'SoftSubMergeMetatata + " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSubs2(i))
2020-11-19 22:28:42 +01:00
End If
Next
2021-02-23 19:30:18 +01:00
If DispositionIndex < 999 Then
SoftSubMergeMetatata = SoftSubMergeMetatata + " -disposition:s: " + DispositionIndex . ToString + " default "
2021-02-20 18:25:49 +01:00
End If
2020-08-27 13:25:28 +02:00
Else
2020-11-19 22:28:42 +01:00
For i As Integer = 0 To UsedSubs . Count - 1
LabelUpdate = " Status: downloading subtitle file "
2020-11-21 14:56:27 +01:00
LabelEpisode = UsedSubs ( i )
2020-11-19 22:28:42 +01:00
Dim SoftSub As String ( ) = UsedSubs . Item ( i ) . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim SoftSub_3 As String = SoftSub ( 0 ) . Replace ( " \/ " , " / " )
Dim Subfile As String = SubsClient . DownloadString ( SoftSub_3 )
Dim Pfad3 As String = DownloadPfad . Replace ( Chr ( 34 ) , " " )
'MsgBox(FN)
Dim SubtitelFormat As String = " srt "
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( SoftSub_3 , " .vtt " ) ) Then
2020-11-19 22:28:42 +01:00
SubtitelFormat = " vtt "
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( SoftSub_3 , " .dfxp " ) ) Then
2020-11-19 22:28:42 +01:00
SubtitelFormat = " dfxp "
End If
Dim FN As String = Path . ChangeExtension ( Path . Combine ( Path . GetFileNameWithoutExtension ( Pfad3 ) + " " + SoftSub ( 1 ) + Path . GetExtension ( Pfad3 ) ) , SubtitelFormat )
If i = 0 Then
FN = Path . ChangeExtension ( Path . GetFileName ( Pfad3 ) , SubtitelFormat )
'MsgBox(FN)
End If
Dim Pfad4 As String = Path . Combine ( Path . GetDirectoryName ( Pfad3 ) , FN )
'MsgBox(Pfad4)
2020-11-21 14:56:27 +01:00
File . WriteAllText ( Pfad4 , Subfile , Encoding . UTF8 )
2020-11-19 22:28:42 +01:00
Pause ( 1 )
Next
2020-08-27 13:25:28 +02:00
End If
2020-11-19 22:28:42 +01:00
End If
#End Region
#Region "ffmpeg command"
Dim DubMetatata As String = Nothing
If FunimationDub = " japanese " Then
DubMetatata = " -metadata:s:a:0 language=jpn "
ElseIf FunimationDub = " portuguese-brazil " Then
DubMetatata = " -metadata:s:a:0 language=por "
ElseIf FunimationDub = " spanish-latin-am " Then
DubMetatata = " -metadata:s:a:0 language=spa "
Else '
DubMetatata = " -metadata:s:a:0 language=eng "
End If
2021-06-04 15:25:59 +02:00
If HardSubFound = True And CBool ( InStr ( VideoFormat , " .aac " ) ) = False Then
2021-04-24 20:51:34 +02:00
Funimation_m3u8_final = " -i " + Chr ( 34 ) + Funimation_m3u8_final + Chr ( 34 ) + FunimationAudioMap + " -vf subtitles= " + Chr ( 34 ) + UsedSub + Chr ( 34 ) + " " + ffmpeg_hardsub
2020-11-19 22:28:42 +01:00
2021-03-08 21:08:26 +01:00
ElseIf MergeSubs = True Then
2020-11-19 22:28:42 +01:00
2021-04-24 20:51:34 +02:00
Funimation_m3u8_final = " -i " + Chr ( 34 ) + Funimation_m3u8_final + Chr ( 34 ) + FunimationAudioMap + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + DubMetatata
2020-11-19 22:28:42 +01:00
2021-06-04 15:25:59 +02:00
ElseIf CBool ( InStr ( VideoFormat , " .aac " ) ) = True Then
If FunimationAudioMap = Nothing Then
Funimation_m3u8_final = " -i " + Chr ( 34 ) + Funimation_m3u8_final + Chr ( 34 ) + DubMetatata + " " + ffmpeg_command_temp
Else
Funimation_m3u8_final = FunimationAudioMap . Replace ( " -headers " + My . Resources . ffmpeg_user_agend + " " , " " ) + DubMetatata + " " + ffmpeg_command_temp
End If
2020-11-19 22:28:42 +01:00
Else
2021-06-04 15:25:59 +02:00
Funimation_m3u8_final = " -i " + Chr ( 34 ) + Funimation_m3u8_final + Chr ( 34 ) + FunimationAudioMap + DubMetatata + " " + ffmpeg_command_temp
2020-08-27 13:25:28 +02:00
2020-08-16 23:27:48 +02:00
End If
2020-11-19 22:28:42 +01:00
2020-08-16 23:27:48 +02:00
#End Region
2020-09-30 18:19:31 +02:00
'MsgBox(Funimation_m3u8_final)
2020-08-16 23:27:48 +02:00
'DownloadPfad = DownloadPfad.Replace(" \", "\")
2021-03-20 13:02:49 +01:00
If SubsOnly = True Then
Funimation_m3u8_final = " -i [Subtitles only] "
End If
2020-08-16 23:27:48 +02:00
DownloadPfad = RemoveExtraSpaces ( DownloadPfad )
Dim L1Name_Split As String ( ) = WebbrowserURL . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim L1Name As String = L1Name_Split ( 1 ) . Replace ( " www. " , " " ) + " | Dub : " + FunimationDub
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-12-10 19:18:20 +01:00
ListItemAdd ( Pfad_DL , L1Name , DefaultName , ResoHTMLDisplay , " Unknown " , SubValuesToDisplay ( ) , thumbnail3 , Funimation_m3u8_final , Chr ( 34 ) + DownloadPfad + Chr ( 34 ) , " FM " )
2020-08-16 23:27:48 +02:00
Return Nothing
End Function ) )
2020-08-22 15:46:44 +02:00
liList . Add ( My . Resources . htmlvorThumbnail + thumbnail3 + My . Resources . htmlnachTumbnail + FunimationTitle + " <br> " + FunimationSeason + " " + FunimationEpisode + My . Resources . htmlvorAufloesung + ResoHTMLDisplay + My . Resources . htmlvorSoftSubs + vbNewLine + SubValuesToDisplay ( ) + My . Resources . htmlvorHardSubs + " null " + My . Resources . htmlnachHardSubs + " <!-- " + DefaultName + " --> " )
2020-08-16 23:27:48 +02:00
#End Region
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-03-20 13:02:49 +01:00
Me . Text = " Crunchyroll Downloader "
Me . Invalidate ( )
Return Nothing
End Function ) )
2020-08-16 23:27:48 +02:00
Catch ex As Exception
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-13 15:57:34 +01:00
Me . Text = " Crunchyroll Downloader! "
Me . Invalidate ( )
2020-09-30 18:19:31 +02:00
Return Nothing
End Function ) )
2020-08-16 23:27:48 +02:00
MsgBox ( ex . ToString )
End Try
Funimation_Grapp_RDY = True
End Sub
2021-05-23 22:27:56 +02:00
#Region "Funimation JS "
2021-07-04 17:22:46 +02:00
Public Sub GetFunimationJS_Seasons ( Optional ByVal JsonUrl As String = Nothing , Optional ByVal Json As String = Nothing )
FunimtaionAPISeasonID . Clear ( )
Dim SeasonJson As String = Nothing
2021-09-20 20:37:57 +02:00
Debug . WriteLine ( " JsonUrl: " + JsonUrl )
2021-07-04 17:22:46 +02:00
If JsonUrl = Nothing Then
SeasonJson = Json
Else
2021-09-20 20:37:57 +02:00
'Navigate(JsonUrl)
'FunimationJsonBrowser = "SeasonJson"
'Exit Sub
2021-07-04 17:22:46 +02:00
Try
Using client As New WebClient ( )
client . Encoding = System . Text . Encoding . UTF8
client . Headers . Add ( My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) )
SeasonJson = client . DownloadString ( JsonUrl )
2021-09-20 20:37:57 +02:00
2021-07-04 17:22:46 +02:00
End Using
Catch ex As Exception
2021-09-20 20:37:57 +02:00
Debug . WriteLine ( " error- getting funimation SeasonJson data " )
2021-07-04 17:22:46 +02:00
FunimationJsonBrowser = " SeasonJson "
2021-09-20 20:37:57 +02:00
Navigate ( JsonUrl )
'Navigate(JsonUrl)
2021-07-04 17:22:46 +02:00
Exit Sub
End Try
End If
2021-05-23 22:27:56 +02:00
2021-09-20 20:37:57 +02:00
Debug . WriteLine ( " SeasonJson: " + SeasonJson )
SeasonJson = SeasonJson . Replace ( " </html> " , " " ) . Replace ( " <html><head></head><pre style= " + Chr ( 34 ) + " word-wrap: break-word; white-space: pre-wrap; " + Chr ( 34 ) + " > " , " " )
2021-05-23 22:27:56 +02:00
Anime_Add . groupBox2 . Visible = True
Anime_Add . PictureBox1 . Enabled = True
Anime_Add . PictureBox1 . Visible = True
Anime_Add . groupBox1 . Visible = False
Anime_Add . ComboBox1 . Items . Clear ( )
Anime_Add . comboBox3 . Items . Clear ( )
Anime_Add . comboBox4 . Items . Clear ( )
Anime_Add . ComboBox1 . Text = Nothing
Anime_Add . comboBox3 . Text = Nothing
Anime_Add . comboBox4 . Text = Nothing
Anime_Add . ComboBox1 . Enabled = True
2021-07-04 17:22:46 +02:00
Anime_Add . comboBox3 . Enabled = False
Anime_Add . comboBox4 . Enabled = False
2021-05-23 22:27:56 +02:00
2021-09-20 20:37:57 +02:00
Try
2021-05-23 22:27:56 +02:00
2021-09-20 20:37:57 +02:00
Dim ser As JObject = JObject . Parse ( SeasonJson )
Dim data As List ( Of JToken ) = ser . Children ( ) . ToList
For Each item As JProperty In data
item . CreateReader ( )
Select Case item . Name
Case " seasons " 'each record is inside the entries array
For Each Entry As JObject In item . Values
Dim name As String = Entry ( " name " ) . ToString
Anime_Add . ComboBox1 . Items . Add ( name )
'Debug.WriteLine(name)
Dim id As String = Entry ( " id " ) . ToString
FunimtaionAPISeasonID . Add ( id )
Next
End Select
Next
2021-05-23 22:27:56 +02:00
2021-09-20 20:37:57 +02:00
WebbrowserURL = " https://funimation.com/js "
Catch ex As Exception
MsgBox ( " fatal error " , MsgBoxStyle . Critical )
End Try
2021-05-23 22:27:56 +02:00
End Sub
Public Async Sub DownloadFunimationJS_Seasons ( )
Try
2021-09-20 20:37:57 +02:00
#Region "JS"
Debug . WriteLine ( " EpisodeJson: " + FunimationEpisodeJSON )
2021-07-04 17:22:46 +02:00
Anime_Add . Add_Display . Text = " preparing .... "
2021-05-23 22:27:56 +02:00
Dim ListOfEpisodes As New List ( Of String )
Dim BaseURL As String = " https://www.funimation.com/shows/ "
If FunimationRegion IsNot Nothing Then
BaseURL = " https://www.funimation.com/ " + FunimationRegion + " /shows/ "
2021-09-20 20:37:57 +02:00
Else
BaseURL = " https://www.funimation.com/en/shows/ "
2021-05-23 22:27:56 +02:00
End If
2021-09-20 20:37:57 +02:00
'Dim EpisodeSplit() As String = FunimationEpisodeJSON.Split(New String() {Chr(34) + "slug" + Chr(34) + ": " + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
'For i As Integer = 1 To EpisodeSplit.Count - 1
' Dim EpisodeSplit2() As String = EpisodeSplit(i).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
2021-05-23 22:27:56 +02:00
2021-09-20 20:37:57 +02:00
' Debug.WriteLine(BaseURL + FunimationShowPath + EpisodeSplit2(0))
' ListOfEpisodes.Add(BaseURL + FunimationShowPath + EpisodeSplit2(0)) '+ FunimationAPIRegion)
'Next
Dim ser As JObject = JObject . Parse ( FunimationEpisodeJSON )
Dim data As List ( Of JToken ) = ser . Children ( ) . ToList
For Each item As JProperty In data
item . CreateReader ( )
Select Case item . Name
Case " episodes " 'each record is inside the entries array
For Each Entry As JObject In item . Values
Dim slug As String = Entry ( " slug " ) . ToString
Debug . WriteLine ( BaseURL + FunimationShowPath + slug )
ListOfEpisodes . Add ( BaseURL + FunimationShowPath + slug ) '+ FunimationAPIRegion)
Next
End Select
2021-05-23 22:27:56 +02:00
Next
2021-09-20 20:37:57 +02:00
2021-05-23 22:27:56 +02:00
Dim First As Integer = 0
Dim Last As Integer = 0
If Anime_Add . comboBox4 . SelectedIndex > Anime_Add . comboBox3 . SelectedIndex Then
First = Anime_Add . comboBox3 . SelectedIndex
Last = Anime_Add . comboBox4 . SelectedIndex
ElseIf Anime_Add . comboBox4 . SelectedIndex = Anime_Add . comboBox3 . SelectedIndex Then
Exit Sub
Else
First = Anime_Add . comboBox4 . SelectedIndex
Last = Anime_Add . comboBox4 . SelectedIndex
End If
Dim Anzahl As Integer = Anime_Add . comboBox4 . SelectedIndex - Anime_Add . comboBox3 . SelectedIndex
For i As Integer = First To Last
For e As Integer = 0 To Integer . MaxValue
If Funimation_Grapp_RDY = True Then
Try
Dim ItemFinshedCount As Integer = 0
For i2 As Integer = 0 To ListView1 . Items . Count - 1
If ItemList ( i2 ) . GetIsStatusFinished ( ) = True Then
ItemFinshedCount = ItemFinshedCount + 1
End If
Next
RunningDownloads = ListView1 . Items . Count - ItemFinshedCount
Catch ex As Exception
RunningDownloads = ListView1 . Items . Count
End Try
If RunningDownloads < MaxDL Then
Exit For
Else
'MsgBox(e)
Await Task . Delay ( 1000 )
End If
Else
Await Task . Delay ( 5000 )
End If
Next
If Anime_Add . Mass_DL_Cancel = False Then
b = True
Exit For
Grapp_Abord = True
'MsgBox("dl_abourd")
End If
If UseQueue = True Then
Anime_Add . ListBox1 . Items . Add ( ListOfEpisodes ( i ) )
Anime_Add . Add_Display . ForeColor = Color . FromArgb ( 9248044 )
Pause ( 1 )
Anime_Add . Add_Display . ForeColor = Color . Black
Else
Funimation_Grapp_RDY = False
b = False
2021-09-20 20:37:57 +02:00
Navigate ( ListOfEpisodes ( i ) )
2021-05-23 22:27:56 +02:00
End If
Anime_Add . Add_Display . Text = ( i - First + 1 ) . ToString + " / " + ( Last - First + 1 ) . ToString
Next
2021-09-20 20:37:57 +02:00
#End Region
2021-05-23 22:27:56 +02:00
Catch ex As Exception
If Debug2 = True Then
MsgBox ( ex . ToString )
End If
Anime_Add . comboBox4 . Items . Clear ( )
Anime_Add . comboBox3 . Items . Clear ( )
Aktuell = 0 . ToString
Gesamt = 0 . ToString
Anime_Add . groupBox1 . Visible = True
Anime_Add . groupBox2 . Visible = False
Anime_Add . GroupBox3 . Visible = False
Anime_Add . Mass_DL_Cancel = False
2021-09-20 20:37:57 +02:00
Anime_Add . btn_dl . Text = " Download " 'Anime_Add.btn_dl.BackgroundImage = My.Resources.main_button_download_default
2021-05-23 22:27:56 +02:00
End Try
2021-09-20 20:37:57 +02:00
FunimationEpisodeJSON = Nothing
2021-05-23 22:27:56 +02:00
Pause ( 5 )
Anime_Add . groupBox1 . Visible = True
Anime_Add . groupBox2 . Visible = False
Anime_Add . GroupBox3 . Visible = False
Anime_Add . Mass_DL_Cancel = False
2021-09-20 20:37:57 +02:00
Anime_Add . btn_dl . Text = " Download " 'Anime_Add.btn_dl.BackgroundImage = My.Resources.main_button_download_default
2021-05-23 22:27:56 +02:00
End Sub
2021-09-20 20:37:57 +02:00
Private Function ConvertFunimationDub ( ByVal Dub As String ) As String
2021-06-04 15:25:59 +02:00
If Dub = " english " Then
Return " English "
ElseIf Dub = " spanish(Mexico) " Then
Return " Spanish (Latin Am) "
ElseIf Dub = " portuguese(Brazil) " Then
Return " Portuguese (Brazil) "
Else
Return " Japanese "
End If
End Function
2021-07-04 17:22:46 +02:00
Public Sub GetFunimationJS_VideoProxy ( Optional ByVal v1JsonURL As String = Nothing , Optional ByVal v1JsonData As String = Nothing )
Dim Evaluator = New Thread ( Sub ( ) Me . GetFunimationJS_Video ( v1JsonURL , v1JsonData ) )
2021-06-04 15:25:59 +02:00
Evaluator . Start ( )
End Sub
2021-07-04 17:22:46 +02:00
Public Sub GetFunimationJS_Video ( ByVal v1JsonUrl As String , ByVal v1JsonData As String ) ', ByVal WebsiteURL As String
Debug . WriteLine ( v1JsonUrl )
2021-06-04 15:25:59 +02:00
Dim v1Json As String = Nothing
2021-05-23 22:27:56 +02:00
2021-07-04 17:22:46 +02:00
If v1JsonUrl = Nothing Then
v1Json = v1JsonData
Else
Try
Using client As New WebClient ( )
client . Encoding = System . Text . Encoding . UTF8
client . Headers . Add ( My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) )
v1Json = client . DownloadString ( v1JsonUrl )
End Using
Catch ex As Exception
Debug . WriteLine ( " error- getting v1Json data " )
Debug . WriteLine ( ex . ToString )
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-07-04 17:22:46 +02:00
'Me.Text = "Status: error - getting v1Json data"
FunimationJsonBrowser = " v1Json "
2021-09-20 20:37:57 +02:00
Navigate ( v1JsonUrl )
2021-07-04 17:22:46 +02:00
'Anime_Add.StatusLabel.Text = "Status: error - getting v1Json data"
Me . Invalidate ( )
Return Nothing
End Function ) )
Exit Sub
End Try
End If
2021-09-20 20:37:57 +02:00
Debug . WriteLine ( " v1Json: " + v1Json )
2021-07-04 17:22:46 +02:00
If v1Json = Nothing Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
Me . Text = " Status: error - getting v1Json data "
Anime_Add . StatusLabel . Text = " Status: error - getting v1Json data "
Me . Invalidate ( )
2021-05-23 22:27:56 +02:00
Return Nothing
End Function ) )
2021-06-04 15:25:59 +02:00
Exit Sub
2021-07-04 17:22:46 +02:00
End If
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-07-04 17:22:46 +02:00
'My.Computer.Clipboard.SetText(v1Json)
Return Nothing
End Function ) )
2021-06-04 15:25:59 +02:00
Try
Dim ffmpeg_command_temp As String = ffmpeg_command
If VideoFormat = " .aac " Then
Dim ffmpeg_command_Builder ( ) As String = ffmpeg_command . Split ( New String ( ) { " -c:a copy " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
ffmpeg_command_temp = " -c:a copy " + ffmpeg_command_Builder ( 1 )
End If
2021-05-23 22:27:56 +02:00
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
Me . Text = " Status: looking for video file "
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Anime_Add . StatusLabel . Text = " Status: looking for video file "
Me . Invalidate ( )
Return Nothing
End Function ) )
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Funimation_Grapp_RDY = False
#Region "Name"
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Dim DownloadPfad As String = Nothing
Dim FunimationSeason As String = Nothing
Dim FunimationEpisode As String = Nothing
Dim FunimationTitle As String = Nothing
Dim FunimationEpisodeTitle As String = Nothing
Dim FunimationDub As String = Nothing
Dim FunimationAudioMap As String = Nothing
2021-05-23 22:27:56 +02:00
2021-06-04 16:11:06 +02:00
Dim ser As JObject = JObject . Parse ( v1Json )
Try
2021-07-04 17:22:46 +02:00
Try
2021-09-20 20:37:57 +02:00
FunimationEpisodeTitle = RemoveExtraSpaces ( ser ( " name " ) . ToString )
2021-07-04 17:22:46 +02:00
Catch ex As Exception
End Try
Try
2021-09-20 20:37:57 +02:00
Dim FunimationEpisode3 As String = RemoveExtraSpaces ( ser ( " episodeNumber " ) . ToString )
2021-07-04 17:22:46 +02:00
If Episode_Prefix = " [default episode prefix] " Then
FunimationEpisode = " Episode " + FunimationEpisode3
Else
FunimationEpisode = Episode_Prefix + FunimationEpisode3
End If
Catch ex As Exception
End Try
Try
2021-09-20 20:37:57 +02:00
FunimationTitle = RemoveExtraSpaces ( ser ( " name " ) . ToString )
2021-07-04 17:22:46 +02:00
Catch ex As Exception
End Try
2021-06-04 16:11:06 +02:00
Catch ex As Exception
End Try
2021-07-04 17:22:46 +02:00
Dim data As List ( Of JToken ) = ser . Children ( ) . ToList
2021-06-04 16:11:06 +02:00
2021-07-04 17:22:46 +02:00
For Each item As JProperty In data
item . CreateReader ( )
Select Case item . Name
Case " season " 'each record is inside the entries array
Dim SubData As List ( Of JToken ) = item . Values . ToList ( )
2021-08-08 12:23:22 +02:00
For Each SubItem As JProperty In SubData
2021-07-04 17:22:46 +02:00
2021-08-08 12:23:22 +02:00
Select Case SubItem . Name
Case " name "
2021-07-04 17:22:46 +02:00
2021-08-08 12:23:22 +02:00
If Season_Prefix = " [default season prefix] " Then
2021-07-04 17:22:46 +02:00
FunimationSeason = SubItem . Value . ToString
Debug . WriteLine ( " FunimationSeason: " + FunimationSeason )
End If
2021-08-08 12:23:22 +02:00
Case " number "
2021-07-04 17:22:46 +02:00
2021-08-08 12:23:22 +02:00
If Season_Prefix = " [default season prefix] " Then
'FunimationSeason = Entry("name")
Else
Dim EpisodeNumer As String = SubItem . Value . ToString
2021-07-04 17:22:46 +02:00
FunimationSeason = Season_Prefix + " " + EpisodeNumer
Debug . WriteLine ( " FunimationSeason: " + FunimationSeason )
End If
2021-08-08 12:23:22 +02:00
End Select
Next
2021-05-23 22:27:56 +02:00
2021-07-04 17:22:46 +02:00
Case " show " 'each record is inside the entries array
Dim SubData As List ( Of JToken ) = item . Values . ToList ( )
For Each SubItem As JProperty In SubData
Select Case SubItem . Name
Case " name "
FunimationTitle = SubItem . Value . ToString
Debug . WriteLine ( " FunimationTitle: " + FunimationTitle )
End Select
Next
End Select
Next
FunimationDub = ConvertFunimationDub ( DubFunimation ) 'FunimationDub2(0)
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Dim DefaultName As String = RemoveExtraSpaces ( FunimationTitle + " " + FunimationSeason + " " + FunimationEpisode )
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
If CR_NameMethode = 1 Then
DefaultName = RemoveExtraSpaces ( FunimationTitle + " " + FunimationSeason + " " + FunimationEpisodeTitle )
ElseIf CR_NameMethode = 2 Then
DefaultName = RemoveExtraSpaces ( FunimationTitle + " " + FunimationSeason + " " + FunimationEpisode + " " + FunimationEpisodeTitle )
ElseIf CR_NameMethode = 3 Then
DefaultName = RemoveExtraSpaces ( FunimationTitle + " " + FunimationEpisodeTitle + " " + FunimationSeason + " " + FunimationEpisode )
End If
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
DefaultName = DefaultName . Replace ( " ' " , " ' " )
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
'Dim DefaultPath As String = Pfad + "\" + DefaultName + VideoFormat
'DefaultPath = DefaultPath.Replace("\\", "\")
#End Region
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
#Region "Pfad"
Dim TextBox2_Text As String = Nothing
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
TextBox2_Text = Anime_Add . textBox2 . Text
2021-06-04 15:25:59 +02:00
Return Nothing
End Function ) )
2021-05-23 22:27:56 +02:00
2021-08-07 23:49:09 +02:00
If TextBox2_Text = Nothing Or TextBox2_Text = " Use Custom Name " Then
2021-05-23 22:27:56 +02:00
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Return Nothing
End Function ) )
2021-05-23 22:27:56 +02:00
End If
2021-06-04 15:25:59 +02:00
DownloadPfad = UseSubfolder ( FunimationTitle , FunimationSeason , Pfad )
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
If Not Directory . Exists ( Path . GetDirectoryName ( DownloadPfad ) ) Then
2021-05-23 22:27:56 +02:00
' Nein! Jetzt erstellen...
Try
2021-06-04 15:25:59 +02:00
Directory . CreateDirectory ( Path . GetDirectoryName ( DownloadPfad ) )
2021-05-23 22:27:56 +02:00
Catch ex As Exception
' Ordner wurde nich erstellt
2021-07-04 17:22:46 +02:00
DownloadPfad = Pfad '+ "\" + DefaultName + VideoFormat
2021-05-23 22:27:56 +02:00
End Try
End If
2021-06-04 15:25:59 +02:00
DownloadPfad = DownloadPfad + DefaultName + VideoFormat
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
#Region "lösche doppel download"
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Dim Pfad5 As String = DownloadPfad . Replace ( Chr ( 34 ) , " " )
If My . Computer . FileSystem . FileExists ( Pfad5 ) Then 'Pfad = Kompeltter Pfad mit Dateinamen + ENdung
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
Me . Text = " Status: File already exists. "
Me . Invalidate ( )
Return Nothing
End Function ) )
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
If MessageBox . Show ( " The file " + Pfad5 + " already exists. " + vbNewLine + " You want to override it? " , " File exists! " , MessageBoxButtons . OKCancel ) = DialogResult . OK Then
Try
My . Computer . FileSystem . DeleteFile ( Pfad5 )
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
Me . Text = " Status: Old file overwritten. "
Me . Invalidate ( )
Return Nothing
End Function ) )
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Catch ex As Exception
End Try
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
Me . Text = " Crunchyroll Downloader "
Me . Invalidate ( )
Return Nothing
End Function ) )
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Funimation_Grapp_RDY = True
Exit Sub
End If
2021-05-23 22:27:56 +02:00
End If
2021-06-04 15:25:59 +02:00
#End Region
2021-05-23 22:27:56 +02:00
#End Region
2021-06-04 15:25:59 +02:00
#Region "m3u8 URL"
Dim client0 As New WebClient
client0 . Encoding = Encoding . UTF8
Dim Funimation_m3u8_final As String = Nothing
Dim ExperienceID As String = Nothing
2021-06-04 16:11:06 +02:00
'Dim ser As JObject = JObject.Parse(v1Json)
2021-07-04 17:22:46 +02:00
'Dim data As List(Of JToken) = ser.Children().ToList
2021-06-04 15:25:59 +02:00
For Each item As JProperty In data
item . CreateReader ( )
Select Case item . Name
Case " videoList " 'each record is inside the entries array
For Each Entry As JObject In item . Values
2021-09-20 20:37:57 +02:00
Dim id As String = Entry ( " id " ) . ToString
2021-06-04 15:25:59 +02:00
Dim SubData As List ( Of JToken ) = Entry . Children ( ) . ToList
For Each SubItem As JProperty In SubData
Select Case SubItem . Name
Case " spokenLanguages "
For Each SubEntry As JObject In SubItem . Values
2021-09-20 20:37:57 +02:00
Dim name As String = SubEntry ( " name " ) . ToString
2021-06-04 15:25:59 +02:00
If name = FunimationDub Then
ExperienceID = id
End If
Next
End Select
Next
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Next
End Select
Next
If ExperienceID = Nothing Then
MsgBox ( " Dub not found " ) 'proper error handling to be done.
Exit Sub
End If
If SubsOnly = False Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
' Anime_Add.StatusLabel.Text = iFrameURL
2021-09-20 20:37:57 +02:00
'MsgBox(WebbrowserCookie)
2021-06-04 15:25:59 +02:00
Return Nothing
End Function ) )
2021-07-04 17:22:46 +02:00
2021-06-04 15:25:59 +02:00
If Not WebbrowserCookie = Nothing Then
client0 . Headers . Add ( HttpRequestHeader . Cookie , WebbrowserCookie )
ElseIf Not SystemWebBrowserCookie = Nothing Then
client0 . Headers . Add ( HttpRequestHeader . Cookie , SystemWebBrowserCookie )
End If
Dim str0 As String = client0 . DownloadString ( " https://www.funimation.com/api/showexperience/ " + ExperienceID + " /?pinst_id=fzQc9p9f " )
'MsgBox("https://www.funimation.com/api/showexperience/" + Player_ID2(0) + "/?pinst_id=fzQc9p9f")
'MsgBox(str0)
Dim Funimation_m3u8 ( ) As String = str0 . Split ( New String ( ) { My . Resources . Funimation_src_string } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Funimation_m3u8_Main As String = Nothing
For i As Integer = 0 To Funimation_m3u8 . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( Funimation_m3u8 ( i ) , " m3u8? " ) ) Then
2021-06-04 15:25:59 +02:00
Dim Funimation_m3u8_split ( ) As String = Funimation_m3u8 ( i ) . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
Funimation_m3u8_Main = Funimation_m3u8_split ( 0 )
Exit For
End If
Next
If Funimation_m3u8_Main = Nothing Then
If MessageBox . Show ( " No media found in: " + vbNewLine + str0 , " No media " , MessageBoxButtons . RetryCancel ) = DialogResult . Retry Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
Navigate ( WebbrowserURL )
2021-06-04 15:25:59 +02:00
Try
Anime_Add . StatusLabel . Text = " retrying Funimation "
Me . Text = " retrying Funimation "
Me . Invalidate ( )
Catch ex As Exception
End Try
Return Nothing
End Function ) )
Exit Sub
2021-05-23 22:27:56 +02:00
Else
2021-06-04 15:25:59 +02:00
Funimation_Grapp_RDY = True
Exit Sub
2021-05-23 22:27:56 +02:00
End If
2021-06-04 15:25:59 +02:00
End If
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
Me . Text = " Status: Video found! "
Me . Invalidate ( )
Return Nothing
End Function ) )
Dim str1 As String = client0 . DownloadString ( Funimation_m3u8_Main . Replace ( Chr ( 34 ) , " " ) )
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( str1 , " # AUDIO groups " ) ) Then
2021-06-04 15:25:59 +02:00
Dim FunimationAudio ( ) As String = str1 . Split ( New String ( ) { " # AUDIO groups " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FunimationAudio2 ( ) As String = FunimationAudio ( 1 ) . Split ( New String ( ) { " URI= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FunimationAudio3 ( ) As String = FunimationAudio2 ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
FunimationAudioMap = " -headers " + My . Resources . ffmpeg_user_agend + " -i " + Chr ( 34 ) + FunimationAudio3 ( 0 ) + Chr ( 34 )
End If
Dim Streams ( ) As String = str1 . Split ( New String ( ) { " RESOLUTION= " } , System . StringSplitOptions . RemoveEmptyEntries )
'MsgBox(Funimation_m3u8_Main)
Dim FunimationBackupm3u8 As String = Nothing
For i As Integer = 0 To Streams . Length - 1
Try
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( Streams ( i ) , " x " + Reso . ToString ) ) Then
2021-06-04 15:25:59 +02:00
Dim Streams2 ( ) As String = Streams ( i ) . Split ( New String ( ) { " https:// " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Streams3 ( ) As String = Streams2 ( 1 ) . Split ( New String ( ) { " #EXT- " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StreamURL As String = " https:// " + Streams3 ( 0 ) . Trim
Dim CheckClient As New WebClient
CheckClient . Encoding = Encoding . UTF8
If Not WebbrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , WebbrowserCookie )
ElseIf Not SystemWebBrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , SystemWebBrowserCookie )
End If
Dim m3u8String As String = CheckClient . DownloadString ( StreamURL )
'MsgBox(m3u8String)
Dim keyfileurl ( ) As String = m3u8String . Split ( New String ( ) { " URI= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl2 ( ) As String = keyfileurl ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl3 As String = keyfileurl2 ( 0 )
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( keyfileurl2 ( 0 ) , " https:// " ) ) Then
2021-06-04 15:25:59 +02:00
Else
Dim c ( ) As String = New Uri ( StreamURL ) . Segments
Dim path As String = " https:// " + New Uri ( StreamURL ) . Host
For i3 As Integer = 0 To c . Count - 2
path = path + c ( i3 )
Next
keyfileurl3 = path + keyfileurl2 ( 0 ) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
End If
'MsgBox(keyfileurl3)
Try
Dim CheckClient2 As New WebClient
CheckClient2 . Encoding = System . Text . Encoding . UTF8
Dim testdl As String = CheckClient2 . DownloadString ( keyfileurl3 )
Funimation_m3u8_final = StreamURL
FunimationBackupm3u8 = StreamURL
Exit For
Catch ex As Exception
Debug . WriteLine ( keyfileurl3 + vbNewLine + vbNewLine + ex . ToString )
End Try
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( Streams ( i ) , ResoFunBackup ) ) Then
2021-06-04 15:25:59 +02:00
Dim Streams2 ( ) As String = Streams ( i ) . Split ( New String ( ) { " https:// " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Streams3 ( ) As String = Streams2 ( 1 ) . Split ( New String ( ) { " #EXT- " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StreamURL As String = " https:// " + Streams3 ( 0 ) . Trim
Dim CheckClient As New WebClient
CheckClient . Encoding = Encoding . UTF8
If Not WebbrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , WebbrowserCookie )
ElseIf Not SystemWebBrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , SystemWebBrowserCookie )
End If
Dim m3u8String As String = CheckClient . DownloadString ( StreamURL )
Dim keyfileurl ( ) As String = m3u8String . Split ( New String ( ) { " URI= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl2 ( ) As String = keyfileurl ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl3 As String = keyfileurl2 ( 0 )
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( keyfileurl2 ( 0 ) , " https:// " ) ) Then
2021-06-04 15:25:59 +02:00
Else
Dim c ( ) As String = New Uri ( StreamURL ) . Segments
Dim path As String = " https:// " + New Uri ( StreamURL ) . Host
For i3 As Integer = 0 To c . Count - 2
path = path + c ( i3 )
Next
keyfileurl3 = path + keyfileurl2 ( 0 ) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
End If
'MsgBox(keyfileurl3)
Try
Dim CheckClient2 As New WebClient
CheckClient2 . Encoding = System . Text . Encoding . UTF8
Dim testdl As String = CheckClient2 . DownloadString ( keyfileurl3 )
FunimationBackupm3u8 = StreamURL
Exit For
Catch ex As Exception
Debug . WriteLine ( keyfileurl3 + vbNewLine + vbNewLine + ex . ToString )
End Try
End If
Catch ex As Exception
End Try
2021-05-23 22:27:56 +02:00
Next
2021-06-04 15:25:59 +02:00
If Funimation_m3u8_final = Nothing And FunimationBackupm3u8 = Nothing Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
Me . Text = " Status: Resolution not found! "
Me . Invalidate ( )
DialogTaskString = " Funimation_Resolution "
ResoNotFoundString = str1
ErrorDialog . ShowDialog ( )
Return Nothing
End Function ) )
ResoFunBackup = ResoBackString
For i As Integer = 0 To Streams . Length - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( Streams ( i ) , ResoBackString ) ) Then
2021-06-04 15:25:59 +02:00
Dim Streams2 ( ) As String = Streams ( i ) . Split ( New String ( ) { " https:// " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Streams3 ( ) As String = Streams2 ( 1 ) . Split ( New String ( ) { " #EXT- " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StreamURL As String = " https:// " + Streams3 ( 0 ) . Trim
Dim CheckClient As New WebClient
CheckClient . Encoding = Encoding . UTF8
If Not WebbrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , WebbrowserCookie )
ElseIf Not SystemWebBrowserCookie = Nothing Then
CheckClient . Headers . Add ( HttpRequestHeader . Cookie , SystemWebBrowserCookie )
End If
Dim m3u8String As String = CheckClient . DownloadString ( StreamURL )
'MsgBox(textLenght(i))
Dim keyfileurl ( ) As String = m3u8String . Split ( New String ( ) { " URI= " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl2 ( ) As String = keyfileurl ( 1 ) . Split ( New String ( ) { Chr ( 34 ) + " , " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim keyfileurl3 As String = keyfileurl2 ( 0 )
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( keyfileurl2 ( 0 ) , " https:// " ) ) Then
2021-06-04 15:25:59 +02:00
Else
Dim c ( ) As String = New Uri ( StreamURL ) . Segments
Dim path As String = " https:// " + New Uri ( StreamURL ) . Host
For i3 As Integer = 0 To c . Count - 2
path = path + c ( i3 )
Next
keyfileurl3 = path + keyfileurl2 ( 0 ) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
End If
Try
Dim CheckClient2 As New WebClient
CheckClient2 . Encoding = System . Text . Encoding . UTF8
Dim testdl As String = CheckClient2 . DownloadString ( keyfileurl3 )
Funimation_m3u8_final = StreamURL
Exit For
Catch ex As Exception
Debug . WriteLine ( keyfileurl3 + vbNewLine + ex . ToString )
End Try
'Funimation_m3u8_final = textLenght(i)
'Exit For
End If
Next
ElseIf Funimation_m3u8_final = Nothing Then
Funimation_m3u8_final = FunimationBackupm3u8
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
Me . Text = " Status: Resolution found! "
Me . Invalidate ( )
Return Nothing
End Function ) )
End If
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
Me . Text = " Status: Substitles only mode - skipped video "
Me . Invalidate ( )
Return Nothing
End Function ) )
End If
'MsgBox(FunimationName3)
'MsgBox(Funimation_m3u8_final)
#Region "thumbnail"
2021-06-04 16:11:06 +02:00
'Dim thumbnail As String() = v1Json.Split(New String() {"episodeThumbnail"}, System.StringSplitOptions.RemoveEmptyEntries)
'Dim thumbnail2 As String() = thumbnail(1).Split(New String() {"https://"}, System.StringSplitOptions.RemoveEmptyEntries) '(New [Char]() {"-"})
'Dim thumbnail3 As String() = thumbnail2(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries) '(New [Char]() {"-"})
Dim thumbnail4 As String = " "
For Each item As JProperty In data
item . CreateReader ( )
Select Case item . Name
Case " images " 'each record is inside the entries array
For Each Entry As JObject In item . Values
2021-09-20 20:37:57 +02:00
Dim key As String = Entry ( " key " ) . ToString
2021-06-04 16:11:06 +02:00
If key = " episodeThumbnail " Then
2021-09-20 20:37:57 +02:00
Dim path As String = Entry ( " path " ) . ToString
2021-06-04 16:11:06 +02:00
thumbnail4 = path
Exit Select
End If
'Dim factor As String = Entry("factor").ToList.Item(0)
' you can continue listing the array items untill you reach the end of you array
Next
End Select
Next
2021-06-04 15:25:59 +02:00
#End Region
Dim ResoHTMLDisplay As String = Reso . ToString + " p "
#Region "Subs"
Dim SubsClient As New WebClient
SubsClient . Encoding = Encoding . UTF8
If Not WebbrowserCookie = Nothing Then
SubsClient . Headers . Add ( HttpRequestHeader . Cookie , WebbrowserCookie )
ElseIf Not SystemWebBrowserCookie = Nothing Then
SubsClient . Headers . Add ( HttpRequestHeader . Cookie , SystemWebBrowserCookie )
End If
Dim PlayerPage As String = SubsClient . DownloadString ( " https://www.funimation.com/player/ " + ExperienceID + " /?bdub=0&qid= " )
Dim Subs_in_srt As New List ( Of String )
Dim Subs_in_vtt As New List ( Of String )
Dim Subs_in_dfxp As New List ( Of String )
Dim SoftSubs2 As New List ( Of String )
If SubFunimation . Count > 0 Then
For i As Integer = 0 To SubFunimation . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String + SubFunimation ( i ) ) ) Then
2021-06-04 15:25:59 +02:00
SoftSubs2 . Add ( My . Resources . Funimation_Subtitle_String + SubFunimation ( i ) )
Continue For
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String2 + SubFunimation ( i ) ) ) Then
2021-06-04 15:25:59 +02:00
SoftSubs2 . Add ( My . Resources . Funimation_Subtitle_String2 + SubFunimation ( i ) )
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String3 + SubFunimation ( i ) ) ) Then
2021-06-04 15:25:59 +02:00
SoftSubs2 . Add ( My . Resources . Funimation_Subtitle_String3 + SubFunimation ( i ) )
End If
Next
If SoftSubs2 . Count = 0 Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
Me . Text = " No Subtitles found... "
Me . Invalidate ( )
Return Nothing
End Function ) )
File . WriteAllText ( DownloadPfad . Replace ( VideoFormat , " -subtitle_error.log " ) , PlayerPage , Encoding . UTF8 )
End If
End If
Dim HardSubFound As Boolean = False
Dim HardSubSplittString As String = Nothing
Dim UsedSub As String = Nothing
Dim UsedSubs As New List ( Of String )
Dim ffmpeg_hardsub As String = Nothing
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String + HardSubFunimation ) ) Then
2021-06-04 15:25:59 +02:00
HardSubFound = True
HardSubSplittString = My . Resources . Funimation_Subtitle_String + HardSubFunimation
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String2 + HardSubFunimation ) ) Then
2021-06-04 15:25:59 +02:00
HardSubFound = True
HardSubSplittString = My . Resources . Funimation_Subtitle_String2 + HardSubFunimation
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( PlayerPage , My . Resources . Funimation_Subtitle_String3 + HardSubFunimation ) ) Then
2021-06-04 15:25:59 +02:00
HardSubFound = True
HardSubSplittString = My . Resources . Funimation_Subtitle_String3 + HardSubFunimation
End If
If HardSubFound = True Then 'anyways not true if hardsub is "Disabled"
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( ffmpeg_command , " -c copy " ) ) Then
2021-06-04 15:25:59 +02:00
ffmpeg_hardsub = " -bsf:a aac_adtstoasc "
Else
ffmpeg_hardsub = ffmpeg_command
End If
'MsgBox(HardSubSplittString)
Dim HardSubTitle ( ) As String = PlayerPage . Split ( New String ( ) { HardSubSplittString } , System . StringSplitOptions . RemoveEmptyEntries )
For i As Integer = 0 To HardSubTitle . Count - 1
Dim HardSubTitle2 ( ) As String = HardSubTitle ( i ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( HardSubTitle2 ( HardSubTitle2 . Count - 1 ) , " .srt " ) ) Then
2021-06-04 15:25:59 +02:00
UsedSub = HardSubTitle2 ( HardSubTitle2 . Count - 1 )
Exit For
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( HardSubTitle2 ( HardSubTitle2 . Count - 1 ) , " .vtt " ) ) Then
2021-06-04 15:25:59 +02:00
UsedSub = HardSubTitle2 ( HardSubTitle2 . Count - 1 )
Exit For
End If
Next
If UsedSub = Nothing Then
Throw New System . Exception ( " Error - No valid Subtitle for hard-subtiles found " )
End If
'MsgBox(UsedSub)
Dim SubText As String = client0 . DownloadString ( UsedSub )
Dim SubtitelFormat As String = " .srt "
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( UsedSub , " .vtt " ) ) Then
2021-06-04 15:25:59 +02:00
SubtitelFormat = " .vtt "
2021-09-20 20:37:57 +02:00
'ElseIf CBool(InStr(UsedSub, ".dfxp") Then
2021-06-04 15:25:59 +02:00
' SubtitelFormat = ".dfxp"
End If
2021-09-20 20:37:57 +02:00
UsedSub = GeräteID ( ) + SubtitelFormat
2021-06-04 15:25:59 +02:00
File . WriteAllText ( Application . StartupPath + " \ " + UsedSub , SubText , Encoding . UTF8 )
ElseIf SoftSubs2 . Count > 0 Then
For i As Integer = 0 To SoftSubs2 . Count - 1
Dim SubTitle ( ) As String = PlayerPage . Split ( New String ( ) { SoftSubs2 . Item ( i ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim FoundCount As Integer = 0
For ii As Integer = 0 To SubTitle . Count - 1
Dim SubTitle2 ( ) As String = SubTitle ( ii ) . Split ( New String ( ) { My . Resources . Funimation_subs_src } , System . StringSplitOptions . RemoveEmptyEntries )
For iii As Integer = 0 To SubTitle2 . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( SubTitle2 ( iii ) , " .srt " + Chr ( 34 ) ) ) Then
ElseIf CBool ( InStr ( SubTitle2 ( iii ) , " .vtt " + Chr ( 34 ) ) ) Then
ElseIf CBool ( InStr ( SubTitle2 ( iii ) , " .dfxp " + Chr ( 34 ) ) ) Then
ElseIf CBool ( InStr ( SubTitle2 ( iii ) , " .srt " ) ) Then
2021-06-04 15:25:59 +02:00
If Subs_in_srt . Contains ( SubTitle2 ( iii ) ) Then
Else
Subs_in_srt . Add ( SubTitle2 ( iii ) )
End If
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( SubTitle2 ( iii ) , " .vtt " ) ) Then
2021-06-04 15:25:59 +02:00
If Subs_in_vtt . Contains ( SubTitle2 ( iii ) ) Then
Else
Subs_in_vtt . Add ( SubTitle2 ( iii ) )
End If
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( SubTitle2 ( iii ) , " .dfxp " ) ) Then
2021-06-04 15:25:59 +02:00
If Subs_in_dfxp . Contains ( SubTitle2 ( iii ) ) Then
Else
Subs_in_dfxp . Add ( SubTitle2 ( iii ) )
End If
End If
Next
Next
Dim TempCount As Integer = UsedSubs . Count
Try
If Funimation_srt = True Then
UsedSubs . Add ( Subs_in_srt . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
End If
Catch ex As Exception
End Try
Try
If Funimation_vtt = True Then
UsedSubs . Add ( Subs_in_vtt . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
End If
Catch ex As Exception
End Try
Try
If Funimation_dfxp = True Then
UsedSubs . Add ( Subs_in_dfxp . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
End If
Catch ex As Exception
End Try
If TempCount = UsedSubs . Count Then
If Subs_in_srt . Count > 0 Then
UsedSubs . Add ( Subs_in_srt . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
ElseIf Subs_in_vtt . Count > 0 Then
UsedSubs . Add ( Subs_in_vtt . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
ElseIf Subs_in_dfxp . Count > 0 Then
UsedSubs . Add ( Subs_in_dfxp . Item ( 0 ) + " , " + SoftSubs2 . Item ( i ) . Replace ( My . Resources . Funimation_Subtitle_String , " " ) . Replace ( My . Resources . Funimation_Subtitle_String2 , " " ) . Replace ( My . Resources . Funimation_Subtitle_String3 , " " ) )
End If
End If
Subs_in_srt . Clear ( )
Subs_in_vtt . Clear ( )
Subs_in_dfxp . Clear ( )
Next
2021-05-23 22:27:56 +02:00
End If
2021-06-04 15:25:59 +02:00
'
2021-05-23 22:27:56 +02:00
Dim SoftSubMergeURLs As String = Nothing
Dim SoftSubMergeMaps As String = " -map 0:v -map 0:a "
2021-06-04 15:25:59 +02:00
If Not FunimationAudioMap = Nothing Then
SoftSubMergeMaps = " -map 0:v -map 1:a "
End If
2021-05-23 22:27:56 +02:00
Dim SoftSubMergeMetatata As String = Nothing
2021-06-04 15:25:59 +02:00
If UsedSubs . Count > 0 Then
2021-05-23 22:27:56 +02:00
If MergeSubs = True And SubsOnly = False Then
2021-06-04 15:25:59 +02:00
Dim DispositionIndex As Integer = 999
Dim LastMerged As String = Nothing
Dim MapCount As Integer = - 1
For i As Integer = 0 To UsedSubs . Count - 1
Dim SoftSub As String ( ) = UsedSubs . Item ( i ) . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
If CCtoMP4CC ( SoftSub ( 1 ) ) = LastMerged Then
Continue For
Else
LastMerged = CCtoMP4CC ( SoftSub ( 1 ) )
End If
MapCount = MapCount + 1
If DefaultSubFunimation = SoftSub ( 1 ) Then
'Debug.WriteLine(SoftSub(1))
DispositionIndex = MapCount
2021-05-23 22:27:56 +02:00
End If
If SoftSubMergeURLs = Nothing Then
2021-06-04 15:25:59 +02:00
SoftSubMergeURLs = " -headers " + My . Resources . ffmpeg_user_agend + " -i " + Chr ( 34 ) + SoftSub ( 0 ) + Chr ( 34 )
2021-05-23 22:27:56 +02:00
Else
2021-06-04 15:25:59 +02:00
SoftSubMergeURLs = SoftSubMergeURLs + " -headers " + My . Resources . ffmpeg_user_agend + " -i " + Chr ( 34 ) + SoftSub ( 0 ) + Chr ( 34 )
2021-05-23 22:27:56 +02:00
End If
2021-06-04 15:25:59 +02:00
If FunimationAudioMap = Nothing Then
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + ( MapCount + 1 ) . ToString
Else
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + ( MapCount + 2 ) . ToString
End If
2021-05-23 22:27:56 +02:00
If SoftSubMergeMetatata = Nothing Then
2021-06-04 15:25:59 +02:00
'SoftSubMergeMetatata = " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSub(1))
SoftSubMergeMetatata = " -metadata:s:s: " + MapCount . ToString + " language= " + CCtoMP4CC ( SoftSub ( 1 ) ) + " -metadata:s:s: " + MapCount . ToString + " title= " + Chr ( 34 ) + HardSubValuesToDisplay ( Chr ( 34 ) + SoftSub ( 1 ) + Chr ( 34 ) ) + Chr ( 34 ) + " -metadata:s:s: " + MapCount . ToString + " handler_name= " + Chr ( 34 ) + HardSubValuesToDisplay ( Chr ( 34 ) + SoftSub ( 1 ) + Chr ( 34 ) ) + Chr ( 34 )
2021-05-23 22:27:56 +02:00
Else
2021-06-04 15:25:59 +02:00
SoftSubMergeMetatata = SoftSubMergeMetatata + " -metadata:s:s: " + MapCount . ToString + " language= " + CCtoMP4CC ( SoftSub ( 1 ) ) + " -metadata:s:s: " + MapCount . ToString + " title= " + Chr ( 34 ) + HardSubValuesToDisplay ( Chr ( 34 ) + SoftSub ( 1 ) + Chr ( 34 ) ) + Chr ( 34 ) + " -metadata:s:s: " + MapCount . ToString + " handler_name= " + Chr ( 34 ) + HardSubValuesToDisplay ( Chr ( 34 ) + SoftSub ( 1 ) + Chr ( 34 ) ) + Chr ( 34 )
'SoftSubMergeMetatata + " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSubs2(i))
2021-05-23 22:27:56 +02:00
End If
Next
2021-06-04 15:25:59 +02:00
If DispositionIndex < 999 Then
2021-05-23 22:27:56 +02:00
SoftSubMergeMetatata = SoftSubMergeMetatata + " -disposition:s: " + DispositionIndex . ToString + " default "
End If
Else
2021-06-04 15:25:59 +02:00
For i As Integer = 0 To UsedSubs . Count - 1
LabelUpdate = " Status: downloading subtitle file "
LabelEpisode = UsedSubs ( i )
Dim SoftSub As String ( ) = UsedSubs . Item ( i ) . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim SoftSub_3 As String = SoftSub ( 0 ) . Replace ( " \/ " , " / " )
Dim Subfile As String = SubsClient . DownloadString ( SoftSub_3 )
Dim Pfad3 As String = DownloadPfad . Replace ( Chr ( 34 ) , " " )
2021-05-23 22:27:56 +02:00
'MsgBox(FN)
2021-06-04 15:25:59 +02:00
Dim SubtitelFormat As String = " srt "
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( SoftSub_3 , " .vtt " ) ) Then
2021-06-04 15:25:59 +02:00
SubtitelFormat = " vtt "
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( SoftSub_3 , " .dfxp " ) ) Then
2021-06-04 15:25:59 +02:00
SubtitelFormat = " dfxp "
End If
Dim FN As String = Path . ChangeExtension ( Path . Combine ( Path . GetFileNameWithoutExtension ( Pfad3 ) + " " + SoftSub ( 1 ) + Path . GetExtension ( Pfad3 ) ) , SubtitelFormat )
2021-05-23 22:27:56 +02:00
If i = 0 Then
2021-06-04 15:25:59 +02:00
FN = Path . ChangeExtension ( Path . GetFileName ( Pfad3 ) , SubtitelFormat )
2021-05-23 22:27:56 +02:00
'MsgBox(FN)
End If
Dim Pfad4 As String = Path . Combine ( Path . GetDirectoryName ( Pfad3 ) , FN )
'MsgBox(Pfad4)
2021-06-04 15:25:59 +02:00
File . WriteAllText ( Pfad4 , Subfile , Encoding . UTF8 )
Pause ( 1 )
2021-05-23 22:27:56 +02:00
Next
End If
End If
2021-06-04 15:25:59 +02:00
2021-05-23 22:27:56 +02:00
#End Region
2021-06-04 15:25:59 +02:00
#Region "ffmpeg command"
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Dim DubMetatata As String = Nothing
If FunimationDub = " japanese " Then
DubMetatata = " -metadata:s:a:0 language=jpn "
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
ElseIf FunimationDub = " portuguese-brazil " Then
DubMetatata = " -metadata:s:a:0 language=por "
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
ElseIf FunimationDub = " spanish-latin-am " Then
DubMetatata = " -metadata:s:a:0 language=spa "
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Else '
DubMetatata = " -metadata:s:a:0 language=eng "
2021-05-23 22:27:56 +02:00
End If
2021-06-04 15:25:59 +02:00
If HardSubFound = True And CBool ( InStr ( VideoFormat , " .aac " ) ) = False Then
Funimation_m3u8_final = " -i " + Chr ( 34 ) + Funimation_m3u8_final + Chr ( 34 ) + FunimationAudioMap + " -vf subtitles= " + Chr ( 34 ) + UsedSub + Chr ( 34 ) + " " + ffmpeg_hardsub
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
ElseIf MergeSubs = True Then
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Funimation_m3u8_final = " -i " + Chr ( 34 ) + Funimation_m3u8_final + Chr ( 34 ) + FunimationAudioMap + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + DubMetatata
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
ElseIf CBool ( InStr ( VideoFormat , " .aac " ) ) = True Then
If FunimationAudioMap = Nothing Then
Funimation_m3u8_final = " -i " + Chr ( 34 ) + Funimation_m3u8_final + Chr ( 34 ) + DubMetatata + " " + ffmpeg_command_temp
2021-05-23 22:27:56 +02:00
Else
2021-06-04 15:25:59 +02:00
Funimation_m3u8_final = FunimationAudioMap . Replace ( " -headers " + My . Resources . ffmpeg_user_agend + " " , " " ) + DubMetatata + " " + ffmpeg_command_temp
2021-05-23 22:27:56 +02:00
End If
2021-06-04 15:25:59 +02:00
Else
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
Funimation_m3u8_final = " -i " + Chr ( 34 ) + Funimation_m3u8_final + Chr ( 34 ) + FunimationAudioMap + DubMetatata + " " + ffmpeg_command
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
End If
2021-05-23 22:27:56 +02:00
#End Region
2021-06-04 15:25:59 +02:00
'MsgBox(Funimation_m3u8_final)
'DownloadPfad = DownloadPfad.Replace(" \", "\")
2021-05-23 22:27:56 +02:00
If SubsOnly = True Then
2021-06-04 15:25:59 +02:00
Funimation_m3u8_final = " -i [Subtitles only] "
2021-05-23 22:27:56 +02:00
End If
2021-06-04 15:25:59 +02:00
DownloadPfad = RemoveExtraSpaces ( DownloadPfad )
Dim L1Name_Split As String ( ) = WebbrowserURL . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim L1Name As String = L1Name_Split ( 1 ) . Replace ( " www. " , " " ) + " | Dub : " + FunimationDub
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
ListItemAdd ( Pfad_DL , L1Name , DefaultName , ResoHTMLDisplay , " Unknown " , SubValuesToDisplay ( ) , thumbnail4 , Funimation_m3u8_final , Chr ( 34 ) + DownloadPfad + Chr ( 34 ) , " FM " )
2021-05-23 22:27:56 +02:00
Return Nothing
End Function ) )
2021-06-04 15:25:59 +02:00
liList . Add ( My . Resources . htmlvorThumbnail + thumbnail4 + My . Resources . htmlnachTumbnail + FunimationTitle + " <br> " + FunimationSeason + " " + FunimationEpisode + My . Resources . htmlvorAufloesung + ResoHTMLDisplay + My . Resources . htmlvorSoftSubs + vbNewLine + SubValuesToDisplay ( ) + My . Resources . htmlvorHardSubs + " null " + My . Resources . htmlnachHardSubs + " <!-- " + DefaultName + " --> " )
2021-05-23 22:27:56 +02:00
2021-06-04 15:25:59 +02:00
#End Region
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-05-23 22:27:56 +02:00
Me . Text = " Crunchyroll Downloader "
Me . Invalidate ( )
Return Nothing
End Function ) )
2021-06-04 15:25:59 +02:00
2021-05-23 22:27:56 +02:00
Catch ex As Exception
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-06-04 15:25:59 +02:00
Me . Text = " Crunchyroll Downloader! "
2021-05-23 22:27:56 +02:00
Me . Invalidate ( )
Return Nothing
End Function ) )
2021-06-04 15:25:59 +02:00
MsgBox ( ex . ToString )
2021-05-23 22:27:56 +02:00
End Try
2021-06-04 15:25:59 +02:00
Funimation_Grapp_RDY = True
2021-05-23 22:27:56 +02:00
End Sub
2021-06-04 15:25:59 +02:00
2021-05-23 22:27:56 +02:00
#End Region
2021-04-24 20:51:34 +02:00
2020-08-16 23:27:48 +02:00
Private Sub Timer3_Tick ( sender As Object , e As EventArgs ) Handles Timer3 . Tick
2021-01-14 18:06:42 +01:00
2020-11-13 15:57:34 +01:00
Me . Invalidate ( )
2020-08-16 23:27:48 +02:00
Try
2020-11-13 15:57:34 +01:00
Dim GeckoHTML As String = My . Resources . htmlTop + vbNewLine + My . Resources . htmlTitlel . Replace ( " Placeholder " , Me . Text . Replace ( " open the add window to continue " , " " ) )
2020-08-16 23:27:48 +02:00
Dim LiAdd As String = Nothing
For ii As Integer = 0 To ItemList . Count - 1
For i As Integer = 0 To liList . Count - 1
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( liList ( i ) , " <!-- " + ItemList . Item ( ii ) . GetNameAnime + " --> " ) ) Then
If CBool ( InStr ( liList ( i ) , " Finished - " ) ) Then
2020-09-30 18:19:31 +02:00
If LiAdd = Nothing Then
LiAdd = liList ( i )
Else
LiAdd = LiAdd + vbNewLine + liList ( i )
End If
2020-08-16 23:27:48 +02:00
Else
2020-09-30 18:19:31 +02:00
Dim ProzentBalken As String ( ) = liList ( i ) . Split ( New String ( ) { " width: " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ProzentBalken2 As String ( ) = ProzentBalken ( 1 ) . Split ( New String ( ) { " % " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ProzentZahl As String ( ) = ProzentBalken2 ( 1 ) . Split ( New String ( ) { " 'percenttext'> " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ProzentZahl2 As String ( ) = ProzentZahl ( 1 ) . Split ( New String ( ) { " %< " } , System . StringSplitOptions . RemoveEmptyEntries )
liList ( i ) = ProzentBalken ( 0 ) + " width: " + ItemList . Item ( ii ) . GetPercentValue . ToString + " % " + Chr ( 34 ) + ProzentZahl ( 0 ) + " 'percenttext'> " + ItemList . Item ( ii ) . GetLabelPercent . ToString + " < " + ProzentZahl2 ( 1 )
If LiAdd = Nothing Then
LiAdd = liList ( i )
Else
LiAdd = LiAdd + vbNewLine + liList ( i )
End If
Exit For
2020-08-16 23:27:48 +02:00
End If
End If
Next
Next
Dim c As String = GeckoHTML + vbNewLine + LiAdd + vbNewLine + My . Resources . htmlEnd
Dim Balken As String = " balken.png "
c = c . Replace ( " balken1.png " , Balken )
Dim CC As String = " cc.png "
c = c . Replace ( " cc1.png " , CC )
2021-02-20 18:25:49 +01:00
HTML = c
2020-08-16 23:27:48 +02:00
Catch ex As Exception
2020-12-13 16:11:43 +01:00
'Debug.WriteLine(ex.ToString)
2020-08-16 23:27:48 +02:00
'MsgBox(ex.ToString)
End Try
End Sub
2021-09-20 20:37:57 +02:00
#Region "process html"
Public Sub ProcessHTML ( ByVal document As String , ByVal Address As String , ByVal DocumentTitle As String )
If b = True Then
Exit Sub
End If
Dim localHTML As String = document
Debug . WriteLine ( Date . Now . ToString + " . " + Date . Now . Millisecond . ToString )
Debug . WriteLine ( Address )
'MsgBox("loaded!")
If CBool ( InStr ( Address , " beta.crunchyroll.com " ) ) Then
WebbrowserURL = Address
Pause ( 10 )
ProcessUrls ( )
Exit Sub
ElseIf CBool ( InStr ( Address , " crunchyroll.com " ) ) Then
If b = False Then
Try
If Address = " https://www.crunchyroll.com/ " Then
b = True
ElseIf Address = " https://www.crunchyroll.com/en-gb " Then
b = True
ElseIf Address = " https://www.crunchyroll.com/es " Then
b = True
ElseIf Address = " https://www.crunchyroll.com/es-es " Then
b = True
ElseIf Address = " https://www.crunchyroll.com/pt-br " Then
b = True
ElseIf Address = " https://www.crunchyroll.com/pt-pt " Then
b = True
ElseIf Address = " https://www.crunchyroll.com/fr " Then
b = True
ElseIf Address = " https://www.crunchyroll.com/de " Then
b = True
ElseIf Address = " https://www.crunchyroll.com/ar " Then
b = True
ElseIf Address = " https://www.crunchyroll.com/it " Then
b = True
ElseIf Address = " https://www.crunchyroll.com/ru " Then
b = True
ElseIf CBool ( InStr ( localHTML , " hardsub_lang " ) ) Then
Debug . WriteLine ( " starting grabber " )
WebbrowserURL = Address
WebbrowserText = localHTML
WebbrowserTitle = DocumentTitle
WebbrowserHeadText = localHTML
b = True
Debug . WriteLine ( " Invoke Required: " + InvokeRequired . ToString )
'Dim Evaluator = New Thread(Sub() Me.GrappURL())
'Evaluator.Start()
t = New Thread ( AddressOf GrappURL )
t . Priority = ThreadPriority . Normal
t . IsBackground = True
t . Start ( )
Exit Sub
ElseIf CBool ( InStr ( localHTML , " season-dropdown content-menu block " ) ) Then
b = True
Anime_Add . textBox2 . Text = " Use Custom Name "
WebbrowserURL = Address
WebbrowserText = localHTML
WebbrowserTitle = DocumentTitle
WebbrowserHeadText = localHTML
SeasonDropdownGrapp ( )
Exit Sub
ElseIf CBool ( InStr ( localHTML , " wrapper container-shadow hover-classes " ) ) Then
b = True
Anime_Add . textBox2 . Text = " Use Custom Name "
WebbrowserURL = Address
WebbrowserText = localHTML
WebbrowserTitle = DocumentTitle
WebbrowserHeadText = localHTML
MassGrapp ( )
Exit Sub
Else
My . Computer . FileSystem . WriteAllText ( Application . StartupPath + " \html.log " , localHTML , True )
b = True
MsgBox ( No_Stream , MsgBoxStyle . OkOnly )
Anime_Add . StatusLabel . Text = " Status: idle "
Exit Sub
End If
Catch ex As Exception
MsgBox ( ex . ToString )
Anime_Add . StatusLabel . Text = " Status: idle "
End Try
ElseIf c = False Then
If CBool ( InStr ( localHTML , " hardsub_lang " ) ) Then
c = True
WebbrowserURL = Address
WebbrowserText = localHTML
WebbrowserTitle = DocumentTitle
WebbrowserHeadText = localHTML
'SoftSub.DownloadSubs()
Exit Sub
End If
End If
ElseIf CBool ( InStr ( Address , " funimation.com " ) ) Then
Dim Collector As New TaskCookieVisitor
Dim CM As ICookieManager = CefSharp_Browser . WebBrowser1 . GetCookieManager
CM . VisitAllCookies ( Collector )
Dim list As List ( Of Global . CefSharp . Cookie ) = Collector . Task . Result ( )
Dim Cookie As String = " "
For i As Integer = 0 To list . Count - 1
If CBool ( InStr ( list . Item ( i ) . Domain , " funimation.com " ) ) Then 'list.Item(i).Domain = "funimation.com" Then
'MsgBox(list.Item(i).Name + vbNewLine + list.Item(i).Value)
Cookie = Cookie + list . Item ( i ) . Name + " = " + list . Item ( i ) . Value + " ; "
End If
Next
If b = False Then
If CBool ( InStr ( localHTML , My . Resources . Funimation_Player_ID ) ) = True Or CBool ( InStr ( localHTML , My . Resources . Funimation_Player_ID_2 ) ) = True Then
WebbrowserURL = Address
WebbrowserText = localHTML
WebbrowserTitle = DocumentTitle
WebbrowserHeadText = localHTML
WebbrowserCookie = Cookie
b = True
t = New Thread ( AddressOf Funitmation_Grapp )
t . Priority = ThreadPriority . Normal
t . IsBackground = True
t . Start ( )
Exit Sub
Else
'WebbrowserCookie = Cookie
WebbrowserURL = Address
Text = " Crunchyroll Downloader "
For i As Integer = 10 To 0 Step - 1
Anime_Add . StatusLabel . Text = " Status: checking traffic - " + i . ToString
Pause ( 1 )
Next
ProcessUrls ( )
Exit Sub
End If
End If
ElseIf CBool ( InStr ( Address , " title-api.prd.funimationsvc.com " ) ) Then
If FunimationJsonBrowser = " SeasonJson " Then
'My.Computer.Clipboard.SetText(localHTML)
GetFunimationJS_Seasons ( Nothing , localHTML . Replace ( " <body> " , " " ) . Replace ( " </body> " , " " ) . Replace ( " <pre> " , " " ) . Replace ( " </pre> " , " " ) . Replace ( " </html> " , " " ) . Replace ( " <html><head></head><pre style= " + Chr ( 34 ) + " word-wrap: break-word; white-space: pre-wrap; " + Chr ( 34 ) + " > " , " " ) ) '
FunimationJsonBrowser = Nothing
WebbrowserURL = " https://funimation.com/js "
ElseIf FunimationJsonBrowser = " EpisodeJson " Then
Anime_Add . FillFunimationEpisodes ( localHTML . Replace ( " <body> " , " " ) . Replace ( " </body> " , " " ) . Replace ( " <pre> " , " " ) . Replace ( " </pre> " , " " ) . Replace ( " </html> " , " " ) . Replace ( " <html><head></head><pre style= " + Chr ( 34 ) + " word-wrap: break-word; white-space: pre-wrap; " + Chr ( 34 ) + " > " , " " ) ) '
FunimationJsonBrowser = Nothing
WebbrowserURL = " https://funimation.com/js "
ElseIf FunimationJsonBrowser = " v1Json " Then
GetFunimationJS_VideoProxy ( Nothing , localHTML . Replace ( " <body> " , " " ) . Replace ( " </body> " , " " ) . Replace ( " <pre> " , " " ) . Replace ( " </pre> " , " " ) . Replace ( " </html> " , " " ) . Replace ( " <html><head></head><pre style= " + Chr ( 34 ) + " word-wrap: break-word; white-space: pre-wrap; " + Chr ( 34 ) + " > " , " " ) ) '
FunimationJsonBrowser = Nothing
WebbrowserURL = " https://funimation.com/js "
End If
Exit Sub
ElseIf CBool ( InStr ( Address , " anime-on-demand.de " ) ) Then
Dim Collector As New TaskCookieVisitor
Dim CM As ICookieManager = CefSharp_Browser . WebBrowser1 . GetCookieManager
CM . VisitAllCookies ( Collector )
Dim list As List ( Of Global . CefSharp . Cookie ) = Collector . Task . Result ( )
Dim Cookie As String = " "
For i As Integer = 0 To list . Count - 1
If CBool ( InStr ( list . Item ( i ) . Domain , " anime-on-demand.de " ) ) Then 'list.Item(i).Domain = "funimation.com" Then
'MsgBox(list.Item(i).Name + vbNewLine + list.Item(i).Value)
Cookie = Cookie + list . Item ( i ) . Name + " = " + list . Item ( i ) . Value + " ; "
End If
Next
If b = False Then
b = True
WebbrowserURL = Address
WebbrowserText = localHTML
WebbrowserTitle = DocumentTitle
Anime_Add . AoD_Cookie = Cookie
Anime_Add . AoDHTML = localHTML
Anime_Add . ProcessAoDNew ( )
'Anime_Add.ProcessAoD()
Exit Sub
End If
Else
WebbrowserURL = Address
Text = " Crunchyroll Downloader "
For i As Integer = 10 To 0 Step - 1
Anime_Add . StatusLabel . Text = " Status: checking traffic - " + i . ToString
Pause ( 1 )
Next
ProcessUrls ( )
'Pause(10)
'ProcessUrls()
End If
'End If
End Sub
#End Region
Public Sub ProcessUrls ( )
Debug . WriteLine ( LoadedUrls . Count . ToString )
Dim VRVSeason As String = Nothing
For i As Integer = 0 To LoadedUrls . Count - 1
Dim requesturl As String = LoadedUrls . Item ( i )
If CBool ( InStr ( requesturl , " https://beta-api.crunchyroll.com/ " ) ) And CBool ( InStr ( requesturl , " streams? " ) ) Then
If b = False Then
GetBetaVideoProxy ( requesturl , WebbrowserURL )
b = True
LoadedUrls . Clear ( )
Exit Sub
End If
ElseIf CBool ( InStr ( requesturl , " https://beta-api.crunchyroll.com/ " ) ) And CBool ( InStr ( requesturl , " seasons?series_id= " ) ) Then
If b = False Then
GetBetaSeasons ( requesturl )
b = True
LoadedUrls . Clear ( )
Exit Sub
End If
End If
If CBool ( InStr ( requesturl , " https://api.vrv.co " ) ) And CBool ( InStr ( requesturl , " streams? " ) ) Then
Debug . WriteLine ( " vrv-1 " + requesturl )
If b = False Then
Get_VRV_VideoProxy ( requesturl , WebbrowserURL )
b = True
LoadedUrls . Clear ( )
Exit Sub
End If
ElseIf CBool ( InStr ( requesturl , " https://api.vrv.co " ) ) And CBool ( InStr ( requesturl , " seasons?series_id= " ) ) Then
If b = False Then
'GetBetaSeasons(requesturl)
VRVSeason = requesturl
'b = True
'LoadedUrls.Clear()
'Exit Sub
End If
End If
If CBool ( InStr ( requesturl , " /data/v1/shows/ " ) ) Then
Dim ShowJson As String = Nothing
Try
Using client As New WebClient ( )
client . Encoding = System . Text . Encoding . UTF8
client . Headers . Add ( My . Resources . ffmpeg_user_agend . Replace ( Chr ( 34 ) , " " ) )
ShowJson = client . DownloadString ( requesturl )
End Using
Catch ex As Exception
Debug . WriteLine ( " error- getting ShowJson data " )
End Try
End If
If CBool ( InStr ( requesturl , " https://title-api.prd.funimationsvc.com " ) ) And CBool ( InStr ( requesturl , " ?region= " ) ) Then
Try
Dim Collector As New TaskCookieVisitor
Dim CM As ICookieManager = CefSharp_Browser . WebBrowser1 . GetCookieManager
CM . VisitAllCookies ( Collector )
Dim list As List ( Of Global . CefSharp . Cookie ) = Collector . Task . Result ( )
Dim Cookie As String = " "
For ii As Integer = 0 To list . Count - 1
If CBool ( InStr ( list . Item ( ii ) . Domain , " funimation.com " ) ) Then 'list.Item(i).Domain = "funimation.com" Then
'MsgBox(list.Item(i).Name + vbNewLine + list.Item(i).Value)
Cookie = Cookie + list . Item ( ii ) . Name + " = " + list . Item ( ii ) . Value + " ; "
End If
Next
WebbrowserCookie = Cookie
Catch ex As Exception
End Try
If FunimationAPIRegion = Nothing Then
Me . Invoke ( New Action ( Function ( ) As Object
Dim parms As String ( ) = requesturl . Split ( New String ( ) { " ?region= " } , System . StringSplitOptions . RemoveEmptyEntries )
FunimationAPIRegion = " ?region= " + parms ( 1 )
Return Nothing
End Function ) )
End If
If b = False Then
'If CBool(InStr(requesturl, "https://title-api.prd.funimationsvc.com/v1/episodes/")) Then
' GetFunimationJS_VideoProxy(requesturl)
' Debug.WriteLine("processing :" + requesturl)
' b = True
' Exit For
'Else
If CBool ( InStr ( requesturl , " https://title-api.prd.funimationsvc.com/v1/show " ) ) And CBool ( InStr ( requesturl , " /episodes/ " ) ) Then
GetFunimationJS_VideoProxy ( requesturl )
Debug . WriteLine ( " processing : " + requesturl )
b = True
LoadedUrls . Clear ( )
Exit Sub
Else
If FunimationEpisodeJSON = Nothing Then
Debug . WriteLine ( " processing overview " )
Me . Invoke ( New Action ( Function ( ) As Object
'MsgBox(WebbrowserURL)
Anime_Add . ProcessFunimationJS ( WebbrowserURL )
Return Nothing
End Function ) )
b = True
LoadedUrls . Clear ( )
Exit Sub
End If
End If
End If
End If
Next
If Not VRVSeason = Nothing Then
Debug . WriteLine ( " vrv-2 " + VRVSeason )
Get_VRV_Seasons ( VRVSeason )
b = True
LoadedUrls . Clear ( )
Exit Sub
End If
'If GeckoFX.ScanTrue = True Then
' If CBool(InStr(requesturl, ".m3u8") Then
' Dim client0 As New WebClient
' client0.Encoding = Encoding.UTF8
' 'client0.Headers.Add(HttpRequestHeader.Cookie, e.Channel.GetRequestHeader("Cookie"))
' Dim str0 As String = client0.DownloadString(requesturl)
' If CBool(InStr(str0, "#EXTM3U") Then
' m3u8List.Add(requesturl)
' Else
' Dim DecodedUrl As String = UrlDecode(requesturl)
' 'MsgBox(DecodedUrl)
' Dim URLSplit() As String = DecodedUrl.Split(New String() {".m3u8"}, System.StringSplitOptions.RemoveEmptyEntries)
' Dim URLSplit2() As String = URLSplit(0).Split(New String() {"https://"}, System.StringSplitOptions.RemoveEmptyEntries)
' Dim NewUrl As String = "https://" + URLSplit2(URLSplit2.Count - 1) + ".m3u8" + URLSplit(1)
' 'MsgBox(NewUrl)
' Dim str1 As String = client0.DownloadString(NewUrl)
' 'MsgBox(str1)
' If CBool(InStr(str1, "#EXTM3U") Then
' m3u8List.Add(NewUrl)
' End If
' End If
' ElseIf CBool(InStr(requesturl, ".mpd") Then
' mpdList.Add(requesturl)
' ElseIf CBool(InStr(requesturl, "googlevideo.com")) And CBool(InStr(requesturl, "&range=")) = True Then
' Dim DecodedUrl As String = UrlDecode(requesturl)
' 'MsgBox(DecodedUrl)
' Dim VideoUrl() As String = DecodedUrl.Split(New String() {"&range="}, System.StringSplitOptions.RemoveEmptyEntries)
' Dim VideoUrl2() As String = VideoUrl(1).Split(New String() {"&"}, System.StringSplitOptions.RemoveEmptyEntries)
' Dim NewUrl As String = VideoUrl(0) + "&" + VideoUrl2(1)
' 'Debug.WriteLine(NewUrl)
' If Not mpdList.Contains(NewUrl) Then
' mpdList.Add(NewUrl)
' End If
' ElseIf CBool(InStr(requesturl, ".txt") Then
' txtList.Add(requesturl)
' ElseIf CBool(InStr(requesturl, ".vtt") Then
' txtList.Add(requesturl)
' ElseIf CBool(InStr(requesturl, ".srt") Then
' txtList.Add(requesturl)
' ElseIf CBool(InStr(requesturl, ".ass") Then
' txtList.Add(requesturl)
' ElseIf CBool(InStr(requesturl, ".ssa") Then
' txtList.Add(requesturl)
' ElseIf CBool(InStr(requesturl, ".dfxp") Then
' txtList.Add(requesturl)
' End If
'End If
LoadedUrls . Clear ( )
End Sub
Public Sub Navigate ( ByVal Url As String )
If Application . OpenForms ( ) . OfType ( Of CefSharp_Browser ) . Any = True Then
If InvokeRequired = True Then
Me . Invoke ( New Action ( Function ( ) As Object
CefSharp_Browser . WebBrowser1 . Load ( Url )
Return Nothing
End Function ) )
Else
CefSharp_Browser . WebBrowser1 . Load ( Url )
End If
Else
If InvokeRequired = True Then
Me . Invoke ( New Action ( Function ( ) As Object
CefSharp_Browser . Show ( )
CefSharp_Browser . WebBrowser1 . Load ( Url )
Return Nothing
End Function ) )
Else
CefSharp_Browser . Show ( )
CefSharp_Browser . WebBrowser1 . Load ( Url )
End If
End If
End Sub
2020-08-16 23:27:48 +02:00
#Region "server"
2021-02-20 18:25:49 +01:00
Dim ListOfThread As New List ( Of Thread )
Sub ServerStart ( )
Dim server As TcpListener
server = Nothing
2020-08-16 23:27:48 +02:00
Try
2021-02-20 18:25:49 +01:00
2021-02-12 13:44:17 +01:00
2021-09-20 20:37:57 +02:00
Dim Port As String = StartServer . ToString
2021-02-12 13:44:17 +01:00
2021-02-20 18:25:49 +01:00
Dim localAddr As IPAddress = IPAddress . Parse ( " 127.0.0.1 " )
2021-02-12 13:44:17 +01:00
2021-05-23 22:27:56 +02:00
server = New TcpListener ( localAddr , Int32 . Parse ( Port ) )
2021-02-12 13:44:17 +01:00
2021-02-20 18:25:49 +01:00
' Start listening for client requests.
server . Start ( )
2021-01-16 14:08:33 +01:00
2021-05-23 22:27:56 +02:00
Debug . WriteLine ( " Web server started at: " & localAddr . ToString ( ) & " : " & Port )
2020-08-16 23:27:48 +02:00
2021-02-20 18:25:49 +01:00
While True
Dim client As TcpClient = server . AcceptTcpClient ( )
Dim clientThread As New Thread ( Sub ( ) Me . ManageConnections ( client ) )
clientThread . Start ( )
End While
Catch ex As SocketException
Debug . WriteLine ( " SocketException: " + ex . ToString )
Finally
2021-09-20 20:37:57 +02:00
Debug . WriteLine ( Date . Now . ToString + " " + " End server " )
2021-02-20 18:25:49 +01:00
server . Stop ( )
2020-08-16 23:27:48 +02:00
End Try
2021-02-20 18:25:49 +01:00
Debug . WriteLine ( ControlChars . Cr + " Hit enter to continue.... " )
2020-08-16 23:27:48 +02:00
End Sub
2021-02-20 18:25:49 +01:00
Sub ManageConnections ( ByVal client As TcpClient )
Dim bytes ( 1048576 ) As Byte
2020-08-16 23:27:48 +02:00
2021-02-20 18:25:49 +01:00
Dim stream As NetworkStream = client . GetStream ( )
2020-08-16 23:27:48 +02:00
2021-02-20 18:25:49 +01:00
' Debug.WriteLine(Date.Now + " " + "stream opend")
2020-08-16 23:27:48 +02:00
2021-02-20 18:25:49 +01:00
Dim numberOfBytesRead As Integer = 0
Dim myCompleteMessage As StringBuilder = New StringBuilder ( )
Dim stopWatch As New Stopwatch ( )
stopWatch . Start ( )
Do While stopWatch . Elapsed . TotalSeconds < 4 And stream . DataAvailable
'Debug.WriteLine(Date.Now + " " + numberOfBytesRead.ToString + " " + stopWatch.Elapsed.TotalSeconds.ToString)
numberOfBytesRead = stream . Read ( bytes , 0 , bytes . Length )
myCompleteMessage . AppendFormat ( " {0} " , Encoding . UTF8 . GetString ( bytes , 0 , numberOfBytesRead ) )
Loop
stopWatch . Stop ( )
2020-08-16 23:27:48 +02:00
2021-02-20 18:25:49 +01:00
ProcessRequest ( stream , myCompleteMessage . ToString ( ) )
client . Close ( )
2020-08-16 23:27:48 +02:00
End Sub
2021-02-20 18:25:49 +01:00
Sub ProcessRequest ( ByVal stream As NetworkStream , ByVal htmlReq As String )
2021-09-20 20:37:57 +02:00
' Debug.WriteLine(htmlReq)
2020-08-16 23:27:48 +02:00
Dim recvBytes ( 1048576 ) As Byte
2021-01-16 14:08:33 +01:00
2021-02-20 18:25:49 +01:00
Try
2020-08-16 23:27:48 +02:00
Dim rootPath As String = Directory . GetCurrentDirectory ( ) & " \WebInterface\ "
' Set default page
Dim defaultPage As String = " index.html "
Dim PostPage As String = " post.html "
Dim strArray ( ) As String
Dim strRequest As String
2021-09-20 20:37:57 +02:00
strArray = htmlReq . Trim . Split ( New String ( ) { " " } , System . StringSplitOptions . RemoveEmptyEntries )
2020-08-16 23:27:48 +02:00
'MsgBox(htmlReq)
2020-09-30 18:19:31 +02:00
If strArray ( 0 ) . Trim ( ) . ToUpper . Equals ( " POST " ) Then
2020-11-04 19:11:38 +01:00
2021-02-12 13:44:17 +01:00
'Debug.WriteLine("receiving data from the add-on")
2021-02-20 18:25:49 +01:00
'Debug.WriteLine(htmlReq)
'UrlDecode
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-13 15:57:34 +01:00
Me . Text = " Status: receiving data from the add-on "
Me . Invalidate ( )
2020-10-15 01:04:15 +02:00
Return Nothing
End Function ) )
2020-09-30 18:19:31 +02:00
#Region "CR Einzeln"
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( htmlReq , " HTMLSingle= " ) ) Then
2020-09-30 18:19:31 +02:00
Debug . WriteLine ( " Single episode mode - Crunchyroll " )
2020-10-15 13:49:06 +02:00
2020-08-16 23:27:48 +02:00
Try
Dim html ( ) As String = htmlReq . Split ( New String ( ) { " HTMLSingle= " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim DecodedHTML As String = UrlDecode ( html ( 1 ) )
Dim URLSplit ( ) As String = DecodedHTML . Split ( New String ( ) { My . Resources . CR_Head_Url_Split } , System . StringSplitOptions . RemoveEmptyEntries )
Dim URLSplit2 ( ) As String = URLSplit ( 1 ) . Split ( New String ( ) { Chr ( 34 ) + " > " } , System . StringSplitOptions . RemoveEmptyEntries )
WebbrowserURL = URLSplit2 ( 0 )
Dim BodySplit ( ) As String = DecodedHTML . Split ( New String ( ) { " <body " } , System . StringSplitOptions . RemoveEmptyEntries )
WebbrowserText = BodySplit ( 1 )
2021-02-07 13:47:30 +01:00
WebbrowserHeadText = BodySplit ( 0 )
2020-08-16 23:27:48 +02:00
Dim TitleSplit ( ) As String = DecodedHTML . Split ( New String ( ) { " <title> " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim TitleSplit2 ( ) As String = TitleSplit ( 1 ) . Split ( New String ( ) { " </title> " } , System . StringSplitOptions . RemoveEmptyEntries )
WebbrowserTitle = TitleSplit2 ( 0 )
2020-10-15 13:49:06 +02:00
If CBool ( InStr ( WebbrowserText , " hardsub_lang " ) ) Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-13 15:57:34 +01:00
Me . Text = " Status: Download added from add-on "
Me . Invalidate ( )
2020-10-15 13:49:06 +02:00
Return Nothing
End Function ) )
If Grapp_RDY = True Then
Dim t As Thread
t = New Thread ( AddressOf GrappURL )
t . Priority = ThreadPriority . Normal
t . IsBackground = True
t . Start ( )
2020-08-16 23:27:48 +02:00
Else
2020-10-15 13:49:06 +02:00
If Application . OpenForms ( ) . OfType ( Of Anime_Add ) . Any = True Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-10-31 23:36:52 +01:00
If Anime_Add . ListBox1 . Items . Contains ( WebbrowserURL ) = False Then
Anime_Add . ListBox1 . Items . Add ( WebbrowserURL )
End If
'Anime_Add.ListBox1.Items.Add(WebbrowserURL)
2020-10-15 13:49:06 +02:00
Return Nothing
End Function ) )
Else
2020-10-31 23:36:52 +01:00
If ListBoxList . Contains ( WebbrowserURL ) = False Then
ListBoxList . Add ( WebbrowserURL )
End If
'ListBoxList.Add(WebbrowserURL)
2020-10-15 13:49:06 +02:00
End If
2020-08-16 23:27:48 +02:00
End If
2020-10-15 13:49:06 +02:00
strRequest = rootPath & " Post_Single_Sucess.html " 'PostPage
2021-02-20 18:25:49 +01:00
SendHTMLResponse ( strRequest , stream )
2020-10-15 13:49:06 +02:00
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-13 15:57:34 +01:00
Me . Text = " Status: no video found "
Me . Invalidate ( )
2020-10-15 13:49:06 +02:00
Return Nothing
End Function ) )
Dim ErrorPage As String = My . Resources . Post_error_Top + " no video found " + My . Resources . Post_error_Bottom
My . Computer . FileSystem . WriteAllText ( Application . StartupPath + " \WebInterface\error_Page.html " , ErrorPage , False )
strRequest = rootPath & " error_Page.html " 'PostPage
2021-02-20 18:25:49 +01:00
SendHTMLResponse ( strRequest , stream )
2020-08-16 23:27:48 +02:00
End If
2021-01-16 14:08:33 +01:00
Catch abort As ThreadAbortException
Exit Sub
2020-08-16 23:27:48 +02:00
Catch ex As Exception
Dim ErrorPage As String = My . Resources . Post_error_Top + ex . ToString + My . Resources . Post_error_Bottom
My . Computer . FileSystem . WriteAllText ( Application . StartupPath + " \WebInterface\error_Page.html " , ErrorPage , False )
strRequest = rootPath & " error_Page.html " 'PostPage
2021-02-20 18:25:49 +01:00
SendHTMLResponse ( strRequest , stream )
2020-08-16 23:27:48 +02:00
End Try
2020-09-30 18:19:31 +02:00
#End Region
#Region "mass-dl"
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( htmlReq , " HTMLMass= " ) ) Then
2020-09-30 18:19:31 +02:00
Debug . WriteLine ( " multi episode mode " )
2020-08-16 23:27:48 +02:00
Try
Dim html ( ) As String = htmlReq . Split ( New String ( ) { " HTMLMass= " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim DecodedHTML As String = UrlDecode ( html ( 1 ) )
Dim URLSplit ( ) As String = DecodedHTML . Split ( New String ( ) { " javascript: " } , System . StringSplitOptions . RemoveEmptyEntries )
2020-09-30 18:19:31 +02:00
If Application . OpenForms ( ) . OfType ( Of Anime_Add ) . Any = True Then
2020-08-16 23:27:48 +02:00
For i As Integer = 0 To URLSplit . Count - 1
2020-10-07 22:40:58 +02:00
Dim ii As Integer = i
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-10-31 23:36:52 +01:00
If Anime_Add . ListBox1 . Items . Contains ( URLSplit ( ii ) ) = False Then
Anime_Add . ListBox1 . Items . Add ( URLSplit ( ii ) )
End If
'Anime_Add.ListBox1.Items.Add(URLSplit(ii))
2020-09-30 18:19:31 +02:00
Return Nothing
End Function ) )
2020-08-16 23:27:48 +02:00
Next
Else
2020-09-30 18:19:31 +02:00
2020-08-16 23:27:48 +02:00
For i As Integer = 0 To URLSplit . Count - 1
2020-10-31 23:36:52 +01:00
If ListBoxList . Contains ( URLSplit ( i ) ) = False Then
ListBoxList . Add ( URLSplit ( i ) )
End If
2020-08-16 23:27:48 +02:00
Next
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-13 15:57:34 +01:00
Me . Text = " Status: " + ListBoxList . Count . ToString + " Downloads in queue " + vbNewLine + " open the add window to continue "
Me . Invalidate ( )
2020-09-30 18:19:31 +02:00
Return Nothing
End Function ) )
2020-08-16 23:27:48 +02:00
End If
strRequest = rootPath & " Post_Mass_Sucess.html " 'PostPage
2021-02-20 18:25:49 +01:00
SendHTMLResponse ( strRequest , stream )
2021-01-16 14:08:33 +01:00
Catch abort As ThreadAbortException
Exit Sub
2020-08-16 23:27:48 +02:00
Catch ex As Exception
Dim ErrorPage As String = My . Resources . Post_error_Top + ex . ToString + My . Resources . Post_error_Bottom
My . Computer . FileSystem . WriteAllText ( Application . StartupPath + " \WebInterface\error_Page.html " , ErrorPage , False )
strRequest = rootPath & " error_Page.html " 'PostPage
2021-02-20 18:25:49 +01:00
SendHTMLResponse ( strRequest , stream )
2020-08-16 23:27:48 +02:00
End Try
2020-09-30 18:19:31 +02:00
#End Region
2021-02-28 13:22:00 +01:00
#Region "Funimation-mass"
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( htmlReq , " FunimationMass= " ) ) Then
2021-02-28 13:22:00 +01:00
Debug . WriteLine ( " Funimation multi episode mode " )
Try
Dim DecodedHTML As String = UrlDecode ( htmlReq )
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( DecodedHTML , " &FunimationCookie= " ) ) Then
2021-02-28 13:22:00 +01:00
Dim CookieSplit ( ) As String = DecodedHTML . Split ( New String ( ) { " &FunimationCookie= " } , System . StringSplitOptions . RemoveEmptyEntries )
SystemWebBrowserCookie = CookieSplit ( 1 )
Dim URLSplit ( ) As String = CookieSplit ( 0 ) . Split ( New String ( ) { " FunimationMass= " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim URLSplit2 ( ) As String = URLSplit ( 1 ) . Split ( New String ( ) { " javascript: " } , System . StringSplitOptions . RemoveEmptyEntries )
If Application . OpenForms ( ) . OfType ( Of Anime_Add ) . Any = True Then
For i As Integer = 0 To URLSplit2 . Count - 1
Dim ii As Integer = i
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-02-28 13:22:00 +01:00
If Anime_Add . ListBox1 . Items . Contains ( URLSplit2 ( ii ) ) = False Then
Anime_Add . ListBox1 . Items . Add ( URLSplit2 ( ii ) )
End If
'Anime_Add.ListBox1.Items.Add(URLSplit(ii))
Return Nothing
End Function ) )
Next
Else
For i As Integer = 0 To URLSplit2 . Count - 1
If ListBoxList . Contains ( URLSplit2 ( i ) ) = False Then
ListBoxList . Add ( URLSplit2 ( i ) )
End If
Next
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-02-28 13:22:00 +01:00
Me . Text = " Status: " + ListBoxList . Count . ToString + " Downloads in queue " + vbNewLine + " open the add window to continue "
Me . Invalidate ( )
Return Nothing
End Function ) )
End If
strRequest = rootPath & " Post_Mass_Sucess.html " 'PostPage
SendHTMLResponse ( strRequest , stream )
End If
Catch abort As ThreadAbortException
Exit Sub
Catch ex As Exception
Dim ErrorPage As String = My . Resources . Post_error_Top + ex . ToString + My . Resources . Post_error_Bottom
My . Computer . FileSystem . WriteAllText ( Application . StartupPath + " \WebInterface\error_Page.html " , ErrorPage , False )
strRequest = rootPath & " error_Page.html " 'PostPage
SendHTMLResponse ( strRequest , stream )
End Try
#End Region
2020-09-30 18:19:31 +02:00
#Region "funimation Einzeln"
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( htmlReq , " FunimationURL= " ) ) Then
2020-09-30 18:19:31 +02:00
Debug . WriteLine ( " single episode mode - Funimation " )
2021-03-08 21:08:26 +01:00
'MsgBox(htmlReq)
2021-02-28 13:22:00 +01:00
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-13 15:57:34 +01:00
Me . Text = " Status: Download added from add-on "
Me . Invalidate ( )
2020-09-30 18:19:31 +02:00
Return Nothing
End Function ) )
2020-08-16 23:27:48 +02:00
Try
2020-09-30 18:19:31 +02:00
Dim URLSplit ( ) As String = htmlReq . Split ( New String ( ) { " FunimationURL= " } , System . StringSplitOptions . RemoveEmptyEntries )
2021-02-28 13:22:00 +01:00
Dim URLSplit2 ( ) As String = URLSplit ( 1 ) . Split ( New String ( ) { " &FunimationCookie= " } , System . StringSplitOptions . RemoveEmptyEntries )
SystemWebBrowserCookie = URLSplit2 ( 1 )
WebbrowserURL = UrlDecode ( URLSplit2 ( 0 ) )
2020-08-16 23:27:48 +02:00
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( WebbrowserURL , " funimation.com " ) ) Then
2021-01-16 14:08:33 +01:00
If DubFunimation = " Disabled " Then
Else
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( WebbrowserURL , " ?lang= " ) ) Then
2021-01-16 14:08:33 +01:00
Dim ClearUri As String ( ) = WebbrowserURL . Split ( New String ( ) { " ?lang= " } , System . StringSplitOptions . RemoveEmptyEntries )
If ClearUri . Count > 1 Then
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( ClearUri ( 1 ) , " & " ) ) Then
2021-01-16 14:08:33 +01:00
Dim ClearUri2 As String ( ) = ClearUri ( 1 ) . Split ( New String ( ) { " & " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Parms As String = Nothing
2021-03-08 21:08:26 +01:00
For i As Integer = 1 To ClearUri2 . Count - 1
2021-01-16 14:08:33 +01:00
Parms = Parms + " & " + ClearUri2 ( i )
Next
WebbrowserURL = ClearUri ( 0 ) + " ?lang= " + DubFunimation + Parms
Else
WebbrowserURL = ClearUri ( 0 ) + " ?lang= " + DubFunimation
End If
Else
WebbrowserURL = ClearUri ( 0 ) + " ?lang= " + DubFunimation
End If
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( WebbrowserURL , " &lang= " ) ) Then
2021-01-16 14:08:33 +01:00
Dim ClearUri As String ( ) = WebbrowserURL . Split ( New String ( ) { " &lang= " } , System . StringSplitOptions . RemoveEmptyEntries )
If ClearUri . Count > 1 Then
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( ClearUri ( 1 ) , " & " ) ) Then
2021-01-16 14:08:33 +01:00
Dim ClearUri2 As String ( ) = ClearUri ( 1 ) . Split ( New String ( ) { " & " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Parms As String = Nothing
For i As Integer = 1 To ClearUri2 . Count - 1
Parms = Parms + " & " + ClearUri2 ( i )
Next
WebbrowserURL = ClearUri ( 0 ) + " &lang= " + DubFunimation + Parms
Else
WebbrowserURL = ClearUri ( 0 ) + " &lang= " + DubFunimation
End If
Else
WebbrowserURL = ClearUri ( 0 ) + " &lang= " + DubFunimation
End If
2021-09-20 20:37:57 +02:00
ElseIf CBool ( InStr ( WebbrowserURL , " ? " ) ) Then
2021-01-16 14:08:33 +01:00
WebbrowserURL = WebbrowserURL + " &lang= " + DubFunimation
Else
WebbrowserURL = WebbrowserURL + " ?lang= " + DubFunimation
End If
End If
End If
2020-08-16 23:27:48 +02:00
If Funimation_Grapp_RDY = True Then
2020-08-27 13:25:28 +02:00
If RunningDownloads >= MaxDL Then
2020-10-31 23:36:52 +01:00
If ListBoxList . Contains ( WebbrowserURL ) = False Then
ListBoxList . Add ( WebbrowserURL )
End If
'ListBoxList.Add(WebbrowserURL)
2020-08-27 13:25:28 +02:00
Else
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
Navigate ( WebbrowserURL )
2021-06-20 19:02:55 +02:00
Return Nothing
End Function ) )
2021-02-28 13:22:00 +01:00
2021-06-20 19:02:55 +02:00
b = False
2021-02-28 13:22:00 +01:00
2020-08-27 13:25:28 +02:00
End If
2020-09-30 18:19:31 +02:00
Else
If Application . OpenForms ( ) . OfType ( Of Anime_Add ) . Any = True Then
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-10-31 23:36:52 +01:00
If Anime_Add . ListBox1 . Items . Contains ( WebbrowserURL ) = False Then
Anime_Add . ListBox1 . Items . Add ( WebbrowserURL )
End If
2020-09-30 18:19:31 +02:00
Return Nothing
End Function ) )
2020-08-16 23:27:48 +02:00
Else
2020-10-31 23:36:52 +01:00
If ListBoxList . Contains ( WebbrowserURL ) = False Then
ListBoxList . Add ( WebbrowserURL )
End If
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2020-11-13 15:57:34 +01:00
Me . Text = " Status: " + ListBoxList . Count . ToString + " Downloads in queue "
Me . Invalidate ( )
2020-10-15 13:49:06 +02:00
Return Nothing
End Function ) )
2020-08-16 23:27:48 +02:00
End If
End If
strRequest = rootPath & " Post_Single_Sucess.html " 'PostPage
2021-02-20 18:25:49 +01:00
SendHTMLResponse ( strRequest , stream )
2021-01-16 14:08:33 +01:00
Catch abort As ThreadAbortException
Exit Sub
2020-08-16 23:27:48 +02:00
Catch ex As Exception
Dim ErrorPage As String = My . Resources . Post_error_Top + ex . ToString + My . Resources . Post_error_Bottom
My . Computer . FileSystem . WriteAllText ( Application . StartupPath + " \WebInterface\error_Page.html " , ErrorPage , False )
strRequest = rootPath & " error_Page.html " 'PostPage
2021-02-20 18:25:49 +01:00
SendHTMLResponse ( strRequest , stream )
2020-08-16 23:27:48 +02:00
End Try
2020-09-30 18:19:31 +02:00
#End Region
2020-08-16 23:27:48 +02:00
Else
strRequest = rootPath & " error_Page_default.html " 'PostPage
2021-02-20 18:25:49 +01:00
SendHTMLResponse ( strRequest , stream )
2020-08-16 23:27:48 +02:00
End If
2020-09-30 18:19:31 +02:00
ElseIf strArray ( 0 ) . Trim ( ) . ToUpper . Equals ( " GET " ) Then
2021-02-20 18:25:49 +01:00
'Debug.WriteLine(Date.Now + " " + "found GET while procesing")
2021-02-12 13:44:17 +01:00
2021-02-20 18:25:49 +01:00
'Debug.WriteLine(Date.Now + " " + strArray(1))
2020-09-30 18:19:31 +02:00
strRequest = strArray ( 1 ) . Trim
If strRequest . StartsWith ( " / " ) Then
strRequest = strRequest . Substring ( 1 )
2021-02-20 18:25:49 +01:00
2020-09-30 18:19:31 +02:00
End If
2021-02-20 18:25:49 +01:00
2020-09-30 18:19:31 +02:00
If strRequest . EndsWith ( " / " ) Or strRequest . Equals ( " " ) Then
2021-02-20 18:25:49 +01:00
'Debug.WriteLine(Date.Now + " " + "it's index.html")
2020-09-30 18:19:31 +02:00
strRequest = strRequest & defaultPage '"HTMLString" 'strRequest & defaultPage
2021-02-20 18:25:49 +01:00
2020-09-30 18:19:31 +02:00
End If
2021-09-20 20:37:57 +02:00
'If CBool(InStr(htmlReq, "CRD_Handshake") Then
2021-02-20 18:25:49 +01:00
' 'Debug.WriteLine(Date.Now + " " + "it's a handshake")
' SendHTMLResponse("Handshake_Confirm", stream)
'Else
'
'End If
2020-09-30 18:19:31 +02:00
strRequest = rootPath & strRequest
2021-02-20 18:25:49 +01:00
SendHTMLResponse ( strRequest , stream )
2020-09-30 18:19:31 +02:00
2020-08-16 23:27:48 +02:00
Else ' Not HTTP GET method
2021-02-20 18:25:49 +01:00
'Debug.WriteLine(Date.Now + " " + "empty request, returning index.html")
'Debug.WriteLine(Date.Now + " " + strArray(0))
2020-08-16 23:27:48 +02:00
strRequest = rootPath & defaultPage
2021-02-20 18:25:49 +01:00
SendHTMLResponse ( strRequest , stream )
2020-08-16 23:27:48 +02:00
End If
2021-02-20 18:25:49 +01:00
2020-08-16 23:27:48 +02:00
Catch ex As Exception
2020-09-30 18:19:31 +02:00
Debug . WriteLine ( ex . ToString ( ) )
Dim ErrorPage As String = My . Resources . Post_error_Top + ex . ToString + My . Resources . Post_error_Bottom
My . Computer . FileSystem . WriteAllText ( Application . StartupPath + " \WebInterface\error_Page.html " , ErrorPage , False )
'strRequest = rootPath & "error_Page.html" 'PostPage
2021-02-20 18:25:49 +01:00
SendHTMLResponse ( Application . StartupPath + " \WebInterface\error_Page.html " , stream )
2020-08-16 23:27:48 +02:00
End Try
2020-02-12 22:08:02 +01:00
End Sub
2020-08-16 23:27:48 +02:00
' Send HTTP Response
2021-02-20 18:25:49 +01:00
Private Sub SendHTMLResponse ( ByVal httpRequest As String , ByVal stream As NetworkStream )
2020-08-16 23:27:48 +02:00
Try
Dim respByte ( ) As Byte
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( httpRequest , " index.html " ) ) Then
2020-09-30 18:19:31 +02:00
Debug . WriteLine ( httpRequest )
2021-02-20 18:25:49 +01:00
respByte = System . Text . Encoding . UTF8 . GetBytes ( HTML ) 'File.ReadAllBytes("") '
2020-08-16 23:27:48 +02:00
' Set HTML Header
Dim htmlHeader As String =
" HTTP/1.0 200 OK " & ControlChars . CrLf &
2021-01-16 14:08:33 +01:00
" Server: CRD 1.0 " & ControlChars . CrLf &
2021-02-20 18:25:49 +01:00
" Content-Length: " & respByte . Length & ControlChars . CrLf &
2021-01-16 14:08:33 +01:00
" Content-Type: " & GetContentType ( httpRequest ) &
2020-08-16 23:27:48 +02:00
ControlChars . CrLf & ControlChars . CrLf
' The content Length of HTML Header
Dim headerByte ( ) As Byte = Encoding . UTF8 . GetBytes ( htmlHeader )
2020-09-30 18:19:31 +02:00
'Debug.WriteLine("HTML Header: " & ControlChars.CrLf & htmlHeader)
2020-08-16 23:27:48 +02:00
' Send HTML Header back to Web Browser
2021-02-20 18:25:49 +01:00
'Dim response() As Byte = headerByte.Concat(respByte).ToArray()
' stream.Write(response, 0, response.Length)
'Debug.WriteLine("sending headers")
stream . Write ( headerByte , 0 , headerByte . Length )
'Debug.WriteLine("headers send")
'Debug.WriteLine("sending content")
2020-08-16 23:27:48 +02:00
' Send HTML Content back to Web Browser
2021-02-20 18:25:49 +01:00
stream . Write ( respByte , 0 , respByte . Length )
'clientSocket.Send(respByte, 0, respByte.Length, SocketFlags.None)
2020-08-16 23:27:48 +02:00
' Close HTTP Socket connection
2021-02-20 18:25:49 +01:00
'Debug.WriteLine("content send")
ElseIf File . Exists ( httpRequest ) Then
Debug . WriteLine ( httpRequest )
respByte = File . ReadAllBytes ( httpRequest )
' Set HTML Header
Dim htmlHeader As String =
" HTTP/1.0 200 OK " & ControlChars . CrLf &
" Server: CRD 1.0 " & ControlChars . CrLf &
" Content-Length: " & respByte . Length & ControlChars . CrLf &
2021-06-20 19:02:55 +02:00
" Content-Type: " & GetContentType ( httpRequest ) & ControlChars . CrLf &
2021-02-20 18:25:49 +01:00
" Connection: close " &
ControlChars . CrLf & ControlChars . CrLf
' The content Length of HTML Header
Dim headerByte ( ) As Byte = Encoding . UTF8 . GetBytes ( htmlHeader )
' Send HTML Header back to Web Browser
stream . Write ( headerByte , 0 , headerByte . Length )
' Send HTML Content back to Web Browser
stream . Write ( respByte , 0 , respByte . Length )
2021-02-12 13:44:17 +01:00
ElseIf httpRequest = " Handshake_Confirm " Then
respByte = System . Text . Encoding . UTF8 . GetBytes ( " CRD_Handshake_Confirm " ) 'File.ReadAllBytes("") '
Dim htmlHeader As String =
" HTTP/1.0 200 OK " & ControlChars . CrLf &
" Server: CRD 1.0 " & ControlChars . CrLf &
" Access-Control-Allow-Origin: * " & ControlChars . CrLf &
" Content-Length: " & respByte . Length & ControlChars . CrLf &
" Content-Type: text/plain " &
2021-02-20 18:25:49 +01:00
" Connection: close " &
ControlChars . CrLf & ControlChars . CrLf
2021-02-12 13:44:17 +01:00
Dim headerByte ( ) As Byte = Encoding . UTF8 . GetBytes ( htmlHeader )
2021-02-20 18:25:49 +01:00
stream . Write ( headerByte , 0 , headerByte . Length )
' Send HTML Content back to Web Browser
stream . Write ( respByte , 0 , respByte . Length )
Debug . WriteLine ( " content send " )
2020-08-16 23:27:48 +02:00
Else
respByte = Encoding . UTF8 . GetBytes ( My . Resources . Error_404 ) 'File.ReadAllBytes(httpRequest)
2020-09-30 18:19:31 +02:00
Debug . WriteLine ( " 404 Not Found : " + httpRequest )
2020-08-16 23:27:48 +02:00
' Set HTML Header
Dim htmlHeader As String =
" HTTP/1.0 404 Not Found " & ControlChars . CrLf &
" Server: WebServer 1.0 " & ControlChars . CrLf &
2021-02-20 18:25:49 +01:00
" Connection: close " &
2020-08-16 23:27:48 +02:00
ControlChars . CrLf & ControlChars . CrLf
' The content Length of HTML Header
Dim headerByte ( ) As Byte = Encoding . UTF8 . GetBytes ( htmlHeader )
2020-09-30 18:19:31 +02:00
2020-08-16 23:27:48 +02:00
' Send HTML Header back to Web Browser
2021-02-20 18:25:49 +01:00
stream . Write ( headerByte , 0 , headerByte . Length )
'stream.Write(headerByte, 0, headerByte.Length, SocketFlags.None)
2020-08-16 23:27:48 +02:00
' Send HTML Content back to Web Browser
2021-02-20 18:25:49 +01:00
stream . Write ( respByte , 0 , respByte . Length )
2020-08-16 23:27:48 +02:00
End If
Catch ex As Exception
2021-02-20 18:25:49 +01:00
Debug . WriteLine ( ex . ToString ( ) )
2020-04-01 20:55:47 +02:00
2020-08-16 23:27:48 +02:00
End Try
2020-06-10 17:34:27 +02:00
End Sub
2020-08-16 23:27:48 +02:00
2021-02-20 18:25:49 +01:00
2020-08-16 23:27:48 +02:00
' Get Content Type
2020-12-02 21:01:30 +01:00
Private Function GetContentType ( ByVal httpRequest As String ) As String
2020-08-16 23:27:48 +02:00
If ( httpRequest . EndsWith ( " html " ) ) Then
Return " text/html "
ElseIf ( httpRequest . EndsWith ( " htm " ) ) Then
Return " text/html "
ElseIf ( httpRequest . EndsWith ( " txt " ) ) Then
Return " text/plain "
ElseIf ( httpRequest . EndsWith ( " gif " ) ) Then
Return " image/gif "
ElseIf ( httpRequest . EndsWith ( " jpg " ) ) Then
Return " image/jpeg "
ElseIf ( httpRequest . EndsWith ( " jpg " ) ) Then
Return " image/jpeg "
ElseIf ( httpRequest . EndsWith ( " ico " ) ) Then
Return " image/x-icon "
ElseIf ( httpRequest . EndsWith ( " png " ) ) Then
Return " image/png "
ElseIf ( httpRequest . EndsWith ( " jpeg " ) ) Then
Return " image/jpeg "
ElseIf ( httpRequest . EndsWith ( " pdf " ) ) Then
Return " application/pdf "
ElseIf ( httpRequest . EndsWith ( " pdf " ) ) Then
Return " application/pdf "
ElseIf ( httpRequest . EndsWith ( " doc " ) ) Then
Return " application/msword "
ElseIf ( httpRequest . EndsWith ( " xls " ) ) Then
Return " application/vnd.ms-excel "
ElseIf ( httpRequest . EndsWith ( " ppt " ) ) Then
Return " application/vnd.ms-powerpoint "
ElseIf ( httpRequest . EndsWith ( " js " ) ) Then
Return " application/javascript "
2020-10-15 01:04:15 +02:00
ElseIf ( httpRequest . EndsWith ( " ass " ) ) Then
Return " application/octet-stream "
2021-09-20 20:37:57 +02:00
ElseIf ( httpRequest . EndsWith ( " check " ) ) Then
Return " application/json "
2020-08-16 23:27:48 +02:00
Else
Return " text/plain "
End If
End Function
2020-12-04 20:22:22 +01:00
Private Sub Button1_Click ( sender As Object , e As EventArgs )
2020-12-08 19:01:35 +01:00
ErrorDialog . Show ( )
2020-12-04 20:22:22 +01:00
End Sub
2020-12-10 19:18:20 +01:00
Private Sub Button1_Click_1 ( sender As Object , e As EventArgs )
ErrorDialog . ShowDialog ( )
End Sub
2020-12-04 20:22:22 +01:00
2020-09-30 18:19:31 +02:00
2020-12-13 16:11:43 +01:00
Private Sub Btn_min_Click ( sender As Object , e As EventArgs ) Handles Btn_min . Click
Me . WindowState = System . Windows . Forms . FormWindowState . Minimized
End Sub
2020-09-30 18:19:31 +02:00
2020-12-24 16:56:45 +01:00
Private Sub Button1_Click_2 ( sender As Object , e As EventArgs )
network_scan . Show ( )
End Sub
2021-07-04 17:22:46 +02:00
Private Sub Timer4_Tick ( sender As Object , e As EventArgs ) Handles Timer4 . Tick
If ListBoxList . Count > 0 Then
2021-09-20 20:37:57 +02:00
If CBool ( InStr ( Me . Text , " Crunchyroll Downloader " ) ) Then
2021-07-04 17:22:46 +02:00
Me . Text = " Status: " + ListBoxList . Count . ToString + " Downloads in queue " + vbNewLine + " open the add window to continue "
End If
End If
End Sub
2021-09-20 20:37:57 +02:00
Private Sub Main_Shown ( sender As Object , e As EventArgs ) Handles Me . Shown
Btn_add . Image = My . Resources . main_add
ListView1 . Select ( )
End Sub
2021-04-05 19:08:42 +02:00
2020-12-13 16:11:43 +01:00
#End Region
2020-09-30 18:19:31 +02:00
End Class
2020-11-04 19:11:38 +01:00