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" project from the solution.
1. Delete the "PersonalUtilities.Notifications" 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: 1. The following libraries must be added to project references with the '**Copy to output folder**' option:
- ```PersonalUtilities.dll``` - ```PersonalUtilities.dll```
- ```PersonalUtilities.Notifications.dll``` - ```PersonalUtilities.Notifications.dll```
- ```Microsoft.Toolkit.Uwp.Notifications.dll``` - ```Microsoft.Toolkit.Uwp.Notifications.dll```
- ```System.ValueTuple.dll``` - ```System.ValueTuple.dll```
1. Import PersonalUtilities.Functions for the whole project. 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.** **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.0
*2022-12-27* *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.** #### 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)** **[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 AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
ThrowAny(Token) ThrowAny(Token)
HasError = False HasError = False
Dim dt As Boolean = (CBool(MySiteSettings.DownloadTimeline.Value) And GetTimeline) Or IsSavedPosts Dim dt As Func(Of Boolean) = Function() (CBool(MySiteSettings.DownloadTimeline.Value) And GetTimeline) Or IsSavedPosts
If dt And Not LastCursor.IsEmptyString Then If dt.Invoke And Not LastCursor.IsEmptyString Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline) s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(LastCursor, s, Token) DownloadData(LastCursor, s, Token)
ThrowAny(Token) ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True If Not HasError Then FirstLoadingDone = True
End If End If
If dt And Not HasError Then If dt.Invoke And Not HasError Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline) s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(String.Empty, s, Token) DownloadData(String.Empty, s, Token)
ThrowAny(Token) ThrowAny(Token)
@@ -398,7 +398,6 @@ Namespace API.Instagram
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID") If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
End If End If
'Create query 'Create query
Select Case Section Select Case Section
Case Sections.Timeline Case Sections.Timeline

View File

@@ -41,6 +41,7 @@ Namespace API.PornHub
Friend Sub New() Friend Sub New()
MyBase.New("PornHub", "pornhub.com") MyBase.New("PornHub", "pornhub.com")
Responser.CurlPath = $"cURL\curl.exe" Responser.CurlPath = $"cURL\curl.exe"
Responser.CurlArgumentsRight = "--ssl-no-revoke"
CurlPathExists = Responser.CurlPath.Exists CurlPathExists = Responser.CurlPath.Exists
Responser.DeclaredError = EDP.ThrowException Responser.DeclaredError = EDP.ThrowException

View File

@@ -210,6 +210,7 @@ Namespace API.PornHub
If __continue And Not __videoDone Then If __continue And Not __videoDone Then
Do While DownloadUserVideos(page, Token) = DataDownloaded And page < 100 : page += 1 : Loop Do While DownloadUserVideos(page, Token) = DataDownloaded And page < 100 : page += 1 : Loop
End If End If
If _TempMediaList.Count > 0 Then _TempMediaList.RemoveAll(Function(m) Not m.Type = UTypes.m3u8 And Not m.Type = UTypes.VideoPre)
End If End If
Responser.Method = "GET" Responser.Method = "GET"
@@ -256,7 +257,7 @@ Namespace API.PornHub
If PersonType = PersonTypeUser And r.Contains(HtmlPageNotFoundVideo) Then Return DataDownloaded_NotFound 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 l As List(Of UserVideo) = RegexFields(Of UserVideo)(r, {RegexVideo_Video_All}, {1, 2})
Dim lw As List(Of UserVideo) = Nothing 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 l.ListExists Then
If lw.ListExists Then l.ListWithRemove(lw) If lw.ListExists Then l.ListWithRemove(lw)
If l.Count > 0 Then If l.Count > 0 Then

View File

@@ -662,6 +662,7 @@ Namespace API.Reddit
Try Try
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
Using r As New UserData Using r As New UserData
r.SetEnvironment(Settings(RedditSiteKey), Nothing, False, False)
r.Responser = New Responser r.Responser = New Responser
r.Responser.Copy(resp) r.Responser.Copy(resp)
r.ParsePost(URL) r.ParsePost(URL)

