Imports System.Net Imports System.IO Imports System.Threading Public Class Form1 #Region "Deklaration" Dim Name_des_videos As String Dim Name_des_herstellers As String Dim start_DL_url As String Dim start_DL_url_playlist As String Dim Name_des_downloads_1 As String Dim Name_des_downloads_2 As String Dim end_DL_url As String Dim qualy As String WithEvents item As New ListViewItem Public alle_downloads As Integer Public aktuelle_dl_nummer_alle As Integer Public aktuelle_dl_nummer_einzeln As Integer Dim WeiterGehts As Boolean = False Dim ms As Integer Dim Sizes As Double WithEvents ContextMenu1 As New ContextMenu Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load ContextMenu1.MenuItems.Add("&Infos", New System.EventHandler(AddressOf infos)) ContextMenu1.MenuItems.Add("&Anzeigen", New System.EventHandler(AddressOf anzeigen)) ContextMenu1.MenuItems.Add("B&eenden", New System.EventHandler(AddressOf beenden)) NotifyIcon1.ContextMenu = ContextMenu1 ListView.LabelEdit = True ListView.AllowColumnReorder = True ListView.CheckBoxes = True ListView.GridLines = True Dim dateiname As String = My.Application.Info.DirectoryPath.ToString & "\pfad.config" Dim sr1 As StreamReader If File.Exists(dateiname) = True Then sr1 = New StreamReader(dateiname) Dim pfad_name_aus_config As String = sr1.ReadLine If pfad_name_aus_config = "" Then FolderBrowserDialog.ShowDialog() TextBox_pfad.Text = FolderBrowserDialog.SelectedPath & "\" sr1.Close() Else TextBox_pfad.Text = pfad_name_aus_config sr1.Close() End If Else FolderBrowserDialog.ShowDialog() TextBox_pfad.Text = FolderBrowserDialog.SelectedPath & "\" End If End Sub #End Region #Region "Speichern unter + Hinzufügen + Ermitteln" Private Sub Button_save_under_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_save_under.Click FolderBrowserDialog.ShowDialog() TextBox_pfad.Text = FolderBrowserDialog.SelectedPath & "\" End Sub Private Sub Button_add_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_add.Click daten_ermitteln_einzeln() End Sub Private Sub daten_ermitteln_einzeln() If RadioButton_low.Checked = True Then qualy = "" ElseIf RadioButton_middle.Checked = True Then qualy = "%3D&fmt=18" ElseIf RadioButton_high.Checked = True Then qualy = "%3D&fmt=22" ElseIf RadioButton_highest.Checked = True Then qualy = "%3D&fmt=35" End If 'start_DL_url_link = ComboBox_link.Text On Error GoTo err If TextBox_pfad.Text <> "" Then Dim httpURL As New System.Uri(ComboBox_link.Text) Dim request As HttpWebRequest = HttpWebRequest.Create(httpURL) request.Method = WebRequestMethods.Http.Get Dim response As HttpWebResponse = request.GetResponse() Dim reader As New StreamReader(response.GetResponseStream()) start_DL_url = reader.ReadToEnd() response.Close() ERMITTELN_ROUTINE_EINZELN() item = ListView.Items.Add(Name_des_videos) Dim items_number As Integer = ListView.Items.Count item.SubItems.Add(items_number) item.SubItems.Add(Name_des_herstellers) item.SubItems.Add("Bereit") item.SubItems.Add(Sizes & " MB") item.SubItems.Add(end_DL_url) Else MsgBox("""""ist kein gültiger Speicherort. Bitte wähle deinen Speicherort aus.") End If Exit Sub err: MsgBox("Leider kein gültiges YouTube Video. Bitte kopieren sie nur YouTube Video Links!") End Sub Public Sub ERMITTELN_ROUTINE_EINZELN() Dim anfang_stelle_des_video_namens As Integer anfang_stelle_des_video_namens = InStr(start_DL_url, " 0 ListView.Items.Remove(ListView.Items(ListView.CheckedIndices.Item(0))) End While End Sub Private Sub Button_alle_löschen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_alle_löschen.Click ListView.Items.Clear() End Sub #End Region #Region "DOWNLOADEN" Private Sub Button_einzelne_downloaden_click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_einzeln_downloaden.Click For i = 0 To ListView.CheckedIndices.Count - 1 If Download_einzeln.download_1_fertig = True Then aktuelle_dl_nummer_einzeln = ListView.CheckedIndices.Item(i) Download_einzeln.download_berechnen() ElseIf Download_einzeln.download_2_fertig = True Then aktuelle_dl_nummer_einzeln = ListView.CheckedIndices.Item(i) Download_einzeln.download_berechnen() ElseIf Download_einzeln.download_3_fertig = True Then aktuelle_dl_nummer_einzeln = ListView.CheckedIndices.Item(i) Download_einzeln.download_berechnen() Else i -= 1 Wartezeit(1) End If Next End Sub Private Sub Timer_einzeln_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer_einzeln.Tick If alle_downloads >= aktuelle_dl_nummer_alle Then Download_alles.download_berechnen() Else Timer_einzeln.Stop() End If End Sub Private Sub Button_alle_downloaden_click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_alle_downloaden.Click alle_downloads = ListView.Items.Count aktuelle_dl_nummer_alle = 0 Timer_alle.Start() End Sub Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer_alle.Tick If alle_downloads >= aktuelle_dl_nummer_alle Then Download_alles.download_berechnen() Else Timer_alle.Stop() End If End Sub #End Region #Region "Closing und BGW" Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing 'If BackgroundWorker_alles.IsBusy Then ' BackgroundWorker_alles.CancelAsync() 'End If End Sub #End Region #Region "Wartezeit" 'Hier wird die Wartezeit in ms umgerechnet und der Thread gestartet Public Sub Wartezeit(ByVal Sekunden As Integer) ms = Sekunden * 1000 WeiterGehts = False Dim T As Thread = New Thread(AddressOf Warten) T.Start() Do Application.DoEvents() Loop Until WeiterGehts = True End Sub 'Hier wartet das Programm Private Sub Warten() Thread.Sleep(ms) WeiterGehts = True End Sub #End Region Private Sub Button_pause_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_stop.Click Download_alles.download_1.CancelAsync() Download_alles.download_2.CancelAsync() Download_alles.download_3.CancelAsync() Download_einzeln.download_1.CancelAsync() Download_einzeln.download_2.CancelAsync() Download_einzeln.download_3.CancelAsync() End Sub Private Sub LinkLabel1_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked System.Diagnostics.Process.Start("http://www.sempervideo.de/bbpress/topic.php?id=1193") End Sub Private Sub Button_save_config_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_save_config.Click Dim fnum As Short, dateiname As Object fnum = FreeFile() dateiname = My.Application.Info.DirectoryPath.ToString & "\pfad.config" FileOpen(fnum, dateiname, OpenMode.Output) PrintLine(fnum, TextBox_pfad.Text) FileClose(fnum) End Sub Private Sub Button_minimize_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_minimize.Click Me.Hide() Me.ShowInTaskbar = False NotifyIcon1.Visible = True End Sub Private Sub infos() MsgBox("YouTube Downloader by kwoxer") End Sub Private Sub anzeigen() Me.Show() Me.ShowInTaskbar = True NotifyIcon1.Visible = False End Sub Private Sub beenden() Me.Close() End Sub Private Sub NotifyIcon1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles NotifyIcon1.DoubleClick If RadioButton_low.Checked = True Then qualy = "" ElseIf RadioButton_middle.Checked = True Then qualy = "%3D&fmt=18" ElseIf RadioButton_high.Checked = True Then qualy = "%3D&fmt=22" ElseIf RadioButton_highest.Checked = True Then qualy = "%3D&fmt=35" End If 'start_DL_url_link = ComboBox_link.Text On Error GoTo err If TextBox_pfad.Text <> "" Then Dim httpURL As New System.Uri(My.Computer.Clipboard.GetText.ToString()) Dim request As HttpWebRequest = HttpWebRequest.Create(httpURL) request.Method = WebRequestMethods.Http.Get Dim response As HttpWebResponse = request.GetResponse() Dim reader As New StreamReader(response.GetResponseStream()) start_DL_url = reader.ReadToEnd() response.Close() ERMITTELN_ROUTINE_EINZELN() item = ListView.Items.Add(Name_des_videos) Dim items_number As Integer = ListView.Items.Count item.SubItems.Add(items_number) item.SubItems.Add(Name_des_herstellers) item.SubItems.Add("Bereit") item.SubItems.Add(Sizes & " MB") item.SubItems.Add(end_DL_url) Else MsgBox("""""ist kein gültiger Speicherort. Bitte wähle deinen Speicherort aus.") End If Exit Sub err: MsgBox("Leider kein gültiges YouTube Video. Bitte kopieren sie nur YouTube Video Links!") End Sub Private Sub Button_playlist_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_playlist.Click If RadioButton_low.Checked = True Then qualy = "" ElseIf RadioButton_middle.Checked = True Then qualy = "%3D&fmt=18" ElseIf RadioButton_high.Checked = True Then qualy = "%3D&fmt=22" ElseIf RadioButton_highest.Checked = True Then qualy = "%3D&fmt=35" End If On Error GoTo err If TextBox_pfad.Text <> "" Then Dim httpURL As New System.Uri(ComboBox_link.Text) Dim request As HttpWebRequest = HttpWebRequest.Create(httpURL) request.Method = WebRequestMethods.Http.Get Dim response As HttpWebResponse = request.GetResponse() Dim reader As New StreamReader(response.GetResponseStream()) start_DL_url_playlist = reader.ReadToEnd() response.Close() ''''''''''#################################### Dim anfang_playlist_count As Integer anfang_playlist_count = InStr(start_DL_url_playlist, "Videos: ") + 14 Dim ende_playlist_count As Integer ende_playlist_count = InStr(anfang_playlist_count, start_DL_url_playlist, "") Dim Laenge_playlist_count1 As Integer Laenge_playlist_count1 = ende_playlist_count - anfang_playlist_count Dim Laenge_playlist_count2 As Integer Laenge_playlist_count2 = Mid(start_DL_url_playlist, anfang_playlist_count, Laenge_playlist_count1) Dim playlist_ohne_youtube As String Dim playlist_mit_youtube As String Dim anfang_stelle_der_playlist_videos As Integer Dim anfang_stelle_der_playlist_video As Integer Dim ende_stelle_der_playlist_video As Integer Dim Laenge_der_playlist_video As Integer For i As Integer = 0 To Laenge_playlist_count2 - 1 anfang_stelle_der_playlist_videos = InStr(anfang_playlist_count, start_DL_url_playlist, "