2023.10.1.0

JustForFans: some profiles won't download

Changelog.md

@@ -1,3 +1,41 @@
+# 2023.10.1.0
+
+*2023-10-01*
+
+- Added
+  - **Threads.net**
+  - YouTube: add URL standardization
+- Fixed
+  - UserEditor: disable updating labels if they haven't changed
+  - Collections: incorrect updating of colors and labels when adding a new user
+  - RedGifs: incorrect handling of error 410
+  - Mastodon: hide error 503
+  - JustForFans: some profiles won't download
+  - Minor bugs
+
+# 2023.9.21.0
+
+*2023-09-21*
+
+- Fixed
+  - PornHub: videos are not downloading
+
+# 2023.9.20.0
+
+*2023-09-20*
+
+- Added
+  - **Instagram: user active (non-pinned) stories (Issue #17)**
+  - Reddit: reduce the number of token updates (refresh the token if there are Reddit users in the download queue)
+  - YouTube (standalone app): priority download protocol *(`Settings` - `Defaults` - `Protocol`)* (you can now select the default protocol you want to download media on: `Any`, `https`, `m3u8`))
+  - Automation: ability to change schedulers (`Download` - `Automation` - `Script icon`)
+  - Collections: update colors for the added user
+- Fixed
+  - YouTube: can't detect `shorts` links
+  - Incorrect MD5 validation initial value
+  - Instagram: handle error 500
+  - Collections: update labels only for the added user
+
 # 2023.8.27.0
 
 *2023-08-27*

README.md

@@ -1,5 +1,5 @@
-# :rainbow_flag: Happy LGBT Pride Month :tada:
-
+<!-- # :rainbow_flag: Happy LGBT Pride Month :tada:
+-->
 # :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)
@@ -11,7 +11,7 @@
 :eu:
 :greece:
 
