Compare commits

..

6 Commits

Author SHA1 Message Date
Andy
fc226d549a 2023.1.24.1
Some Imgur albums won't download
Added icon for standalone downloader
2023-01-24 16:13:46 +03:00
Andy
602771d982 2023.1.24.0
Imgur albums not downloading
Collections: users in the collection are not banned
2023-01-24 06:05:40 +03:00
Andy
3e472b4f2b Update HowToSupport.md 2023-01-13 00:21:48 +03:00
Andy
30c3fe3b68 Update info
Update info
2023-01-12 07:38:17 +03:00
Andy
38c81b7a0b 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
2023-01-02 18:53:24 +03:00
Andy
0fb6add751 Update UserData.vb 2022-12-27 15:19:40 +03:00
25 changed files with 281 additions and 171 deletions

View File

@@ -8,14 +8,16 @@ I welcome requests! Follow these steps to contribute:
1. If you have a code change suggestion, you can post a replacement code block. I also accept pull requests.
# How to build from source
1. Delete the "PersonalUtilities" project from the solution.
1. Delete the "PersonalUtilities.Notifications" project from the solution.
1. Delete the ```PersonalUtilities``` project from the solution.
1. Delete the ```PersonalUtilities.Notifications``` project from the solution.
1. Delete the ```cURL``` folder from the solution.
1. Delete the ```ffmpeg.exe``` 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```
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.**

View File

@@ -1,3 +1,35 @@
# 2023.1.24.1
*2023-01-24*
- Added
- Icon for standalone downloader
- Fixed
- (Issue #100) some Imgur albums won't download
# 2023.1.24.0
*2023-01-24*
- Fixed
- (Issue #100) Imgur albums not downloading
- When deleting a collection with the 'ban' option, users in the collection are not banned
# 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)**

View File

@@ -6,6 +6,7 @@ You can support the program by:
- :repeat: make a post about my program on your profile (Reddit, Twitter, Instagram and any other social networks)
- :speech_balloon: tell your friends about the program
- :heart: like the program on this site: https://alternativeto.net/software/scrawler/about/
- :heart: like the program on this site: https://www.softpedia.com/get/Internet/Download-Managers/Social-networks-crawler.shtml
- suggest my program as an alternative ([on this site](https://alternativeto.net/software/scrawler/about/)) to any program you have used before
I would be very grateful for any support! :blush:

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 16 KiB

View File

@@ -1,6 +1,4 @@
# :rainbow_flag: Social networks crawler :rainbow_flag: :christmas_tree:
# :christmas_tree: Happy new year :christmas_tree:
# :rainbow_flag: Social networks crawler :rainbow_flag:
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
[![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE)
@@ -39,18 +37,18 @@ Do you like this program? Consider adding to my coffee fund by making a donation
- Download [saved Reddit, Twitter and Instagram posts](https://github.com/AAndyProgram/SCrawler/wiki/Home#saved-posts)
- Add users from parsed channel
- **Advanced user management**
- **Automation** (downloading data automatically every ```X``` minutes)
- **Feed** (feed of downloaded media files)
- **Automation** ([downloading data automatically](https://github.com/AAndyProgram/SCrawler/wiki/Settings#automation) every ```X``` minutes)
- **Feed** ([feed](https://github.com/AAndyProgram/SCrawler/wiki#feed) of downloaded media files)
- Labeling users
- Create download groups
- Create [download groups](https://github.com/AAndyProgram/SCrawler/wiki/Settings#download-groups)
- Adding users to favorites and temporary
- Filter exists users by label or group
- [Filter exists users](https://github.com/AAndyProgram/SCrawler/wiki#view) by label or group
- Selection of media types you want to download (images only, videos only, both)
- Download a special video, image or gallery
- Making collections (grouping users into collections)
- [Download a special video](https://github.com/AAndyProgram/SCrawler/wiki#download-separate-video), image or gallery
- Making [collections](https://github.com/AAndyProgram/SCrawler/wiki#collections) (grouping users into collections)
- Specifying a user folder (for downloading data to another location)
- Changing user icons
- Changing view modes
- Changing [view modes](https://github.com/AAndyProgram/SCrawler/wiki#view)
- ...and many others...
# Supported sites
@@ -76,11 +74,11 @@ First, the program downloads the full profile. After the program downloads only
## Reddit
The program parses all user posts, obtain MD5 images hash and compares them with existing ones to remove duplicates. Then the media will be downloaded.
The program parses user posts, obtain MD5 images hash and compares them with existing ones to remove duplicates. Then the media will be downloaded.
## Other sites
The program parses all user posts and compares file names with existing ones to remove duplicates. Then the media will be downloaded.
The program parses user posts and compares file names with existing ones to remove duplicates. Then the media will be downloaded.
## How to request a new site
@@ -122,7 +120,7 @@ Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about
# Installation
**Just download the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest), unzip the program archive to any folder, copy the file ```ffmpeg.exe``` into it and enjoy.** :blush:
**Just download the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest), unzip the program archive to any folder and enjoy.** :blush:
**Don't put program in the ```Program Files``` system folder (this is portable program and program settings are stored in the program folder)**
@@ -140,7 +138,7 @@ Read about how to make plugin [here](https://github.com/AAndyProgram/SCrawler/wi
# How to support
Read more about how to support the program [here](HowToSupport.md).
Read about how to support the program [here](HowToSupport.md).
# Settings and usage

View File

@@ -15,7 +15,7 @@ Imports PersonalUtilities.Tools.Web.Documents.JSON
Namespace API.Imgur
Namespace Declarations
Friend Module Imgur_Declarations
Friend ReadOnly PostRegex As RParams = RParams.DMS("/([\w\d]+?)(|\.[\w]{0,4})\Z", 1)
Friend ReadOnly PostRegex As RParams = RParams.DMS("/([^/]+?)(|#.*?|\.[\w]{0,4})(|\?.*?)\Z", 1)
End Module
End Namespace
Friend NotInheritable Class Envir
@@ -70,11 +70,12 @@ Namespace API.Imgur
Friend Shared Function GetVideoInfo(ByVal URL As String, Optional ByVal e As ErrorsDescriber = Nothing) As IEnumerable(Of UserMedia)
Try
If Not URL.IsEmptyString AndAlso URL.ToLower.Contains("imgur") AndAlso Not Settings.ImgurClientID.IsEmptyString Then
Dim img$ = GetImage(URL, EDP.ReturnValue)
If Not img.IsEmptyString Then
Return {New UserMedia(img)}
Dim imgList As List(Of String) = GetGallery(URL, EDP.ReturnValue)
If imgList.ListExists Then
Return imgList.Select(Function(u) New UserMedia(u))
Else
Return GetGallery(URL, EDP.ReturnValue).ListIfNothing.Select(Function(u) New UserMedia(u))
Dim img$ = GetImage(URL, EDP.ReturnValue)
If Not img.IsEmptyString Then Return {New UserMedia(img)}
End If
End If
Return Nothing

View File

@@ -98,12 +98,14 @@ Namespace API.Instagram
If Loading Then
LastCursor = Container.Value(Name_LastCursor)
FirstLoadingDone = Container.Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
GetTimeline = Container.Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value))
GetStories = Container.Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
GetTaggedData = Container.Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
TaggedChecked = Container.Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
Else
Container.Add(Name_LastCursor, LastCursor)
Container.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
Container.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
Container.Add(Name_GetStories, GetStories.BoolToInteger)
Container.Add(Name_GetTagged, GetTaggedData.BoolToInteger)
Container.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
@@ -200,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)
@@ -396,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

@@ -151,10 +151,10 @@ Namespace DownloadObjects
Me.Controls.Add(Me.LIST_VIDEOS)
Me.Controls.Add(Me.ToolbarBOTTOM)
Me.Controls.Add(Me.ToolbarTOP)
Me.Icon = Global.SCrawler.My.Resources.Resources.ArrowDownIcon_Blue_24
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(540, 400)
Me.Name = "VideosDownloaderForm"
Me.ShowIcon = False
Me.Text = "Download videos"
Me.ToolbarTOP.ResumeLayout(False)
Me.ToolbarTOP.PerformLayout()

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
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,6 +40,7 @@ Friend Class ListImagesLoader
ImageThread = New Thread(New ThreadStart(Sub()
Dim ar As IAsyncResult = Nothing
Dim a As Action = Sub()
Try
If UserDataList.ListExists Then
For i% = 0 To UserDataList.Count - 1
With UserDataList(i).User
@@ -53,7 +54,12 @@ Friend Class ListImagesLoader
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,7 +71,17 @@ 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()
Try
If UpdateInProgress Then InterruptUpdate()
If Not UpdateInProgress Then
UpdateInProgress = True
Dim a As Action = Sub()
@@ -99,7 +115,13 @@ Friend Class ListImagesLoader
If UserDataList.ListExists Then
.Items.AddRange(UserDataList.Select(Function(u) u.LVI).ToArray)
If Settings.ViewModeIsPicture Then MyList.EndUpdate() : UpdateImages() Else UserDataList.Clear()
If Settings.ViewModeIsPicture Then
MyList.EndUpdate()
UpdateImages()
Else
UserDataList.Clear()
UpdateInProgress = False
End If
End If
Else
Dim t As New List(Of Task)
@@ -113,14 +135,17 @@ Friend Class ListImagesLoader
End If
Next
If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear()
UpdateInProgress = False
End If
End With
MyList.EndUpdate()
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)
MsgBoxE({"User list update aborted. Click the 'Refresh' button to refresh the user list.", "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

@@ -121,10 +121,10 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_PAUSE_AUTOMATION = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_SILENT_MODE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_FEED_SHOW = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CHANNELS = New System.Windows.Forms.ToolStripMenuItem()
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_TRAY_CHANNELS = 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()
@@ -419,7 +419,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'BTT_DOWN_VIDEO
'
Me.BTT_DOWN_VIDEO.AutoToolTip = True
Me.BTT_DOWN_VIDEO.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Text
Me.BTT_DOWN_VIDEO.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_DOWN_VIDEO.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DOWN_VIDEO.Name = "BTT_DOWN_VIDEO"
Me.BTT_DOWN_VIDEO.Size = New System.Drawing.Size(231, 22)
@@ -856,6 +856,13 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_FEED_SHOW.Text = "Feed"
Me.BTT_TRAY_FEED_SHOW.ToolTipText = "Show feed of recently downloaded data." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Ctrl+Click the tray icon to show the feed" &
"."
'
'BTT_TRAY_CHANNELS
'
Me.BTT_TRAY_CHANNELS.Image = Global.SCrawler.My.Resources.SiteResources.RedditPic_512
Me.BTT_TRAY_CHANNELS.Name = "BTT_TRAY_CHANNELS"
Me.BTT_TRAY_CHANNELS.Size = New System.Drawing.Size(170, 22)
Me.BTT_TRAY_CHANNELS.Text = "Channels"
'
'BTT_TRAY_SHOW_HIDE
'
@@ -885,13 +892,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_TRAY_CHANNELS
'
Me.BTT_TRAY_CHANNELS.Name = "BTT_TRAY_CHANNELS"
Me.BTT_TRAY_CHANNELS.Size = New System.Drawing.Size(170, 22)
Me.BTT_TRAY_CHANNELS.Text = "Channels"
Me.BTT_TRAY_CHANNELS.Image = Global.SCrawler.My.Resources.SiteResources.RedditPic_512
'
'MainFrame
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)

View File

@@ -88,19 +88,18 @@ Public Class MainFrame
LIST_PROFILES.ShowGroups = .UseGrouping
ApplyViewPattern(.ViewMode.Value)
AddHandler .Labels.NewLabelAdded, AddressOf UpdateLabelsGroups
End With
UserListLoader = New ListImagesLoader(LIST_PROFILES)
RefillList()
UpdateLabelsGroups()
SetShowButtonsCheckers(Settings.ShowingMode.Value)
SetShowButtonsCheckers(.ShowingMode.Value)
CheckVersion(False)
BTT_SITE_ALL.Checked = Settings.SelectedSites.Count = 0
BTT_SITE_SPECIFIC.Checked = Settings.SelectedSites.Count > 0
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 = Settings.ViewDateMode.Value = 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 = Settings.ViewDateMode.Value = ShowingDates.In
With Settings.Groups
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
@@ -108,12 +107,14 @@ Public Class MainFrame
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
.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 Settings.Automation.Start(True)
Await .Automation.Start(True)
End With
UpdatePauseButtonsVisibility()
GoTo EndFunction
FormClosingInvoker:
@@ -1395,6 +1396,7 @@ ResumeDownloadingOperation:
If result < 6 Then
Dim collectionResult% = -1
Dim tmpResult%
Dim tmpUserNames As New List(Of String)
Dim IsMultiple As Boolean = users.Count > 1
Dim removedUsers As New List(Of String)
Dim keepData As Boolean = Not (result Mod 2) = 0
@@ -1429,10 +1431,18 @@ ResumeDownloadingOperation:
removedUsers.Add(ugn(user))
user.Dispose()
Else
If banUser Then
tmpUserNames.Clear()
If user.IsCollection Then
tmpUserNames.ListAddList(DirectCast(user, UserDataBind).Collections.Select(Function(u) u.Name), l)
Else
tmpUserNames.Add(user.Name)
End If
End If
tmpResult = user.Delete(IsMultiple, collectionResult)
If user.IsCollection And collectionResult = -1 Then collectionResult = tmpResult
If tmpResult > 0 Then
If banUser Then Settings.BlackList.ListAddValue(New UserBan(user.Name, reason), l) : b = True
If banUser And tmpUserNames.Count > 0 Then Settings.BlackList.ListAddList(tmpUserNames.Select(Function(u) New UserBan(u, reason)), l) : b = True
RemoveUserFromList(user)
removedUsers.Add(ugn(user))
Else

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.24.1")>
<Assembly: AssemblyFileVersion("2023.1.24.1")>
<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