' Copyright (C) 2023 Andy https://github.com/AAndyProgram ' This program is free software: you can redistribute it and/or modify ' it under the terms of the GNU General Public License as published by ' the Free Software Foundation, either version 3 of the License, or ' (at your option) any later version. ' ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY Imports System.Threading Imports System.ComponentModel Imports PersonalUtilities.Forms Imports PersonalUtilities.Functions.Messaging Imports PersonalUtilities.Tools Imports SCrawler.API Imports SCrawler.API.Base Imports SCrawler.Editors Imports SCrawler.DownloadObjects Imports SCrawler.Plugin.Hosts Imports PauseModes = SCrawler.DownloadObjects.AutoDownloader.PauseModes Public Class MainFrame #Region "Declarations" Private MyView As FormView Private WithEvents MyActivator As FormActivator Private WithEvents BTT_IMPORT_USERS As ToolStripMenuItem Private WithEvents BTT_NEW_PROFILE As ToolStripMenuItem Friend MyChannels As ChannelViewForm Friend MySavedPosts As DownloadSavedPostsForm Private MyMissingPosts As MissingPostsForm Private DownloadQueue As UserDownloadQueueForm Private MyFeed As DownloadFeedForm Private MySearch As UserSearchForm Private MyUserMetrics As UsersInfoForm = Nothing Private _UFinit As Boolean = True #End Region #Region "Initializer" Public Sub New() InitializeComponent() Settings = New SettingsCLS With Settings.Plugins If .Count > 0 Then For i% = 0 To .Count - 1 If Not .Item(i).Key = PathPlugin.PluginKey Then _ MENU_SETTINGS.DropDownItems.Insert(MENU_SETTINGS.DropDownItems.Count - 2, .Item(i).Settings.GetSettingsButton) Next End If End With BTT_IMPORT_USERS = New ToolStripMenuItem("Import", My.Resources.UsersIcon_32.ToBitmap) BTT_NEW_PROFILE = New ToolStripMenuItem("Add new profile", My.Resources.PlusPic_24) MENU_SETTINGS.DropDownItems.Insert(MENU_SETTINGS.DropDownItems.Count - 2, New ToolStripSeparator) MENU_SETTINGS.DropDownItems.Insert(MENU_SETTINGS.DropDownItems.Count - 2, BTT_NEW_PROFILE) MENU_SETTINGS.DropDownItems.AddRange({New ToolStripSeparator, BTT_IMPORT_USERS}) BTT_BUG_REPORT.Image = My.Resources.MailPic_16 End Sub #End Region #Region "Form handlers" Private Async Sub MainFrame_Load(sender As Object, e As EventArgs) Handles Me.Load If Now.Month.ValueBetween(6, 8) Then Text = "SCrawler: Happy LGBT Pride Month! :-)" ElseIf Not Settings.ProgramText.IsEmptyString Then Text = Settings.ProgramText End If Settings.DeleteCachePath() MainFrameObj = New MainFrameObjects(Me) MainFrameObj.ChangeCloseVisible() MainFrameObj.PauseButtons.AddButtons() STDownloader.MyNotificator = MainFrameObj STDownloader.MyDownloaderSettings = Settings YouTube.MyCache = Settings.Cache YouTube.MyYouTubeSettings = New YouTube.YTSettings_Internal UpdateYouTubeSettings() MainProgress = New MyProgressExt(Toolbar_BOTTOM, PR_MAIN, PR_PRE, LBL_STATUS, "Downloading profiles' data") With { .ResetProgressOnMaximumChanges = False, .Visible = False} Downloader = New TDownloader InfoForm = New DownloadedInfoForm DownloadQueue = New UserDownloadQueueForm MyProgressForm = New ActiveDownloadingProgress Downloader.ReconfPool() AddHandler Downloader.JobsChange, AddressOf Downloader_UpdateJobsCount AddHandler Downloader.Downloading, AddressOf Downloader_Downloading AddHandler Downloader.DownloadCountChange, AddressOf InfoForm.Downloader_DownloadCountChange AddHandler Downloader.SendNotification, AddressOf MainFrameObj.ShowNotification AddHandler Downloader.UserDownloadStateChanged, AddressOf DownloadQueue.Downloader_UserDownloadStateChanged AddHandler Downloader.Downloading, AddressOf DownloadQueue.Downloader_Downloading AddHandler InfoForm.UserFind, AddressOf FocusUser Settings.LoadUsers() MyView = New FormView(Me) MyView.Import(Settings.Design) MyView.SetFormSize() If Settings.CloseToTray Then TrayIcon.Visible = True MyActivator = New FormActivator(Me) With LIST_PROFILES.Groups .AddRange(GetLviGroupName(Nothing, True)) 'collections If Settings.Plugins.Count > 0 Then For Each h As SettingsHost In Settings.Plugins.Select(Function(hh) hh.Settings.Default) : .AddRange(GetLviGroupName(h, False)) : Next End If If Settings.Labels.Count > 0 Then Settings.Labels.ToList.ForEach(Sub(l) .Add(New ListViewGroup(l, l))) .Add(Settings.Labels.NoLabel) End With With Settings LIST_PROFILES.View = .ViewMode LIST_PROFILES.ShowGroups = .UseGrouping ApplyViewPattern(.ViewMode.Value) AddHandler .Labels.NewLabelAdded, AddressOf UpdateLabelsGroups UpdateImageColor() UserListLoader = New ListImagesLoader(LIST_PROFILES) RefillList() UpdateLabelsGroups() SetShowButtonsCheckers(.ShowingMode.Value) CheckVersion(False) BTT_MODE_SHOW_USERS.Checked = .MainFrameUsersShowDefaults BTT_MODE_SHOW_SUBSCRIPTIONS.Checked = .MainFrameUsersShowSubscriptions BTT_SITE_ALL.Checked = .SelectedSites.Count = 0 BTT_SITE_SPECIFIC.Checked = .SelectedSites.Count > 0 BTT_SHOW_LIMIT_DATES_NOT.Tag = ShowingDates.Not BTT_SHOW_LIMIT_DATES_NOT.Checked = .ViewDateMode.Value = ShowingDates.Not BTT_SHOW_LIMIT_DATES_IN.Tag = ShowingDates.In BTT_SHOW_LIMIT_DATES_IN.Checked = .ViewDateMode.Value = ShowingDates.In With .Groups AddHandler .Added, AddressOf GROUPS_Added AddHandler .Deleted, AddressOf GROUPS_Deleted AddHandler .Updated, AddressOf GROUPS_Updated If .Count > 0 Then For Each ugroup As Groups.DownloadGroup In Settings.Groups : GROUPS_Added(ugroup) : Next End If End With .Automation = New Scheduler AddHandler .Groups.Updated, AddressOf .Automation.GROUPS_Updated AddHandler .Groups.Deleted, AddressOf .Automation.GROUPS_Deleted AddHandler .Automation.PauseChanged, AddressOf MainFrameObj.PauseButtons.UpdatePauseButtons_Handler If .Automation.Count > 0 Then .Labels.AddRange(.Automation.GetGroupsLabels, False) : .Labels.Update() _UFinit = False Await .Automation.Start(True) End With UpdatePauseButtonsVisibility() MainFrameObj.UpdateLogButton() End Sub Private _CloseInvoked As Boolean = False Private _IgnoreTrayOptions As Boolean = False Private _IgnoreCloseConfirm As Boolean = False Private Async Sub MainFrame_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing If Settings.CloseToTray And Not _IgnoreTrayOptions Then e.Cancel = True Hide() Else If CheckForClose(_IgnoreCloseConfirm) Then If _CloseInvoked Then GoTo CloseResume Dim ChannelsWorking As Func(Of Boolean) = Function() If(MyChannels?.Working, False) Dim SP_Working As Func(Of Boolean) = Function() If(MySavedPosts?.Working, False) If (Not Downloader.Working And Not ChannelsWorking.Invoke And Not SP_Working.Invoke) OrElse MsgBoxE({"The program is still downloading something..." & vbNewLine & "Are you sure you want to stop downloading and exit the program?", "Downloading in progress"}, MsgBoxStyle.Exclamation,,, {"Stop downloading and close", "Cancel"}) = 0 Then If Downloader.Working Then _CloseInvoked = True : Downloader.Stop() If ChannelsWorking.Invoke Then _CloseInvoked = True : MyChannels.Stop(False) If SP_Working.Invoke Then _CloseInvoked = True : MySavedPosts.Stop() MyActivator.DisposeIfReady() Settings.Automation.Stop() If _CloseInvoked Then e.Cancel = True Await Task.Run(Sub() While Downloader.Working Or ChannelsWorking.Invoke Or SP_Working.Invoke : Thread.Sleep(500) : End While End Sub) End If Downloader.Dispose() MyProgressForm.Dispose() InfoForm.Dispose() DownloadQueue.DisposeIfReady() MyMissingPosts.DisposeIfReady() MyFeed.DisposeIfReady() MainFrameObj.ClearNotifications() MainFrameObj.PauseButtons.Dispose() MyChannels.DisposeIfReady() VideoDownloader.DisposeIfReady() MySavedPosts.DisposeIfReady() MySearch.DisposeIfReady() MyUserMetrics.DisposeIfReady() MyView.Dispose(Settings.Design) Settings.Dispose() Else GoTo DropCloseParams End If Else GoTo DropCloseParams End If GoTo CloseContinue DropCloseParams: e.Cancel = True _IgnoreTrayOptions = False _IgnoreCloseConfirm = False _CloseInvoked = False Exit Sub CloseContinue: If Not BATCH Is Nothing Then BATCH.Dispose() : BATCH = Nothing If _CloseInvoked Then Close() CloseResume: End If End Sub Private _DisableClosingScript As Boolean = False Private Sub MainFrame_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed If Not _DisableClosingScript Then ExecuteCommand(Settings.ClosingCommand) If Not MyMainLOG.IsEmptyString Then SaveLogToFile() End Sub Private Sub MainFrame_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd If Not _UFinit Then UpdateImageColor() End Sub Private ListImageLastWidth As Integer = -1 Private Sub UpdateImageColor(Optional ByVal UpdateOnlyImage As Boolean = False) Try If Settings.UserListImage.Value.Exists Then If Not ListImageLastWidth = LIST_PROFILES.Width Or LIST_PROFILES.BackgroundImage Is Nothing Then ListImageLastWidth = LIST_PROFILES.Width Using ir As New ImageRenderer(Settings.UserListImage) : LIST_PROFILES.BackgroundImage = ir.FitToWidth(LIST_PROFILES.Width) : End Using End If Else LIST_PROFILES.BackgroundImage = Nothing End If If Not UpdateOnlyImage Then With Settings If Not .UserListBackColorF = LIST_PROFILES.BackColor Or Not .UserListForeColorF = LIST_PROFILES.ForeColor Then LIST_PROFILES.BackColor = .UserListBackColorF LIST_PROFILES.ForeColor = .UserListForeColorF End If End With End If Catch ex As Exception End Try End Sub Private Sub MainFrame_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown Dim b As Boolean = True Select Case e.KeyCode Case Keys.Insert : BTT_ADD_USER_Click(Me, New Controls.KeyClick.KeyClickEventArgs(e)) Case Keys.Delete : DeleteSelectedUser() Case Keys.Enter : OpenFolder() Case Keys.F1 : BTT_VERSION_INFO.PerformClick() Case Keys.F3 : EditSelectedUser() Case Keys.F5 : DownloadSelectedUser(DownUserLimits.None, New MyKeyEventArgs(e).IncludeInTheFeed) Case Keys.F6 : BTT_DOWN_ALL_FULL_KeyClick(Nothing, New MyKeyEventArgs(e)) Case Else : b = NumGroup(e) End Select If Not b And e.Control And e.KeyCode = Keys.F Then MySearch.FormShow() : b = True If b Then e.Handled = True End Sub Private Function NumGroup(ByVal e As KeyEventArgs) As Boolean Dim GroupExists As Func(Of Integer, Boolean) = Function(i) Settings.Groups.DownloadGroupIfExists(i - 1) If e.Control And Settings.Groups.Count > 0 Then Select Case e.KeyCode Case Keys.D1, Keys.NumPad1 : Return GroupExists(1) Case Keys.D2, Keys.NumPad2 : Return GroupExists(2) Case Keys.D3, Keys.NumPad3 : Return GroupExists(3) Case Keys.D4, Keys.NumPad4 : Return GroupExists(4) Case Keys.D5, Keys.NumPad5 : Return GroupExists(5) Case Keys.D6, Keys.NumPad6 : Return GroupExists(6) Case Keys.D7, Keys.NumPad7 : Return GroupExists(7) Case Keys.D8, Keys.NumPad8 : Return GroupExists(8) Case Keys.D9, Keys.NumPad9 : Return GroupExists(9) End Select End If Return False End Function #End Region #Region "Form Tray" Private Sub MyActivator_TrayIconClick(Sender As Object, e As Controls.KeyClick.KeyClickEventArgs) Handles MyActivator.TrayIconClick If e.Control Then ShowFeed() : e.Handled = True End Sub Private Sub BTT_TRAY_SHOW_HIDE_Click(sender As Object, e As EventArgs) Handles BTT_TRAY_SHOW_HIDE.Click If Visible Then Hide() Else Show() End Sub Private Sub BTT_TRAY_CLOSE_Click(sender As Object, e As EventArgs) Handles BTT_TRAY_CLOSE.Click ClosePressed(False) End Sub Private Sub BTT_TRAY_CLOSE_NO_SCRIPT_Click(sender As Object, e As EventArgs) Handles BTT_TRAY_CLOSE_NO_SCRIPT.Click ClosePressed(True) End Sub Private Sub ClosePressed(ByVal DisableScript As Boolean) _DisableClosingScript = DisableScript If CheckForClose(False) Then _IgnoreTrayOptions = True : _IgnoreCloseConfirm = True : Close() End Sub Private Function CheckForClose(ByVal _Ignore As Boolean) As Boolean If Settings.ExitConfirm And Not _Ignore Then Return MsgBoxE({"Do you want to close the program?", "Closing the program"}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes Else Return True End If End Function #End Region #Region "List refill, update" Friend Sub RefillList() UpdateImageColor(True) UserListLoader.Update() End Sub Private Sub UserListUpdate(ByVal User As IUserData, ByVal Add As Boolean) UserListLoader.UpdateUser(User, Add) End Sub #End Region #Region "Toolbar buttons" #Region "Settings" Private Sub BTT_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS.Click With Settings Dim mhl% = .MaxLargeImageHeight.Value Dim mhs% = .MaxSmallImageHeight.Value Dim sg As Boolean = .ShowGroups Using f As New GlobalSettingsForm f.ShowDialog() If f.DialogResult = DialogResult.OK Then UpdateYouTubeSettings() If ((Not .MaxLargeImageHeight = mhl Or Not .MaxSmallImageHeight = mhs) And .ViewModeIsPicture) Or (Not sg = Settings.ShowGroups And .UseGrouping) Then RefillList() TrayIcon.Visible = .CloseToTray LIST_PROFILES.ShowGroups = .UseGrouping If f.FeedParametersChanged And Not MyFeed Is Nothing Then MyFeed.UpdateSettings() UpdateSilentButtons() UpdateImageColor() End If End Using End With End Sub Private Sub UpdateYouTubeSettings() With YouTube.MyYouTubeSettings If Not .YTDLP.Value.Exists And Settings.YtdlpFile.Exists Then .YTDLP.Value = Settings.YtdlpFile.File If Not .FFMPEG.Value.Exists And Settings.FfmpegFile.Exists Then .FFMPEG.Value = Settings.FfmpegFile.File If .OutputPath.IsEmptyString And Not Settings.LatestSavingPath.IsEmptyString Then .OutputPath.Value = Settings.LatestSavingPath.Value End With End Sub Private Sub BTT_NEW_PROFILE_Click(sender As Object, e As EventArgs) Handles BTT_NEW_PROFILE.Click Try Using f As New SimpleListForm(Of PluginHost)(Settings.Plugins, Settings.Design) With { .DesignXMLNodeName = "PluginsChooserForm", .Mode = SimpleListFormModes.SelectedItems, .MultiSelect = False, .FormText = "Available plugins", .Icon = My.Resources.SettingsIcon_48 } If f.ShowDialog = DialogResult.OK AndAlso f.DataResult.Count > 0 Then f.DataResult.First.Settings.CreateAbstract() End Using Catch ex As Exception ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "MainFrame.CreateNewProfile]") End Try End Sub Private Sub BTT_IMPORT_USERS_Click(sender As Object, e As EventArgs) Handles BTT_IMPORT_USERS.Click Const MsgTitle$ = "Import users" Try Dim file As SFile = Nothing Dim _OriginalLocations As Boolean = False Select Case MsgBoxE({"Where do you want to import users from?" & vbCr & vbCr & "This feature is not for importing users from the site. It's more like searching for missing users.", MsgTitle}, vbQuestion,,, {"Select path", New MsgBoxButton("Current", "All plugin paths will be checked"), "Cancel"}).Index Case 0 : file = SFile.SelectPath Case 1 : _OriginalLocations = True Case Else : MsgBoxE({"Operation canceled", MsgTitle}) : Exit Sub End Select If Not file.IsEmptyString Or _OriginalLocations Then Using import As New UserFinder(file) With import .Find(_OriginalLocations) If .Count > 0 Then .Verify() .Dialog() Else MsgBoxE({"No users found", MsgTitle}) End If End With End Using End If Catch ex As Exception ErrorsDescriber.Execute(EDP.LogMessageValue, ex, MsgTitle) End Try End Sub #End Region #Region "Add, Edit, Delete, Refresh" Private Sub OnUsersAddedHandler(ByVal StartIndex As Integer) If StartIndex <= Settings.Users.Count - 1 Then For i% = StartIndex To Settings.Users.Count - 1 : UserListUpdate(Settings.Users(i), True) : Next End If End Sub Private Sub BTT_ADD_USER_Click(ByVal Sender As Object, ByVal e As Controls.KeyClick.KeyClickEventArgs) Handles BTT_ADD_USER.KeyClick Dim f As UserCreatorForm = Nothing If e.Control Then Dim tmpBufferUrl$ = BufferText If Not tmpBufferUrl.IsEmptyString Then f = UserCreatorForm.TryCreate(tmpBufferUrl) End If If f Is Nothing Then f = New UserCreatorForm f.ShowDialog() If Not (f.DialogResult = DialogResult.OK Or f.StartIndex >= 0) Then f.Dispose() : f = Nothing End If If Not f Is Nothing Then Dim i% If f.StartIndex >= 0 Then OnUsersAddedHandler(f.StartIndex) Else Dim SimpleUser As Predicate(Of IUserData) = Function(u) u.Site = f.User.Site And u.Name = f.User.Name i = Settings.Users.FindIndex(Function(u) If(u.IsCollection, DirectCast(u, UserDataBind).Collections.Exists(SimpleUser), SimpleUser.Invoke(u))) If i < 0 Then If Not UserBanned(f.User.Name) Then Settings.UpdateUsersList(f.User) Settings.Users.Add(UserDataBase.GetInstance(f.User)) With Settings.Users.Last If Not .FileExists Then .Options = f.Options .Favorite = f.UserFavorite .Temporary = f.UserTemporary .ParseUserMediaOnly = f.UserMediaOnly .ReadyForDownload = f.UserReady .DownloadImages = f.DownloadImages .DownloadVideos = f.DownloadVideos .FriendlyName = f.UserFriendly .BackColor = f.UserBackColor .ForeColor = f.UserForeColor .Description = f.UserDescr .ScriptUse = f.ScriptUse .ScriptData = f.ScriptData If Not f.MyExchangeOptions Is Nothing Then DirectCast(.Self, UserDataBase).ExchangeOptionsSet(f.MyExchangeOptions) If Not .HOST.Key = PathPlugin.PluginKey Then Settings.Labels.Add(LabelsKeeper.NoParsedUser) f.UserLabels.ListAddValue(LabelsKeeper.NoParsedUser) End If .Self.Labels.ListAddList(f.UserLabels, LAP.ClearBeforeAdd, LAP.NotContainsOnly) .UpdateUserInformation() End If End With UserListUpdate(Settings.Users.Last, True) FocusUser(Settings.Users(Settings.Users.Count - 1).Key) Else MsgBoxE($"User [{f.User.Name}] was not added") End If Else FocusUser(Settings.Users(i).Key) MsgBoxE($"User [{f.User.Name}] already exists", MsgBoxStyle.Exclamation) End If End If f.Dispose() End If End Sub Private Sub BTT_EDIT_USER_Click(sender As Object, e As EventArgs) Handles BTT_EDIT_USER.Click EditSelectedUser() End Sub Private Sub BTT_DELETE_USER_Click(sender As Object, e As EventArgs) Handles BTT_DELETE_USER.Click DeleteSelectedUser() End Sub Private Sub BTT_REFRESH_Click(sender As Object, e As EventArgs) Handles BTT_REFRESH.Click RefillList() End Sub #End Region #Region "Info, Feed, Channels, Saved posts" #Region "Info" Private Sub MENU_INFO_SHOW_INFO_Click(sender As Object, e As EventArgs) Handles MENU_INFO_SHOW_INFO.Click InfoForm.FormShow(EDP.LogMessageValue) End Sub Private Sub MENU_INFO_SHOW_QUEUE_Click(sender As Object, e As EventArgs) Handles MENU_INFO_SHOW_QUEUE.Click ShowDownloadQueueForm() End Sub Private Sub ShowDownloadQueueForm(Optional ByVal Round As Integer = 0) Try DownloadQueue.FormShow(EDP.LogMessageValue) Catch ex As Exception If Round = 0 Then ErrorsDescriber.Execute(EDP.SendToLog, ex, "ShowDownloadQueueForm_0") If Not DownloadQueue Is Nothing Then DownloadQueue.Dispose() : DownloadQueue = Nothing ShowDownloadQueueForm(Round + 1) Else ErrorsDescriber.Execute(EDP.SendToLog, ex, "ShowDownloadQueueForm") End If End Try End Sub Private Sub MENU_INFO_SHOW_MISSING_Click(sender As Object, e As EventArgs) Handles MENU_INFO_SHOW_MISSING.Click MyMissingPosts.FormShow(EDP.LogMessageValue) End Sub Private Sub MENU_INFO_SHOW_USER_METRICS_Click(sender As Object, e As EventArgs) Handles MENU_INFO_SHOW_USER_METRICS.Click MyUserMetrics.FormShow(EDP.LogMessageValue) End Sub #End Region Private Sub ShowFeed() Handles BTT_FEED.Click, BTT_TRAY_FEED_SHOW.Click If MyFeed Is Nothing Then MyFeed = New DownloadFeedForm : AddHandler Downloader.FeedFilesChanged, AddressOf MyFeed.Downloader_FilesChanged If MyFeed.Visible Then MyFeed.BringToFront() Else MyFeed.Show() End Sub Private Sub BTT_CHANNELS_Click(sender As Object, e As EventArgs) Handles BTT_CHANNELS.Click, BTT_TRAY_CHANNELS.Click If MyChannels Is Nothing Then MyChannels = New ChannelViewForm AddHandler MyChannels.OnUsersAdded, AddressOf OnUsersAddedHandler AddHandler MyChannels.OnDownloadDone, AddressOf MainFrameObj.ShowNotification End If If MyChannels.Visible Then MyChannels.BringToFront() Else MyChannels.Show() End Sub Private Sub BTT_DOWN_SAVED_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_SAVED.Click If MySavedPosts Is Nothing Then MySavedPosts = New DownloadSavedPostsForm AddHandler MySavedPosts.DownloadDone, AddressOf MainFrameObj.ShowNotification End If With MySavedPosts If .Visible Then .BringToFront() Else .Show() End With End Sub #End Region #Region "Download" Private Sub BTT_DOWN_SELECTED_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_SELECTED.KeyClick DownloadSelectedUser(DownUserLimits.None, e.IncludeInTheFeed) End Sub #Region "Down all" Private Sub BTT_DOWN_ALL_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_ALL.KeyClick Downloader.AddRange(Settings.GetUsers(Function(u) u.ReadyForDownload And UserExistsNonSubscriptionsPredicate.Invoke(u)), e.IncludeInTheFeed) End Sub Private Sub BTT_DOWN_ALL_SUBSCR_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_ALL_SUBSCR.KeyClick Downloader.AddRange(Settings.GetUsers(Function(u) u.ReadyForDownload And UserExistsSubscriptionsPredicate.Invoke(u)), e.IncludeInTheFeed) End Sub Private Sub BTT_DOWN_SITE_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_SITE.KeyClick DownloadSiteFull(True, e.IncludeInTheFeed, False) End Sub Private Sub BTT_DOWN_SITE_SUBSCR_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_SITE_SUBSCR.KeyClick DownloadSiteFull(True, e.IncludeInTheFeed, True) End Sub #End Region #Region "Down full" Private Sub BTT_DOWN_ALL_FULL_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_ALL_FULL.KeyClick Downloader.AddRange(Settings.GetUsers(UserExistsNonSubscriptionsPredicate), e.IncludeInTheFeed) End Sub Private Sub BTT_DOWN_ALL_FULL_SUBSCR_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_ALL_FULL_SUBSCR.KeyClick Downloader.AddRange(Settings.GetUsers(UserExistsSubscriptionsPredicate), e.IncludeInTheFeed) End Sub Private Sub BTT_DOWN_SITE_FULL_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_SITE_FULL.KeyClick DownloadSiteFull(False, e.IncludeInTheFeed, False, e.Shift) End Sub Private Sub BTT_DOWN_SITE_FULL_SUBSCR_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_SITE_FULL_SUBSCR.KeyClick DownloadSiteFull(False, e.IncludeInTheFeed, True, e.Shift) End Sub #End Region Private Sub BTT_DOWN_SPEC_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_SPEC.KeyClick Dim group As Groups.DownloadGroup = Nothing Using f As New Groups.GroupEditorForm(Nothing) With {.DownloadMode = True} f.ShowDialog() If f.DialogResult = DialogResult.OK AndAlso Not f.MyGroup Is Nothing Then group = f.MyGroup End Using If Not group Is Nothing Then group.DownloadUsers(e.IncludeInTheFeed,, e.Shift) : group.Dispose() End Sub Private Sub DownloadSiteFull(ByVal ReadyForDownloadOnly As Boolean, ByVal IncludeInTheFeed As Boolean, ByVal Subscription As Boolean, Optional ByVal IgnoreExists As Boolean = False) Using f As New SiteSelectionForm(Settings.LatestDownloadedSites.ValuesList) f.ShowDialog() If f.DialogResult = DialogResult.OK AndAlso f.SelectedSites.Count > 0 Then Settings.LatestDownloadedSites.Clear() Settings.LatestDownloadedSites.AddRange(f.SelectedSites) Settings.LatestDownloadedSites.Update() Using g As New Groups.DownloadGroup g.Sites.AddRange(f.SelectedSites) g.ReadyForDownload = True g.ReadyForDownloadIgnore = Not ReadyForDownloadOnly If Subscription Then g.Subscriptions = True g.SubscriptionsOnly = True End If g.DownloadUsers(IncludeInTheFeed, ReadyForDownloadOnly, IgnoreExists) End Using End If End Using End Sub #Region "Download groups" Private Sub BTT_ADD_NEW_GROUP_Click(sender As Object, e As EventArgs) Handles BTT_ADD_NEW_GROUP.Click Settings.Groups.Add() End Sub Private Sub GROUPS_Added(ByVal Sender As Groups.DownloadGroup) Dim i% = MENU_DOWN_ALL.DropDownItems.IndexOf(BTT_ADD_NEW_GROUP) ControlInvoke(Toolbar_TOP, MENU_DOWN_ALL, Sub() MENU_DOWN_ALL.DropDownItems.Insert(i, Sender.GetControl)) End Sub Private Sub GROUPS_Updated(ByVal Sender As Groups.DownloadGroup) Dim i% = MENU_DOWN_ALL.DropDownItems.IndexOf(Sender.GetControl) If i >= 0 Then ControlInvoke(Toolbar_TOP, MENU_DOWN_ALL, Sub() MENU_DOWN_ALL.DropDownItems(i).Text = Sender.ToString) End Sub Private Sub GROUPS_Deleted(ByVal Sender As Groups.DownloadGroup) MENU_DOWN_ALL.DropDownItems.Remove(Sender.GetControl) End Sub #End Region Private Sub BTT_SILENT_MODE_Click(sender As Object, e As EventArgs) Handles BTT_SILENT_MODE.Click, BTT_TRAY_SILENT_MODE.Click With Settings : .NotificationsSilentMode = Not .NotificationsSilentMode : End With UpdateSilentButtons() End Sub Private Sub UpdateSilentButtons() With Settings ControlInvokeFast(Toolbar_TOP, BTT_SILENT_MODE, Sub() BTT_SILENT_MODE.Checked = .NotificationsSilentMode) ControlInvokeFast(Me, Sub() BTT_TRAY_SILENT_MODE.Checked = .NotificationsSilentMode) End With End Sub Private Sub UpdatePauseButtonsVisibility() Dim b As Boolean = Settings.Automation.Count > 0 ControlInvokeFast(Toolbar_TOP, BTT_DOWN_AUTOMATION_PAUSE, Sub() BTT_DOWN_AUTOMATION_PAUSE.Visible = b) ControlInvokeFast(Me, Sub() BTT_TRAY_PAUSE_AUTOMATION.Visible = b) End Sub Private Async Sub BTT_DOWN_AUTOMATION_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION.Click Try Using f As New SchedulerEditorForm : f.ShowDialog() : End Using Await Settings.Automation.Start(False) UpdatePauseButtonsVisibility() MainFrameObj.PauseButtons.UpdatePauseButtons() Catch ex As Exception ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Start automation") MainFrameObj.UpdateLogButton() End Try End Sub Private Sub BTT_DOWN_AUTOMATION_PAUSE_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION_PAUSE.Click, BTT_TRAY_PAUSE_AUTOMATION.Click Dim p As PauseModes = Settings.Automation.Pause If p = PauseModes.Disabled Then p = PauseModes.Unlimited Else p = PauseModes.Disabled Settings.Automation.Pause = p MENU_DOWN_ALL.HideDropDown() TrayIcon.ContextMenuStrip.Hide() MainFrameObj.PauseButtons.UpdatePauseButtons() End Sub Private Sub BTT_DOWN_VIDEO_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_VIDEO.Click, BTT_TRAY_DOWNLOADER.Click VideoDownloader.FormShow() End Sub Private Sub BTT_DOWN_STOP_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_STOP.Click Downloader.Stop() End Sub #End Region #Region "View" #Region "1 - view mode list" Private Sub BTT_VIEW_LARGE_Click(sender As Object, e As EventArgs) Handles BTT_VIEW_LARGE.Click ApplyViewPattern(ViewModes.IconLarge) End Sub Private Sub BTT_VIEW_SMALL_Click(sender As Object, e As EventArgs) Handles BTT_VIEW_SMALL.Click ApplyViewPattern(ViewModes.IconSmall) End Sub Private Sub BTT_VIEW_LIST_Click(sender As Object, e As EventArgs) Handles BTT_VIEW_LIST.Click ApplyViewPattern(ViewModes.List) End Sub Private Sub BTT_VIEW_DETAILS_Click(sender As Object, e As EventArgs) Handles BTT_VIEW_DETAILS.Click ApplyViewPattern(ViewModes.Details) End Sub Private Sub ApplyViewPattern(ByVal v As ViewModes) LIST_PROFILES.View = v Dim b As Boolean = Not (Settings.ViewMode.Value = v) Settings.ViewMode.Value = v BTT_VIEW_LARGE.Checked = v = ViewModes.IconLarge BTT_VIEW_SMALL.Checked = v = ViewModes.IconSmall BTT_VIEW_LIST.Checked = v = ViewModes.List BTT_VIEW_DETAILS.Checked = v = ViewModes.Details If v = View.Details Then LIST_PROFILES.Columns(0).Width = -2 LIST_PROFILES.FullRowSelect = True LIST_PROFILES.GridLines = True End If If b Then If Settings.ViewModeIsPicture Then With LIST_PROFILES : .LargeImageList.Images.Clear() : .SmallImageList.Images.Clear() : End With End If RefillList() End If End Sub #End Region #Region "2 - view mode users" Private Sub BTT_MODE_SHOW_USERS_Click(sender As Object, e As EventArgs) Handles BTT_MODE_SHOW_USERS.Click Settings.MainFrameUsersShowDefaults.Value = BTT_MODE_SHOW_USERS.Checked RefillList() End Sub Private Sub BTT_MODE_SHOW_SUBSCRIPTIONS_Click(sender As Object, e As EventArgs) Handles BTT_MODE_SHOW_SUBSCRIPTIONS.Click Settings.MainFrameUsersShowSubscriptions.Value = BTT_MODE_SHOW_SUBSCRIPTIONS.Checked RefillList() End Sub #End Region #Region "3 - view site" Private Sub BTT_SITE_ALL_Click(sender As Object, e As EventArgs) Handles BTT_SITE_ALL.Click Settings.SelectedSites.Clear() Settings.SelectedSites.Update() If Not BTT_SITE_ALL.Checked Then RefillList() BTT_SITE_ALL.Checked = True BTT_SITE_SPECIFIC.Checked = False End Sub Private Sub BTT_SITE_SPECIFIC_Click(sender As Object, e As EventArgs) Handles BTT_SITE_SPECIFIC.Click Using f As New SiteSelectionForm(Settings.SelectedSites.ValuesList) f.ShowDialog() If f.DialogResult = DialogResult.OK Then Settings.SelectedSites.Clear() Settings.SelectedSites.AddRange(f.SelectedSites) Settings.SelectedSites.Update() BTT_SITE_SPECIFIC.Checked = Settings.SelectedSites.Count > 0 BTT_SITE_ALL.Checked = Settings.SelectedSites.Count = 0 RefillList() End If End Using End Sub #End Region #Region "4 - view filters" Private Sub BTT_SHOW_ALL_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_ALL.Click SetShowButtonsCheckers(ShowingModes.All) End Sub Private Sub BTT_SHOW_REGULAR_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_REGULAR.Click SetShowButtonsCheckers(ShowingModes.Regular) End Sub Private Sub BTT_SHOW_TEMP_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_TEMP.Click SetShowButtonsCheckers(ShowingModes.Temporary) End Sub Private Sub BTT_SHOW_FAV_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_FAV.Click SetShowButtonsCheckers(ShowingModes.Favorite) End Sub Private Sub BTT_SHOW_DELETED_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_DELETED.Click SetShowButtonsCheckers(ShowingModes.Deleted) End Sub Private Sub BTT_SHOW_SUSPENDED_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_SUSPENDED.Click SetShowButtonsCheckers(ShowingModes.Suspended) End Sub Private Sub BTT_SHOW_LABELS_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_LABELS.Click Dim b As Boolean = OpenLabelsForm(Settings.Labels.Current) Dim m As ShowingModes If Settings.Labels.Current.Count = 0 Then m = Settings.ShowingMode.Value If m = ShowingModes.Labels Then m = ShowingModes.All Else m = ShowingModes.Labels End If SetShowButtonsCheckers(m, Settings.ShowingMode.Value = ShowingModes.Labels And m = ShowingModes.Labels And b) End Sub Private Sub BTT_SHOW_NO_LABELS_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_NO_LABELS.Click SetShowButtonsCheckers(ShowingModes.NoLabels) End Sub Private Sub BTT_SHOW_EXCLUDED_LABELS_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_EXCLUDED_LABELS.Click Dim b As Boolean = OpenLabelsForm(Settings.Labels.Excluded) SetExcludedButtonChecker() If b Then RefillList() End Sub Private Sub BTT_SHOW_EXCLUDED_LABELS_IGNORE_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_EXCLUDED_LABELS_IGNORE.Click Settings.Labels.ExcludedIgnore.Value = Not Settings.Labels.ExcludedIgnore.Value If Settings.Labels.Excluded.Count > 0 Then RefillList() SetExcludedButtonChecker() End Sub Private Sub BTT_SHOW_SHOW_GROUPS_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_SHOW_GROUPS.Click Settings.ShowGroupsInsteadLabels.Value = Not Settings.ShowGroupsInsteadLabels.Value If Settings.ShowingMode.Value = ShowingModes.Labels Then RefillList() SetShowButtonsCheckers(Settings.ShowingMode.Value) End Sub Private Sub SetShowButtonsCheckers(ByVal m As ShowingModes, Optional ByVal ForceRefill As Boolean = False) BTT_SHOW_ALL.Checked = m = ShowingModes.All BTT_SHOW_REGULAR.Checked = m = ShowingModes.Regular BTT_SHOW_TEMP.Checked = m = ShowingModes.Temporary BTT_SHOW_FAV.Checked = m = ShowingModes.Favorite BTT_SHOW_DELETED.Checked = m = ShowingModes.Deleted BTT_SHOW_SUSPENDED.Checked = m = ShowingModes.Suspended BTT_SHOW_LABELS.Checked = m = ShowingModes.Labels BTT_SHOW_NO_LABELS.Checked = m = ShowingModes.NoLabels BTT_SHOW_SHOW_GROUPS.Checked = Settings.ShowGroupsInsteadLabels BTT_SHOW_FILTER_ADV.Checked = m = ShowingModes.AdvancedFilter SetExcludedButtonChecker() With Settings If Not m = ShowingModes.Labels Then .Labels.Current.Clear() : .Labels.Current.Update() If Not .ShowingMode.Value = m Or ForceRefill Then .ShowingMode.Value = m RefillList() Else .ShowingMode.Value = m End If End With End Sub Private Sub SetExcludedButtonChecker() BTT_SHOW_EXCLUDED_LABELS.Checked = Settings.Labels.Excluded.Count > 0 BTT_SHOW_EXCLUDED_LABELS_IGNORE.Checked = Settings.Labels.ExcludedIgnore End Sub Private Function OpenLabelsForm(ByRef ll As XML.Objects.XMLValuesCollection(Of String)) As Boolean Using f As New LabelsForm(ll) With {.WithDeleteButton = True} f.ShowDialog() If f.DialogResult = DialogResult.OK Then With ll : .Clear() : .AddRange(f.LabelsList) : .Update() : End With Return True Else Return False End If End Using End Function Private Sub BTT_SHOW_FILTER_ADV_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_FILTER_ADV.Click Try Using g As New Groups.GroupEditorForm(Settings.AdvancedFilter) With {.FilterMode = True} g.ShowDialog() If g.DialogResult = DialogResult.OK Then Settings.AdvancedFilter.UpdateFile() SetShowButtonsCheckers(ShowingModes.AdvancedFilter, True) End If End Using Catch ex As Exception ErrorsDescriber.Execute(EDP.SendToLog, ex, "Changing advanced filter options") End Try End Sub #End Region #Region "5 - view dates" Private Sub BTT_SHOW_LIMIT_DATES_NOT_IN_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles BTT_SHOW_LIMIT_DATES_NOT.Click, BTT_SHOW_LIMIT_DATES_IN.Click Dim r As Boolean = False Dim UpSettings As Action(Of Date?, Date?, ShowingDates) = Sub(ByVal _from As Date?, ByVal _to As Date?, ByVal Mode As ShowingDates) With Settings .BeginUpdate() If Not .ViewDateMode.Value = CInt(Mode) Then r = True .ViewDateMode.Value = CInt(Mode) If Not Mode = ShowingDates.Off Then If .ViewDateFrom.HasValue And _from.HasValue Then If Not .ViewDateFrom.Value.Date = _from.Value.Date Then r = True Else r = True End If .ViewDateFrom = _from If .ViewDateTo.HasValue And _to.HasValue Then If Not .ViewDateTo.Value.Date = _to.Value.Date Then r = True Else r = True End If .ViewDateTo = _to End If .EndUpdate() End With End Sub Using f As New DateTimeSelectionForm(DateTimeSelectionForm.ModesAllDate, Settings.Design) With { .MyDateStart = Settings.ViewDateFrom, .MyDateEnd = Settings.ViewDateTo, .UseDeleteButton = True } f.ShowDialog() Select Case f.DialogResult Case DialogResult.Abort : UpSettings(f.MyDateStart, f.MyDateEnd, ShowingDates.Off) Case DialogResult.OK : UpSettings(f.MyDateStart, f.MyDateEnd, Sender.Tag) End Select End Using BTT_SHOW_LIMIT_DATES_NOT.Checked = Settings.ViewDateMode.Value = ShowingDates.Not BTT_SHOW_LIMIT_DATES_IN.Checked = Settings.ViewDateMode.Value = ShowingDates.In If r Then RefillList() End Sub #End Region #End Region Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click MyMainLOG_ShowForm(Settings.Design,,,, Sub() MainFrameObj.UpdateLogButton()) End Sub Private Sub BTT_VERSION_INFO_Click(sender As Object, e As EventArgs) Handles BTT_VERSION_INFO.Click CheckVersion(True) End Sub Private Sub BTT_DONATE_Click(sender As Object, e As EventArgs) Handles BTT_DONATE.Click Try : Process.Start("https://github.com/AAndyProgram/SCrawler/blob/main/HowToSupport.md") : Catch : End Try End Sub Private Sub BTT_BUG_REPORT_Click(sender As Object, e As EventArgs) Handles BTT_BUG_REPORT.Click Try With Settings Using f As New BugReporterForm(.Cache, .Design, .ProgramText, My.Application.Info.Version, False, .Self, .ProgramDescription) : f.ShowDialog() : End Using End With Catch End Try End Sub #End Region #Region "List handlers" Private _LatestSelected As Integer = -1 Private Sub LIST_PROFILES_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_PROFILES.SelectedIndexChanged Dim a As Action = Sub() If LIST_PROFILES.SelectedIndices.Count > 0 Then _LatestSelected = LIST_PROFILES.SelectedIndices(0) Else _LatestSelected = -1 End If End Sub If LIST_PROFILES.InvokeRequired Then LIST_PROFILES.Invoke(a) Else a.Invoke End Sub Private Sub LIST_PROFILES_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles LIST_PROFILES.MouseDoubleClick OpenFolder() End Sub #End Region #Region "Context" #Region "1 - download" Private Sub BTT_CONTEXT_DOWN_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_CONTEXT_DOWN.KeyClick DownloadSelectedUser(DownUserLimits.None, e.IncludeInTheFeed) End Sub Private Sub BTT_CONTEXT_DOWN_LIMITED_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_CONTEXT_DOWN_LIMITED.KeyClick DownloadSelectedUser(DownUserLimits.Number, e.IncludeInTheFeed) End Sub Private Sub BTT_CONTEXT_DOWN_DATE_LIMIT_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_CONTEXT_DOWN_DATE_LIMIT.KeyClick DownloadSelectedUser(DownUserLimits.Date, e.IncludeInTheFeed) End Sub #End Region #Region "1 - edit, delete, copy" Private Sub BTT_CONTEXT_EDIT_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_EDIT.Click EditSelectedUser() End Sub Private Sub BTT_CONTEXT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DELETE.Click DeleteSelectedUser() End Sub Private Sub BTT_CONTEXT_ERASE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_ERASE.Click Const msgTitle$ = "Erase data" Try Dim users As List(Of IUserData) = GetSelectedUserArray() If users.ListExists Then Dim m As IUserData.EraseMode = UserDataBase.GetEraseMode(users) If Not m = IUserData.EraseMode.None Then Dim nd As New List(Of IUserData) For Each user As IUserData In users If Not user.EraseData(m) Then nd.Add(user) Next If nd.Count = 0 Then MsgBoxE({"All user data has been erased.", msgTitle}) Else MsgBoxE(New MMessage("The data of the following users has not been erased:" & vbCr.StringDup(2) & nd.ListToStringE(vbCr, GetUserListProvider(True)), msgTitle,, MsgBoxStyle.Exclamation) With {.Editable = True}) End If End If Else MsgBoxE({"No user selected", msgTitle}, vbExclamation) End If Catch ex As Exception ErrorsDescriber.Execute(EDP.LogMessageValue, ex, msgTitle) End Try End Sub Private Sub BTT_CONTEXT_COPY_TO_FOLDER_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_COPY_TO_FOLDER.Click CopyUserData() End Sub #End Region #Region "2 - user parameters" Private Sub BTT_CONTEXT_FAV_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_FAV.Click Dim users As List(Of IUserData) = GetSelectedUserArray() If AskForMassReplace(users, "Favorite") Then users.ForEach(Sub(u) u.Favorite = Not u.Favorite u.UpdateUserInformation() UserListUpdate(u, False) End Sub) End Sub Private Sub BTT_CONTEXT_TEMP_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_TEMP.Click Dim users As List(Of IUserData) = GetSelectedUserArray() If AskForMassReplace(users, "Temporary") Then users.ForEach(Sub(u) u.Temporary = Not u.Temporary u.UpdateUserInformation() UserListUpdate(u, False) End Sub) End Sub Private Sub BTT_CONTEXT_READY_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_READY.Click Dim users As List(Of IUserData) = GetSelectedUserArray() If AskForMassReplace(users, "Ready for download") Then Dim r As Boolean = MsgBoxE({"What state do you want to set for selected users", "Select ready state"}, vbQuestion,,, {"Not Ready", "Ready"}).Index users.ForEach(Sub(u) u.ReadyForDownload = r u.UpdateUserInformation() End Sub) End If End Sub Private Sub BTT_CONTEXT_GROUPS_Click(ByVal Sender As Object, ByVal e As Controls.KeyClick.KeyClickEventArgs) Handles BTT_CONTEXT_GROUPS.KeyClick Const MsgTitle$ = "Label change" Try Dim users As List(Of IUserData) = GetSelectedUserArray() If users.ListExists Then Dim l As List(Of String) = ListAddList(Nothing, users.SelectMany(Function(u) u.Labels), LAP.NotContainsOnly) Dim lex As List(Of String) = ListAddList(Nothing, users.SelectMany(Function(u As UserDataBase) u.SpecialLabels), LNC) Dim initialCount% = l.Count Dim isOneUser As Boolean = users.Count = 1 AndAlso Not users(0).IsCollection Dim inclSpec As Boolean = (e.Control And (users.Count > 1 Or (users.Count = 1 And users(0).IsCollection))) Or isOneUser If Not inclSpec Then l.ListWithRemove(lex) Using f As New LabelsForm(l) With {.WithDeleteButton = l.Count > 0} f.ShowDialog() If f.DialogResult = DialogResult.OK Then Dim labels As List(Of String) = f.LabelsList Dim cMsg As New MMessage("Operation canceled", MsgTitle) Dim upMode As Byte Dim keepSpecial As Boolean = True If labels.ListExists Then Select Case MsgBoxE(New MMessage($"What do you want to do with the selected labels?{vbCr}Selected labels:{vbCr}{labels.ListToString(vbCr)}", MsgTitle, { New MsgBoxButton("Replace", "All existing labels will be removed and replaced with these labels"), New MsgBoxButton("Add", "These labels will be added to the existing ones"), New MsgBoxButton("Remove", "These labels will be removed from the existing ones"), "Cancel" }, vbExclamation) With {.ButtonsPerRow = 2}).Index Case 0 : upMode = 1 Case 1 : upMode = 0 Case 2 : upMode = 2 Case Else : cMsg.Show() : Exit Sub End Select Else If MsgBoxE({"Are you sure you want to remove all labels?", MsgTitle}, vbExclamation + vbYesNo) = vbYes Then upMode = 1 Else cMsg.Show() Exit Sub End If End If If lex.ListExists AndAlso Not isOneUser AndAlso (l.ListContains(lex) Or (Not inclSpec And Not l.Count = initialCount)) Then _ keepSpecial = UserDataBase.UpdateLabelsKeepSpecial(upMode) users.ForEach(Sub(ByVal u As IUserData) UserDataBase.UpdateLabels(u, labels, upMode, keepSpecial) u.UpdateUserInformation() End Sub) End If End Using Else MsgBoxE("No user found", vbExclamation) End If Catch ex As Exception ErrorsDescriber.Execute(EDP.ShowAllMsg, ex, "[ChangeUserGroups]") End Try End Sub Private Sub BTT_CONTEXT_SCRIPT_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_SCRIPT.Click Try Dim users As List(Of IUserData) = GetSelectedUserArray() If users.ListExists Then Dim ans% = MsgBoxE({"You want to change the script usage for selected users." & vbCr & "Which script usage mode do you want to set?", "Change script usage"}, vbExclamation,,, {"Use", "Do not use", "Cancel"}) If ans < 2 Then Dim s As Boolean = IIf(ans = 0, True, False) users.ForEach(Sub(ByVal u As IUserData) Dim b As Boolean = u.ScriptUse = s u.ScriptUse = s If Not b Then u.UpdateUserInformation() End Sub) MsgBoxE($"Script mode was set to [{IIf(s, "Use", "Do not use")}] for all selected users") Else MsgBoxE("Operation canceled") End If Else MsgBoxE("Users not selected", vbExclamation) End If Catch ex As Exception ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Change script usage") End Try End Sub Private Function AskForMassReplace(ByVal users As List(Of IUserData), ByVal param As String) As Boolean Dim u$ = users.ListIfNothing.Take(20).Select(Function(uu) uu.Name).ListToString(vbCr) If Not u.IsEmptyString And users.ListExists(21) Then u &= vbCr & "..." Return users.ListExists AndAlso (users.Count = 1 OrElse MsgBoxE({$"Do you really want to change [{param}] for {users.Count} users?{vbCr}{vbCr}{u}", "Users' parameters change"}, MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo) = MsgBoxResult.Yes) End Function Private Sub BTT_CONTEXT_ADD_TO_COL_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_ADD_TO_COL.Click Const MsgTitle$ = "Add users to the collection" If Settings.CollectionsPath.Value.IsEmptyString Then MsgBoxE({"Collection path not specified", MsgTitle}, MsgBoxStyle.Exclamation) Else Dim users As List(Of IUserData) = GetSelectedUserArray() If users.ListExists Then Dim i% Dim _col_user As Predicate(Of IUserData) = Function(u) u.IsCollection Dim userCollection As UserDataBind = users.Find(_col_user) Dim _col_name$ = String.Empty Dim _col_dest As SFile = Nothing Dim allUsersIsSubscriptions As Boolean Dim userProvider As IFormatProvider = GetUserListProvider(False) If Not userCollection Is Nothing Then i = users.LongCount(Function(u) _col_user(u)) If i > 1 OrElse i = users.Count OrElse (i = 1 AndAlso MsgBoxE({$"Do you want to add the following users to the [{userCollection.Name}] collection?" & vbCr & users.Where(Function(u) Not _col_user(u)).ListToStringE(vbCr, userProvider), MsgTitle}, vbQuestion + vbYesNo) = vbNo) Then _ MsgBoxE({"The collection cannot be added to the collection!", MsgTitle}, MsgBoxStyle.Critical) : Exit Sub _col_name = userCollection.Name End If If _col_name.IsEmptyString Then Using f As New CollectionEditorForm f.ShowDialog() If f.DialogResult = DialogResult.OK Then _col_name = f.MyCollection _col_dest = f.MyCollectionSpecialPath End If End Using End If If _col_name.IsEmptyString Then MsgBoxE({"The destination collection has not been selected.", MsgTitle}, vbExclamation) Else With (From u In users Where Not u.IsCollection Select u.IsSubscription) allUsersIsSubscriptions = .ListExists AndAlso .All(Function(u) u) End With With Settings userCollection = .Users.Find(Function(u) u.IsCollection And u.CollectionName = _col_name) Dim Added As Boolean = userCollection Is Nothing If Added Then .Users.Add(New UserDataBind(_col_name, _col_dest)) MainFrameObj.CollectionHandler(DirectCast(.Users.Last, UserDataBind)) userCollection = .Users.Last End If Dim __modelUser As UsageModel = -1 Dim __modelCollection As UsageModel = -1 Dim __ModelAskForDecision As Boolean = False If Not Added Then __modelCollection = userCollection.CollectionModel If Added Then If allUsersIsSubscriptions Then __modelUser = UsageModel.Virtual __modelCollection = UsageModel.Virtual Else __ModelAskForDecision = True End If ElseIf userCollection.CollectionModel = UsageModel.Virtual Then __modelUser = UsageModel.Virtual __modelCollection = UsageModel.Virtual ElseIf allUsersIsSubscriptions Then __modelCollection = userCollection.CollectionModel __modelUser = UsageModel.Virtual Else __ModelAskForDecision = True End If If (users.Count = 1 AndAlso Not users(0).IsCollection AndAlso users(0).HOST.Key = PathPlugin.PluginKey) OrElse (users.Count = 2 AndAlso users.All(Function(u) u.IsCollection OrElse u.HOST.Key = PathPlugin.PluginKey)) Then __modelUser = UsageModel.Virtual If Added Then __modelCollection = UsageModel.Virtual Else i = users.FindIndex(_col_user) If i >= 0 Then __modelCollection = users(i).CollectionModel Else __modelCollection = UsageModel.Virtual End If End If __ModelAskForDecision = False End If If __ModelAskForDecision Then Select Case MsgBoxE({"How do you want to add users to the collection?", MsgTitle}, vbQuestion,,, { New MsgBoxButton("Default", "User files will be moved to the collection") With {.KeyCode = Keys.Enter}, New MsgBoxButton("Virtual", "The user will be included in the collection, but user files will not be moved") With { .KeyCode = New ButtonKey(Keys.Enter, True)} }).Index Case 0 __modelUser = UsageModel.Default If __modelCollection = -1 Then __modelCollection = UsageModel.Default Case 1 __modelUser = UsageModel.Virtual If __modelCollection = -1 Then __modelCollection = UsageModel.Virtual End Select End If If __modelUser = -1 Or __modelCollection = -1 Then MsgBoxE({$"Some parameters cannot be processed:{vbCr}" & $"UserModel: {CInt(__modelUser)}{vbCr}CollectionModel: {CInt(__modelCollection)}{vbCr}" & "Operation canceled", MsgTitle}, vbCritical) Exit Sub End If Dim __added_users As New List(Of IUserData) Dim __added_users_not As New List(Of IUserData) For Each user As UserDataBase In users If Not user.IsCollection Then Try If user.IsSubscription Then user.User.UserModel = UsageModel.Virtual Else user.User.UserModel = IIf(user.HOST.Key = PathPlugin.PluginKey, UsageModel.Virtual, __modelUser) End If user.User.CollectionModel = __modelCollection userCollection.Add(user) RemoveUserFromList(user) UserListUpdate(userCollection, Added) If Not Added Then FocusUser(userCollection.LVIKey) Added = False __added_users.Add(user) Catch ex As InvalidOperationException userCollection.Remove(user) If __added_users.Count > 0 AndAlso __added_users.Contains(user) Then __added_users.Remove(user) __added_users_not.Add(user) End Try End If Next If userCollection.Count = 0 Then RemoveUserFromList(userCollection) If Settings.Users.Remove(userCollection) Then userCollection.Dispose() MsgBoxE({$"No users have been added to the [{_col_name}] collection.", MsgTitle}, vbCritical) ElseIf __added_users.Count = 1 And __added_users_not.Count = 0 Then MsgBoxE({$"The user [{__added_users(0)}] has been added to the collection [{_col_name}].", MsgTitle}) ElseIf __added_users.Count = 0 And __added_users_not.Count = 1 Then MsgBoxE({$"The user [{__added_users_not(0)}] was not added to the collection [{_col_name}].", MsgTitle}, vbCritical) Else Dim m As New MMessage($"The following users have been added to the [{_col_name}] collection:{vbCr}", MsgTitle,, If(__added_users_not.Count > 0, vbExclamation, vbInformation)) m.Text &= __added_users.ListToStringE(vbCr, userProvider) If __added_users_not.Count > 0 Then m.Text &= $"{vbNewLine.StringDup(2)}The following users have not been added to the [{_col_name}] collection:{vbCr}" m.Text &= __added_users_not.ListToStringE(vbCr, userProvider) End If MsgBoxE(m) End If __added_users.Clear() __added_users_not.Clear() End With End If End If End If End Sub Private Sub BTT_CONTEXT_COL_MERGE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_COL_MERGE.Click Const MsgTitle$ = "Merging files" Dim user As IUserData = GetSelectedUser() If Not user Is Nothing Then If user.IsCollection Then If DirectCast(user, UserDataBind).DataMerging Then MsgBoxE({"Collection files are already merged", MsgTitle}) ElseIf user.IsVirtual Then MsgBoxE({"The action cannot be performed. This is a virtual collection.", MsgTitle}, vbCritical) Else If MsgBoxE({"Are you sure you want to merge the collection files into one folder?" & vbNewLine & "This action is not turnable!", MsgTitle}, vbExclamation + vbYesNo) = vbYes Then DirectCast(user, UserDataBind).DataMerging = True End If End If Else MsgBoxE("This is not collection!", MsgBoxStyle.Exclamation) End If End If End Sub Private Sub BTT_CONTEXT_CHANGE_FOLDER_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_CHANGE_FOLDER.Click ChangeUserDestination(GetSelectedUserArray(), True) End Sub Private Function ChangeUserDestination(ByVal users As IEnumerable(Of IUserData), ByVal InitialInvoke As Boolean, Optional ByVal NewUsersLocation As STDownloader.DownloadLocation? = Nothing) As Boolean Const MsgTitle$ = "Change user folder" Dim automationPaused As Boolean = Not Settings.Automation.Pause = PauseModes.Disabled Try Dim msgShowing As New ErrorsDescriber(If(InitialInvoke, EDP.ShowMainMsg, EDP.None)) If users.ListExists Then If Downloader.Working Then MsgBoxE({"Some users are currently downloading." & vbCr & "You cannot change paths while downloading." & vbCr & "Wait until the download is complete.", MsgTitle}, vbCritical) Return False Else If InitialInvoke Then Downloader.Suspended = True If Not automationPaused Then Settings.Automation.Pause = PauseModes.Unlimited End If End If Dim locationChooser As GlobalLocationsChooserForm Dim newLoc As STDownloader.DownloadLocation If users.Count > 1 Then Dim multiUserMsgTxt$ = "You have selected multiple users to change their destinations." & vbCr & "It is highly recommended to change the destination for one user at a time." If users.ListExists(Function(u) u.IsCollection And Not u.IsVirtual) Then _ multiUserMsgTxt &= vbCr & vbCr & "A collection was also found in your selection." & vbCr & "The collection movement model is always the only one, regardless of the path model you choose." multiUserMsgTxt &= vbCr & vbCr & $"Selected users:{vbCr}{users.ListToStringE(vbCr, GetUserListProvider(True))}." Select Case MsgBoxE({multiUserMsgTxt, MsgTitle}, vbExclamation,,, {New MsgBoxButton("Process", "Change the destination for all the users you selected"), New MsgBoxButton("First only", "Process only the first user in the selection"), "Cancel"}).Index Case 0 locationChooser = New GlobalLocationsChooserForm With { .MyIsMultipleUsers = True, .MyNonMyltipleUser = If(users.FirstOrDefault(Function(u) Not u.IsCollection), users(0)), .MyIsCollectionSelector = users.All(Function(u) u.IsCollection) } With locationChooser .ShowDialog() If .DialogResult = DialogResult.OK Then newLoc = .MyDestination .Dispose() Else .Dispose() ShowOperationCanceledMsg(MsgTitle) Return False End If End With With users.Where(Function(u) Not ChangeUserDestination({u}, False, newLoc)) If .ListExists Then If .Count = users.Count Then MsgBoxE({"None of the users' destinations have been changed!", MsgTitle}, vbCritical) Return False Else MsgBoxE({$"The following users' destinations have not been changed:{vbCr}" & users.ListToStringE(vbCr, GetUserListProvider(True)), MsgTitle}, vbCritical) Return True End If Else MsgBoxE({"Users' data has been moved", MsgTitle}) Return True End If End With Case 1 : users = New List(Of IUserData) From {users.First} Case Else : ShowOperationCanceledMsg(MsgTitle) : Return False End Select End If If users.Count = 1 Then Dim CutOption% = 1 Dim _IsCollection As Boolean = False Dim CurrDir As SFile Dim colName$ = String.Empty Dim pathHandler As PathMoverHandler With users(0) If .IsCollection Then _IsCollection = True With DirectCast(.Self, UserDataBind) If .Count = 0 Then Throw New ArgumentOutOfRangeException("Collection", "Collection is empty") ElseIf .IsVirtual Then MsgBoxE({"This is a virtual collection." & vbCr & "The virtual collection path cannot be changed." & vbCr & "To change the paths of users included in a virtual collection, " & "you must split the collection and then change the user paths.", MsgTitle}, vbCritical, msgShowing) Return False Else CurrDir = .GetRealUserFile If CurrDir.IsEmptyString Then MsgBoxE({"Non-virtual users not found", MsgTitle}, vbCritical, msgShowing) Return False End If CurrDir = CurrDir.CutPath(IIf(.DataMerging, 3, 2)) colName = .CollectionName Dim vu As IEnumerable(Of IUserData) = .Where(Function(vuu) vuu.UserModel = UsageModel.Virtual Or vuu.HOST.Key = PathPlugin.PluginKey) If vu.ListExists Then If InitialInvoke AndAlso MsgBoxE({"This collection contains virtual users and/or paths." & vbCr & "If you continue, the virtual user paths will not be changed." & vbCr & "The following users have been added to the collection in virtual mode:" & vbCr & vu.ListToStringE(vbCr, GetUserListProvider(False)), MsgTitle}, vbExclamation,,, {"Continue", "Cancel"}) = 1 Then ShowOperationCanceledMsg(MsgTitle) : Return False End If End If End With ElseIf .HOST.Key = PathPlugin.PluginKey Then MsgBoxE({"This is the path (not user). The paths cannot be changed.", MsgTitle}, vbCritical, msgShowing) Return False Else CurrDir = .Self.File.CutPath(1) End If If NewUsersLocation.HasValue Then newLoc = NewUsersLocation.Value Else locationChooser = New GlobalLocationsChooserForm With {.MyInitialLocation = CurrDir} locationChooser.MyNonMyltipleUser = .Self() If _IsCollection Then locationChooser.MyIsCollectionSelector = True locationChooser.MyCollectionName = colName End If With locationChooser .ShowDialog() If .DialogResult = DialogResult.OK Then newLoc = .MyDestination colName = .MyCollectionName .Dispose() Else .Dispose() If InitialInvoke Then ShowOperationCanceledMsg(MsgTitle) Return False End If End With End If If .IsCollection Then pathHandler = GlobalLocationsChooserForm.ModelHandler(PathCreationModel.Collection) Else pathHandler = GlobalLocationsChooserForm.ModelHandler(newLoc.Model) End If Dim NewDest As SFile If .IsCollection Then If Not InitialInvoke Then NewDest = $"{newLoc.Path.CSFilePS}{SettingsCLS.CollectionsFolderName}\{ .CollectionName}\" Else NewDest = $"{newLoc.Path.CSFilePS}{ .CollectionName}\" End If Else NewDest = pathHandler.Invoke(DirectCast(.Self, UserDataBase).User, newLoc.Path.CSFileP) End If If Not NewDest.IsEmptyString Then If Not NewDest.IsEmptyString AndAlso (Not NewDest.Exists(SFO.Path, False) OrElse ( SFile.GetFiles(NewDest,, IO.SearchOption.AllDirectories, EDP.ThrowException).ListIfNothing.Count = 0 AndAlso NewDest.Delete(SFO.Path, Settings.DeleteMode, EDP.ThrowException) AndAlso Not NewDest.Exists(SFO.Path, False) ) ) Then If SFile.Move(CurrDir, NewDest, SFO.Path,,, EDP.ReturnValue + If(InitialInvoke, EDP.ShowMainMsg, 0)) Then Dim colRootDef As SFile = Settings.CollectionsPathF Dim __UserSpecialPathsEquals As Func(Of UserInfo, Boolean, Boolean) = Function(ByVal __user As UserInfo, ByVal __isCol As Boolean) As Boolean Dim u1 As UserInfo = __user Dim u2 As UserInfo = __user If __isCol Then u1.CollectionName = colName u1.SpecialPath = Nothing u1.SpecialCollectionPath = Nothing u2.CollectionName = colName u2.SpecialPath = Nothing u2.SpecialCollectionPath = NewDest Else u1.CollectionName = String.Empty u1.SpecialPath = Nothing u1.SpecialCollectionPath = Nothing u2.CollectionName = String.Empty u2.SpecialPath = NewDest u2.SpecialCollectionPath = Nothing End If u1.UpdateUserFile() u2.UpdateUserFile() Return u1.File = u2.File End Function Dim ApplyChanges As Action(Of IUserData) = Sub(ByVal __user As IUserData) With DirectCast(__user, UserDataBase) Dim u As UserInfo = .User Settings.UsersList.Remove(u) If _IsCollection Then u.CollectionName = colName If Not __UserSpecialPathsEquals(u, True) Then u.SpecialCollectionPath = NewDest Else u.SpecialCollectionPath = Nothing End If u.SpecialPath = Nothing Else u.CollectionName = String.Empty If Not __UserSpecialPathsEquals(u, False) Then u.SpecialPath = NewDest Else u.SpecialPath = Nothing End If u.SpecialCollectionPath = Nothing End If u.UpdateUserFile() Settings.UsersList.Add(u) .User = u .UpdateUserInformation() End With End Sub If .IsCollection Then With DirectCast(.Self, UserDataBind) For Each user In .Collections : ApplyChanges(user) : Next End With Else ApplyChanges(.Self) End If Settings.UpdateUsersList() MsgBoxE({"User data has been moved", MsgTitle},, msgShowing) Return True End If Else MsgBoxE({$"Unable to move user data to new destination [{NewDest}]{vbCr}Operation canceled", MsgTitle}, MsgBoxStyle.Critical, msgShowing) End If Else MsgBoxE({$"You have not entered a new destination{vbCr}Operation canceled", MsgTitle}, MsgBoxStyle.Exclamation, msgShowing) End If End With Else MsgBoxE({"You have selected multiple users. You can change the folder only for one user!", MsgTitle}, MsgBoxStyle.Critical, msgShowing) End If Else MsgBoxE({"No one user selected", MsgTitle}, MsgBoxStyle.Exclamation, msgShowing) End If Return False Catch ex As Exception Return ErrorsDescriber.Execute(EDP.ReturnValue + If(InitialInvoke, EDP.ShowAllMsg, EDP.SendToLog), ex, "Error while moving user", False) Finally If InitialInvoke Then Downloader.Suspended = False If Not automationPaused Then Settings.Automation.Pause = PauseModes.Disabled End If End Try End Function #End Region #Region "3 - change image" Private Sub BTT_CHANGE_IMAGE_Click(sender As Object, e As EventArgs) Handles BTT_CHANGE_IMAGE.Click Dim user As IUserData = GetSelectedUser() If Not user Is Nothing Then Dim f As SFile = SFile.SelectFiles(user.File.CutPath(IIf(user.IsCollection, 2, 1)), False, "Select new user picture", "Pictures|*.jpeg;*.jpg;*.png;*.webp|GIF|*.gif|All Files|*.*").FirstOrDefault If Not f.IsEmptyString Then user.SetPicture(f) UserListUpdate(user, False) End If End If End Sub #End Region #Region "4 - open folder" Private Sub BTT_CONTEXT_OPEN_PATH_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_PATH.Click OpenFolder() End Sub #End Region #Region "5 - open site" Private Sub BTT_CONTEXT_OPEN_SITE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_SITE.Click Dim user As IUserData = GetSelectedUser() If Not user Is Nothing Then user.OpenSite() End Sub #End Region #Region "6 - information" Private Sub BTT_CONTEXT_INFO_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_INFO.Click Dim user As IUserData = GetSelectedUser() If Not user Is Nothing Then MsgBoxE(New MMessage(DirectCast(user, UserDataBase).GetUserInformation(), "User information") With {.Editable = True}) End Sub #End Region Private Sub USER_CONTEXT_VisibleChanged(sender As Object, e As EventArgs) Handles USER_CONTEXT.VisibleChanged Try If USER_CONTEXT.Visible Then Dim user As IUserData = GetSelectedUser() If Not user Is Nothing AndAlso user.IsCollection Then With DirectCast(user, UserDataBind) BTT_CONTEXT_DOWN.DropDownItems.AddRange(.ContextDown) BTT_CONTEXT_EDIT.DropDownItems.AddRange(.ContextEdit) BTT_CONTEXT_DELETE.DropDownItems.AddRange(.ContextDelete) BTT_CONTEXT_ERASE.DropDownItems.AddRange(.ContextErase) BTT_CONTEXT_OPEN_PATH.DropDownItems.AddRange(.ContextPath) BTT_CONTEXT_OPEN_SITE.DropDownItems.AddRange(.ContextSite) End With End If Else BTT_CONTEXT_DOWN.DropDownItems.Clear() BTT_CONTEXT_EDIT.DropDownItems.Clear() BTT_CONTEXT_DELETE.DropDownItems.Clear() BTT_CONTEXT_ERASE.DropDownItems.Clear() BTT_CONTEXT_OPEN_PATH.DropDownItems.Clear() BTT_CONTEXT_OPEN_SITE.DropDownItems.Clear() End If Catch ex As Exception End Try End Sub #End Region #Region "Focus user" Private Overloads Sub FocusUser(ByVal Key As String) FocusUser(Key, True) End Sub Friend Overloads Sub FocusUser(ByVal Key As String, Optional ByVal ActivateMe As Boolean = False) If Not Key.IsEmptyString Then Dim a As Action = Sub() Dim i% = LIST_PROFILES.Items.IndexOfKey(Key) If i < 0 Then Dim u As IUserData = Settings.GetUser(Key, True) If Not u Is Nothing Then i = LIST_PROFILES.Items.IndexOfKey(u.Key) If i < 0 Then UserListUpdate(u, True) i = LIST_PROFILES.Items.IndexOfKey(u.Key) End If End If End If If i >= 0 Then LIST_PROFILES.Select() LIST_PROFILES.SelectedIndices.Clear() With LIST_PROFILES.Items(i) : .Selected = True : .Focused = True : End With LIST_PROFILES.EnsureVisible(i) If ActivateMe Then If Visible Then BringToFront() Else Visible = True End If End If End Sub If LIST_PROFILES.InvokeRequired Then LIST_PROFILES.Invoke(a) Else a.Invoke End If End Sub #End Region #Region "Toolbar bottom" Private Sub BTT_PR_INFO_Click(sender As Object, e As EventArgs) Handles BTT_PR_INFO.Click If MyProgressForm.Visible Then MyProgressForm.BringToFront() Else MyProgressForm.Show() End Sub #End Region #Region "Operation providers" Private OperationsUserListProvider As IFormatProvider = Nothing Private OperationsUserListProviderCollections As IFormatProvider = Nothing Friend Function GetUserListProvider(ByVal WithCollections As Boolean) As IFormatProvider If WithCollections Then If OperationsUserListProviderCollections Is Nothing Then _ OperationsUserListProviderCollections = New CustomProvider(Function(v, d, p, n, ee) Dim OutStr$ With DirectCast(v, IUserData) If .IsCollection Then OutStr = $"Collection [{ .Name}]" Else OutStr = $"User [{ .Site}] { .Name}" End If End With Return OutStr End Function) Return OperationsUserListProviderCollections Else If OperationsUserListProvider Is Nothing Then _ OperationsUserListProvider = New CustomProvider(Function(v, d, p, n, ee) $"[{DirectCast(v, IUserData).Site}] {DirectCast(v, IUserData).Name}") Return OperationsUserListProvider End If End Function #End Region #Region "Operations with selected users: modify" Private Function GetSelectedUser() As IUserData If _LatestSelected.ValueBetween(0, LIST_PROFILES.Items.Count - 1) Then Dim k$ = LIST_PROFILES.Items(_LatestSelected).Name Dim i% = Settings.Users.FindIndex(Function(u) u.Key = k) If i >= 0 Then Return Settings.Users(i) Else MsgBoxE("User not found", MsgBoxStyle.Critical) End If End If Return Nothing End Function Private Function GetSelectedUserArray() As List(Of IUserData) Try With LIST_PROFILES If .SelectedIndices.Count > 0 Then Dim l As New List(Of IUserData) Dim k$ Dim indx% For i% = 0 To .SelectedIndices.Count - 1 k = .Items(.SelectedIndices(i)).Name indx = Settings.Users.FindIndex(Function(u) u.Key = k) If i >= 0 Then l.Add(Settings.Users(indx)) Next Return l End If End With Return New List(Of IUserData) Catch ex As Exception Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[MainFrame.GetSelectedUserArray]", New List(Of IUserData)) End Try End Function Private Enum DownUserLimits : None : Number : [Date] : End Enum Private Sub DownloadSelectedUser(ByVal UseLimits As DownUserLimits, Optional ByVal IncludeInTheFeed As Boolean = True) Const MsgTitle$ = "Download limit" Dim users As List(Of IUserData) = GetSelectedUserArray() If users.ListExists Then Dim limit%? = Nothing Dim _from As Date? = Nothing Dim _to As Date? = Nothing Dim _fromStr$, _toStr$ If UseLimits = DownUserLimits.Number Then Do limit = AConvert(Of Integer)(InputBoxE("Enter top posts limit for downloading:", MsgTitle, 10), AModes.Var, Nothing) If limit.HasValue Then Select Case MsgBoxE(New MMessage($"You are set up downloading top [{limit.Value}] posts", MsgTitle, {"Confirm", "Try again", "Disable limit", "Cancel"}) With {.ButtonsPerRow = 2}).Index Case 0 : Exit Do Case 2 : limit = Nothing : Exit Do Case 3 : GoTo CancelDownloadingOperation End Select Else Select Case MsgBoxE({"You are not set up downloading limit", MsgTitle},,,, {"Confirm", "Try again", "Cancel"}).Index Case 0 : Exit Do Case 2 : GoTo CancelDownloadingOperation End Select End If Loop ElseIf UseLimits = DownUserLimits.Date Then Do Using fd As New DateTimeSelectionForm(DateTimeSelectionForm.ModesAllDate, Settings.Design) fd.ShowDialog() If fd.DialogResult = DialogResult.OK Then _from = fd.MyDateStart _to = fd.MyDateEnd ElseIf fd.DialogResult = DialogResult.Abort Then _from = Nothing _to = Nothing End If End Using If _from.HasValue Or _to.HasValue Then _fromStr = AConvert(Of String)(_from, ADateTime.Formats.BaseDate, String.Empty) _toStr = AConvert(Of String)(_to, ADateTime.Formats.BaseDate, String.Empty) If Not _fromStr.IsEmptyString Then _fromStr = $"FROM [{_fromStr}]" If Not _toStr.IsEmptyString Then _toStr = $"TO [{_toStr}]" If Not _toStr.IsEmptyString And Not _fromStr.IsEmptyString Then _fromStr &= " " Select Case MsgBoxE(New MMessage($"You have set a date limit for downloading posts: {_fromStr}{_toStr}", MsgTitle, {"Confirm", "Try again", "Disable limit", "Cancel"}) With {.ButtonsPerRow = 2}).Index Case 0 : Exit Do Case 2 : _from = Nothing : _to = Nothing : Exit Do Case 3 : GoTo CancelDownloadingOperation End Select Else Select Case MsgBoxE({"You have not set a date limit", MsgTitle},,,, {"Confirm", "Try again", "Cancel"}).Index Case 0 : Exit Do Case 2 : GoTo CancelDownloadingOperation End Select End If Loop End If If USER_CONTEXT.Visible Then USER_CONTEXT.Hide() GoTo ResumeDownloadingOperation CancelDownloadingOperation: MsgBoxE("Operation canceled") Exit Sub ResumeDownloadingOperation: Dim uStr$ = If(users.Count = 1, String.Empty, users.ListToStringE(vbNewLine, GetUserListProvider(True))) Dim fStr$ = $" ({IIf(IncludeInTheFeed, "included in", "excluded from")} the feed)" If users.Count = 1 OrElse MsgBoxE({$"You have selected {users.Count} user profiles" & vbCr & $"Do you want to download them all{fStr}?{vbNewLine.StringDup(2)}" & $"Selected users:{vbNewLine}{uStr}", "Multiple users selected"}, MsgBoxStyle.Question + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then users.ForEach(Sub(u) u.DownloadTopCount = limit u.DownloadDateFrom = _from u.DownloadDateTo = _to End Sub) Downloader.AddRange(users, IncludeInTheFeed) End If End If End Sub Private Sub EditSelectedUser() Const MsgTitle$ = "User update" Dim user As IUserData = GetSelectedUser() If Not user Is Nothing Then On Error Resume Next If Not user.IsCollection OrElse DirectCast(user, UserDataBind).Count > 0 Then If user.IsCollection And USER_CONTEXT.Visible Then USER_CONTEXT.Hide() Using f As New UserCreatorForm(user) f.ShowDialog() If f.DialogResult = DialogResult.OK Then Dim NeedToUpdate As Boolean = True If user.IsCollection And Not user.CollectionName = f.CollectionName Then If Not user.IsVirtual AndAlso Downloader.Working Then MsgBoxE({"Some users are currently downloading." & vbCr & "You cannot change collection name while downloading." & vbCr & "Wait until the download is complete.", MsgTitle}, vbCritical) Exit Sub Else If Not user.IsVirtual Then Dim rUser As UserDataBase = DirectCast(user, UserDataBind).GetRealUser If Not rUser Is Nothing Then Dim colPathCurr As SFile = rUser.User.GetCollectionRootPath Dim colPathNew As SFile = SFile.GetPath(colPathCurr.CutPath.PathWithSeparator & f.CollectionName) If Not colPathCurr.Exists(SFO.Path, False) Then MsgBoxE({"Original location of collection not found. Operation canceled.", MsgTitle}, vbCritical) ElseIf colPathNew.Exists(SFO.Path, False) Then MsgBoxE({"The new collection location already exists. Operation canceled.", MsgTitle}, vbCritical) Else If Not SFile.Rename(colPathCurr, colPathNew, SFO.Path, New ErrorsDescriber(True, False, False, New SFile)).IsEmptyString Then RemoveUserFromList(user) Dim __user As UserInfo For Each ColUser As UserDataBase In DirectCast(user, UserDataBind).Collections __user = ColUser.User Settings.UsersList.Remove(__user) __user.CollectionName = f.CollectionName If Not __user.SpecialCollectionPath.IsEmptyString Then __user.SpecialCollectionPath = colPathNew __user.UpdateUserFile() ColUser.User = __user Settings.UsersList.Add(__user) Next user.UpdateUserInformation() UserListUpdate(user, True) NeedToUpdate = False End If End If End If Else RemoveUserFromList(user) DirectCast(user, UserDataBind).ChangeVirtualCollectionName(f.CollectionName) UserListUpdate(user, True) NeedToUpdate = False End If End If End If If NeedToUpdate Then UserListUpdate(user, False) End If End Using End If End If End Sub Private Sub DeleteSelectedUser() Try Dim users As List(Of IUserData) = GetSelectedUserArray() If users.ListExists Then If USER_CONTEXT.Visible Then USER_CONTEXT.Hide() Dim userProvider As IFormatProvider = GetUserListProvider(True) Dim ugn As Func(Of IUserData, String) = Function(u) AConvert(Of String)(u, userProvider) Dim m As New MMessage(users.ListToStringE(vbNewLine, userProvider), "Users deleting", {New MsgBoxButton("Delete and ban") With { .ToolTip = "Users and their data will be deleted and added to the blacklist", .KeyCode = Keys.Enter}, New MsgBoxButton("Delete user only and ban") With { .ToolTip = "Users will be deleted and added to the blacklist (user data will not be deleted)"}, New MsgBoxButton("Delete and ban with reason") With { .ToolTip = "Users and their data will be deleted and added to the blacklist with set a reason to delete", .KeyCode = New ButtonKey(Keys.Enter,, True)}, New MsgBoxButton("Delete user only and ban with reason") With { .ToolTip = "Users will be deleted and added to the blacklist with set a reason to delete (user data will not be deleted)"}, New MsgBoxButton("Delete") With { .ToolTip = "Delete users and their data", .KeyCode = New ButtonKey(Keys.Enter, True)}, New MsgBoxButton("Delete user only") With {.ToolTip = "Delete users but keep data"}, "Cancel"}, MsgBoxStyle.Exclamation) With {.ButtonsPerRow = 2, .ButtonsPlacing = MMessage.ButtonsPlacings.StartToEnd} m.Text = $"The following users ({users.Count}) will be deleted:{vbNewLine}{m.Text}" Dim result% = MsgBoxE(m) If result < 6 Then Dim collectionResult% = -1 Dim tmpResult% Dim tmpUserNames As New List(Of String) Dim IsMultiple As Boolean = users.Count > 1 Dim removedUsers As New List(Of String) Dim keepData As Boolean = Not (result Mod 2) = 0 Dim banUser As Boolean = result < 4 Dim setReason As Boolean = banUser And result > 1 Dim leftUsers As New List(Of String) Dim l As New ListAddParams(LAP.NotContainsOnly) Dim b As Boolean = False Dim reason$ = String.Empty If setReason Then reason = InputBoxE("Enter a deletion reason:", "Deletion reason") For Each user In users If keepData Then If banUser Then If user.IsCollection Then Settings.BlackList.ListAddList(DirectCast(user, UserDataBind). Collections.Select(Function(u) New UserBan(u.Name, reason)), l) Else Settings.BlackList.ListAddValue(New UserBan(user.Name, reason), l) End If b = True End If If user.IsCollection Then With DirectCast(user, UserDataBind) If .Count > 0 Then .Collections.ForEach(Sub(c) Settings.UsersList.Remove(DirectCast(c, UserDataBase).User)) End With Else Settings.UsersList.Remove(DirectCast(user, UserDataBase).User) End If Settings.Users.Remove(user) Settings.UpdateUsersList() RemoveUserFromList(user) removedUsers.Add(ugn(user)) user.Dispose() Else If banUser Then tmpUserNames.Clear() If user.IsCollection Then tmpUserNames.ListAddList(DirectCast(user, UserDataBind).Collections.Select(Function(u) u.Name), l) Else tmpUserNames.Add(user.Name) End If End If tmpResult = user.Delete(IsMultiple, collectionResult) If user.IsCollection And collectionResult = -1 Then collectionResult = tmpResult If tmpResult > 0 Then If banUser And tmpUserNames.Count > 0 Then Settings.BlackList.ListAddList(tmpUserNames.Select(Function(u) New UserBan(u, reason)), l) : b = True RemoveUserFromList(user) removedUsers.Add(ugn(user)) Else leftUsers.Add(ugn(user)) End If End If Next m = New MMessage(String.Empty, "Users deleting") If removedUsers.Count = users.Count Then If removedUsers.Count = 1 Then m.Text = "User deleted" Else m.Text = "All users were deleted" End If ElseIf removedUsers.Count = 0 Then m.Text = "No one user deleted!" m.Style = MsgBoxStyle.Critical Else m.Text = $"The following users were deleted:{vbNewLine}{removedUsers.ListToString(vbNewLine)}{vbNewLine.StringDup(2)}" m.Text &= $"The following users were NOT deleted:{vbNewLine}{leftUsers.ListToString(vbNewLine)}" m.Style = MsgBoxStyle.Exclamation End If If b Then Settings.UpdateBlackList() MsgBoxE(m) Else MsgBoxE("Operation canceled") End If End If Catch ex As Exception ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error when trying to delete user / collection") End Try End Sub Private Sub CopyUserData() Const MsgTitle$ = "Copying user data" Try Dim users As List(Of IUserData) = GetSelectedUserArray() If users.ListExists Then Dim f As SFile = Settings.LastCopyPath Dim _select_path As Func(Of Boolean) = Function() As Boolean f = SFile.SelectPath(f) If f.Exists(SFO.Path, False) Then Return MsgBoxE({$"Are you sure you want to copy the data to the selected folder?{vbCr}{f}", MsgTitle}, vbQuestion + vbYesNo) = vbYes Else MsgBoxE({$"Destination path not selected.{vbCr}Operation canceled.", MsgTitle}, vbExclamation) Return False End If End Function If f.Exists(SFO.Path, False) Then Select Case MsgBoxE({$"Last folder you copied to:{vbCr}{f}" & vbCr & "Do you want to copy to this folder or choose another destination?", MsgTitle}, vbQuestion,,, {New MsgBoxButton("Process") With {.ToolTip = "Use last folder"}, New MsgBoxButton("Choose new") With {.ToolTip = "Choose a new destination"}, New MsgBoxButton("Cancel")}) Case 1 : If Not _select_path.Invoke Then Exit Sub Case 2 : MsgBoxE({"Operation canceled", MsgTitle}) : Exit Sub End Select Else If Not _select_path.Invoke Then Exit Sub End If If f.Exists(SFO.Path, False) Then Dim userProvider As IFormatProvider = GetUserListProvider(True) Settings.LastCopyPath.Value = f Using logger As New TextSaver With {.LogMode = True} Dim m As New MMessage("", MsgTitle,,, {logger}) Dim err As New ErrorsDescriber(EDP.SendToLog) With {.DeclaredMessage = m} Dim __copied_users As New List(Of IUserData) Dim __copied_users_not As New List(Of IUserData) For Each user As IUserData In users If user.CopyFiles(f, err) Then __copied_users.Add(user) Else __copied_users_not.Add(user) End If Next err = Nothing Dim buttons As New List(Of MsgBoxButton) From {New MsgBoxButton("OK")} If __copied_users_not.Count > 0 Then err = New ErrorsDescriber(EDP.ShowAllMsg) m.Style = If(__copied_users.Count > 0, vbExclamation, vbCritical) If Not logger.IsEmptyString Then m.DefaultButton = 0 m.CancelButton = 0 buttons.Add(New MsgBoxButton("Show LOG") With { .IsDialogResultButton = False, .BackColor = MyColor.DeleteBack, .ForeColor = MyColor.DeleteFore, .KeyCode = Keys.F1, .ToolTip = "Show error log", .CallBack = Sub(r, mm, b) Using ff As New LOG_FORM(logger) : ff.ShowDialog() : End Using End Sub}) End If End If m.Buttons = buttons If __copied_users_not.Count = 0 Then m.Text = "All users are copied." ElseIf __copied_users.Count = 0 And __copied_users_not.Count > 0 Then m.Text = "No users have been copied." Else m.Text = $"The following users have been copied:{vbNewLine}" m.Text &= __copied_users.ListToStringE(vbNewLine, userProvider) If __copied_users_not.Count > 0 Then m.Text = $"{vbNewLine.StringDup(2)}The following users have not been copied:{vbNewLine}" m.Text &= __copied_users_not.ListToStringE(vbNewLine, userProvider) End If End If MsgBoxE(m,, err) End Using End If End If Catch ex As Exception ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error when trying to copy data") End Try End Sub Private Sub OpenFolder() Dim user As IUserData = GetSelectedUser() If Not user Is Nothing Then user.OpenFolder() End Sub #End Region #Region "Operations with selected users: list" Private Overloads Sub RemoveUserFromList(ByVal _User As IUserData) RemoveUserFromList(LIST_PROFILES.Items.IndexOfKey(_User.Key), _User.Key) End Sub Private Overloads Sub RemoveUserFromList(ByVal _Index As Integer, ByVal Key As String) Dim a As Action = Sub() With LIST_PROFILES If _Index >= 0 Then .Items.RemoveAt(_Index) If Settings.ViewModeIsPicture Then Dim ImgIndx% Select Case Settings.ViewMode.Value Case View.LargeIcon ImgIndx = .LargeImageList.Images.IndexOfKey(Key) If ImgIndx >= 0 Then .LargeImageList.Images.RemoveAt(_Index) Case View.SmallIcon ImgIndx = .SmallImageList.Images.IndexOfKey(Key) If ImgIndx >= 0 Then .SmallImageList.Images.RemoveAt(_Index) End Select End If End If End With End Sub If LIST_PROFILES.InvokeRequired Then LIST_PROFILES.Invoke(a) Else a.Invoke End Sub #End Region #Region "Handlers" Private Sub UpdateLabelsGroups() If Settings.Labels.NewLabelsExists Then If Settings.Labels.NewLabels.Count > 0 Then Dim ll As ListViewGroup = Nothing Dim a As Action = Sub() LIST_PROFILES.Groups.Add(ll) For Each l$ In Settings.Labels.NewLabels ll = New ListViewGroup(l, l) If Not LIST_PROFILES.Groups.Contains(ll) Then If LIST_PROFILES.InvokeRequired Then LIST_PROFILES.Invoke(a) Else a.Invoke End If Next End If Settings.Labels.Update() Settings.Labels.NewLabels.Clear() End If End Sub Friend Sub UserRemovedFromCollection(ByVal User As IUserData) If LIST_PROFILES.Items.Count = 0 OrElse Not LIST_PROFILES.Items.ContainsKey(User.Key) Then UserListUpdate(User, True) End Sub Friend Sub CollectionRemoved(ByVal User As IUserData) With LIST_PROFILES.Items If .Count > 0 AndAlso .ContainsKey(User.Key) Then .RemoveByKey(User.Key) End With End Sub Friend Sub User_OnUserUpdated(ByVal User As IUserData) UserListUpdate(User, False) End Sub Private Sub Downloader_UpdateJobsCount(ByVal TotalCount As Integer) ControlInvokeFast(Toolbar_BOTTOM, LBL_JOBS_COUNT, Sub() LBL_JOBS_COUNT.Text = IIf(TotalCount = 0, String.Empty, $"[Jobs {TotalCount}]")) MainFrameObj.UpdateLogButton() End Sub Private Sub Downloader_Downloading(ByVal Value As Boolean) Dim __isDownloading As Boolean = Value Or Downloader.Working(False) ControlInvokeFast(Toolbar_TOP, BTT_DOWN_STOP, Sub() BTT_DOWN_STOP.Enabled = __isDownloading) TrayIcon.Icon = If(__isDownloading, My.Resources.ArrowDownIcon_Blue_24, My.Resources.RainbowIcon_48) End Sub #End Region End Class