diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 935df46..4f0f6b1 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -11,10 +11,10 @@ I welcome requests! Follow these steps to contribute: 1. Delete the "PersonalUtilities" project from the solution. 1. Delete the "PersonalUtilities.Notifications" project from the solution. 1. The following libraries must be added to project references with the '**Copy to output folder**' option: - - ```PersonalUtilities.dll``` - - ```PersonalUtilities.Notifications.dll``` - - ```Microsoft.Toolkit.Uwp.Notifications.dll``` - - ```System.ValueTuple.dll``` + - ```PersonalUtilities.dll``` + - ```PersonalUtilities.Notifications.dll``` + - ```Microsoft.Toolkit.Uwp.Notifications.dll``` + - ```System.ValueTuple.dll``` 1. Import PersonalUtilities.Functions for the whole project. **Always use the correct libraries. You must download libraries from the same release date as the code commit date.** diff --git a/Changelog.md b/Changelog.md index 55073ee..72c26af 100644 --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,18 @@ +# 2023.1.2.0 + +*2023-01-02* + +- Added + - RedGifs: an ability to customize token refresh interval + - RedGifs: token refresh interval changed from 24 hours to 12 hours + - Updated labels collection +- Fixed + - PornHub: bug in the downloader + - PornHub: download additional non-user videos + - Reddit: bug in standalone downloader + - Fixed a bug in the user list loading algorithm + - Notifications: pressing any button opens SCrawler + # 2022.12.27.0 *2022-12-27* diff --git a/FAQ.md b/FAQ.md index 5c31122..f165970 100644 --- a/FAQ.md +++ b/FAQ.md @@ -42,7 +42,7 @@ A: How to request a new site you can read [here](CONTRIBUTING.md#how-to-request- #### Q: **Twitter/Instagram download failed.** -A: Check your credentials. Both of these sites require cookies. Check your [Twitter tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) and [Instagram settings](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram-settings). If all settings are set, but nothing works, go to [create a new issue](https://github.com/AAndyProgram/SCrawler/issues). Don't forget to attach the LOG. +A: Check your credentials. Both of these sites require cookies. Check your [Twitter tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) and [Instagram settings](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram). If all settings are set, but nothing works, go to [create a new issue](https://github.com/AAndyProgram/SCrawler/issues). Don't forget to attach the LOG. **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)** diff --git a/ProgramScreenshots/SettingsSiteRedGifs.png b/ProgramScreenshots/SettingsSiteRedGifs.png index e5ed242..bc71828 100644 Binary files a/ProgramScreenshots/SettingsSiteRedGifs.png and b/ProgramScreenshots/SettingsSiteRedGifs.png differ diff --git a/SCrawler/API/Instagram/UserData.vb b/SCrawler/API/Instagram/UserData.vb index 01485be..c16c2e0 100644 --- a/SCrawler/API/Instagram/UserData.vb +++ b/SCrawler/API/Instagram/UserData.vb @@ -202,14 +202,14 @@ Namespace API.Instagram AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived ThrowAny(Token) HasError = False - Dim dt As Boolean = (CBool(MySiteSettings.DownloadTimeline.Value) And GetTimeline) Or IsSavedPosts - If dt And Not LastCursor.IsEmptyString Then + Dim dt As Func(Of Boolean) = Function() (CBool(MySiteSettings.DownloadTimeline.Value) And GetTimeline) Or IsSavedPosts + If dt.Invoke And Not LastCursor.IsEmptyString Then s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline) DownloadData(LastCursor, s, Token) ThrowAny(Token) If Not HasError Then FirstLoadingDone = True End If - If dt And Not HasError Then + If dt.Invoke And Not HasError Then s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline) DownloadData(String.Empty, s, Token) ThrowAny(Token) @@ -398,7 +398,6 @@ Namespace API.Instagram If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID") End If - 'Create query Select Case Section Case Sections.Timeline diff --git a/SCrawler/API/PornHub/SiteSettings.vb b/SCrawler/API/PornHub/SiteSettings.vb index d083cc5..e5e931d 100644 --- a/SCrawler/API/PornHub/SiteSettings.vb +++ b/SCrawler/API/PornHub/SiteSettings.vb @@ -41,6 +41,7 @@ Namespace API.PornHub Friend Sub New() MyBase.New("PornHub", "pornhub.com") Responser.CurlPath = $"cURL\curl.exe" + Responser.CurlArgumentsRight = "--ssl-no-revoke" CurlPathExists = Responser.CurlPath.Exists Responser.DeclaredError = EDP.ThrowException diff --git a/SCrawler/API/PornHub/UserData.vb b/SCrawler/API/PornHub/UserData.vb index 91fe281..eace7f2 100644 --- a/SCrawler/API/PornHub/UserData.vb +++ b/SCrawler/API/PornHub/UserData.vb @@ -210,6 +210,7 @@ Namespace API.PornHub If __continue And Not __videoDone Then Do While DownloadUserVideos(page, Token) = DataDownloaded And page < 100 : page += 1 : Loop End If + If _TempMediaList.Count > 0 Then _TempMediaList.RemoveAll(Function(m) Not m.Type = UTypes.m3u8 And Not m.Type = UTypes.VideoPre) End If Responser.Method = "GET" @@ -256,7 +257,7 @@ Namespace API.PornHub If PersonType = PersonTypeUser And r.Contains(HtmlPageNotFoundVideo) Then Return DataDownloaded_NotFound Dim l As List(Of UserVideo) = RegexFields(Of UserVideo)(r, {RegexVideo_Video_All}, {1, 2}) Dim lw As List(Of UserVideo) = Nothing - If Not PersonType = PersonTypeUser Then RegexFields(Of UserVideo)(r, {RegexVideo_Video_Wrong}, RegexVideo_Video_Wrong_Fields) + If Not PersonType = PersonTypeUser Then lw = RegexFields(Of UserVideo)(r, {RegexVideo_Video_Wrong}, RegexVideo_Video_Wrong_Fields) If l.ListExists Then If lw.ListExists Then l.ListWithRemove(lw) If l.Count > 0 Then diff --git a/SCrawler/API/Reddit/UserData.vb b/SCrawler/API/Reddit/UserData.vb index 669d992..1043d5b 100644 --- a/SCrawler/API/Reddit/UserData.vb +++ b/SCrawler/API/Reddit/UserData.vb @@ -662,6 +662,7 @@ Namespace API.Reddit Try If Not URL.IsEmptyString Then Using r As New UserData + r.SetEnvironment(Settings(RedditSiteKey), Nothing, False, False) r.Responser = New Responser r.Responser.Copy(resp) r.ParsePost(URL) diff --git a/SCrawler/API/Redgifs/SiteSettings.vb b/SCrawler/API/Redgifs/SiteSettings.vb index 5b4bb27..dfdb5b5 100644 --- a/SCrawler/API/Redgifs/SiteSettings.vb +++ b/SCrawler/API/Redgifs/SiteSettings.vb @@ -9,10 +9,10 @@ Imports SCrawler.API.Base Imports SCrawler.Plugin Imports SCrawler.Plugin.Attributes +Imports PersonalUtilities.Forms Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Tools.Web.Clients -Imports PersonalUtilities.Tools.Web.Cookies Imports PersonalUtilities.Tools.Web.Documents.JSON Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UStates = SCrawler.API.Base.UserMedia.States @@ -30,10 +30,38 @@ Namespace API.RedGifs Return My.Resources.SiteResources.RedGifsPic_32 End Get End Property - - Friend Property Token As PropertyValue - Friend Property TokenLastDateUpdated As PropertyValue + + Friend ReadOnly Property Token As PropertyValue + Friend ReadOnly Property TokenLastDateUpdated As PropertyValue Private Const TokenName As String = "authorization" +#Region "TokenUpdateInterval" + + Friend ReadOnly Property TokenUpdateInterval As PropertyValue + Private Class TokenIntervalProvider : Implements IFieldsCheckerProvider + Private Property ErrorMessage As String Implements IFieldsCheckerProvider.ErrorMessage + Private Property Name As String Implements IFieldsCheckerProvider.Name + Private Property TypeError As Boolean Implements IFieldsCheckerProvider.TypeError + Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider, + Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert + TypeError = False + ErrorMessage = String.Empty + If Not ACheck(Of Integer)(Value) Then + TypeError = True + ElseIf CInt(Value) > 0 Then + Return Value + Else + ErrorMessage = $"The value of [{Name}] field must be greater than or equal to 1" + End If + Return Nothing + End Function + Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat + Throw New NotImplementedException("[GetFormat] is not available in the context of [TokenIntervalProvider]") + End Function + End Class + + Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider +#End Region #End Region #Region "Initializer" Friend Sub New() @@ -47,6 +75,8 @@ Namespace API.RedGifs End With Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v)) TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date)) + TokenUpdateInterval = New PropertyValue(60 * 12, GetType(Integer)) + TokenUpdateIntervalProvider = New TokenIntervalProvider UrlPatternUser = "https://www.redgifs.com/users/{0}/" UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1) ImageVideoContains = "redgifs" @@ -61,7 +91,7 @@ Namespace API.RedGifs #Region "Token updaters" Friend Function UpdateTokenIfRequired() As Boolean Dim d As Date? = AConvert(Of Date)(TokenLastDateUpdated.Value, AModes.Var, Nothing) - If Not d.HasValue OrElse d.Value < Now.AddDays(-1) Then + If Not d.HasValue OrElse d.Value < Now.AddMinutes(-CInt(TokenUpdateInterval.Value)) Then Return UpdateToken() Else Return True diff --git a/SCrawler/Download/Automation/AutoDownloader.vb b/SCrawler/Download/Automation/AutoDownloader.vb index 70c1367..a34c14c 100644 --- a/SCrawler/Download/Automation/AutoDownloader.vb +++ b/SCrawler/Download/Automation/AutoDownloader.vb @@ -143,7 +143,8 @@ Namespace DownloadObjects ''' True to activate Friend Function Open(ByVal _Key As String) As Boolean If Not User Is Nothing Then - If Key = _Key Then + If KeyDismiss = _Key Then + ElseIf Key = _Key Then Return True ElseIf KeyFolder = _Key Then User.OpenFolder() @@ -152,6 +153,8 @@ Namespace DownloadObjects ElseIf Images.ContainsKey(_Key) Then Images(_Key).Open(, EDP.None) End If + Else + Return True End If Return False End Function @@ -548,10 +551,12 @@ Namespace DownloadObjects UserKeys.Last.ShowNotification() End If End Sub - Friend Function NotificationClicked(ByVal Key As String) As Boolean + Friend Function NotificationClicked(ByVal Key As String, ByRef Found As Boolean, ByRef ActivateForm As Boolean) As Boolean Dim i% = UserKeys.IndexOf(Key) If i >= 0 Then - MainFrameObj.FocusUser(UserKeys(i).IUserDataKey, UserKeys(i).Open(Key)) + Found = True + ActivateForm = UserKeys(i).Open(Key) + MainFrameObj.FocusUser(UserKeys(i).IUserDataKey, ActivateForm) Return True Else Return False diff --git a/SCrawler/Download/Automation/Scheduler.vb b/SCrawler/Download/Automation/Scheduler.vb index f2fb9f9..b44741f 100644 --- a/SCrawler/Download/Automation/Scheduler.vb +++ b/SCrawler/Download/Automation/Scheduler.vb @@ -52,8 +52,13 @@ Namespace DownloadObjects Return Plans.Count End Get End Property - Friend Function NotificationClicked(ByVal Key As String) As Boolean - Return Count > 0 AndAlso Plans.Exists(Function(p) p.NotificationClicked(Key)) + Friend Function NotificationClicked(ByVal Key As String, ByRef Found As Boolean, ByRef ActivateForm As Boolean) As Boolean + If Count > 0 Then + For Each plan As AutoDownloader In Plans + If plan.NotificationClicked(Key, Found, ActivateForm) Then Return True + Next + End If + Return False End Function Friend Sub Add(ByVal Plan As AutoDownloader) Plan.Source = Me diff --git a/SCrawler/Download/Groups/DownloadGroupCollection.vb b/SCrawler/Download/Groups/DownloadGroupCollection.vb index 4d5b1b5..8ed4cfe 100644 --- a/SCrawler/Download/Groups/DownloadGroupCollection.vb +++ b/SCrawler/Download/Groups/DownloadGroupCollection.vb @@ -34,9 +34,6 @@ Namespace DownloadObjects.Groups End If GroupsList.ListReindex End Sub - Friend Function GetLabels() As List(Of String) - Return ListAddList(Nothing, GroupsList.SelectMany(Function(g) g.Labels), LAP.NotContainsOnly) - End Function Default Friend ReadOnly Property Item(ByVal Index As Integer) As DownloadGroup Implements IMyEnumerator(Of DownloadGroup).MyEnumeratorObject Get Return GroupsList(Index) diff --git a/SCrawler/Editors/LabelsForm.vb b/SCrawler/Editors/LabelsForm.vb index 81eebdd..70ab06e 100644 --- a/SCrawler/Editors/LabelsForm.vb +++ b/SCrawler/Editors/LabelsForm.vb @@ -72,7 +72,7 @@ Friend Class LabelsForm Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick Try LabelsList.ListAddList(CMB_LABELS.Items.CheckedItems.Select(Function(l) CStr(l.Value(0))), LAP.ClearBeforeAdd, LAP.NotContainsOnly) - If _AnyLabelAdd And _Source Is Nothing Then Settings.Labels.Update() + If _Source Is Nothing Then Settings.Labels.Update() MyDefs.CloseForm() Catch ex As Exception ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Label selection") diff --git a/SCrawler/LabelsKeeper.vb b/SCrawler/LabelsKeeper.vb index a859446..6302478 100644 --- a/SCrawler/LabelsKeeper.vb +++ b/SCrawler/LabelsKeeper.vb @@ -25,30 +25,16 @@ Friend Class LabelsKeeper : Implements ICollection(Of String), IMyEnumerator(Of Friend ReadOnly Property Current As XMLValuesCollection(Of String) Friend ReadOnly Property Excluded As XMLValuesCollection(Of String) Friend ReadOnly Property ExcludedIgnore As XMLValue(Of Boolean) - Private ReadOnly Property SourceXML As XmlFile Friend Sub New(ByRef x As XmlFile) - SourceXML = x LabelsList = New List(Of String) NewLabels = New List(Of String) If LabelsFile.Exists Then LabelsList.ListAddList(IO.File.ReadAllLines(LabelsFile), LAP.NotContainsOnly) Current = New XMLValuesCollection(Of String)(XMLValueBase.ListModes.String, "LatestSelectedLabels", x) With {.ListAddParameters = LAP.NotContainsOnly} Excluded = New XMLValuesCollection(Of String)(XMLValueBase.ListModes.String, "LatestExcludedLabels", x) With {.ListAddParameters = LAP.NotContainsOnly} ExcludedIgnore = New XMLValue(Of Boolean)("LatestExcludedLabelsIgnore", False, x) - End Sub - Friend Sub Verify() - SourceXML.BeginUpdate() - Dim r As Predicate(Of String) = Function(l) Not LabelsList.Contains(l) - Dim c% = Current.Count - If c > 0 Then - Current.ValuesList.RemoveAll(r) - If Not Current.Count = c Then Current.Update() - End If - c = Excluded.Count - If c > 0 Then - Excluded.ValuesList.RemoveAll(r) - If Not c = Excluded.Count Then Excluded.Update() - End If - SourceXML.EndUpdate() + Dim lp As New ListAddParams(LAP.NotContainsOnly + LAP.IgnoreICopier) + If Current.Count > 0 Then LabelsList.ListAddList(Current, lp) + If Excluded.Count > 0 Then LabelsList.ListAddList(Excluded, lp) End Sub Friend ReadOnly Property ToList As List(Of String) Get @@ -69,10 +55,14 @@ Friend Class LabelsKeeper : Implements ICollection(Of String), IMyEnumerator(Of LabelsList.Clear() NewLabels.Clear() End Sub - Friend Sub Update() + Friend Sub Update(Optional ByVal Force As Boolean = False) If LabelsList.Count > 0 Then - LabelsList.Sort() - TextSaver.SaveTextToFile(LabelsList.ListToString(vbNewLine), LabelsFile, True, False, EDP.SendInLog) + If NewLabelsExists Or Force Then + If LabelsList.Contains(NoParsedUser) Then LabelsList.Remove(NoParsedUser) + LabelsList.Sort() + TextSaver.SaveTextToFile(LabelsList.ListToString(vbNewLine), LabelsFile, True, False, EDP.SendInLog) + If NewLabels.Count > 0 Then NewLabels.Clear() + End If Else LabelsFile.Delete(, Settings.DeleteMode, EDP.SendInLog) End If diff --git a/SCrawler/ListImagesLoader.vb b/SCrawler/ListImagesLoader.vb index bd68adb..53a5cef 100644 --- a/SCrawler/ListImagesLoader.vb +++ b/SCrawler/ListImagesLoader.vb @@ -40,20 +40,26 @@ Friend Class ListImagesLoader ImageThread = New Thread(New ThreadStart(Sub() Dim ar As IAsyncResult = Nothing Dim a As Action = Sub() - If UserDataList.ListExists Then - For i% = 0 To UserDataList.Count - 1 - With UserDataList(i).User - Select Case Settings.ViewMode.Value - Case View.LargeIcon : MyList.LargeImageList.Images.Add(.Key, .GetPicture()) - Case View.SmallIcon : MyList.SmallImageList.Images.Add(.Key, .GetPicture()) - End Select - End With - Application.DoEvents() - Next - UserDataList.Clear() - GC.Collect() - End If + Try + If UserDataList.ListExists Then + For i% = 0 To UserDataList.Count - 1 + With UserDataList(i).User + Select Case Settings.ViewMode.Value + Case View.LargeIcon : MyList.LargeImageList.Images.Add(.Key, .GetPicture()) + Case View.SmallIcon : MyList.SmallImageList.Images.Add(.Key, .GetPicture()) + End Select + End With + Application.DoEvents() + Next + UserDataList.Clear() + GC.Collect() + End If + Catch iex As ArgumentOutOfRangeException + Catch ex As Exception + ErrorsDescriber.Execute(EDP.SendInLog, ex, "[ListImagesLoader.UpdateImages]") + End Try If Not ar Is Nothing Then MyList.EndInvoke(ar) + UpdateInProgress = False End Sub If MyList.InvokeRequired Then ar = MyList.BeginInvoke(a) @@ -65,62 +71,81 @@ Friend Class ListImagesLoader ImageThread.Start() End If End Sub + Private Sub InterruptUpdate() + Try + If UserDataList.ListExists Then UserDataList.Clear() : Application.DoEvents() + If If(ImageThread?.IsAlive, False) Then ImageThread.Abort() : Application.DoEvents() + Catch ex As Exception + ErrorsDescriber.Execute(EDP.SendInLog, ex, "[ListImagesLoader.InterruptUpdate]") + End Try + End Sub Friend Sub Update() - If Not UpdateInProgress Then - UpdateInProgress = True - Dim a As Action = Sub() - With MyList - .Items.Clear() - If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear() - .LargeImageList = New ImageList - If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear() - .SmallImageList = New ImageList - If Settings.ViewModeIsPicture Then - .LargeImageList.ColorDepth = ColorDepth.Depth32Bit - .SmallImageList.ColorDepth = ColorDepth.Depth32Bit - .LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeight.Value, 100) * 75, Settings.MaxLargeImageHeight.Value) - .SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeight.Value, 100) * 75, Settings.MaxSmallImageHeight.Value) - End If - End With - End Sub - If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke - If Settings.Users.Count > 0 Then - Settings.Users.Sort() - Dim v As View = Settings.ViewMode.Value + Try + If UpdateInProgress Then InterruptUpdate() + If Not UpdateInProgress Then + UpdateInProgress = True + Dim a As Action = Sub() + With MyList + .Items.Clear() + If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear() + .LargeImageList = New ImageList + If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear() + .SmallImageList = New ImageList + If Settings.ViewModeIsPicture Then + .LargeImageList.ColorDepth = ColorDepth.Depth32Bit + .SmallImageList.ColorDepth = ColorDepth.Depth32Bit + .LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeight.Value, 100) * 75, Settings.MaxLargeImageHeight.Value) + .SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeight.Value, 100) * 75, Settings.MaxSmallImageHeight.Value) + End If + End With + End Sub + If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke + If Settings.Users.Count > 0 Then + Settings.Users.Sort() + Dim v As View = Settings.ViewMode.Value - With MyList - MyList.BeginUpdate() + With MyList + MyList.BeginUpdate() - If Settings.FastProfilesLoading Then - Settings.Users.ListReindex + If Settings.FastProfilesLoading Then + Settings.Users.ListReindex - UserDataList = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList)).ListIfNothing - If UserDataList.ListExists Then UserDataList.Sort() + UserDataList = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList)).ListIfNothing + If UserDataList.ListExists Then UserDataList.Sort() - If UserDataList.ListExists Then - .Items.AddRange(UserDataList.Select(Function(u) u.LVI).ToArray) - If Settings.ViewModeIsPicture Then MyList.EndUpdate() : UpdateImages() Else UserDataList.Clear() - End If - Else - Dim t As New List(Of Task) - For Each User As IUserData In Settings.Users - If User.FitToAddParams Then + If UserDataList.ListExists Then + .Items.AddRange(UserDataList.Select(Function(u) u.LVI).ToArray) If Settings.ViewModeIsPicture Then - t.Add(Task.Run(Sub() UpdateUser(User, True))) + MyList.EndUpdate() + UpdateImages() Else - UpdateUser(User, True) + UserDataList.Clear() + UpdateInProgress = False End If End If - Next - If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear() - End If - End With - MyList.EndUpdate() + Else + Dim t As New List(Of Task) + For Each User As IUserData In Settings.Users + If User.FitToAddParams Then + If Settings.ViewModeIsPicture Then + t.Add(Task.Run(Sub() UpdateUser(User, True))) + Else + UpdateUser(User, True) + End If + End If + Next + If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear() + UpdateInProgress = False + End If + End With + MyList.EndUpdate() + End If + Else + MsgBoxE({"User list update aborted. Click the 'Refresh' button to refresh the user list.", "Update user list"}, vbExclamation) End If - UpdateInProgress = False - Else - MsgBoxE({"The user list is currently being updated. Please wait for the update operation to complete and try again.", "Update user list"}, vbExclamation) - End If + Catch ex As Exception + ErrorsDescriber.Execute(EDP.SendInLog, ex, "[ListImagesLoader.Update]") + End Try End Sub Friend Sub UpdateUser(ByVal User As IUserData, ByVal Add As Boolean) Try diff --git a/SCrawler/MainFrame.vb b/SCrawler/MainFrame.vb index 58af93c..b5127fe 100644 --- a/SCrawler/MainFrame.vb +++ b/SCrawler/MainFrame.vb @@ -88,32 +88,33 @@ Public Class MainFrame LIST_PROFILES.ShowGroups = .UseGrouping ApplyViewPattern(.ViewMode.Value) AddHandler .Labels.NewLabelAdded, AddressOf UpdateLabelsGroups + UserListLoader = New ListImagesLoader(LIST_PROFILES) + RefillList() + UpdateLabelsGroups() + SetShowButtonsCheckers(.ShowingMode.Value) + CheckVersion(False) + 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.PauseDisabled, AddressOf MainFrameObj.PauseButtons.UpdatePauseButtons + If .Automation.Count > 0 Then .Labels.AddRange(.Automation.GetGroupsLabels, False) : .Labels.Update() + _UFinit = False + Await .Automation.Start(True) End With - UserListLoader = New ListImagesLoader(LIST_PROFILES) - RefillList() - UpdateLabelsGroups() - SetShowButtonsCheckers(Settings.ShowingMode.Value) - CheckVersion(False) - BTT_SITE_ALL.Checked = Settings.SelectedSites.Count = 0 - BTT_SITE_SPECIFIC.Checked = Settings.SelectedSites.Count > 0 - BTT_SHOW_LIMIT_DATES_NOT.Tag = ShowingDates.Not - BTT_SHOW_LIMIT_DATES_NOT.Checked = Settings.ViewDateMode.Value = ShowingDates.Not - BTT_SHOW_LIMIT_DATES_IN.Tag = ShowingDates.In - BTT_SHOW_LIMIT_DATES_IN.Checked = Settings.ViewDateMode.Value = ShowingDates.In - With Settings.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 - Settings.Automation = New Scheduler - AddHandler Settings.Groups.Updated, AddressOf Settings.Automation.GROUPS_Updated - AddHandler Settings.Groups.Deleted, AddressOf Settings.Automation.GROUPS_Deleted - AddHandler Settings.Automation.PauseDisabled, AddressOf MainFrameObj.PauseButtons.UpdatePauseButtons - _UFinit = False - Await Settings.Automation.Start(True) UpdatePauseButtonsVisibility() GoTo EndFunction FormClosingInvoker: diff --git a/SCrawler/MainFrameObjects.vb b/SCrawler/MainFrameObjects.vb index b7be299..3c137db 100644 --- a/SCrawler/MainFrameObjects.vb +++ b/SCrawler/MainFrameObjects.vb @@ -74,14 +74,18 @@ Friend Class MainFrameObjects End Sub Private Sub Notificator_OnClicked(ByVal Key As String) Handles Notificator.OnClicked If Not Key.IsEmptyString Then + Dim found As Boolean = False + Dim activateForm As Boolean = False If Key.StartsWith(NotificationInternalKey) Then Select Case Key Case $"{NotificationInternalKey}_{NotifyObj.Channels}" : MF.MyChannels.FormShowS() Case $"{NotificationInternalKey}_{NotifyObj.SavedPosts}" : MF.MySavedPosts.FormShowS() Case Else : Focus(True) End Select - ElseIf Settings.Automation Is Nothing OrElse Not Settings.Automation.NotificationClicked(Key) Then + ElseIf Settings.Automation Is Nothing OrElse Not Settings.Automation.NotificationClicked(Key, found, activateForm) Then Focus(True) + ElseIf found Then + Focus(activateForm) Else Focus(True) End If diff --git a/SCrawler/MainMod.vb b/SCrawler/MainMod.vb index d7abb30..1272ab1 100644 --- a/SCrawler/MainMod.vb +++ b/SCrawler/MainMod.vb @@ -6,6 +6,7 @@ ' ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY +Imports System.Runtime.CompilerServices Imports PersonalUtilities.Functions.XML.Base Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Forms.Toolbars @@ -147,6 +148,14 @@ Friend Module MainMod Return $"{If(Host?.Name, String.Empty)}{Opt}" End If End Function + Friend Function GetGroupsLabels(Of T As Groups.IGroup)(ByVal Groups As IEnumerable(Of T)) As List(Of String) + If Groups.ListExists Then + Return ListAddList(Nothing, Groups.SelectMany(Function(g) g.Labels), LAP.NotContainsOnly). + ListAddList(Groups.SelectMany(Function(g) g.LabelsExcluded), LAP.NotContainsOnly) + Else + Return Nothing + End If + End Function #Region "Standalone video download functions" Friend Function GetCurrentBuffer() As String Dim b$ = BufferText diff --git a/SCrawler/My Project/AssemblyInfo.vb b/SCrawler/My Project/AssemblyInfo.vb index e6cd1ab..f41e4c0 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/SettingsCLS.vb b/SCrawler/SettingsCLS.vb index 184f873..fa66328 100644 --- a/SCrawler/SettingsCLS.vb +++ b/SCrawler/SettingsCLS.vb @@ -119,7 +119,7 @@ Friend Class SettingsCLS : Implements IDisposable If tmpPluginList.ListExists Then Plugins.AddRange(tmpPluginList) CookiesEncrypted.Value = True - FastProfilesLoading = New XMLValue(Of Boolean)("FastProfilesLoading", False, MyXML) + FastProfilesLoading = New XMLValue(Of Boolean)("FastProfilesLoading", True, MyXML) MaxLargeImageHeight = New XMLValue(Of Integer)("MaxLargeImageHeight", 150, MyXML) MaxSmallImageHeight = New XMLValue(Of Integer)("MaxSmallImageHeight", 15, MyXML) DownloadOpenInfo = New XMLValueAttribute(Of Boolean, Boolean)("DownloadOpenInfo", "OpenAgain", False, False, MyXML) @@ -206,7 +206,7 @@ Friend Class SettingsCLS : Implements IDisposable Labels = New LabelsKeeper(MyXML) Groups = New Groups.DownloadGroupCollection - Labels.AddRange(Groups.GetLabels, False) + Labels.AddRange(Groups.GetGroupsLabels, False) MyXML.EndUpdate() If MyXML.ChangesDetected Then MyXML.Sort() : MyXML.UpdateData() @@ -317,11 +317,8 @@ Friend Class SettingsCLS : Implements IDisposable If NeedUpdate Then UpdateUsersList() End If If Users.Count > 0 Then - Dim tul As IEnumerable(Of String) = Users.SelectMany(Function(u) u.Labels) - Labels.AddRange(tul, False) - If Labels.NewLabelsExists Or - (tul.ListExists AndAlso Not tul.Contains(LabelsKeeper.NoParsedUser) AndAlso Labels.Remove(LabelsKeeper.NoParsedUser)) Then _ - Labels.Update() : Labels.NewLabels.Clear() : Labels.Verify() + Labels.AddRange(Users.SelectMany(Function(u) u.Labels), False) + Labels.Update() End If Catch ex As Exception End Try