View File

@@ -9,10 +9,10 @@
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
@@ -30,10 +30,38 @@ Namespace API.RedGifs
Return My.Resources.SiteResources.RedGifsPic_32 Return My.Resources.SiteResources.RedGifsPic_32
End Get End Get
End Property End Property
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Bearer token")> <PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), ControlNumber(1)>
Friend Property Token As PropertyValue Friend ReadOnly Property Token As PropertyValue
<PXML> Friend Property TokenLastDateUpdated As PropertyValue <PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue
Private Const TokenName As String = "authorization" 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 #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
@@ -47,6 +75,8 @@ Namespace API.RedGifs
End With End With
Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v)) Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v))
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date)) 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}/" UrlPatternUser = "https://www.redgifs.com/users/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1) UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1)
ImageVideoContains = "redgifs" ImageVideoContains = "redgifs"
@@ -61,7 +91,7 @@ Namespace API.RedGifs
#Region "Token updaters" #Region "Token updaters"
Friend Function UpdateTokenIfRequired() As Boolean Friend Function UpdateTokenIfRequired() As Boolean
Dim d As Date? = AConvert(Of Date)(TokenLastDateUpdated.Value, AModes.Var, Nothing) 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() Return UpdateToken()
Else Else
Return True Return True

View File

@@ -143,7 +143,8 @@ Namespace DownloadObjects
''' <returns>True to activate</returns> ''' <returns>True to activate</returns>
Friend Function Open(ByVal _Key As String) As Boolean Friend Function Open(ByVal _Key As String) As Boolean
If Not User Is Nothing Then If Not User Is Nothing Then
If Key = _Key Then If KeyDismiss = _Key Then
ElseIf Key = _Key Then
Return True Return True
ElseIf KeyFolder = _Key Then ElseIf KeyFolder = _Key Then
User.OpenFolder() User.OpenFolder()
@@ -152,6 +153,8 @@ Namespace DownloadObjects
ElseIf Images.ContainsKey(_Key) Then ElseIf Images.ContainsKey(_Key) Then
Images(_Key).Open(, EDP.None) Images(_Key).Open(, EDP.None)
End If End If
Else
Return True
End If End If
Return False Return False
End Function End Function
@@ -548,10 +551,12 @@ Namespace DownloadObjects
UserKeys.Last.ShowNotification() UserKeys.Last.ShowNotification()
End If End If
End Sub 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) Dim i% = UserKeys.IndexOf(Key)
If i >= 0 Then 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 Return True
Else Else
Return False Return False

View File

@@ -52,8 +52,13 @@ Namespace DownloadObjects
Return Plans.Count Return Plans.Count
End Get End Get
End Property End Property
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
Return Count > 0 AndAlso Plans.Exists(Function(p) p.NotificationClicked(Key)) 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 End Function
Friend Sub Add(ByVal Plan As AutoDownloader) Friend Sub Add(ByVal Plan As AutoDownloader)
Plan.Source = Me Plan.Source = Me

View File