-A program to download photo and video from [any site](#supported-sites) (e.g. YouTube, YouTube Music, OnlyFans, Reddit, Twitter, Mastodon, Instagram, TikTok, RedGifs, JustForFans, PornHub, XHamster, XVIDEOS, ThisVid, LPSG, Pinterest).
+A program to download photo and video from [any site](#supported-sites) (e.g. YouTube, YouTube Music, OnlyFans, Reddit, Twitter, Mastodon, Instagram, Threads, TikTok, RedGifs, JustForFans, PornHub, XHamster, XVIDEOS, ThisVid, LPSG, Pinterest).
 
 **If you like SCrawler, please like the program on [this site](https://alternativeto.net/software/scrawler/about/) and/or [this](https://www.softpedia.com/get/Internet/Download-Managers/Social-networks-crawler.shtml)**
 <!---Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush:
@@ -37,6 +37,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
   - JustForFans images and videos, saved (bookmarked) posts;
   - Mastodon images and videos, saved (bookmarked) posts;
   - Instagram images and videos, tagged posts, stories, saved posts;
+  - Threads images and videos;
   - TikTok videos;
   - Pinterest boards, users, saved posts;
   - Imgur images, galleries and videos;
@@ -73,6 +74,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
 - **OnlyFans**
 - **Mastodon**
 - **Instagram**
+- **Threads**
 - JustForFans
 - TikTok
 - RedGifs
@@ -124,6 +126,7 @@ First, the program downloads the full profile. After the program downloads only
   - [OnlyFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans)
   - [Mastodon](https://github.com/AAndyProgram/SCrawler/wiki/Settings#mastodon)
   - [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram)
+  - [Threads](https://github.com/AAndyProgram/SCrawler/wiki/Settings#threads)
   - [JustForFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#justforfans)
   - [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok)
   - [RedGifs](https://github.com/AAndyProgram/SCrawler/wiki/Settings#redgifs)
@@ -189,6 +192,10 @@ F5-->[*]
 
 # Contact me
 
+Discord server: https://discord.gg/uFNUXvFFmg
+
+[e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me
+<!--
 [e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me
 
 Matrix (Element): https://matrix.to/#/@andyprogram:matrix.org
@@ -198,3 +205,4 @@ Discord (contact the developer): andyprogram
 Discord server: https://discord.gg/uFNUXvFFmg
 
 [Wire](https://account.wire.com/user-profile/?id=93985052-cf2c-4b72-ac75-bbe3231cf544): @andyprogram
+-->

SCrawler.PluginProvider/My Project/AssemblyInfo.vb

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

SCrawler.PluginProvider/ObjectInterfaces/ILogProvider.vb

@@ -11,6 +11,6 @@ Namespace Plugin
         Overloads Sub Add(ByVal Message As String)
         Overloads Sub Add(ByVal ex As Exception, ByVal Message As String,
                           Optional ByVal ShowMainMsg As Boolean = False, Optional ByVal ShowErrorMsg As Boolean = False,
-                          Optional ByVal SendInLog As Boolean = True)
+                          Optional ByVal SendToLog As Boolean = True)
     End Interface
 End Namespace

SCrawler.YouTube/Base/Structures.vb

@@ -6,6 +6,10 @@
 '
 ' This program is distributed in the hope that it will be useful,
 ' but WITHOUT ANY WARRANTY
+Imports System.Drawing.Design
+Imports System.ComponentModel
+Imports PersonalUtilities.Tools.Grid.Attributes
+Imports PersonalUtilities.Tools.Grid.EnumObjects
 Namespace API.YouTube.Base
     Public Structure Thumbnail : Implements IIndexable, IComparable(Of Thumbnail)
         Public ID As String
@@ -47,6 +51,14 @@ Namespace API.YouTube.Base
         Channel = 2
         PlayList = 3
     End Enum
+    <Editor(GetType(EnumDropDownEditor), GetType(UITypeEditor))>
+    Public Enum Protocols As Integer
+        <EnumValue(ExcludeFromList:=True)>
+        Undefined = -1
+        Any = 0
+        https = 1
+        m3u8 = 2
+    End Enum
     Public Structure MediaObject : Implements IIndexable, IComparable(Of MediaObject)
         Public Type As Plugin.UserMediaTypes
         Public ID As String
@@ -59,6 +71,17 @@ Namespace API.YouTube.Base
         Public Size As Double
         Public Codec As String
         Public Protocol As String
+        Public ReadOnly Property ProtocolType As Protocols
+            Get
+                If Not Protocol.IsEmptyString Then
+                    Select Case Protocol.StringToLower.StringTrim
+                        Case "http", "https" : Return Protocols.https
+                        Case "m3u8" : Return Protocols.m3u8
+                    End Select
+                End If
+                Return Protocols.Undefined
+            End Get
+        End Property
         Public URL As String
         Public Property Index As Integer Implements IIndexable.Index
         Private Function SetIndex(ByVal Obj As Object, ByVal Index As Integer) As Object Implements IIndexable.SetIndex

SCrawler.YouTube/Base/YouTubeFunctions.vb

@@ -20,20 +20,45 @@ Namespace API.YouTube.Base
         Public Const UrlTypePattern As String = "(?<=https?://[^/]*?youtube.com/)((@|[^\?/&]+))([/\?]{0,1}(list=|v=|)([^\?/&]*))(?=(\S+|\Z|))"
         Private Sub New()
         End Sub
+        Public Shared Function StandardizeURL(ByVal URL As String) As String
+            Try
+                Dim isMusic As Boolean = False, isShorts As Boolean = False
+                If Info_GetUrlType(URL, isMusic, isShorts) = YouTubeMediaType.Single Then
+                    If Not isMusic And Not isShorts Then
+                        Dim videoOptionRegex As RParams = RParams.DMS("[\?&]v=([^\?&]+)", 1, EDP.ReturnValue)
+                        Dim data As List(Of String) = RegexReplace(URL, RParams.DMS(UrlTypePattern, 0, RegexReturn.ListByMatch, EDP.ReturnValue))
+                        Dim val$ = String.Empty
+                        If data.ListExists Then
+                            For Each d$ In data
+                                val = RegexReplace(d, videoOptionRegex)
+                                If Not val.IsEmptyString Then Exit For
+                            Next
+                            data.Clear()
+                        End If
+                        If Not val.IsEmptyString Then Return $"https://www.youtube.com/watch?v={val}"
+                    End If
+                End If
+                Return URL
+            Catch ex As Exception
+                Return URL
+            End Try
+        End Function
         Public Shared Function IsMyUrl(ByVal URL As String) As Boolean
             Return Not Info_GetUrlType(URL) = YouTubeMediaType.Undefined
         End Function
-        Public Shared Function Info_GetUrlType(ByVal URL As String, Optional ByRef IsMusic As Boolean = False,
+        Public Shared Function Info_GetUrlType(ByVal URL As String, Optional ByRef IsMusic As Boolean = False, Optional ByRef IsShorts As Boolean = False,
                                                Optional ByRef IsChannelUser As Boolean = False, Optional ByRef Id As String = Nothing) As YouTubeMediaType
             If Not URL.IsEmptyString Then
                 IsMusic = URL.Contains("music.youtube.com")
                 IsChannelUser = False
+                IsShorts = False
                 Dim data As List(Of String) = RegexReplace(URL, RParams.DMS(UrlTypePattern, 0, RegexReturn.ListByMatch, EDP.ReturnValue))
                 If data.ListExists Then
                     If data.Count >= 6 Then Id = data(5)
                     If data.Count >= 3 And Not data(2).IsEmptyString Then
                         Select Case data(2).ToLower
                             Case "watch" : Return YouTubeMediaType.Single
+                            Case "shorts" : IsShorts = True : Return YouTubeMediaType.Single
                             Case "playlist" : Return YouTubeMediaType.PlayList
                             Case UserChannelOption, "@" : IsChannelUser = data(2).ToLower = UserChannelOption : Return YouTubeMediaType.Channel
                         End Select
@@ -64,8 +89,8 @@ Namespace API.YouTube.Base
             Dim urlOrig$ = URL
             URL = RegexReplace(URL, TrueUrlRegEx)
             If URL.IsEmptyString Then Throw New ArgumentNullException("URL", $"Can't get true URL from [{urlOrig}]")
-            Dim isMusic As Boolean = False
-            Dim objType As YouTubeMediaType = Info_GetUrlType(URL, isMusic)
+            Dim isMusic As Boolean = False, isShorts As Boolean = False
+            Dim objType As YouTubeMediaType = Info_GetUrlType(URL, isMusic, isShorts)
             If Not objType = YouTubeMediaType.Undefined Then
                 Dim __GetDefault As Boolean = If(GetDefault, True)
                 Dim __GetShorts As Boolean = If(GetShorts, True)
@@ -105,7 +130,7 @@ Namespace API.YouTube.Base
 
                 If result Then
                     container.Parse(Nothing, _CachePathDefault, isMusic, Token, Progress)
-                    If Not container.HasError Then container.URL = URL : Return container
+                    If Not container.HasError Then container.URL = URL : container.IsShorts = isShorts : Return container
                 End If
                 container.Dispose()
             End If

SCrawler.YouTube/Base/YouTubeSettings.vb

@@ -133,12 +133,18 @@ Namespace API.YouTube.Base
         End Property
 #End Region
 #Region "Defaults"
+        <Browsable(True), GridVisible, XMLVN({"Defaults"}, True), Category("Defaults"), DisplayName("Standardize URLs"),
+            Description("Standardize URLs by eliminating unwanted strings. Default: true.")>
+        Public ReadOnly Property StandardizeURLs As XMLValue(Of Boolean)
         <Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Replace modification date"),
             Description("Set the file date to the date the video was added (website) (if available). Default: false.")>
         Public ReadOnly Property ReplaceModificationDate As XMLValue(Of Boolean)
         <Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Use cookies"),
             Description("By default, use cookies when downloading from YouTube.")>
         Public ReadOnly Property DefaultUseCookies As XMLValue(Of Boolean)
+        <Browsable(True), GridVisible, XMLVN({"Defaults"}, Protocols.Any), Category("Defaults"), DisplayName("Protocol"),
+            Description("Priority download protocol. Default: 'Any'")>
+        Public ReadOnly Property DefaultProtocol As XMLValue(Of Protocols)
         <Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"),
             DisplayName("Auto remove"), Description("Automatically remove downloaded items from the list.")>
         Public ReadOnly Property RemoveDownloadedAutomatically As XMLValue(Of Boolean)

SCrawler.YouTube/Controls/VideoOptionsForm.vb

@@ -433,7 +433,7 @@ Namespace API.YouTube.Controls
         End Sub
 #End Region
 #Region "Footer"
-        Private Sub BTT_BROWSE_MouseClick(sender As Object, e As MouseEventArgs) Handles BTT_BROWSE.MouseClick
+        Private Sub BTT_BROWSE_MouseDown(sender As Object, e As MouseEventArgs) Handles BTT_BROWSE.MouseDown
             Dim f As SFile
 #Disable Warning BC40000
             If MyContainer.HasElements Then

SCrawler.YouTube/Downloader/VideoListForm.vb

@@ -247,6 +247,8 @@ Namespace DownloadObjects.STDownloader
                 If e.Control Then useCookies = True
                 Dim useCookiesParse As Boolean? = Nothing
                 If useCookies Then useCookiesParse = True
+                Dim standardizeUrls As Boolean = MyYouTubeSettings.StandardizeURLs
+                Dim standardize As Func(Of String, String) = Function(input) If(standardizeUrls, YouTubeFunctions.StandardizeURL(input), input)
 
                 Dim c As IYouTubeMediaContainer = Nothing
                 Dim url$ = String.Empty
@@ -264,7 +266,7 @@ Namespace DownloadObjects.STDownloader
                                     pForm.SetInitialValues(.Count, "Parsing playlists...")
                                     Dim containers As New List(Of IYouTubeMediaContainer)
                                     For Each u$ In .Self
-                                        containers.Add(YouTubeFunctions.Parse(u, useCookiesParse, pForm.Token, pForm.MyProgress, True, False))
+                                        containers.Add(YouTubeFunctions.Parse(standardize(u), useCookiesParse, pForm.Token, pForm.MyProgress, True, False))
                                         pForm.NextPlaylist()
                                         pForm.MyProgress.Perform()
                                     Next
@@ -295,7 +297,7 @@ Namespace DownloadObjects.STDownloader
                         pForm = New ParsingProgressForm
                         pForm.Show(Me)
                         pForm.SetInitialValues(1, "Parsing data...")
-                        c = YouTubeFunctions.Parse(url, useCookiesParse, pForm.Token, pForm.MyProgress, GetDefault, GetShorts)
+                        c = YouTubeFunctions.Parse(standardize(url), useCookiesParse, pForm.Token, pForm.MyProgress, GetDefault, GetShorts)
                         pForm.Dispose()
                     End If
                     If Not c Is Nothing Then

SCrawler.YouTube/My Project/AssemblyInfo.vb

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

SCrawler.YouTube/Objects/IYouTubeMediaContainer.vb

@@ -25,6 +25,7 @@ Namespace API.YouTube.Objects
         ReadOnly Property MediaType As UMTypes
         ReadOnly Property MediaState As UMStates
         Property IsMusic As Boolean
+        Property IsShorts As Boolean
         Property ID As String
         Property Description As String
         Property PlaylistID As String

SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb

@@ -112,7 +112,7 @@ Namespace API.YouTube.Objects
             End Set
         End Property
         <XMLEC(Name_IsMusic)> Public Property IsMusic As Boolean = False Implements IYouTubeMediaContainer.IsMusic
-        <XMLEC> Public Property IsShorts As Boolean = False
+        <XMLEC> Public Property IsShorts As Boolean = False Implements IYouTubeMediaContainer.IsShorts
         <XMLEC> Public Property ID As String Implements IYouTubeMediaContainer.ID, IUserMedia.PostID
         <XMLEC> Public Property Title As String Implements IDownloadableMedia.Title
         <XMLEC> Public Property Description As String Implements IYouTubeMediaContainer.Description
@@ -1309,9 +1309,29 @@ Namespace API.YouTube.Objects
                             Next
                         End If
                     End Sub
+                Dim protocolCleaner As Action =
+                    Sub()
+                        If Not MyYouTubeSettings.DefaultProtocol.Value = Protocols.Undefined And
+                           Not MyYouTubeSettings.DefaultProtocol.Value = Protocols.Any Then
+                            Dim data As New List(Of MediaObject)(MediaObjects.Where(Function(mo) mo.ProtocolType = MyYouTubeSettings.DefaultProtocol.Value))
+                            If data.ListExists Then
+                                Dim dRem As Protocols = IIf(MyYouTubeSettings.DefaultProtocol.Value = Protocols.https, Protocols.m3u8, Protocols.https)
+                                Dim d As MediaObject
+                                Dim dr As New FPredicate(Of MediaObject)(Function(mo) mo.Height = d.Height And mo.ProtocolType = dRem)
+                                For Each d In data
+                                    If MediaObjects.Count = 0 Then
+                                        Exit For
+                                    ElseIf MediaObjects.LongCount(dr) > 0 Then
+                                        MediaObjects.RemoveAll(dr)
+                                    End If
+                                Next
+                            End If
+                        End If
+                    End Sub
                 If MediaObjects.Count > 0 And Not MyYouTubeSettings.DefaultVideoIncludeNullSize Then MediaObjects.RemoveAll(Function(mo) mo.Size <= 0)
                 If MediaObjects.Count > 0 Then DupRemover.Invoke(UMTypes.Audio)
                 If MediaObjects.Count > 0 Then DupRemover.Invoke(UMTypes.Video)
+                If MediaObjects.Count > 0 Then protocolCleaner.Invoke
                 If MediaObjects.Count > 0 Then
                     MediaObjects.Sort()
                     SelectedAudioIndex = MediaObjects.FindIndex(Function(mo) mo.Type = UMTypes.Audio)

SCrawler.YouTubeDownloader/My Project/AssemblyInfo.vb

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

SCrawler/API/Base/UserDataBase.vb

@@ -1226,7 +1226,7 @@ BlockNullPicture:
                 End If
                 ThrowIfDisposed()
                 If Not _PictureExists Or _EnvirInvokeUserUpdated Then OnUserUpdated()
-            Catch oex As OperationCanceledException When Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested
+            Catch oex As OperationCanceledException When Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested Or TokenQueue.IsCancellationRequested
                 MyMainLOG = $"{ToStringForLog()}: downloading canceled"
                 Canceled = True
             Catch exit_ex As ExitException
@@ -1371,7 +1371,7 @@ BlockNullPicture:
 #Region "MD5 support"
         Protected Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR"
         Friend Property UseMD5Comparison As Boolean = False
-        Protected Property StartMD5Checked As Boolean = True
+        Protected Property StartMD5Checked As Boolean = False
         Friend Property RemoveExistingDuplicates As Boolean = False
         Protected Overridable Sub ValidateMD5(ByVal Token As CancellationToken)
             Try
@@ -1829,6 +1829,7 @@ BlockNullPicture:
                         If m.Contains(IUserData.EraseMode.History) Then
                             If MyFilePosts.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
                             If MyFileData.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
+                            EraseData_AdditionalDataFiles()
                         End If
                         If m.Contains(IUserData.EraseMode.Data) Then
                             Dim files As List(Of SFile) = SFile.GetFiles(DownloadContentDefault_GetRootDir.CSFileP,, SearchOption.AllDirectories, e)
@@ -1850,6 +1851,8 @@ BlockNullPicture:
                 Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"EraseData({CInt(Mode)}): {ToStringForLog()}", False)
             End Try
         End Function
+        Protected Overridable Sub EraseData_AdditionalDataFiles()
+        End Sub
         Friend Overridable Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer Implements IUserData.Delete
             Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
             If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then
@@ -2026,8 +2029,8 @@ BlockNullPicture:
         End Function
 #End Region
 #Region "Errors functions"
-        Protected Sub LogError(ByVal ex As Exception, ByVal Message As String)
-            ErrorsDescriber.Execute(EDP.SendToLog, ex, $"{ToStringForLog()}: {Message}")
+        Protected Sub LogError(ByVal ex As Exception, ByVal Message As String, Optional ByVal e As ErrorsDescriber = Nothing)
+            ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}")
         End Sub
         Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String)
             If Not f.Exists Then MyMainLOG = $"Error downloading from [{URL}] to [{f}]"
@@ -2040,9 +2043,13 @@ BlockNullPicture:
         Private Overloads Sub ThrowAny() Implements IThrower.ThrowAny
             ThrowAny(TokenQueue)
         End Sub
+        ''' <summary><c>ThrowAnyImpl(Token)</c></summary>
         ''' <exception cref="OperationCanceledException"></exception>
         ''' <exception cref="ObjectDisposedException"></exception>
         Friend Overridable Overloads Sub ThrowAny(ByVal Token As CancellationToken)
+            ThrowAnyImpl(Token)
+        End Sub
+        Protected Sub ThrowAnyImpl(ByVal Token As CancellationToken)
             Token.ThrowIfCancellationRequested()
             TokenQueue.ThrowIfCancellationRequested()
             TokenPersonal.ThrowIfCancellationRequested()

SCrawler/API/Instagram/Declarations.vb

@@ -17,7 +17,7 @@ Namespace API.Instagram
         Friend ReadOnly FilesPattern As RParams = RParams.DMS(".+?([^/\?]+?\.[\w\d]{3,4})(?=(\?|\Z))", 1, EDP.ReturnValue)
         Friend Sub UpdateResponser(ByVal Source As IResponse, ByRef Destination As Responser)
             Const r_wwwClaimName$ = "x-ig-set-www-claim"
-            Const r_tokenName$ = "csrftoken"
+            Const r_tokenName$ = SiteSettings.Header_CSRF_TOKEN_COOKIE
             If Not Source Is Nothing Then
                 Dim isInternal As Boolean = TypeOf Source Is WebDataResponse
                 Dim wwwClaimName$, tokenName$

SCrawler/API/Instagram/EditorExchangeOptions.vb

@@ -11,14 +11,17 @@ Namespace API.Instagram
     Friend Class EditorExchangeOptions
         <PSetting(Caption:="Get timeline", ToolTip:="Download user timeline")>
         Friend Property GetTimeline As Boolean
-        <PSetting(Caption:="Get stories", ToolTip:="Download user stories")>
+        <PSetting(Caption:="Get stories", ToolTip:="Download user stories (pinned)")>
         Friend Property GetStories As Boolean
+        <PSetting(Caption:="Get stories: user", ToolTip:="Download user stories")>
+        Friend Property GetStoriesUser As Boolean
         <PSetting(Caption:="Get tagged posts", ToolTip:="Download user tagged posts")>
         Friend Property GetTagged As Boolean
         Friend Sub New(ByVal u As UserData)
             With u
                 GetTimeline = .GetTimeline
                 GetStories = .GetStories
+                GetStoriesUser = .GetStoriesUser
                 GetTagged = .GetTaggedData
             End With
         End Sub
@@ -26,6 +29,7 @@ Namespace API.Instagram
             With s
                 GetTimeline = CBool(.GetTimeline.Value)
                 GetStories = CBool(.GetStories.Value)
+                GetStoriesUser = CBool(.GetStoriesUser.Value)
                 GetTagged = CBool(.GetTagged.Value)
             End With
         End Sub

SCrawler/API/Instagram/SiteSettings.vb

@@ -70,13 +70,14 @@ Namespace API.Instagram
         End Class
 #End Region
 #Region "Authorization properties"
-        Private Const Header_IG_APP_ID As String = "x-ig-app-id"
+        Friend Const Header_IG_APP_ID As String = "x-ig-app-id"
         Friend Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
         Friend Const Header_CSRF_TOKEN As String = "x-csrftoken"
-        Private Const Header_ASBD_ID As String = "X-Asbd-Id"
-        Private Const Header_Browser As String = "Sec-Ch-Ua"
-        Private Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
-        Private Const Header_Platform As String = "Sec-Ch-Ua-Platform-Version"
+        Friend Const Header_CSRF_TOKEN_COOKIE As String = "csrftoken"
+        Friend Const Header_ASBD_ID As String = "X-Asbd-Id"
+        Friend Const Header_Browser As String = "Sec-Ch-Ua"
+        Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
+        Friend Const Header_Platform As String = "Sec-Ch-Ua-Platform-Version"
         <PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash for tagged posts", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)>
         Friend ReadOnly Property HashTagged As PropertyValue
         <PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(2)>
@@ -139,11 +140,13 @@ Namespace API.Instagram
         Friend ReadOnly Property GetTimeline As PropertyValue
         <PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users"), PXML, ControlNumber(24)>
         Friend ReadOnly Property GetStories As PropertyValue
-        <PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), PXML, ControlNumber(25)>
+        <PropertyOption(ControlText:="Get stories: user", ControlToolTip:="Default value for new users"), PXML, ControlNumber(25)>
+        Friend ReadOnly Property GetStoriesUser As PropertyValue
+        <PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), PXML, ControlNumber(26)>
         Friend ReadOnly Property GetTagged As PropertyValue
         <PropertyOption(ControlText:="Tagged notify limit",
                         ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr &
-                        "-1 to disable"), PXML, ControlNumber(26)>
+                        "-1 to disable"), PXML, ControlNumber(27)>
         Friend ReadOnly Property TaggedNotifyLimit As PropertyValue
         <Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
         Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
@@ -153,7 +156,9 @@ Namespace API.Instagram
         Friend ReadOnly Property DownloadTimeline As PropertyValue
         <PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories"), PXML, ControlNumber(11)>
         Friend ReadOnly Property DownloadStories As PropertyValue
-        <PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(12)>
+        <PropertyOption(ControlText:="Download stories: user", ControlToolTip:="Download stories (user)"), PXML, ControlNumber(12)>
+        Friend ReadOnly Property DownloadStoriesUser As PropertyValue
+        <PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(13)>
         Friend ReadOnly Property DownloadTagged As PropertyValue
 #End Region
 #Region "429 bypass"
@@ -259,6 +264,7 @@ Namespace API.Instagram
 
             DownloadTimeline = New PropertyValue(True)
             DownloadStories = New PropertyValue(True)
+            DownloadStoriesUser = New PropertyValue(True)
             DownloadTagged = New PropertyValue(False)
 
             RequestsWaitTimer = New PropertyValue(1000)
@@ -270,6 +276,7 @@ Namespace API.Instagram
 
             GetTimeline = New PropertyValue(True)
             GetStories = New PropertyValue(False)
+            GetStoriesUser = New PropertyValue(False)
             GetTagged = New PropertyValue(False)
             TaggedNotifyLimit = New PropertyValue(200)
             TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
@@ -359,13 +366,16 @@ Namespace API.Instagram
             SkipUntilNextSession = False
         End Sub
 #End Region
-#Region "UserOptions, GetUserPostUrl"
+#Region "UserOptions, GetUserUrl, GetUserPostUrl"
         Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
             If Options Is Nothing OrElse Not TypeOf Options Is EditorExchangeOptions Then Options = New EditorExchangeOptions(Me)
             If OpenForm Then
                 Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
             End If
         End Sub
+        Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
+            Return String.Format(UrlPatternUser, DirectCast(User, UserData).NameTrue)
+        End Function
         Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
             Try
                 Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID)

SCrawler/API/Instagram/UserData.vb

@@ -24,12 +24,13 @@ Namespace API.Instagram
         Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
         Private Const Name_GetTimeline As String = "GetTimeline"
         Private Const Name_GetStories As String = "GetStories"
+        Private Const Name_GetStoriesUser As String = "GetStoriesUser"
         Private Const Name_GetTagged As String = "GetTaggedData"
         Private Const Name_TaggedChecked As String = "TaggedChecked"
         Private Const Name_NameTrue As String = "NameTrue"
 #End Region
 #Region "Declarations"
-        Private Structure PostKV : Implements IEContainerProvider
+        Protected Structure PostKV : Implements IEContainerProvider
             Private Const Name_Code As String = "Code"
             Private Const Name_Section As String = "Section"
             Friend Code As String
@@ -75,15 +76,41 @@ Namespace API.Instagram
         Private FirstLoadingDone As Boolean = False
         Friend Property GetTimeline As Boolean = True
         Friend Property GetStories As Boolean
+        Friend Property GetStoriesUser As Boolean
         Friend Property GetTaggedData As Boolean
-        Private _NameTrue As String = String.Empty
-        Private ReadOnly Property NameTrue As String
+        Protected _NameTrue As String = String.Empty
+        Friend ReadOnly Property NameTrue As String
             Get
                 Return _NameTrue.IfNullOrEmpty(Name)
             End Get
         End Property
         Private UserNameRequested As Boolean = False
 #End Region
+#Region "Loader"
+        Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
+            With Container
+                If Loading Then
+                    LastCursor = .Value(Name_LastCursor)
+                    FirstLoadingDone = .Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
+                    GetTimeline = .Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value))
+                    GetStories = .Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
+                    GetStoriesUser = .Value(Name_GetStoriesUser).FromXML(Of Boolean)(MySiteSettings.GetStoriesUser.Value)
+                    GetTaggedData = .Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
+                    TaggedChecked = .Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
+                    _NameTrue = .Value(Name_NameTrue)
+                Else
+                    .Add(Name_LastCursor, LastCursor)
+                    .Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
+                    .Add(Name_GetTimeline, GetTimeline.BoolToInteger)
+                    .Add(Name_GetStories, GetStories.BoolToInteger)
+                    .Add(Name_GetStoriesUser, GetStoriesUser.BoolToInteger)
+                    .Add(Name_GetTagged, GetTaggedData.BoolToInteger)
+                    .Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
+                    .Add(Name_NameTrue, _NameTrue)
+                End If
+            End With
+        End Sub
+#End Region
 #Region "Exchange options"
         Friend Overrides Function ExchangeOptionsGet() As Object
             Return New EditorExchangeOptions(Me)
@@ -93,37 +120,17 @@ Namespace API.Instagram
                 With DirectCast(Obj, EditorExchangeOptions)
                     GetTimeline = .GetTimeline
                     GetStories = .GetStories
+                    GetStoriesUser = .GetStoriesUser
                     GetTaggedData = .GetTagged
                 End With
             End If
         End Sub
 #End Region
-#Region "Initializer, loader"
+#Region "Initializer"
         Friend Sub New()
             PostsKVIDs = New List(Of PostKV)
             PostsToReparse = New List(Of PostKV)
         End Sub
-        Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
-            With Container
-                If Loading Then
-                    LastCursor = .Value(Name_LastCursor)
-                    FirstLoadingDone = .Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
-                    GetTimeline = .Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value))
-                    GetStories = .Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
-                    GetTaggedData = .Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
-                    TaggedChecked = .Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
-                    _NameTrue = .Value(Name_NameTrue)
-                Else
-                    .Add(Name_LastCursor, LastCursor)
-                    .Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
-                    .Add(Name_GetTimeline, GetTimeline.BoolToInteger)
-                    .Add(Name_GetStories, GetStories.BoolToInteger)
-                    .Add(Name_GetTagged, GetTaggedData.BoolToInteger)
-                    .Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
-                    .Add(Name_NameTrue, _NameTrue)
-                End If
-            End With
-        End Sub
 #End Region
 #Region "Download data"
         Private E560Thrown As Boolean = False
@@ -136,12 +143,22 @@ Namespace API.Instagram
                 Throw New ExitException
             End Sub
         End Class
-        Private Sub LoadSavePostsKV(ByVal Load As Boolean)
+        Private ReadOnly Property MyFilePostsKV As SFile
+            Get
+                Dim f As SFile = MyFilePosts
+                If Not f.IsEmptyString Then
+                    f.Name &= "_KV"
+                    f.Extension = "xml"
+                    Return f
+                Else
+                    Return Nothing
+                End If
+            End Get
+        End Property
+        Protected Sub LoadSavePostsKV(ByVal Load As Boolean)
             Dim x As XmlFile
-            Dim f As SFile = MyFilePosts
+            Dim f As SFile = MyFilePostsKV
             If Not f.IsEmptyString Then
-                f.Name &= "_KV"
-                f.Extension = "xml"
                 If Load Then
                     PostsKVIDs.Clear()
                     x = New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
@@ -175,10 +192,8 @@ Namespace API.Instagram
         Friend Function GetPostCodeById(ByVal PostID As String) As String
             Try
                 If Not PostID.IsEmptyString Then
-                    Dim f As SFile = MyFilePosts
+                    Dim f As SFile = MyFilePostsKV
                     If Not f.IsEmptyString Then
-                        f.Name &= "_KV"
-                        f.Extension = "xml"
                         Dim l As List(Of PostKV) = Nothing
                         Using x As New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
                             x.LoadData()
@@ -206,11 +221,15 @@ Namespace API.Instagram
             End If
         End Function
         Private _DownloadingInProgress As Boolean = False
+        Private _Limit As Integer = -1
+        Private _TotalPostsParsed As Integer = 0
         Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
             UserNameRequested = False
             Dim s As Sections = Sections.Timeline
             Dim errorFound As Boolean = False
             Try
+                _Limit = If(DownloadTopCount, -1)
+                _TotalPostsParsed = 0
                 LoadSavePostsKV(True)
                 _DownloadingInProgress = True
                 AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
@@ -234,6 +253,7 @@ Namespace API.Instagram
                 If FirstLoadingDone Then LastCursor = String.Empty
                 If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then
                     If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
+                    If CBool(MySiteSettings.DownloadStoriesUser.Value) And GetStoriesUser Then s = Sections.UserStories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
                     If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
                 End If
                 If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
@@ -262,7 +282,7 @@ Namespace API.Instagram
             Catch ex As Exception
             End Try
         End Sub
-        Private Sub UpdateResponser()
+        Protected Overridable Sub UpdateResponser()
             Try
                 If _DownloadingInProgress AndAlso Not Responser Is Nothing AndAlso Not Responser.Disposed Then
                     _DownloadingInProgress = False
@@ -272,10 +292,10 @@ Namespace API.Instagram
             Catch
             End Try
         End Sub
-        Private Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
+        Protected Overridable Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
             Declarations.UpdateResponser(e, Responser)
         End Sub
-        Private Enum Sections : Timeline : Tagged : Stories : SavedPosts : End Enum
+        Protected Enum Sections : Timeline : Tagged : Stories : UserStories : SavedPosts : End Enum
         Private Const StoriesFolder As String = "Stories"
         Private Const TaggedFolder As String = "Tagged"
 #Region "429 bypass"
@@ -455,7 +475,7 @@ Namespace API.Instagram
                                     ThrowAny(Token)
                                 End If
                                 If StoriesList.ListExists Then
-                                    GetStoriesData(StoriesList, Token)
+                                    GetStoriesData(StoriesList, False, Token)
                                     MySiteSettings.TooManyRequests(False)
                                     RequestsCount += 1
                                 End If
@@ -464,6 +484,11 @@ Namespace API.Instagram
                                 Else
                                     Throw New ExitException
                                 End If
+                            Case Sections.UserStories
+                                GetStoriesData(Nothing, True, Token)
+                                MySiteSettings.TooManyRequests(False)
+                                RequestsCount += 1
+                                Throw New ExitException
                         End Select
 
                         'Get response
@@ -559,6 +584,7 @@ Namespace API.Instagram
             Dim URL$ = String.Empty
             Dim dValue% = 1
             Dim _Index% = 0
+            Dim before%
             If PostsToReparse.Count > 0 Then ProgressPre.ChangeMax(PostsToReparse.Count)
             Try
                 Do While dValue = 1
@@ -587,7 +613,12 @@ Namespace API.Instagram
                                     If Not j Is Nothing Then
                                         If If(j("items")?.Count, 0) > 0 Then
                                             With j("items")
-                                                For Each jj In .Self : ObtainMedia(jj, PostsToReparse(i).ID) : Next
+                                                For Each jj In .Self
+                                                    before = _TempMediaList.Count
+                                                    ObtainMedia(jj, PostsToReparse(i).ID)
+                                                    If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
+                                                    If _Limit > 0 And _TotalPostsParsed >= _Limit Then Throw New ExitException
+                                                Next
                                             End With
                                         End If
                                         j.Dispose()
@@ -624,21 +655,23 @@ Namespace API.Instagram
                             NextCursor = .Value("next_max_id")
                             If .Contains("items") Then nodes = (From ee As EContainer In .Item("items") Where ee.Count > 0 Select ee(0))
                         End With
-                        If nodes.ListExists Then
-                            DefaultParser(nodes, Sections.SavedPosts, Token)
-                            If HasNextPage And Not NextCursor.IsEmptyString Then SavedPostsDownload(NextCursor, Token)
-                        End If
+                        If nodes.ListExists AndAlso DefaultParser(nodes, Sections.SavedPosts, Token) AndAlso
+                           HasNextPage AndAlso Not NextCursor.IsEmptyString Then SavedPostsDownload(NextCursor, Token)
                     End If
                 End Using
             End If
         End Sub
-        Private Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
-                                       Optional ByVal SpecFolder As String = Nothing) As Boolean
+        Protected DefaultParser_ElemNode() As Object = Nothing
+        Protected DefaultParser_IgnorePass As Boolean = False
+        Protected DefaultParser_PostUrlCreator As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/"
+        Protected Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
+                                         Optional ByVal SpecFolder As String = Nothing) As Boolean
             ThrowAny(Token)
             If Items.Count > 0 Then
                 Dim PostIDKV As PostKV
                 Dim Pinned As Boolean
-                Dim PostDate$
+                Dim PostDate$, PostOriginUrl$
+                Dim before%
                 If SpecFolder.IsEmptyString Then
                     Select Case Section
                         Case Sections.Tagged : SpecFolder = TaggedFolder
@@ -649,22 +682,26 @@ Namespace API.Instagram
                 ProgressPre.ChangeMax(Items.Count)
                 For Each nn In Items
                     ProgressPre.Perform()
-                    With nn
+                    With If(Not DefaultParser_ElemNode Is Nothing, nn.ItemF(DefaultParser_ElemNode), nn)
                         PostIDKV = New PostKV(.Value("code"), .Value("id"), Section)
+                        PostOriginUrl = DefaultParser_PostUrlCreator(PostIDKV)
                         Pinned = .Contains("timeline_pinned_user_ids")
-                        If PostKvExists(PostIDKV) Then
+                        If Not DefaultParser_IgnorePass AndAlso PostKvExists(PostIDKV) Then
                             If Not Pinned Then Return False
                         Else
                             _TempPostsList.Add(PostIDKV.ID)
                             PostsKVIDs.ListAddValue(PostIDKV, LNC)
                             PostDate = .Value("taken_at")
-                            If Not IsSavedPosts Then
+                            If Not DefaultParser_IgnorePass And Not IsSavedPosts Then
                                 Select Case CheckDatesLimit(PostDate, UnixDate32Provider)
                                     Case DateResult.Skip : Continue For
                                     Case DateResult.Exit : If Not Pinned Then Return False
                                 End Select
                             End If
-                            ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate)
+                            before = _TempMediaList.Count
+                            ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate,, PostOriginUrl)
+                            If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
+                            If _Limit > 0 And _TotalPostsParsed >= _Limit Then Return False
                         End If
                     End With
                 Next
@@ -675,7 +712,7 @@ Namespace API.Instagram
         End Function
 #End Region
 #Region "Code ID converters"
-        Private Function CodeToID(ByVal Code As String) As String
+        Protected Function CodeToID(ByVal Code As String) As String
             Const CodeSymbols$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
             Try
                 If Not Code.IsEmptyString Then
@@ -695,12 +732,19 @@ Namespace API.Instagram
         End Function
 #End Region
 #Region "Obtain Media"
-        Private Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
-                                Optional ByVal DateObj As String = Nothing)
+        Protected ObtainMedia_SizeFuncVid As Func(Of EContainer, Sizes) = Nothing
+        Protected ObtainMedia_SizeFuncPic As Func(Of EContainer, Sizes) = Nothing
+        Protected ObtainMedia_AllowAbstract As Boolean = False
+        Protected Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
+                                  Optional ByVal DateObj As String = Nothing, Optional ByVal InitialType As Integer = -1,
+                                  Optional ByVal PostOriginUrl As String = Nothing)
             Try
+                Dim wrongData As Predicate(Of Sizes) = Function(_ss) _ss.HasError Or _ss.Data.IsEmptyString
                 Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
                 Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0
                 Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url"))
+                Dim ssVid As Func(Of EContainer, Sizes) = ss
+                Dim ssPic As Func(Of EContainer, Sizes) = ss
                 Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String
                                                                If Not DateObj.IsEmptyString Then Return DateObj
                                                                If elem.Contains("taken_at") Then
@@ -720,28 +764,41 @@ Namespace API.Instagram
                                                                    End If
                                                                End If
                                                            End Function
+                If Not ObtainMedia_SizeFuncVid Is Nothing Then ssVid = ObtainMedia_SizeFuncVid
+                If Not ObtainMedia_SizeFuncPic Is Nothing Then ssPic = ObtainMedia_SizeFuncPic
                 If n.Count > 0 Then
                     Dim l As New List(Of Sizes)
                     Dim d As EContainer
                     Dim t%
+                    Dim abstractDecision As Boolean = False
                     '8 - gallery
                     '2 - one video
                     '1 - one picture
                     t = n.Value("media_type").FromXML(Of Integer)(-1)
+                    If t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then
+                        If n.Contains(vid) Then
+                            t = 2
+                            abstractDecision = True
+                        ElseIf n.Contains(img) Then
+                            t = 1
+                            abstractDecision = True
+                        End If
+                    End If
                     If t >= 0 Then
                         Select Case t
                             Case 1
                                 If n.Contains(img) Then
-                                    t = n.Value("media_type").FromXML(Of Integer)(-1)
+                                    If Not abstractDecision Then t = n.Value("media_type").FromXML(Of Integer)(-1)
                                     DateObj = mDate(n)
                                     If t >= 0 Then
                                         With n.ItemF({img, "candidates"}).XmlIfNothing
                                             If .Count > 0 Then
                                                 l.Clear()
-                                                l.ListAddList(.Select(ss), LNC)
+                                                l.ListAddList(.Select(ssPic), LNC)
+                                                If l.Count > 0 Then l.RemoveAll(wrongData)
                                                 If l.Count > 0 Then
                                                     l.Sort()
-                                                    _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder), LNC)
+                                                    _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl), LNC)
                                                     l.Clear()
                                                 End If
                                             End If
@@ -754,10 +811,11 @@ Namespace API.Instagram
                                     With n.ItemF({vid}).XmlIfNothing
                                         If .Count > 0 Then
                                             l.Clear()
-                                            l.ListAddList(.Select(ss), LNC)
+                                            l.ListAddList(.Select(ssVid), LNC)
+                                            If l.Count > 0 Then l.RemoveAll(wrongData)
                                             If l.Count > 0 Then
                                                 l.Sort()
-                                                _TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder), LNC)
+                                                _TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl), LNC)
                                                 l.Clear()
                                             End If
                                         End If
@@ -767,7 +825,7 @@ Namespace API.Instagram
                                 DateObj = mDate(n)
                                 With n("carousel_media").XmlIfNothing
                                     If .Count > 0 Then
-                                        For Each d In .Self : ObtainMedia(d, PostID, SpecialFolder, DateObj) : Next
+                                        For Each d In .Self : ObtainMedia(d, PostID, SpecialFolder, DateObj, 8, PostOriginUrl) : Next
                                     End If
                                 End With
                         End Select
@@ -854,17 +912,21 @@ Namespace API.Instagram
         End Function
 #End Region
 #Region "Pinned stories"
-        Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken)
+        Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal GetUserStory As Boolean, ByVal Token As CancellationToken)
             Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}"
-            Dim tmpList As IEnumerable(Of String)
+            Dim tmpList As IEnumerable(Of String) = Nothing
             Dim qStr$, r$, sFolder$, storyID$, pid$
             Dim i% = -1
             Dim jj As EContainer, s As EContainer
             ThrowAny(Token)
-            If StoriesList.ListExists Then
-                tmpList = StoriesList.Take(5)
-                If tmpList.ListExists Then
-                    qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids=highlight:{q}").ListToString("&"))
+            If StoriesList.ListExists Or GetUserStory Then
+                If Not GetUserStory Then tmpList = StoriesList.Take(5)
+                If tmpList.ListExists Or GetUserStory Then
+                    If GetUserStory Then
+                        qStr = $"https://www.instagram.com/api/v1/feed/reels_media/?reel_ids={ID}"
+                    Else
+                        qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids=highlight:{q}").ListToString("&"))
+                    End If
                     r = Responser.GetResponse(qStr,, EDP.ThrowException)
                     ThrowAny(Token)
                     If Not r.IsEmptyString Then
@@ -876,9 +938,13 @@ Namespace API.Instagram
                                     i += 1
                                     sFolder = jj.Value("title").StringRemoveWinForbiddenSymbols
                                     storyID = jj.Value("id").Replace("highlight:", String.Empty)
-                                    If sFolder.IsEmptyString Then sFolder = $"Story_{storyID}"
-                                    If sFolder.IsEmptyString Then sFolder = $"Story_{i}"
-                                    sFolder = $"{StoriesFolder}\{sFolder}"
+                                    If GetUserStory Then
+                                        sFolder = $"{StoriesFolder} (user)"
+                                    Else
+                                        If sFolder.IsEmptyString Then sFolder = $"Story_{storyID}"
+                                        If sFolder.IsEmptyString Then sFolder = $"Story_{i}"
+                                        sFolder = $"{StoriesFolder}\{sFolder}"
+                                    End If
                                     If Not storyID.IsEmptyString Then storyID &= ":"
                                     With jj("items").XmlIfNothing
                                         If .Count > 0 Then
@@ -896,7 +962,7 @@ Namespace API.Instagram
                             End If
                         End Using
                     End If
-                    StoriesList.RemoveRange(0, tmpList.Count)
+                    If Not GetUserStory Then StoriesList.RemoveRange(0, tmpList.Count)
                 End If
             End If
         End Sub
@@ -920,6 +986,12 @@ Namespace API.Instagram
             DownloadContentDefault(Token)
         End Sub
 #End Region
+#Region "Erase"
+        Protected Overrides Sub EraseData_AdditionalDataFiles()
+            Dim f As SFile = MyFilePostsKV
+            If f.Exists Then f.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.ReturnValue)
+        End Sub
+#End Region
 #Region "Exceptions"
         ''' <exception cref="ExitException"></exception>
         ''' <inheritdoc cref="UserDataBase.ThrowAny(CancellationToken)"/>
@@ -933,15 +1005,15 @@ Namespace API.Instagram
         ''' </summary>
         Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
                                                           Optional ByVal s As Object = Nothing) As Integer
-            If Responser.StatusCode = HttpStatusCode.NotFound Then
+            If Responser.StatusCode = HttpStatusCode.NotFound Then '404
                 If Not UserNameRequested AndAlso GetUserNameById() Then Return 1 Else UserExists = False
-            ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
+            ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then '400
                 HasError = True
                 MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
                 DisableSection(s)
-            ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then
+            ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then '403
                 Return 3
-            ElseIf Responser.StatusCode = 429 Then
+            ElseIf Responser.StatusCode = 429 Then '429
                 With MySiteSettings
                     Dim WaiterExists As Boolean = .LastApplyingValue.HasValue
                     .TooManyRequests(True)
@@ -950,10 +1022,10 @@ Namespace API.Instagram
                 Caught429 = True
                 MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
                 Return 1
-            ElseIf Responser.StatusCode = 560 Then
+            ElseIf Responser.StatusCode = 560 Or Responser.StatusCode = HttpStatusCode.InternalServerError Then '560, 500
                 MySiteSettings.SkipUntilNextSession = True
             Else
-                MyMainLOG = $"Something is wrong. Your credentials may have expired [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
+                MyMainLOG = $"Something is wrong. Your credentials may have expired [{CInt(Responser.StatusCode)}/{CInt(Responser.Status)}]: {ToString()} [{s}]"
                 DisableSection(s)
                 If Not FromPE Then LogError(ex, Message) : HasError = True
                 Return 0
@@ -965,6 +1037,10 @@ Namespace API.Instagram
                 Dim s As Sections = DirectCast(Section, Sections)
                 Select Case s
                     Case Sections.Timeline : MySiteSettings.DownloadTimeline.Value = False
+                    Case Sections.Stories, Sections.UserStories
+                        MySiteSettings.DownloadTimeline.Value = False
+                        MySiteSettings.DownloadStories.Value = False
+                        MySiteSettings.DownloadStoriesUser.Value = False
                     Case Else : MySiteSettings.DownloadTagged.Value = False
                 End Select
                 MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper
@@ -973,9 +1049,9 @@ Namespace API.Instagram
 #End Region
 #Region "Create media"
         Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
-                                       Optional ByVal SpecialFolder As String = Nothing) As UserMedia
+                                       Optional ByVal SpecialFolder As String = Nothing, Optional ByVal PostOriginUrl As String = Nothing) As UserMedia
             _URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
-            Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}}
+            Dim m As New UserMedia(_URL, t) With {.URL_BASE = PostOriginUrl.IfNullOrEmpty(_URL), .Post = New UserPost With {.ID = PostID}}
             If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
             If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, UnixDate32Provider, Nothing) Else m.Post.Date = Nothing
             m.SpecialFolder = SpecialFolder

SCrawler/API/JustForFans/UserData.vb

@@ -238,6 +238,8 @@ Namespace API.JustForFans
 
                                 _DownloadedPostsCount += 1
                                 _TempMediaList.ListAddList(post.GetUserMedia(FileSerialInstance), LNC)
+
+                                If _Limit > 0 And _DownloadedPostsCount >= _Limit Then Exit For
                             End If
                         Next
                     End If
@@ -250,11 +252,12 @@ Namespace API.JustForFans
         End Sub
         Private Sub GetUserID()
             Try
-                Dim r$, hash$, new_id$
+                Dim r$, hash$, new_id$, profilePic$
                 If ID.IsEmptyString Then
                     r = Responser.GetResponse($"https://justfor.fans/{Name}")
                     If Not r.IsEmptyString Then
                         hash = RegexReplace(r, RegexUser)
+                        profilePic = RegexReplace(r, RParams.DMS("<img class=.mainProfilePic..+?src=""([^""]+)", 1, EDP.ReturnValue))
                         If Not hash.IsEmptyString Then
                             r = Responser.GetResponse($"https://justfor.fans/ajax/getAssetCount.php?User={Name}&Ver={hash}")
                             If Not r.IsEmptyString Then
@@ -262,8 +265,14 @@ Namespace API.JustForFans
                                     If j.ListExists Then
                                         new_id = j.Value("UserID")
                                         If Not new_id.IsEmptyString Then
-                                            new_id = RegexReplace(new_id, RParams.DM("\D", 0, RegexReturn.Replace, CType(Function(input$) String.Empty, Func(Of String, String))))
-                                            If Not new_id.IsEmptyString Then ID = new_id : _ForceSaveUserInfo = True
+                                            new_id = RegexReplace(new_id, RParams.DM("\D", -1, RegexReturn.Replace,
+                                                                                     CType(Function(input$) String.Empty, Func(Of String, String)),
+                                                                                     String.Empty, EDP.ReturnValue))
+                                            If Not new_id.IsEmptyString Then
+                                                ID = new_id
+                                                _ForceSaveUserInfo = True
+                                                If Not profilePic.IsEmptyString Then GetWebFile(profilePic, $"{DownloadContentDefault_GetRootDir.CSFilePS}ProfilePic.jpg", EDP.None)
+                                            End If
                                         End If
                                     End If
                                 End Using

SCrawler/API/Mastodon/SiteSettings.vb

@@ -203,17 +203,21 @@ Namespace API.Mastodon
 #Region "UpdateServersList"
         Private Sub UpdateServersList()
             Try
-                Dim r$ = GetWebString("https://api.joinmastodon.org/servers?language=&category=&region=&ownership=&registrations=",, EDP.ThrowException)
-                If Not r.IsEmptyString Then
-                    Dim j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
-                    If If(j?.Count, 0) > 0 Then
-                        Domains.Domains.ListAddList(j.Select(Function(e) e.Value("domain")), LAP.NotContainsOnly, EDP.ReturnValue)
-                        Domains.Domains.Sort()
-                        Domains.Save()
-                        j.Dispose()
+                Using resp As New Responser With {
+                    .ProcessExceptionDecision = Function(rr, obj, e) If(rr.StatusCode = Net.HttpStatusCode.ServiceUnavailable,
+                                                                        EDP.ReturnValue, EDP.ThrowException)}
+                    Dim r$ = resp.GetResponse("https://api.joinmastodon.org/servers?language=&category=&region=&ownership=&registrations=")
+                    If Not r.IsEmptyString Then
+                        Dim j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
+                        If If(j?.Count, 0) > 0 Then
+                            Domains.Domains.ListAddList(j.Select(Function(e) e.Value("domain")), LAP.NotContainsOnly, EDP.ReturnValue)
+                            Domains.Domains.Sort()
+                            Domains.Save()
+                            j.Dispose()
+                        End If
+                        DomainsLastUpdateDate.Value = Now
                     End If
-                End If
-                DomainsLastUpdateDate.Value = Now
+                End Using
             Catch ex As Exception
                 ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.Mastodon.SiteSettings.UpdateServersList]")
             End Try

