diff --git a/Changelog.md b/Changelog.md index 8e202d6..0326625 100644 --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,21 @@ +# 2022.9.24.0 + +*2022-09-24* + +- Added + - Ability to copy user data to another destination + - Ability to add 'Session' and 'Date' values to the post title in the feed + - Minor feed improvements + - The newly created collection will now appear at the top of the list (after reopening the form) + - Ability to add multiple users at a time to the collection. +- Fixed + - Autodownloader opens a compressed image instead of a full one + - Incorrect resizing of the feed grid after deleting a media file + - Incorrect behavior when deleting/removing a user from a collection. + - An incorrect function that displayed the number of spent Instagram requests. + - Bug in the XVIDEOS downloader + - Minor bugs + # 2022.9.17.0 *2022-09-17* diff --git a/ProgramScreenshots/MainContext.png b/ProgramScreenshots/MainContext.png index 48b1ceb..914d9fa 100644 Binary files a/ProgramScreenshots/MainContext.png and b/ProgramScreenshots/MainContext.png differ diff --git a/ProgramScreenshots/MainWindow.png b/ProgramScreenshots/MainWindow.png index 4bead73..0ffaaff 100644 Binary files a/ProgramScreenshots/MainWindow.png and b/ProgramScreenshots/MainWindow.png differ diff --git a/ProgramScreenshots/MainWindow2.png b/ProgramScreenshots/MainWindow2.png index 0b32a59..a839c53 100644 Binary files a/ProgramScreenshots/MainWindow2.png and b/ProgramScreenshots/MainWindow2.png differ diff --git a/ProgramScreenshots/SettingsGlobalDownloading.png b/ProgramScreenshots/SettingsGlobalDownloading.png index d2bedd1..5da184a 100644 Binary files a/ProgramScreenshots/SettingsGlobalDownloading.png and b/ProgramScreenshots/SettingsGlobalDownloading.png differ diff --git a/ProgramScreenshots/SettingsGlobalFeed.png b/ProgramScreenshots/SettingsGlobalFeed.png index 4565ff9..e1d6846 100644 Binary files a/ProgramScreenshots/SettingsGlobalFeed.png and b/ProgramScreenshots/SettingsGlobalFeed.png differ diff --git a/ProgramScreenshots/SettingsSiteInstagram.png b/ProgramScreenshots/SettingsSiteInstagram.png index c04ae6b..ff57c99 100644 Binary files a/ProgramScreenshots/SettingsSiteInstagram.png and b/ProgramScreenshots/SettingsSiteInstagram.png differ diff --git a/ProgramScreenshots/SettingsSiteRedGifs.png b/ProgramScreenshots/SettingsSiteRedGifs.png new file mode 100644 index 0000000..df586e1 Binary files /dev/null and b/ProgramScreenshots/SettingsSiteRedGifs.png differ diff --git a/ProgramScreenshots/SettingsSiteReddit.png b/ProgramScreenshots/SettingsSiteReddit.png index 5029d26..721a33a 100644 Binary files a/ProgramScreenshots/SettingsSiteReddit.png and b/ProgramScreenshots/SettingsSiteReddit.png differ diff --git a/ProgramScreenshots/SettingsSiteTwitter.png b/ProgramScreenshots/SettingsSiteTwitter.png index 6023ee6..fa55583 100644 Binary files a/ProgramScreenshots/SettingsSiteTwitter.png and b/ProgramScreenshots/SettingsSiteTwitter.png differ diff --git a/README.md b/README.md index 6574433..0627c76 100644 --- a/README.md +++ b/README.md @@ -8,6 +8,8 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Reddit, Twitter, Instagram). +**If you like SCrawler, please like the program on [this site]( https://alternativeto.net/software/scrawler/about/)** + Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush: [![ko-fi](https://www.ko-fi.com/img/githubbutton_sm.svg)](https://ko-fi.com/andyprogram) diff --git a/SCrawler.Plugin.XVIDEOS/My Project/AssemblyInfo.vb b/SCrawler.Plugin.XVIDEOS/My Project/AssemblyInfo.vb index 8cbd99a..ace973e 100644 --- a/SCrawler.Plugin.XVIDEOS/My Project/AssemblyInfo.vb +++ b/SCrawler.Plugin.XVIDEOS/My Project/AssemblyInfo.vb @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices ' by using the '*' as shown below: ' - - + + diff --git a/SCrawler.Plugin.XVIDEOS/SettingsForm.vb b/SCrawler.Plugin.XVIDEOS/SettingsForm.vb index a434fbe..2dfcd2f 100644 --- a/SCrawler.Plugin.XVIDEOS/SettingsForm.vb +++ b/SCrawler.Plugin.XVIDEOS/SettingsForm.vb @@ -35,7 +35,7 @@ Public Class SettingsForm Settings.UpdateDomains() MyDefs.CloseForm() End Sub - Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbar.EditToolbarEventArgs) Handles MyDefs.ButtonAddClick + Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick Dim nd$ = InputBoxE("Enter a new domain using the pattern [xvideos.com]:", "New domain") If Not nd.IsEmptyString Then If Not LIST_DOMAINS.Items.Contains(nd) Then @@ -45,7 +45,7 @@ Public Class SettingsForm End If End If End Sub - Private Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbar.EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE + Private Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE If _LatestSelected.ValueBetween(0, LIST_DOMAINS.Items.Count - 1) Then Dim n$ = LIST_DOMAINS.Items(_LatestSelected) If MsgBoxE({$"Are you sure you want to delete the [{n}] domain?", "Removing domains"}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then diff --git a/SCrawler.Plugin.XVIDEOS/UserData.vb b/SCrawler.Plugin.XVIDEOS/UserData.vb index 49c5ad6..dd64a38 100644 --- a/SCrawler.Plugin.XVIDEOS/UserData.vb +++ b/SCrawler.Plugin.XVIDEOS/UserData.vb @@ -71,7 +71,7 @@ Public Class UserData : Implements IPluginContentProvider Dim NextPage% = 0 Dim r$ - Dim j As EContainer, jj As EContainer + Dim jj As EContainer Dim e As ErrorsDescriber = EDP.ThrowException Dim user$ = Settings.GetUserUrl(Name, False) Dim p As PluginUserMedia @@ -82,8 +82,7 @@ Public Class UserData : Implements IPluginContentProvider r = Responser.GetResponse($"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}",, e) If Not r.IsEmptyString Then If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True - j = JsonDocument.Parse(r).XmlIfNothing - With j + With JsonDocument.Parse(r).XmlIfNothing If .Contains("videos") Then With .Item("videos") If .Count > 0 Then @@ -94,9 +93,12 @@ Public Class UserData : Implements IPluginContentProvider .URL = $"https://www.xvideos.com{jj.Value("u")}" } If Not p.PostID.IsEmptyString And Not jj.Value("u").IsEmptyString Then - If Not TempPostsList.Contains(p.PostID) Then TempPostsList.Add(p.PostID) : TempMediaList.Add(p) Else Exit Do + If Not TempPostsList.Contains(p.PostID) Then TempPostsList.Add(p.PostID) : TempMediaList.Add(p) Else .Dispose() : Exit Do End If Next + Else + .Dispose() + Exit Do End If End With Else diff --git a/SCrawler/API/Base/UserDataBase.vb b/SCrawler/API/Base/UserDataBase.vb index faf461d..2fa2284 100644 --- a/SCrawler/API/Base/UserDataBase.vb +++ b/SCrawler/API/Base/UserDataBase.vb @@ -879,6 +879,7 @@ BlockNullPicture: DownloadDataF(Token) ThrowAny(Token) Else + 'PENDING: UserDataBase ReparseMissing (DownloadDataF) 'ReparseMissing(Token) End If '_TempMediaList.ListAddList(ContentMissing, LNC) @@ -1100,14 +1101,14 @@ BlockNullPicture: End Try End Sub #End Region -#Region "Delete, Move, Merge" +#Region "Delete, Move, Merge, Copy" Friend Overridable Function Delete() As Integer Implements IUserData.Delete Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path) If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then - MainFrameObj.ImageHandler(Me, False) + If Not IncludedInCollection Then MainFrameObj.ImageHandler(Me, False) Settings.UsersList.Remove(User) Settings.UpdateUsersList() - Settings.Users.Remove(Me) + If Not IncludedInCollection Then Settings.Users.Remove(Me) Downloader.UserRemove(Me) Dispose(True) Return 1 @@ -1224,6 +1225,48 @@ BlockNullPicture: End If Return f End Function + Private Class FilesCopyingException : Inherits ErrorsDescriberException + Friend Sub New(ByVal User As IUserData, ByVal Msg As String, ByVal Path As SFile) + SendInLogOnlyMessage = True + If User.IncludedInCollection Then _MainMessage = $"[{User.CollectionName}] - " + _MainMessage &= $"[{User.Site}] - [{User.Name}]. {Msg}: {Path.Path}." + End Sub + End Class + Friend Overridable Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements IUserData.CopyFiles + Dim fSource As SFile = Nothing + Dim fDest As SFile = Nothing + Try + Dim pOffset% + If IncludedInCollection Then + If DataMerging Then pOffset = 1 Else pOffset = 2 + Else + pOffset = 1 + End If + fSource = User.File.CutPath(pOffset).Path.CSFileP + + Dim OptPath$ = String.Empty + If IncludedInCollection Then + OptPath = $"Collections\{CollectionName}" 'Copying a collection based on the first file + Else + OptPath = $"{Site}\{Name}" + End If + fDest = $"{DestinationPath.PathWithSeparator}{OptPath}".CSFileP + If fDest.Exists(SFO.Path, False) AndAlso MsgBoxE({$"The following path already exists:{vbCr}{fDest.Path}" & vbCr & + "Do you want to copy files here?", "Copying files"}, vbExclamation + vbYesNo) = vbNo Then _ + Throw New FilesCopyingException(Me, "The following path already exists", fDest) + + If DestinationPath.Exists(SFO.Path, True) Then + My.Computer.FileSystem.CopyDirectory(fSource, fDest, FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.ThrowException) + Else + Throw New FilesCopyingException(Me, "Cannot create the following path", fDest) + End If + Return True + Catch cex As OperationCanceledException + Return ErrorsDescriber.Execute(e, New FilesCopyingException(Me, "Copy canceled", fDest),, False) + Catch ex As Exception + Return ErrorsDescriber.Execute(e, ex,, False) + End Try + End Function #End Region #Region "Errors functions" Protected Sub LogError(ByVal ex As Exception, ByVal Message As String) @@ -1398,6 +1441,7 @@ BlockNullPicture: ''' Function Delete() As Integer Function MoveFiles(ByVal CollectionName As String) As Boolean + Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Sub OpenFolder() ReadOnly Property Self As IUserData Property DownloadTopCount As Integer? diff --git a/SCrawler/API/Instagram/SiteSettings.vb b/SCrawler/API/Instagram/SiteSettings.vb index 061de53..410f718 100644 --- a/SCrawler/API/Instagram/SiteSettings.vb +++ b/SCrawler/API/Instagram/SiteSettings.vb @@ -233,7 +233,7 @@ Namespace API.Instagram LastDownloadDate = New XMLValue(Of Date)("LastDownloadDate", Now.AddDays(-1), _XML, n) LastRequestsCount = New XMLValue(Of Integer)("LastRequestsCount", 0, _XML, n) LastRequestsCountLabel = New PropertyValue(LastRequestsCountLabelStr.Invoke(LastRequestsCount.Value)) - AddHandler LastRequestsCount.OnValueChanged, Sub(sender, __name, __value) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(__value) + AddHandler LastRequestsCount.OnValueChanged, Sub(sender, __name, __value) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(DirectCast(__value, Existable(Of Integer)).Value) UrlPatternUser = "https://www.instagram.com/{0}/" UserRegex = RParams.DMS("[htps:/]{7,8}.*?instagram.com/([^/]+)", 1) diff --git a/SCrawler/API/Reddit/UserData.vb b/SCrawler/API/Reddit/UserData.vb index 50ed61c..011b641 100644 --- a/SCrawler/API/Reddit/UserData.vb +++ b/SCrawler/API/Reddit/UserData.vb @@ -150,6 +150,7 @@ Namespace API.Reddit End Sub Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) _TotalPostsDownloaded = 0 + 'PENDING: Reddit ReparseMissing (DownloadDataF) 'If Not IsSavedPosts AndAlso (Not IsChannel OrElse ChannelInfo Is Nothing) Then ReparseMissing(Token) If IsSavedPosts Then DownloadDataChannel(String.Empty, Token) @@ -376,6 +377,7 @@ Namespace API.Reddit ElseIf Not s.Value({"media", "reddit_video"}, "fallback_url").IsEmptyString Then tmpUrl = s.Value({"media", "reddit_video"}, "fallback_url") If SaveToCache Then + 'TODELETE: Reddit thumbnail -> GetVideoRedditPreview 'tmpUrl = s.Value("thumbnail") tmpUrl = GetVideoRedditPreview(s) If Not tmpUrl.IsEmptyString Then diff --git a/SCrawler/API/Redgifs/SiteSettings.vb b/SCrawler/API/Redgifs/SiteSettings.vb index 339d9d8..c6fb0d1 100644 --- a/SCrawler/API/Redgifs/SiteSettings.vb +++ b/SCrawler/API/Redgifs/SiteSettings.vb @@ -39,6 +39,7 @@ Namespace API.RedGifs Return $"https://www.redgifs.com/watch/{PostID}" End Function Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean + 'PENDING: RedGifs SiteSettings Available FALSE Return False End Function End Class diff --git a/SCrawler/API/Twitter/UserData.vb b/SCrawler/API/Twitter/UserData.vb index d5db18d..174e1c3 100644 --- a/SCrawler/API/Twitter/UserData.vb +++ b/SCrawler/API/Twitter/UserData.vb @@ -34,6 +34,7 @@ Namespace API.Twitter Else If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly) DownloadData(String.Empty, Token) + 'PENDING: Twitter ReparseMissing (DownloadDataF) 'ReparseMissing(Token) End If End Sub @@ -101,6 +102,7 @@ Namespace API.Twitter If IsSavedPosts OrElse Not ParseUserMediaOnly OrElse (Not nn.Contains("retweeted_status") OrElse (Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then + 'TODELETE: Twitter ObtainMedia 'If Not CheckVideoNode(nn, PostID, PostDate) Then ' s = nn.ItemF({"extended_entities", "media"}) ' If s Is Nothing OrElse s.Count = 0 Then s = nn.ItemF({"retweeted_status", "extended_entities", "media"}) @@ -161,6 +163,7 @@ Namespace API.Twitter End If End Sub Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken) + 'PENDING: Twitter ReparseMissing verify Dim rList As New List(Of Integer) Dim URL$ = String.Empty Try diff --git a/SCrawler/API/UserDataBind.vb b/SCrawler/API/UserDataBind.vb index 72955e8..250c479 100644 --- a/SCrawler/API/UserDataBind.vb +++ b/SCrawler/API/UserDataBind.vb @@ -346,6 +346,14 @@ Namespace API Return False End Get End Property + Private Sub CopyTo(ByVal _Array() As IUserData, ByVal _ArrayIndex As Integer) Implements ICollection(Of IUserData).CopyTo + Throw New NotImplementedException("[CopyTo] method does not supported in collections context") + End Sub + Friend Sub Clear() Implements ICollection(Of IUserData).Clear + Collections.ListClearDispose + End Sub +#End Region +#Region "Add" ''' Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add With _Item @@ -413,6 +421,8 @@ Namespace API For i% = 0 To _Items.Count - 1 : Add(_Items(i)) : Next End If End Sub +#End Region +#Region "Move, Merge" Friend Overrides Function MoveFiles(ByVal __CollectionName As String) As Boolean Throw New NotImplementedException("Move files is not available in the collection context") End Function @@ -440,15 +450,8 @@ Namespace API End If End If End Sub - Friend Sub Clear() Implements ICollection(Of IUserData).Clear - Collections.ListClearDispose - End Sub - Friend Function Contains(ByVal _Item As IUserData) As Boolean Implements ICollection(Of IUserData).Contains - Return Count > 0 AndAlso Collections.Contains(_Item) - End Function - Private Sub CopyTo(ByVal _Array() As IUserData, ByVal _ArrayIndex As Integer) Implements ICollection(Of IUserData).CopyTo - Throw New NotImplementedException("[CopyTo] method does not supported in collections context") - End Sub +#End Region +#Region "Remove, Delete" Friend Function Remove(ByVal _Item As IUserData) As Boolean Implements ICollection(Of IUserData).Remove If DataMerging Then MsgBoxE($"Collection [{CollectionName}] data is already merged" & vbCr & @@ -547,6 +550,17 @@ Namespace API End If End With End Sub +#End Region +#Region "Copy" + Friend Overrides Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean + Return Count > 0 AndAlso Collections(0).CopyFiles(DestinationPath, e) + End Function +#End Region +#Region "Contains" + Friend Function Contains(ByVal _Item As IUserData) As Boolean Implements ICollection(Of IUserData).Contains + Return Count > 0 AndAlso Collections.Contains(_Item) + End Function +#End Region #Region "IEnumerable Support" Private Function GetEnumerator() As IEnumerator(Of IUserData) Implements IEnumerable(Of IUserData).GetEnumerator Return New MyEnumerator(Of IUserData)(Me) @@ -554,7 +568,6 @@ Namespace API Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator Return GetEnumerator() End Function -#End Region #End Region Friend Overrides Function Equals(ByVal Other As UserDataBase) As Boolean If Other.IsCollection Then diff --git a/SCrawler/Content/Pictures/PastePic32.png b/SCrawler/Content/Pictures/PastePic32.png new file mode 100644 index 0000000..c78a251 Binary files /dev/null and b/SCrawler/Content/Pictures/PastePic32.png differ diff --git a/SCrawler/Download/AutoDownloader.vb b/SCrawler/Download/AutoDownloader.vb index 3c6bf4b..d64f237 100644 --- a/SCrawler/Download/AutoDownloader.vb +++ b/SCrawler/Download/AutoDownloader.vb @@ -84,12 +84,14 @@ Namespace DownloadObjects Using Notify As New Notification(Text, Title) With {.Key = Key} Dim uPic As SFile = Nothing Dim uif As SFile = Nothing + Dim uif_orig As SFile = Nothing Dim uif_compressed As SFile = Nothing Dim uifKey$ = String.Empty If AutoDownloaderSource.ShowPictureUser Then uPic = DirectCast(User, UserDataBase).GetUserPictureToastAddress If AutoDownloaderSource.ShowPictureUser AndAlso uPic.Exists Then Notify.Images = {New ToastImage(uPic)} If AutoDownloaderSource.ShowPictureDownloaded And User.DownloadedPictures(False) > 0 Then uif = DirectCast(User, UserDataBase).GetLastImageAddress + uif_orig = uif If uif.Exists Then uif_compressed = uif uif_compressed.Path = CachePath.Path @@ -101,7 +103,7 @@ Namespace DownloadObjects If uif.Exists Then Notify.Images = {New ToastImage(uif, IImage.Modes.Inline)} uifKey = $"{Key}_{Images.Keys.Count + 1}_{KeyBttPhoto}" - If Not Images.ContainsKey(uifKey) Then Images.Add(uifKey, uif) + If Not Images.ContainsKey(uifKey) Then Images.Add(uifKey, uif_orig) End If End If End If diff --git a/SCrawler/Download/DownloadFeedForm.vb b/SCrawler/Download/DownloadFeedForm.vb index 92579f9..31063d5 100644 --- a/SCrawler/Download/DownloadFeedForm.vb +++ b/SCrawler/Download/DownloadFeedForm.vb @@ -23,6 +23,7 @@ Namespace DownloadObjects Private DataRows As Integer = 10 Private DataColumns As Integer = 1 Private FeedEndless As Boolean = False + Private ReadOnly FileNotExist As Predicate(Of UserMediaD) = Function(d) Not d.Data.File.Exists #End Region #Region "Initializer" Friend Sub New() @@ -112,6 +113,7 @@ Namespace DownloadObjects End Sub Private Sub RefillList() Handles BTT_REFRESH.Click DataPopulated = False + Try : Downloader.Files.RemoveAll(FileNotExist) : Catch : End Try DataList.ListAddList(Downloader.Files, LAP.ClearBeforeAdd, LAP.NotContainsOnly) MyRange.Source = DataList ControlInvoke(ToolbarTOP, LBL_FILES, Sub() LBL_FILES.Text = String.Empty) @@ -128,7 +130,7 @@ Namespace DownloadObjects RefillList() End Sub #End Region -#Region "Data" +#Region "Delete" Private Sub BTT_DELETE_SELECTED_Click(sender As Object, e As EventArgs) Handles BTT_DELETE_SELECTED.Click Const MsgTitle$ = "Deleting marked files" Try @@ -139,25 +141,18 @@ Namespace DownloadObjects Dim d% = 0 ControlInvoke(TP_DATA, Sub() With TP_DATA + .SuspendLayout() For Each fm As FeedMedia In c If fm.DeleteFile(True) Then d += 1 DataList.RemoveAll(Function(dd) dd.Data.File = fm.File) + TPRemoveControl(fm, False) End If Next + .ResumeLayout(True) End With End Sub) - If d > 0 Then - If DataList.Count > 0 Then - MyRange.HandlersSuspended = True - MyRange.Source = DataList - If indx.ValueBetween(0, MyRange.Count - 1) Then MyRange.CurrentIndex = indx - MyRange.HandlersSuspended = False - DirectCast(MyRange.Switcher, RangeSwitcher(Of UserMediaD)).PerformIndexChanged() - Else - RefillList() - End If - End If + If d > 0 Then RefillAfterDelete() MsgBoxE({$"{d}/{c.Count} file(s) deleted", MsgTitle}) Else MsgBoxE({"Operation canceled", MsgTitle}) @@ -169,6 +164,59 @@ Namespace DownloadObjects ErrorsDescriber.Execute(EDP.LogMessageValue, ex, MsgTitle) End Try End Sub + Private Sub FeedMedia_MediaDeleted(ByVal Sender As FeedMedia) + Try + ControlInvoke(TP_DATA, Sub() TPRemoveControl(Sender, True)) + DataList.RemoveAll(Function(dd) dd.Data.File = Sender.File) + RefillAfterDelete() + Catch + End Try + End Sub + Private Sub TPRemoveControl(ByVal CNT As FeedMedia, ByVal Suspend As Boolean) + Try + If Suspend Then TP_DATA.SuspendLayout() + Dim p As TableLayoutPanelCellPosition = TP_DATA.GetCellPosition(CNT) + Dim HeightChanged As Boolean = False + TP_DATA.Controls.Remove(CNT) + CNT.Dispose() + If DataColumns = 1 Then + If p.Column >= 0 And p.Row >= 0 Then TP_DATA.RowStyles(p.Row).Height = 0 : HeightChanged = True + Else + If p.Row.ValueBetween(0, TP_DATA.RowStyles.Count - 1) And p.Column.ValueBetween(0, TP_DATA.ColumnStyles.Count - 1) Then + Dim found As Boolean = False + For i% = 0 To TP_DATA.ColumnStyles.Count - 1 + If Not TP_DATA.GetControlFromPosition(i, p.Row) Is Nothing Then found = True : Exit For + Next + If Not found Then TP_DATA.RowStyles(p.Row).Height = 0 : HeightChanged = True + End If + End If + If HeightChanged Then TP_DATA.AutoScroll = False : TP_DATA.AutoScroll = True + Catch + Finally + If Suspend Then TP_DATA.ResumeLayout(True) + End Try + End Sub + Private Sub RefillAfterDelete() + If ControlInvoke(TP_DATA, Function() TP_DATA.Controls.Count) = 0 Then + With MyRange + Dim indx% = .CurrentIndex + .HandlersSuspended = True + .Source = DataList + If .Count > 0 Then + If indx.ValueBetween(0, .Count - 1) Then + .CurrentIndex = indx + ElseIf (indx - 1).ValueBetween(0, .Count - 1) Then + .CurrentIndex = indx - 1 + Else + .CurrentIndex = .Count - 1 + End If + .HandlersSuspended = False + DirectCast(MyRange.Switcher, RangeSwitcher(Of UserMediaD)).PerformIndexChanged() + End If + .HandlersSuspended = False + End With + End If + End Sub #End Region #Region "Range" Private DataPopulated As Boolean = False @@ -205,6 +253,19 @@ Namespace DownloadObjects Dim d As List(Of UserMediaD) = MyRange.Current Dim d2 As List(Of UserMediaD) Dim i% + If d.ListExists And d.All(Function(md) FileNotExist(md)) Then + i = Sender.CurrentIndex + Sender.HandlersSuspended = True + RefillList() + If Sender.Count > 0 Then + If i.ValueBetween(0, Sender.Count - 1) Then Sender.CurrentIndex = i + Sender.HandlersSuspended = False + End If + RefillInProgress = False + Sender.HandlersSuspended = False + DirectCast(MyRange.Switcher, RangeSwitcher(Of UserMediaD)).PerformIndexChanged() + Exit Sub + End If If d.ListExists Then ClearTable() If Sender.CurrentIndex > 0 And FeedEndless Then @@ -214,7 +275,7 @@ Namespace DownloadObjects Dim w% = GetWidth() Dim p As New TPCELL(DataRows, DataColumns) Dim fmList As New List(Of FeedMedia) - d.ForEach(Sub(de) fmList.Add(New FeedMedia(de, w))) + d.ForEach(Sub(de) fmList.Add(New FeedMedia(de, w, AddressOf FeedMedia_MediaDeleted))) If fmList.Count > 0 Then fmList.ListDisposeRemoveAll(Function(fm) fm Is Nothing OrElse fm.HasError) If fmList.Count > 0 Then For i = 0 To fmList.Count - 1 diff --git a/SCrawler/Download/FeedMedia.vb b/SCrawler/Download/FeedMedia.vb index cb7bee4..443e95c 100644 --- a/SCrawler/Download/FeedMedia.vb +++ b/SCrawler/Download/FeedMedia.vb @@ -16,6 +16,7 @@ Namespace DownloadObjects Public Class FeedMedia #Region "Declarations" + Friend Event MediaDeleted(ByVal Sender As Object) Private Const VideoHeight As Integer = 450 Private WithEvents MyPicture As PictureBox Private ReadOnly MyImage As ImageRenderer @@ -64,7 +65,7 @@ Namespace DownloadObjects Public Sub New() InitializeComponent() End Sub - Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer) + Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Handler As MediaDeletedEventHandler) Try InitializeComponent() File = Media.Data.File @@ -131,12 +132,16 @@ Namespace DownloadObjects End With End If + If Settings.FeedAddSessionToCaption Then info = $"[{Media.Session}] {info}" + If Settings.FeedAddDateToCaption Then info &= $" ({Media.Date.ToStringDate(ADateTime.Formats.BaseDateTime)})" LBL_INFO.Text = info - 'TT_MAIN.SetToolTip(LBL_INFO, Information) + s = New Size(Width, h + TP_MAIN.RowStyles(0).Height + PaddingE.GetOf({TP_MAIN}).Vertical(2)) Size = s MinimumSize = s MaximumSize = s + + If Not Handler Is Nothing Then AddHandler Me.MediaDeleted, Handler Else Throw New ArgumentNullException With {.HelpLink = 1} End If @@ -158,6 +163,9 @@ Namespace DownloadObjects End Sub #End Region #Region "LBL" + Private Sub LBL_INFO_MouseClick(sender As Object, e As MouseEventArgs) Handles LBL_INFO.MouseClick + If e.Button = MouseButtons.Left Then ControlInvoke(CH_CHECKED, Sub() CH_CHECKED.Checked = Not CH_CHECKED.Checked) + End Sub Private Sub LBL_INFO_DoubleClick(sender As Object, e As EventArgs) Handles LBL_INFO.DoubleClick If Not UserKey.IsEmptyString Then Dim u As IUserData = Settings.GetUser(UserKey) @@ -214,11 +222,10 @@ Namespace DownloadObjects Const msgTitle$ = "Deleting a file" Try If Silent OrElse MsgBoxE({$"Are you sure you want to delete the [{File.File}] file?{vbCr}{File}", msgTitle}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then + If Not MyVideo Is Nothing Then MyVideo.Stop() If File.Delete(SFO.File, Settings.DeleteMode, EDP.ThrowException) Then - If Not Silent Then MsgBoxE({"File deleted", msgTitle}) + If Not Silent Then RaiseEvent MediaDeleted(Me) : MsgBoxE({"File deleted", msgTitle}) LBL_INFO.Height = 0 - If Not MyPicture Is Nothing Then MyPicture.Size = New Size(0, 0) - If Not MyVideo Is Nothing Then MyVideo.MinimumSize = New Size(0, 0) : MyVideo.Size = New Size(0, 0) Height = 0 Return True End If diff --git a/SCrawler/Download/FeedVideo.vb b/SCrawler/Download/FeedVideo.vb index 7272982..1b93ff5 100644 --- a/SCrawler/Download/FeedVideo.vb +++ b/SCrawler/Download/FeedVideo.vb @@ -76,7 +76,7 @@ Namespace DownloadObjects Try : MediaPlayer.Pause() : Catch : End Try UpdateButtons() End Sub - Private Sub BTT_STOP_Click(sender As Object, e As EventArgs) Handles BTT_STOP.Click + Friend Sub [Stop]() Handles BTT_STOP.Click Try : MediaPlayer.Stop() : Catch : End Try UpdateButtons() End Sub diff --git a/SCrawler/Download/SchedulerEditorForm.vb b/SCrawler/Download/SchedulerEditorForm.vb index 5e837c4..1d308ff 100644 --- a/SCrawler/Download/SchedulerEditorForm.vb +++ b/SCrawler/Download/SchedulerEditorForm.vb @@ -53,7 +53,7 @@ Namespace DownloadObjects ErrorsDescriber.Execute(EDP.SendInLog, ex) End Try End Sub - Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbar.EditToolbarEventArgs) Handles MyDefs.ButtonAddClick + Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick Dim a As New AutoDownloader(True) Using f As New AutoDownloaderEditorForm(a) f.ShowDialog() @@ -74,7 +74,7 @@ Namespace DownloadObjects End If End Sub Private _DeleteInProgress As Boolean = False - Private Async Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbar.EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE + Private Async Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE If Not _DeleteInProgress Then If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then _DeleteInProgress = True diff --git a/SCrawler/Download/TDownloader.vb b/SCrawler/Download/TDownloader.vb index 9e7f57b..f48ba94 100644 --- a/SCrawler/Download/TDownloader.vb +++ b/SCrawler/Download/TDownloader.vb @@ -27,7 +27,7 @@ Namespace DownloadObjects Friend ReadOnly User As IUserData Friend ReadOnly Data As UserMedia Friend ReadOnly [Date] As Date - Private ReadOnly Session As Integer + Friend ReadOnly Session As Integer Friend Sub New(ByVal Data As UserMedia, ByVal User As IUserData, ByVal Session As Integer) Me.Data = Data Me.User = User diff --git a/SCrawler/Download/VideosDownloaderForm.vb b/SCrawler/Download/VideosDownloaderForm.vb index 33b814c..41c776b 100644 --- a/SCrawler/Download/VideosDownloaderForm.vb +++ b/SCrawler/Download/VideosDownloaderForm.vb @@ -109,15 +109,15 @@ Namespace DownloadObjects StartDownloading() End Sub Private Sub BTT_STOP_Click(sender As Object, e As EventArgs) Handles BTT_STOP.Click - SetControlValueInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = False) + ControlInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = False) MyJob.Stop() End Sub #End Region #Region "Downloading" Private Sub StartDownloading() If Not MyJob.Working And MyJob.Count > 0 Then - SetControlValueInvoke(ToolbarTOP, BTT_DOWN, Sub() BTT_DOWN.Enabled = False) - SetControlValueInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = True) + ControlInvoke(ToolbarTOP, BTT_DOWN, Sub() BTT_DOWN.Enabled = False) + ControlInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = True) MyJob.Start(AddressOf DownloadVideos, Threading.ApartmentState.STA) End If End Sub @@ -137,8 +137,8 @@ Namespace DownloadObjects RefillList() MyJob.Progress.Visible = False End If - SetControlValueInvoke(ToolbarTOP, BTT_DOWN, Sub() BTT_DOWN.Enabled = True) - SetControlValueInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = False) + ControlInvoke(ToolbarTOP, BTT_DOWN, Sub() BTT_DOWN.Enabled = True) + ControlInvoke(ToolbarTOP, BTT_STOP, Sub() BTT_STOP.Enabled = False) MyJob.Stopped() End Sub #End Region diff --git a/SCrawler/Editors/CollectionEditorForm.Designer.vb b/SCrawler/Editors/CollectionEditorForm.Designer.vb index f52770c..1dea643 100644 --- a/SCrawler/Editors/CollectionEditorForm.Designer.vb +++ b/SCrawler/Editors/CollectionEditorForm.Designer.vb @@ -15,9 +15,9 @@ Private Sub InitializeComponent() Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer - Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() + Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(CollectionEditorForm)) - Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() + Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() Me.CMB_COLLECTIONS = New PersonalUtilities.Forms.Controls.ComboBoxExtended() CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer() CONTAINER_MAIN.ContentPanel.SuspendLayout() @@ -44,14 +44,14 @@ ' 'CMB_COLLECTIONS ' - ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image) - ActionButton3.Name = "Add" - ActionButton3.ToolTipText = "Add new collection" - ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image) - ActionButton4.Name = "ArrowDown" - ActionButton4.Visible = False - Me.CMB_COLLECTIONS.Buttons.Add(ActionButton3) - Me.CMB_COLLECTIONS.Buttons.Add(ActionButton4) + ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image) + ActionButton1.Name = "Add" + ActionButton1.ToolTipText = "Add new collection" + ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image) + ActionButton2.Name = "ArrowDown" + ActionButton2.Visible = False + Me.CMB_COLLECTIONS.Buttons.Add(ActionButton1) + Me.CMB_COLLECTIONS.Buttons.Add(ActionButton2) Me.CMB_COLLECTIONS.Dock = System.Windows.Forms.DockStyle.Fill Me.CMB_COLLECTIONS.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple Me.CMB_COLLECTIONS.Location = New System.Drawing.Point(2, 0) diff --git a/SCrawler/Editors/CollectionEditorForm.resx b/SCrawler/Editors/CollectionEditorForm.resx index 492e1a6..c30579c 100644 --- a/SCrawler/Editors/CollectionEditorForm.resx +++ b/SCrawler/Editors/CollectionEditorForm.resx @@ -121,7 +121,7 @@ False - + iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6 JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAADmUlE @@ -143,7 +143,7 @@ 0AUyNxOP1DOwcaG/8I+/LRB+At7psBnyDBG0AAAAAElFTkSuQmCC - + iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE65JREFUeF7t 3X2sJWddB/DdLi2lQG2hdOHuvfM887J7Cxca4ELTQMDWKigIFpBAEAgi9g+CJpJo9Q8NJhgBiYZIYspL diff --git a/SCrawler/Editors/CollectionEditorForm.vb b/SCrawler/Editors/CollectionEditorForm.vb index bf581d9..97ddeec 100644 --- a/SCrawler/Editors/CollectionEditorForm.vb +++ b/SCrawler/Editors/CollectionEditorForm.vb @@ -27,6 +27,7 @@ Namespace Editors With MyDefs .MyViewInitialize() .AddOkCancelToolbar() + Collections.ListAddList(Settings.LastCollections) Collections.ListAddList((From c In Settings.Users Where c.IsCollection Select c.CollectionName), LAP.NotContainsOnly, EDP.ThrowException) If Collections.ListExists Then Collections.Sort() : CMB_COLLECTIONS.Items.AddRange(From c In Collections Select New ListItem(c)) If Not Collection.IsEmptyString And Collections.Contains(Collection) Then CMB_COLLECTIONS.SelectedIndex = Collections.IndexOf(Collection) @@ -46,6 +47,10 @@ Namespace Editors Private Sub MyDefs_ButtonOkClick() Handles MyDefs.ButtonOkClick If CMB_COLLECTIONS.SelectedIndex >= 0 Then Collection = CMB_COLLECTIONS.Value.ToString + With Settings.LastCollections + If .Contains(Collection) Then .Remove(Collection) + If .Count = 0 Then .Add(Collection) Else .Insert(0, Collection) + End With MyDefs.CloseForm() Else MsgBoxE("Collection not selected", MsgBoxStyle.Exclamation) diff --git a/SCrawler/Editors/GlobalSettingsForm.Designer.vb b/SCrawler/Editors/GlobalSettingsForm.Designer.vb index d7b38cf..927feeb 100644 --- a/SCrawler/Editors/GlobalSettingsForm.Designer.vb +++ b/SCrawler/Editors/GlobalSettingsForm.Designer.vb @@ -95,6 +95,8 @@ Me.TXT_FEED_ROWS = New PersonalUtilities.Forms.Controls.TextBoxExtended() Me.TXT_FEED_COLUMNS = New PersonalUtilities.Forms.Controls.TextBoxExtended() Me.CH_FEED_ENDLESS = New System.Windows.Forms.CheckBox() + Me.CH_FEED_ADD_SESSION = New System.Windows.Forms.CheckBox() + Me.CH_FEED_ADD_DATE = New System.Windows.Forms.CheckBox() Me.TAB_MAIN = New System.Windows.Forms.TabControl() Me.CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer() TP_BASIS = New System.Windows.Forms.TableLayoutPanel() @@ -1091,14 +1093,17 @@ TP_FEED.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) TP_FEED.Controls.Add(TP_FEED_IMG_COUNT, 0, 0) TP_FEED.Controls.Add(Me.CH_FEED_ENDLESS, 0, 1) + TP_FEED.Controls.Add(Me.CH_FEED_ADD_SESSION, 0, 2) + TP_FEED.Controls.Add(Me.CH_FEED_ADD_DATE, 0, 3) TP_FEED.Dock = System.Windows.Forms.DockStyle.Fill TP_FEED.Location = New System.Drawing.Point(0, 0) TP_FEED.Name = "TP_FEED" - TP_FEED.RowCount = 3 + TP_FEED.RowCount = 5 TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!)) TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) + TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) + TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) - TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!)) TP_FEED.Size = New System.Drawing.Size(576, 284) TP_FEED.TabIndex = 0 ' @@ -1117,7 +1122,7 @@ TP_FEED_IMG_COUNT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) TP_FEED_IMG_COUNT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!)) TP_FEED_IMG_COUNT.Size = New System.Drawing.Size(574, 28) - TP_FEED_IMG_COUNT.TabIndex = 1 + TP_FEED_IMG_COUNT.TabIndex = 0 ' 'TXT_FEED_ROWS ' @@ -1158,10 +1163,32 @@ Me.CH_FEED_ENDLESS.Location = New System.Drawing.Point(4, 33) Me.CH_FEED_ENDLESS.Name = "CH_FEED_ENDLESS" Me.CH_FEED_ENDLESS.Size = New System.Drawing.Size(568, 19) - Me.CH_FEED_ENDLESS.TabIndex = 3 + Me.CH_FEED_ENDLESS.TabIndex = 1 Me.CH_FEED_ENDLESS.Text = "Endless feed" Me.CH_FEED_ENDLESS.UseVisualStyleBackColor = True ' + 'CH_FEED_ADD_SESSION + ' + Me.CH_FEED_ADD_SESSION.AutoSize = True + Me.CH_FEED_ADD_SESSION.Dock = System.Windows.Forms.DockStyle.Fill + Me.CH_FEED_ADD_SESSION.Location = New System.Drawing.Point(4, 59) + Me.CH_FEED_ADD_SESSION.Name = "CH_FEED_ADD_SESSION" + Me.CH_FEED_ADD_SESSION.Size = New System.Drawing.Size(568, 19) + Me.CH_FEED_ADD_SESSION.TabIndex = 2 + Me.CH_FEED_ADD_SESSION.Text = "Add the session number to the post title" + Me.CH_FEED_ADD_SESSION.UseVisualStyleBackColor = True + ' + 'CH_FEED_ADD_DATE + ' + Me.CH_FEED_ADD_DATE.AutoSize = True + Me.CH_FEED_ADD_DATE.Dock = System.Windows.Forms.DockStyle.Fill + Me.CH_FEED_ADD_DATE.Location = New System.Drawing.Point(4, 85) + Me.CH_FEED_ADD_DATE.Name = "CH_FEED_ADD_DATE" + Me.CH_FEED_ADD_DATE.Size = New System.Drawing.Size(568, 19) + Me.CH_FEED_ADD_DATE.TabIndex = 3 + Me.CH_FEED_ADD_DATE.Text = "Add the date to the post title" + Me.CH_FEED_ADD_DATE.UseVisualStyleBackColor = True + ' 'TAB_MAIN ' Me.TAB_MAIN.Controls.Add(TAB_BASIS) @@ -1314,5 +1341,7 @@ Private WithEvents TXT_FEED_ROWS As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents TXT_FEED_COLUMNS As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents CH_FEED_ENDLESS As CheckBox + Private WithEvents CH_FEED_ADD_SESSION As CheckBox + Private WithEvents CH_FEED_ADD_DATE As CheckBox End Class End Namespace \ No newline at end of file diff --git a/SCrawler/Editors/GlobalSettingsForm.vb b/SCrawler/Editors/GlobalSettingsForm.vb index dbb5a94..790c6eb 100644 --- a/SCrawler/Editors/GlobalSettingsForm.vb +++ b/SCrawler/Editors/GlobalSettingsForm.vb @@ -83,6 +83,8 @@ Namespace Editors TXT_FEED_ROWS.Value = .FeedDataRows.Value TXT_FEED_COLUMNS.Value = .FeedDataColumns.Value CH_FEED_ENDLESS.Checked = .FeedEndless + CH_FEED_ADD_SESSION.Checked = .FeedAddSessionToCaption + CH_FEED_ADD_DATE.Checked = .FeedAddDateToCaption End With .MyFieldsChecker = New FieldsChecker With .MyFieldsCheckerE @@ -191,6 +193,8 @@ Namespace Editors .FeedDataRows.Value = CInt(TXT_FEED_ROWS.Value) .FeedDataColumns.Value = CInt(TXT_FEED_COLUMNS.Value) .FeedEndless.Value = CH_FEED_ENDLESS.Checked + .FeedAddSessionToCaption.Value = CH_FEED_ADD_SESSION.Checked + .FeedAddDateToCaption.Value = CH_FEED_ADD_DATE.Checked FeedParametersChanged = .FeedDataRows.ChangesDetected Or .FeedDataColumns.ChangesDetected Or .FeedEndless.ChangesDetected .EndUpdate() diff --git a/SCrawler/ListImagesLoader.vb b/SCrawler/ListImagesLoader.vb index 42181ce..d3fe85e 100644 --- a/SCrawler/ListImagesLoader.vb +++ b/SCrawler/ListImagesLoader.vb @@ -176,9 +176,7 @@ Friend Class ListImagesLoader Try Dim t As New List(Of Task) Dim l As New List(Of UserOption) - For Each u As IUserData In Settings.Users - If u.FitToAddParams Then t.Add(Task.Run(Sub() l.Add(New UserOption(u, MyList, True)))) - Next + t.AddRange(From u As IUserData In Settings.Users Where u.FitToAddParams Select Task.Run(Sub() l.Add(New UserOption(u, MyList, True)))) If t.Count > 0 Then Task.WaitAll(t.ToArray) If l.Count > 0 Then For i% = 0 To l.Count - 1 diff --git a/SCrawler/MainFrame.Designer.vb b/SCrawler/MainFrame.Designer.vb index 569bc07..5ecba73 100644 --- a/SCrawler/MainFrame.Designer.vb +++ b/SCrawler/MainFrame.Designer.vb @@ -73,6 +73,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form Me.BTT_SHOW_EXCLUDED_LABELS_IGNORE = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_SHOW_SHOW_GROUPS = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_SHOW_LIMIT_DATES_NOT = New System.Windows.Forms.ToolStripMenuItem() + Me.BTT_SHOW_LIMIT_DATES_IN = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_LOG = New System.Windows.Forms.ToolStripButton() Me.BTT_VERSION_INFO = New System.Windows.Forms.ToolStripButton() Me.BTT_DONATE = New System.Windows.Forms.ToolStripButton() @@ -89,6 +90,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form Me.BTT_CONTEXT_DOWN_DATE_LIMIT = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_CONTEXT_EDIT = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_CONTEXT_DELETE = New System.Windows.Forms.ToolStripMenuItem() + Me.BTT_CONTEXT_COPY_TO_FOLDER = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_CONTEXT_FAV = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_CONTEXT_TEMP = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_CONTEXT_READY = New System.Windows.Forms.ToolStripMenuItem() @@ -106,7 +108,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form Me.BTT_TRAY_SHOW_HIDE = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_TRAY_CLOSE = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_TRAY_CLOSE_NO_SCRIPT = New System.Windows.Forms.ToolStripMenuItem() - Me.BTT_SHOW_LIMIT_DATES_IN = New System.Windows.Forms.ToolStripMenuItem() SEP_1 = New System.Windows.Forms.ToolStripSeparator() SEP_2 = New System.Windows.Forms.ToolStripSeparator() CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator() @@ -537,6 +538,14 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form Me.BTT_SHOW_LIMIT_DATES_NOT.Text = "Limit dates (not in range)" Me.BTT_SHOW_LIMIT_DATES_NOT.ToolTipText = "Filter users whose last download date is not in the selected date range" ' + 'BTT_SHOW_LIMIT_DATES_IN + ' + Me.BTT_SHOW_LIMIT_DATES_IN.AutoToolTip = True + Me.BTT_SHOW_LIMIT_DATES_IN.Name = "BTT_SHOW_LIMIT_DATES_IN" + Me.BTT_SHOW_LIMIT_DATES_IN.Size = New System.Drawing.Size(231, 22) + Me.BTT_SHOW_LIMIT_DATES_IN.Text = "Limit dates (in range)" + Me.BTT_SHOW_LIMIT_DATES_IN.ToolTipText = "Filter users whose last download date is in the selected date range" + ' 'BTT_LOG ' Me.BTT_LOG.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Text @@ -622,9 +631,9 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form ' 'USER_CONTEXT ' - Me.USER_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_CONTEXT_DOWN, Me.BTT_CONTEXT_DOWN_LIMITED, Me.BTT_CONTEXT_DOWN_DATE_LIMIT, Me.BTT_CONTEXT_EDIT, Me.BTT_CONTEXT_DELETE, CONTEXT_SEP_1, Me.BTT_CONTEXT_FAV, Me.BTT_CONTEXT_TEMP, Me.BTT_CONTEXT_READY, Me.BTT_CONTEXT_GROUPS, Me.BTT_CONTEXT_SCRIPT, Me.BTT_CONTEXT_ADD_TO_COL, Me.BTT_CONTEXT_COL_MERGE, Me.BTT_CONTEXT_CHANGE_FOLDER, CONTEXT_SEP_2, Me.BTT_CHANGE_IMAGE, CONTEXT_SEP_3, Me.BTT_CONTEXT_OPEN_PATH, CONTEXT_SEP_4, Me.BTT_CONTEXT_OPEN_SITE, CONTEXT_SEP_5, Me.BTT_CONTEXT_INFO}) + Me.USER_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_CONTEXT_DOWN, Me.BTT_CONTEXT_DOWN_LIMITED, Me.BTT_CONTEXT_DOWN_DATE_LIMIT, Me.BTT_CONTEXT_EDIT, Me.BTT_CONTEXT_DELETE, Me.BTT_CONTEXT_COPY_TO_FOLDER, CONTEXT_SEP_1, Me.BTT_CONTEXT_FAV, Me.BTT_CONTEXT_TEMP, Me.BTT_CONTEXT_READY, Me.BTT_CONTEXT_GROUPS, Me.BTT_CONTEXT_SCRIPT, Me.BTT_CONTEXT_ADD_TO_COL, Me.BTT_CONTEXT_COL_MERGE, Me.BTT_CONTEXT_CHANGE_FOLDER, CONTEXT_SEP_2, Me.BTT_CHANGE_IMAGE, CONTEXT_SEP_3, Me.BTT_CONTEXT_OPEN_PATH, CONTEXT_SEP_4, Me.BTT_CONTEXT_OPEN_SITE, CONTEXT_SEP_5, Me.BTT_CONTEXT_INFO}) Me.USER_CONTEXT.Name = "USER_CONTEXT" - Me.USER_CONTEXT.Size = New System.Drawing.Size(222, 408) + Me.USER_CONTEXT.Size = New System.Drawing.Size(222, 452) ' 'BTT_CONTEXT_DOWN ' @@ -663,6 +672,13 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form Me.BTT_CONTEXT_DELETE.Size = New System.Drawing.Size(221, 22) Me.BTT_CONTEXT_DELETE.Text = "Delete user / collection" ' + 'BTT_CONTEXT_COPY_TO_FOLDER + ' + Me.BTT_CONTEXT_COPY_TO_FOLDER.Image = Global.SCrawler.My.Resources.Resources.PastePic32 + Me.BTT_CONTEXT_COPY_TO_FOLDER.Name = "BTT_CONTEXT_COPY_TO_FOLDER" + Me.BTT_CONTEXT_COPY_TO_FOLDER.Size = New System.Drawing.Size(221, 22) + Me.BTT_CONTEXT_COPY_TO_FOLDER.Text = "Copy data to another folder" + ' 'BTT_CONTEXT_FAV ' Me.BTT_CONTEXT_FAV.Image = Global.SCrawler.My.Resources.Resources.StarPic_24 @@ -786,14 +802,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form Me.BTT_TRAY_CLOSE_NO_SCRIPT.ToolTipText = "Close the program without executing the script" Me.BTT_TRAY_CLOSE_NO_SCRIPT.Visible = False ' - 'BTT_SHOW_LIMIT_DATES_IN - ' - Me.BTT_SHOW_LIMIT_DATES_IN.AutoToolTip = True - Me.BTT_SHOW_LIMIT_DATES_IN.Name = "BTT_SHOW_LIMIT_DATES_IN" - Me.BTT_SHOW_LIMIT_DATES_IN.Size = New System.Drawing.Size(231, 22) - Me.BTT_SHOW_LIMIT_DATES_IN.Text = "Limit dates (in range)" - Me.BTT_SHOW_LIMIT_DATES_IN.ToolTipText = "Filter users whose last download date is in the selected date range" - ' 'MainFrame ' Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) @@ -892,4 +900,5 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form Friend WithEvents Toolbar_TOP As ToolStrip Private WithEvents BTT_FEED As ToolStripButton Private WithEvents BTT_SHOW_LIMIT_DATES_IN As ToolStripMenuItem + Private WithEvents BTT_CONTEXT_COPY_TO_FOLDER As ToolStripMenuItem End Class \ No newline at end of file diff --git a/SCrawler/MainFrame.resx b/SCrawler/MainFrame.resx index d0c334c..a12484e 100644 --- a/SCrawler/MainFrame.resx +++ b/SCrawler/MainFrame.resx @@ -312,6 +312,35 @@ 623, 17 + + + iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGPC/xhBQAAABl0RVh0U29m + dHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVoSURBVEhLhZVrTJNXGMdfrtNSQIoadKRz2o0CorU3 + WkDIVBRaaGNbwAteh+AARRQlitEYTTRekiX7sH3YPmyZH9wtziybigLRCWTaCW5sCBWhlrb0Ci9zSxbo + 2f+UliGX7SS/tO85z/k9T57zXhhCCPO7Wh3VIhB83JKQ0Nu4bNlHm5YseZ1hmHC69n+Y5HLFcz7/ft/S + pY+vr1hhwL4oEBJcZ0x793If5uZ+1VNfT/qvXCHP6+p8tzMymqRxcW8hMGKqbDo9MlmWddu2AfbiRTJ6 + +TIZKC52fyAUVi2JiYkLJmGaBYIPnx4+TPrOnCH9p08TC4LNx46RWwrF/ZXR0W/PleRZZuY669atZvbS + JcJiL9vQQEZPnSKmwkLPjcTE97GPB8KZlvh4C5X31dWRgRMniAVBtvPnyWB9ve+2XP7jmtjYpOlJTOnp + G60lJRZaOZWPQs4ePUpGUZh3xw7SnJDQhT0KEM3c5fOv9paVkX4kMAPL8ePEig1D584RG9rVpFS2rY6J + EQaTmKTSjbbiYsvIhQuERTGjKIrFvtHaWjK8fz9plsudexYu/BLxKsBj9ALBGzel0vt9e/b4XiBoENhQ + zRDOxIWWOY4cIS0KRZs4Nja5QyLJtRoM1pGzZ/0tYVExi/ayNTVkBPJ76enuJA7nM4j3gVWAHjgTIYqL + E96SStvMu3YR64EDxF5dTYYOHSJOJPNA5Kiu9rUrlZ1mrdbCnjzpr5jFGotYtqpqQi6TuVM4nKvwlYHU + gDzU31OMSGl8fPJtsbjVsn27z15RQRzAVVlJ3BB4kcx78CAZQbUjVIxrFtd+OdrbmpHhEXG5VE4rTwHz + wMRdFDw4jEgFj5dyRyRqsxYVEcfu3cQFPPv2ES8qHEbCYRzgsFZLvO+8Q7xKJXGDVoXCK46Ovob95YBW + Ph/8+xwE/wSTyHi81OZVq9qsGs2Ye8sW4srPJy6JhDgTE4kzOpo4IyKIMyyMOLhcX9Py5R4lj0cPtAKs + BBwwKfc7p174J5BEhHY9FIk6bBDaIRuiQkDFfsLDSbdU+pdBKPwe8e+BNDBD7vdNn6BYd+6stK5da7bP + nz9TDujcoEAw1lJY+CyFz9dCHDubnDJjwltRccS5fr3TjurnlIMBYE5NJY8Nhq7SrCwREsz6xL9y4S4v + b3Bt2uSyR0XNkDvQe9ouKu8HvaGh5FfQIxL5OgyG30qUStqmGUkm/3jKy0+48vLcs1XuiI8nL/Ly/rYl + JfmovCcgN4JW+l8iGe8oKuoqzcyckSQob3CpVB47l+sXv9KWxYtJt0r1x9ns7HZjQYHNnJxMfoH0EXgA + 7oFm0CmTjRsNhs6Na9bQF+Tkq57xlJXVu9Rqz9Bs8kWLSG9BwcsqieQONlXnpaaWdul0z7rR+6C8CTSC + m8Aol4+36/XGT7VaevCRIIRx6/WWoQULZq2cyveLxY0IrAT0IHm1OTmZT3Q6U2da2qT8B/Ad+BZ05OSM + GXW6p4hdBiIZZ1FRt5vPn6vyuwiqCsj9Xyq6qXbDBkWnXm/6OS3NN1X+dUgIeZSdPXZPoxlEXC6IY9pL + S7faNBqXC9Iplf95YBb5ZF+RpGbdunQcbO/D1avJ9YC8LT19/Iv8/BeqpKRPEDORAGNeY3HxSYtG43Eq + FL5etfpljUzWhPlZ5VOTlGVliR+hHUbs+0mpHP9GpRqM5XAuY20zmGgRRohYKIx9rNd/3qfTOa7l5uLu + C63BvARw6fp0eRCMyBslJe8+2bx58EFhoVMlFNJvgQ4kgggQEgykvV0ApEAd+J3z8Z8KxmuA3pr0zikA + b4LJZ2FqYBigFdOPNf0NC679Fxi0OPr+XxiAJgwURph/AJfOQQebMR8TAAAAAElFTkSuQmCC + + AAABAAEAMDAAAAEAIACoJQAAFgAAACgAAAAwAAAAYAAAAAEAIAAAAAAAACQAAMMOAADDDgAAAAAAAAAA @@ -476,35 +505,6 @@ AAAAAAAAH/8AAAAAAAA//wAAAAAAAH//AAAAAAAA//8AAAAAAAP//wAAAAAAB///AAAAAAAP//8AAAAA AB///wAAAAAAf///AAAAAAH///8AAAAAB////wAAAAAf////AAAAAP////8AAAAH/////wAAAH////// AAA= - - - - - iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGPC/xhBQAAABl0RVh0U29m - dHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVoSURBVEhLhZVrTJNXGMdfrtNSQIoadKRz2o0CorU3 - WkDIVBRaaGNbwAteh+AARRQlitEYTTRekiX7sH3YPmyZH9wtziybigLRCWTaCW5sCBWhlrb0Ci9zSxbo - 2f+UliGX7SS/tO85z/k9T57zXhhCCPO7Wh3VIhB83JKQ0Nu4bNlHm5YseZ1hmHC69n+Y5HLFcz7/ft/S - pY+vr1hhwL4oEBJcZ0x793If5uZ+1VNfT/qvXCHP6+p8tzMymqRxcW8hMGKqbDo9MlmWddu2AfbiRTJ6 - +TIZKC52fyAUVi2JiYkLJmGaBYIPnx4+TPrOnCH9p08TC4LNx46RWwrF/ZXR0W/PleRZZuY669atZvbS - JcJiL9vQQEZPnSKmwkLPjcTE97GPB8KZlvh4C5X31dWRgRMniAVBtvPnyWB9ve+2XP7jmtjYpOlJTOnp - G60lJRZaOZWPQs4ePUpGUZh3xw7SnJDQhT0KEM3c5fOv9paVkX4kMAPL8ePEig1D584RG9rVpFS2rY6J - EQaTmKTSjbbiYsvIhQuERTGjKIrFvtHaWjK8fz9plsudexYu/BLxKsBj9ALBGzel0vt9e/b4XiBoENhQ - zRDOxIWWOY4cIS0KRZs4Nja5QyLJtRoM1pGzZ/0tYVExi/ayNTVkBPJ76enuJA7nM4j3gVWAHjgTIYqL - E96SStvMu3YR64EDxF5dTYYOHSJOJPNA5Kiu9rUrlZ1mrdbCnjzpr5jFGotYtqpqQi6TuVM4nKvwlYHU - gDzU31OMSGl8fPJtsbjVsn27z15RQRzAVVlJ3BB4kcx78CAZQbUjVIxrFtd+OdrbmpHhEXG5VE4rTwHz - wMRdFDw4jEgFj5dyRyRqsxYVEcfu3cQFPPv2ES8qHEbCYRzgsFZLvO+8Q7xKJXGDVoXCK46Ovob95YBW - Ph/8+xwE/wSTyHi81OZVq9qsGs2Ye8sW4srPJy6JhDgTE4kzOpo4IyKIMyyMOLhcX9Py5R4lj0cPtAKs - BBwwKfc7p174J5BEhHY9FIk6bBDaIRuiQkDFfsLDSbdU+pdBKPwe8e+BNDBD7vdNn6BYd+6stK5da7bP - nz9TDujcoEAw1lJY+CyFz9dCHDubnDJjwltRccS5fr3TjurnlIMBYE5NJY8Nhq7SrCwREsz6xL9y4S4v - b3Bt2uSyR0XNkDvQe9ouKu8HvaGh5FfQIxL5OgyG30qUStqmGUkm/3jKy0+48vLcs1XuiI8nL/Ly/rYl - JfmovCcgN4JW+l8iGe8oKuoqzcyckSQob3CpVB47l+sXv9KWxYtJt0r1x9ns7HZjQYHNnJxMfoH0EXgA - 7oFm0CmTjRsNhs6Na9bQF+Tkq57xlJXVu9Rqz9Bs8kWLSG9BwcsqieQONlXnpaaWdul0z7rR+6C8CTSC - m8Aol4+36/XGT7VaevCRIIRx6/WWoQULZq2cyveLxY0IrAT0IHm1OTmZT3Q6U2da2qT8B/Ad+BZ05OSM - GXW6p4hdBiIZZ1FRt5vPn6vyuwiqCsj9Xyq6qXbDBkWnXm/6OS3NN1X+dUgIeZSdPXZPoxlEXC6IY9pL - S7faNBqXC9Iplf95YBb5ZF+RpGbdunQcbO/D1avJ9YC8LT19/Iv8/BeqpKRPEDORAGNeY3HxSYtG43Eq - FL5etfpljUzWhPlZ5VOTlGVliR+hHUbs+0mpHP9GpRqM5XAuY20zmGgRRohYKIx9rNd/3qfTOa7l5uLu - C63BvARw6fp0eRCMyBslJe8+2bx58EFhoVMlFNJvgQ4kgggQEgykvV0ApEAd+J3z8Z8KxmuA3pr0zikA - b4LJZ2FqYBigFdOPNf0NC679Fxi0OPr+XxiAJgwURph/AJfOQQebMR8TAAAAAElFTkSuQmCC diff --git a/SCrawler/MainFrame.vb b/SCrawler/MainFrame.vb index 07f5d75..ff8c439 100644 --- a/SCrawler/MainFrame.vb +++ b/SCrawler/MainFrame.vb @@ -10,6 +10,7 @@ Imports System.ComponentModel Imports System.Globalization Imports System.Threading Imports PersonalUtilities.Forms +Imports PersonalUtilities.Functions.Messaging Imports SCrawler.API Imports SCrawler.API.Base Imports SCrawler.Editors @@ -672,6 +673,9 @@ CloseResume: Private Sub BTT_CONTEXT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DELETE.Click DeleteSelectedUser() 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 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 @@ -776,40 +780,83 @@ CloseResume: End If End Sub 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", MsgBoxStyle.Exclamation) + MsgBoxE({"Collection path not specified", MsgTitle}, MsgBoxStyle.Exclamation) Else - Dim user As IUserData = GetSelectedUser() - If Not user Is Nothing Then - If user.IsCollection Then - MsgBoxE("Collection can not be added to collection!", MsgBoxStyle.Critical) - Else - Using f As New CollectionEditorForm(user.CollectionName) + 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 + 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)).ListToString(vbCr), + 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 - With Settings - Dim fCol As Predicate(Of IUserData) = Function(u) u.IsCollection And u.CollectionName = f.Collection - Dim i% = .Users.FindIndex(fCol) - Dim Added As Boolean = i < 0 - If i < 0 Then - .Users.Add(New UserDataBind(f.Collection)) - MainFrameObj.CollectionHandler(DirectCast(.Users.Last, UserDataBind)) - i = .Users.Count - 1 - End If - Try - DirectCast(.Users(i), UserDataBind).Add(user) - RemoveUserFromList(user) - i = .Users.FindIndex(fCol) - If i >= 0 Then UserListUpdate(.Users(i), Added) - MsgBoxE($"[{user.Name}] was added to collection [{f.Collection}]") - Catch ex As InvalidOperationException - i = .Users.FindIndex(fCol) - If i >= 0 AndAlso DirectCast(.Users(i), UserDataBind).Count = 0 Then .Users(i).Dispose() : .Users.RemoveAt(i) - End Try - End With - End If + If f.DialogResult = DialogResult.OK Then _col_name = f.Collection End Using End If + If _col_name.IsEmptyString Then + MsgBoxE({"The destination collection has not been selected.", MsgTitle}, vbExclamation) + Else + 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)) + MainFrameObj.CollectionHandler(DirectCast(.Users.Last, UserDataBind)) + userCollection = .Users.Last + End If + Dim __added_users As New List(Of IUserData) + Dim __added_users_not As New List(Of IUserData) + For Each user As IUserData In users + If Not user.IsCollection Then + Try + 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.ListToString(vbCr) + 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.ListToString(vbCr) + End If + MsgBoxE(m) + End If + __added_users.Clear() + __added_users_not.Clear() + End With + End If End If End If End Sub @@ -1025,15 +1072,15 @@ CloseResume: If USER_CONTEXT.Visible Then USER_CONTEXT.Hide() Dim ugn As Func(Of IUserData, String) = Function(u) $"{IIf(u.IsCollection, "Collection", "User")}: {u.Name}" Dim m As New MMessage(users.Select(ugn).ListToString(vbNewLine), "Users deleting", - {New Messaging.MsgBoxButton("Delete and ban") With {.ToolTip = "Users and their data will be deleted and added to the blacklist"}, - New Messaging.MsgBoxButton("Delete user only and ban") With { + {New MsgBoxButton("Delete and ban") With {.ToolTip = "Users and their data will be deleted and added to the blacklist"}, + 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 Messaging.MsgBoxButton("Delete and ban with reason") With { + 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"}, - New Messaging.MsgBoxButton("Delete user only and ban with reason") With { + 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 Messaging.MsgBoxButton("Delete") With {.ToolTip = "Delete users and their data"}, - New Messaging.MsgBoxButton("Delete user only") With {.ToolTip = "Delete users but keep data"}, "Cancel"}, + New MsgBoxButton("Delete") With {.ToolTip = "Delete users and their data"}, + 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) @@ -1094,7 +1141,89 @@ CloseResume: End If End If Catch ex As Exception - ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error on trying to delete user / collection") + 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, True) + 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 + 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.SendInLog) 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.ListToString(vbNewLine) + 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.ListToString(vbNewLine) + 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 Friend Sub UserRemovedFromCollection(ByVal User As IUserData) diff --git a/SCrawler/My Project/AssemblyInfo.vb b/SCrawler/My Project/AssemblyInfo.vb index d7ad027..1bed40a 100644 --- a/SCrawler/My Project/AssemblyInfo.vb +++ b/SCrawler/My Project/AssemblyInfo.vb @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices ' by using the '*' as shown below: ' - - + + diff --git a/SCrawler/My Project/Resources.Designer.vb b/SCrawler/My Project/Resources.Designer.vb index 86ed3f0..5f417d8 100644 --- a/SCrawler/My Project/Resources.Designer.vb +++ b/SCrawler/My Project/Resources.Designer.vb @@ -170,6 +170,16 @@ Namespace My.Resources End Get End Property + ''' + ''' Looks up a localized resource of type System.Drawing.Bitmap. + ''' + Friend ReadOnly Property PastePic32() As System.Drawing.Bitmap + Get + Dim obj As Object = ResourceManager.GetObject("PastePic32", resourceCulture) + Return CType(obj,System.Drawing.Bitmap) + End Get + End Property + ''' ''' Looks up a localized resource of type System.Drawing.Bitmap. ''' diff --git a/SCrawler/My Project/Resources.resx b/SCrawler/My Project/Resources.resx index dc3a063..1711fa5 100644 --- a/SCrawler/My Project/Resources.resx +++ b/SCrawler/My Project/Resources.resx @@ -214,4 +214,7 @@ ..\Content\Pictures\StopPic32.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a + + ..\Content\Pictures\PastePic32.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a + \ No newline at end of file diff --git a/SCrawler/SCrawler.vbproj b/SCrawler/SCrawler.vbproj index 4973176..17d1a1e 100644 --- a/SCrawler/SCrawler.vbproj +++ b/SCrawler/SCrawler.vbproj @@ -492,6 +492,7 @@ + PreserveNewest diff --git a/SCrawler/SettingsCLS.vb b/SCrawler/SettingsCLS.vb index 299838d..011c3aa 100644 --- a/SCrawler/SettingsCLS.vb +++ b/SCrawler/SettingsCLS.vb @@ -36,6 +36,7 @@ Friend Class SettingsCLS : Implements IDisposable Friend Property Channels As Reddit.ChannelsCollection Friend ReadOnly Property Labels As LabelsKeeper Friend ReadOnly Property Groups As Groups.DownloadGroupCollection + Friend ReadOnly Property LastCollections As List(Of String) Friend Property Automation As Scheduler Friend ReadOnly Property BlackList As List(Of UserBan) Private ReadOnly BlackListFile As SFile = $"{SettingsFolderName}\BlackList.txt" @@ -52,9 +53,11 @@ Friend Class SettingsCLS : Implements IDisposable UsersList = New List(Of UserInfo) BlackList = New List(Of UserBan) Plugins = New List(Of PluginHost) + LastCollections = New List(Of String) GlobalPath = New XMLValue(Of SFile)("GlobalPath", New SFile($"{SFile.GetPath(Application.StartupPath).PathWithSeparator}Data\"), MyXML,, New XMLValueBase.ToFilePath) + LastCopyPath = New XMLValue(Of SFile)("LastCopyPath",, MyXML,, New XMLValueBase.ToFilePath) CookiesEncrypted = New XMLValue(Of Boolean)("CookiesEncrypted", False, MyXML) EncryptCookies.CookiesEncrypted = CookiesEncrypted @@ -122,6 +125,8 @@ Friend Class SettingsCLS : Implements IDisposable FeedDataColumns = New XMLValue(Of Integer)("DataColumns", 1, MyXML, n) FeedDataRows = New XMLValue(Of Integer)("DataRows", 10, MyXML, n) FeedEndless = New XMLValue(Of Boolean)("Endless", True, MyXML, n) + FeedAddDateToCaption = New XMLValue(Of Boolean)("AddDateToCaption", True, MyXML, n) + FeedAddSessionToCaption = New XMLValue(Of Boolean)("AddSessionToCaption", False, MyXML, n) n = {"Users"} FromChannelDownloadTop = New XMLValue(Of Integer)("FromChannelDownloadTop", 10, MyXML, n) @@ -420,6 +425,7 @@ Friend Class SettingsCLS : Implements IDisposable End Get End Property Friend ReadOnly Property GlobalPath As XMLValue(Of SFile) + Friend ReadOnly Property LastCopyPath As XMLValue(Of SFile) Friend ReadOnly Property SeparateVideoFolder As XMLValue(Of Boolean) Friend ReadOnly Property CollectionsPath As XMLValue(Of String) Friend ReadOnly Property CollectionsPathF As SFile @@ -519,6 +525,8 @@ Friend Class SettingsCLS : Implements IDisposable Friend ReadOnly Property FeedDataColumns As XMLValue(Of Integer) Friend ReadOnly Property FeedDataRows As XMLValue(Of Integer) Friend ReadOnly Property FeedEndless As XMLValue(Of Boolean) + Friend ReadOnly Property FeedAddDateToCaption As XMLValue(Of Boolean) + Friend ReadOnly Property FeedAddSessionToCaption As XMLValue(Of Boolean) #End Region #Region "New version properties" Friend ReadOnly Property CheckUpdatesAtStart As XMLValue(Of Boolean) @@ -550,6 +558,7 @@ Friend Class SettingsCLS : Implements IDisposable If Not Automation Is Nothing Then Automation.Dispose() CachePath.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.None) Plugins.Clear() + LastCollections.Clear() Users.ListClearDispose UsersList.Clear() SelectedSites.Dispose()