@@ -34,9 +34,6 @@ Namespace DownloadObjects.Groups
End If End If
GroupsList.ListReindex GroupsList.ListReindex
End Sub 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 Default Friend ReadOnly Property Item(ByVal Index As Integer) As DownloadGroup Implements IMyEnumerator(Of DownloadGroup).MyEnumeratorObject
Get Get
Return GroupsList(Index) 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 Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
Try Try
LabelsList.ListAddList(CMB_LABELS.Items.CheckedItems.Select(Function(l) CStr(l.Value(0))), LAP.ClearBeforeAdd, LAP.NotContainsOnly) 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() MyDefs.CloseForm()
Catch ex As Exception Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Label selection") 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 Current As XMLValuesCollection(Of String)
Friend ReadOnly Property Excluded As XMLValuesCollection(Of String) Friend ReadOnly Property Excluded As XMLValuesCollection(Of String)
Friend ReadOnly Property ExcludedIgnore As XMLValue(Of Boolean) Friend ReadOnly Property ExcludedIgnore As XMLValue(Of Boolean)
Private ReadOnly Property SourceXML As XmlFile
Friend Sub New(ByRef x As XmlFile) Friend Sub New(ByRef x As XmlFile)
SourceXML = x
LabelsList = New List(Of String) LabelsList = New List(Of String)
NewLabels = New List(Of String) NewLabels = New List(Of String)
If LabelsFile.Exists Then LabelsList.ListAddList(IO.File.ReadAllLines(LabelsFile), LAP.NotContainsOnly) 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} 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} Excluded = New XMLValuesCollection(Of String)(XMLValueBase.ListModes.String, "LatestExcludedLabels", x) With {.ListAddParameters = LAP.NotContainsOnly}
ExcludedIgnore = New XMLValue(Of Boolean)("LatestExcludedLabelsIgnore", False, x) ExcludedIgnore = New XMLValue(Of Boolean)("LatestExcludedLabelsIgnore", False, x)
End Sub Dim lp As New ListAddParams(LAP.NotContainsOnly + LAP.IgnoreICopier)
Friend Sub Verify() If Current.Count > 0 Then LabelsList.ListAddList(Current, lp)
SourceXML.BeginUpdate() If Excluded.Count > 0 Then LabelsList.ListAddList(Excluded, lp)
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()
End Sub End Sub
Friend ReadOnly Property ToList As List(Of String) Friend ReadOnly Property ToList As List(Of String)
Get Get
@@ -69,10 +55,14 @@ Friend Class LabelsKeeper : Implements ICollection(Of String), IMyEnumerator(Of
LabelsList.Clear() LabelsList.Clear()
NewLabels.Clear() NewLabels.Clear()
End Sub End Sub
Friend Sub Update() Friend Sub Update(Optional ByVal Force As Boolean = False)
If LabelsList.Count > 0 Then If LabelsList.Count > 0 Then
LabelsList.Sort() If NewLabelsExists Or Force Then
TextSaver.SaveTextToFile(LabelsList.ListToString(vbNewLine), LabelsFile, True, False, EDP.SendInLog) 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 Else
LabelsFile.Delete(, Settings.DeleteMode, EDP.SendInLog) LabelsFile.Delete(, Settings.DeleteMode, EDP.SendInLog)
End If End If

View File

@@ -40,20 +40,26 @@ Friend Class ListImagesLoader
ImageThread = New Thread(New ThreadStart(Sub() ImageThread = New Thread(New ThreadStart(Sub()
Dim ar As IAsyncResult = Nothing Dim ar As IAsyncResult = Nothing
Dim a As Action = Sub() Dim a As Action = Sub()
If UserDataList.ListExists Then Try
For i% = 0 To UserDataList.Count - 1 If UserDataList.ListExists Then
With UserDataList(i).User For i% = 0 To UserDataList.Count - 1
Select Case Settings.ViewMode.Value With UserDataList(i).User
Case View.LargeIcon : MyList.LargeImageList.Images.Add(.Key, .GetPicture()) Select Case Settings.ViewMode.Value
Case View.SmallIcon : MyList.SmallImageList.Images.Add(.Key, .GetPicture()) Case View.LargeIcon : MyList.LargeImageList.Images.Add(.Key, .GetPicture())
End Select Case View.SmallIcon : MyList.SmallImageList.Images.Add(.Key, .GetPicture())
End With End Select
Application.DoEvents() End With
Next Application.DoEvents()
UserDataList.Clear() Next
GC.Collect() UserDataList.Clear()
End If 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) If Not ar Is Nothing Then MyList.EndInvoke(ar)
UpdateInProgress = False
End Sub End Sub
If MyList.InvokeRequired Then If MyList.InvokeRequired Then
ar = MyList.BeginInvoke(a) ar = MyList.BeginInvoke(a)
@@ -65,62 +71,81 @@ Friend Class ListImagesLoader
ImageThread.Start() ImageThread.Start()
End If End If
End Sub 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() Friend Sub Update()
If Not UpdateInProgress Then Try
UpdateInProgress = True If UpdateInProgress Then InterruptUpdate()
Dim a As Action = Sub() If Not UpdateInProgress Then
With MyList UpdateInProgress = True
.Items.Clear() Dim a As Action = Sub()
If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear() With MyList
.LargeImageList = New ImageList .Items.Clear()
If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear() If Not .LargeImageList Is Nothing Then .LargeImageList.Images.Clear()
.SmallImageList = New ImageList .LargeImageList = New ImageList
If Settings.ViewModeIsPicture Then If Not .SmallImageList Is Nothing Then .SmallImageList.Images.Clear()
.LargeImageList.ColorDepth = ColorDepth.Depth32Bit .SmallImageList = New ImageList
.SmallImageList.ColorDepth = ColorDepth.Depth32Bit If Settings.ViewModeIsPicture Then
.LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeight.Value, 100) * 75, Settings.MaxLargeImageHeight.Value) .LargeImageList.ColorDepth = ColorDepth.Depth32Bit
.SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeight.Value, 100) * 75, Settings.MaxSmallImageHeight.Value) .SmallImageList.ColorDepth = ColorDepth.Depth32Bit
End If .LargeImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxLargeImageHeight.Value, 100) * 75, Settings.MaxLargeImageHeight.Value)
End With .SmallImageList.ImageSize = New Size(DivideWithZeroChecking(Settings.MaxSmallImageHeight.Value, 100) * 75, Settings.MaxSmallImageHeight.Value)
End Sub End If
If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke End With
If Settings.Users.Count > 0 Then End Sub
Settings.Users.Sort() If MyList.InvokeRequired Then MyList.Invoke(a) Else a.Invoke
Dim v As View = Settings.ViewMode.Value If Settings.Users.Count > 0 Then
Settings.Users.Sort()
Dim v As View = Settings.ViewMode.Value
With MyList With MyList
MyList.BeginUpdate() MyList.BeginUpdate()
If Settings.FastProfilesLoading Then If Settings.FastProfilesLoading Then
Settings.Users.ListReindex Settings.Users.ListReindex
UserDataList = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList)).ListIfNothing 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 UserDataList.Sort()
If UserDataList.ListExists Then If UserDataList.ListExists Then
.Items.AddRange(UserDataList.Select(Function(u) u.LVI).ToArray) .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 Settings.ViewModeIsPicture Then If Settings.ViewModeIsPicture Then
t.Add(Task.Run(Sub() UpdateUser(User, True))) MyList.EndUpdate()
UpdateImages()
Else Else
UpdateUser(User, True) UserDataList.Clear()
UpdateInProgress = False
End If End If
End If End If
Next Else
If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear() Dim t As New List(Of Task)
End If For Each User As IUserData In Settings.Users
End With If User.FitToAddParams Then
MyList.EndUpdate() 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 End If
UpdateInProgress = False Catch ex As Exception
Else ErrorsDescriber.Execute(EDP.SendInLog, ex, "[ListImagesLoader.Update]")
MsgBoxE({"The user list is currently being updated. Please wait for the update operation to complete and try again.", "Update user list"}, vbExclamation) End Try
End If
End Sub End Sub
Friend Sub UpdateUser(ByVal User As IUserData, ByVal Add As Boolean) Friend Sub UpdateUser(ByVal User As IUserData, ByVal Add As Boolean)
Try Try