SCrawler/API/PornHub/Declarations.vb

@@ -14,6 +14,7 @@ Namespace API.PornHub
         Private ReadOnly UnicodeHexConverter As Func(Of String, String) = Function(Input) SymbolsConverter.UnicodeHex.Decode(Input, EDP.ReturnValue)
 #End Region
 #Region "Declarations video"
+        Friend ReadOnly RegexVideo_MediaDef As RParams = RParams.DMS("mediaDefinitions.:\s*(\[\{.+?\}\])", 1, RegexOptions.Singleline, EDP.ReturnValue)
         Friend ReadOnly RegexVideo_FlashVarsBlocks As RParams = RParams.DM("(?<=(flashvars_\['[nN]ext[vV]ideo'\]|flashvars_\d+[^ ]+? = media_\d+?);[\r\n]*?)(.+?)(?=;flashvars_\d+?)",
                                                                            0, RegexReturn.List, EDP.ReturnValue)
         Friend ReadOnly RegexVideo_FlashVars_Vars As RParams = RParams.DM("var ([\w\d]{10,})=("".+?)(?=(;|\Z))", 0, RegexReturn.List)

SCrawler/API/PornHub/UserData.vb

@@ -818,6 +818,15 @@ Namespace API.PornHub
 #End Region
 #Region "CreateVideoURL"
         Private Function CreateVideoURL(ByVal r As String) As String
