Mirrors/Crunchyroll-Downloader-v3.0
2
0
Fork 0
mirror of https://github.com/hama3254/Crunchyroll-Downloader-v3.0.git synced 2024-12-23 22:51:48 +01:00
Code Issues Packages Projects Releases Wiki Activity

hybrid mode for #EXT-X-VERSION:4

Browse Source 
added hybrid mode for #EXT-X-VERSION:4
removed old hybrid mode for #EXT-X-VERSION:3 (needs to be redone)
This commit is contained in:
hama3254 2021-04-24 20:51:34 +02:00
parent 2bf5ee0a4c
commit b659133761
25 changed files with 653 additions and 716 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
.vs/Crunchyroll Downloader/v15/.suo
View File

Binary file not shown.

BIN
.vs/Crunchyroll Downloader/v15/Server/sqlite3/storage.ide
View File

Binary file not shown.

BIN
.vs/Crunchyroll Downloader/v15/Server/sqlite3/storage.ide-shm
View File

Binary file not shown.

BIN
.vs/Crunchyroll Downloader/v15/Server/sqlite3/storage.ide-wal
View File

Binary file not shown.

27
Crunchyroll Downloader/ApplicationEvents.vb
View File

@ -14,19 +14,19 @@ Namespace My
' StartupNextInstance: Raised when launching a single-instance application and the application is already active.
' NetworkAvailabilityChanged: Raised when the network connection is connected or disconnected.
Partial Friend Class MyApplication
Dim UseFirefoxProfile As Boolean = False
'Dim UseFirefoxProfile As Boolean = True
Protected Overrides Function OnStartup(ByVal eventArgs As Microsoft.VisualBasic.ApplicationServices.StartupEventArgs) As Boolean
Dim ProfileDirectory As String = Path.Combine(GetFolderPath(SpecialFolder.ApplicationData), "Mozilla", "Firefox", "Profiles", "CRD")
If UseFirefoxProfile = True Then
Dim di As New System.IO.DirectoryInfo(Path.Combine(GetFolderPath(SpecialFolder.ApplicationData), "Mozilla", "Firefox", "Profiles"))
Try
For Each fi As System.IO.DirectoryInfo In di.EnumerateDirectories("*.*", System.IO.SearchOption.TopDirectoryOnly)
Dim TempPath As String = Path.Combine(GetFolderPath(SpecialFolder.ApplicationData), "Mozilla", "Firefox", "Profiles", fi.Name)
ProfileDirectory = TempPath
Next
Catch ex As Exception
End Try
End If
'If UseFirefoxProfile = True Then
' Dim di As New System.IO.DirectoryInfo(Path.Combine(GetFolderPath(SpecialFolder.ApplicationData), "Mozilla", "Firefox", "Profiles"))
' Try
' For Each fi As System.IO.DirectoryInfo In di.EnumerateDirectories("*.*", System.IO.SearchOption.TopDirectoryOnly)
' Dim TempPath As String = Path.Combine(GetFolderPath(SpecialFolder.ApplicationData), "Mozilla", "Firefox", "Profiles", fi.Name)
' ProfileDirectory = TempPath
' Next
' Catch ex As Exception
' End Try
'End If
'MsgBox(ProfileDirectory)
If Not Directory.Exists(ProfileDirectory) Then
Directory.CreateDirectory(ProfileDirectory)
@ -34,11 +34,12 @@ Namespace My
Try
Dim sUserAgent As String = "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:84.0) Gecko/20100101 Firefox/84.0"
Dim sUserAgent As String = My.Resources.ffmpeg_user_agend.Replace("User-Agent: ", "").Replace(Chr(34), "") '"Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:84.0) Gecko/20100101 Firefox/84.0"
'sUserAgent = "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/44.0.2403.157 Safari/537.36"
Xpcom.ProfileDirectory = ProfileDirectory
Xpcom.Initialize("Firefox")
'MsgBox(Xpcom.XulRunnerVersion)
Xpcom.ProfileDirectory = ProfileDirectory
'Dim File As nsIFile = CType(Xpcom.NewNativeLocalFile("E:\addon\"), nsIFile)
'File.Append(New nsAString("manifest.json"))
'Xpcom.ComponentRegistrar.AutoRegister(File)

632
Crunchyroll Downloader/CRD_List_Item.vb
View File