View File

@@ -88,32 +88,33 @@ Public Class MainFrame
LIST_PROFILES.ShowGroups = .UseGrouping LIST_PROFILES.ShowGroups = .UseGrouping
ApplyViewPattern(.ViewMode.Value) ApplyViewPattern(.ViewMode.Value)
AddHandler .Labels.NewLabelAdded, AddressOf UpdateLabelsGroups 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 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() UpdatePauseButtonsVisibility()
GoTo EndFunction GoTo EndFunction
FormClosingInvoker: FormClosingInvoker:

View File

@@ -74,14 +74,18 @@ Friend Class MainFrameObjects
End Sub End Sub
Private Sub Notificator_OnClicked(ByVal Key As String) Handles Notificator.OnClicked Private Sub Notificator_OnClicked(ByVal Key As String) Handles Notificator.OnClicked
If Not Key.IsEmptyString Then If Not Key.IsEmptyString Then
Dim found As Boolean = False
Dim activateForm As Boolean = False
If Key.StartsWith(NotificationInternalKey) Then If Key.StartsWith(NotificationInternalKey) Then
Select Case Key Select Case Key
Case $"{NotificationInternalKey}_{NotifyObj.Channels}" : MF.MyChannels.FormShowS() Case $"{NotificationInternalKey}_{NotifyObj.Channels}" : MF.MyChannels.FormShowS()
Case $"{NotificationInternalKey}_{NotifyObj.SavedPosts}" : MF.MySavedPosts.FormShowS() Case $"{NotificationInternalKey}_{NotifyObj.SavedPosts}" : MF.MySavedPosts.FormShowS()
Case Else : Focus(True) Case Else : Focus(True)
End Select 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) Focus(True)
ElseIf found Then
Focus(activateForm)
Else Else
Focus(True) Focus(True)
End If End If