+            If r.IsEmptyString Then
+                Return String.Empty
+            Else
+                Dim u$ = CreateVideoURL_FlashVars(r)
+                If u.IsEmptyString Then u = CreateVideoURL_MediaDef(r)
+                Return u
+            End If
+        End Function
+        Private Function CreateVideoURL_FlashVars(ByVal r As String) As String
             Try
                 Dim OutStr$ = String.Empty
                 Dim OutList As New List(Of String)
@@ -876,7 +885,26 @@ Namespace API.PornHub
                 MyMainLOG = $"{ToStringForLog()}: something is wrong when parsing flashvars.{vbCr}{regex_ex.Message}"
                 Return String.Empty
             Catch ex As Exception
-                Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)
+                Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL_FlashVars]", String.Empty)
+            End Try
+        End Function
+        Private Function CreateVideoURL_MediaDef(ByVal r As String) As String
+            Try
+                Dim result$ = String.Empty
+                If Not r.IsEmptyString Then
+                    Dim script$ = RegexReplace(r, RegexVideo_MediaDef)
+                    If Not script.IsEmptyString Then
+                        Using j As EContainer = JsonDocument.Parse(script)
+                            If j.ListExists Then
+                                Dim s As List(Of Sizes) = j.Select(Function(jj) New Sizes(jj.Value("quality"), jj.Value("videoUrl"))).ListWithRemove(Function(d) d.HasError Or d.Data.IsEmptyString)
+                                If s.ListExists Then s.Sort() : result = s(0).Data : s.Clear()
+                            End If
+                        End Using
+                    End If
+                End If
+                Return result
+            Catch ex As Exception
+                Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL_MediaDef]", String.Empty)
             End Try
         End Function
 #End Region

