2021-09-20 20:37:57 +02:00
Option Strict On
2024-04-09 21:15:21 +02:00
2021-09-20 20:37:57 +02:00
Imports System . Net
2019-11-10 00:16:12 +01:00
Imports System . Text
Imports System . IO
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-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
2022-11-10 14:31:11 +01:00
Imports MyProvider . MyProvider
2022-12-02 18:43:43 +01:00
Imports Microsoft . Web . WebView2 . Core
2023-02-21 14:17:59 +01:00
Imports Crunchyroll_Downloader . CRD_Classes
2024-04-09 21:15:21 +02:00
2019-11-10 00:16:12 +01:00
Public Class Main
2020-11-13 15:57:34 +01:00
Inherits MetroForm
2023-02-16 20:56:58 +01:00
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
2022-10-20 18:23:22 +02:00
Public CR_Cookies As String = " Cookie: "
2022-10-24 18:33:49 +02:00
2023-01-21 11:21:39 +01:00
Public CR_MassSeasons As New List ( Of CR_Seasons )
Public CR_MassEpisodes As New List ( Of CR_Seasons )
2024-04-21 10:35:49 +02:00
Public Mail As String = Nothing
Public PW As String = Nothing
Public CrBetaBasic As String = " Basic dC1rZGdwMmg4YzNqdWI4Zm4wZnE6eWZMRGZNZnJZdktYaDRKWFMxTEVJMmNDcXUxdjVXYW4= "
2024-04-28 21:29:33 +02:00
Public CR_Token As CR_Tokens = New CR_Tokens ( Nothing , " " , 0 )
2022-10-27 17:23:57 +02:00
Public locale As String = Nothing
2022-10-29 14:48:05 +02:00
Public Url_locale As String = Nothing
2024-04-28 21:29:33 +02:00
2022-12-02 18:43:43 +01:00
Public LoadingUrl As String = " "
2022-12-18 20:28:02 +01:00
Public LoadedUrls As New List ( Of CoreWebView2WebResourceRequest )
2024-04-13 11:37:48 +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
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
2022-12-02 18:43:43 +01:00
Public CookieList As New List ( Of CoreWebView2Cookie )
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 )
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-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
2022-06-24 16:11:21 +02:00
Public IgnoreSeason As Integer = 0
2023-02-09 13:24:51 +01:00
Public HideFLInt As Integer = 0
2021-07-04 17:22:46 +02:00
Public KeepCache As Boolean = False
2023-02-21 14:17:59 +01:00
Public DownloadScope As Integer = 0
2021-03-08 21:08:26 +01:00
Public VideoFormat As String = " .mp4 "
Public MergeSubsFormat As String = " mov_text "
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
2024-05-11 18:47:10 +02:00
'Dim NewAPIString1 As String
'Dim NewAPIString2 As String
2024-03-15 18:04:55 +01:00
Dim TTL As Integer = 0
2022-10-24 18:33:49 +02:00
'Public ErrorBrowserBackString As String
2023-06-19 20:17:59 +02:00
Public RunningQueue As Boolean = False
2019-11-10 00:16:12 +01:00
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
2019-11-10 00:16:12 +01:00
Public LoginOnly As String = " False "
Public Pfad As String = My . Computer . FileSystem . CurrentDirectory
2022-03-19 12:01:12 +01:00
Public TempFolder As String = Pfad
2022-11-10 14:31:11 +01:00
Public ProfileFolder As String = Path . Combine ( Application . StartupPath , " CRD-Profile " ) '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
2021-02-07 13:47:30 +01:00
Public Season_Prefix As String = " [default season prefix] "
2023-01-05 14:26:40 +01:00
Public Season_PrefixDefault As String = " [default season prefix] "
2021-02-07 13:47:30 +01:00
Public Episode_Prefix As String = " [default episode prefix] "
2023-01-05 14:26:40 +01:00
Public Episode_PrefixDefault As String = " [default episode prefix] "
2022-12-02 18:43:43 +01:00
2020-11-13 15:57:34 +01:00
Public ResoSave As String = " 6666x6666 "
2020-11-21 14:56:27 +01:00
Public ResoFunBackup As String = " 6666x6666 "
2023-01-21 11:21:39 +01:00
Public LangValueEnum As New List ( Of NameValuePair )
2023-09-10 16:28:23 +02:00
Public DubSprache As NameValuePair = New NameValuePair ( " Japanese " , " jpn " , " ja-JP " , Nothing )
2023-12-15 16:53:07 +01:00
Public SubSprache As NameValuePair = New NameValuePair ( " [ null ] " , " " , " null " , Nothing )
2023-01-21 11:21:39 +01:00
2019-11-10 00:16:12 +01:00
Public SoftSubs As New List ( Of String )
2021-09-20 20:37:57 +02:00
Public IncludeLangName As Boolean = False
2022-01-23 15:34:33 +01:00
Public LangNameType As Integer = 0
2022-07-30 10:04:28 +02:00
Public HybridThread As Integer = CInt ( Environment . ProcessorCount / 2 - 1 )
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
2023-01-01 16:34:18 +01:00
'Dim URL_DL As String
'Dim Pfad_DL As String
2019-11-10 00:16:12 +01:00
Public 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
2023-01-01 20:47:09 +01:00
Public NameBuilder As String = " "
2021-12-20 18:10:51 +01:00
Public LeadingZero As Integer = 1
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
2024-05-11 18:47:10 +02:00
Public UserQueue As Boolean = False
2019-11-10 00:16:12 +01:00
Public UserBowser As Boolean = False
2024-05-11 18:47:10 +02:00
2023-06-03 15:57:13 +02:00
Public BowserWasOpen As Boolean = False
2020-09-30 18:19:31 +02:00
Public HybridMode As Boolean = False
2024-04-13 11:37:48 +02:00
2021-02-20 18:25:49 +01:00
Public DefaultSubCR As String = " Disabled "
2022-08-05 15:12:25 +02:00
Public DubMode As Boolean = True
2022-10-25 18:05:57 +02:00
Public CR_Chapters As Boolean = False
2022-10-26 09:39:24 +02:00
Public Curl_insecure As Boolean = False
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. "
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? "
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 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 "
2022-12-29 11:45:55 +01: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
2021-12-19 13:38:19 +01:00
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 ( )
2023-01-07 19:04:56 +01:00
2020-11-13 15:57:34 +01:00
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 ( )
2022-11-10 14:31:11 +01:00
Panel1 . BackColor = Color . FromArgb ( 50 , 50 , 50 )
2020-12-10 19:18:20 +01:00
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
2021-12-19 13:38:19 +01:00
2020-12-10 19:18:20 +01:00
Public Sub LightMode ( )
2021-01-16 14:08:33 +01:00
BackColorValue = Color . FromArgb ( 243 , 243 , 243 )
ForeColorValue = SystemColors . WindowText
2022-11-10 14:31:11 +01:00
Panel1 . BackColor = SystemColors . Control
2020-12-10 19:18:20 +01:00
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
2021-12-19 13:38:19 +01:00
2021-09-20 20:37:57 +02:00
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
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
2021-12-19 13:38:19 +01: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
2023-01-07 19:04:56 +01:00
Private Sub Btn_Queue_MouseEnter ( sender As Object , e As EventArgs ) Handles Btn_Queue . MouseEnter , Btn_Queue . GotFocus
If Manager . Theme = MetroThemeStyle . Dark Then
Btn_Queue . Image = My . Resources . main_queue_invert_dark
Else
Btn_Queue . Image = My . Resources . main_queue_invert
End If
End Sub
Private Sub Btn_Queue_MouseLeave ( sender As Object , e As EventArgs ) Handles Btn_Queue . MouseLeave , Btn_Queue . LostFocus
Btn_Queue . Image = My . Resources . main_queue
End Sub
2021-12-19 13:38:19 +01:00
Private Sub Btn_min_MouseEnter ( sender As Object , e As EventArgs ) Handles Btn_min . MouseEnter , Btn_min . GotFocus
2021-09-20 20:37:57 +02:00
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
2022-11-10 14:31:11 +01:00
Private Sub ConsoleBar_Click ( sender As Object , e As EventArgs ) Handles ConsoleBar . Click
2020-11-13 15:57:34 +01:00
If TheTextBox . Visible = True Then
2022-12-02 18:43:43 +01:00
'TheTextBox.Lines = DebugList.ToArray
2020-11-13 15:57:34 +01:00
TheTextBox . Visible = False
ListViewHeightOffset = 7
2022-11-10 14:31:11 +01:00
ConsoleBar . Location = New Point ( 0 , Me . Height - ListViewHeightOffset )
2020-11-13 15:57:34 +01:00
TheTextBox . Location = New Point ( 1 , Me . Height - ListViewHeightOffset + 7 )
TheTextBox . Width = Me . Width - 2
Else
ListViewHeightOffset = 103
TheTextBox . Visible = True
2022-11-10 14:31:11 +01:00
ConsoleBar . Location = New Point ( 0 , Me . Height - ListViewHeightOffset )
2020-11-13 15:57:34 +01:00
TheTextBox . Location = New Point ( 1 , Me . Height - ListViewHeightOffset + 7 )
TheTextBox . Width = Me . Width - 2
End If
2022-11-10 14:31:11 +01:00
Me . Height = Me . Height + 1
2020-11-13 15:57:34 +01:00
End Sub
2022-11-10 14:31:11 +01:00
Private Sub ConsoleBar_MouseEnter ( sender As Object , e As EventArgs ) Handles ConsoleBar . MouseEnter
ConsoleBar . BackgroundImage = My . Resources . balken_console
2020-11-13 15:57:34 +01:00
End Sub
2022-11-10 14:31:11 +01:00
Private Sub ConsoleBar_MouseLeave ( sender As Object , e As EventArgs ) Handles ConsoleBar . MouseLeave
ConsoleBar . BackgroundImage = My . Resources . balken
2020-11-13 15:57:34 +01:00
End Sub
Private Sub Main_Resize ( sender As Object , e As EventArgs ) Handles Me . Resize
2022-11-10 14:31:11 +01:00
Panel1 . Width = Me . Width - 2
Panel1 . Height = Me . Height - 71 - ListViewHeightOffset
2020-11-13 15:57:34 +01:00
PictureBox5 . Width = Me . Width - 40
2022-11-10 14:31:11 +01:00
ConsoleBar . Location = New Point ( 1 , Me . Height - ListViewHeightOffset )
ConsoleBar . Width = Me . Width - 40
2020-11-13 15:57:34 +01:00
TheTextBox . Location = New Point ( 1 , Me . Height - ListViewHeightOffset + 7 )
TheTextBox . Width = Me . Width - 2
2023-01-07 19:04:56 +01:00
Btn_Close . Location = New Point ( Me . Width - 36 , 1 )
Btn_min . Location = New Point ( Me . Width - 67 , 1 )
Btn_Settings . Location = New Point ( Me . Width - 165 , 17 )
Btn_Queue . Location = New Point ( Me . Width - 265 , 17 )
2020-11-13 15:57:34 +01:00
Try
2022-11-10 14:31:11 +01:00
Panel1 . AutoScrollPosition = New Point ( 0 , 0 )
Dim W As Integer = Panel1 . Width
If Panel1 . Controls . Count * 142 > Panel1 . Height Then
2022-12-02 18:43:43 +01:00
W = Panel1 . Width - SystemInformation . VerticalScrollBarWidth
2022-11-10 14:31:11 +01:00
End If
Dim Item As New List ( Of CRD_List_Item )
Item . AddRange ( Panel1 . Controls . OfType ( Of CRD_List_Item ) )
2022-12-02 18:43:43 +01:00
Item . Reverse ( )
2022-11-10 14:31:11 +01:00
For s As Integer = 0 To Item . Count - 1
Item ( s ) . SetBounds ( 0 , 142 * s , W - 2 , 142 )
If Debug2 = True Then
Debug . WriteLine ( " Bounds: " + Item ( s ) . GetTextBound . ToString )
Debug . WriteLine ( " Ist: " + Item ( s ) . Location . Y . ToString )
Debug . WriteLine ( " Soll: " + ( 142 * s ) . ToString )
2020-11-13 15:57:34 +01:00
End If
Next
Catch ex As Exception
2022-11-10 14:31:11 +01:00
Debug . WriteLine ( ex . ToString )
2020-11-13 15:57:34 +01:00
End Try
End Sub
2019-11-10 00:16:12 +01:00
#End Region
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
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
2022-12-18 20:28:02 +01:00
2021-12-20 18:10:51 +01:00
Function AddLeadingZeros ( ByVal txt As String ) As String
txt = txt . Replace ( " , " , " . " )
Dim Post As String = Nothing
If CBool ( InStr ( txt , " . " ) ) = True Then
Dim txt_split As String ( ) = txt . Split ( New String ( ) { " . " } , System . StringSplitOptions . RemoveEmptyEntries )
txt = txt_split ( 0 )
Post = " . " + txt_split ( 1 )
End If
For i As Integer = 0 To LeadingZero + 1
2021-12-31 14:21:19 +01:00
If txt . Count = LeadingZero + 1 Or txt . Count > LeadingZero + 1 Then
2021-12-20 18:10:51 +01:00
Exit For
Else
txt = " 0 " + txt
End If
Next
Dim Output As String = txt + Post
Return Output
End Function
2022-11-10 14:31:11 +01:00
2022-12-02 18:43:43 +01:00
Private Sub Main_Load ( sender As Object , e As EventArgs ) Handles MyBase . Load
2023-01-07 19:04:56 +01:00
2022-12-29 11:45:55 +01:00
FillArray ( )
2023-01-07 19:04:56 +01:00
2022-11-10 14:31:11 +01:00
#Region "settings path"
Dim mySettings As New DirectorySettings
mySettings . DirectoryName = Application . StartupPath
mySettings . FileName = " User.config.dat "
mySettings . Save ( ) ' muss explizit gepeichert werden...
#End Region
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
2021-09-26 22:01:31 +02:00
Thread . CurrentThread . Name = " Main "
2023-06-03 15:57:13 +02:00
Debug . WriteLine ( " v " + Application . ProductVersion )
2021-09-26 22:01:31 +02:00
Debug . WriteLine ( " Thread Name: " + Thread . CurrentThread . Name )
2022-11-10 14:31:11 +01:00
DarkModeValue = My . Settings . DarkModeValue
2021-09-20 20:37:57 +02:00
2024-04-04 19:52:43 +02:00
DownloadScope = My . Settings . DownloadScope
2021-12-20 18:10:51 +01:00
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
2022-11-10 14:31:11 +01:00
StartServer = My . Settings . ServerPort
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-01-12 16:25:55 +01:00
waveOutSetVolume ( 0 , 0 )
2022-11-10 14:31:11 +01:00
2019-11-10 00:16:12 +01:00
ServicePointManager . Expect100Continue = True
2022-10-20 18:23:22 +02:00
ServicePointManager . SecurityProtocol = SecurityProtocolType . Tls12
2022-11-10 14:31:11 +01:00
StatusToolTip . Active = True
2020-11-13 15:57:34 +01:00
Try
Me . Icon = My . Resources . icon
Catch ex As Exception
End Try
2022-03-19 12:01:12 +01:00
2022-11-10 14:31:11 +01:00
If My . Settings . Pfad = Nothing Then
Pfad = My . Computer . FileSystem . SpecialDirectories . MyDocuments
Else
Pfad = My . Settings . Pfad
End If
If My . Settings . TempFolder = Nothing Then
2022-03-19 12:01:12 +01:00
TempFolder = Pfad
2022-11-10 14:31:11 +01:00
Else
TempFolder = My . Settings . TempFolder
End If
2022-03-19 12:01:12 +01:00
2022-11-10 14:31:11 +01:00
Episode_Prefix = My . Settings . Prefix_E
2022-08-05 15:12:25 +02:00
2022-11-10 14:31:11 +01:00
Season_Prefix = My . Settings . Prefix_S
2022-08-05 15:12:25 +02:00
2022-10-25 18:05:57 +02:00
2022-11-10 14:31:11 +01:00
DefaultSubCR = My . Settings . DefaultSubCR
2021-12-31 14:21:19 +01:00
2022-11-10 14:31:11 +01:00
Startseite = My . Settings . Startseite
2021-12-31 14:21:19 +01:00
2022-09-06 21:20:05 +02:00
2022-11-10 14:31:11 +01:00
UseQueue = My . Settings . QueueMode
2022-09-06 21:20:05 +02:00
2022-11-10 14:31:11 +01:00
KodiNaming = My . Settings . KodiSupport
2022-09-06 21:20:05 +02:00
2022-11-10 14:31:11 +01:00
DubMode = My . Settings . DubMode
2022-09-06 21:20:05 +02:00
2022-11-10 14:31:11 +01:00
CR_Chapters = My . Settings . CR_Chapters
2022-09-06 21:20:05 +02:00
2022-11-10 14:31:11 +01:00
Curl_insecure = My . Settings . Curl_insecure
2022-01-23 15:34:33 +01:00
2022-11-10 14:31:11 +01:00
KeepCache = My . Settings . Keep_Cache
ffmpeg_command = My . Settings . ffmpeg_command
2023-01-26 21:01:15 +01:00
If My . Settings . ffmpeg_command_override = " null " Then
Else
ffmpeg_command = My . Settings . ffmpeg_command_override
End If
2022-11-10 14:31:11 +01:00
Reso = My . Settings . Reso
2024-04-13 11:37:48 +02:00
If Reso = 42 Then
2024-04-21 10:35:49 +02:00
MsgBox ( " Resolution [Auto] is no longer supported. " + vbNewLine + " Please select a valid Resolution inside the settings. " , MsgBoxStyle . Information )
2024-04-13 11:37:48 +02:00
End If
2022-11-10 14:31:11 +01:00
LeadingZero = My . Settings . LeadingZero
2022-12-29 11:45:55 +01:00
2023-01-21 11:21:39 +01:00
For i As Integer = 0 To LangValueEnum . Count - 1
If LangValueEnum ( i ) . CR_Value = My . Settings . Subtitle Then
2022-12-29 11:45:55 +01:00
'MsgBox(My.Settings.Subtitle)
2023-01-21 11:21:39 +01:00
SubSprache = LangValueEnum ( i )
2022-12-29 11:45:55 +01:00
Exit For
End If
Next
2022-11-10 14:31:11 +01:00
2023-01-21 11:21:39 +01:00
For i As Integer = 0 To LangValueEnum . Count - 1
If LangValueEnum ( i ) . CR_Value = My . Settings . CR_Dub Then
DubSprache = LangValueEnum ( i )
Exit For
End If
Next
2023-01-10 17:04:41 +01:00
2022-11-10 14:31:11 +01:00
2024-04-13 11:37:48 +02:00
2022-11-10 14:31:11 +01:00
SubFolder_Value = My . Settings . SubFolder_Value
MaxDL = My . Settings . SL_DL
2023-01-01 20:47:09 +01:00
'
If My . Settings . NameTemplate = " Unused " Then 'convert old stlye
If My . Settings . CR_NameMethode = 0 Then
NameBuilder = " AnimeTitle;Season;EpisodeNR; "
ElseIf My . Settings . CR_NameMethode = 1 Then
NameBuilder = " AnimeTitle;Season;EpisodeName; "
ElseIf My . Settings . CR_NameMethode = 2 Then
NameBuilder = " AnimeTitle;Season;EpisodeNR;EpisodeName; "
ElseIf My . Settings . CR_NameMethode = 3 Then
NameBuilder = " AnimeTitle;Season;EpisodeName;EpisodeNR; "
End If
Else
NameBuilder = My . Settings . NameTemplate
End If
2022-11-10 14:31:11 +01:00
ErrorTolerance = My . Settings . ErrorTolerance
IncludeLangName = My . Settings . IncludeLangName
LangNameType = My . Settings . LangNameType
HybridThread = My . Settings . HybridThread
IgnoreSeason = My . Settings . IgnoreSeason
2023-02-09 13:24:51 +01:00
HideFLInt = My . Settings . HideSF
2022-11-10 14:31:11 +01:00
HybridMode = My . Settings . HybridMode
SoftSubsString = My . Settings . AddedSubs
2023-01-01 16:34:18 +01:00
2022-11-10 14:31:11 +01:00
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
MergeSubsFormat = My . Settings . MergeSubs
If MergeSubsFormat = " [merge disabled] " Then
MergeSubs = False
Else
MergeSubs = True
2019-11-10 00:16:12 +01:00
End If
2022-11-10 14:31:11 +01:00
VideoFormat = My . Settings . VideoFormat
2023-02-21 14:17:59 +01:00
If VideoFormat = " .aac " Then
VideoFormat = " .mp4 "
'My.Settings.VideoFormat = ".mp4"
MsgBox ( " The 'Audio only' output option has been moved. " + vbNewLine + " See https://github.com/hama3254/Crunchyroll-Downloader-v3.0/issues/698 for more information. " )
End If
2022-11-10 14:31:11 +01:00
2021-07-04 17:22:46 +02:00
RetryWithCachedFiles ( )
2021-12-20 18:10:51 +01:00
2023-08-30 18:40:53 +02:00
'MsgBox(Curl_insecure.ToString)
2021-04-05 19:08:42 +02:00
2019-11-10 00:16:12 +01:00
End Sub
2022-11-10 14:31:11 +01:00
2022-12-29 11:45:55 +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 ThumbnialURL As String , ByVal URL_DL As String , ByVal Pfad_DL As String , Optional Service As String = " CR " ) ', ByVal AudioLang As String)
2022-07-08 20:54:20 +02:00
2022-11-10 14:31:11 +01:00
'With ListView1.Items.Add("0")
'For i As Integer = 0 To 10
2022-12-29 11:45:55 +01:00
ItemConstructor ( NameKomplett , NameP1 , NameP2 , Reso , HardSub , ThumbnialURL , URL_DL , Pfad_DL , Service )
2022-11-10 14:31:11 +01:00
'Next
'End With
2019-11-10 00:16:12 +01:00
End Sub
2021-12-19 13:38:19 +01:00
2022-12-29 11:45:55 +01: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 ThumbnialURL As String , 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
2022-11-10 14:31:11 +01:00
2020-08-16 23:27:48 +02:00
#Region "Set Variables"
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 )
2022-07-08 20:54:20 +02:00
Item . SetThumbnailImage ( ThumbnialURL )
2020-08-16 23:27:48 +02:00
Item . SetLabelPercent ( " 0% " )
2022-11-10 14:31:11 +01:00
Item . SetCache ( KeepCache )
Item . SetMergeSubstoMP4 ( MergeSubs )
Item . SetDebug2 ( Debug2 )
#End Region
Dim W As Integer = Panel1 . Width
If Panel1 . Controls . Count * 142 > Panel1 . Height Then
W = Panel1 . Width - SystemInformation . VerticalScrollBarWidth
End If
Item . SetBounds ( 0 , 142 * Panel1 . Controls . Count , W - 2 , 142 )
Item . Parent = Panel1
Panel1 . Controls . Add ( Item )
2020-08-16 23:27:48 +02:00
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
2022-01-22 11:56:37 +01:00
If Pfad_DL . Length > 255 Then
2022-01-22 11:57:44 +01:00
'MsgBox(Pfad_DL.Length.ToString)
2022-01-22 11:56:37 +01:00
Pfad_DL = Chr ( 34 ) + " \\?\ " + Pfad_DL . Replace ( Chr ( 34 ) , " " ) + Chr ( 34 )
End If
2021-09-20 20:37:57 +02:00
'MsgBox(URL_DL + vbNewLine + Pfad_DL + vbNewLine + NameKomplett + vbNewLine + TempHybridMode.ToString)
2022-03-19 12:01:12 +01:00
Item . StartDownload ( URL_DL , Pfad_DL , NameKomplett , TempHybridMode , TempFolder )
2019-11-10 00:16:12 +01:00
End Sub
2021-12-19 13:38:19 +01:00
2019-11-10 00:16:12 +01:00
#Region "Season DL"
2022-10-20 18:23:22 +02:00
2020-02-02 16:39:54 +01:00
2021-12-19 13:38:19 +01:00
#End Region
2023-09-10 16:28:23 +02:00
#Region "Convert Subs"
2022-12-29 11:45:55 +01:00
2023-09-10 16:28:23 +02:00
Public Function ConvertSubValue ( ByVal HardSub As String , ByVal Output As Integer ) As String
' 0 = DisplayText ; 1 = MP4CC/ISO-639-2 ; 2 = Both
2022-01-23 15:34:33 +01:00
2023-09-10 16:28:23 +02:00
HardSub = HardSub . Replace ( Chr ( 34 ) , " " ) 'clean up any mess just in case...
2022-12-29 11:45:55 +01:00
2023-01-21 11:21:39 +01:00
For i As Integer = 0 To LangValueEnum . Count - 1
If LangValueEnum ( i ) . CR_Value = HardSub Or LangValueEnum ( i ) . FM_Value = HardSub Then
2023-09-10 16:28:23 +02:00
If Output = 1 Then ' MP4CC/ISO-639-2 replacing the old ConvertSubValue version | 'Return ConvertSubValue(HardSub)
Return LangValueEnum ( i ) . MP4CC
ElseIf Output = 2 Then '; 2 = Both replacing the old GetSubFileLangName funktion
Dim RS As String = LangValueEnum ( i ) . DisplayText + " . " + LangValueEnum ( i ) . MP4CC
Return RS
Else
Return LangValueEnum ( i ) . DisplayText
End If
2019-11-10 00:16:12 +01:00
End If
2022-12-29 11:45:55 +01:00
Next
2024-01-06 14:35:22 +01:00
Return HardSub + " -not-found "
2022-12-29 11:45:55 +01:00
2019-11-10 00:16:12 +01:00
End Function
2022-12-29 11:45:55 +01:00
2019-11-10 00:16:12 +01:00
#End Region
2022-07-13 16:55:43 +02:00
2022-10-22 13:53:55 +02:00
2021-04-05 19:08:42 +02:00
#Region "CR-Beta"
Public Async Sub DownloadBetaSeasons ( )
Try
Dim ListOfEpisodes As New List ( Of String )
2022-10-20 18:23:22 +02:00
2023-01-21 11:21:39 +01:00
For i As Integer = 0 To CR_MassEpisodes . Count - 1
2022-10-20 18:23:22 +02:00
2022-10-29 14:48:05 +02:00
If Url_locale = " " Then
2023-01-21 11:21:39 +01:00
ListOfEpisodes . Add ( " https://www.crunchyroll.com/watch/ " + CR_MassEpisodes . Item ( i ) . guid + " / " + CR_MassEpisodes . Item ( i ) . audio_locale + " / " )
2022-10-29 14:48:05 +02:00
Else
2023-01-21 11:21:39 +01:00
ListOfEpisodes . Add ( " https://www.crunchyroll.com/ " + Url_locale + " / " + " watch/ " + CR_MassEpisodes . Item ( i ) . guid + " / " + CR_MassEpisodes . Item ( i ) . audio_locale + " / " )
2022-10-29 14:48:05 +02:00
End If
2021-04-05 19:08:42 +02:00
Next
Dim First As Integer = 0
Dim Last As Integer = 0
2024-01-06 14:35:22 +01:00
If Anime_Add . CB_EP1 . SelectedIndex > Anime_Add . CB_EP0 . SelectedIndex Or Anime_Add . CB_EP1 . SelectedIndex = Anime_Add . CB_EP0 . SelectedIndex Then
First = Anime_Add . CB_EP0 . SelectedIndex
Last = Anime_Add . CB_EP1 . SelectedIndex
ElseIf Anime_Add . CB_EP0 . SelectedIndex > Anime_Add . CB_EP1 . SelectedIndex Then
First = Anime_Add . CB_EP1 . SelectedIndex
Last = Anime_Add . CB_EP0 . SelectedIndex
2021-04-05 19:08:42 +02:00
End If
2024-01-06 14:35:22 +01:00
Dim Anzahl As Integer = Anime_Add . CB_EP1 . SelectedIndex - Anime_Add . CB_EP0 . SelectedIndex
2021-04-05 19:08:42 +02:00
For i As Integer = First To Last
For e As Integer = 0 To Integer . MaxValue
If Grapp_RDY = True Then
Try
2022-11-10 14:31:11 +01:00
Dim ItemFinshedCount As Integer = 0 '
Dim Item As New List ( Of CRD_List_Item )
Item . AddRange ( Panel1 . Controls . OfType ( Of CRD_List_Item ) )
2022-12-02 18:43:43 +01:00
Item . Reverse ( )
2022-11-10 14:31:11 +01:00
For i2 As Integer = 0 To Item . Count - 1
If Item ( i2 ) . GetIsStatusFinished ( ) = True Then
2021-04-05 19:08:42 +02:00
ItemFinshedCount = ItemFinshedCount + 1
End If
Next
2022-11-10 14:31:11 +01:00
RunningDownloads = Panel1 . Controls . Count - ItemFinshedCount
2021-04-05 19:08:42 +02:00
Catch ex As Exception
2022-11-10 14:31:11 +01:00
RunningDownloads = Panel1 . Controls . Count
2021-04-05 19:08:42 +02:00
End Try
2024-05-11 18:47:10 +02:00
If RunningDownloads < MaxDL Or My . Settings . HiddenQueue = True Then
2021-04-05 19:08:42 +02:00
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
2022-10-01 12:13:29 +02:00
Grapp_RDY = True
2021-04-05 19:08:42 +02:00
'MsgBox("dl_abourd")
End If
If UseQueue = True Then
2023-01-07 19:04:56 +01:00
'Anime_Add.ListBox1.Items.Add(ListOfEpisodes(i))
ListBoxList . Add ( ListOfEpisodes ( i ) )
2021-04-05 19:08:42 +02:00
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 )
2023-01-07 19:04:56 +01:00
LoadBrowser ( 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
2024-01-06 14:35:22 +01:00
Anime_Add . CB_EP1 . Items . Clear ( )
Anime_Add . CB_EP0 . Items . Clear ( )
2021-05-23 22:27:56 +02:00
Aktuell = 0 . ToString
Gesamt = 0 . ToString
Anime_Add . groupBox1 . Visible = True
Anime_Add . groupBox2 . 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 . 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
2021-09-20 20:37:57 +02:00
2023-01-21 11:21:39 +01:00
Public Sub GetBetaSeasons ( ByVal AnimeUrl As String , ByVal JsonUrl As String , ByVal Auth As String , Optional ByVal BrowserData As String = Nothing ) ', ByVal SeasonJson As String)
2024-01-06 14:35:22 +01:00
'switch UI
2021-04-05 19:08:42 +02:00
Anime_Add . groupBox2 . Visible = True
2022-07-08 20:54:20 +02:00
Anime_Add . bt_Cancel_mass . Enabled = True
Anime_Add . bt_Cancel_mass . Visible = True
2021-04-05 19:08:42 +02:00
Anime_Add . groupBox1 . Visible = False
2024-01-06 14:35:22 +01:00
'clear everything
Anime_Add . CB_Dub . Items . Clear ( )
Anime_Add . CB_Season . Items . Clear ( )
Anime_Add . CB_EP0 . Items . Clear ( )
Anime_Add . CB_EP1 . Items . Clear ( )
'also remove display text
Anime_Add . CB_Dub . Text = Nothing
Anime_Add . CB_Season . Text = Nothing
Anime_Add . CB_EP0 . Text = Nothing
Anime_Add . CB_EP1 . Text = Nothing
'disable everything for now
Anime_Add . CB_Dub . Enabled = False
Anime_Add . CB_Season . Enabled = False
Anime_Add . CB_EP0 . Enabled = False
Anime_Add . CB_EP1 . Enabled = False
2022-10-21 20:25:48 +02:00
Dim SeasonJson As String = Nothing
2023-01-21 11:21:39 +01:00
CR_MassSeasons . Clear ( )
2022-12-27 17:04:25 +01:00
If BrowserData = Nothing Then
2022-10-22 13:53:55 +02:00
2023-01-21 12:57:00 +01:00
Dim Loc_CR_Cookies = " -H " + Chr ( 34 ) + CR_Cookies . Replace ( Chr ( 34 ) , " " ) . Replace ( " -H " , " " ) + Chr ( 34 )
2023-04-09 09:31:16 +02:00
Try
SeasonJson = CurlAuthNew ( JsonUrl , Loc_CR_Cookies , Auth )
Catch ex As Exception
If CBool ( InStr ( ex . ToString , " Error - Getting " ) ) Then
MsgBox ( " Error invalid CR respone " )
Exit Sub
Else
MsgBox ( " Error processing data " )
Exit Sub
End If
End Try
2022-10-22 13:53:55 +02:00
2022-12-27 17:04:25 +01:00
Else
SeasonJson = BrowserData
Debug . WriteLine ( " BrowserData: " + BrowserData )
2022-10-22 13:53:55 +02:00
End If
2022-12-27 17:04:25 +01:00
2023-01-21 11:21:39 +01:00
2022-03-25 15:06:31 +01:00
SeasonJson = CleanJSON ( SeasonJson )
2024-01-28 12:09:00 +01:00
'Debug.WriteLine("SeasonJson: " + SeasonJson)
2023-01-21 11:21:39 +01:00
Dim SeasonJObject As JObject = JObject . Parse ( SeasonJson )
Dim SeasonData As List ( Of JToken ) = SeasonJObject . Children ( ) . ToList
2024-01-06 14:35:22 +01:00
Dim DubList As New List ( Of String )
2023-01-21 11:21:39 +01:00
For Each item As JProperty In SeasonData
item . CreateReader ( )
Select Case item . Name
Case " data " 'each record is inside the entries array
For Each Entry As JObject In item . Values
Dim SeasonSubData As List ( Of JToken ) = Entry . Children ( ) . ToList
Dim localSeasons As New List ( Of CR_Seasons )
Dim season_number As String = Nothing
2023-01-21 23:08:14 +01:00
Dim id As String = Nothing
2024-01-06 14:35:22 +01:00
Dim title As String = Nothing
2023-01-21 23:08:14 +01:00
Dim audio_localeMain As String = Nothing
2024-01-06 14:35:22 +01:00
Dim Dubs As New List ( Of CR_Seasons )
2023-01-21 23:08:14 +01:00
2023-01-21 11:21:39 +01:00
For Each SeasonSubItem As JProperty In SeasonSubData
SeasonSubItem . CreateReader ( )
2024-01-06 14:35:22 +01:00
2023-01-21 11:21:39 +01:00
Select Case SeasonSubItem . Name
Case " versions "
2023-01-21 23:08:14 +01:00
Try
For Each VersionItem As JObject In SeasonSubItem . Values
2024-01-06 14:35:22 +01:00
Dim guid As String = Nothing
Dim audio_locale As String = Nothing
2023-01-21 11:21:39 +01:00
2024-01-06 14:35:22 +01:00
guid = VersionItem . GetValue ( " guid " ) . ToString
audio_locale = VersionItem . GetValue ( " audio_locale " ) . ToString
Dubs . Add ( New CR_Seasons ( guid , audio_locale , Auth , " NaN " ) )
2023-01-21 11:21:39 +01:00
2023-01-21 23:08:14 +01:00
Next
Catch ex As Exception
Debug . WriteLine ( " Error getting season data " )
End Try
2023-01-21 11:21:39 +01:00
Case " season_number "
season_number = SeasonSubItem . Value . ToString
2023-01-21 23:08:14 +01:00
Case " id "
id = SeasonSubItem . Value . ToString
Case " audio_locale "
audio_localeMain = SeasonSubItem . Value . ToString
2024-01-06 14:35:22 +01:00
Case " title "
title = SeasonSubItem . Value . ToString
2023-01-21 11:21:39 +01:00
End Select
2024-01-06 14:35:22 +01:00
2023-01-21 11:21:39 +01:00
Next
2024-01-09 17:55:11 +01:00
'MsgBox(season_number + vbNewLine + id + vbNewLine + title + vbNewLine + audio_localeMain)
2024-01-06 14:35:22 +01:00
'add dubs to local seasons
For i As Integer = 0 To Dubs . Count - 1
localSeasons . Add ( New CR_Seasons ( Dubs . Item ( i ) . guid , Dubs . Item ( i ) . audio_locale , Dubs . Item ( i ) . Auth , season_number + " - " + title ) )
Next
2024-01-09 17:55:11 +01:00
'if version are null then add the main version
2023-01-21 23:08:14 +01:00
If localSeasons . Count = 0 Then
2024-01-09 17:55:11 +01:00
localSeasons . Add ( New CR_Seasons ( id , audio_localeMain , Auth , season_number + " - " + title ) )
2023-01-21 23:08:14 +01:00
End If
2024-01-09 17:55:11 +01:00
'add seasons to DubList
2023-01-21 23:08:14 +01:00
If localSeasons . Count > 0 Then
For i As Integer = 0 To localSeasons . Count - 1
2024-01-06 14:35:22 +01:00
'Anime_Add.CB_Season.Items.Add(ConvertSubValue(localSeasons.Item(i).audio_locale, ConvertSubsEnum.DisplayText) + " - Season " + season_number)
DubList . Add ( localSeasons . Item ( i ) . audio_locale )
2023-01-21 23:08:14 +01:00
CR_MassSeasons . Add ( localSeasons . Item ( i ) )
Next
End If
2023-01-21 11:21:39 +01:00
Next
End Select
2021-04-05 19:08:42 +02:00
Next
2023-01-21 11:21:39 +01:00
2024-01-06 14:35:22 +01:00
Dim CleanDubs As List ( Of String ) = DubList . Distinct ( ) . ToList
2024-01-09 17:55:11 +01:00
'MsgBox(CleanDubs.Count.ToString)
2024-01-06 14:35:22 +01:00
Anime_Add . CB_Dub . Enabled = True
Dim Index As Integer = 0
For i As Integer = 0 To CleanDubs . Count - 1
Anime_Add . CB_Dub . Items . Add ( ConvertSubValue ( CleanDubs . Item ( i ) , ConvertSubsEnum . DisplayText ) )
If CleanDubs . Item ( i ) = DubSprache . CR_Value Then
Index = i
End If
Next
Anime_Add . CB_Dub . SelectedIndex = Index
'Anime_Add.TT_Dub.SetToolTip(Anime_Add.CB_Dub, "Unable to select dub, dub override enabled!")
'Anime_Add.CB_Dub.Enabled = False
2021-04-05 19:08:42 +02:00
End Sub
2021-12-19 13:38:19 +01:00
2023-06-03 15:57:13 +02:00
Public Sub GetCRVideoProxy ( ByVal requesturl As String , ByVal AuthToken As String , ByVal WebsiteURL As String , ByVal RT_count As Integer )
2024-04-09 21:15:21 +02:00
Dim Evaluator = New Thread ( Sub ( ) Me . GetCRVideo ( requesturl , AuthToken , WebsiteURL , RT_count ) )
Evaluator . Start ( )
End Sub
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
Public Sub GetCRVideo ( ByVal Streams As String , ByVal AuthToken As String , ByVal WebsiteURL As String , ByVal RT_count As Integer )
2022-10-24 18:33:49 +02:00
If b = False Then
b = True
End If
2022-10-20 18:23:22 +02:00
2024-04-09 21:15:21 +02:00
Debug . WriteLine ( " Website: " + WebsiteURL )
2022-10-20 18:23:22 +02:00
2021-04-05 19:08:42 +02:00
Try
Grapp_RDY = False
2021-06-04 15:25:59 +02:00
Dim ffmpeg_command_temp As String = ffmpeg_command
2022-09-28 13:21:52 +02:00
Dim CR_MetadataUsage As Boolean = False
2022-06-24 16:11:21 +02:00
Dim CR_Streams As New List ( Of CR_Beta_Stream )
2021-04-05 19:08:42 +02:00
Dim CR_series_title As String = Nothing
Dim CR_season_number As String = Nothing
2023-01-05 14:26:40 +01:00
Dim CR_FolderSeason As String = Nothing
2021-04-05 19:08:42 +02:00
Dim CR_episode As String = Nothing
2022-09-28 13:21:52 +02:00
Dim CR_episode_duration_ms As String = " 60000000 "
2022-05-29 18:38:46 +02:00
Dim CR_episode2 As String = Nothing
2021-08-08 12:23:22 +02:00
Dim CR_Anime_Staffel_int As String = Nothing
2024-04-09 21:15:21 +02:00
Dim CR_episode_int As String = Nothing
2021-04-05 19:08:42 +02:00
Dim CR_title As String = Nothing
2024-04-09 21:15:21 +02:00
Dim CR_audio_locale As String = " ja-JP "
2023-01-01 16:34:18 +01:00
Dim CR_audio_isDubbed As Boolean = False
2022-12-02 18:43:43 +01:00
Dim ResoUsed As String = " x " + Reso . ToString
2023-01-01 16:34:18 +01:00
Dim ffmpegInput As String = " -i [Subtitles only] "
2024-04-09 21:15:21 +02:00
Dim CR_HardSubLang As String = SubSprache . CR_Value
2023-01-05 14:26:40 +01:00
2021-04-05 19:08:42 +02:00
Dim Pfad2 As String
Dim TextBox2_Text As String = Nothing
Dim CR_FilenName As String = Nothing
2022-10-21 20:25:48 +02:00
Dim ObjectJson As String = Nothing
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2021-12-19 13:38:19 +01:00
TextBox2_Text = Anime_Add . TextBox2 . Text
2021-04-05 19:08:42 +02:00
Return Nothing
End Function ) )
2022-10-20 18:23:22 +02:00
2023-03-05 12:59:54 +01:00
'
2022-12-18 20:28:02 +01:00
Dim Loc_CR_Cookies = " -H " + Chr ( 34 ) + CR_Cookies + Chr ( 34 )
Dim Loc_AuthToken = " -H " + Chr ( 34 ) + " Authorization: " + AuthToken + Chr ( 34 )
If CBool ( InStr ( AuthToken , " Authorization " ) ) = True Then
Loc_AuthToken = AuthToken
End If
2023-03-05 12:59:54 +01:00
Dim CR_EpisodeID As String = " "
2024-04-09 21:15:21 +02:00
2023-04-09 09:31:16 +02:00
#Region "No anime :("
2024-04-09 21:15:21 +02:00
Dim NewAPI_0 As String ( ) = WebsiteURL . Split ( New String ( ) { " watch/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim NewAPI_1 As String ( ) = NewAPI_0 ( 1 ) . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim page_guid As String = NewAPI_1 ( 0 )
2023-04-09 09:31:16 +02:00
2023-03-05 12:59:54 +01:00
If CBool ( InStr ( WebsiteURL , " musicvideo " ) ) = True Then
'TextBox2_Text to bypasss name for now
2024-04-09 21:15:21 +02:00
Dim page_guid_0 As String ( ) = WebsiteURL . Split ( New String ( ) { " watch/musicvideo/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim page_guid_1 As String ( ) = page_guid_0 ( 1 ) . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURL As String = " https://www.crunchyroll.com/content/v2/music/music_videos/ " + page_guid_1 ( 0 ) 'Streams.Replace("music/", "music/music_videos/").Replace("/streams", "")
page_guid = " music/ " + page_guid_1 ( 0 )
2022-10-21 20:25:48 +02:00
2023-04-09 09:31:16 +02:00
ObjectJson = CurlAuthNew ( ObjectsURL , Loc_CR_Cookies , Loc_AuthToken )
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
Dim Title ( ) As String = ObjectJson . Split ( New String ( ) { Chr ( 34 ) + " title " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Title2 ( ) As String = Title ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
Dim Arti ( ) As String = ObjectJson . Split ( New String ( ) { Chr ( 34 ) + " name " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Arti2 ( ) As String = Arti ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
2022-10-22 13:53:55 +02:00
2023-03-05 12:59:54 +01:00
TextBox2_Text = Arti2 ( 0 ) + " - " + Title2 ( 0 )
2022-10-20 18:23:22 +02:00
2023-03-05 14:24:20 +01:00
ElseIf CBool ( InStr ( WebsiteURL , " /concert/ " ) ) = True Then
2024-04-09 21:15:21 +02:00
Dim page_guid_0 As String ( ) = WebsiteURL . Split ( New String ( ) { " watch/concert/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim page_guid_1 As String ( ) = page_guid_0 ( 1 ) . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURL As String = " https://www.crunchyroll.com/content/v2/music/concerts/ " + page_guid_1 ( 0 ) 'Streams.Replace("music/", "music/music_videos/").Replace("/streams", "")
page_guid = " music/ " + page_guid_1 ( 0 )
2023-03-05 14:24:20 +01:00
2023-04-09 09:31:16 +02:00
ObjectJson = CurlAuthNew ( ObjectsURL , Loc_CR_Cookies , Loc_AuthToken )
2023-03-05 14:24:20 +01:00
Dim Title ( ) As String = ObjectJson . Split ( New String ( ) { Chr ( 34 ) + " title " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Title2 ( ) As String = Title ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Arti ( ) As String = ObjectJson . Split ( New String ( ) { Chr ( 34 ) + " name " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Arti2 ( ) As String = Arti ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
'MsgBox(Arti2(0))
'MsgBox(Title2(0))
2023-01-05 14:26:40 +01:00
2023-03-05 14:24:20 +01:00
TextBox2_Text = Arti2 ( 0 ) + " - " + Title2 ( 0 )
2023-04-09 09:31:16 +02:00
#End Region
2023-03-05 12:59:54 +01:00
2024-03-06 17:26:20 +01:00
Else ' Not needed for Music or concerts
2024-04-09 21:15:21 +02:00
Dim ObjectsURLBuilder ( ) As String = Streams . Split ( New String ( ) { " videos " } , System . StringSplitOptions . RemoveEmptyEntries )
2024-04-28 21:29:33 +02:00
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 )
2024-03-06 17:26:20 +01:00
2024-04-28 21:29:33 +02:00
CR_EpisodeID = ObjectsURLBuilder4 ( 0 )
2024-03-06 17:26:20 +01:00
2024-04-28 21:29:33 +02:00
'Debug.WriteLine(ObjectsURL)
2024-03-06 17:26:20 +01:00
2024-04-28 21:29:33 +02:00
ObjectJson = CurlAuthNew ( ObjectsURL , Loc_CR_Cookies , Loc_AuthToken )
2024-03-06 17:26:20 +01:00
2024-04-28 21:29:33 +02:00
ObjectJson = CleanJSON ( ObjectJson )
Dim DubsAvalible As New List ( Of CR_MediaVersion )
Dim ser As JObject = JObject . Parse ( ObjectJson )
Dim data As List ( Of JToken ) = ser . Children ( ) . ToList
For Each item As JProperty In data
item . CreateReader ( )
Select Case item . Name
Case " data " '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 ) . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " ) . Replace ( " : " , " " )
Debug . WriteLine ( Date . Now . ToString + " CR-Title: " + CR_title )
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 . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " ) . Replace ( " : " , " " )
2024-04-09 21:15:21 +02:00
'Case "season_title"
' CR_season_title = SubEntry.Value.ToString
2024-04-28 21:29:33 +02:00
Case " season_number "
CR_season_number = SubEntry . Value . ToString . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " ) . Replace ( " : " , " " )
Case " episode_number "
CR_episode2 = SubEntry . Value . ToString . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " ) . Replace ( " : " , " " )
Case " episode "
CR_episode = SubEntry . Value . ToString . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " ) . Replace ( " : " , " " )
Case " duration_ms "
CR_episode_duration_ms = SubEntry . Value . ToString . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " ) . Replace ( " : " , " " )
Case " is_dubbed "
CR_audio_isDubbed = CBool ( SubEntry . Value . ToString . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " ) . Replace ( " : " , " " ) )
Case " audio_locale "
CR_audio_locale = SubEntry . Value . ToString . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " ) . Replace ( " : " , " " )
Case " versions " 'each record is inside the entries array
For Each VersionEntry As JObject In item . Values
Dim VideoSubData As List ( Of JToken ) = VersionEntry . Children ( ) . ToList
Dim guid As String = Nothing
Dim audio_locale As String = Nothing
For Each VideoSubItem As JProperty In VideoSubData
Select Case VideoSubItem . Name
Case " audio_locale "
audio_locale = VideoSubItem . Value . ToString
Case " guid "
guid = VideoSubItem . Value . ToString
'Debug.WriteLine(guid)
End Select
Next
If audio_locale = Nothing Or guid = Nothing Then
Else
DubsAvalible . Add ( New CR_MediaVersion ( audio_locale , guid ) )
End If
2024-04-09 21:15:21 +02:00
Next
2024-04-28 21:29:33 +02:00
End Select
Next '
End Select
Next
2024-04-09 21:15:21 +02:00
Next
2024-04-28 21:29:33 +02:00
End Select
Next
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
#Region "m3u8 suche"
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
#Region "Check for dub override"
If My . Settings . OverrideDub = True And CR_audio_locale = DubSprache . CR_Value = False Then 'einstellung ein + kein musikvideo oder Konzert
2024-04-28 21:29:33 +02:00
'MsgBox("Trigger on!")
For i As Integer = 0 To DubsAvalible . Count - 1
If DubsAvalible ( i ) . AudioLang = DubSprache . CR_Value Then
page_guid = DubsAvalible ( i ) . guid
End If
Next
2024-03-06 17:26:20 +01:00
2024-04-28 21:29:33 +02:00
End If
2024-04-09 21:15:21 +02:00
#End Region
End If
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
Dim NewAPI As String = " https://cr-play-service.prd.crunchyrollsvc.com/v1/ " + page_guid + " /console/switch/play "
Debug . WriteLine ( " NewAPI: " + NewAPI )
2024-05-22 18:43:13 +02:00
'MsgBox(Loc_AuthToken)
2024-05-23 18:20:36 +02:00
'Dim UserAgent As String = " -H " + Chr(34) + "User-Agent: Crunchyroll/1.8.0 Nintendo Switch/12.3.12.0 UE4/4.27" + Chr(34)
Dim UserAgent As String = Chr ( 34 ) + " Crunchyroll/1.8.0 Nintendo Switch/12.3.12.0 UE4/4.27 " + Chr ( 34 )
Dim NewAPIData As String = CurlAuthNew ( NewAPI , " " , Loc_AuthToken , False , UserAgent )
2024-04-28 21:29:33 +02:00
'Debug.WriteLine("NewAPIData: " + NewAPIData)
2024-03-06 17:26:20 +01:00
2024-05-23 18:20:36 +02:00
If CBool ( InStr ( NewAPIData , " HTTP Status: 420 " ) ) Then '
Me . Invoke ( New Action ( Function ( ) As Object
SetStatusLabel ( " Stream limit reached - Bypassing " )
Return Nothing
End Function ) )
'page_guid NewAPIData
Dim OldToCancel_0 As String ( ) = NewAPIData . Split ( New String ( ) { Chr ( 34 ) + " token " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '
Dim OldToCancel_1 As String ( ) = OldToCancel_0 ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '
Dim OldToCancel As String = OldToCancel_1 ( 0 )
Dim OldPage_0 As String ( ) = NewAPIData . Split ( New String ( ) { Chr ( 34 ) + " contentId " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '
Dim OldPage_1 As String ( ) = OldPage_0 ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '
Dim OldPage As String = OldPage_1 ( 0 )
CurlDeleteNew ( " https://cr-play-service.prd.crunchyrollsvc.com/v1/token/ " + OldPage + " / " + OldToCancel , Loc_AuthToken )
Debug . WriteLine ( " Error 420 - delete old Token: " + OldToCancel + " for " + OldPage )
Pause ( 3 )
NewAPIData = CurlAuthNew ( NewAPI , " " , Loc_AuthToken , False , UserAgent )
End If
If CBool ( InStr ( NewAPIData , " HTTP Status: 420 " ) ) Then
Me . Invoke ( New Action ( Function ( ) As Object
SetStatusLabel ( " Bypassing failed " )
Return Nothing
End Function ) )
Throw New System . Exception ( " Error - Getting " + vbNewLine + " Error 420 " )
End If
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
Dim VideoJSON_New As String = CleanJSON ( NewAPIData )
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
Dim VideoJObjectNew As JObject = JObject . Parse ( VideoJSON_New )
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
Dim VideoJSON2New As String = " [ " & VideoJSON_New . Replace ( " }{ " , " },{ " ) & " ] "
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
Dim jsonArray As JArray = JArray . Parse ( VideoJSON2New )
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
For Each item As JObject In jsonArray
Dim hardSubs As JObject = CType ( item ( " hardSubs " ) , JObject )
For Each prop As JProperty In hardSubs . Properties ( )
Dim Sublang As String = prop . Value ( " hlang " ) . ToString
Dim vUrl As String = prop . Value ( " url " ) . ToString . Replace ( " manifest.mpd " , " master.m3u8 " )
CR_Streams . Add ( New CR_Beta_Stream ( Sublang , " fake_hls " , vUrl ) )
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
Next
Next
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
Dim VideoDataNew As List ( Of JToken ) = VideoJObjectNew . Children ( ) . ToList
For Each item As JProperty In VideoDataNew
item . CreateReader ( )
Select Case item . Name
Case " url "
Dim vUrl As String = item . Value . ToString . Replace ( " manifest.mpd " , " master.m3u8 " )
CR_Streams . Add ( New CR_Beta_Stream ( " null " , " fake_hls " , vUrl ) )
'MsgBox(Title)
2024-03-06 17:26:20 +01:00
End Select
Next
2024-04-28 21:29:33 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
SetStatusLabel ( " Status: API data received " )
Return Nothing
End Function ) )
2024-04-09 21:15:21 +02:00
2024-03-06 17:26:20 +01:00
Dim CR_URI_Master As New List ( Of String )
2024-04-09 21:15:21 +02:00
' Dim CR_URI_Master2 As New List(Of CR_Beta_Stream)
2024-03-06 17:26:20 +01:00
Dim RawStream As New List ( Of String )
For c As Integer = 0 To CR_Streams . Count - 1
Dim i As Integer = c
2024-04-09 21:15:21 +02:00
Debug . WriteLine ( c . ToString + " Streams-1988: " + CR_Streams . Item ( i ) . subLang + " " + CR_Streams . Item ( i ) . Format + " " + CR_Streams . Item ( i ) . Url )
2024-03-06 17:26:20 +01:00
If CR_Streams . Item ( i ) . subLang = CR_HardSubLang Then
CR_URI_Master . Add ( CR_Streams . Item ( i ) . Url )
2024-04-09 21:15:21 +02:00
ElseIf CR_Streams . Item ( i ) . subLang = " " And CR_audio_locale IsNot " ja-JP " And DubMode = True Then 'nothing/raw ohne subs
RawStream . Add ( CR_Streams . Item ( i ) . Url )
ElseIf CR_Streams . Item ( i ) . subLang = " null " And CR_audio_locale IsNot " ja-JP " And DubMode = True Then 'nothing/raw mit 'null' tagged
2024-03-06 17:26:20 +01:00
RawStream . Add ( CR_Streams . Item ( i ) . Url )
End If
2024-04-09 21:15:21 +02:00
Next
'MsgBox(CR_URI_Master.Count.ToString)
2024-03-06 17:26:20 +01:00
If CR_URI_Master . Count = 0 And RawStream . Count > 0 Then
CR_URI_Master . Clear ( )
CR_URI_Master . AddRange ( RawStream )
ElseIf CR_URI_Master . Count = 0 Then
2024-05-04 13:24:54 +02:00
Dim ListOfStreams As String = " "
For i As Integer = 0 To CR_Streams . Count - 1 'fill back the streams to a string to use it for the error handling
ListOfStreams = ListOfStreams + CR_Streams ( i ) . subLang + " ; "
Next
2024-03-06 17:26:20 +01:00
Me . Invoke ( New Action ( Function ( ) As Object
2024-05-04 13:24:54 +02:00
ResoNotFoundString = ListOfStreams
2024-03-06 17:26:20 +01:00
DialogTaskString = " Language_CR_Beta "
ErrorDialog . ShowDialog ( )
Return Nothing
End Function ) )
2024-05-04 13:24:54 +02:00
2024-03-06 17:26:20 +01:00
If UserCloseDialog = True Then
Throw New System . Exception ( Chr ( 34 ) + " UserAbort " + Chr ( 34 ) )
Else
'MsgBox(CR_HardSubLang)
CR_HardSubLang = ResoBackString
ResoBackString = Nothing
'MsgBox(CR_Streams.Count.ToString)
For i As Integer = 0 To CR_Streams . Count - 1
2024-04-09 21:15:21 +02:00
Debug . WriteLine ( " 1280: " + CR_Streams . Item ( i ) . subLang )
If CR_Streams . Item ( i ) . subLang = CR_HardSubLang Then 'check for all hardsubs even 'null'
CR_URI_Master . Add ( CR_Streams . Item ( i ) . Url )
ElseIf CR_Streams . Item ( i ) . subLang = " " And CR_HardSubLang = " null " Then 'keeping in mind 'null' and a empty string would be CRs style ...
2024-03-06 17:26:20 +01:00
CR_URI_Master . Add ( CR_Streams . Item ( i ) . Url )
End If
Next
End If
End If
2024-04-28 21:29:33 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
SetStatusLabel ( " Status: Language found " )
Return Nothing
End Function ) )
2024-03-06 17:26:20 +01:00
#End Region
#Region "Name"
2024-04-09 21:15:21 +02:00
#Region "Name von Crunchyroll"
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
Dim MergeSearch As String = " if not changed no Merch possible, i hope... "
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
If CR_episode = Nothing Or CR_episode = " " And CR_episode2 = Nothing Then
CR_episode_int = " 0 "
ElseIf CR_episode IsNot Nothing And CR_episode IsNot " " Then
CR_episode_int = CR_episode
ElseIf CR_episode2 IsNot Nothing Then
CR_episode_int = CR_episode2
2024-03-06 17:26:20 +01:00
End If
2024-04-09 21:15:21 +02:00
CR_Anime_Staffel_int = CR_season_number
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
If TextBox2_Text = Nothing Or TextBox2_Text = " Use Custom Name " Or CBool ( InStr ( TextBox2_Text , " ++ " ) ) = True Then
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
If IgnoreSeason = 1 And CR_season_number = " 1 " Or IgnoreSeason = 1 And CR_season_number = " 0 " Then
CR_season_number = Nothing
ElseIf IgnoreSeason = 2 Then
CR_season_number = Nothing
End If
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
If Season_Prefix = " [default season prefix] " Then
If CR_episode = Nothing And CR_episode2 = 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
2024-03-06 17:26:20 +01:00
Else
2024-04-09 21:15:21 +02:00
If CR_episode = Nothing And CR_episode2 = 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
2024-03-06 17:26:20 +01:00
End If
2024-04-09 21:15:21 +02:00
CR_FolderSeason = CR_season_number
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
If Episode_Prefix = " [default episode prefix] " Then
If CR_episode = Nothing Or CR_episode = " " And CR_episode2 = Nothing Then
CR_episode = CR_title
ElseIf CR_episode IsNot Nothing And CR_episode IsNot " " Then
CR_episode = " Episode " + AddLeadingZeros ( CR_episode )
ElseIf CR_episode2 IsNot Nothing Then
CR_episode = " Episode " + AddLeadingZeros ( CR_episode2 )
End If
'CR_episode = "Episode " + AddLeadingZeros(CR_episode)
Else
CR_episode = Episode_Prefix + AddLeadingZeros ( CR_episode )
End If
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
Dim NameParts As String ( ) = NameBuilder . Split ( New String ( ) { " ; " } , System . StringSplitOptions . RemoveEmptyEntries )
2024-03-06 17:26:20 +01:00
2024-04-09 21:15:21 +02:00
For i As Integer = 0 To NameParts . Count - 1
2023-01-05 14:26:40 +01:00
If NameParts ( i ) = " AnimeTitle " Then
CR_FilenName = CR_FilenName + " " + CR_series_title
2023-04-09 09:31:16 +02:00
MergeSearch = MergeSearch + " " + CR_series_title
2023-01-05 14:26:40 +01:00
ElseIf NameParts ( i ) = " Season " Then
CR_FilenName = CR_FilenName + " " + CR_season_number
2023-04-09 09:31:16 +02:00
MergeSearch = MergeSearch + " " + CR_season_number
2023-01-05 14:26:40 +01:00
ElseIf NameParts ( i ) = " EpisodeNR " Then
CR_FilenName = CR_FilenName + " " + CR_episode
2023-04-09 09:31:16 +02:00
MergeSearch = MergeSearch + " " + CR_episode
2023-01-05 14:26:40 +01:00
ElseIf NameParts ( i ) = " EpisodeName " Then
CR_FilenName = CR_FilenName + " " + CR_title
ElseIf NameParts ( i ) = " AnimeDub " Then
2023-09-10 16:28:23 +02:00
CR_FilenName = CR_FilenName + " " + ConvertSubValue ( CR_audio_locale , ConvertSubsEnum . DisplayText )
2023-01-05 14:26:40 +01:00
ElseIf NameParts ( i ) = " AnimeSub " Then
' CR_FilenName = CR_FilenName + " RepSub" 'to be done
End If
Next
If CBool ( InStr ( TextBox2_Text , " ++ " ) ) = True Then
Dim Backup_CR_FilenName As String = CR_FilenName
Try
Dim AddDef As String = " CRD "
Dim TestString As String = AddDef + TextBox2_Text + AddDef
Dim PrePost As String ( ) = TestString . Split ( New String ( ) { " ++ " } , System . StringSplitOptions . RemoveEmptyEntries )
CR_FilenName = PrePost ( 0 ) + CR_FilenName + PrePost ( 1 )
CR_FilenName = CR_FilenName . Replace ( AddDef , " " )
Catch ex As Exception
CR_FilenName = Backup_CR_FilenName
End Try
End If
#End Region
Else
2023-01-07 19:04:56 +01:00
CR_FilenName = RemoveExtraSpaces ( String . Join ( " " , TextBox2_Text . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) ) . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " ) 'System.Text.RegularExpressions.Regex.Replace(TextBox2_Text, "[^\w\\-]", " "))
2023-01-05 14:26:40 +01:00
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
KodiString = KodiString + CR_Anime_Staffel_int + " E " + AddLeadingZeros ( CR_episode_int ) ' CR_episode_nr
KodiString = KodiString + " ] "
CR_FilenName = KodiString + CR_FilenName
End If
Debug . WriteLine ( CR_FilenName )
CR_FilenName = String . Join ( " " , CR_FilenName . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " ) '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_FolderSeason , 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
2023-02-21 14:17:59 +01:00
#Region "Chapters"
2023-03-05 12:59:54 +01:00
Dim Mdata_File As String = Application . StartupPath + " \ " + CR_EpisodeID + " -mdata.txt "
2023-12-15 16:53:07 +01:00
Debug . WriteLine ( " Checking chapters " )
2023-03-05 12:59:54 +01:00
If CR_EpisodeID = " " Then
'ignore for music video
Else
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
If CR_Chapters = True Then
Dim ChaptersJson As String = Nothing
2023-06-03 15:57:13 +02:00
Dim ChaptersUrl As String = " https://static.crunchyroll.com/datalab-intro-v2/ " + CR_EpisodeID + " .json "
Try
ChaptersJson = Curl ( ChaptersUrl )
2023-03-05 12:59:54 +01:00
2023-06-03 15:57:13 +02:00
If CBool ( InStr ( ChaptersJson , " curl: " ) ) = True Then
ChaptersJson = Curl ( ChaptersUrl )
End If
2023-02-21 14:17:59 +01:00
2023-06-03 15:57:13 +02:00
If CBool ( InStr ( ChaptersJson , " curl: " ) ) = True Then
ChaptersJson = Nothing
Debug . WriteLine ( " no Chapter data... ignoring " )
End If
Catch ex As Exception
2023-02-21 14:17:59 +01:00
2023-06-03 15:57:13 +02:00
End Try
2023-02-21 14:17:59 +01:00
2023-05-04 18:48:37 +02:00
If ChaptersJson IsNot Nothing Then
'MsgBox(ChaptersJson)
2023-03-05 12:59:54 +01:00
Dim StartTime As String ( ) = ChaptersJson . Split ( New String ( ) { Chr ( 34 ) + " startTime " + Chr ( 34 ) + " : " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StartTime2 As String ( ) = StartTime ( 1 ) . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StartTime3 As String ( ) = StartTime2 ( 0 ) . Split ( New String ( ) { " . " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StartTime4 As String = StartTime3 ( 1 )
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
For i As Integer = StartTime4 . Length To 2
StartTime4 = StartTime4 + " 0 "
Next
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
Dim StartTime_ms As String = StartTime3 ( 0 ) + StartTime4
2023-05-04 18:48:37 +02:00
'
Dim StartTime_int As Integer = CInt ( StartTime_ms )
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
Dim EndTime As String ( ) = ChaptersJson . Split ( New String ( ) { Chr ( 34 ) + " endTime " + Chr ( 34 ) + " : " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim EndTime2 As String ( ) = EndTime ( 1 ) . Split ( New String ( ) { " , " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim EndTime3 As String ( ) = EndTime2 ( 0 ) . Split ( New String ( ) { " . " } , System . StringSplitOptions . RemoveEmptyEntries )
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
Dim EndTime4 As String = EndTime3 ( 1 )
Dim AfterTime As String = Nothing
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
For i As Integer = EndTime4 . Length To 2
If EndTime4 . Length = 2 Then
AfterTime = EndTime4 + " 1 "
End If
EndTime4 = EndTime4 + " 0 "
Next
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
Dim EndTime_ms As String = EndTime3 ( 0 ) + EndTime4
Dim AfterTime_ms As String = EndTime3 ( 0 ) + AfterTime
Dim Metadata As String = Nothing
2023-02-21 14:17:59 +01:00
2023-05-04 18:48:37 +02:00
2023-03-05 12:59:54 +01:00
If CInt ( CR_episode_duration_ms ) < CInt ( StartTime_ms ) Then
'Totaly invalid...
2023-05-04 18:48:37 +02:00
ElseIf CInt ( CR_episode_duration_ms ) < CInt ( EndTime_ms ) And StartTime_int = 0 Then
'the answer is 42...
Debug . WriteLine ( " Skip Chapters, the answer is 42... " )
'this is pointless
2023-03-05 12:59:54 +01:00
ElseIf CInt ( CR_episode_duration_ms ) < CInt ( EndTime_ms ) Then
'it's not an Intro it's an outro
2023-05-04 18:48:37 +02:00
Dim DeCh As Integer = StartTime_int - 1
Metadata = My . Resources . ffmpeg_metadata_out . Replace ( " [Start-1] " , DeCh . ToString ) . Replace ( " [Start] " , StartTime_ms ) . Replace ( " [duration_ms] " , CR_episode_duration_ms )
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
Else
2023-05-04 18:48:37 +02:00
Metadata = My . Resources . ffmpeg_metadata . Replace ( " [Start] " , StartTime_ms ) . Replace ( " [END] " , EndTime_ms ) . Replace ( " [after] " , AfterTime_ms ) . Replace ( " [duration_ms] " , CR_episode_duration_ms )
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
End If
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
If Metadata = Nothing Then
Else
Dim utf8WithoutBom2 As New System . Text . UTF8Encoding ( False )
Using sink As New StreamWriter ( Mdata_File , False , utf8WithoutBom2 )
sink . WriteLine ( Metadata )
CR_MetadataUsage = True
End Using
End If
2023-02-21 14:17:59 +01:00
2023-03-05 12:59:54 +01:00
End If
2023-02-21 14:17:59 +01:00
End If
End If
2023-12-15 16:53:07 +01:00
Debug . WriteLine ( " Checking chapters ended " )
2023-02-21 14:17:59 +01:00
#End Region
2023-01-05 14:26:40 +01:00
#Region "lösche doppel download"
2023-01-21 11:21:39 +01:00
'MsgBox(Pfad2)
2023-01-05 14:26:40 +01:00
Dim Pfad5 As String = Pfad2 . Replace ( Chr ( 34 ) , " " )
2023-02-21 14:17:59 +01:00
Dim Pfad6 As String = Pfad5
Dim MergeAudio As Boolean = False
2023-04-09 09:31:16 +02:00
If DownloadScope = DownloadScopeEnum . MergeAudio Then
Pfad5 = FindExistingVideo ( Path . GetDirectoryName ( Pfad5 ) , MergeSearch , Pfad5 )
End If
'
2023-02-21 14:17:59 +01:00
If My . Computer . FileSystem . FileExists ( Pfad5 ) And DownloadScope = DownloadScopeEnum . OldDefault Then 'Pfad = Kompeltter Pfad mit Dateinamen + ENdung
2023-01-05 14:26:40 +01:00
Me . Invoke ( New Action ( Function ( ) As Object
2023-02-21 14:17:59 +01:00
Anime_Add . StatusLabel . Text = " Status: The file already exists. "
Me . Text = " Status: The file already exists. "
2023-01-05 14:26:40 +01:00
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
2023-02-21 14:17:59 +01:00
ElseIf My . Computer . FileSystem . FileExists ( Pfad5 ) And DownloadScope = DownloadScopeEnum . MergeAudio Then
Pfad6 = Path . GetDirectoryName ( Pfad5 ) + " \ " + GeräteID ( ) + Path . GetExtension ( Pfad5 ) '+ "."
FileSystem . Rename ( Pfad5 , Pfad6 )
MergeAudio = True
2023-04-09 09:31:16 +02:00
2023-02-21 14:17:59 +01:00
ElseIf My . Computer . FileSystem . FileExists ( Path . GetDirectoryName ( Pfad5 ) + " \ " + Path . GetFileNameWithoutExtension ( Pfad5 ) + " aac " ) And DownloadScope = DownloadScopeEnum . AudioOnly Then
Me . Invoke ( New Action ( Function ( ) As Object
Anime_Add . StatusLabel . Text = " Status: The file already exists. "
Me . Text = " Status: The file already exists. "
Me . Invalidate ( )
Return Nothing
End Function ) )
If MessageBox . Show ( " The file " + Path . GetDirectoryName ( Pfad5 ) + " \ " + Path . GetFileNameWithoutExtension ( Pfad5 ) + " aac " + " already exists. " + vbNewLine + " You want to override it? " , " File exists! " , MessageBoxButtons . OKCancel ) = DialogResult . OK Then
Try
My . Computer . FileSystem . DeleteFile ( Path . GetDirectoryName ( Pfad5 ) + " \ " + Path . GetFileNameWithoutExtension ( Pfad5 ) + " aac " )
Catch ex As Exception
End Try
Else
Grapp_RDY = True
Exit Sub
End If
ElseIf DownloadScope = DownloadScopeEnum . AudioOnly Then
'replace format with aac
Pfad2 = Pfad2 . Replace ( VideoFormat , " .aac " )
'replace command for aac
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 )
2023-01-05 14:26:40 +01:00
End If
#End Region
2023-01-01 16:34:18 +01:00
#Region "GetResolution"
2024-04-04 19:52:43 +02:00
If DownloadScope = DownloadScopeEnum . SubsOnly Then
2023-01-05 14:26:40 +01:00
ffmpegInput = " -i [Subtitles only] "
2024-04-28 21:29:33 +02:00
2023-01-01 16:34:18 +01:00
Else
2024-05-23 18:20:36 +02:00
Dim str0 As String = CurlAuthNew ( CR_URI_Master ( 0 ) , " " , Loc_AuthToken )
Dim str1 ( ) As String = str0 . Split ( New String ( ) { " " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim str As String = str1 ( 0 )
2024-03-15 18:04:55 +01:00
2023-06-03 15:57:13 +02:00
If CBool ( InStr ( str , " curl: " ) ) = True Or str = Nothing Then
2023-01-13 14:05:30 +01:00
2023-03-05 12:59:54 +01:00
Debug . WriteLine ( " Checked " + CR_URI_Master . Count . ToString )
2023-01-13 14:05:30 +01:00
MsgBox ( " Unable to get master.m3u8 " + vbNewLine + str , MsgBoxStyle . Critical )
2023-03-05 12:59:54 +01:00
Grapp_RDY = True
Exit Sub
2024-01-01 17:27:14 +01:00
ElseIf ( DownloadScope = DownloadScopeEnum . AudioOnly Or MergeAudio = True ) AndAlso CBool ( InStr ( str , My . Settings . AudioOnlyReso ) ) = True Then
ResoUsed = My . Settings . AudioOnlyReso . Replace ( " , " , " " )
2023-01-13 14:05:30 +01:00
ElseIf CBool ( InStr ( str , " x " + Reso . ToString + " , " ) ) Then
2023-01-01 16:34:18 +01:00
ResoUsed = " x " + Reso . ToString
2021-09-20 20:37:57 +02:00
Else
2023-01-01 16:34:18 +01:00
If CBool ( InStr ( str , ResoSave + " , " ) ) Then
2023-01-21 11:21:39 +01:00
ResoUsed = ResoSave
Else
Me . Invoke ( New Action ( Function ( ) As Object
DialogTaskString = " Resolution "
ResoNotFoundString = str
ErrorDialog . ShowDialog ( )
Return Nothing
End Function ) )
If UserCloseDialog = True Then
Throw New System . Exception ( Chr ( 34 ) + " UserAbort " + Chr ( 34 ) )
2023-01-01 16:34:18 +01:00
Else
2023-01-21 11:21:39 +01:00
ResoUsed = ResoBackString
ResoSave = ResoBackString
2023-01-01 16:34:18 +01:00
End If
End If
2023-01-21 11:21:39 +01:00
End If
2023-02-21 14:17:59 +01:00
2023-08-30 18:40:53 +02:00
'MsgBox(ResoUsed)
2023-01-21 11:21:39 +01:00
Dim ffmpeg_url_3 As String = Nothing
Dim LineChar As String = vbLf
If CBool ( InStr ( str , vbCrLf ) ) Then
LineChar = vbCrLf
ElseIf CBool ( InStr ( str , vbCr ) ) Then
LineChar = vbCr
End If
2023-08-30 18:40:53 +02:00
'MsgBox(str)
2023-01-21 11:21:39 +01:00
Dim ffmpeg_url_1 As String ( ) = str . Split ( New String ( ) { LineChar } , System . StringSplitOptions . RemoveEmptyEntries )
2023-01-01 16:34:18 +01:00
2023-01-21 11:21:39 +01:00
For i As Integer = 0 To ffmpeg_url_1 . Count - 2 'Step 2
If CBool ( InStr ( ffmpeg_url_1 ( i ) , ResoUsed + " , " ) ) Then
ffmpeg_url_3 = ffmpeg_url_1 ( i + 1 )
End If
Next
2023-01-01 16:34:18 +01:00
2023-08-30 18:40:53 +02:00
'MsgBox(ffmpeg_url_3.Trim())
2024-04-04 19:52:43 +02:00
Dim localm3u8 As String = CurlAuthNew ( ffmpeg_url_3 . Trim ( ) , " " , Loc_AuthToken )
2024-05-23 18:20:36 +02:00
2024-04-04 19:52:43 +02:00
Dim localfile As String = Application . StartupPath + " \ " + GeräteID2 ( ) + " .m3u8 "
Dim utf8WithoutBom As New System . Text . UTF8Encoding ( False )
Using sink As New StreamWriter ( localfile , False , utf8WithoutBom )
sink . WriteLine ( localm3u8 )
End Using
2024-05-07 21:24:41 +02:00
ffmpegInput = " -protocol_whitelist file,http,https,tcp,tls,crypto,data -allowed_extensions ALL " + " -i " + Chr ( 34 ) + localfile + Chr ( 34 ) 'add whitelist to the stream input directly #950
2023-01-13 14:05:30 +01:00
2023-01-21 11:21:39 +01:00
End If
2023-01-01 16:34:18 +01:00
2024-04-28 21:29:33 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
SetStatusLabel ( " Status: Resolution found " )
Pause ( 2 )
Return Nothing
End Function ) )
2023-01-01 16:34:18 +01:00
2021-09-20 20:37:57 +02:00
#End Region
2022-10-22 13:53:55 +02:00
2024-05-23 18:20:36 +02:00
#Region "Cancel Token"
'page_guid NewAPIData
Dim ToCancel_0 As String ( ) = NewAPIData . Split ( New String ( ) { Chr ( 34 ) + " token " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '
Dim ToCancel_1 As String ( ) = ToCancel_0 ( 1 ) . Split ( New String ( ) { Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '
Dim ToCancel As String = ToCancel_1 ( 0 )
CurlDeleteNew ( " https://cr-play-service.prd.crunchyrollsvc.com/v1/token/ " + page_guid + " / " + ToCancel , Loc_AuthToken )
Debug . WriteLine ( " Delete Token: " + ToCancel + " for " + page_guid + " - " + CR_FilenName )
#End Region
2023-01-01 16:34:18 +01:00
#Region "GetSoftsubs"
2024-05-23 18:20:36 +02:00
Dim SoftSubsAvailable As New List ( Of String )
2024-04-09 21:15:21 +02:00
'Dim CCAvailable As New List(Of String)
2022-10-22 13:53:55 +02:00
2023-01-01 16:34:18 +01:00
Dim SoftSubsList As New List ( Of CR_Subtiles )
2022-10-22 13:53:55 +02:00
2023-03-21 16:48:10 +01:00
2024-04-09 21:15:21 +02:00
'Dim SplitVideo As String() = VideoJson.Split(New String() {Chr(34) + "closed_captions" + Chr(34) + ":"}, System.StringSplitOptions.RemoveEmptyEntries)
2023-03-21 16:48:10 +01:00
2024-04-09 21:15:21 +02:00
'If SoftSubs.Count > 0 And My.Settings.Captions = True Then
' For i As Integer = 0 To SoftSubs.Count - 1
' If CBool(InStr(SplitVideo(1), Chr(34) + "locale" + Chr(34) + ":" + Chr(34) + SoftSubs(i) + Chr(34) + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34))) Then
' CCAvailable.Add(SoftSubs(i))
' End If
' Next
'End If
'"language":"de-DE"
If SoftSubs . Count > 0 Then 'And CCAvailable.Count = 0 Then
2024-04-28 21:29:33 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
SetStatusLabel ( " Status: Checking Soft-Subs " )
Return Nothing
End Function ) )
2023-01-01 16:34:18 +01:00
For i As Integer = 0 To SoftSubs . Count - 1
2024-04-09 21:15:21 +02:00
If CBool ( InStr ( VideoJSON_New , Chr ( 34 ) + " language " + Chr ( 34 ) + " : " + Chr ( 34 ) + SoftSubs ( i ) + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) ) ) Then
2023-01-01 16:34:18 +01:00
SoftSubsAvailable . Add ( SoftSubs ( i ) )
2021-09-20 20:37:57 +02:00
End If
2023-01-01 16:34:18 +01:00
Next
2024-04-09 21:15:21 +02:00
'ElseIf SoftSubs.Count > 0 And CCAvailable.Count > 0 Then
' SoftSubsAvailable.AddRange(CCAvailable)
2023-01-01 16:34:18 +01:00
End If
2022-10-27 17:23:57 +02:00
2023-02-21 14:17:59 +01:00
If DownloadScope = DownloadScopeEnum . AudioOnly Then
2023-02-22 14:50:53 +01:00
If CR_MetadataUsage = False Then
2023-09-10 16:28:23 +02:00
ffmpegInput = ffmpegInput + " -metadata:s:a:0 language= " + ConvertSubValue ( CR_audio_locale , ConvertSubsEnum . MP4CC_ISO_639_2 ) + " " + ffmpeg_command_temp
2023-02-22 14:50:53 +01:00
Else
2023-09-10 16:28:23 +02:00
ffmpegInput = ffmpegInput + " -i " + Chr ( 34 ) + Mdata_File + Chr ( 34 ) + " -map_metadata 1 " + " -metadata:s:a:0 language= " + ConvertSubValue ( CR_audio_locale , ConvertSubsEnum . MP4CC_ISO_639_2 ) + " " + ffmpeg_command_temp
2023-02-22 14:50:53 +01:00
End If
2023-02-21 14:17:59 +01:00
ElseIf MergeAudio = True Then
2023-09-10 16:28:23 +02:00
ffmpegInput = " -i " + Chr ( 34 ) + Pfad6 + Chr ( 34 ) + " " + ffmpegInput + " -map 0 -map 1:a " + " -metadata:s:a: " + FFMPEG_Audio ( Pfad6 ) . ToString + " language= " + ConvertSubValue ( CR_audio_locale , ConvertSubsEnum . MP4CC_ISO_639_2 ) + " -c copy "
2023-02-22 14:50:53 +01:00
2023-02-21 14:17:59 +01:00
2024-04-09 21:15:21 +02:00
ElseIf SoftSubsAvailable . Count > 0 Then 'Or CCAvailable.Count > 0 Then
2023-02-21 14:17:59 +01:00
Dim MergeSubsNow As Boolean = MergeSubs
If DownloadScope = DownloadScopeEnum . SubsOnly Then
MergeSubsNow = False
End If
2022-10-27 17:23:57 +02:00
2023-01-01 16:34:18 +01:00
Debug . WriteLine ( " Softsubs Default: " + DefaultSubCR )
For i As Integer = 0 To SoftSubsAvailable . Count - 1
2024-04-09 21:15:21 +02:00
Dim SubsJson As String = VideoJSON_New
'If CCAvailable.Count > 0 Then
' SubsJson = SplitVideo(1)
'End If
2023-03-21 16:48:10 +01:00
2024-04-09 21:15:21 +02:00
Dim SoftSub As String ( ) = SubsJson . Split ( New String ( ) { Chr ( 34 ) + " language " + Chr ( 34 ) + " : " + Chr ( 34 ) + SoftSubsAvailable ( i ) + Chr ( 34 ) + " , " + Chr ( 34 ) + " url " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
2023-01-01 16:34:18 +01:00
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 " , " & " )
2023-09-10 16:28:23 +02:00
SoftSubsList . Add ( New CR_Subtiles ( SoftSubsAvailable ( i ) , ConvertSubValue ( SoftSubsAvailable ( i ) , ConvertSubsEnum . DisplayText ) , " -i " + Chr ( 34 ) + SoftSub_3 + Chr ( 34 ) , i . ToString , SoftSubsAvailable ( i ) = DefaultSubCR ) )
2023-01-01 16:34:18 +01:00
Next
2023-02-21 14:17:59 +01:00
If MergeSubsNow = True Then
2023-01-01 16:34:18 +01:00
Dim DispositionIndex As Integer = 69
Dim SoftSubMergeURLs As String = " "
Dim SoftSubMergeMaps As String = " -map 0:v -map 0:a "
Dim SoftSubMergeMetatata As String = " "
Dim IndexMoveMap As Integer = 1
If CR_MetadataUsage = True Then
IndexMoveMap = 2
2022-10-27 17:23:57 +02:00
End If
2023-01-01 16:34:18 +01:00
For i As Integer = 0 To SoftSubsList . Count - 1
SoftSubMergeURLs = SoftSubMergeURLs + " " + SoftSubsList ( i ) . Url
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + ( i + IndexMoveMap ) . ToString
2023-09-10 16:28:23 +02:00
SoftSubMergeMetatata = SoftSubMergeMetatata + " -metadata:s:s: " + i . ToString + " language= " + ConvertSubValue ( SoftSubsList ( i ) . SubLangValue , ConvertSubsEnum . MP4CC_ISO_639_2 ) + " -metadata:s:s: " + i . ToString + " title= " + Chr ( 34 ) + SoftSubsList ( i ) . SubLangName + Chr ( 34 ) + " -metadata:s:s: " + i . ToString + " handler_name= " + Chr ( 34 ) + SoftSubsList ( i ) . SubLangName + Chr ( 34 )
2023-01-01 16:34:18 +01:00
If SoftSubsList ( i ) . DefaultSub = True Then
DispositionIndex = i
2021-09-20 20:37:57 +02:00
End If
2023-01-01 16:34:18 +01:00
Next
Debug . WriteLine ( " -disposition:s: " + DispositionIndex . ToString )
If DispositionIndex < 69 Then
SoftSubMergeMetatata = SoftSubMergeMetatata + " -disposition:s: " + DispositionIndex . ToString + " default "
2021-09-20 20:37:57 +02:00
End If
2023-01-01 16:34:18 +01:00
If CR_MetadataUsage = False Then
2023-09-10 16:28:23 +02:00
ffmpegInput = ffmpegInput + " " + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command_temp + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language= " + ConvertSubValue ( CR_audio_locale , ConvertSubsEnum . MP4CC_ISO_639_2 )
2023-01-01 16:34:18 +01:00
Else
2023-09-10 16:28:23 +02:00
ffmpegInput = ffmpegInput + " -i " + Chr ( 34 ) + Mdata_File + Chr ( 34 ) + SoftSubMergeURLs + SoftSubMergeMaps + " -map_metadata 1 " + ffmpeg_command_temp + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language= " + ConvertSubValue ( CR_audio_locale , ConvertSubsEnum . MP4CC_ISO_639_2 )
2023-01-01 16:34:18 +01:00
2022-12-02 18:43:43 +01:00
End If
2023-02-21 14:17:59 +01:00
2023-01-01 16:34:18 +01:00
Else
For i As Integer = 0 To SoftSubsList . Count - 1
2023-03-21 16:48:10 +01:00
Dim SubFormat As String = " ass "
2024-04-09 21:15:21 +02:00
'If CCAvailable.Count > 0 Then
' SubFormat = "vtt"
'End If
2023-01-01 16:34:18 +01:00
Dim i2 As Integer = i
Me . Invoke ( New Action ( Function ( ) As Object
Anime_Add . StatusLabel . Text = " Status: downloading subtitle file " + SoftSubsList ( i2 ) . SubLangName
Me . Text = " Status: downloading subtitle file " + SoftSubsList ( i2 ) . SubLangName
Me . Invalidate ( )
Return Nothing
End Function ) )
Dim SubText As String = " "
SubText = Curl ( SoftSubsList ( i2 ) . Url . Replace ( " -i " , " " ) . Replace ( Chr ( 34 ) , " " ) )
2023-06-17 17:23:31 +02:00
If My . Settings . SubtitleMod1 = True Then
SubText = AddScaledBorderAndShadow ( SubText )
End If
2023-01-01 16:34:18 +01:00
Dim Pfad3 As String = Pfad2 . Replace ( Chr ( 34 ) , " " )
2023-09-10 16:28:23 +02:00
Dim FN As String = Path . ChangeExtension ( Path . Combine ( Path . GetFileNameWithoutExtension ( Pfad3 ) + " . " + ConvertSubValue ( SoftSubsList ( i2 ) . SubLangValue , LangNameType ) + Path . GetExtension ( Pfad3 ) ) , SubFormat )
2023-01-01 16:34:18 +01:00
If i = 0 And IncludeLangName = False Then
2023-03-21 16:48:10 +01:00
FN = Path . ChangeExtension ( Path . GetFileName ( Pfad3 ) , SubFormat )
2022-12-02 18:43:43 +01:00
End If
2023-01-01 16:34:18 +01:00
Dim Pfad4 As String = Path . Combine ( Path . GetDirectoryName ( Pfad3 ) , FN )
WriteText ( Pfad4 , SubText )
Pause ( 3 )
2023-02-21 14:17:59 +01:00
2022-12-02 18:43:43 +01:00
Next
2022-10-22 13:53:55 +02:00
2023-01-01 16:34:18 +01:00
If CR_MetadataUsage = False Then
2023-09-10 16:28:23 +02:00
ffmpegInput = ffmpegInput + " -metadata:s:a:0 language= " + ConvertSubValue ( CR_audio_locale , ConvertSubsEnum . MP4CC_ISO_639_2 ) + " " + ffmpeg_command_temp
2023-01-01 16:34:18 +01:00
Else
2023-09-10 16:28:23 +02:00
ffmpegInput = ffmpegInput + " -i " + Chr ( 34 ) + Mdata_File + Chr ( 34 ) + " -map_metadata 1 " + " -metadata:s:a:0 language= " + ConvertSubValue ( CR_audio_locale , ConvertSubsEnum . MP4CC_ISO_639_2 ) + " " + ffmpeg_command_temp
2021-09-20 20:37:57 +02:00
End If
End If
2023-02-22 14:50:53 +01:00
Else
2023-02-21 14:17:59 +01:00
2023-02-22 14:50:53 +01:00
If CR_MetadataUsage = False Then
2023-09-10 16:28:23 +02:00
ffmpegInput = ffmpegInput + " -metadata:s:a:0 language= " + ConvertSubValue ( CR_audio_locale , ConvertSubsEnum . MP4CC_ISO_639_2 ) + " " + ffmpeg_command_temp
2023-02-22 14:50:53 +01:00
Else
2023-09-10 16:28:23 +02:00
ffmpegInput = ffmpegInput + " -i " + Chr ( 34 ) + Mdata_File + Chr ( 34 ) + " -map_metadata 1 " + " -metadata:s:a:0 language= " + ConvertSubValue ( CR_audio_locale , ConvertSubsEnum . MP4CC_ISO_639_2 ) + " " + ffmpeg_command_temp
2023-02-22 14:50:53 +01:00
End If
2022-12-18 20:28:02 +01:00
End If
2023-01-01 16:34:18 +01:00
ffmpegInput = RemoveExtraSpaces ( ffmpegInput )
#End Region
2021-09-20 20:37:57 +02:00
#Region "thumbnail"
2022-12-18 20:28:02 +01:00
Dim thumbnail3 As String = " "
2023-03-05 12:59:54 +01:00
Try
2023-03-05 14:24:20 +01:00
2023-03-05 12:59:54 +01:00
Dim thumbnail As String ( ) = ObjectJson . Split ( New String ( ) { " https:// " } , System . StringSplitOptions . RemoveEmptyEntries )
For i As Integer = 0 To thumbnail . Count - 1
If CBool ( InStr ( thumbnail ( i ) , " .jpg " + Chr ( 34 ) ) ) Then
Dim thumbnail2 As String ( ) = thumbnail ( i ) . Split ( New String ( ) { " .jpg " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
thumbnail3 = " https:// " + thumbnail2 ( 0 ) . Replace ( " \/ " , " / " ) + " .jpg "
Exit For
ElseIf CBool ( InStr ( thumbnail ( i ) , " .jpeg " + Chr ( 34 ) ) ) Then
Dim thumbnail2 As String ( ) = thumbnail ( i ) . Split ( New String ( ) { " .jpeg " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
thumbnail3 = " https:// " + thumbnail2 ( 0 ) . Replace ( " \/ " , " / " ) + " .jpeg "
Exit For
ElseIf CBool ( InStr ( thumbnail ( i ) , " .jpe " + Chr ( 34 ) ) ) Then
Dim thumbnail2 As String ( ) = thumbnail ( i ) . Split ( New String ( ) { " .jpe " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
thumbnail3 = " https:// " + thumbnail2 ( 0 ) . Replace ( " \/ " , " / " ) + " .jpe "
Exit For
2023-03-05 14:24:20 +01:00
ElseIf CBool ( InStr ( thumbnail ( i ) , " .JPEG " + Chr ( 34 ) ) ) Then
Dim thumbnail2 As String ( ) = thumbnail ( i ) . Split ( New String ( ) { " .JPEG " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
thumbnail3 = " https:// " + thumbnail2 ( 0 ) . Replace ( " \/ " , " / " ) + " .JPEG "
Exit For
ElseIf CBool ( InStr ( thumbnail ( i ) , " .JPG " + Chr ( 34 ) ) ) Then
Dim thumbnail2 As String ( ) = thumbnail ( i ) . Split ( New String ( ) { " .JPG " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
thumbnail3 = " https:// " + thumbnail2 ( 0 ) . Replace ( " \/ " , " / " ) + " .JPG "
Exit For
ElseIf CBool ( InStr ( thumbnail ( i ) , " .JPE " + Chr ( 34 ) ) ) Then
Dim thumbnail2 As String ( ) = thumbnail ( i ) . Split ( New String ( ) { " .JPE " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries ) '(New [Char]() {"-"})
thumbnail3 = " https:// " + thumbnail2 ( 0 ) . Replace ( " \/ " , " / " ) + " .JPE "
Exit For
2023-03-05 12:59:54 +01:00
End If
Next
Catch ex As Exception
End Try
2021-09-20 20:37:57 +02:00
#End Region
2023-01-05 14:26:40 +01:00
2022-12-02 18:43:43 +01:00
#Region "item constructor"
2023-01-01 16:34:18 +01:00
#Region "Display Hard_Softsubs"
Dim SubType_Value As String = Nothing
2022-12-02 18:43:43 +01:00
If Not CR_HardSubLang = " " Then
2023-09-10 16:28:23 +02:00
SubType_Value = " Hardsub: " + ConvertSubValue ( CR_HardSubLang , ConvertSubsEnum . DisplayText )
2022-12-02 18:43:43 +01:00
End If
2023-12-15 19:05:33 +01:00
If SoftSubsList . Count > 0 And CR_HardSubLang = " null " Then
2022-12-02 18:43:43 +01:00
SubType_Value = " Softsubs: "
2023-01-01 16:34:18 +01:00
For i As Integer = 0 To SoftSubsList . Count - 1
SubType_Value = SubType_Value + SoftSubsList ( i ) . SubLangName
If i < SoftSubsList . Count - 1 Then
2022-12-02 18:43:43 +01:00
SubType_Value = SubType_Value + " , "
End If
Next
End If
2023-01-01 16:34:18 +01:00
#End Region
2023-01-01 20:47:09 +01:00
2023-01-01 16:34:18 +01:00
#Region "Display Resolution"
2022-12-02 18:43:43 +01:00
2021-09-20 20:37:57 +02:00
Dim ResoHTMLDisplay As String = Nothing
2022-12-02 18:43:43 +01:00
Dim ResoHTML As String ( ) = ResoUsed . Split ( New String ( ) { " x " } , System . StringSplitOptions . RemoveEmptyEntries )
If ResoHTML . Count > 1 Then
ResoHTMLDisplay = ResoHTML ( 1 ) + " p "
2021-09-20 20:37:57 +02:00
Else
2022-12-02 18:43:43 +01:00
ResoHTMLDisplay = ResoHTML ( 0 ) + " p "
2021-09-20 20:37:57 +02:00
End If
2022-12-02 18:43:43 +01:00
2021-09-20 20:37:57 +02:00
Dim L2Name As String = String . Join ( " " , CR_FilenName . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) 'System.Text.RegularExpressions.Regex.Replace(CR_FilenName_Backup, "[^\w\\-]", " ")
2022-12-02 18:43:43 +01:00
2024-04-13 11:37:48 +02:00
2023-01-01 16:34:18 +01:00
#End Region
2022-12-02 18:43:43 +01:00
2021-09-20 20:37:57 +02:00
Dim L1Name_Split As String ( ) = WebsiteURL . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
2023-09-10 16:28:23 +02:00
Dim L1Name As String = L1Name_Split ( 1 ) . Replace ( " www. " , " " ) + " | Dub : " + ConvertSubValue ( CR_audio_locale , ConvertSubsEnum . DisplayText )
2022-10-22 13:53:55 +02:00
2023-01-01 16:34:18 +01:00
'MsgBox(URL_DL)
2022-10-22 13:53:55 +02:00
2024-04-04 19:52:43 +02:00
2021-09-20 20:37:57 +02:00
Me . Invoke ( New Action ( Function ( ) As Object
2023-01-01 16:34:18 +01:00
ListItemAdd ( Path . GetFileName ( Pfad2 . Replace ( Chr ( 34 ) , " " ) ) , L1Name , L2Name , ResoHTMLDisplay , SubType_Value , thumbnail3 , ffmpegInput , Pfad2 )
2021-09-20 20:37:57 +02:00
Return Nothing
End Function ) )
2022-10-22 13:53:55 +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-09-20 20:37:57 +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
Me . Invoke ( New Action ( Function ( ) As Object
Anime_Add . StatusLabel . Text = " Status: idle "
Me . Text = " Crunchyroll Downloader "
2022-10-22 13:53:55 +02:00
ResoBackString = Nothing
2021-09-20 20:37:57 +02:00
Me . Invalidate ( )
Return Nothing
End Function ) )
2023-02-21 14:17:59 +01:00
2021-09-20 20:37:57 +02:00
Catch ex As Exception
Me . Invoke ( New Action ( Function ( ) As Object
Anime_Add . StatusLabel . Text = " Status: idle "
Me . Text = " Crunchyroll Downloader "
2022-10-22 13:53:55 +02:00
ResoBackString = Nothing
2021-09-20 20:37:57 +02:00
Me . Invalidate ( )
Return Nothing
End Function ) )
Grapp_RDY = True
If CBool ( InStr ( ex . ToString , " Could not find the sub language " ) ) Then
2023-09-10 16:28:23 +02:00
MsgBox ( Sub_language_NotFound + SubSprache . DisplayText )
2021-09-20 20:37:57 +02:00
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 )
2023-02-21 14:17:59 +01:00
ElseIf CBool ( InStr ( ex . ToString , " Error - Getting " ) ) Then
2023-07-11 18:53:50 +02:00
2023-06-03 15:57:13 +02:00
MsgBox ( ex . ToString )
2023-07-11 18:53:50 +02:00
'If RT_count = 0 Then
' If File.Exists("cookies.txt") = True Then
' MsgBox("Request refused, try a new cookies.txt", MsgBoxStyle.Exclamation)
' Exit Sub
' End If
' Me.Invoke(New Action(Function() As Object
' Anime_Add.StatusLabel.Text = "Browser reset..."
' Me.Text = "Browser reset..."
' ResoBackString = Nothing
' Me.Invalidate()
' Return Nothing
' End Function))
' If Application.OpenForms().OfType(Of Browser).Any = True Then
' Browser.Close()
' Startseite = WebsiteURL
' Pause(5)
' UserBowser = False
' Browser.Show()
' 'Anime_Add.btn_dl.Cursor = Cursors.Default
' 'Anime_Add.btn_dl.BackgroundImage = My.Resources.main_button_download_default
' End If
' 'Navigate(WebsiteURL)
' 'Pause(5)
' 'LoadBrowser(WebsiteURL, 1)
' Exit Sub
'End If
' MsgBox(ex.ToString)
2023-06-03 15:57:13 +02:00
' b = False
' Navigate(WebsiteURL)
2021-09-20 20:37:57 +02:00
Else
MsgBox ( ex . ToString , MsgBoxStyle . Information )
End If
2023-02-21 14:17:59 +01:00
End Try '
2021-09-20 20:37:57 +02:00
End Sub
2022-10-27 17:23:57 +02:00
Function Convert_locale ( ByVal locale As String ) As String
Try
If locale = " de " Then
Return " de-DE "
ElseIf locale = " " Then
Return " en-US "
ElseIf locale = " pt-br " Then
Return " pt-BR "
ElseIf locale = " es " Then
Return " es-419 "
ElseIf locale = " fr " Then
Return " fr-FR "
ElseIf locale = " ar " Then
Return " ar-SA "
ElseIf locale = " ru " Then
Return " ru-RU "
ElseIf locale = " it " Then
Return " it-IT "
ElseIf locale = " es-es " Then
Return " es-ES "
ElseIf locale = " pt-pt " Then
Return " pt-PT "
Else
2022-10-29 14:48:05 +02:00
Return " en-US "
2022-10-27 17:23:57 +02:00
End If
Catch ex As Exception
Return Nothing
End Try
End Function
2023-01-01 16:34:18 +01:00
2021-12-19 13:38:19 +01:00
#End Region
2022-10-22 13:53:55 +02:00
2021-09-20 20:37:57 +02:00
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
2022-11-10 14:31:11 +01:00
Dim Item As New List ( Of CRD_List_Item )
Item . AddRange ( Panel1 . Controls . OfType ( Of CRD_List_Item ) )
2022-12-02 18:43:43 +01:00
Item . Reverse ( )
2022-11-10 14:31:11 +01:00
For i As Integer = 0 To Item . Count - 1
Item ( i ) . KillRunningTask ( )
2021-09-20 20:37:57 +02:00
Next
2022-11-10 14:31:11 +01:00
2021-09-20 20:37:57 +02:00
RemoveTempFiles ( )
Me . Close ( )
End If
Else
Timer3 . Enabled = False
RemoveTempFiles ( )
Me . Close ( )
End If
End Sub
2021-12-19 13:38:19 +01:00
2021-09-20 20:37:57 +02:00
Private Sub RemoveTempFiles ( )
Try
Dim files ( ) As String = System . IO . Directory . GetFiles ( Application . StartupPath )
For Each file As String In files
2022-11-10 14:31:11 +01:00
If CBool ( InStr ( file , " CRD-Temp-File- " ) ) Or CBool ( InStr ( file , " -mdata.txt " ) ) Then
2021-09-20 20:37:57 +02:00
System . IO . File . Delete ( file )
End If
Next
Catch ex As Exception
End Try
2023-06-24 23:50:39 +02:00
Try
2023-04-09 09:31:16 +02:00
2023-06-24 23:50:39 +02:00
If KeepCache = False Then
2023-04-09 09:31:16 +02:00
2023-06-24 23:50:39 +02:00
Dim folderPath As String = Pfad
Dim files ( ) As String = Directory . GetFiles ( folderPath , " * " , SearchOption . AllDirectories )
For Each file As String In files
If CBool ( InStr ( file , " CRD-Temp-File- " ) ) Then
'MsgBox(file)
System . IO . File . Delete ( file )
2021-09-20 20:37:57 +02:00
End If
Next
2023-06-24 23:50:39 +02:00
Try
Dim di As New System . IO . DirectoryInfo ( Pfad )
For Each fi As System . IO . DirectoryInfo In di . EnumerateDirectories ( " *.* " , System . IO . SearchOption . TopDirectoryOnly )
If CBool ( InStr ( fi . Name , " CRD-Temp-File- " ) ) Then
System . IO . Directory . Delete ( fi . FullName , True )
End If
Next
Catch ex As Exception
End Try
End If
Catch ex As Exception
End Try
2021-09-20 20:37:57 +02:00
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
2022-12-29 11:45:55 +01:00
ListItemAdd ( Filename , L1Name , L2Name , ResoHTMLDisplay , Subsprache3 , thumbnail3 , URL2 , Pfad2 )
2021-09-20 20:37:57 +02:00
Return Nothing
End Function ) )
2022-07-08 20:54:20 +02:00
' 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 + "-->")
2021-09-20 20:37:57 +02:00
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
2020-09-30 18:19:31 +02:00
End Sub
2019-11-10 00:16:12 +01:00
2021-09-20 20:37:57 +02:00
Private Sub Btn_add_Click ( sender As Object , e As EventArgs ) Handles Btn_add . Click
2021-12-20 18:10:51 +01:00
2024-05-02 17:43:12 +02:00
'If File.Exists("cookies.txt") = False Then
' If Application.OpenForms().OfType(Of Browser).Any = True Then
' Else
' UserBowser = False
' Browser.Show()
' End If
'End If
2021-12-20 18:10:51 +01:00
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
2023-01-26 21:01:15 +01:00
Private Sub OpenSettingsToolStripMenuItem_Click ( sender As Object , e As EventArgs )
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
2023-06-17 17:23:31 +02:00
'Dim Teststring As String = TheTextBox.Text
'TheTextBox.Text = AddScaledBorderAndShadow(Teststring)
'Exit Sub
2023-06-03 15:57:13 +02:00
'Debug.WriteLine(Date.Now.ToString + "." + Date.Now.Millisecond.ToString)
2021-12-20 18:10:51 +01:00
UserBowser = True
2022-12-02 18:43:43 +01:00
If Application . OpenForms ( ) . OfType ( Of Browser ) . Any = True Then
Browser . Location = Me . Location
2021-12-20 18:10:51 +01:00
Else
2022-12-02 18:43:43 +01:00
Browser . Location = Me . Location
Browser . Show ( )
2021-09-20 20:37:57 +02:00
End If
2021-12-20 18:10:51 +01:00
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
2022-11-10 14:31:11 +01:00
2019-11-10 00:16:12 +01:00
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
2022-11-10 14:31:11 +01:00
Dim Item As New List ( Of CRD_List_Item )
Item . AddRange ( Panel1 . Controls . OfType ( Of CRD_List_Item ) )
2022-12-02 18:43:43 +01:00
Item . Reverse ( )
2022-11-10 14:31:11 +01:00
For i As Integer = 0 To Item . Count - 1
2022-12-02 18:43:43 +01:00
'Debug.WriteLine(Item(i).GetIsStatusFinished().ToString)
2022-11-10 14:31:11 +01:00
If Item ( i ) . GetIsStatusFinished ( ) = True Then
2021-01-14 18:06:42 +01:00
ItemFinshedCount = ItemFinshedCount + 1
2020-08-16 23:27:48 +02:00
End If
Next
2022-11-10 14:31:11 +01:00
RunningDownloads = Item . 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
2022-11-10 14:31:11 +01:00
Debug . WriteLine ( " Failed? : " + ex . ToString )
RunningDownloads = Panel1 . Controls . Count
2020-08-16 23:27:48 +02:00
End Try
2022-11-10 14:31:11 +01:00
'Debug.WriteLine("Running: " + RunningDownloads.ToString)
2020-08-16 23:27:48 +02:00
'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
2024-04-13 11:37:48 +02:00
Private Sub Timer3_Tick ( sender As Object , e As EventArgs ) Handles Timer3 . Tick
2022-02-26 10:31:22 +01:00
2024-04-13 11:37:48 +02:00
Dim Item As New List ( Of CRD_List_Item )
Item . AddRange ( Panel1 . Controls . OfType ( Of CRD_List_Item ) )
Item . Reverse ( )
2022-02-26 10:31:22 +01:00
2024-04-13 11:37:48 +02:00
Dim GeckoHTML As String = My . Resources . htmlTop + vbNewLine + My . Resources . htmlTitlel . Replace ( " Placeholder " , Me . Text . Replace ( " open the add window to continue " , " " ) )
2022-02-26 10:31:22 +01:00
2024-04-13 11:37:48 +02:00
For i As Integer = 0 To Item . Count - 1
Dim ItemString As String = My . Resources . htmlvorThumbnail + Item ( i ) . GetThumbnailSource + My . Resources . htmlnachTumbnail + Item ( i ) . Label_website . Text + " <br> " + Item ( i ) . Label_Anime . Text + My . Resources . htmlvorAufloesung . Replace ( " 0% " , Item ( i ) . Label_percent . Text ) . Replace ( " width:0% " , Item ( i ) . GetPercentValue . ToString + " % " ) + Item ( i ) . Label_Reso . Text + My . Resources . htmlvorSoftSubs + vbNewLine + My . Resources . htmlvorHardSubs + Item ( i ) . Label_Hardsub . Text + My . Resources . htmlnachHardSubs
GeckoHTML = GeckoHTML + vbNewLine + ItemString
Next
2022-02-26 10:31:22 +01:00
2024-04-13 11:37:48 +02:00
Dim c As String = GeckoHTML + 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 )
HTML = c
2022-02-26 10:31:22 +01:00
2024-04-13 11:37:48 +02:00
End Sub
2022-12-02 18:43:43 +01:00
2021-11-14 22:06:06 +01:00
2021-10-29 20:38:09 +02:00
2024-04-13 11:37:48 +02:00
#Region "process html"
Public Sub ProcessHTML ( ByVal document As String , ByVal Address As String , ByVal DocumentTitle As String )
Dim localHTML As String = document
Debug . WriteLine ( Date . Now . ToString + " . " + Date . Now . Millisecond . ToString )
Debug . WriteLine ( Address )
If b = True Then
LoadedUrls . Clear ( )
Grapp_RDY = True
Debug . WriteLine ( " Just Browsing, exiting... " )
'Debug.WriteLine("Just Browsing, exiting... for real...")
Exit Sub
2021-12-19 13:38:19 +01:00
End If
2024-04-13 11:37:48 +02:00
'MsgBox("loaded!")
If CBool ( InStr ( Address , " crunchyroll.com " ) ) Then
WebbrowserURL = Address
2021-12-20 18:10:51 +01:00
2024-04-13 11:37:48 +02:00
End If
'End If
2021-10-29 20:38:09 +02:00
End Sub
2023-02-21 14:17:59 +01:00
2023-01-01 20:47:09 +01:00
2024-04-13 11:37:48 +02:00
#End Region
2023-01-01 20:47:09 +01:00
2021-09-20 20:37:57 +02:00
Public Sub Navigate ( ByVal Url As String )
2022-12-02 18:43:43 +01:00
If Application . OpenForms ( ) . OfType ( Of Browser ) . Any = True Then
2021-09-20 20:37:57 +02:00
If InvokeRequired = True Then
Me . Invoke ( New Action ( Function ( ) As Object
2022-12-02 18:43:43 +01:00
Browser . WebView2 . CoreWebView2 . Navigate ( Url )
2021-09-20 20:37:57 +02:00
Return Nothing
End Function ) )
Else
2022-12-02 18:43:43 +01:00
Browser . WebView2 . CoreWebView2 . Navigate ( Url )
2021-09-20 20:37:57 +02:00
End If
Else
If InvokeRequired = True Then
Me . Invoke ( New Action ( Function ( ) As Object
2022-12-02 18:43:43 +01:00
Browser . Show ( )
Browser . WebView2 . CoreWebView2 . Navigate ( Url )
2021-09-20 20:37:57 +02:00
Return Nothing
End Function ) )
Else
2022-12-02 18:43:43 +01:00
Browser . Show ( )
Browser . WebView2 . CoreWebView2 . Navigate ( Url )
2021-09-20 20:37:57 +02:00
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-09-20 20:37:57 +02:00
Dim Port As String = StartServer . ToString
2021-02-20 18:25:49 +01:00
Dim localAddr As IPAddress = IPAddress . Parse ( " 127.0.0.1 " )
2021-05-23 22:27:56 +02:00
server = New TcpListener ( localAddr , Int32 . Parse ( Port ) )
2021-02-20 18:25:49 +01:00
' Start listening for client requests.
server . Start ( )
2021-05-23 22:27:56 +02:00
Debug . WriteLine ( " Web server started at: " & localAddr . ToString ( ) & " : " & Port )
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-12-19 13:38:19 +01:00
2021-02-20 18:25:49 +01:00
Sub ManageConnections ( ByVal client As TcpClient )
Dim bytes ( 1048576 ) As Byte
Dim stream As NetworkStream = client . GetStream ( )
' Debug.WriteLine(Date.Now + " " + "stream opend")
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 ( )
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 )
2022-01-22 11:56:37 +01:00
Debug . WriteLine ( htmlReq )
' Dim recvBytes(1048576) As Byte
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
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 ) )
2022-05-02 18:37:40 +02:00
2020-09-30 18:19:31 +02:00
#Region "mass-dl"
2022-05-02 18:37:40 +02:00
2022-10-20 18:23:22 +02:00
If CBool ( InStr ( htmlReq , " HTMLMass= " ) ) Then
2022-10-21 20:25:48 +02:00
Debug . WriteLine ( " multi episode mode " )
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 )
2023-01-07 19:04:56 +01:00
'If Application.OpenForms().OfType(Of Anime_Add).Any = True Then
' For i As Integer = 0 To URLSplit.Count - 1
' Dim ii As Integer = i
' Me.Invoke(New Action(Function() As Object
' 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))
' Return Nothing
' End Function))
' Next
'Else
For i As Integer = 0 To URLSplit . Count - 1
If ListBoxList . Contains ( URLSplit ( i ) ) = False Then
ListBoxList . Add ( URLSplit ( i ) )
End If
Next
Me . Invoke ( New Action ( Function ( ) As Object
Me . Text = " Status: " + ListBoxList . Count . ToString + " downloads in queue " + vbNewLine + " open the add window to continue "
Me . Invalidate ( )
Return Nothing
End Function ) )
'End If
2022-10-21 20:25:48 +02:00
strRequest = rootPath & " Post_Mass_Sucess.html " 'PostPage
SendHTMLResponse ( stream , strRequest )
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(stream, strRequest)
SendHTMLResponse ( stream , Nothing , New ServerResponse ( ErrorPage , " html " ) )
End Try
#End Region
2022-10-20 18:23:22 +02:00
2024-01-28 12:09:00 +01:00
ElseIf CBool ( InStr ( htmlReq , " m3u8_Url= " ) ) Then
Debug . WriteLine ( " m3u8_Url mode " )
Try
Dim DecodedHTML As String = UrlDecode ( htmlReq )
'MsgBox(DecodedHTML)
If CBool ( InStr ( DecodedHTML , " &tabName= " ) ) Then
Dim DataSplit ( ) As String = DecodedHTML . Split ( New String ( ) { " &tabName= " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim UrlSplit ( ) As String = DataSplit ( 0 ) . Split ( New String ( ) { " m3u8_Url= " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim NameSplit ( ) As String = DataSplit ( 1 ) . Split ( New String ( ) { " | " } , System . StringSplitOptions . RemoveEmptyEntries )
' CR_title = String.Join(" ", Title.Split(invalids, StringSplitOptions.RemoveEmptyEntries)).TrimEnd("."c).Replace(Chr(34), "").Replace("\", "").Replace("/", "").Replace(":", "")
' MsgBox(URLSplit(1) + vbNewLine + DataSplit(1))
Dim NameKomplett As String = Nothing
Try
NameKomplett = String . Join ( " " , NameSplit ( 0 ) . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " ) . Replace ( " : " , " " )
NameKomplett = RemoveExtraSpaces ( String . Join ( " " , NameKomplett . Split ( invalids , StringSplitOptions . RemoveEmptyEntries ) ) . TrimEnd ( " . "c ) ) . Replace ( Chr ( 34 ) , " " ) . Replace ( " \ " , " " ) . Replace ( " / " , " " )
Catch ex As Exception
End Try
'
If NameKomplett = Nothing Or NameKomplett = " Use Custom Name " Then
NameKomplett = GeräteID2 ( ) . Replace ( " CRD-Temp-File " , " misc_download-# " )
End If
Dim Namep1 As String = " Other "
Dim Namep2 As String = NameKomplett + VideoFormat
Dim Reso As String = " NaN "
Dim HardSub As String = " maybe? "
Dim ThumbnialURL As String = " no "
Dim URL_DL As String = " -i " + Chr ( 34 ) + UrlSplit ( 1 ) . Replace ( vbCrLf , " " ) . Replace ( vbCr , " " ) . Replace ( vbLf , " " ) + Chr ( 34 ) + ffmpeg_command
Dim Pfad_DL As String = Path . Combine ( Pfad , Namep2 )
Dim Service As String = " other "
Me . Invoke ( New Action ( Function ( ) As Object
If MessageBox . Show ( NameKomplett + vbNewLine + vbNewLine + URL_DL , " Confirm Download " , MessageBoxButtons . OKCancel ) = DialogResult . OK Then
Else
strRequest = rootPath & " Post_Mass_Sucess.html " 'PostPage
SendHTMLResponse ( stream , strRequest )
Return Nothing
Exit Function
End If
ItemConstructor ( NameKomplett , Namep1 , Namep2 , Reso , HardSub , ThumbnialURL , URL_DL , Chr ( 34 ) + Pfad_DL + Chr ( 34 ) , Service )
Return Nothing
End Function ) )
'End If
strRequest = rootPath & " Post_Mass_Sucess.html " 'PostPage
SendHTMLResponse ( stream , strRequest )
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
SendHTMLResponse ( stream , Nothing , New ServerResponse ( ErrorPage , " html " ) )
End Try
2022-10-21 20:25:48 +02:00
Else
strRequest = rootPath & " error_Page_default.html " 'PostPage
2022-05-02 18:37:40 +02:00
SendHTMLResponse ( stream , strRequest )
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
strRequest = strArray ( 1 ) . Trim
2023-02-07 14:31:23 +01:00
If CBool ( InStr ( strRequest , " 403 " ) ) Then
strRequest = strRequest & defaultPage '"HTMLString" 'strRequest & defaultPage
SendHTMLResponse ( stream , " index.html " , Nothing , " HTTP/1.0 403 Forbidden " )
End If
2020-09-30 18:19:31 +02:00
If strRequest . StartsWith ( " / " ) Then
strRequest = strRequest . Substring ( 1 )
End If
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
End If
2022-05-02 18:37:40 +02:00
2020-09-30 18:19:31 +02:00
strRequest = rootPath & strRequest
2022-05-02 18:37:40 +02:00
SendHTMLResponse ( stream , strRequest )
2020-08-16 23:27:48 +02:00
Else ' Not HTTP GET method
2022-05-02 18:37:40 +02:00
2020-08-16 23:27:48 +02:00
strRequest = rootPath & defaultPage
2022-05-02 18:37:40 +02:00
SendHTMLResponse ( stream , strRequest )
2020-08-16 23:27:48 +02:00
End If
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
2022-05-02 18:37:40 +02:00
' My.Computer.FileSystem.WriteAllText(Application.StartupPath + "\WebInterface\error_Page.html", ErrorPage, False)
SendHTMLResponse ( stream , Nothing , New ServerResponse ( ErrorPage , " html " ) )
2020-08-16 23:27:48 +02:00
End Try
2020-02-12 22:08:02 +01:00
End Sub
2021-02-20 18:25:49 +01:00
2021-12-19 13:38:19 +01:00
' Send HTTP Response
2023-02-07 14:31:23 +01:00
Private Sub SendHTMLResponse ( ByVal stream As NetworkStream , Optional ByVal httpRequest As String = Nothing , Optional ByVal Response As ServerResponse = Nothing , Optional ByVal httpCode As String = " HTTP/1.0 200 OK " )
2020-08-16 23:27:48 +02:00
Try
Dim respByte ( ) As Byte
2022-05-02 18:37:40 +02:00
If httpRequest = Nothing Then
Debug . WriteLine ( httpRequest )
respByte = System . Text . Encoding . UTF8 . GetBytes ( Response . Content ) 'File.ReadAllBytes("") '
' Set HTML Header
Dim htmlHeader As String =
2023-02-07 14:31:23 +01:00
httpCode & ControlChars . CrLf &
2022-05-02 18:37:40 +02:00
" Server: CRD 1.0 " & ControlChars . CrLf &
" Content-Length: " & respByte . Length & ControlChars . CrLf &
" Content-Type: " & GetContentType ( Response . Type ) &
ControlChars . CrLf & ControlChars . CrLf
' The content Length of HTML Header
Dim headerByte ( ) As Byte = Encoding . UTF8 . GetBytes ( htmlHeader )
stream . Write ( headerByte , 0 , headerByte . Length )
stream . Write ( respByte , 0 , respByte . Length )
ElseIf 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 =
2023-02-07 14:31:23 +01:00
httpCode & 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 =
2023-02-07 14:31:23 +01:00
httpCode & ControlChars . CrLf &
2021-02-20 18:25:49 +01:00
" 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 )
' 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-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
' 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 "
2023-06-03 15:57:13 +02:00
ElseIf ( httpRequest . EndsWith ( " css " ) ) Then
Return " text/css "
2020-08-16 23:27:48 +02:00
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-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
2021-07-04 17:22:46 +02:00
Private Sub Timer4_Tick ( sender As Object , e As EventArgs ) Handles Timer4 . Tick
2022-05-22 11:01:32 +02:00
2023-01-07 19:04:56 +01:00
'If Application.OpenForms().OfType(Of Anime_Add).Any = False Then
' If ListBoxList.Count > 0 Then
' If CBool(InStr(Me.Text, "Crunchyroll Downloader")) Or CBool(InStr(Me.Text, " downloads in queue")) Then
' Me.Text = "Status: " + ListBoxList.Count.ToString + " downloads in queue" + vbNewLine + "open the add window to continue"
' End If
' End If
'End If
2022-05-22 11:01:32 +02:00
2021-07-04 17:22:46 +02:00
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
2022-11-10 14:31:11 +01:00
Panel1 . Select ( )
2021-04-05 19:08:42 +02:00
2023-01-07 19:04:56 +01:00
End Sub
2022-06-14 17:09:33 +02:00
2022-02-26 10:31:22 +01:00
2023-01-26 21:01:15 +01:00
Private Sub AddonHTMLToolStripMenuItem_Click ( sender As Object , e As EventArgs )
2022-07-08 20:54:20 +02:00
My . Computer . Clipboard . SetText ( HTML )
End Sub
Private Sub Timer3OffToolStripMenuItem_Click ( sender As Object , e As EventArgs ) Handles Timer3OffToolStripMenuItem . Click
Timer3 . Enabled = False
End Sub
2022-07-30 10:04:28 +02:00
Private Sub ThreadCount_Click ( sender As Object , e As EventArgs ) Handles ThreadCount . Click
Trackbar . ShowDialog ( )
End Sub
2023-01-26 21:01:15 +01:00
Private Sub MsgBoxToolStripMenuItem_Click ( sender As Object , e As EventArgs )
2022-10-01 12:47:02 +02:00
MsgBox ( LoadedUrls . Count . ToString )
For i As Integer = 0 To LoadedUrls . Count - 1
MsgBox ( LoadedUrls ( i ) )
Next
End Sub
2022-10-20 18:23:22 +02:00
Private Sub CRCookieToolStripMenuItem_Click ( sender As Object , e As EventArgs ) Handles CRCookieToolStripMenuItem . Click
2022-10-21 20:25:48 +02:00
2022-10-22 13:53:55 +02:00
'MsgBox(Curl(InputBox("test", "test")))
2022-12-02 18:43:43 +01:00
'For i As Integer = 0 To CookieList.Count - 1
2022-10-21 20:25:48 +02:00
2022-12-02 18:43:43 +01:00
'Next
MsgBox ( CookieList . Count . ToString )
'MsgBox(CR_Cookies)
2022-10-20 18:23:22 +02:00
End Sub
2022-10-24 18:33:49 +02:00
2022-10-20 18:23:22 +02:00
2023-01-26 21:01:15 +01:00
Private Sub ItemBoundsToolStripMenuItem_Click ( sender As Object , e As EventArgs )
2022-11-10 14:31:11 +01:00
Try
For s As Integer = 0 To Panel1 . Controls . Count - 1
MsgBox ( Panel1 . Controls . Item ( s ) . Bounds . ToString )
Next
Catch ex As Exception
End Try
End Sub
Private Sub PanelControlRemoved ( sender As Object , e As ControlEventArgs ) Handles Panel1 . ControlAdded , Panel1 . ControlRemoved
ItemBounds ( )
End Sub
2023-03-23 13:49:11 +01:00
'Private Sub PanelScroll(sender As Object, e As ScrollEventArgs) Handles Panel1.Scroll
' 'MsgBox("Scroll")
' 'ItemBounds()
'End Sub
2022-11-10 14:31:11 +01:00
Sub ItemBounds ( )
Try
Panel1 . AutoScrollPosition = New Point ( 0 , 0 )
Dim W As Integer = Panel1 . Width
If Panel1 . Controls . Count * 142 > Panel1 . Height Then
W = Panel1 . Width - SystemInformation . VerticalScrollBarWidth
End If
Dim Item As New List ( Of CRD_List_Item )
Item . AddRange ( Panel1 . Controls . OfType ( Of CRD_List_Item ) )
2022-12-02 18:43:43 +01:00
Item . Reverse ( )
2022-11-10 14:31:11 +01:00
For s As Integer = 0 To Item . Count - 1
Item ( s ) . SetBounds ( 0 , 142 * s , W - 2 , 142 )
If Debug2 = True Then
Debug . WriteLine ( " Ist: " + Item ( s ) . Location . Y . ToString )
Debug . WriteLine ( " Soll: " + ( 142 * s ) . ToString )
End If
Next
Catch ex As Exception
Debug . WriteLine ( ex . ToString )
End Try
End Sub
Private Sub DummyItemToolStripMenuItem_Click ( sender As Object , e As EventArgs ) Handles DummyItemToolStripMenuItem . Click
Dim TN As String = " https://invalid.com/ "
Dim cmd As String = " -i " + Chr ( 34 ) + " https://invalid.com/ " + Chr ( 34 ) + " -c copy "
ListItemAdd ( " TestDL " , " CR " , " TestDL " , " 9987p " , " DE " , " None " , TN , cmd , " E:\Test\RWBY\Testdl.mkv " )
End Sub
2020-12-13 16:11:43 +01:00
#End Region
2020-09-30 18:19:31 +02:00
2022-12-29 11:45:55 +01:00
#Region "enum"
2020-09-30 18:19:31 +02:00
2022-12-29 11:45:55 +01:00
Sub FillArray ( ) '
2021-10-29 20:38:09 +02:00
2023-12-15 16:53:07 +01:00
LangValueEnum . Add ( New NameValuePair ( " [ null ] " , " " , " null " , Nothing ) )
2023-09-10 16:28:23 +02:00
LangValueEnum . Add ( New NameValuePair ( " Deutsch " , " ger " , " de-DE " , Nothing ) ) '
LangValueEnum . Add ( New NameValuePair ( " English " , " eng " , " en-US " , " en " ) )
LangValueEnum . Add ( New NameValuePair ( " Português (Brasil) " , " por " , " pt-BR " , " pt " ) )
LangValueEnum . Add ( New NameValuePair ( " Português (Portugal) " , " por " , " pt-PT " , Nothing ) )
LangValueEnum . Add ( New NameValuePair ( " Español (LA) " , " spa " , " es-419 " , " es " ) )
LangValueEnum . Add ( New NameValuePair ( " Français (France) " , " fre " , " fr-FR " , Nothing ) )
LangValueEnum . Add ( New NameValuePair ( " العربية (Arabic) " , " ara " , " ar-SA " , Nothing ) )
2024-01-06 14:35:22 +01:00
LangValueEnum . Add ( New NameValuePair ( " Polski " , " pol " , " pl-PL " , Nothing ) )
2023-09-10 16:28:23 +02:00
LangValueEnum . Add ( New NameValuePair ( " Русский (Russian) " , " rus " , " ru-RU " , Nothing ) )
LangValueEnum . Add ( New NameValuePair ( " Italiano (Italian) " , " ita " , " it-IT " , Nothing ) )
LangValueEnum . Add ( New NameValuePair ( " Español (España) " , " spa " , " es-ES " , Nothing ) )
2024-01-06 14:35:22 +01:00
LangValueEnum . Add ( New NameValuePair ( " Türkçe " , " tur " , " tr-TR " , Nothing ) )
2023-09-10 16:28:23 +02:00
LangValueEnum . Add ( New NameValuePair ( " Bahasa Indonesia " , " ind " , " id-ID " , Nothing ) )
2024-03-26 20:56:18 +01:00
LangValueEnum . Add ( New NameValuePair ( " Bahasa Melayu " , " msa " , " ms-MY " , Nothing ) )
2023-09-10 16:28:23 +02:00
LangValueEnum . Add ( New NameValuePair ( " Català " , " cat " , " ca-ES " , Nothing ) )
LangValueEnum . Add ( New NameValuePair ( " Tiếng Việt " , " vie " , " vi-VN " , Nothing ) )
2024-01-06 14:35:22 +01:00
LangValueEnum . Add ( New NameValuePair ( " English (India) " , " eng " , " en-IN " , Nothing ) )
2023-09-10 16:28:23 +02:00
2024-01-11 22:02:32 +01:00
LangValueEnum . Add ( New NameValuePair ( " తెలుగు (Telegu) " , " tel " , " te-IN " , Nothing ) )
2023-09-10 16:28:23 +02:00
2024-01-11 22:02:32 +01:00
LangValueEnum . Add ( New NameValuePair ( " हिंदी (Hindi) " , " hin " , " hi-IN " , Nothing ) )
2023-09-10 16:28:23 +02:00
2024-01-11 22:02:32 +01:00
LangValueEnum . Add ( New NameValuePair ( " தமிழ் (Tamil) " , " tam " , " ta-IN " , Nothing ) )
2023-09-10 16:28:23 +02:00
LangValueEnum . Add ( New NameValuePair ( " 中文 (中国) " , " zho " , " zh-CN " , Nothing ) )
LangValueEnum . Add ( New NameValuePair ( " 中文 (台灣) " , " zho " , " zh-TW " , Nothing ) )
LangValueEnum . Add ( New NameValuePair ( " 한국어 " , " kor " , " ko-KR " , Nothing ) )
LangValueEnum . Add ( New NameValuePair ( " ไทย " , " tha " , " th-TH " , Nothing ) )
LangValueEnum . Add ( New NameValuePair ( " Japanese " , " jpn " , " ja-JP " , Nothing ) )
2021-10-29 20:38:09 +02:00
End Sub
2023-02-16 20:56:58 +01:00
2023-01-05 14:26:40 +01:00
Private Sub QueueToolStripMenuItem_Click ( sender As Object , e As EventArgs ) Handles QueueToolStripMenuItem . Click
2023-01-26 21:01:15 +01:00
'ffmpeg_options.ShowDialog()
Dim newCmd As New ffmpeg_options
newCmd . command = ffmpeg_command
'MsgBox(newCmd.ShowDialog.ToString)
If newCmd . ShowDialog = DialogResult . OK Then
ffmpeg_command = newCmd . command
My . Settings . ffmpeg_command_override = newCmd . command
End If
2023-01-05 14:26:40 +01:00
End Sub
2023-01-07 19:04:56 +01:00
Private Sub Btn_Queue_Click ( sender As Object , e As EventArgs ) Handles Btn_Queue . Click
2024-05-11 18:47:10 +02:00
UserQueue = True
If Application . OpenForms ( ) . OfType ( Of Queue ) . Any = True Then
Queue . Location = New Point ( CInt ( Me . Location . X + Me . Width / 2 - Queue . Width / 2 ) , CInt ( Me . Location . Y + Me . Height / 2 - Queue . Height / 2 ) )
If Queue . WindowState = System . Windows . Forms . FormWindowState . Minimized Then
Queue . WindowState = System . Windows . Forms . FormWindowState . Normal
Queue . ShowInTaskbar = True
End If
2023-01-07 19:04:56 +01:00
Else
2024-05-11 18:47:10 +02:00
Queue . Location = New Point ( CInt ( Me . Location . X + Me . Width / 2 - Queue . Width / 2 ) , CInt ( Me . Location . Y + Me . Height / 2 - Queue . Height / 2 ) )
2023-01-07 19:04:56 +01:00
Queue . Show ( )
End If
2024-05-11 18:47:10 +02:00
Try
Dim hwnd As IntPtr = FindWindow ( Nothing , Queue . Text )
SetForegroundWindow ( hwnd )
Catch ex As Exception
Debug . WriteLine ( " Queue foreground failure " )
End Try
2023-01-07 19:04:56 +01:00
End Sub
2022-05-02 18:37:40 +02:00
2022-06-24 16:11:21 +02:00
2022-12-29 11:45:55 +01:00
#End Region
2022-12-05 18:16:07 +01:00
2023-01-07 19:04:56 +01:00
#Region "Process Urls"
2023-06-03 15:57:13 +02:00
Public Sub LoadBrowser ( ByVal Url As String , Optional ByVal RT_count As Integer = 0 )
2023-01-07 19:04:56 +01:00
2022-12-05 18:16:07 +01:00
2023-01-07 19:04:56 +01:00
LoadingUrl = Url
LoadedUrls . Clear ( )
Dim NoBrowser As Boolean = False
2024-05-02 17:43:12 +02:00
WebbrowserURL = Url
2023-02-21 14:17:59 +01:00
2023-02-07 14:31:23 +01:00
'CR_v1Token = "Get"
2023-01-07 19:04:56 +01:00
'Browser.WebView2.Source = New Uri(Url)
'Exit Sub
'MsgBox(Url)
If CBool ( InStr ( Url , " crunchyroll.com " ) ) = True And CBool ( InStr ( Url , " series " ) ) = True Or CBool ( InStr ( Url , " crunchyroll.com " ) ) = True And CBool ( InStr ( Url , " watch " ) ) = True Then
2024-04-30 22:44:38 +02:00
#Region "Get local"
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
2024-04-30 22:44:38 +02:00
If CBool ( InStr ( Url , " /series " ) ) Then
Dim locale1 ( ) As String = Url . Split ( New String ( ) { " crunchyroll.com/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim locale2 ( ) As String = locale1 ( 1 ) . Split ( New String ( ) { " /series " } , System . StringSplitOptions . RemoveEmptyEntries )
locale = Convert_locale ( locale2 ( 0 ) )
If locale = " en-US " Then
Url_locale = " "
Else
Url_locale = locale2 ( 0 )
End If
2023-03-05 12:59:54 +01:00
2024-04-30 22:44:38 +02:00
ElseIf CBool ( InStr ( Url , " /watch " ) ) Then
Dim locale1 ( ) As String = Url . Split ( New String ( ) { " crunchyroll.com/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim locale2 ( ) As String = locale1 ( 1 ) . Split ( New String ( ) { " /watch " } , System . StringSplitOptions . RemoveEmptyEntries )
'MsgBox(locale2(0))
2023-03-05 12:59:54 +01:00
2024-04-30 22:44:38 +02:00
locale = Convert_locale ( locale2 ( 0 ) )
'End If
If locale = " en-US " Then
Url_locale = " "
Else
Url_locale = locale2 ( 0 )
End If
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
2024-04-30 22:44:38 +02:00
End If
2023-01-07 19:04:56 +01:00
#End Region
2024-04-28 21:29:33 +02:00
Dim Loc_CR_Cookies As String = " " ' do we need that? does not seem like it.
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
Dim Auth As String = " -H " + Chr ( 34 ) + " Authorization: " + CrBetaBasic + Chr ( 34 )
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
Dim Post As String = Nothing
Dim UnixTime As Integer
UnixTime = CInt ( ( DateTime . UtcNow - New DateTime ( 1970 , 1 , 1 , 0 , 0 , 0 ) ) . TotalSeconds )
If CBool ( CR_Token . access_token = Nothing ) = True Then ' *insert *First time* meme
Post = " -d " + Chr ( 34 ) + " username= " + UrlEncode ( Mail ) + " &password= " + UrlEncode ( PW ) + " &grant_type=password&scope=offline_access " + Chr ( 34 ) + " -X POST -H " + Chr ( 34 ) + " Content-Type: application/x-www-form-urlencoded; charset=utf-8 " + Chr ( 34 )
SetStatusLabel ( " Status: using login to authenticate " )
Pause ( 2 )
ElseIf CR_Token . expires_Unix + 30 > UnixTime Then 'we are not expired yet (+10% tolleranz)
Post = " Skip! "
SetStatusLabel ( " Status: Token not expired - skip auth " )
Pause ( 2 )
ElseIf CR_Token . expires_Unix + 30 < UnixTime Then 'we should renew it
Post = " -d " + Chr ( 34 ) + " refresh_token= " + CR_Token . refresh_token + " &grant_type=refresh_token&scope=offline_access " + Chr ( 34 ) + " -X POST -H " + Chr ( 34 ) + " Content-Type: application/x-www-form-urlencoded; charset=utf-8 " + Chr ( 34 )
SetStatusLabel ( " Status: Token expired - refreshing " )
Pause ( 2 )
2024-04-21 16:45:13 +02:00
End If
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
'
Dim CRBetaBearer As String = " Bearer "
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
If Post = " Skip! " Then
Dim Auth2 As String = " -H " + Chr ( 34 ) + " Authorization: " + CRBetaBearer + CR_Token . access_token + Chr ( 34 )
ProcessLoading ( Url , Auth2 , Loc_CR_Cookies , RT_count )
Else
Dim v1Token As String = CurlPost ( " https://www.crunchyroll.com/auth/v1/token " , Loc_CR_Cookies , Auth , Post , " add_main_4494 " )
2023-07-15 20:54:20 +02:00
2024-05-23 18:20:36 +02:00
If CBool ( InStr ( v1Token , " HTTP Status: 401 " ) ) = True Then
MsgBox ( " CR reported : " + vbNewLine + v1Token , MsgBoxStyle . Exclamation , " CR-Error 401 " )
2024-04-28 21:29:33 +02:00
LoginForm . ShowDialog ( )
Exit Sub
End If
2023-07-15 20:54:20 +02:00
2024-05-23 18:20:36 +02:00
If CBool ( InStr ( v1Token , " HTTP Status: 400 " ) ) = True Then
'MsgBox("CR reported error 400, idk why tbh", MsgBoxStyle.Exclamation, "CR-Error 400")
'SetStatusLabel("Status: Unknown error. #3038")
MsgBox ( " CR reported : " + vbNewLine + v1Token , MsgBoxStyle . Exclamation , " CR-Error 400 " )
2024-04-28 21:29:33 +02:00
Exit Sub
End If
2023-07-15 20:54:20 +02:00
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
If CBool ( InStr ( v1Token , " curl: (60) " ) ) = True Then
SetStatusLabel ( " Status: Critical error. #3043 " )
MsgBox ( " Please try the '--insecure' option found on the 'Main' page of the settings. " )
Exit Sub
'ElseIf CBool(InStr(v1Token, "curl:")) Then
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
ElseIf CBool ( InStr ( v1Token , " curl: " ) ) = True Then
' Browser.WebView2.CoreWebView2.Navigate(Url)
SetStatusLabel ( " Status: Unknown error. #3050 " )
Exit Sub
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
End If
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
Dim Token ( ) As String = v1Token . Split ( New String ( ) { Chr ( 34 ) + " access_token " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim Token2 ( ) As String = Token ( 1 ) . Split ( New String ( ) { Chr ( 34 ) + " , " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
CRBetaBearer = CRBetaBearer + Token2 ( 0 )
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
Dim RefrehToken ( ) As String = v1Token . Split ( New String ( ) { Chr ( 34 ) + " refresh_token " + Chr ( 34 ) + " : " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
Dim RefrehToken2 ( ) As String = RefrehToken ( 1 ) . Split ( New String ( ) { Chr ( 34 ) + " , " + Chr ( 34 ) } , System . StringSplitOptions . RemoveEmptyEntries )
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
Dim TokenUnixTime As Integer
TokenUnixTime = CInt ( ( DateTime . UtcNow - New DateTime ( 1970 , 1 , 1 , 0 , 0 , 0 ) ) . TotalSeconds ) + 300
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
CR_Token = New CR_Tokens ( Token2 ( 0 ) , RefrehToken2 ( 0 ) , TokenUnixTime )
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
Dim Auth2 As String = " -H " + Chr ( 34 ) + " Authorization: " + CRBetaBearer + Chr ( 34 )
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
ProcessLoading ( Url , Auth2 , Loc_CR_Cookies , RT_count )
2023-01-07 19:04:56 +01:00
2024-04-28 21:29:33 +02:00
End If
2023-02-07 14:31:23 +01:00
Else
'to do
End If
End Sub
2023-01-07 19:04:56 +01:00
2023-06-03 15:57:13 +02:00
Public Sub ProcessLoading ( ByVal url As String , Auth2 As String , ByVal Loc_CR_Cookies As String , ByVal RT_Count As Integer )
2023-01-07 19:04:56 +01:00
2023-08-10 13:16:55 +02:00
' MsgBox(url)
2023-02-07 14:31:23 +01:00
If CBool ( InStr ( url , " crunchyroll.com " ) ) = True And CBool ( InStr ( url , " series/ " ) ) = True Then
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
Dim SeriesUrlBuilder ( ) As String = url . Split ( New String ( ) { " series/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim SeriesUrlBuilder2 ( ) As String = SeriesUrlBuilder ( 1 ) . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
Dim SeriesUrl As String = " https://www.crunchyroll.com/content/v2/cms/series/ " + SeriesUrlBuilder2 ( 0 ) + " /seasons?preferred_audio_language= " + DubSprache . CR_Value + " &locale= " + locale '+ "&Signature=" + signature2(0) + "&Policy=" + policy2(0) + "&Key-Pair-Id=" + key_pair_id2(0)
Debug . WriteLine ( SeriesUrl )
'MsgBox(SeriesUrl)
GetBetaSeasons ( url , SeriesUrl , Auth2 )
2023-01-07 19:04:56 +01:00
2023-08-10 13:16:55 +02:00
ElseIf CBool ( InStr ( url , " crunchyroll.com " ) ) = True And CBool ( InStr ( url , " watch/ " ) ) = True And CBool ( CrBetaBasic = Nothing ) = False And CBool ( InStr ( url , " /musicvideo/ " ) ) = False And CBool ( InStr ( url , " /concert/ " ) ) = False Then
#Region "Anime"
2024-04-28 21:29:33 +02:00
SetStatusLabel ( " Status: Url match - Anime episode " )
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
Dim ObjectsUrl As String = Nothing
2023-01-21 11:21:39 +01:00
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
'MsgBox(Url)
Dim ObjectsURLBuilder3 ( ) As String = url . Split ( New String ( ) { " watch/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURLBuilder4 ( ) As String = ObjectsURLBuilder3 ( 1 ) . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
ObjectsUrl = " https://www.crunchyroll.com/content/v2/cms/objects/ " + ObjectsURLBuilder4 ( 0 ) + " ?preferred_audio_language= " + DubSprache . CR_Value + " &locale= " + locale
'End Using
'MsgBox(ObjectsUrl)
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
Debug . WriteLine ( " ObjectsUrl: " + ObjectsUrl )
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
Dim StreamsUrl As String = Nothing
Dim ObjectJson As String
2023-04-09 09:31:16 +02:00
Try
ObjectJson = CurlAuthNew ( ObjectsUrl , Loc_CR_Cookies , Auth2 )
Catch ex As Exception
2024-05-23 18:20:36 +02:00
MsgBox ( ex . ToString )
Exit Sub
'If CBool(InStr(ex.ToString, "Error - Getting")) Then
' MsgBox("Error invalid CR respone")
' Exit Sub
'Else
' MsgBox("Error processing data")
' Exit Sub
'End If
2023-04-09 09:31:16 +02:00
End Try
2023-01-07 19:04:56 +01:00
2023-02-21 14:17:59 +01:00
If CBool ( InStr ( ObjectJson , " curl: " ) ) = True Then
Browser . WebView2 . CoreWebView2 . Navigate ( url )
2023-01-07 19:04:56 +01:00
2023-02-21 14:17:59 +01:00
Exit Sub
ElseIf CBool ( InStr ( ObjectJson , " videos/ " ) ) = False Then
2024-05-23 18:20:36 +02:00
MsgBox ( ObjectJson )
2023-02-21 14:17:59 +01:00
SetStatusLabel ( " Status: Failed - no video, check CR login " )
Me . Text = " Status: Failed - no video, check CR login "
Debug . WriteLine ( " Status: Failed - no video, check CR login " )
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
Exit Sub
2023-02-21 14:17:59 +01:00
End If
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
Try
Dim StreamsUrlBuilder ( ) As String = ObjectJson . Split ( New String ( ) { " videos/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StreamsUrlBuilder2 ( ) As String = StreamsUrlBuilder ( 1 ) . Split ( New String ( ) { " /streams " } , System . StringSplitOptions . RemoveEmptyEntries )
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
Dim StreamsUrlBuilder3 ( ) As String = ObjectsUrl . Split ( New String ( ) { " objects/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StreamsUrlBuilder4 ( ) As String = StreamsUrlBuilder3 ( 1 ) . Split ( New String ( ) { " ? " } , System . StringSplitOptions . RemoveEmptyEntries )
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
StreamsUrl = StreamsUrlBuilder3 ( 0 ) + " videos/ " + StreamsUrlBuilder2 ( 0 ) + " /streams? " + StreamsUrlBuilder4 ( 1 )
2023-01-21 11:21:39 +01:00
2023-02-07 14:31:23 +01:00
'MsgBox(StreamsUrl)
2023-01-07 19:04:56 +01:00
2023-02-07 14:31:23 +01:00
' Debug.WriteLine(StreamsUrl)
Catch ex As Exception
Browser . WebView2 . CoreWebView2 . Navigate ( url )
Exit Sub
End Try
2023-06-03 15:57:13 +02:00
GetCRVideoProxy ( StreamsUrl , Auth2 , url , RT_Count )
2023-08-10 13:16:55 +02:00
#End Region
ElseIf CBool ( InStr ( url , " crunchyroll.com " ) ) = True And CBool ( InStr ( url , " musicvideo/ " ) ) = True And CBool ( CrBetaBasic = Nothing ) = False Then
#Region "musik videos"
2024-04-28 21:29:33 +02:00
SetStatusLabel ( " Status: Url match - Music video " )
2023-08-10 13:16:55 +02:00
Dim ObjectsUrl As String = Nothing
Dim ObjectsURLBuilder3 ( ) As String = url . Split ( New String ( ) { " musicvideo/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURLBuilder4 ( ) As String = ObjectsURLBuilder3 ( 1 ) . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
ObjectsUrl = " https://www.crunchyroll.com/content/v2/music/music_videos/ " + ObjectsURLBuilder4 ( 0 ) + " ?locale= " + locale
Debug . WriteLine ( " ObjectsUrl: " + ObjectsUrl )
Dim StreamsUrl As String = Nothing
Dim ObjectJson As String
Try
ObjectJson = CurlAuthNew ( ObjectsUrl , Loc_CR_Cookies , Auth2 )
Catch ex As Exception
If CBool ( InStr ( ex . ToString , " Error - Getting " ) ) Then
MsgBox ( " Error invalid CR respone " )
Exit Sub
Else
MsgBox ( " Error processing data " )
Exit Sub
End If
End Try
If CBool ( InStr ( ObjectJson , " /content/v2/music/ " ) ) = False Then
SetStatusLabel ( " Status: Failed - no video, check CR login " )
Me . Text = " Status: Failed - no video, check CR login "
Debug . WriteLine ( " Status: Failed - no video, check CR login " )
Exit Sub
End If
2023-01-07 19:04:56 +01:00
2023-08-10 13:16:55 +02:00
'Try
Dim StreamsUrlBuilder ( ) As String = ObjectJson . Split ( New String ( ) { " /content/v2/music/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StreamsUrlBuilder2 ( ) As String = StreamsUrlBuilder ( 1 ) . Split ( New String ( ) { " /streams " } , System . StringSplitOptions . RemoveEmptyEntries )
2023-01-07 19:04:56 +01:00
2023-08-10 13:16:55 +02:00
StreamsUrl = " https://www.crunchyroll.com/content/v2/music/ " + StreamsUrlBuilder2 ( 0 ) + " /streams?locale= " + locale
GetCRVideoProxy ( StreamsUrl , Auth2 , url , RT_Count )
#End Region
ElseIf CBool ( InStr ( url , " crunchyroll.com " ) ) = True And CBool ( InStr ( url , " concert/ " ) ) = True And CBool ( CrBetaBasic = Nothing ) = False Then
2024-04-28 21:29:33 +02:00
#Region "concert"
SetStatusLabel ( " Status: Url match - Concert " )
2023-08-10 13:16:55 +02:00
Dim ObjectsUrl As String = Nothing
Dim ObjectsURLBuilder3 ( ) As String = url . Split ( New String ( ) { " concert/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim ObjectsURLBuilder4 ( ) As String = ObjectsURLBuilder3 ( 1 ) . Split ( New String ( ) { " / " } , System . StringSplitOptions . RemoveEmptyEntries )
ObjectsUrl = " https://www.crunchyroll.com/content/v2/music/concerts/ " + ObjectsURLBuilder4 ( 0 ) + " ?locale= " + locale
Debug . WriteLine ( " ObjectsUrl: " + ObjectsUrl )
Dim StreamsUrl As String = Nothing
Dim ObjectJson As String
Try
ObjectJson = CurlAuthNew ( ObjectsUrl , Loc_CR_Cookies , Auth2 )
Catch ex As Exception
If CBool ( InStr ( ex . ToString , " Error - Getting " ) ) Then
MsgBox ( " Error invalid CR respone " )
Exit Sub
Else
MsgBox ( " Error processing data " )
Exit Sub
End If
End Try
If CBool ( InStr ( ObjectJson , " /content/v2/music/ " ) ) = False Then
SetStatusLabel ( " Status: Failed - no video, check CR login " )
Me . Text = " Status: Failed - no video, check CR login "
Debug . WriteLine ( " Status: Failed - no video, check CR login " )
Exit Sub
End If
'Try
Dim StreamsUrlBuilder ( ) As String = ObjectJson . Split ( New String ( ) { " /content/v2/music/ " } , System . StringSplitOptions . RemoveEmptyEntries )
Dim StreamsUrlBuilder2 ( ) As String = StreamsUrlBuilder ( 1 ) . Split ( New String ( ) { " /streams " } , System . StringSplitOptions . RemoveEmptyEntries )
StreamsUrl = " https://www.crunchyroll.com/content/v2/music/ " + StreamsUrlBuilder2 ( 0 ) + " /streams?locale= " + locale
GetCRVideoProxy ( StreamsUrl , Auth2 , url , RT_Count )
2024-04-28 21:29:33 +02:00
#End Region
2023-01-07 19:04:56 +01:00
Else
2024-04-28 21:29:33 +02:00
'Browser.WebView2.CoreWebView2.Navigate(url)
2023-01-07 19:04:56 +01:00
End If
2023-02-07 14:31:23 +01:00
2023-01-07 19:04:56 +01:00
End Sub
2023-02-07 14:31:23 +01:00
2023-01-07 19:04:56 +01:00
Public Function GetCookiesFromFile ( ByVal Host As String ) As String
Dim Cookies As String = " Cookie: "
Dim Cookie_txt As String = My . Computer . FileSystem . ReadAllText ( " cookies.txt " )
Dim LineChar As String = vbCrLf
If CBool ( InStr ( Cookie_txt , vbCr ) ) Then
LineChar = vbCr
'Debug.WriteLine("vbCr")
ElseIf CBool ( InStr ( Cookie_txt , vbLf ) ) Then
LineChar = vbLf
'Debug.WriteLine("vbLf")
End If
Dim Cookie_txt1 ( ) As String = Cookie_txt . Split ( New String ( ) { LineChar } , System . StringSplitOptions . RemoveEmptyEntries )
Debug . WriteLine ( " got txt " )
For i As Integer = 0 To Cookie_txt1 . Count - 1
Dim Cookie_txt2 ( ) As String = Cookie_txt1 ( i ) . Split ( New String ( ) { Chr ( 9 ) } , System . StringSplitOptions . RemoveEmptyEntries )
If CBool ( InStr ( Cookie_txt2 ( 0 ) , Host ) ) = True Then
If CBool ( InStr ( Cookie_txt2 ( 5 ) , " _evidon_suppress " ) ) = True Then
Continue For
End If
Cookies = Cookies + Cookie_txt2 ( 5 ) + " = " + Cookie_txt2 ( 6 ) + " ; "
End If
Next
'Debug.WriteLine(Cookies)
Return Cookies
End Function
Sub SetStatusLabel ( ByVal txt As String )
If Application . OpenForms ( ) . OfType ( Of Anime_Add ) . Any = True Then
Anime_Add . StatusLabel . Text = txt
End If
2024-04-28 21:29:33 +02:00
Me . Text = txt
Debug . WriteLine ( " StatusLabel: " + Date . Now . ToString + " - " + txt )
2023-01-07 19:04:56 +01:00
End Sub
2023-02-16 20:56:58 +01:00
Private Sub SaveThumbnailAsImageToolStripMenuItem_Click ( sender As Object , e As EventArgs ) Handles SaveThumbnailAsImageToolStripMenuItem . Click
If My . Settings . SaveThumbnail = False Then
My . Settings . SaveThumbnail = True
MsgBox ( " Thumbnails will be saved into the video folder " )
My . Settings . Save ( )
Else
My . Settings . SaveThumbnail = False
MsgBox ( " Thumbnail saving disabled " )
My . Settings . Save ( )
End If
End Sub
2023-03-23 13:49:11 +01:00
Private Sub Panel1_Paint ( sender As Object , e As PaintEventArgs ) Handles Panel1 . Paint
End Sub
2023-06-24 23:50:39 +02:00
Private Sub Main_Closing ( sender As Object , e As CancelEventArgs ) Handles Me . Closing
End Sub
2023-08-30 18:40:53 +02:00
Private Sub AudioOnlyQualityToolStripMenuItem_Click ( sender As Object , e As EventArgs ) Handles AudioOnlyQualityToolStripMenuItem . Click
Me . Invoke ( New Action ( Function ( ) As Object
' ResoNotFoundString = VideoJson
DialogTaskString = " AudioOnlyResolution "
ErrorDialog . ShowDialog ( )
Return Nothing
End Function ) )
If UserCloseDialog = True Then
'Throw New System.Exception(Chr(34) + "UserAbort" + Chr(34))
Else
MsgBox ( ResoBackString )
My . Settings . AudioOnlyReso = ResoBackString
ResoBackString = Nothing
End If
End Sub
2023-09-10 16:28:23 +02:00
Public Sub ProcessLocal ( ByVal Input As String )
Dim Pfad2 As String = Input . Replace ( Path . GetExtension ( Input ) , VideoFormat )
If File . Exists ( Pfad2 ) = True Then
Pfad2 = Input . Replace ( Path . GetExtension ( Input ) , GeräteID ( ) . Replace ( " CRD-Temp-File- " , " " ) ) + VideoFormat
End If
Dim ffmpegInput As String = " -i " + Chr ( 34 ) + Input + Chr ( 34 ) + ffmpeg_command
Me . Invoke ( New Action ( Function ( ) As Object
ListItemAdd ( Path . GetFileName ( Pfad2 . Replace ( Chr ( 34 ) , " " ) ) , " Local " , Path . GetFileName ( Pfad2 . Replace ( Chr ( 34 ) , " " ) ) , " Local " , " unkown " , " non " , ffmpegInput , Chr ( 34 ) + Pfad2 + Chr ( 34 ) )
Return Nothing
End Function ) )
End Sub
2023-12-15 16:53:07 +01:00
2024-04-21 18:03:13 +02:00
Private Sub LoginFormToolStripMenuItem_Click ( sender As Object , e As EventArgs ) Handles LoginFormToolStripMenuItem . Click
LoginForm . ShowDialog ( )
End Sub
2023-12-15 16:53:07 +01:00
2023-01-07 19:04:56 +01:00
#End Region
2022-12-05 18:16:07 +01:00
End Class
2022-05-02 18:37:40 +02:00