View File

@@ -6,6 +6,7 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Runtime.CompilerServices
Imports PersonalUtilities.Functions.XML.Base Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Forms.Toolbars Imports PersonalUtilities.Forms.Toolbars
@@ -147,6 +148,14 @@ Friend Module MainMod
Return $"{If(Host?.Name, String.Empty)}{Opt}" Return $"{If(Host?.Name, String.Empty)}{Opt}"
End If End If
End Function 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" #Region "Standalone video download functions"
Friend Function GetCurrentBuffer() As String Friend Function GetCurrentBuffer() As String
Dim b$ = BufferText Dim b$ = BufferText

View File

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

View File

@@ -119,7 +119,7 @@ Friend Class SettingsCLS : Implements IDisposable
If tmpPluginList.ListExists Then Plugins.AddRange(tmpPluginList) If tmpPluginList.ListExists Then Plugins.AddRange(tmpPluginList)
CookiesEncrypted.Value = True 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) MaxLargeImageHeight = New XMLValue(Of Integer)("MaxLargeImageHeight", 150, MyXML)
MaxSmallImageHeight = New XMLValue(Of Integer)("MaxSmallImageHeight", 15, MyXML) MaxSmallImageHeight = New XMLValue(Of Integer)("MaxSmallImageHeight", 15, MyXML)
DownloadOpenInfo = New XMLValueAttribute(Of Boolean, Boolean)("DownloadOpenInfo", "OpenAgain", False, False, 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) Labels = New LabelsKeeper(MyXML)
Groups = New Groups.DownloadGroupCollection Groups = New Groups.DownloadGroupCollection
Labels.AddRange(Groups.GetLabels, False) Labels.AddRange(Groups.GetGroupsLabels, False)
MyXML.EndUpdate() MyXML.EndUpdate()
If MyXML.ChangesDetected Then MyXML.Sort() : MyXML.UpdateData() If MyXML.ChangesDetected Then MyXML.Sort() : MyXML.UpdateData()
@@ -317,11 +317,8 @@ Friend Class SettingsCLS : Implements IDisposable
If NeedUpdate Then UpdateUsersList() If NeedUpdate Then UpdateUsersList()
End If End If
If Users.Count > 0 Then If Users.Count > 0 Then
Dim tul As IEnumerable(Of String) = Users.SelectMany(Function(u) u.Labels) Labels.AddRange(Users.SelectMany(Function(u) u.Labels), False)
Labels.AddRange(tul, False) Labels.Update()
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()
End If End If
Catch ex As Exception Catch ex As Exception
End Try End Try