SCrawler/API/Reddit/SiteSettings.vb

@@ -104,12 +104,45 @@ Namespace API.Reddit
             Return New UserData
         End Function
 #End Region
-#Region "Available, UpdateRedGifsToken"
+#Region "DownloadStarted, ReadyToDownload, Available, DownloadDone, UpdateRedGifsToken"
+        Private ____DownloadStarted As Boolean = False
+        Friend Overrides Sub DownloadStarted(ByVal What As Download)
+            If What = Download.Main Then ____DownloadStarted = True
+            MyBase.DownloadStarted(What)
+        End Sub
         Friend Property SessionInterrupted As Boolean = False
         Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
-            If What = Download.Main Then Return Not SessionInterrupted Else Return True
+            If What = Download.Main Then
+                Dim result As Boolean = Not SessionInterrupted
+                If result Then
+                    If ____DownloadStarted And ____AvailableRequested Then
+                        ____AvailableResult = AvailableImpl(What, ____AvailableSilent)
+                        ____AvailableChecked = True
+                        ____AvailableRequested = False
+                        result = ____AvailableResult
+                    ElseIf ____AvailableChecked Then
+                        result = ____AvailableResult
+                    End If
+                End If
+                Return result
+            Else
+                Return True
+            End If
         End Function
+        Private ____AvailableRequested As Boolean = False
+        Private ____AvailableSilent As Boolean = True
+        Private ____AvailableChecked As Boolean = False
+        Private ____AvailableResult As Boolean = False
         Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
+            If What = Download.Main And ____DownloadStarted Then
+                ____AvailableRequested = True
+                ____AvailableSilent = Silent
+                Return True
+            Else
+                Return AvailableImpl(What, Silent)
+            End If
+        End Function
+        Private Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean
             Try
                 Dim trueValue As Boolean = Not What = Download.SavedPosts OrElse (Responser.CookiesExists And ACheck(SavedPostsUserName.Value))
                 If Not trueValue Then Return False
@@ -141,6 +174,11 @@ Namespace API.Reddit
         End Function
         Friend Overrides Sub DownloadDone(ByVal What As Download)
             SessionInterrupted = False
+            ____DownloadStarted = False
+            ____AvailableRequested = False
+            ____AvailableChecked = False
+            ____AvailableSilent = True
+            ____AvailableResult = False
             MyBase.DownloadDone(What)
         End Sub
         Private Sub UpdateRedGifsToken()

SCrawler/API/Redgifs/UserData.vb

@@ -249,7 +249,7 @@ Namespace API.RedGifs
                                                           Optional ByVal EObj As Object = Nothing) As Integer
             Dim s As WebExceptionStatus = Responser.Status
             Dim sc As HttpStatusCode = Responser.StatusCode
-            If sc = HttpStatusCode.NotFound Or s = DataGone Then
+            If sc = HttpStatusCode.NotFound Or s = DataGone Or sc = DataGone Then
                 UserExists = False
             ElseIf sc = HttpStatusCode.Unauthorized Then
                 MyMainLOG = $"RedGifs credentials have expired [{CInt(sc)}]: {ToStringForLog()}"

SCrawler/API/ThreadsNet/SiteSettings.vb

@@ -0,0 +1,166 @@
+' Copyright (C) 2023  Andy https://github.com/AAndyProgram
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT ANY WARRANTY
+Imports SCrawler.API.Base
+Imports SCrawler.Plugin
+Imports SCrawler.Plugin.Attributes
+Imports PersonalUtilities.Tools.Web.Clients
+Imports PersonalUtilities.Tools.Web.Cookies
+Imports PersonalUtilities.Functions.RegularExpressions
+Imports IG = SCrawler.API.Instagram.SiteSettings
+Namespace API.ThreadsNet
+    <Manifest("AndyProgram_ThreadsNet"), SeparatedTasks(1)>
+    Friend Class SiteSettings : Inherits SiteSettingsBase
+#Region "Declarations"
+        Friend Overrides ReadOnly Property Icon As Icon
+            Get
+                Return My.Resources.SiteResources.ThreadsIcon_192
+            End Get
+        End Property
+        Private ReadOnly _Image As Image
+        Friend Overrides ReadOnly Property Image As Image
+            Get
+                Return _Image
+            End Get
+        End Property
+#Region "Authorization"
+        <PropertyOption(ControlText:="x-csrftoken", AllowNull:=False)>
+        Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue
+        <PropertyOption(ControlText:="x-ig-app-id", AllowNull:=False)>
+        Friend Property HH_IG_APP_ID As PropertyValue
+        <PropertyOption(ControlText:="x-asbd-id", AllowNull:=True)>
+        Friend Property HH_ASBD_ID As PropertyValue
+        <PropertyOption(ControlText:="sec-ch-ua", AllowNull:=True)>
+        Private Property HH_BROWSER As PropertyValue
+        <PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", AllowNull:=True)>
+        Private Property HH_BROWSER_EXT As PropertyValue
+        <PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", AllowNull:=True, LeftOffset:=120)>
+        Private Property HH_PLATFORM As PropertyValue
+        <PropertyOption(ControlText:="UserAgent")>
+        Private ReadOnly Property HH_USER_AGENT As PropertyValue
+        Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
+            If Not PropName.IsEmptyString Then
+                Dim f$ = String.Empty
+                Dim isUserAgent As Boolean = False
+                Select Case PropName
+                    Case NameOf(HH_IG_APP_ID) : f = IG.Header_IG_APP_ID
+                    Case NameOf(HH_ASBD_ID) : f = IG.Header_ASBD_ID
+                    Case NameOf(HH_CSRF_TOKEN) : f = IG.Header_CSRF_TOKEN
+                    Case NameOf(HH_BROWSER) : f = IG.Header_Browser
+                    Case NameOf(HH_BROWSER_EXT) : f = IG.Header_BrowserExt
+                    Case NameOf(HH_PLATFORM) : f = IG.Header_Platform
+                    Case NameOf(HH_USER_AGENT) : isUserAgent = True
+                End Select
+                If Not f.IsEmptyString Then
+                    Responser.Headers.Remove(f)
+                    If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
+                ElseIf isUserAgent Then
+                    Responser.UserAgent = CStr(Value)
+                End If
+            End If
+        End Sub
+#End Region
+#End Region
+#Region "Initializer"
+        Friend Sub New()
+            MyBase.New("Threads", "threads.net")
+            _AllowUserAgentUpdate = False
+            _Image = My.Resources.SiteResources.ThreadsIcon_192.ToBitmap
+
+            Dim app_id$ = String.Empty
+            Dim token$ = String.Empty
+            Dim asbd$ = String.Empty
+            Dim browser$ = String.Empty
+            Dim browserExt$ = String.Empty
+            Dim platform$ = String.Empty
+            Dim useragent$ = String.Empty
+
+            With Responser
+                .Accept = "*/*"
+                'URGENT: remove after debug
+                .DeclaredError = EDP.SendToLog + EDP.ThrowException
+                If .UserAgentExists Then useragent = .UserAgent
+                With .Headers
+                    If .Count > 0 Then
+                        token = .Value(IG.Header_CSRF_TOKEN)
+                        app_id = .Value(IG.Header_IG_APP_ID)
+                        asbd = .Value(IG.Header_ASBD_ID)
+                        browser = .Value(IG.Header_Browser)
+                        browserExt = .Value(IG.Header_BrowserExt)
+                        platform = .Value(IG.Header_Platform)
+                    End If
+                    .Add("Authority", "www.threads.net")
+                    .Add("Origin", "https://www.threads.net")
+                    .Add("Upgrade-Insecure-Requests", 1)
+                    .Add("Sec-Ch-Ua-Model", "")
+                    .Add("Sec-Ch-Ua-Mobile", "?0")
+                    .Add("Sec-Ch-Ua-Platform", """Windows""")
+                    .Add("Sec-Fetch-Dest", "empty")
+                    .Add("Sec-Fetch-Mode", "cors")
+                    .Add("Sec-Fetch-Site", "same-origin")
+                    .Add("Sec-Fetch-User", "?1")
+                    .Add("x-fb-friendly-name", "BarcelonaProfileThreadsTabRefetchableQuery")
+                End With
+                .CookiesExtractMode = Responser.CookiesExtractModes.Any
+                .CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
+                .CookiesExtractedAutoSave = False
+                .Cookies.ChangedAllowInternalDrop = False
+                .Cookies.Changed = False
+            End With
+
+            HH_CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_CSRF_TOKEN), v))
+            HH_IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_IG_APP_ID), v))
+            HH_ASBD_ID = New PropertyValue(asbd, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_ASBD_ID), v))
+            HH_BROWSER = New PropertyValue(browser, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER), v))
+            HH_BROWSER_EXT = New PropertyValue(browserExt, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER_EXT), v))
+            HH_PLATFORM = New PropertyValue(platform, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_PLATFORM), v))
+            HH_USER_AGENT = New PropertyValue(useragent, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_USER_AGENT), v))
+
+            UrlPatternUser = "https://www.threads.net/@{0}"
+            UserRegex = RParams.DMS("threads.net/@([^/\?&]+)", 1)
+            ImageVideoContains = "threads.net"
+        End Sub
+#End Region
+#Region "UpdateResponserData"
+        Friend Sub UpdateResponserData(ByVal Resp As Responser)
+            With Responser.Cookies
+                Dim csrf$ = String.Empty
+                .Update(Resp.Cookies)
+                If .Changed Then
+                    Responser.SaveCookies()
+                    .Changed = False
+                    csrf = If(.FirstOrDefault(Function(c) c.Name.StringToLower = IG.Header_CSRF_TOKEN_COOKIE)?.Value, String.Empty)
+                End If
+                If Not csrf.IsEmptyString AndAlso Not AEquals(Of String)(csrf, HH_CSRF_TOKEN.Value) Then HH_CSRF_TOKEN.Value = csrf
+            End With
+        End Sub
+#End Region
+#Region "GetInstance"
+        Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
+            Return New UserData
+        End Function
+#End Region
+#Region "BaseAuthExists, GetUserUrl, GetUserPostUrl"
+        Friend Overrides Function BaseAuthExists() As Boolean
+            Return Responser.CookiesExists And {HH_CSRF_TOKEN, HH_IG_APP_ID}.All(Function(v) ACheck(Of String)(v.Value))
+        End Function
+        Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
+            Return String.Format(UrlPatternUser, DirectCast(User, UserData).NameTrue)
+        End Function
+        Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
+            Try
+                Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID)
+                Dim name$ = DirectCast(User, UserData).NameTrue
+                If Not code.IsEmptyString Then Return $"https://www.threads.net/@{name}/post/{code}/" Else Return String.Empty
+            Catch ex As Exception
+                Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "Can't open user's post", String.Empty)
+            End Try
+        End Function
+#End Region
+    End Class
+End Namespace

SCrawler/API/ThreadsNet/UserData.vb