@ -13,8 +13,6 @@ Public Class CRD_List_Item
Inherits Controls.MetroUserControl
Dim ZeitGesamtInteger As Integer = 0
Dim ListOfStreams As New List(Of String)
Dim proc As Process
@ -52,6 +50,11 @@ Public Class CRD_List_Item
Dim FailedSegments As New List(Of FailedSegemtsWithURL)
Dim LogText As New List(Of String)
Dim PauseTime As Integer = 0
Dim Threads As Integer = Environment.ProcessorCount / 2 - 1
#Region "Remove from list"
Public Sub DisposeItem(ByVal Dispose As Boolean)
If Dispose = True Then
@ -388,6 +391,9 @@ Public Class CRD_List_Item
End Sub
Private Sub Item_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.ContextMenuStrip = ContextMenuStrip1 '.ContextMenu
If Threads < 2 Then
Threads = 2
End If
'bt_del.SetBounds(775, 10, 35, 29)
'bt_pause.SetBounds(740, 15, 25, 20)
'PB_Thumbnail.SetBounds(11, 20, 168, 95)
@ -485,7 +491,7 @@ Public Class CRD_List_Item
End Try
End Sub
Private Function TS_StatusAsync(ByVal prozent As Integer, ByVal di As IO.DirectoryInfo, ByVal Filename As String, ByVal pausetime As Integer)
Private Function TS_StatusAsync(ByVal prozent As Integer, ByVal di As IO.DirectoryInfo, ByVal pausetime As Integer)
'Dim Now As Date = Date.Now
Dim FinishedSize As Double = 0
@ -493,7 +499,7 @@ Public Class CRD_List_Item
Try
Dim aryFi As IO.FileInfo() = di.GetFiles("*.ts")
Dim aryFi As IO.FileInfo() = di.GetFiles("*.*")
Dim fi As IO.FileInfo
For Each fi In aryFi
FinishedSize = FinishedSize + fi.Length 'Math.Round(fi.Length / 1048576, 2, MidpointRounding.AwayFromZero).ToString()
@ -558,412 +564,258 @@ Public Class CRD_List_Item
End Function
Public Function DownloadHybrid(ByVal DL_URL As String, ByVal DL_Pfad As String, ByVal Filename As String) As String
MsgBox(DL_URL)
Dim Folder As String = Einstellungen.GeräteID()
Dim Pfad2 As String = Path.GetDirectoryName(DL_Pfad.Replace(Chr(34), "")) + "\" + Folder + "\"
If Not Directory.Exists(Path.GetDirectoryName(Pfad2)) Then
Private Function GetFullUri(ByVal MainUri As String, ByVal CurrentPath As String)
Dim path As String = Nothing
If InStr(CurrentPath, "../") Then
Dim countDot() As String = CurrentPath.Split(New String() {"./"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim c() As String = New Uri(MainUri).Segments
path = "https://" + New Uri(MainUri).Host
For i3 As Integer = 0 To c.Count - (2 + countDot.Count - 1)
path = path + c(i3)
Next
path = path + countDot(countDot.Count - 1)
Else
Dim c() As String = New Uri(MainUri).Segments
path = "https://" + New Uri(MainUri).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
End If
Return path
End Function
Private Function ProcessV4(ByVal InputData As String, ByVal Folder As String) As String
If Not Directory.Exists(Path.GetDirectoryName(Folder)) Then
' Nein! Jetzt erstellen...
Try
Directory.CreateDirectory(Path.GetDirectoryName(Pfad2))
Directory.CreateDirectory(Path.GetDirectoryName(Folder))
Catch ex As Exception
MsgBox("Temp folder creation failed")
Return Nothing
Debug.WriteLine("folder issue")
Return "Error"
Exit Function
' Ordner wurde nich erstellt
'Pfad2 = Pfad + "\" + CR_FilenName_Backup + ".mp4"
End Try
End If
Dim MergeSub As String() = DL_URL.Split(New String() {"-i " + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
If MergeSub.Count > 1 Then
Me.Invoke(New Action(Function()
Label_percent.Text = "Downloading Subtitles..."
Return Nothing
End Function))
For i As Integer = 1 To MergeSub.Count - 1
Dim SubsURL As String() = MergeSub(i).Split(New [Char]() {Chr(34)})
Dim SubsClient As New WebClient
SubsClient.Encoding = Encoding.UTF8
If Main.WebbrowserCookie = Nothing Then
Else
SubsClient.Headers.Add(HttpRequestHeader.Cookie, Main.WebbrowserCookie)
End If
Dim SubsFile As String = Einstellungen.GeräteID() + ".txt"
Dim KeyFile As String = Einstellungen.GeräteID + ".key"
Dim KeyFilePath As String = Application.StartupPath + "\" + KeyFile 'needs to be in the ffmpeg/downloader directory
Dim Fragments() As String = InputData.Split(New String() {"#EXT-X-BYTERANGE:"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim FragmentsInt As Integer = Fragments.Count - 2
Dim retry As Boolean = True
Dim retryCount As Integer = 3
While retry
Try
SubsClient.DownloadFile(SubsURL(0), Pfad2 + "\" + SubsFile)
retry = False
Catch ex As Exception
If retryCount > 0 Then
retryCount = retryCount - 1
Dim di As New IO.DirectoryInfo(Folder)
Dim m3u8FileContent As String = Nothing
Dim Client As New WebClient
Client.Encoding = Encoding.UTF8
Client.Headers.Add(My.Resources.ffmpeg_user_agend.Replace(Chr(34), ""))
Dim m3u8Text As String = InputData
Dim m3u8Key() As String = m3u8Text.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim m3u8Key2() As String = m3u8Key(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Client.DownloadFile(m3u8Key2(0), KeyFilePath)
Dim StreamFile() As String = m3u8Text.Split(New String() {"https://"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim StreamFile2() As String = StreamFile(2).Split(New String() {vbLf}, System.StringSplitOptions.RemoveEmptyEntries)
Dim DownloadFile As String = "https:\\" + StreamFile2(0)
Dim text() As String = m3u8Text.Split(New String() {vbLf}, System.StringSplitOptions.RemoveEmptyEntries)
Dim zeile As String
Dim Count As Integer = 0
For i As Integer = 0 To text.Count - 1
zeile = text(i)
For w As Integer = 0 To Integer.MaxValue
If StatusRunning = False Then
'MsgBox(True.ToString)
Thread.Sleep(5000)
PauseTime = PauseTime + 5
ElseIf ThreadList.Count > Threads Then
Thread.Sleep(50)
ElseIf Canceld = True Then
For www As Integer = 0 To Integer.MaxValue
If ThreadList.Count > 0 Then
Thread.Sleep(250)
Else
Try
System.IO.Directory.Delete(HybridModePath, True)
Catch ex As Exception
End Try
Me.Invoke(New Action(Function()
Label_percent.Text = "Error Downloading Subtitles - retrying"
ProgressBar1.Value = 0
Label_percent.Text = "canceled -%"
bt_pause.BackgroundImage = My.Resources.main_pause_play
Return Nothing
End Function))
Else
Dim utf8WithoutBom2 As New System.Text.UTF8Encoding(False)
Using sink As New StreamWriter(SubsFile, False, utf8WithoutBom2)
sink.WriteLine(My.Resources.ass_template)
End Using
retry = False
Exit For
End If
End Try
End While
DL_URL = DL_URL.Replace(SubsURL(0), Pfad2 + "\" + SubsFile)
Next
Next
Return Nothing
Exit Function
End If
Dim m3u8_url As String() = DL_URL.Split(New [Char]() {Chr(34)})
Dim m3u8_url_1 As String = Nothing
Dim m3u8_url_3 As String = m3u8_url(1)
If Debug2 = True Then
MsgBox(m3u8_url(1) + vbNewLine + DL_Pfad + vbNewLine + Filename)
End If
'Dim client0 As New WebClient
'client0.Encoding = Encoding.UTF8
Dim text As String = Nothing
'Try
' text = client0.DownloadString(m3u8_url(1))
'Catch ex As Exception
' Me.Invoke(New Action(Function()
' Label_website.Text = "Hybrid mode error"
' Label_percent.Text = ex.ToString
' Return Nothing
' End Function))
' Return Nothing
' Exit Function
'End Try
Try
Using client As New WebClient()
client.Headers.Add(My.Resources.ffmpeg_user_agend.Replace(Chr(34), ""))
client.Headers.Add("ACCEPT: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8")
client.Headers.Add("ACCEPT-ENCODING: *")
'client.DownloadFile(TextBox1.Text, "test.m3u8")
'Dim archive As Zipfi = New ZipArchive(ms)
'Dim m3u8String As String = client.DownloadString(TextBox1.Text)
'MsgBox(DL_URL)
'MsgBox(m3u8_url(1))
Try
Dim m3u8 As String = DecompressString(client.DownloadData(m3u8_url(1)))
text = m3u8
Catch ex As Exception
Dim m3u8 As String = client.DownloadString(m3u8_url(1))
text = m3u8
End Try
'MsgBox(m3u8)
End Using
Catch ex As Exception
MsgBox(ex.ToString)
End Try
If InStr(text, "RESOLUTION=") Then 'master m3u8 no fragments
'My.Computer.FileSystem.WriteAllText(Application.StartupPath + "\log.txt", text, False)
Dim new_m3u8_2() As String = text.Split(New String() {vbLf}, System.StringSplitOptions.RemoveEmptyEntries)
If TargetReso = 42 Then
TargetReso = 1080
End If
For i As Integer = 0 To new_m3u8_2.Count - 1
'MsgBox("x" + Main.Resu.ToString)
If CBool(InStr(new_m3u8_2(i), "x" + TargetReso.ToString)) = True Then
m3u8_url_1 = new_m3u8_2(i + 1)
Else
Thread.Sleep(ServiceSleep)
Exit For
End If
Next
If InStr(m3u8_url_1, "https://") Then
Try
Using client As New WebClient()
client.Headers.Add(My.Resources.ffmpeg_user_agend.Replace(Chr(34), ""))
client.Headers.Add("ACCEPT: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8")
client.Headers.Add("ACCEPT-ENCODING: *")
'client.DownloadFile(TextBox1.Text, "test.m3u8")
'Dim archive As Zipfi = New ZipArchive(ms)
'Dim m3u8String As String = client.DownloadString(TextBox1.Text)
Try
Dim m3u8 As String = DecompressString(client.DownloadData(m3u8_url(1)))
text = m3u8
Catch ex As Exception
Dim m3u8 As String = client.DownloadString(m3u8_url(1))
text = m3u8
End Try
'Dim m3u8 As String = DecompressString(client.DownloadData(m3u8_url(1)))
'text = m3u8
'MsgBox(m3u8)
End Using
Catch ex As Exception
MsgBox(ex.ToString)
End Try
Else
'MsgBox("false postive")
Dim c() As String = New Uri(m3u8_url_3).Segments
Dim path As String = "https://" + New Uri(m3u8_url_3).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
m3u8_url_3 = path + m3u8_url_1
'MsgBox(m3u8_url_3)
Try
Using client As New WebClient()
client.Headers.Add(My.Resources.ffmpeg_user_agend.Replace(Chr(34), ""))
client.Headers.Add("ACCEPT: text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8")
client.Headers.Add("ACCEPT-ENCODING: *")
'client.DownloadFile(TextBox1.Text, "test.m3u8")
'Dim archive As Zipfi = New ZipArchive(ms)
'Dim m3u8String As String = client.DownloadString(TextBox1.Text)
Try
Dim m3u8 As String = DecompressString(client.DownloadData(m3u8_url(1)))
text = m3u8
Catch ex As Exception
Dim m3u8 As String = client.DownloadString(m3u8_url(1))
text = m3u8
End Try
'MsgBox(m3u8)
End Using
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End If
If zeile.Contains("#EXT-X-BYTERANGE:") Then
Dim Zeile2 As String = zeile.Replace("#EXT-X-BYTERANGE:", "")
Dim Zeile3() As String = Zeile2.Split(New String() {"@"}, System.StringSplitOptions.RemoveEmptyEntries)
End If
Dim LoadedKeys As New List(Of String)
LoadedKeys.Add("Nothing")
Dim KeyFileCache As String = Nothing
Dim textLenght() As String = text.Split(New String() {vbLf}, System.StringSplitOptions.RemoveEmptyEntries)
Dim Fragments() As String = text.Split(New String() {".ts"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim FragmentsInt As Integer = Fragments.Count - 2
Dim nummerint As Integer = 0 '-1
Dim m3u8FFmpeg As String = Nothing
Dim ts_dl As String = Nothing
HybridModePath = Pfad2
If Debug2 = True Then
MsgBox(Pfad2)
End If
Dim PauseTime As Integer = 0
Dim Threads As Integer = Environment.ProcessorCount / 2 - 1
If Threads < 2 Then
Threads = 2
End If
'Threads = textLenght.Length / 20
Dim di As New IO.DirectoryInfo(Pfad2)
For i As Integer = 0 To textLenght.Length - 1
If InStr(textLenght(i), ".ts") Then
For w As Integer = 0 To Integer.MaxValue
If StatusRunning = False Then
'MsgBox(True.ToString)
Thread.Sleep(5000)
PauseTime = PauseTime + 5
ElseIf ThreadList.Count > Threads Then
Thread.Sleep(50)
ElseIf Canceld = True Then
For www As Integer = 0 To Integer.MaxValue
If ThreadList.Count > 0 Then
Thread.Sleep(250)
Else
Try
System.IO.Directory.Delete(HybridModePath, True)
Catch ex As Exception
End Try
Me.Invoke(New Action(Function()
ProgressBar1.Value = 0
Label_percent.Text = "canceled -%"
bt_pause.BackgroundImage = My.Resources.main_pause_play
Return Nothing
End Function))
Exit For
End If
Next
Return Nothing
Exit Function
'ElseIf nummerint < Threads Then
' Thread.Sleep(2000)
' Exit For
Else
Thread.Sleep(ServiceSleep)
Exit For
End If
Next
nummerint = nummerint + 1
Dim nummer4D As String = String.Format("{0:0000}", nummerint)
Dim curi As String = textLenght(i)
If InStr(curi, "https://") Then
ElseIf InStr(curi, "../") Then
Dim countDot() As String = curi.Split(New String() {"./"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim c() As String = New Uri(m3u8_url_3).Segments
Dim path As String = "https://" + New Uri(m3u8_url_3).Host
For i3 As Integer = 0 To c.Count - (2 + countDot.Count - 1)
path = path + c(i3)
Next
curi = path + countDot(countDot.Count - 1)
Else
Dim c() As String = New Uri(m3u8_url_3).Segments
Dim path As String = "https://" + New Uri(m3u8_url_3).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
curi = path + textLenght(i)
End If
Dim Evaluator = New Thread(Sub() Me.TS_DownloadAsync(curi, Pfad2 + nummer4D + ".ts"))
Dim CurrentSize As Integer = Integer.Parse(Zeile3(1))
Dim NewBytes As Integer = Integer.Parse(Zeile3(0))
Dim File As String = Folder + String.Format("{0:0000}", Count)
Dim Evaluator = New Thread(Sub() Me.DownloadTSv4(DownloadFile, File, CurrentSize, NewBytes))
Evaluator.Start()
ThreadList.Add(Evaluator)
m3u8FFmpeg = m3u8FFmpeg + Pfad2 + nummer4D + ".ts" + vbLf '+ "#" + curi + vbLf
m3u8FileContent = m3u8FileContent + File + vbNewLine
Dim FragmentsFinised = nummerint / FragmentsInt * 100 '(ThreadList.Count + nummerint) / FragmentsInt * 100
Dim Update = New Thread(Sub() Me.TS_StatusAsync(FragmentsFinised, di, Filename, PauseTime))
Count = Count + 1
Dim FragmentsFinised = Count * 100 / FragmentsInt
Dim Update = New Thread(Sub() Me.TS_StatusAsync(FragmentsFinised, di, PauseTime))
Update.Start()
ElseIf zeile.Contains("URI=" + Chr(34)) Then
Dim Zeile2() As String = zeile.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
m3u8FileContent = m3u8FileContent + Zeile2(0) + "URI=" + Chr(34) + KeyFile + Chr(34) + vbNewLine ' a full path does not work here, that's why KeyFilePath is in the ffmpeg/downloader folder
ElseIf textLenght(i) = "#EXT-X-PLAYLIST-TYPE:VOD" Then
ElseIf InStr(textLenght(i), "URI=" + Chr(34)) Then
Dim KeyLine As String = textLenght(i)
If InStr(KeyLine, "https://") Then
Dim KeyFile() As String = KeyLine.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim KeyFile2() As String = KeyFile(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
If LoadedKeys.Item(LoadedKeys.Count - 1) = KeyFile2(0) Then
Else
Dim KeyClient As New WebClient
KeyClient.Encoding = Encoding.UTF8
If Main.WebbrowserCookie = Nothing Then
Else
KeyClient.Headers.Add(HttpRequestHeader.Cookie, Main.WebbrowserCookie)
End If
Dim KeyFile3 As String = Einstellungen.GeräteID() + ".key"
KeyFileCache = KeyFile3
Dim retry As Boolean = True
Dim retryCount As Integer = 3
While retry
Try
KeyClient.DownloadFile(KeyFile2(0), Application.StartupPath + "\" + KeyFile3)
retry = False
Catch ex As Exception
If retryCount > 0 Then
retryCount = retryCount - 1
Me.Invoke(New Action(Function()
Label_percent.Text = "Access Error - retrying"
Debug.WriteLine(ex.ToString)
Return Nothing
End Function))
Else
'retry = False
Me.Invoke(New Action(Function()
Label_percent.Text = "Access Error - download canceled"
Debug.WriteLine(ex.ToString)
Return Nothing
End Function))
Return Nothing
Exit Function
End If
End Try
End While
LoadedKeys.Add(KeyFile2(0))
End If
If KeyFile2.Count > 1 Then
KeyLine = KeyFile(0) + "URI=" + Chr(34) + KeyFileCache + Chr(34) + KeyFile2(1)
Else
KeyLine = KeyFile(0) + "URI=" + Chr(34) + KeyFileCache + Chr(34)
End If
'ElseIf InStr(KeyLine, "../") Then
' Dim countDot() As String = KeyLine.Split(New String() {"./"}, System.StringSplitOptions.RemoveEmptyEntries)
' Dim c() As String = New Uri(m3u8_url_3).Segments
' Dim path As String = "https://" + New Uri(m3u8_url_3).Host
' For i3 As Integer = 0 To c.Count - (2 + countDot.Count - 1)
' path = path + c(i3)
' Next
' KeyLine = path + countDot(countDot.Count - 1)
Else
Dim c() As String = New Uri(m3u8_url_3).Segments
Dim path As String = "https://" + New Uri(m3u8_url_3).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
KeyLine = KeyLine.Replace("URI=" + Chr(34), "URI=" + Chr(34) + path) 'path + textLenght(i)
Dim KeyFile() As String = KeyLine.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim KeyFile2() As String = KeyFile(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
If LoadedKeys.Item(LoadedKeys.Count - 1) = KeyFile2(0) Then
Else
Dim KeyClient As New WebClient
KeyClient.Encoding = Encoding.UTF8
If Main.WebbrowserCookie = Nothing Then
Else
KeyClient.Headers.Add(HttpRequestHeader.Cookie, Main.WebbrowserCookie)
End If
Dim KeyFile3 As String = Einstellungen.GeräteID() + ".key"
KeyFileCache = KeyFile3
Dim retry As Boolean = True
Dim retryCount As Integer = 3
Try
KeyClient.DownloadFile(KeyFile2(0), Application.StartupPath + "\" + KeyFile3)
retry = False
Catch ex As Exception
If retryCount > 0 Then
retryCount = retryCount - 1
Me.Invoke(New Action(Function()
Label_percent.Text = "Access Error - retrying"
Debug.WriteLine(ex.ToString)
Return Nothing
End Function))
Else
Me.Invoke(New Action(Function()
Label_percent.Text = "Access Error - download canceled"
Debug.WriteLine(ex.ToString)
Return Nothing
End Function))
Return Nothing
Exit Function
'Dim utf8WithoutBom2 As New System.Text.UTF8Encoding(False)
'Using sink As New StreamWriter(SubsFile, False, utf8WithoutBom2)
' sink.WriteLine(My.Resources.ass_template)
'End Using
'Retry = False
End If
End Try
'KeyClient.DownloadFile(KeyFile2(0), Application.StartupPath + "\" + KeyFile3)
LoadedKeys.Add(KeyFile2(0))
End If
If KeyFile2.Count > 1 Then
KeyLine = KeyFile(0) + "URI=" + Chr(34) + KeyFileCache + Chr(34) + KeyFile2(1)
Else
KeyLine = KeyFile(0) + "URI=" + Chr(34) + KeyFileCache + Chr(34)
End If
End If
m3u8FFmpeg = m3u8FFmpeg + KeyLine + vbLf
ElseIf zeile.Contains("https://") Then
'If zeile = DownloadFile Then
'Else
' DownloadFile = zeile
'End If
Else
m3u8FFmpeg = m3u8FFmpeg + textLenght(i) + vbLf
m3u8FileContent = m3u8FileContent + zeile + vbNewLine
End If
Next
My.Computer.FileSystem.WriteAllText(Application.StartupPath + "\m3u8FileContent.txt", m3u8FileContent, False)
Dim utf8WithoutBom As New System.Text.UTF8Encoding(False)
Using sink As New StreamWriter(Pfad2 + "\index" + Folder + ".m3u8", False, utf8WithoutBom)
sink.WriteLine(m3u8FFmpeg)
Using sink As New StreamWriter(Folder + "\index.m3u8", False, utf8WithoutBom)
sink.WriteLine(m3u8FileContent)
End Using
Return Folder + "\index.m3u8"
End Function
Private Sub DownloadTSv4(ByVal DL_URL As String, ByVal DL_Pfad As String, ByVal CurrentSize As Integer, ByVal NewBytes As Integer)
Dim retry As Boolean = True
Dim retryCount As Integer = 3
While retry
Try
Dim Request As Net.HttpWebRequest = Net.HttpWebRequest.Create(DL_URL)
Dim Bytes(NewBytes) As Byte
Request.UserAgent = My.Resources.ffmpeg_user_agend.Replace(Chr(34), "").Replace("User-Agent: ", "")
Request.Timeout = 30000
Request.Method = "GET"
Request.AddRange(CurrentSize, CurrentSize + NewBytes)
Dim Response As Net.HttpWebResponse = Request.GetResponse()
If Response.StatusCode = Net.HttpStatusCode.PartialContent Or Net.HttpStatusCode.OK Then
Using binaryReader As New BinaryReader(Response.GetResponseStream())
Bytes = binaryReader.ReadBytes(NewBytes)
binaryReader.Close()
End Using
End If
File.WriteAllBytes(DL_Pfad, Bytes)
retry = False
Catch ex As Exception
If retryCount > 0 Then
retryCount = retryCount - 1
Me.Invoke(New Action(Function()
Label_percent.Text = "Access Error - retrying"
Debug.WriteLine(ex.ToString)
Return Nothing
End Function))
Else
Me.Invoke(New Action(Function()
Label_percent.Text = "Access Error - download canceled"
Debug.WriteLine(ex.ToString)
Return Nothing
End Function))
End If
End Try
End While
End Sub
Public Function DownloadHybrid(ByVal DL_URL As String, ByVal DL_Pfad As String, ByVal Filename As String) As String
Dim Folder As String = Einstellungen.GeräteID()
Dim PauseTime As Integer = 0
Dim Pfad2 As String = Path.GetDirectoryName(DL_Pfad.Replace(Chr(34), "")) + "\" + Folder + "\"
Dim di As New IO.DirectoryInfo(Pfad2)
Dim m3u8_url As String() = DL_URL.Split(New [Char]() {Chr(34)})
Dim m3u8FFmpeg As String = Nothing
Dim InuputStreams As String() = DL_URL.Split(New String() {"-i " + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Me.Invoke(New Action(Function()
Label_percent.Text = "Checking input..."
Return Nothing
End Function))
For i As Integer = 0 To InuputStreams.Count - 1
Dim int As Integer = i
Dim InputURL As String() = InuputStreams(i).Split(New [Char]() {Chr(34)})
Dim InputClient As New WebClient
InputClient.Encoding = Encoding.UTF8
If Main.WebbrowserCookie = Nothing Then
Else
InputClient.Headers.Add(HttpRequestHeader.Cookie, Main.WebbrowserCookie)
End If
Dim SubsFile As String = Pfad2 + Einstellungen.GeräteID() + ".txt"
Try
Dim InputData As String = InputClient.DownloadString(InputURL(0))
If InStr(InputData, "#EXT-X-VERSION:3") Then
ElseIf InStr(InputData, "#EXT-X-VERSION:4") Then
ProcessV4(InputData, Pfad2 + "Stream-" + int.ToString + "\")
DL_URL = DL_URL.Replace("-i " + Chr(34) + InputURL(0), "-allowed_extensions ALL " + "-i " + Chr(34) + Pfad2 + "Stream-" + int.ToString + "\index.m3u8")
Else
'write string to file
Dim utf8WithoutBom2 As New System.Text.UTF8Encoding(False)
Using sink As New StreamWriter(SubsFile, False, utf8WithoutBom2)
sink.WriteLine(InputData)
End Using
'replace url with local file
DL_URL = DL_URL.Replace(InputURL(0), SubsFile)
End If
Catch ex As Exception
End Try
Next
For w As Integer = 0 To Integer.MaxValue
If ThreadList.Count > 0 Then
Thread.Sleep(250)
@ -972,25 +824,22 @@ Public Class CRD_List_Item
Exit For
End If
Next
TS_StatusAsync(100, di, Filename, PauseTime)
DL_URL = DL_URL.Replace(m3u8_url(1), Pfad2 + "index" + Folder + ".m3u8")
If InStr(DL_URL, "-headers " + My.Resources.ffmpeg_user_agend) Then
DL_URL = DL_URL.Replace("-headers " + My.Resources.ffmpeg_user_agend, "")
TS_StatusAsync(100, di, PauseTime)
If InStr(DL_URL, " -headers " + My.Resources.ffmpeg_user_agend) Then
DL_URL = DL_URL.Replace(" -headers " + My.Resources.ffmpeg_user_agend, "")
End If
'Using sink3 As New StreamWriter(Path.GetDirectoryName(DL_Pfad.Replace(Chr(34), "")) + "\hybridelog.log", False, utf8WithoutBom)
' sink3.WriteLine(HybrideLog)
'End Using
'MsgBox(DL_URL)
Dim exepath As String = Application.StartupPath + "\ffmpeg.exe"
Dim startinfo As New System.Diagnostics.ProcessStartInfo
Dim cmd As String = "-allowed_extensions ALL " + DL_URL + " " + DL_Pfad '+ " " + ffmpeg_command + " " + DL_Pfad 'start ffmpeg with command strFFCMD string
' MsgBox(cmd) -headers " + Chr(34) + "User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:81.0) Gecko/20100101 Firefox/81.0" + Chr(34) +
Dim cmd As String = DL_URL + " " + DL_Pfad
If Debug2 = True Then
MsgBox(cmd)
End If
@ -1020,6 +869,7 @@ Public Class CRD_List_Item
#End Region

11
Crunchyroll Downloader/ErrorDialog.vb
View File

@ -42,6 +42,10 @@ Public Class ErrorDialog
ElseIf Main.DialogTaskString = "Funimation_Resolution" Then
StatusLabel.Text = Main.LabelResoNotFoundText
'Try
' My.Computer.FileSystem.WriteAllText(Application.StartupPath + "\Funimation-Resolution.log", Main.ResoNotFoundString, True)
'Catch ex As Exception
'End Try
Dim ResoList As New List(Of String)
Dim m3u8_split As String() = Main.ResoNotFoundString.Split(New String() {vbLf}, System.StringSplitOptions.RemoveEmptyEntries)
For i As Integer = 0 To m3u8_split.Count - 1
@ -53,7 +57,12 @@ Public Class ErrorDialog
Dim Reso_avaible1 As String() = Main.ResoNotFoundString.Split(New String() {"RESOLUTION="}, System.StringSplitOptions.RemoveEmptyEntries)
For i As Integer = 0 To ResoList.Count - 1
Dim Reso_avaible As String() = ResoList.Item(i).Split(New String() {"RESOLUTION="}, System.StringSplitOptions.RemoveEmptyEntries)
ComboBox1.Items.Add(Reso_avaible(1))
If InStr(Reso_avaible(1), ",") Then
Dim Reso_avaible2 As String() = Reso_avaible(1).Split(New String() {","}, System.StringSplitOptions.RemoveEmptyEntries)
ComboBox1.Items.Add(Reso_avaible2(0))
Else
ComboBox1.Items.Add(Reso_avaible(1))
End If
Next
SurroundingSub()
Try

33
Crunchyroll Downloader/GeckoFX.vb
View File

@ -19,6 +19,7 @@ Public Class GeckoFX
Private Sub GeckoWebBrowser1_DocumentCompleted(sender As Object, e As EventArgs) Handles WebBrowser1.DocumentCompleted
Debug.WriteLine(Date.Now.ToString + "." + Date.Now.Millisecond.ToString)
'MsgBox("loaded!")
If ScanTrue = False Then
Button2.Enabled = True
@ -68,6 +69,7 @@ Public Class GeckoFX
Else
If CBool(InStr(WebBrowser1.Url.ToString, "beta.crunchyroll.com")) Then
Main.WebbrowserURL = WebBrowser1.Url.ToString
Exit Sub
ElseIf CBool(InStr(WebBrowser1.Url.ToString, "crunchyroll.com")) Then
@ -208,7 +210,7 @@ Public Class GeckoFX
End If
End If
End If
If Main.UserBowser = False Then
If Main.UserBowser = False Then
If Main.b = True Then
Anime_Add.StatusLabel.Text = "Status: idle"
Me.Close()
@ -253,7 +255,7 @@ Public Class GeckoFX
End Try
Main.UserBowser = True
'Main.UserBowser = True
'Main.Pause(15)
'For ii As Integer = 19 To 46
' WebBrowser1.Navigate("https://proxer.me/read/22459/" + ii.ToString + "/en/1")
@ -443,21 +445,26 @@ Public Class GeckoFX
If Main.BlockList.Contains(url.Host) Then
e.Cancel = True
Debug.WriteLine(requesturl)
'Debug.WriteLine(requesturl)
Exit Sub
ElseIf requesturl.Contains("ad_") Or requesturl.Contains("ads") Or requesturl.Contains(".swf") Then
ElseIf requesturl.Contains("ad_") Or requesturl.Contains("ads") Or requesturl.Contains(".swf") Or requesturl.Contains("unsupported") Then
e.Cancel = True
Debug.WriteLine(requesturl)
'Debug.WriteLine(requesturl)
Exit Sub
End If
If CBool(InStr(requesturl, ".js")) = True Then
Debug.WriteLine(requesturl)
End If
If CBool(InStr(requesturl, "https://beta-api.crunchyroll.com/")) And CBool(InStr(requesturl, "streams?")) Then
If Main.b = False Then
Main.GetBetaVideo(requesturl, WebBrowser1.Url.ToString)
Main.GetBetaVideo(requesturl, Main.WebbrowserURL)
Exit Sub
End If
ElseIf CBool(InStr(requesturl, "https://beta-api.crunchyroll.com/")) And CBool(InStr(requesturl, "seasons?series_id=")) Then
If Main.b = False Then
Main.WebbrowserURL = WebBrowser1.Url.ToString
'Main.WebbrowserURL = WebBrowser1.Url.ToString
Main.GetBetaSeasons(requesturl)
Exit Sub
End If
@ -514,6 +521,13 @@ Public Class GeckoFX
End If
If Main.UserBowser = False Then
If CBool(InStr(requesturl, ".jpg")) = True Or CBool(InStr(requesturl, ".bmp")) = True Or CBool(InStr(requesturl, ".gif")) = True Or CBool(InStr(requesturl, ".png")) = True Or CBool(InStr(requesturl, ".webp")) = True Then
e.Cancel = True
End If
End If
End Sub
@ -546,5 +560,10 @@ Public Class GeckoFX
CertOverrideService.GetService().RememberValidityOverride(e.Uri, e.Certificate, CertOverride.Mismatch, False)
End If
End Sub
Private Sub WebBrowser1_ConsoleMessage(sender As Object, e As ConsoleMessageEventArgs) Handles WebBrowser1.ConsoleMessage
' Debug.WriteLine(e.Message)
' MsgBox(e.Message)
End Sub
End Class

625
Crunchyroll Downloader/Main.vb
View File

@ -304,6 +304,7 @@ Public Class Main
End Sub
#End Region
Public Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Integer, ByVal dwVolume As Integer) As Integer
Public Sub SetSettingsTheme()
@ -1086,6 +1087,7 @@ Public Class Main
End Function
Public Function CCtoMP4CC(ByVal HardSub As String) As String
Try
If HardSub = "deDE" Then
Return "ger"
@ -1281,7 +1283,7 @@ Public Class Main
End If
'MsgBox(CR_FilenName)
@ -1311,6 +1313,8 @@ Public Class Main
' Ordner wurde nich erstellt
Pfad2 = Pfad + "\" + CR_FilenName + VideoFormat
End Try
Else
Pfad2 = Chr(34) + Pfad2 + CR_FilenName + VideoFormat + Chr(34)
End If
@ -1472,9 +1476,10 @@ Public Class Main
End If
Else
For i As Integer = 0 To SoftSubs2.Count - 1
Dim ii As Integer = i
Me.Invoke(New Action(Function()
Anime_Add.StatusLabel.Text = "Status: downloading subtitle file " + HardSubValuesToDisplay(SoftSubs2(i))
Me.Text = "Status: downloading subtitle file " + HardSubValuesToDisplay(SoftSubs2(i))
Anime_Add.StatusLabel.Text = "Status: downloading subtitle file " + HardSubValuesToDisplay(SoftSubs2(ii))
Me.Text = "Status: downloading subtitle file " + HardSubValuesToDisplay(SoftSubs2(ii))
Me.Invalidate()
Return Nothing
End Function))
@ -1883,11 +1888,17 @@ Public Class Main
End If
If Season_Prefix = "[default season prefix]" Then
CR_season_number = CR_season_title
Else
'My.Computer.Clipboard.SetText(ObjectJson)
'MsgBox(CR_season_title)
CR_season_number = Season_Prefix + CR_season_number
If Season_Prefix = "[default season prefix]" Then
If CR_season_title = CR_series_title Then
CR_season_number = CR_season_title + "Season " + CR_season_number
End If
CR_season_number = CR_season_title
Else
CR_season_number = Season_Prefix + CR_season_number
End If
@ -1950,82 +1961,17 @@ Public Class Main
' Ordner wurde nich erstellt
Pfad2 = Pfad + "\" + CR_FilenName + VideoFormat
End Try
Else
Pfad2 = Chr(34) + Pfad2 + CR_FilenName + VideoFormat + Chr(34)
End If
Pfad2 = Chr(34) + Pfad2 + CR_FilenName + VideoFormat + Chr(34)
#End Region
#Region "Subs" 'to be done
'Dim SoftSubs2 As New List(Of String)
'If SoftSubs.Count > 0 Then
' For i As Integer = 0 To SoftSubs.Count - 1
' If CBool(InStr(WebbrowserText, Chr(34) + "language" + Chr(34) + ":" + Chr(34) + SoftSubs(i) + Chr(34) + ",")) Then
' SoftSubs2.Add(SoftSubs(i))
' Else
' 'MsgBox("Softsubtitle for " + SoftSubs(i) + " is not avalible.", MsgBoxStyle.Information)
' End If
' Next
'End If
'If SubSprache = "None" Then
' If CBool(InStr(WebbrowserText, Chr(34) + "hardsub_lang" + Chr(34) + ":null")) Then
' SubSprache2 = "null"
' Else
' Me.Invoke(New Action(Function()
' ResoNotFoundString = WebbrowserText
' DialogTaskString = "Language"
' ErrorDialog.ShowDialog()
' Return Nothing
' End Function))
' If UserCloseDialog = True Then
' Throw New System.Exception(Chr(34) + "UserAbort" + Chr(34))
' Else
' If ResoBackString = Nothing Then
' Else
' SubSprache2 = ResoBackString
' End If
' End If
' 'Throw New System.Exception("Could not find the sub language")
' End If
'Else
' If CBool(InStr(WebbrowserText, Chr(34) + "hardsub_lang" + Chr(34) + ":" + Chr(34) + SubSprache + Chr(34) + ",")) Then
' SubSprache2 = Chr(34) + SubSprache + Chr(34)
' ElseIf CBool(InStr(WebbrowserText, Chr(34) + "language" + Chr(34) + ":" + Chr(34) + SubSprache + Chr(34) + ",")) Then
' If MessageBox.Show("It look like only Softsubtitle are avalibe." + vbNewLine + "Are you want to use Softsubtitle this time instead?", "No Hardsubtitle", MessageBoxButtons.YesNo) = DialogResult.Yes Then
' SubSprache2 = "null"
' SoftSubs2.Add(SubSprache)
' Else
' Throw New System.Exception("Could not find the sub language")
' End If
' Else
' Me.Invoke(New Action(Function()
' ResoNotFoundString = WebbrowserText
' DialogTaskString = "Language"
' ErrorDialog.ShowDialog()
' Return Nothing
' End Function))
' If UserCloseDialog = True Then
' Throw New System.Exception(Chr(34) + "UserAbort" + Chr(34))
' Else
' If ResoBackString = Nothing Then
' Else
' SubSprache2 = ResoBackString
' End If
' End If
' End If
'End If
#End Region
#Region "m3u8 suche"
#Region "VideoJson"
Dim VideoJson As String = Nothing
Try
@ -2039,7 +1985,106 @@ Public Class Main
Exit Sub
End Try
If CBool(InStr(VideoJson, "audio_locale")) Then ' false on movie true on series
Dim hls_type As String = Nothing
If CBool(InStr(VideoJson, Chr(34) + "adaptive_hls")) = True Then
hls_type = "adaptive_hls"
ElseIf CBool(InStr(VideoJson, Chr(34) + "multitrack_adaptive_hls_v2")) = True Then
hls_type = "multitrack_adaptive_hls_v2"
ElseIf CBool(InStr(VideoJson, Chr(34) + "vo_adaptive_hls")) = True Then
hls_type = "vo_adaptive_hls"
Else
MsgBox("No download stream avalible", MsgBoxStyle.Critical)
Exit Sub
End If
Dim LangNew As String = ConvertCC(SubSprache)
#End Region
#Region "Download softsub file or build ffmpeg cmd"
Dim SoftSubs2 As New List(Of String)
If SoftSubs.Count > 0 Then
For i As Integer = 0 To SoftSubs.Count - 1
If CBool(InStr(VideoJson, Chr(34) + "locale" + Chr(34) + ":" + Chr(34) + ConvertCC(SoftSubs(i)) + Chr(34) + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34))) Then
SoftSubs2.Add(SoftSubs(i))
Else
'MsgBox("Softsubtitle for " + SoftSubs(i) + " is not avalible.", MsgBoxStyle.Information)
End If
Next
End If
Dim SoftSubMergeURLs As String = Nothing
Dim SoftSubMergeMaps As String = " -map 0:v -map 0:a"
Dim SoftSubMergeMetatata As String = Nothing
If SoftSubs2.Count > 0 Then
If MergeSubs = True And SubsOnly = False Then
Dim DispositionIndex As Integer
For i As Integer = 0 To SoftSubs2.Count - 1
Debug.WriteLine(SoftSubs2(i))
If SoftSubs2(i) = DefaultSubCR Then
DispositionIndex = i
End If
Dim SoftSub As String() = VideoJson.Split(New String() {Chr(34) + "locale" + Chr(34) + ":" + Chr(34) + ConvertCC(SoftSubs2(i)) + Chr(34) + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim SoftSub_2 As String() = SoftSub(1).Split(New [Char]() {Chr(34)})
Dim SoftSub_3 As String = SoftSub_2(0).Replace("&amp;", "&").Replace("/u0026", "&").Replace("\u002F", "/").Replace("\u0026", "&")
If SoftSubMergeURLs = Nothing Then
SoftSubMergeURLs = " -i " + Chr(34) + SoftSub_3 + Chr(34)
Else
SoftSubMergeURLs = SoftSubMergeURLs + " -i " + Chr(34) + SoftSub_3 + Chr(34)
End If
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + (i + 1).ToString
If SoftSubMergeMetatata = Nothing Then
SoftSubMergeMetatata = " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSubs2(i)) + " -metadata:s:s:" + i.ToString + " title=" + Chr(34) + HardSubValuesToDisplay(SoftSubs2(i)) + Chr(34) + " -metadata:s:s:" + i.ToString + " handler_name=" + Chr(34) + HardSubValuesToDisplay(SoftSubs2(i)) + Chr(34)
Else
SoftSubMergeMetatata = SoftSubMergeMetatata + " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSubs2(i)) + " -metadata:s:s:" + i.ToString + " title=" + Chr(34) + HardSubValuesToDisplay(SoftSubs2(i)) + Chr(34) + " -metadata:s:s:" + i.ToString + " handler_name=" + Chr(34) + HardSubValuesToDisplay(SoftSubs2(i)) + Chr(34)
End If
Next
If DispositionIndex = Nothing Then
Else
SoftSubMergeMetatata = SoftSubMergeMetatata + " -disposition:s:" + DispositionIndex.ToString + " default"
End If
Else
For i As Integer = 0 To SoftSubs2.Count - 1
Dim i2 As Integer = i
Me.Invoke(New Action(Function()
Anime_Add.StatusLabel.Text = "Status: downloading subtitle file " + HardSubValuesToDisplay(SoftSubs2(i2))
Me.Text = "Status: downloading subtitle file " + HardSubValuesToDisplay(SoftSubs2(i2))
Me.Invalidate()
Return Nothing
End Function))
Dim SoftSub As String() = VideoJson.Split(New String() {Chr(34) + "locale" + Chr(34) + ":" + Chr(34) + ConvertCC(SoftSubs2(i)) + Chr(34) + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim SoftSub_2 As String() = SoftSub(1).Split(New [Char]() {Chr(34)})
Dim SoftSub_3 As String = SoftSub_2(0).Replace("&amp;", "&").Replace("/u0026", "&").Replace("\u002F", "/").Replace("\u0026", "&")
'MsgBox(SoftSub_3)
Dim client0 As New WebClient
client0.Encoding = Encoding.UTF8
Dim str0 As String = client0.DownloadString(SoftSub_3)
Dim Pfad3 As String = Pfad2.Replace(Chr(34), "")
Dim FN As String = Path.ChangeExtension(Path.Combine(Path.GetFileNameWithoutExtension(Pfad3) + " " + SoftSubs2(i) + Path.GetExtension(Pfad3)), "ass")
'MsgBox(FN)
If i = 0 Then
FN = Path.ChangeExtension(Path.GetFileName(Pfad3), "ass")
'MsgBox(FN)
End If
Dim Pfad4 As String = Path.Combine(Path.GetDirectoryName(Pfad3), FN)
'MsgBox(Pfad4)
File.WriteAllText(Pfad4, str0, Encoding.UTF8)
Pause(3)
Next
End If
End If
#End Region
#Region "m3u8 suche"
If CBool(InStr(VideoJson, "audio_locale")) Then
Dim CR_audio As String() = VideoJson.Split(New String() {"audio_locale" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim CR_audio2 As String() = CR_audio(1).Split(New String() {Chr(34) + ","}, System.StringSplitOptions.RemoveEmptyEntries) '(New [Char]() {"-"})
CR_audio_locale = String.Join(" ", CR_audio2(0).Split(invalids, StringSplitOptions.RemoveEmptyEntries)).TrimEnd("."c)
@ -2049,11 +2094,9 @@ Public Class Main
Dim CR_URI_Master As String = Nothing
'If SubsOnly = False Then
Dim ii As Integer = 0
'MsgBox(Chr(34) + "hardsub_lang" + Chr(34) + ":" + SubSprache2 + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34))
Dim CR_VideoJson As String() = VideoJson.Split(New String() {"adaptive_hls"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim CR_VideoJson As String() = VideoJson.Split(New String() {hls_type}, System.StringSplitOptions.RemoveEmptyEntries)
Dim CR_VideoJsonHardSubs As String() = CR_VideoJson(1).Split(New String() {"hardsub_locale" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim LangNew As String = ConvertCC(SubSprache)
Debug.WriteLine(LangNew)
Dim hls_List As New List(Of String)
For i As Integer = 0 To CR_VideoJsonHardSubs.Count - 1
@ -2084,70 +2127,6 @@ Public Class Main
'End If
#End Region
#Region "Download softsub file or build ffmpeg cmd"
'Dim SoftSubMergeURLs As String = Nothing
'Dim SoftSubMergeMaps As String = " -map 0:v -map 0:a"
'Dim SoftSubMergeMetatata As String = Nothing
'If SoftSubs2.Count > 0 Then
' If MergeSubs = True And SubsOnly = False Then
' Dim DispositionIndex As Integer
' For i As Integer = 0 To SoftSubs2.Count - 1
' Debug.WriteLine(SoftSubs2(i))
' If SoftSubs2(i) = DefaultSubCR Then
' DispositionIndex = i
' End If
' Dim SoftSub As String() = WebbrowserText.Split(New String() {Chr(34) + "language" + Chr(34) + ":" + Chr(34) + SoftSubs2(i) + Chr(34) + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
' Dim SoftSub_2 As String() = SoftSub(1).Split(New [Char]() {Chr(34)})
' Dim SoftSub_3 As String = SoftSub_2(0).Replace("\/", "/")
' If SoftSubMergeURLs = Nothing Then
' SoftSubMergeURLs = " -i " + Chr(34) + SoftSub_3 + Chr(34)
' Else
' SoftSubMergeURLs = SoftSubMergeURLs + " -i " + Chr(34) + SoftSub_3 + Chr(34)
' End If
' SoftSubMergeMaps = SoftSubMergeMaps + " -map " + (i + 1).ToString
' If SoftSubMergeMetatata = Nothing Then
' SoftSubMergeMetatata = " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSubs2(i)) + " -metadata:s:s:" + i.ToString + " title=" + Chr(34) + HardSubValuesToDisplay(SoftSubs2(i)) + Chr(34) + " -metadata:s:s:" + i.ToString + " handler_name=" + Chr(34) + HardSubValuesToDisplay(SoftSubs2(i)) + Chr(34)
' Else
' SoftSubMergeMetatata = SoftSubMergeMetatata + " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSubs2(i)) + " -metadata:s:s:" + i.ToString + " title=" + Chr(34) + HardSubValuesToDisplay(SoftSubs2(i)) + Chr(34) + " -metadata:s:s:" + i.ToString + " handler_name=" + Chr(34) + HardSubValuesToDisplay(SoftSubs2(i)) + Chr(34)
' End If
' Next
' If DispositionIndex = Nothing Then
' Else
' SoftSubMergeMetatata = SoftSubMergeMetatata + " -disposition:s:" + DispositionIndex.ToString + " default"
' End If
' Else
' For i As Integer = 0 To SoftSubs2.Count - 1
' Me.Invoke(New Action(Function()
' Anime_Add.StatusLabel.Text = "Status: downloading subtitle file " + HardSubValuesToDisplay(SoftSubs2(i))
' Me.Text = "Status: downloading subtitle file " + HardSubValuesToDisplay(SoftSubs2(i))
' Me.Invalidate()
' Return Nothing
' End Function))
' Dim SoftSub As String() = WebbrowserText.Split(New String() {Chr(34) + "language" + Chr(34) + ":" + Chr(34) + SoftSubs2(i) + Chr(34) + "," + Chr(34) + "url" + Chr(34) + ":" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
' Dim SoftSub_2 As String() = SoftSub(1).Split(New [Char]() {Chr(34)})
' Dim SoftSub_3 As String = SoftSub_2(0).Replace("\/", "/")
' Dim client0 As New WebClient
' client0.Encoding = Encoding.UTF8
' Dim str0 As String = client0.DownloadString(SoftSub_3)
' Dim Pfad3 As String = Pfad2.Replace(Chr(34), "")
' Dim FN As String = Path.ChangeExtension(Path.Combine(Path.GetFileNameWithoutExtension(Pfad3) + " " + SoftSubs2(i) + Path.GetExtension(Pfad3)), "ass")
' 'MsgBox(FN)
' If i = 0 Then
' FN = Path.ChangeExtension(Path.GetFileName(Pfad3), "ass")
' 'MsgBox(FN)
' End If
' Dim Pfad4 As String = Path.Combine(Path.GetDirectoryName(Pfad3), FN)
' 'MsgBox(Pfad4)
' File.WriteAllText(Pfad4, str0, Encoding.UTF8)
' Pause(3)
' Next
' End If
'End If
#End Region
#Region "lösche doppel download"
@ -2176,10 +2155,10 @@ Public Class Main
If Reso = 42 And HybridMode = False Then
If MergeSubs = True Then
' URL_DL = "-i " + Chr(34) + CR_URI_Master + Chr(34) + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language=" + CCtoMP4CC(CR_Anime_Dub)
URL_DL = "-i " + Chr(34) + CR_URI_Master + Chr(34) + " -metadata:s:a:0 language=" + CCtoMP4CC(CR_audio_locale) + " " + ffmpeg_command
URL_DL = "-i " + Chr(34) + CR_URI_Master + Chr(34) + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language=" + CCtoMP4CC(ConvertCC(CR_audio_locale))
'URL_DL = "-i " + Chr(34) + CR_URI_Master + Chr(34) + " -metadata:s:a:0 language=" + CCtoMP4CC(ConvertCC(CR_audio_locale)) + " " + ffmpeg_command
Else
URL_DL = "-i " + Chr(34) + CR_URI_Master + Chr(34) + " -metadata:s:a:0 language=" + CCtoMP4CC(CR_audio_locale) + " " + ffmpeg_command
URL_DL = "-i " + Chr(34) + CR_URI_Master + Chr(34) + " -metadata:s:a:0 language=" + CCtoMP4CC(ConvertCC(CR_audio_locale)) + " " + ffmpeg_command
End If
'MsgBox(URL_DL)
Else
@ -2223,11 +2202,12 @@ Public Class Main
ffmpeg_url_3 = ffmpeg_url_2(2).Split(New [Char]() {System.Convert.ToChar("#")})
If MergeSubs = True Then
'URL_DL = "-i " + Chr(34) + ffmpeg_url_3(0).Trim() + Chr(34) + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language=" + CCtoMP4CC(CR_Anime_Dub)
URL_DL = "-i " + Chr(34) + ffmpeg_url_3(0).Trim() + Chr(34) + " -metadata:s:a:0 language=" + CCtoMP4CC(CR_audio_locale) + " " + ffmpeg_command
Debug.WriteLine(ConvertCC(CR_audio_locale))
URL_DL = "-i " + Chr(34) + ffmpeg_url_3(0).Trim() + Chr(34) + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + " -metadata:s:a:0 language=" + CCtoMP4CC(ConvertCC(CR_audio_locale))
'URL_DL = "-i " + Chr(34) + ffmpeg_url_3(0).Trim() + Chr(34) + " -metadata:s:a:0 language=" + CCtoMP4CC(CR_audio_locale) + " " + ffmpeg_command
Else
URL_DL = "-i " + Chr(34) + ffmpeg_url_3(0).Trim() + Chr(34) + " -metadata:s:a:0 language=" + CCtoMP4CC(CR_audio_locale) + " " + ffmpeg_command
URL_DL = "-i " + Chr(34) + ffmpeg_url_3(0).Trim() + Chr(34) + " -metadata:s:a:0 language=" + CCtoMP4CC(ConvertCC(CR_audio_locale)) + " " + ffmpeg_command
End If
End If
@ -2316,8 +2296,8 @@ Public Class Main
Try
If CC = "deDE" Then
Return "de-DE"
ElseIf CC = "enUS" Then
Return "en-US"
ElseIf CC = "en-US" Then
Return "enUS"
ElseIf CC = "ptBR" Then
Return "pt-BR"
ElseIf CC = "esLA" Then
@ -2333,11 +2313,9 @@ Public Class Main
ElseIf CC = "esES" Then
Return "Español (España)"
ElseIf CC = "jaJP" Then
Return "es-ES"
ElseIf CC = "en" Then
Return "English"
ElseIf CC = "pt" Then
Return "ja-JP"
ElseIf CC = "None" Then
Return ""
Else
Return CB_SuB_Nothing
End If
@ -2406,6 +2384,7 @@ Public Class Main
End Sub
Private Sub PictureBox1_Click(sender As Object, e As EventArgs) Handles Btn_Browser.Click
Debug.WriteLine(Date.Now.ToString + "." + Date.Now.Millisecond.ToString)
UserBowser = True
GeckoFX.Show()
End Sub
@ -2665,6 +2644,7 @@ Public Class Main
'FontLabel2.Text = RunningDownloads.ToString
End Sub
Public Sub Funitmation_Grapp()
Try
Me.Invoke(New Action(Function()
@ -2682,6 +2662,7 @@ Public Class Main
Dim FunimationTitle As String = Nothing
Dim FunimationEpisodeTitle As String = Nothing
Dim FunimationDub As String = Nothing
Dim FunimationAudioMap As String = Nothing
Dim FunimationSeason1() As String = WebbrowserText.Split(New String() {"seasonNum: "}, System.StringSplitOptions.RemoveEmptyEntries)
Dim FunimationSeason2() As String = FunimationSeason1(1).Split(New String() {","}, System.StringSplitOptions.RemoveEmptyEntries)
@ -2724,6 +2705,7 @@ Public Class Main
DefaultName = RemoveExtraSpaces(FunimationTitle + " " + FunimationEpisodeTitle + " " + FunimationSeason + " " + FunimationEpisode)
End If
DefaultName = DefaultName.Replace("&#x27;", "'")
'Dim DefaultPath As String = Pfad + "\" + DefaultName + VideoFormat
'DefaultPath = DefaultPath.Replace("\\", "\")
@ -2753,14 +2735,14 @@ Public Class Main
' Nein! Jetzt erstellen...
Try
Directory.CreateDirectory(Path.GetDirectoryName(DownloadPfad))
DownloadPfad = DownloadPfad + DefaultName + VideoFormat
Catch ex As Exception
' Ordner wurde nich erstellt
DownloadPfad = Pfad + "\" + DefaultName + VideoFormat
End Try
End If
DownloadPfad = DownloadPfad + DefaultName + VideoFormat
#Region "lösche doppel download"
@ -2812,12 +2794,15 @@ Public Class Main
Return Nothing
End Function))
If WebbrowserCookie = Nothing Then
Else
If Not WebbrowserCookie = Nothing Then
client0.Headers.Add(HttpRequestHeader.Cookie, WebbrowserCookie)
ElseIf Not SystemWebBrowserCookie = Nothing Then
client0.Headers.Add(HttpRequestHeader.Cookie, SystemWebBrowserCookie)
End If
Dim str0 As String = client0.DownloadString("https://www.funimation.com/api/showexperience/" + Player_ID2(0) + "/?pinst_id=fzQc9p9f")
'MsgBox("https://www.funimation.com/api/showexperience/" + Player_ID2(0) + "/?pinst_id=fzQc9p9f")
'MsgBox(str0)
Dim Funimation_m3u8() As String = str0.Split(New String() {My.Resources.Funimation_src_string}, System.StringSplitOptions.RemoveEmptyEntries)
Dim Funimation_m3u8_Main As String = Nothing
For i As Integer = 0 To Funimation_m3u8.Count - 1
@ -2854,88 +2839,107 @@ Public Class Main
End Function))
Dim str1 As String = client0.DownloadString(Funimation_m3u8_Main.Replace(Chr(34), ""))
Dim textLenght() As String = str1.Split(New String() {vbLf}, System.StringSplitOptions.RemoveEmptyEntries)
If InStr(str1, "# AUDIO groups") Then
Dim FunimationAudio() As String = str1.Split(New String() {"# AUDIO groups"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim FunimationAudio2() As String = FunimationAudio(1).Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim FunimationAudio3() As String = FunimationAudio2(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
FunimationAudioMap = " -headers " + My.Resources.ffmpeg_user_agend + " -i " + Chr(34) + FunimationAudio3(0) + Chr(34)
End If
Dim Streams() As String = str1.Split(New String() {"RESOLUTION="}, System.StringSplitOptions.RemoveEmptyEntries)
'MsgBox(Funimation_m3u8_Main)
Dim FunimationBackupm3u8 As String = Nothing
For i As Integer = 0 To textLenght.Length - 1
For i As Integer = 0 To Streams.Length - 1
Try
If InStr(textLenght(i), "https") Then
If InStr(textLenght(i - 1), "x" + Reso.ToString) Then
Dim CheckClient As New WebClient
CheckClient.Encoding = Encoding.UTF8
If WebbrowserCookie = Nothing Then
Else
CheckClient.Headers.Add(HttpRequestHeader.Cookie, WebbrowserCookie)
End If
Dim m3u8String As String = CheckClient.DownloadString(textLenght(i))
Dim keyfileurl() As String = m3u8String.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl2() As String = keyfileurl(1).Split(New String() {Chr(34) + ","}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl3 As String = keyfileurl2(0)
If InStr(keyfileurl2(0), "https://") Then
Else
Dim c() As String = New Uri(textLenght(i)).Segments
Dim path As String = "https://" + New Uri(textLenght(i)).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
keyfileurl3 = path + keyfileurl2(0) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
End If
'MsgBox(keyfileurl3)
Try
Dim CheckClient2 As New WebClient
CheckClient2.Encoding = System.Text.Encoding.UTF8
Dim testdl As String = CheckClient2.DownloadString(keyfileurl3)
Funimation_m3u8_final = textLenght(i)
FunimationBackupm3u8 = textLenght(i)
Exit For
Catch ex As Exception
Debug.WriteLine(keyfileurl3 + vbNewLine + vbNewLine + ex.ToString)
End Try
ElseIf InStr(textLenght(i - 1), ResoFunBackup) Then
Dim CheckClient As New WebClient
CheckClient.Encoding = Encoding.UTF8
If WebbrowserCookie = Nothing Then
Else
CheckClient.Headers.Add(HttpRequestHeader.Cookie, WebbrowserCookie)
End If
Dim m3u8String As String = CheckClient.DownloadString(textLenght(i))
Dim keyfileurl() As String = m3u8String.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl2() As String = keyfileurl(1).Split(New String() {Chr(34) + ","}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl3 As String = keyfileurl2(0)
If InStr(keyfileurl2(0), "https://") Then
Else
Dim c() As String = New Uri(textLenght(i)).Segments
Dim path As String = "https://" + New Uri(textLenght(i)).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
keyfileurl3 = path + keyfileurl2(0) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
End If
'MsgBox(keyfileurl3)
Try
Dim CheckClient2 As New WebClient
CheckClient2.Encoding = System.Text.Encoding.UTF8
Dim testdl As String = CheckClient2.DownloadString(keyfileurl3)
FunimationBackupm3u8 = textLenght(i)
Exit For
Catch ex As Exception
Debug.WriteLine(keyfileurl3 + vbNewLine + vbNewLine + ex.ToString)
End Try
If InStr(Streams(i), "x" + Reso.ToString) Then
Dim Streams2() As String = Streams(i).Split(New String() {"https://"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim Streams3() As String = Streams2(1).Split(New String() {"#EXT-"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim StreamURL As String = "https://" + Streams3(0).Trim
Dim CheckClient As New WebClient
CheckClient.Encoding = Encoding.UTF8
If Not WebbrowserCookie = Nothing Then
CheckClient.Headers.Add(HttpRequestHeader.Cookie, WebbrowserCookie)
ElseIf Not SystemWebBrowserCookie = Nothing Then
CheckClient.Headers.Add(HttpRequestHeader.Cookie, SystemWebBrowserCookie)
End If
Dim m3u8String As String = CheckClient.DownloadString(StreamURL)
'MsgBox(m3u8String)
Dim keyfileurl() As String = m3u8String.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl2() As String = keyfileurl(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl3 As String = keyfileurl2(0)
If InStr(keyfileurl2(0), "https://") Then
Else
Dim c() As String = New Uri(StreamURL).Segments
Dim path As String = "https://" + New Uri(StreamURL).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
keyfileurl3 = path + keyfileurl2(0) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
End If
'MsgBox(keyfileurl3)
Try
Dim CheckClient2 As New WebClient
CheckClient2.Encoding = System.Text.Encoding.UTF8
Dim testdl As String = CheckClient2.DownloadString(keyfileurl3)
Funimation_m3u8_final = StreamURL
FunimationBackupm3u8 = StreamURL
Exit For
Catch ex As Exception
Debug.WriteLine(keyfileurl3 + vbNewLine + vbNewLine + ex.ToString)
End Try
ElseIf InStr(Streams(i), ResoFunBackup) Then
Dim Streams2() As String = Streams(i).Split(New String() {"https://"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim Streams3() As String = Streams2(1).Split(New String() {"#EXT-"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim StreamURL As String = "https://" + Streams3(0).Trim
Dim CheckClient As New WebClient
CheckClient.Encoding = Encoding.UTF8
If Not WebbrowserCookie = Nothing Then
CheckClient.Headers.Add(HttpRequestHeader.Cookie, WebbrowserCookie)
ElseIf Not SystemWebBrowserCookie = Nothing Then
CheckClient.Headers.Add(HttpRequestHeader.Cookie, SystemWebBrowserCookie)
End If
Dim m3u8String As String = CheckClient.DownloadString(StreamURL)
Dim keyfileurl() As String = m3u8String.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl2() As String = keyfileurl(1).Split(New String() {Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl3 As String = keyfileurl2(0)
If InStr(keyfileurl2(0), "https://") Then
Else
Dim c() As String = New Uri(StreamURL).Segments
Dim path As String = "https://" + New Uri(StreamURL).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
keyfileurl3 = path + keyfileurl2(0) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
End If
'MsgBox(keyfileurl3)
Try
Dim CheckClient2 As New WebClient
CheckClient2.Encoding = System.Text.Encoding.UTF8
Dim testdl As String = CheckClient2.DownloadString(keyfileurl3)
FunimationBackupm3u8 = StreamURL
Exit For
Catch ex As Exception
Debug.WriteLine(keyfileurl3 + vbNewLine + vbNewLine + ex.ToString)
End Try
End If
Catch ex As Exception
End Try
@ -2953,45 +2957,49 @@ Public Class Main
Return Nothing
End Function))
ResoFunBackup = ResoBackString
For i As Integer = 0 To textLenght.Length - 1
If InStr(textLenght(i), "https") Then
If InStr(textLenght(i - 1), ResoBackString) Then
For i As Integer = 0 To Streams.Length - 1
If InStr(Streams(i), ResoBackString) Then
Dim Streams2() As String = Streams(i).Split(New String() {"https://"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim Streams3() As String = Streams2(1).Split(New String() {"#EXT-"}, System.StringSplitOptions.RemoveEmptyEntries)
Dim StreamURL As String = "https://" + Streams3(0).Trim
Dim CheckClient As New WebClient
CheckClient.Encoding = Encoding.UTF8
Dim CheckClient As New WebClient
CheckClient.Encoding = Encoding.UTF8
If WebbrowserCookie = Nothing Then
Else
CheckClient.Headers.Add(HttpRequestHeader.Cookie, WebbrowserCookie)
End If
Dim m3u8String As String = CheckClient.DownloadString(textLenght(i))
'MsgBox(textLenght(i))
Dim keyfileurl() As String = m3u8String.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl2() As String = keyfileurl(1).Split(New String() {Chr(34) + ","}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl3 As String = keyfileurl2(0)
If InStr(keyfileurl2(0), "https://") Then
Else
Dim c() As String = New Uri(textLenght(i)).Segments
Dim path As String = "https://" + New Uri(textLenght(i)).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
keyfileurl3 = path + keyfileurl2(0) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
End If
Try
Dim CheckClient2 As New WebClient
CheckClient2.Encoding = System.Text.Encoding.UTF8
Dim testdl As String = CheckClient2.DownloadString(keyfileurl3)
Funimation_m3u8_final = textLenght(i)
Exit For
Catch ex As Exception
Debug.WriteLine(keyfileurl3 + vbNewLine + ex.ToString)
End Try
'Funimation_m3u8_final = textLenght(i)
'Exit For
If Not WebbrowserCookie = Nothing Then
CheckClient.Headers.Add(HttpRequestHeader.Cookie, WebbrowserCookie)
ElseIf Not SystemWebBrowserCookie = Nothing Then
CheckClient.Headers.Add(HttpRequestHeader.Cookie, SystemWebBrowserCookie)
End If
Dim m3u8String As String = CheckClient.DownloadString(StreamURL)
'MsgBox(textLenght(i))
Dim keyfileurl() As String = m3u8String.Split(New String() {"URI=" + Chr(34)}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl2() As String = keyfileurl(1).Split(New String() {Chr(34) + ","}, System.StringSplitOptions.RemoveEmptyEntries)
Dim keyfileurl3 As String = keyfileurl2(0)
If InStr(keyfileurl2(0), "https://") Then
Else
Dim c() As String = New Uri(StreamURL).Segments
Dim path As String = "https://" + New Uri(StreamURL).Host
For i3 As Integer = 0 To c.Count - 2
path = path + c(i3)
Next
keyfileurl3 = path + keyfileurl2(0) 'New Uri(textLenght(i)).LocalPath + keyfileurl2(0)
End If
Try
Dim CheckClient2 As New WebClient
CheckClient2.Encoding = System.Text.Encoding.UTF8
Dim testdl As String = CheckClient2.DownloadString(keyfileurl3)
Funimation_m3u8_final = StreamURL
Exit For
Catch ex As Exception
Debug.WriteLine(keyfileurl3 + vbNewLine + ex.ToString)
End Try
'Funimation_m3u8_final = textLenght(i)
'Exit For
End If
Next
ElseIf Funimation_m3u8_final = Nothing Then
@ -3026,10 +3034,10 @@ Public Class Main
Dim SubsClient As New WebClient
SubsClient.Encoding = Encoding.UTF8
If WebbrowserCookie = Nothing Then
Else
'MsgBox(WebbrowserCookie)
If Not WebbrowserCookie = Nothing Then
SubsClient.Headers.Add(HttpRequestHeader.Cookie, WebbrowserCookie)
ElseIf Not SystemWebBrowserCookie = Nothing Then
SubsClient.Headers.Add(HttpRequestHeader.Cookie, SystemWebBrowserCookie)
End If
Dim PlayerPage As String = SubsClient.DownloadString("https://www.funimation.com/player/" + Player_ID2(0) + "/?bdub=0&qid=")
@ -3046,6 +3054,8 @@ Public Class Main
Continue For
ElseIf InStr(PlayerPage, My.Resources.Funimation_Subtitle_String2 + SubFunimation(i)) Then
SoftSubs2.Add(My.Resources.Funimation_Subtitle_String2 + SubFunimation(i))
ElseIf InStr(PlayerPage, My.Resources.Funimation_Subtitle_String3 + SubFunimation(i)) Then
SoftSubs2.Add(My.Resources.Funimation_Subtitle_String3 + SubFunimation(i))
End If
Next
@ -3074,6 +3084,9 @@ Public Class Main
ElseIf InStr(PlayerPage, My.Resources.Funimation_Subtitle_String2 + HardSubFunimation) Then
HardSubFound = True
HardSubSplittString = My.Resources.Funimation_Subtitle_String2 + HardSubFunimation
ElseIf InStr(PlayerPage, My.Resources.Funimation_Subtitle_String3 + HardSubFunimation) Then
HardSubFound = True
HardSubSplittString = My.Resources.Funimation_Subtitle_String3 + HardSubFunimation
End If
If HardSubFound = True Then 'anyways not true if hardsub is "Disabled"
@ -3144,25 +3157,35 @@ Public Class Main
Next
Dim TempCount As Integer = UsedSubs.Count
If Funimation_srt = True Then
UsedSubs.Add(Subs_in_srt.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, ""))
End If
Try
If Funimation_srt = True Then
UsedSubs.Add(Subs_in_srt.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, "").Replace(My.Resources.Funimation_Subtitle_String3, ""))
End If
Catch ex As Exception
End Try
If Funimation_vtt = True Then
UsedSubs.Add(Subs_in_vtt.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, ""))
End If
Try
If Funimation_vtt = True Then
UsedSubs.Add(Subs_in_vtt.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, "").Replace(My.Resources.Funimation_Subtitle_String3, ""))
End If
Catch ex As Exception
End Try
Try
If Funimation_dfxp = True Then
UsedSubs.Add(Subs_in_dfxp.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, "").Replace(My.Resources.Funimation_Subtitle_String3, ""))
End If
Catch ex As Exception
End Try
If Funimation_dfxp = True Then
UsedSubs.Add(Subs_in_dfxp.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, ""))
End If
If TempCount = UsedSubs.Count Then
If Subs_in_srt.Count > 0 Then
UsedSubs.Add(Subs_in_srt.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, ""))
UsedSubs.Add(Subs_in_srt.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, "").Replace(My.Resources.Funimation_Subtitle_String3, ""))
ElseIf Subs_in_vtt.Count > 0 Then
UsedSubs.Add(Subs_in_vtt.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, ""))
UsedSubs.Add(Subs_in_vtt.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, "").Replace(My.Resources.Funimation_Subtitle_String3, ""))
ElseIf Subs_in_dfxp.Count > 0 Then
UsedSubs.Add(Subs_in_dfxp.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, ""))
UsedSubs.Add(Subs_in_dfxp.Item(0) + " , " + SoftSubs2.Item(i).Replace(My.Resources.Funimation_Subtitle_String, "").Replace(My.Resources.Funimation_Subtitle_String2, "").Replace(My.Resources.Funimation_Subtitle_String3, ""))
End If
End If
@ -3176,12 +3199,16 @@ Public Class Main
'
Dim SoftSubMergeURLs As String = Nothing
Dim SoftSubMergeMaps As String = " -map 0:v -map 0:a"
If Not FunimationAudioMap = Nothing Then
SoftSubMergeMaps = " -map 0:v -map 1:a"
End If
Dim SoftSubMergeMetatata As String = Nothing
If UsedSubs.Count > 0 Then
If MergeSubs = True And SubsOnly = False Then
Dim DispositionIndex As Integer = 999
Dim LastMerged As String = Nothing
Dim MapCount As Integer = -1
For i As Integer = 0 To UsedSubs.Count - 1
Dim SoftSub As String() = UsedSubs.Item(i).Split(New String() {" , "}, System.StringSplitOptions.RemoveEmptyEntries)
If CCtoMP4CC(SoftSub(1)) = LastMerged Then
@ -3189,21 +3216,28 @@ Public Class Main
Else
LastMerged = CCtoMP4CC(SoftSub(1))
End If
MapCount = MapCount + 1
If DefaultSubFunimation = SoftSub(1) Then
'Debug.WriteLine(SoftSub(1))
DispositionIndex = i
DispositionIndex = MapCount
End If
If SoftSubMergeURLs = Nothing Then
SoftSubMergeURLs = " -headers " + My.Resources.ffmpeg_user_agend + " -i " + Chr(34) + SoftSub(0) + Chr(34)
Else
SoftSubMergeURLs = SoftSubMergeURLs + " -i " + Chr(34) + SoftSub(0) + Chr(34)
SoftSubMergeURLs = SoftSubMergeURLs + " -headers " + My.Resources.ffmpeg_user_agend + " -i " + Chr(34) + SoftSub(0) + Chr(34)
End If
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + (i + 1).ToString
If FunimationAudioMap = Nothing Then
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + (MapCount + 1).ToString
Else
SoftSubMergeMaps = SoftSubMergeMaps + " -map " + (MapCount + 2).ToString
End If
If SoftSubMergeMetatata = Nothing Then
'SoftSubMergeMetatata = " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSub(1))
SoftSubMergeMetatata = " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSub(1)) + " -metadata:s:s:" + i.ToString + " title=" + Chr(34) + HardSubValuesToDisplay(SoftSub(1)) + Chr(34) + " -metadata:s:s:" + i.ToString + " handler_name=" + Chr(34) + HardSubValuesToDisplay(SoftSub(1)) + Chr(34)
SoftSubMergeMetatata = " -metadata:s:s:" + MapCount.ToString + " language=" + CCtoMP4CC(SoftSub(1)) + " -metadata:s:s:" + MapCount.ToString + " title=" + Chr(34) + HardSubValuesToDisplay(Chr(34) + SoftSub(1) + Chr(34)) + Chr(34) + " -metadata:s:s:" + MapCount.ToString + " handler_name=" + Chr(34) + HardSubValuesToDisplay(Chr(34) + SoftSub(1) + Chr(34)) + Chr(34)
Else
SoftSubMergeMetatata = SoftSubMergeMetatata + " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSub(1)) + " -metadata:s:s:" + i.ToString + " title=" + Chr(34) + HardSubValuesToDisplay(SoftSub(1)) + Chr(34) + " -metadata:s:s:" + i.ToString + " handler_name=" + Chr(34) + HardSubValuesToDisplay(SoftSub(1)) + Chr(34)
SoftSubMergeMetatata = SoftSubMergeMetatata + " -metadata:s:s:" + MapCount.ToString + " language=" + CCtoMP4CC(SoftSub(1)) + " -metadata:s:s:" + MapCount.ToString + " title=" + Chr(34) + HardSubValuesToDisplay(Chr(34) + SoftSub(1) + Chr(34)) + Chr(34) + " -metadata:s:s:" + MapCount.ToString + " handler_name=" + Chr(34) + HardSubValuesToDisplay(Chr(34) + SoftSub(1) + Chr(34)) + Chr(34)
'SoftSubMergeMetatata + " -metadata:s:s:" + i.ToString + " language=" + CCtoMP4CC(SoftSubs2(i))
@ -3263,15 +3297,15 @@ Public Class Main
End If
If HardSubFound = True Then
Funimation_m3u8_final = "-i " + Chr(34) + Funimation_m3u8_final + Chr(34) + " -vf subtitles=" + Chr(34) + UsedSub + Chr(34) + " " + ffmpeg_hardsub
Funimation_m3u8_final = "-i " + Chr(34) + Funimation_m3u8_final + Chr(34) + FunimationAudioMap + " -vf subtitles=" + Chr(34) + UsedSub + Chr(34) + " " + ffmpeg_hardsub
ElseIf MergeSubs = True Then
Funimation_m3u8_final = "-i " + Chr(34) + Funimation_m3u8_final + Chr(34) + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + DubMetatata
Funimation_m3u8_final = "-i " + Chr(34) + Funimation_m3u8_final + Chr(34) + FunimationAudioMap + SoftSubMergeURLs + SoftSubMergeMaps + " " + ffmpeg_command + " -c:s " + MergeSubsFormat + SoftSubMergeMetatata + DubMetatata
Else
Funimation_m3u8_final = "-i " + Chr(34) + Funimation_m3u8_final + Chr(34) + DubMetatata + " " + ffmpeg_command
Funimation_m3u8_final = "-i " + Chr(34) + Funimation_m3u8_final + Chr(34) + FunimationAudioMap + DubMetatata + " " + ffmpeg_command
End If
@ -3311,6 +3345,7 @@ Public Class Main
Funimation_Grapp_RDY = True
End Sub
Private Sub Timer3_Tick(sender As Object, e As EventArgs) Handles Timer3.Tick
Me.Invalidate()

4
Crunchyroll Downloader/My Project/AssemblyInfo.vb
View File

@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("3.7.8.3")>
<Assembly: AssemblyFileVersion("3.7.8.3")>
<Assembly: AssemblyVersion("3.8")>
<Assembly: AssemblyFileVersion("3.8")>
<Assembly: NeutralResourcesLanguage("en")>

11
Crunchyroll Downloader/My Project/Resources.Designer.vb generated
View File

@ -350,7 +350,7 @@ Namespace My.Resources
End Property
'''<summary>
''' Sucht eine lokalisierte Zeichenfolge, die &quot;User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:83.0) Gecko/20100101 Firefox/83.0&quot; ähnelt.
''' Sucht eine lokalisierte Zeichenfolge, die &quot;User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:87.0) Gecko/20100101 Firefox/87.0&quot; ähnelt.
'''</summary>
Friend ReadOnly Property ffmpeg_user_agend() As String
Get
@ -421,6 +421,15 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' Sucht eine lokalisierte Zeichenfolge, die &quot;, &quot;kind&quot;: &quot;subtitle&quot;, &quot;type&quot;: &quot;full&quot;, &quot;language&quot;: &quot; ähnelt.
'''</summary>
Friend ReadOnly Property Funimation_Subtitle_String3() As String
Get
Return ResourceManager.GetString("Funimation_Subtitle_String3", resourceCulture)
End Get
End Property
'''<summary>
''' Sucht eine lokalisierte Zeichenfolge, die &lt;meta property=&quot;og:image&quot; content=&quot; ähnelt.
'''</summary>

5
Crunchyroll Downloader/My Project/Resources.resx
View File

@ -422,7 +422,7 @@ Dialogue: 0,0:00:00.00,0:00:00.00,Default,,0000,0000,0000,,some ideas on how tem
<value>..\Resources\crdSettings_Button_SafeExit_hover.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="ffmpeg_user_agend" xml:space="preserve">
<value>"User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:83.0) Gecko/20100101 Firefox/83.0"</value>
<value>"User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:87.0) Gecko/20100101 Firefox/87.0"</value>
</data>
<data name="crdSettings_Button_SafeExit" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Resources\crdSettings_Button_SafeExit.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
@ -538,4 +538,7 @@ Dialogue: 0,0:00:00.00,0:00:00.00,Default,,0000,0000,0000,,some ideas on how tem
<data name="CR_Season_Nr" xml:space="preserve">
<value>seasonNumber":"</value>
</data>
<data name="Funimation_Subtitle_String3" xml:space="preserve">
<value>", "kind": "subtitle", "type": "full", "language": "</value>
</data>
</root>

2
Crunchyroll Downloader/Subfolder.vb
View File

@ -7,7 +7,7 @@
Public SubFolder_Value As String = "[ ignore subfolder ]"
Public Function UseSubfolder(ByVal Series As String, ByVal Season As String, ByVal Path As String)
Public Function UseSubfolder(ByVal Series As String, ByVal Season As String, ByVal Path As String) As String
Dim newPath As String = Path + "\"
If SubFolder_Value = SubFolder_automatic Or SubFolder_Value = SubFolder_automatic_old Then

3
Crunchyroll Downloader/bin/x86/Debug/AdBlock/CRD-Domain-Blocklist.txt
View File

@ -11,4 +11,5 @@ i.cdn.turner.com
js-agent.newrelic.com
www.googletagmanager.com
googletagmanager.com
ocsp.sca1b.amazontrust.com
ocsp.sca1b.amazontrust.com
sa.etp-prod.com

BIN
Crunchyroll Downloader/bin/x86/Debug/Crunchyroll Downloader.exe
View File

Binary file not shown.

BIN
Crunchyroll Downloader/bin/x86/Debug/Crunchyroll Downloader.pdb
View File

Binary file not shown.

7
Crunchyroll Downloader/bin/x86/Debug/Crunchyroll Downloader.xml
View File

@ -187,7 +187,7 @@ Video Position: 0
</member>
<member name="P:Crunchyroll_Downloader.My.Resources.Resources.ffmpeg_user_agend">
<summary>
Sucht eine lokalisierte Zeichenfolge, die &quot;User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:83.0) Gecko/20100101 Firefox/83.0&quot; ähnelt.
Sucht eine lokalisierte Zeichenfolge, die &quot;User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:87.0) Gecko/20100101 Firefox/87.0&quot; ähnelt.
</summary>
</member>
<member name="P:Crunchyroll_Downloader.My.Resources.Resources.Funimation_Player_ID">
@ -225,6 +225,11 @@ Video Position: 0
Sucht eine lokalisierte Zeichenfolge, die &quot;, &quot;kind&quot;: &quot;subtitle&quot;, &quot;type&quot;: &quot;Full&quot;, &quot;language&quot;: &quot; ähnelt.
</summary>
</member>
<member name="P:Crunchyroll_Downloader.My.Resources.Resources.Funimation_Subtitle_String3">
<summary>
Sucht eine lokalisierte Zeichenfolge, die &quot;, &quot;kind&quot;: &quot;subtitle&quot;, &quot;type&quot;: &quot;full&quot;, &quot;language&quot;: &quot; ähnelt.
</summary>
</member>
<member name="P:Crunchyroll_Downloader.My.Resources.Resources.Funimation_thumbnail">
<summary>
Sucht eine lokalisierte Zeichenfolge, die &lt;meta property=&quot;og:image&quot; content=&quot; ähnelt.

BIN
Crunchyroll Downloader/bin/x86/Debugfunimation.log
View File

Binary file not shown.

2
Crunchyroll Downloader/einstellungen.vb
View File

@ -16,7 +16,7 @@ Public Class Einstellungen
Private Sub Einstellungen_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Label6.Text = "You have: v" + Application.ProductVersion.ToString
Label6.Text = "You have: v" + Application.ProductVersion.ToString + " Beta-U1"
BackgroundWorker1.RunWorkerAsync()

BIN
Crunchyroll Downloader/obj/x86/Debug/Crunchyroll Downloader.exe
View File

Binary file not shown.

BIN
Crunchyroll Downloader/obj/x86/Debug/Crunchyroll Downloader.pdb
View File

Binary file not shown.

BIN
Crunchyroll Downloader/obj/x86/Debug/Crunchyroll Downloader.vbproj.GenerateResource.cache
View File

Binary file not shown.

7
Crunchyroll Downloader/obj/x86/Debug/Crunchyroll Downloader.xml
View File

@ -187,7 +187,7 @@ Video Position: 0
</member>
<member name="P:Crunchyroll_Downloader.My.Resources.Resources.ffmpeg_user_agend">
<summary>
Sucht eine lokalisierte Zeichenfolge, die &quot;User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:83.0) Gecko/20100101 Firefox/83.0&quot; ähnelt.
Sucht eine lokalisierte Zeichenfolge, die &quot;User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:87.0) Gecko/20100101 Firefox/87.0&quot; ähnelt.
</summary>
</member>
<member name="P:Crunchyroll_Downloader.My.Resources.Resources.Funimation_Player_ID">
@ -225,6 +225,11 @@ Video Position: 0
Sucht eine lokalisierte Zeichenfolge, die &quot;, &quot;kind&quot;: &quot;subtitle&quot;, &quot;type&quot;: &quot;Full&quot;, &quot;language&quot;: &quot; ähnelt.
</summary>
</member>
<member name="P:Crunchyroll_Downloader.My.Resources.Resources.Funimation_Subtitle_String3">
<summary>
Sucht eine lokalisierte Zeichenfolge, die &quot;, &quot;kind&quot;: &quot;subtitle&quot;, &quot;type&quot;: &quot;full&quot;, &quot;language&quot;: &quot; ähnelt.
</summary>
</member>
<member name="P:Crunchyroll_Downloader.My.Resources.Resources.Funimation_thumbnail">
<summary>
Sucht eine lokalisierte Zeichenfolge, die &lt;meta property=&quot;og:image&quot; content=&quot; ähnelt.

BIN
Crunchyroll Downloader/obj/x86/Debug/Crunchyroll_Downloader.Resources.resources
View File

Binary file not shown.

BIN
Crunchyroll Downloader/obj/x86/Debug/TempPE/My Project.Resources.Designer.vb.dll
View File

Binary file not shown.