Imports System.ComponentModel Imports System.Data.SQLite Imports System.IO Imports System.Reflection Imports DevExpress.Utils.DragDrop Imports DevExpress.XtraGrid Imports DevExpress.XtraGrid.Columns Imports DevExpress.XtraGrid.Views.Base Imports DevExpress.XtraGrid.Views.Grid Imports DevExpress.XtraGrid.Views.Grid.ViewInfo Public Class frmMain Public Property Songs As New BindingList(Of Song) Dim ErrorMsgs As New List(Of String) Event ReadProgress(Caption As String, Description As String) Dim dtPlaylist As DataTable Dim dvPlaylist As DataView Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load prepareGrid() preparePlaylist() GetSongsFromDB() 'Playlist erstmal ausblenden, da noch nicht in Benutzung splLibraryPlaylists.PanelVisibility = DevExpress.XtraEditors.SplitPanelVisibility.Panel1 End Sub Private Sub preparePlaylist() dtPlaylist = New DataTable For Each prop As PropertyInfo In GetType(Song).GetProperties() dtPlaylist.Columns.Add(prop.Name) Next dvPlaylist = New DataView(dtPlaylist) grdPlaylist.DataSource = dvPlaylist With grdvPlaylist .PopulateColumns() .OptionsBehavior.AllowAddRows = DevExpress.Utils.DefaultBoolean.True End With End Sub Private Sub prepareGrid() grdSongs.DataSource = Songs grdvSongs.PopulateColumns() With grdvSongs .OptionsBehavior.Editable = True For Each col As GridColumn In grdvSongs.Columns col.OptionsColumn.AllowEdit = False Next .Columns(NameOf(Song.IsFavorite)).OptionsColumn.AllowEdit = True .Columns(NameOf(Song.ID)).Visible = False .Columns(NameOf(Song.SongInfos)).Visible = False .Columns(NameOf(Song.Coverfile)).Visible = False .Columns(NameOf(Song.Songfile)).Visible = False .Columns(NameOf(Song.Videofile)).Visible = False .Columns(NameOf(Song.HasError)).Visible = False .Columns(NameOf(Song.ErrorText)).Visible = False .Columns(NameOf(Song.RootDir)).Visible = False .Columns(NameOf(Song.SubDirectory)).Visible = False .Columns(NameOf(Song.InfoFile)).Visible = False '.Columns(NameOf(Song.Language)).Visible = False '.Columns(NameOf(Song.Genre)).Visible = False .Columns(NameOf(Song.BPM)).Visible = False .Columns(NameOf(Song.GAP)).Visible = False .Columns(NameOf(Song.Previewstart)).Visible = False .Columns(NameOf(Song.FullPath)).Visible = False .Columns(NameOf(Song.FolderName)).Visible = False .Columns(NameOf(Song.ExistsInUltrastar)).Visible = False .Columns(NameOf(Song.Songfilename)).Visible = False .Columns(NameOf(Song.VideoFilename)).Visible = False .Columns(NameOf(Song.CoverFilename)).Visible = False .Columns(NameOf(Song.Artist)).SortIndex = 0 .Columns(NameOf(Song.Artist)).Caption = "Künstler" .Columns(NameOf(Song.Title)).SortIndex = 1 .Columns(NameOf(Song.Title)).Caption = "Titel" .Columns(NameOf(Song.ParentFolderName)).SortIndex = 2 .Columns(NameOf(Song.ParentFolderName)).Caption = "Ordnername" .Columns(NameOf(Song.HasError)).Caption = "Fehlerhaft" .Columns(NameOf(Song.Language)).Caption = "Sprache" .Columns(NameOf(Song.Year)).Caption = "Jahr" .Columns(NameOf(Song.IsFavorite)).Caption = "Favorit" .Columns(NameOf(Song.IsFavorite)).VisibleIndex = 0 .Columns(NameOf(Song.SongInfoCount)).Visible = False ' .Columns(NameOf(Song.ParentFolderName)).GroupIndex = 0 grdvSongs.ActiveFilter.Add(.Columns(NameOf(Song.HasError)), New ColumnFilterInfo($"[{NameOf(Song.HasError)}] = FALSE")) Dim rule As GridFormatRule rule = New GridFormatRule With { .Column = grdvSongs.Columns(NameOf(Song.IsFavorite)), .ApplyToRow = True, .Rule = New DevExpress.XtraEditors.FormatConditionRuleValue With { .Condition = DevExpress.XtraEditors.FormatCondition.Equal, .Value1 = True } } rule.RuleCast(Of DevExpress.XtraEditors.FormatConditionRuleValue).Appearance.BackColor = Color.LightYellow grdvSongs.FormatRules.Add(rule) rule = New GridFormatRule With { .Column = grdvSongs.Columns(NameOf(Song.ExistsInUltrastar)), .ApplyToRow = True, .Rule = New DevExpress.XtraEditors.FormatConditionRuleValue With { .Condition = DevExpress.XtraEditors.FormatCondition.Equal, .Value1 = True } } rule.RuleCast(Of DevExpress.XtraEditors.FormatConditionRuleValue).Appearance.BackColor = Color.LightGreen grdvSongs.FormatRules.Add(rule) End With End Sub Private Sub grdvPlaylist_DragDrop(sender As Object, e As DragDropEventArgs) End Sub Private Sub grdvSongs_DragDrop(sender As Object, e As DragDropEventArgs) ' Throw New NotImplementedException() End Sub Private Sub btnSettings_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnSettings.ItemClick Dim frm As New frmSettings frm.ShowDialog() End Sub Private Sub btnReread_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnReread.ItemClick ScanLibrary() End Sub Private Async Sub GetSongsFromDB() grdvSongs.BeginDataUpdate() Dim songlist As BindingList(Of Song) = Await SongRepository.GetSongs Songs.Clear() For Each s As Song In songlist Songs.Add(s) Next CheckFavorites() grdvSongs.EndDataUpdate() grdvSongs.BestFitColumns() End Sub Private Async Sub ScanLibrary() Dim Pfade As List(Of String) = Await LibraryRepository.GetLibraries() 'Ordner auslesen prgMain.Visible = True Await Task.Run(Function() Return ImportSongsToDB(Pfade) End Function) prgMain.Visible = False ErrorMsgs.Clear() If Pfade.Count = 0 Then ErrorMsgs.Add("Es sind keine Pfade hinterlegt.") If ErrorMsgs.Count > 0 Then MessageBox.Show(String.Join(vbCrLf, ErrorMsgs), Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Error) End If GetSongsFromDB() End Sub Private Function ImportSongsToDB(Pfade As List(Of String)) As Boolean Dim FavDirExists As Boolean = Directory.Exists(My.Settings.UltraStarDirectory) Dim UltrastarDir As String = My.Settings.UltraStarDirectory If UltrastarDir.EndsWith("\") = False Then UltrastarDir &= "\" Dim songinfofiles() As String Dim duetinfofiles() As String Dim song As Song Dim songsread As UInt64 Dim templist As New List(Of Song) For Each pfad As String In Pfade If Directory.Exists(pfad) Then For Each ordner As String In Directory.GetDirectories(pfad, "*", SearchOption.AllDirectories) 'ordner = Einzelne liederordner If Directory.GetFiles(ordner, "*.mp3").Count > 0 Then 'Wenn es sich um einen Ordner handelt, der einen Song enthält (und nicht irgendein übergeordneter Ordner ist) songinfofiles = Directory.GetFiles(ordner, "*.txt") duetinfofiles = Directory.GetFiles(ordner, "*.txd") song = New Song song.RootDir = pfad & "\" song.SubDirectory = ordner.Substring(pfad.Length + 1) If songinfofiles.Count = 0 AndAlso duetinfofiles.Count = 0 Then song.ErrorText = $"{songinfofiles.Count} Textdateien gefunden" song.HasError = True Else If songinfofiles.Count > 0 Then song.InfoFile = songinfofiles.FirstOrDefault Else song.InfoFile = duetinfofiles.FirstOrDefault End If song.ReadInfoFile() End If If FavDirExists Then song.IsFavorite = Directory.Exists(UltrastarDir & song.FolderName) templist.Add(song) End If songsread += CType(1, UInt64) RaiseEvent ReadProgress("Songs werden eingelesen...", $"{songsread} Songs") Next Else ErrorMsgs.Add($"Der Pfad {pfad} existiert nicht oder konnte nicht gelesen werden.") End If Next SongRepository.DeleteAllSongs() SongRepository.SaveSongs(templist) Return True End Function Private Sub CheckFavorites() Dim FavDir As String = My.Settings.UltraStarDirectory If FavDir.EndsWith("\") = False Then FavDir &= "\" If Directory.Exists(FavDir) Then For Each s As Song In Songs If Directory.Exists(FavDir & s.FolderName) Then s.ExistsInUltrastar = True Else s.ExistsInUltrastar = False End If Next Else For Each s As Song In Songs s.ExistsInUltrastar = False Next End If End Sub Private Sub ReadSongFolder_Progress(Caption As String, Description As String) Handles Me.ReadProgress prgMain.Invoke(Sub() prgMain.Caption = Caption prgMain.Description = Description End Sub) End Sub Private Sub grdvSongs_RowClick(sender As Object, e As RowClickEventArgs) Handles grdvSongs.RowClick If e.Clicks = 2 AndAlso e.Button = MouseButtons.Left Then Dim s As Song = CType(grdvSongs.GetFocusedRow, Song) avPlayer.Play(s) End If End Sub Private Sub grdvSongs_FocusedRowChanged(sender As Object, e As FocusedRowChangedEventArgs) Handles grdvSongs.FocusedRowChanged Dim s As Song = TryCast(grdvSongs.GetFocusedRow, Song) If s Is Nothing Then grdSongInfos.DataSource = Nothing Exit Sub End If If s.SongInfos Is Nothing Then grdSongInfos.DataSource = Nothing Else grdSongInfos.DataSource = s.SongInfos grdvSongInfos.PopulateColumns() End If End Sub Private Sub menCopy_Click(sender As Object, e As EventArgs) Handles menCopy.Click Dim pfade As New Specialized.StringCollection For Each rh As Integer In grdvSongs.GetSelectedRows pfade.Add(CStr(grdvSongs.GetRowCellValue(rh, NameOf(Song.FullPath)))) Next Dim datas As New DataObject datas.SetFileDropList(pfade) Clipboard.SetDataObject(datas) End Sub Private Sub menOpenFolder_Click(sender As Object, e As EventArgs) Handles menOpenFolder.Click Dim pfad As String = CStr(grdvSongs.GetRowCellValue(grdvSongs.FocusedRowHandle, NameOf(Song.FullPath))) If pfad IsNot Nothing AndAlso Directory.Exists(pfad) Then Process.Start("explorer.exe", pfad) End If End Sub 'Private downHitInfo As GridHitInfo = Nothing 'Private Sub grdvSongs_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles grdvSongs.MouseDown ' Dim view As GridView = TryCast(sender, GridView) ' downHitInfo = Nothing ' Dim hitInfo As GridHitInfo = view.CalcHitInfo(New Point(e.X, e.Y)) ' If Control.ModifierKeys <> Keys.None Then ' Return ' End If ' If e.Button = MouseButtons.Left AndAlso hitInfo.InRow AndAlso hitInfo.RowHandle <> GridControl.NewItemRowHandle Then ' downHitInfo = hitInfo ' End If 'End Sub 'Private Sub grdvSongs_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles grdvSongs.MouseMove ' Dim view As GridView = TryCast(sender, GridView) ' If e.Button = MouseButtons.Left AndAlso downHitInfo IsNot Nothing Then ' Dim dragSize As Size = SystemInformation.DragSize ' Dim dragRect As New Rectangle(New Point(downHitInfo.HitPoint.X - dragSize.Width \ 2, downHitInfo.HitPoint.Y - dragSize.Height \ 2), dragSize) ' If (Not dragRect.Contains(New Point(e.X, e.Y))) Then ' Dim pfade As New Specialized.StringCollection ' For Each rh As Integer In grdvSongs.GetSelectedRows ' pfade.Add(CStr(grdvSongs.GetRowCellValue(rh, NameOf(Song.FullPath)))) ' Next ' Dim datas As New DataObject ' datas.SetFileDropList(pfade) ' 'view.GridControl.DoDragDrop(downHitInfo, DragDropEffects.All) ' view.GridControl.DoDragDrop(datas, DragDropEffects.Copy) ' downHitInfo = Nothing ' End If ' End If 'End Sub Private Sub cmsSongs_Opening(sender As Object, e As CancelEventArgs) Handles cmsSongs.Opening Dim hi As GridHitInfo = grdvSongs.CalcHitInfo(grdSongs.PointToClient(Cursor.Position)) If hi.InRow = False Then e.Cancel = True End If End Sub Private Async Sub btnSave_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnSave.ItemClick grdvSongs.CloseEditor() Dim FavDir = My.Settings.UltraStarDirectory Dim ToAddToFavs As List(Of Song) = Songs.Where(Function(s) s.IsFavorite = True AndAlso s.ExistsInUltrastar = False).ToList Dim ToDeleteFromFavs As List(Of Song) = Songs.Where(Function(s) s.IsFavorite = False AndAlso s.ExistsInUltrastar = True).ToList If ToDeleteFromFavs.Count > 0 Then If MessageBox.Show($"Sind Sie sicher, dass Sie {ToDeleteFromFavs.Count} Lieder aus dem Favoritenverzeichnis entfernen möchten?{vbCrLf}Diese werden nicht in die ursprünglichen Verzeichnisse kopiert, daher sollten Sie ggf. sicherstellen ob diese Songs noch in den ursprünglichen Verzeichnissen vorhanden sind.{vbCrLf}{vbCrLf}Möchten Sie fortfahren?", "Löschen von Favoriten", MessageBoxButtons.YesNo, MessageBoxIcon.Warning) <> DialogResult.Yes Then Exit Sub End If End If grdvSongs.BeginDataUpdate() prgMain.Visible = True Await Task.Run(Sub() SyncPlaylistToUltrastarDir(Songs)) prgMain.Visible = False grdvSongs.EndDataUpdate() End Sub Private Async Sub SyncPlaylistToUltrastarDir(songlist As BindingList(Of Song)) Dim ToAddToFavs As List(Of Song) = songlist.Where(Function(s) s.IsFavorite = True AndAlso s.ExistsInUltrastar = False).ToList Dim ToDeleteFromFavs As List(Of Song) = songlist.Where(Function(s) s.IsFavorite = False AndAlso s.ExistsInUltrastar = True).ToList Dim FavDir = My.Settings.UltraStarDirectory Dim errors As New List(Of String) Dim con As SQLiteConnection = DB.getConnection Dim cmd As New SQLiteCommand(Nothing, con) cmd.Parameters.Add("@id", DbType.Int32) cmd.Parameters.Add("@favorite", DbType.Boolean) cmd.CommandText = "UPDATE t_songs SET S_Favorite = @favorite WHERE S_ID = @id" Await con.OpenAsync 'Favoriten, die noch nicht im FavDir existieren, setzen Dim songcount As Integer = 1 For Each song In ToAddToFavs RaiseEvent ReadProgress("Aktualisiere Favoriten...", $"{songcount}\{ToAddToFavs.Count} Songs kopiert") Dim targetdir As String = FavDir & "\" & song.FolderName Try 'In Favoriten hinzufügen, auch wenn kopieren fehlschlägt cmd.Parameters("@id").Value = song.ID cmd.Parameters("@favorite").Value = song.IsFavorite Await cmd.ExecuteNonQueryAsync() FileFunctions.CopyDirectory(song.FullPath, targetdir) Catch ex As Exception errors.Add($"Kopieren von '{song.FolderName}' ins Favoritenverzeichnis fehlgeschlagen:{vbCrLf} -> {ex.Message}") End Try If Directory.Exists(targetdir) Then song.ExistsInUltrastar = True End If songcount += 1 Next 'Favoriten, die keine Favoriten mehr sind, entfernen songcount = 1 For Each song In ToDeleteFromFavs RaiseEvent ReadProgress("Aktualisiere Favoriten...", $"{songcount}\{ToDeleteFromFavs.Count} Songs entfernt") Dim targetdir As String = FavDir & "\" & song.FolderName Try 'Von Favoriten entfernen, auch wenn löschen fehlschlägt. cmd.Parameters("@id").Value = song.ID cmd.Parameters("@favorite").Value = song.IsFavorite Await cmd.ExecuteNonQueryAsync Directory.Delete(targetdir, True) Catch ex As Exception errors.Add($"Löschen von '{song.FolderName}' aus dem Favoritenverzeichnis fehlgeschlagen:{vbCrLf} -> {ex.Message}") End Try If Directory.Exists(targetdir) = False Then song.ExistsInUltrastar = False songcount += 1 Next con.Close() If errors.Count > 0 Then Me.Invoke(Sub() Dim frm As New frmErrorList(errors) frm.ShowDialog() End Sub) End If End Sub Private Sub btnPrint_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnPrint.ItemClick If Songs.LongCount(Function(s) s.ExistsInUltrastar = False AndAlso s.IsFavorite = True) > 0 Then End If Dim rep As New repFavoritesList Dim ReportList As New List(Of Song) For Each song As Song In Songs.Where(Function(s) s.ExistsInUltrastar = True).OrderBy(Function(s) s.Artist.Trim().ToLower()).ThenBy(Function(s) s.Title.Trim().ToLower) If ReportList.Exists(Function(s) s.Artist.Trim().ToLower() = song.Artist.Trim().ToLower() AndAlso s.Title.Trim.ToLower = song.Title.Trim.ToLower) = False Then ReportList.Add(song) End If Next rep.DataSource = ReportList If SFD.ShowDialog = DialogResult.OK Then Try rep.ExportToPdf(SFD.FileName) Catch ex As Exception MessageBox.Show($"Die Datei konnte nicht gespeichert werden: {ex.Message}", "Fehler beim Speichern der Datei", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try If File.Exists(SFD.FileName) Then Try Process.Start(SFD.FileName) Catch ex As Exception MessageBox.Show($"Die Datei konnte nicht geöffnet werden: {ex.Message}", "Fehler beim Öffnen der Datei", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try End If End If 'rep.ShowPreview() End Sub Private Sub frmMain_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing avPlayer.Stop() End Sub Private Sub grdvPlaylist_DragObjectOver(sender As Object, e As DragObjectOverEventArgs) Handles grdvPlaylist.DragObjectOver Console.WriteLine(e.DragObject.ToString()) End Sub End Class