@@ -0,0 +1,290 @@
+' Copyright (C) 2023  Andy https://github.com/AAndyProgram
+' This program is free software: you can redistribute it and/or modify
+' it under the terms of the GNU General Public License as published by
+' the Free Software Foundation, either version 3 of the License, or
+' (at your option) any later version.
+'
+' This program is distributed in the hope that it will be useful,
+' but WITHOUT ANY WARRANTY
+Imports System.Threading
+Imports SCrawler.API.Base
+Imports SCrawler.API.YouTube.Objects
+Imports PersonalUtilities.Functions.XML
+Imports PersonalUtilities.Functions.RegularExpressions
+Imports PersonalUtilities.Tools.Web.Documents.JSON
+Imports PersonalUtilities.Tools.Web.Clients
+Imports PersonalUtilities.Tools.Web.Clients.EventArguments
+Imports IGS = SCrawler.API.Instagram.SiteSettings
+Namespace API.ThreadsNet
+    Friend Class UserData : Inherits Instagram.UserData
+#Region "Declarations"
+        Private Const Header_FB_LSD As String = "x-fb-lsd"
+        Private ReadOnly Property MySettings As SiteSettings
+            Get
+                Return HOST.Source
+            End Get
+        End Property
+        Private ReadOnly ObtainMedia_SizeFuncPic_RegexP As RParams = RParams.DMS("_p(\d+)x(\d+)", 1, EDP.ReturnValue)
+        Private ReadOnly ObtainMedia_SizeFuncPic_RegexS As RParams = RParams.DMS("_s(\d+)x(\d+)", 1, EDP.ReturnValue)
+        Private ReadOnly DefaultParser_ElemNode_Default() As Object = {"node", "thread_items", 0, "post"}
+        Private OPT_LSD As String = String.Empty
+        Private OPT_FB_DTSG As String = String.Empty
+        Private ReadOnly Property Valid As Boolean
+            Get
+                Return Not OPT_LSD.IsEmptyString And Not OPT_FB_DTSG.IsEmptyString And Not ID.IsEmptyString
+            End Get
+        End Property
+#End Region
+#Region "Loader"
+        Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
+        End Sub
+#End Region
+#Region "Exchange"
+        Friend Overrides Function ExchangeOptionsGet() As Object
+            Return Nothing
+        End Function
+        Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
+        End Sub
+#End Region
+#Region "Initializer"
+        Friend Sub New()
+            ObtainMedia_SizeFuncPic = Function(ByVal ss As EContainer) As Sizes
+                                          If ss.Value("url").IsEmptyString Then
+                                              Return New Sizes("----", "")
+                                          ElseIf Not ss.Value("width").IsEmptyString Then
+                                              Return New Sizes(ss.Value("height").IfNullOrEmpty(ss.Value("width")), ss.Value("url"))
+                                          Else
+                                              Dim rval$ = RegexReplace(ss.Value("url"), ObtainMedia_SizeFuncPic_RegexP)
+                                              If Not rval.IsEmptyString Then Return New Sizes(rval, ss.Value("url"))
+                                              rval = RegexReplace(ss.Value("url"), ObtainMedia_SizeFuncPic_RegexS)
+                                              If Not rval.IsEmptyString Then Return New Sizes(AConvert(Of Integer)(rval, 1) * -1, ss.Value("url"))
+                                              Return New Sizes(10000, ss.Value("url"))
+                                          End If
+                                      End Function
+            ObtainMedia_SizeFuncVid = Function(ss) If(ss.Value("url").IsEmptyString, New Sizes("----", ""), New Sizes(10000, ss.Value("url")))
+            ObtainMedia_AllowAbstract = True
+            DefaultParser_ElemNode = DefaultParser_ElemNode_Default
+            DefaultParser_PostUrlCreator = Function(post) $"https://www.threads.net/@{NameTrue}/post/{post.Code}"
+        End Sub
+#End Region
+#Region "Download functions"
+        Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
+            Dim errorFound As Boolean = False
+            Try
+                Responser.Method = "POST"
+                AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
+                LoadSavePostsKV(True)
+                OPT_LSD = String.Empty
+                OPT_FB_DTSG = String.Empty
+                DownloadData(String.Empty, Token)
+            Catch ex As Exception
+                errorFound = True
+                Throw ex
+            Finally
+                Responser.Method = "POST"
+                UpdateResponser()
+                MySettings.UpdateResponserData(Responser)
+                If Not errorFound Then LoadSavePostsKV(False)
+            End Try
+        End Sub
+        Protected Overrides Sub UpdateResponser()
+            If Not Responser Is Nothing AndAlso Not Responser.Disposed Then
+                RemoveHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
+            End If
+        End Sub
+        Protected Overrides Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As WebDataResponse)
+            If e.CookiesExists Then
+                Dim csrf$ = If(e.Cookies.FirstOrDefault(Function(v) v.Name.StringToLower = IGS.Header_CSRF_TOKEN_COOKIE)?.Value, String.Empty)
+                If Not csrf.IsEmptyString AndAlso Not AEquals(Of String)(csrf, Responser.Headers.Value(IGS.Header_CSRF_TOKEN)) Then _
+                   Responser.Headers.Add(IGS.Header_CSRF_TOKEN, csrf)
+            End If
+        End Sub
+        Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
+            Const urlPattern$ = "https://www.threads.net/api/graphql?lsd={0}&variables={1}&doc_id=6371597506283707&fb_api_req_friendly_name=BarcelonaProfileThreadsTabRefetchableQuery&server_timestamps=true&fb_dtsg={2}"
+            Const var_init$ = """userID"":""{0}"""
+            Const var_cursor$ = """after"":""{1}"",""before"":null,""first"":25,""last"":null,""userID"":""{0}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false"
+            Dim URL$ = String.Empty
+            Try
+                If Not Valid Then
+                    Dim idIsNull As Boolean = ID.IsEmptyString
+                    UpdateCredentials()
+                    If idIsNull And Not ID.IsEmptyString Then _ForceSaveUserInfo = True
+                End If
+                If Not Valid Then Throw New Plugin.ExitException("Some credentials are missing")
+
+                Responser.Method = "POST"
+                Responser.Referer = $"https://www.threads.net/@{NameTrue}"
+                Responser.Headers.Add(Header_FB_LSD, OPT_LSD)
+
+                Dim nextCursor$ = String.Empty
+                Dim dataFound As Boolean = False
+
+                Dim vars$
+                If Cursor.IsEmptyString Then
+                    vars = String.Format(var_init, ID)
+                Else
+                    vars = String.Format(var_cursor, ID, Cursor)
+                End If
+                vars = SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & vars & "}")
+
+                URL = String.Format(urlPattern, OPT_LSD, vars, SymbolsConverter.ASCII.EncodeSymbolsOnly(OPT_FB_DTSG))
+
+                Using j As EContainer = GetDocument(URL, Token)
+                    If j.ListExists Then
+                        With j({"data", "mediaData"})
+                            If .ListExists Then
+                                nextCursor = .Value({"page_info"}, "end_cursor")
+                                With .Item({"edges"})
+                                    If .ListExists Then dataFound = DefaultParser(.Self, Sections.Timeline, Token)
+                                End With
+                            End If
+                        End With
+                    End If
+                End Using
+
+                If dataFound And Not nextCursor.IsEmptyString Then DownloadData(nextCursor, Token)
+            Catch ex As Exception
+                ProcessException(ex, Token, $"data downloading error [{URL}]")
+            End Try
+        End Sub
+        Private Function GetDocument(ByVal URL As String, ByVal Token As CancellationToken, Optional ByVal Round As Integer = 0) As EContainer
+            Try
+                ThrowAny(Token)
+                If Round > 0 AndAlso Not UpdateCredentials() Then Throw New Exception("Failed to update credentials")
+                ThrowAny(Token)
+                Dim r$ = Responser.GetResponse(URL)
+                If Not r.IsEmptyString Then Return JsonDocument.Parse(r) Else Throw New Exception("Failed to get a response")
+            Catch ex As Exception
+                If Round = 0 Then
+                    Return GetDocument(URL, Token, Round + 1)
+                Else
+                    Throw ex
+                End If
+            End Try
+        End Function
+        Private Function UpdateCredentials(Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
+            Dim URL$ = $"https://www.threads.net/@{NameTrue}"
+            OPT_LSD = String.Empty
+            OPT_FB_DTSG = String.Empty
+            Try
+                Responser.Method = "GET"
+                Responser.Referer = URL
+                Responser.Headers.Remove(Header_FB_LSD)
+                Dim r$ = Responser.GetResponse(URL,, EDP.SendToLog + EDP.ThrowException)
+                Dim rr As RParams
+                Dim tt$, ttVal$
+                If Not r.IsEmptyString Then
+                    rr = RParams.DM("\[\],{""token"":""(.*?)""},\d+\]", 0, RegexReturn.List, EDP.ReturnValue)
+                    Dim tokens As List(Of String) = RegexReplace(r, rr)
+                    If tokens.ListExists Then
+                        With rr
+                            .Match = Nothing
+                            .MatchSub = 1
+                            .WhatGet = RegexReturn.Value
+                        End With
+                        For Each tt In tokens
+                            If Not OPT_FB_DTSG.IsEmptyString And Not OPT_LSD.IsEmptyString Then
+                                Exit For
+                            Else
+                                ttVal = RegexReplace(tt, rr)
+                                If Not ttVal.IsEmptyString Then
+                                    If ttVal.Contains(":") Then
+                                        If OPT_FB_DTSG.IsEmptyString Then OPT_FB_DTSG = ttVal
+                                    Else
+                                        If OPT_LSD.IsEmptyString Then OPT_LSD = ttVal
+                                    End If
+                                End If
+                            End If
+                        Next
+                    End If
+                    If ID.IsEmptyString Then ID = RegexReplace(r, RParams.DMS("""props"":\{""user_id"":""(\d+)""\},", 1, EDP.ReturnValue))
+                End If
+                Return Valid
+            Catch ex As Exception
+                Dim notFound$ = String.Empty
+                If OPT_FB_DTSG.IsEmptyString Then notFound.StringAppend(Header_FB_LSD)
+                If OPT_LSD.IsEmptyString Then notFound.StringAppend("lsd")
+                If ID.IsEmptyString Then notFound.StringAppend("User ID")
+                LogError(ex, $"failed to update some{IIf(notFound.IsEmptyString, String.Empty, $" ({notFound})")} credentials", e)
+                Return False
+            End Try
+        End Function
+#End Region
+#Region "ReparseMissing"
+        Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
+            Const varsPattern$ = """postID"":""{0}"",""userID"":""{1}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false"
+            'Const varsPattern$ = "{""postID"":""{0}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false}"
+            Const urlPattern$ = "https://www.threads.net/api/graphql?lsd={0}&variables={1}&fb_api_req_friendly_name=BarcelonaPostPageQuery&server_timestamps=true&fb_dtsg={2}&doc_id=25460088156920903"
+            Dim rList As New List(Of Integer)
+            Dim URL$ = String.Empty
+            DefaultParser_ElemNode = Nothing
+            DefaultParser_IgnorePass = True
+            Try
+                If ContentMissingExists Then
+                    Responser.Method = "POST"
+                    Responser.Referer = $"https://www.threads.net/@{NameTrue}"
+                    If Not IsSingleObjectDownload AndAlso Not UpdateCredentials() Then Throw New Exception("Failed to update credentials")
+                    Dim m As UserMedia
+                    Dim vars$
+                    Dim j As EContainer
+                    ProgressPre.ChangeMax(_ContentList.Count)
+                    For i% = 0 To _ContentList.Count - 1
+                        ProgressPre.Perform()
+                        m = _ContentList(i)
+                        If m.State = UserMedia.States.Missing And Not m.Post.ID.IsEmptyString Then
+                            ThrowAny(Token)
+                            vars = SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(varsPattern, m.Post.ID.Split("_").FirstOrDefault, ID) & "}")
+                            URL = String.Format(urlPattern, OPT_LSD, vars, SymbolsConverter.ASCII.EncodeSymbolsOnly(OPT_FB_DTSG))
+
+                            j = GetDocument(URL, Token)
+                            If j.ListExists Then
+                                With j.ItemF({"data", "data", "edges", 0, "node", "thread_items", 0, "post"})
+                                    If .ListExists AndAlso DefaultParser({ .Self}, Sections.Timeline, Token) Then rList.Add(i)
+                                End With
+                                j.Dispose()
+                            End If
+                        End If
+                    Next
+                End If
+            Catch ex As Exception
+                ProcessException(ex, Token, $"ReparseMissing error [{URL}]")
+            Finally
+                DefaultParser_ElemNode = DefaultParser_ElemNode_Default
+                DefaultParser_IgnorePass = False
+                If rList.Count > 0 Then
+                    For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
+                    rList.Clear()
+                End If
+            End Try
+        End Sub
+#End Region
+#Region "DownloadSingleObject"
+        Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
+            Dim url$ = Data.URL_BASE.IfNullOrEmpty(Data.URL)
+            Dim postCode$ = RegexReplace(url, RParams.DMS("post/([^/\?&]+)", 1, EDP.ReturnValue))
+            If Not postCode.IsEmptyString Then
+                Dim postId$ = CodeToID(postCode)
+                If Not postId.IsEmptyString Then
+                    _NameTrue = MySettings.IsMyUser(url).UserName
+                    DefaultParser_PostUrlCreator = Function(post) url
+                    If Not _NameTrue.IsEmptyString AndAlso UpdateCredentials(EDP.ReturnValue) Then
+                        _ContentList.Add(New UserMedia(url) With {.State = UserMedia.States.Missing, .Post = postId})
+                        ReparseMissing(Token)
+                    End If
+                End If
+            End If
+        End Sub
+#End Region
+#Region "ThrowAny"
+        Friend Overrides Sub ThrowAny(ByVal Token As CancellationToken)
+            ThrowAnyImpl(Token)
+        End Sub
+#End Region
+#Region "DownloadingException"
+        Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
+                                                          Optional ByVal EObj As Object = Nothing) As Integer
+            Return 0
+        End Function
+#End Region
+    End Class
+End Namespace

SCrawler/API/UserDataBind.vb

@@ -291,7 +291,7 @@ Namespace API
         End Property
         Friend Overrides Property ScriptUse As Boolean
             Get
-                Return Count > 0 AndAlso Collections.Exists(Function(c) c.ScriptUse)
+                Return Count > 0 AndAlso Collections.All(Function(c) c.ScriptUse)
             End Get
             Set(ByVal u As Boolean)
                 If Count > 0 Then Collections.ForEach(Sub(ByVal c As IUserData)
@@ -499,19 +499,20 @@ Namespace API
         Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add
             With _Item
                 If .MoveFiles(CollectionName, CollectionPath) Then
-                    If Not _Item.IsVirtual And DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
-                    Collections.Add(_Item)
+                    If Not .Self.IsVirtual And DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
+                    ConsolidateLabels(.Self)
+                    ConsolidateScripts(.Self)
+                    ConsolidateColors(.Self)
+                    Collections.Add(.Self)
                     With Collections.Last
-                        If Count > 1 Then
-                            If _CollectionName.IsEmptyString Then _CollectionName = .CollectionName
-                            .Temporary = Temporary
-                            .Favorite = Favorite
-                            .ReadyForDownload = ReadyForDownload
-                            ConsolidateLabels()
-                            ConsolidateScripts()
-                            .UpdateUserInformation()
-                        End If
-                        MainFrameObj.ImageHandler(_Item, False)
+
+                        If _CollectionName.IsEmptyString Then _CollectionName = .CollectionName
+                        .Temporary = Temporary
+                        .Favorite = Favorite
+                        .ReadyForDownload = ReadyForDownload
+                        .UpdateUserInformation()
+
+                        MainFrameObj.ImageHandler(.Self, False)
                         AddRemoveBttDeleteHandler(.Self, True)
                         AddHandler .Self.UserUpdated, AddressOf User_OnUserUpdated
                     End With
@@ -546,11 +547,25 @@ Namespace API
             Catch ex As Exception
             End Try
         End Sub
-        Private Sub ConsolidateLabels()
-            UpdateLabels(Me, ListAddList(Nothing, Labels.ListWithRemove(SpecialLabels)), 1, True)
+        Private Sub ConsolidateLabels(ByVal Destination As UserDataBase)
+            UpdateLabels(If(Destination, Me), ListAddList(Nothing, Labels.ListWithRemove(SpecialLabels)), 1, True)
         End Sub
-        Private Sub ConsolidateScripts()
-            If Count > 1 AndAlso ScriptUse Then Collections.ForEach(Sub(c) c.ScriptUse = True)
+        Private Sub ConsolidateScripts(ByVal Destination As UserDataBase)
+            If Count > 0 AndAlso ScriptUse Then
+                Dim __scriptData$ = Collections(0).ScriptData
+                Destination.ScriptUse = True
+                If Collections.All(Function(c) c.ScriptData = __scriptData) Then Destination.ScriptData = __scriptData
+            End If
+        End Sub
+        Private Sub ConsolidateColors(ByVal Destination As UserDataBase)
+            If Count > 0 And Not Destination.ForeColor.HasValue And Not Destination.BackColor.HasValue Then
+                Dim b As Color? = BackColor
+                Dim f As Color? = ForeColor
+                If b.HasValue AndAlso Not Collections.All(Function(u) Not u Is Destination AndAlso u.BackColor.HasValue AndAlso u.BackColor.Value = b.Value) Then b = Nothing
+                If f.HasValue AndAlso Not Collections.All(Function(u) Not u Is Destination AndAlso u.ForeColor.HasValue AndAlso u.ForeColor.Value = f.Value) Then f = Nothing
+                If b.HasValue Then Destination.BackColor = b
+                If f.HasValue Then Destination.ForeColor = f
+            End If
         End Sub
 #End Region
 #Region "Move, Merge"

SCrawler/API/YouTube/SiteSettings.vb

@@ -82,7 +82,7 @@ Namespace API.YouTube
             Dim isMusic As Boolean = False
             Dim id$ = String.Empty
             Dim isChannelUser As Boolean = False
-            Dim t As YouTubeMediaType = YouTubeFunctions.Info_GetUrlType(UserURL, isMusic, isChannelUser, id)
+            Dim t As YouTubeMediaType = YouTubeFunctions.Info_GetUrlType(UserURL, isMusic,, isChannelUser, id)
             If Not t = YouTubeMediaType.Undefined And Not t = YouTubeMediaType.Single And Not id.IsEmptyString Then
                 Return New ExchangeOptions(Site, $"{id}@{CInt(t) + IIf(isMusic, UserMedia.Types.Audio, 0) + IIf(isChannelUser, ChannelUserInt, 0)}")
             End If

SCrawler/Download/Automation/AutoDownloader.vb

@@ -15,7 +15,7 @@ Imports PersonalUtilities.Tools
 Imports PersonalUtilities.Tools.Notifications
 Namespace DownloadObjects
     Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider
-        Friend Event PauseDisabled()
+        Friend Event PauseChanged(ByVal Value As PauseModes)
         Friend Enum Modes As Integer
             None = 0
             [Default] = 1
@@ -412,6 +412,7 @@ Namespace DownloadObjects
                     Case PauseModes.Until : _PauseValue = DateLimit
                     Case Else : _PauseValue = Nothing
                 End Select
+                RaiseEvent PauseChanged(p)
             End Set
         End Property
         Private ReadOnly Property IsPaused As Boolean
@@ -423,7 +424,7 @@ Namespace DownloadObjects
                         Else
                             _Pause = PauseModes.Disabled
                             _PauseValue = Nothing
-                            RaiseEvent PauseDisabled()
+                            RaiseEvent PauseChanged(_Pause)
                             Return False
                         End If
                     Else

SCrawler/Download/Automation/AutoDownloaderPauseButtons.vb

@@ -92,34 +92,39 @@ Namespace DownloadObjects
                                                                                                                 BTT_PAUSE_H6.Click, BTT_PAUSE_H12.Click,
                                                                                                                 BTT_PAUSE_UNTIL.Click, BTT_PAUSE_UNLIMITED.Click,
                                                                                                                 BTT_PAUSE_DISABLE.Click
-            If (Place = ButtonsPlace.Scheduler And PlanIndex >= 0 And PlanIndex.ValueBetween(0, Settings.Automation.Count - 1)) Or Not Place = ButtonsPlace.Scheduler Then
-                Dim p As PauseModes = CInt(AConvert(Of Integer)(Sender.Tag, -10))
-                If p > -10 Then
-                    Dim d As Date? = Nothing
-                    Dim _SetPauseValue As Action = Sub()
-                                                       If Place = ButtonsPlace.Scheduler And PlanIndex.ValueBetween(0, Settings.Automation.Count - 1) Then
-                                                           Settings.Automation(PlanIndex).Pause(d) = p
-                                                       ElseIf Not Place = ButtonsPlace.Scheduler Then
-                                                           Settings.Automation.Pause(d) = p
-                                                       End If
-                                                   End Sub
-                    If p = PauseModes.Until Then
-                        Using f As New DateTimeSelectionForm(TimeSelectionModes.End + TimeSelectionModes.Date + TimeSelectionModes.Time, Settings.Design)
-                            f.ShowDialog()
-                            If f.DialogResult = DialogResult.OK Then d = f.MyDateEnd
-                        End Using
-                        If d.HasValue Then _SetPauseValue.Invoke
-                    Else
-                        _SetPauseValue.Invoke
-                    End If
-                    UpdatePauseButtons()
+            Dim p As PauseModes = CInt(AConvert(Of Integer)(Sender.Tag, -10))
+            If p > -10 AndAlso ((Place = ButtonsPlace.Scheduler And PlanIndex >= 0 And PlanIndex.ValueBetween(0, Settings.Automation.Count - 1)) OrElse
+               Not Place = ButtonsPlace.Scheduler OrElse
+               (Place = ButtonsPlace.Scheduler AndAlso PlanIndex = -1 AndAlso
+                MsgBoxE({$"Do you want to turn {IIf(p = PauseModes.Disabled, "off", "on")} pause for all plans?", "Pause plan"},
+                        vbExclamation + vbYesNo) = vbYes)) Then
+                Dim d As Date? = Nothing
+                Dim _SetPauseValue As Action = Sub()
+                                                   If Place = ButtonsPlace.Scheduler And PlanIndex.ValueBetween(0, Settings.Automation.Count - 1) Then
+                                                       Settings.Automation(PlanIndex).Pause(d) = p
+                                                   ElseIf Not Place = ButtonsPlace.Scheduler Or Place = ButtonsPlace.Scheduler And PlanIndex = -1 Then
+                                                       Settings.Automation.Pause(d) = p
+                                                   End If
+                                               End Sub
+                If p = PauseModes.Until Then
+                    Using f As New DateTimeSelectionForm(TimeSelectionModes.End + TimeSelectionModes.Date + TimeSelectionModes.Time, Settings.Design)
+                        f.ShowDialog()
+                        If f.DialogResult = DialogResult.OK Then d = f.MyDateEnd
+                    End Using
+                    If d.HasValue Then _SetPauseValue.Invoke
+                Else
+                    _SetPauseValue.Invoke
                 End If
-            ElseIf Place = ButtonsPlace.Scheduler And PlanIndex = -1 Then
+                UpdatePauseButtons()
+            ElseIf p > -10 And Place = ButtonsPlace.Scheduler And PlanIndex = -1 Then
                 MsgBoxE({"The plan to be paused is not selected", "Pause plan"}, vbExclamation)
             End If
         End Sub
 #End Region
 #Region "Update buttons"
+        Friend Overloads Sub UpdatePauseButtons_Handler(ByVal Value As PauseModes)
+            UpdatePauseButtons()
+        End Sub
         Friend Overloads Sub UpdatePauseButtons() Handles TrayButtons.Updating
             UpdatePauseButtons(True)
         End Sub

SCrawler/Download/Automation/Scheduler.vb

@@ -14,12 +14,14 @@ Imports PauseModes = SCrawler.DownloadObjects.AutoDownloader.PauseModes
 Namespace DownloadObjects
     Friend Class Scheduler : Implements IEnumerable(Of AutoDownloader), IMyEnumerator(Of AutoDownloader), IDisposable
         Friend Const Name_Plan As String = "Plan"
-        Friend Event PauseDisabled As AutoDownloader.PauseDisabledEventHandler
-        Private Sub OnPauseDisabled()
-            RaiseEvent PauseDisabled()
+        Friend Event PauseChanged As AutoDownloader.PauseChangedEventHandler
+        Private Sub OnPauseChanged(ByVal Value As PauseModes)
+            RaiseEvent PauseChanged(Pause)
         End Sub
         Private ReadOnly Plans As List(Of AutoDownloader)
-        Private ReadOnly File As SFile = $"Settings\AutoDownload.xml"
+        Friend Const FileNameDefault As String = "AutoDownload"
+        Friend ReadOnly FileDefault As SFile = $"{SettingsFolderName}\{FileNameDefault}.xml"
+        Friend File As SFile = Nothing
         Private ReadOnly PlanWorking As Predicate(Of AutoDownloader) = Function(Plan) Plan.Working
         Private ReadOnly PlanDownloading As Predicate(Of AutoDownloader) = Function(Plan) Plan.Downloading
         Private ReadOnly PlansWaiter As Action(Of Predicate(Of AutoDownloader)) = Sub(ByVal Predicate As Predicate(Of AutoDownloader))
@@ -27,20 +29,9 @@ Namespace DownloadObjects
                                                                                   End Sub
         Friend Sub New()
             Plans = New List(Of AutoDownloader)
-            If File.Exists Then
-                Using x As New XmlFile(File,, False) With {.AllowSameNames = True}
-                    x.LoadData()
-                    If x.Contains(Name_Plan) Then
-                        For Each e In x : Plans.Add(New AutoDownloader(e)) : Next
-                    Else
-                        Plans.Add(New AutoDownloader(x))
-                    End If
-                End Using
-            End If
-            If Plans.Count > 0 Then Plans.ForEach(Sub(p)
-                                                      p.Source = Me
-                                                      AddHandler p.PauseDisabled, AddressOf OnPauseDisabled
-                                                  End Sub) : Plans.ListReindex
+            File = Settings.AutomationFile.Value.IfNullOrEmpty(FileDefault)
+            If Not File.Exists Then File = FileDefault
+            Reset(File, True)
         End Sub
         Default Friend ReadOnly Property Item(ByVal Index As Integer) As AutoDownloader Implements IMyEnumerator(Of AutoDownloader).MyEnumeratorObject
             Get
@@ -62,7 +53,7 @@ Namespace DownloadObjects
         End Function
         Friend Sub Add(ByVal Plan As AutoDownloader)
             Plan.Source = Me
-            AddHandler Plan.PauseDisabled, AddressOf OnPauseDisabled
+            AddHandler Plan.PauseChanged, AddressOf OnPauseChanged
             Plans.Add(Plan)
             Plans.ListReindex
             Update()
@@ -96,6 +87,39 @@ Namespace DownloadObjects
             Catch
             End Try
         End Sub
+        Friend Function Reset(ByVal f As SFile, ByVal IsInit As Boolean) As Boolean
+            If Plans.Count > 0 Then
+                If Not Plans.Exists(PlanWorking) Then
+                    Pause = PauseModes.Unlimited
+                    If Plans.Exists(PlanWorking) Then
+                        MsgBoxE({$"Some plans are already being worked.{vbCr}Wait for the plans to complete their work and try again.",
+                                 "Change scheduler"}, vbCritical)
+                        Pause = PauseModes.Unlimited
+                        Return False
+                    End If
+                End If
+                [Stop]()
+                If _UpdateRequired Then Update()
+                Plans.ListClearDispose(,, EDP.LogMessageValue)
+            End If
+            If f.Exists Then
+                File = f
+                Using x As New XmlFile(File,, False) With {.AllowSameNames = True}
+                    x.LoadData()
+                    If x.Contains(Name_Plan) Then
+                        For Each e In x : Plans.Add(New AutoDownloader(e)) : Next
+                    Else
+                        Plans.Add(New AutoDownloader(x))
+                    End If
+                End Using
+                If Plans.Count > 0 Then Plans.ForEach(Sub(ByVal p As AutoDownloader)
+                                                          p.Source = Me
+                                                          If Not IsInit Then p.Pause = PauseModes.Unlimited
+                                                          AddHandler p.PauseChanged, AddressOf OnPauseChanged
+                                                      End Sub) : Plans.ListReindex
+            End If
+            Return True
+        End Function
 #Region "Groups Support"
         Friend Sub GROUPS_Updated(ByVal Sender As DownloadGroup)
             If Count > 0 Then Plans.ForEach(Sub(p) p.GROUPS_Updated(Sender))

SCrawler/Download/Automation/SchedulerEditorForm.Designer.vb

@@ -63,7 +63,7 @@ Namespace DownloadObjects
             Me.KeyPreview = True
             Me.MinimumSize = New System.Drawing.Size(430, 380)
             Me.Name = "SchedulerEditorForm"
-            Me.ShowIcon = False
+            Me.ShowIcon = True
             Me.ShowInTaskbar = False
             Me.Text = "Scheduler"
             CONTAINER_MAIN.ContentPanel.ResumeLayout(False)

SCrawler/Download/Automation/SchedulerEditorForm.vb

@@ -8,11 +8,14 @@
 ' but WITHOUT ANY WARRANTY
 Imports PersonalUtilities.Forms
 Imports PersonalUtilities.Forms.Toolbars
+Imports PersonalUtilities.Tools
 Imports ECI = PersonalUtilities.Forms.Toolbars.EditToolbar.ControlItem
+Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
 Namespace DownloadObjects
     Friend Class SchedulerEditorForm
 #Region "Declarations"
         Private WithEvents MyDefs As DefaultFormOptions
+        Private WithEvents BTT_SETTINGS As ToolStripButton
         Private WithEvents BTT_CLONE As ToolStripButton
         Private ReadOnly MENU_SKIP As ToolStripDropDownButton
         Private WithEvents BTT_SKIP As ToolStripMenuItem
@@ -28,6 +31,13 @@ Namespace DownloadObjects
         Friend Sub New()
             InitializeComponent()
             MyDefs = New DefaultFormOptions(Me, Settings.Design)
+            BTT_SETTINGS = New ToolStripButton With {
+                .Text = String.Empty,
+                .AutoToolTip = True,
+                .ToolTipText = "Change scheduler",
+                .DisplayStyle = ToolStripItemDisplayStyle.Image,
+                .Image = My.Resources.ScriptPic_32
+            }
             BTT_CLONE = New ToolStripButton With {
                 .Text = "Clone",
                 .DisplayStyle = ToolStripItemDisplayStyle.ImageAndText,
@@ -89,13 +99,15 @@ Namespace DownloadObjects
             }
             PauseArr = New AutoDownloaderPauseButtons(AutoDownloaderPauseButtons.ButtonsPlace.Scheduler) With {
                        .MainFrameButtonsInstance = MainFrameObj.PauseButtons}
+            Icon = ImageRenderer.GetIcon(My.Resources.ScriptPic_32, EDP.ReturnValue)
         End Sub
 #End Region
 #Region "Form handlers"
         Private Sub SchedulerEditorForm_Load(sender As Object, e As EventArgs) Handles Me.Load
             With MyDefs
                 .MyViewInitialize()
-                .AddEditToolbar({ECI.Add, BTT_CLONE, ECI.Edit, ECI.Delete, ECI.Update, ECI.Separator, BTT_START, BTT_START_FORCE, MENU_SKIP, BTT_PAUSE})
+                .AddEditToolbar({BTT_SETTINGS, ECI.Separator, ECI.Add, BTT_CLONE, ECI.Edit, ECI.Delete, ECI.Update, ECI.Separator,
+                                 BTT_START, BTT_START_FORCE, MENU_SKIP, BTT_PAUSE})
                 PauseArr.AddButtons(BTT_PAUSE, .MyEditToolbar.ToolStrip)
                 Refill()
                 .EndLoaderOperations(False)
@@ -186,7 +198,80 @@ Namespace DownloadObjects
             Edit()
         End Sub
 #End Region
-#Region "Start, Skip, Pause"
+#Region "Settings, Start, Skip, Pause"
+        Private Sub BTT_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS.Click
+            Const msgTitle$ = "Change scheduler"
+            Try
+                Const defName$ = "Default"
+                Dim l As New Dictionary(Of SFile, String)
+                With SFile.GetFiles(SettingsFolderName.CSFileP, $"{Scheduler.FileNameDefault}*.xml",, EDP.ReturnValue)
+                    If .ListExists Then .ForEach(Sub(ff) l.Add(ff, ff.Name.Replace(Scheduler.FileNameDefault, String.Empty).StringTrimStart("_").IfNullOrEmpty(defName)))
+                End With
+                If l.Count > 0 Then
+                    Using chooser As New SimpleListForm(Of String)(l.Values.Cast(Of String), Settings.Design) With {
+                        .DesignXMLNodeName = "SchedulerChooserForm",
+                        .Icon = PersonalUtilities.Tools.ImageRenderer.GetIcon(My.Resources.ScriptPic_32, EDP.ReturnValue),
+                        .FormText = "Schedulers",
+                        .Mode = SimpleListFormModes.SelectedItems,
+                        .MultiSelect = False
+                    }
+                        With chooser
+                            Dim i%
+                            Dim f As SFile
+                            Dim selectedName$
+                            Dim addedObj$ = String.Empty
+                            .ClearButtons()
+                            .Buttons = {ADB.Add, ADB.Delete}
+                            AddHandler .AddClick, Sub(ByVal obj As Object, ByVal args As SimpleListFormEventArgs)
+                                                      If addedObj.IsEmptyString Then
+                                                          addedObj = InputBoxE("Enter a new scheduler name:", msgTitle)
+                                                          args.Result = Not addedObj.IsEmptyString
+                                                          If args.Result Then args.Item = addedObj
+                                                      Else
+                                                          MsgBoxE({"You can only create one scheduler at a time", "Create a new scheduler"}, vbCritical)
+                                                      End If
+                                                  End Sub
+                            If Settings.Automation.File.Name = Scheduler.FileNameDefault Then
+                                .DataSelectedIndexes.Add(0)
+                            Else
+                                i = l.Keys.ListIndexOf(Function(ff) ff = Settings.Automation.File)
+                                If i >= 0 Then .DataSelectedIndexes.Add(i)
+                            End If
+                            If .ShowDialog() = DialogResult.OK Then
+                                selectedName = .DataResult.FirstOrDefault
+                                If Not selectedName.IsEmptyString Then
+                                    If selectedName = defName Then
+                                        f = Settings.Automation.FileDefault
+                                    Else
+                                        f = $"{SettingsFolderName}\{Scheduler.FileNameDefault}_{selectedName.StringRemoveWinForbiddenSymbols}.xml"
+                                    End If
+                                    If Not Settings.Automation.File = f AndAlso Settings.Automation.Reset(f, False) Then
+                                        Settings.Automation.File = f
+                                        If selectedName = defName Then
+                                            Settings.AutomationFile.Value = Nothing
+                                        Else
+                                            Settings.AutomationFile.Value = f
+                                        End If
+                                        PauseArr.UpdatePauseButtons()
+                                        Refill()
+                                        If Not .DataSource.Count = l.Count Then
+                                            For i = l.Count - 1 To 0 Step -1
+                                                If Not .DataSource.Contains(l(l.Keys(i))) Then l.Keys(i).Delete(, SFODelete.DeleteToRecycleBin, EDP.SendToLog)
+                                            Next
+                                        End If
+                                    End If
+                                End If
+                            End If
+                        End With
+                    End Using
+                    l.Clear()
+                Else
+                    MsgBoxE({"There are no plans created", msgTitle}, vbExclamation)
+                End If
+            Catch ex As Exception
+                ErrorsDescriber.Execute(EDP.LogMessageValue, ex, msgTitle)
+            End Try
+        End Sub
         Private Sub BTT_START_Click(sender As Object, e As EventArgs) Handles BTT_START.Click
             If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
                 With Settings.Automation(_LatestSelected) : .Start(.IsNewPlan) : End With

SCrawler/Editors/UserCreatorForm.vb

@@ -120,6 +120,7 @@ Namespace Editors
         Private SpecialPathHandler As PathMoverHandler = Nothing
         Friend ReadOnly Property UserLabels As List(Of String)
         Private LabelsIncludeSpecial As Boolean = False
+        Private LabelsChanged As Boolean = False
 #End Region
 #Region "Initializers"
         ''' <summary>Create new user</summary>
@@ -327,6 +328,8 @@ Namespace Editors
                 FriendlyNameChanged = False
             Catch ex As Exception
                 MyDef.InvokeLoaderError(ex)
+            Finally
+                LabelsChanged = False
             End Try
         End Sub
         Private Sub UserCreatorForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
@@ -367,7 +370,7 @@ Namespace Editors
                             End If
                         End If
 
-                        If Not .Labels.ListEquals(UserLabels) Then _
+                        If LabelsChanged Then _
                            UserDataBase.UpdateLabels(.Self, UserLabels, 1,
                                                      Not DirectCast(.Self, UserDataBase).SpecialLabels.ListExists OrElse
                                                      UserDataBase.UpdateLabelsKeepSpecial(1))
@@ -596,7 +599,7 @@ CloseForm:
         Private Sub TXT_LABELS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_LABELS.ActionOnButtonClick
             Select Case Sender.DefaultButton
                 Case ADB.Open : ChangeLabels()
-                Case ADB.Clear : UserLabels.Clear()
+                Case ADB.Clear : UserLabels.Clear() : LabelsChanged = True
                 Case ADB.Refresh : UpdateSpecificLabels(False)
             End Select
         End Sub
@@ -784,8 +787,10 @@ CloseForm:
             Using fl As New LabelsForm(UserLabels)
                 fl.ShowDialog()
                 If fl.DialogResult = DialogResult.OK Then
+                    LabelsChanged = True
                     UserLabels.ListAddList(fl.LabelsList, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
                     If UserLabels.ListExists Then
+                        UserLabels.Sort()
                         TXT_LABELS.Text = UserLabels.ListToString
                     Else
                         TXT_LABELS.Clear()

SCrawler/GlobalSuppressions.vb

@@ -8,4 +8,5 @@ Imports System.Diagnostics.CodeAnalysis
 <Assembly: SuppressMessage("Style", "IDE0060:Remove unused parameter", Justification:="<Pending>", Scope:="member", Target:="~M:SCrawler.API.UserDataBind.DownloadData(System.Threading.CancellationToken,System.Boolean)")>
 <Assembly: SuppressMessage("Style", "IDE0044:Add readonly modifier", Justification:="<Pending>", Scope:="member", Target:="~F:SCrawler.MainFrame.DownloadQueue")>
 <Assembly: SuppressMessage("Style", "IDE0044:Add readonly modifier", Justification:="<Pending>", Scope:="member", Target:="~F:SCrawler.MainFrame.MyMissingPosts")>
-<Assembly: SuppressMessage("Style", "IDE0044:Add readonly modifier", Justification:="<Pending>", Scope:="member", Target:="~F:SCrawler.MainFrame.MyUserMetrics")>
+<Assembly: SuppressMessage("Style", "IDE0044:Add readonly modifier", Justification:="<Pending>", Scope:="member", Target:="~F:SCrawler.MainFrame.MyUserMetrics")>
+<Assembly: SuppressMessage("Style", "IDE0060:Remove unused parameter", Justification:="<Pending>", Scope:="member", Target:="~M:SCrawler.DownloadObjects.AutoDownloaderPauseButtons.UpdatePauseButtons_Handler(SCrawler.DownloadObjects.AutoDownloader.PauseModes)")>

SCrawler/MainFrame.vb

@@ -122,7 +122,7 @@ Public Class MainFrame
             .Automation = New Scheduler
             AddHandler .Groups.Updated, AddressOf .Automation.GROUPS_Updated
             AddHandler .Groups.Deleted, AddressOf .Automation.GROUPS_Deleted
-            AddHandler .Automation.PauseDisabled, AddressOf MainFrameObj.PauseButtons.UpdatePauseButtons
+            AddHandler .Automation.PauseChanged, AddressOf MainFrameObj.PauseButtons.UpdatePauseButtons_Handler
             If .Automation.Count > 0 Then .Labels.AddRange(.Automation.GetGroupsLabels, False) : .Labels.Update()
             _UFinit = False
             Await .Automation.Start(True)

SCrawler/My Project/AssemblyInfo.vb

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

SCrawler/PluginsEnvironment/Hosts/LogHost.vb

@@ -13,8 +13,8 @@ Namespace Plugin.Hosts
         End Sub
         Friend Sub Add(ByVal ex As Exception, ByVal Message As String,
                        Optional ByVal ShowMainMsg As Boolean = False, Optional ByVal ShowErrorMsg As Boolean = False,
-                       Optional ByVal SendInLog As Boolean = True) Implements ILogProvider.Add
-            ErrorsDescriber.Execute(New ErrorsDescriber(ShowMainMsg, ShowErrorMsg, SendInLog), ex, Message)
+                       Optional ByVal SendToLog As Boolean = True) Implements ILogProvider.Add
+            ErrorsDescriber.Execute(New ErrorsDescriber(ShowMainMsg, ShowErrorMsg, SendToLog), ex, Message)
         End Sub
     End Class
 End Namespace

SCrawler/PluginsEnvironment/Hosts/PluginHost.vb

@@ -79,6 +79,7 @@ Namespace Plugin.Hosts
                     New PluginHost(New API.Twitter.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
                     New PluginHost(New API.Mastodon.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
                     New PluginHost(New API.Instagram.SiteSettings(_XML, GlobalPath), _XML, GlobalPath, _Temp, _Imgs, _Vids),
+                    New PluginHost(New API.ThreadsNet.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
                     New PluginHost(New API.RedGifs.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
                     New PluginHost(New API.YouTube.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
                     New PluginHost(New API.Pinterest.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),

SCrawler/SCrawler.vbproj

@@ -223,6 +223,8 @@
     <Compile Include="API\ThisVid\SiteSettings.vb" />
     <Compile Include="API\ThisVid\UserData.vb" />
     <Compile Include="API\ThisVid\UserExchangeOptions.vb" />
+    <Compile Include="API\ThreadsNet\SiteSettings.vb" />
+    <Compile Include="API\ThreadsNet\UserData.vb" />
     <Compile Include="API\TikTok\Declarations.vb" />
     <Compile Include="API\TikTok\SiteSettings.vb" />
     <Compile Include="API\TikTok\UserData.vb" />
@@ -709,6 +711,9 @@
   <ItemGroup>
     <None Include="Content\Icons\SiteIcons\JFFIcon_64.ico" />
   </ItemGroup>
+  <ItemGroup>
+    <None Include="Content\Icons\SiteIcons\ThreadsIcon_192.ico" />
+  </ItemGroup>
   <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
   <Target Name="EnsureNuGetPackageBuildImports" BeforeTargets="PrepareForBuild">
     <PropertyGroup>

SCrawler/SettingsCLS.vb

@@ -130,6 +130,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
     Friend ReadOnly Property DownloadLocations As STDownloader.DownloadLocationsCollection
     Friend ReadOnly Property GlobalLocations As STDownloader.DownloadLocationsCollection
     Friend Property Automation As Scheduler
+    Friend ReadOnly Property AutomationFile As XMLValue(Of SFile)
     Friend ReadOnly Property BlackList As List(Of UserBan)
     Private ReadOnly BlackListFile As SFile = $"{SettingsFolderName}\BlackList.txt"
     Private ReadOnly UsersSettingsFile As SFile = $"{SettingsFolderName}\Users.xml"
@@ -170,6 +171,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
 
         SeparateVideoFolder = New XMLValue(Of Boolean)("SeparateVideoFolder", True, MyXML)
         CollectionsPath = New XMLValue(Of String)("CollectionsPath", CollectionsFolderName, MyXML)
+        AutomationFile = New XMLValue(Of SFile)("AutomationFile",, MyXML)
 
         UserAgent = New XMLValue(Of String)("UserAgent",, MyXML)
         If Not UserAgent.IsEmptyString Then DefaultUserAgent = UserAgent

SCrawler/SiteResources.Designer.vb

@@ -264,6 +264,16 @@ Namespace My.Resources
             End Get
         End Property
         
+        '''<summary>
+        '''  Looks up a localized resource of type System.Drawing.Icon similar to (Icon).
+        '''</summary>
+        Friend Shared ReadOnly Property ThreadsIcon_192() As System.Drawing.Icon
+            Get
+                Dim obj As Object = ResourceManager.GetObject("ThreadsIcon_192", resourceCulture)
+                Return CType(obj,System.Drawing.Icon)
+            End Get
+        End Property
+        
         '''<summary>
         '''  Looks up a localized resource of type System.Drawing.Icon similar to (Icon).
         '''</summary>

SCrawler/SiteResources.resx

@@ -178,6 +178,9 @@
   <data name="ThisVidPic_16" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>Content\Pictures\SitePictures\ThisVidPic_16.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
   </data>
+  <data name="ThreadsIcon_192" type="System.Resources.ResXFileRef, System.Windows.Forms">
+    <value>Content\Icons\SiteIcons\ThreadsIcon_192.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
+  </data>
   <data name="TikTokIcon_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
     <value>Content\Icons\SiteIcons\TikTokIcon_32.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
   </data>