2022.1.2.0

Redgifs: added token refresh interval; reduced interval value
Updated labels collection
PornHub: fixed bugs
Notifications: pressing any button opens SCrawler
User list loader finished
This commit is contained in:
Andy
2023-01-02 18:53:24 +03:00
parent 0fb6add751
commit 38c81b7a0b
20 changed files with 218 additions and 138 deletions

View File

@@ -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.**

View File

@@ -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*

2
FAQ.md
View File

@@ -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)**

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 16 KiB

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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)

View File

@@ -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
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Bearer token")>
Friend Property Token As PropertyValue
<PXML> Friend Property TokenLastDateUpdated As PropertyValue
<PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), ControlNumber(1)>
Friend ReadOnly Property Token As PropertyValue
<PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue
Private Const TokenName As String = "authorization"
#Region "TokenUpdateInterval"
<PropertyOption(ControlText:="Token refresh interval", ControlToolTip:="Interval (in minutes) to refresh the token", AllowNull:=False, LeftOffset:=120),
PXML, ControlNumber(0)>
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
<Provider(NameOf(TokenUpdateInterval), FieldsChecker:=True)>
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

View File

@@ -143,7 +143,8 @@ Namespace DownloadObjects
''' <returns>True to activate</returns>
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

View File

@@ -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

View File

@@ -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)

View File

@@ -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")

View File

@@ -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

View File

@@ -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

View File

@@ -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:

View File

@@ -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

View File

@@ -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
<Extension> 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

View File

@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2022.12.27.0")>
<Assembly: AssemblyFileVersion("2022.12.27.0")>
<Assembly: AssemblyVersion("2023.1.2.0")>
<Assembly: AssemblyFileVersion("2023.1.2.0")>
<Assembly: NeutralResourcesLanguage("en")>

View File

@@ -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