2025.7.18.0

API.Instagram: fix special folder issue
API.OnlyFans: bypass unpurchased videos; add support for GIF files
API.Reddit: add OAuth credentials validation; add extended 429 error handling
API.Xhamster: remove 'UserOptions' function ('SiteSettings'); add support for downloading 'moments'
API.XVIDEOS: remove 'UserOptions' function ('SiteSettings'); remove 'UserExchangeOptions' class
Add 'EditorExchangeOptionsBase_P' and update base classes for user options

Changelog.md

@@ -1,3 +1,35 @@
+# 2025.7.18.0
+
+*2025-07-18*
+
+- Added
+  - Sites:
+    - OnlyFans:
+      - **bypass unpurchased videos**
+      - support for GIF files
+    - Reddit: extended `429` error handling
+    - Xhamster: support for downloading 'moments'
+  - Minor improvements
+- Updated
+  - yt-dlp up to version **2025.06.30**
+  - gallery-dl up to version **1.30.0**
+- Fixed
+  - Minor bugs
+
+# 2025.6.12.0
+
+*2025-06-12*
+
+- Updated
+  - yt-dlp up to version **2025.06.09**
+- Fixed
+  - Sites:
+    - YouTube: audio formats of protocol `m3u8` are not handled correctly
+    - BlueSky: data is not downloaded in some cases
+    - Reddit: new users do not inherit default text settings
+    - Saved posts: text downloading with saved posts
+  - Environment incorrect output
+
 # 2025.6.1.0
 
 *2025-06-01*

README.md

@@ -35,15 +35,15 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
 # What can program do:
 - Download pictures and videos from user profiles:
   - YouTube videos, shorts, community feeds, users, artists, playlists, music, tracks;
-  - Reddit images, galleries of images, videos, saved posts;
+  - Reddit images, galleries of images, videos, text, saved posts;
   - Redgifs images and videos (https://www.redgifs.com/);
-  - Twitter images and videos, saved (bookmarked) posts, likes, communities;
+  - Twitter images and videos, text, saved (bookmarked) posts, likes, communities;
-  - Bluesky images and videos;
+  - Bluesky images and videos, text;
-  - OnlyFans images and videos, saved (bookmarked) posts, stories;
+  - OnlyFans images and videos, text, saved (bookmarked) posts, stories;
   - JustForFans images and videos, saved (bookmarked) posts;
   - Mastodon images and videos, saved (bookmarked) posts;
-  - Instagram images and videos, tagged posts, stories, saved posts;
+  - Instagram images and videos, text, tagged posts, stories, saved posts;
-  - Threads images and videos, saved posts;
+  - Threads images and videos, text, saved posts;
   - Facebook images and videos, stories, saved posts;
   - TikTok images and videos;
   - Pinterest boards, users, saved posts;

SCrawler.YouTube/MainModShared.vb

@@ -10,6 +10,7 @@ Imports System.Threading
 Imports PersonalUtilities.Tools
 Imports PersonalUtilities.Tools.Web
 Imports PersonalUtilities.Functions.Messaging
+Imports PersonalUtilities.Functions.RegularExpressions
 Imports SCrawler.DownloadObjects.STDownloader
 Public Module MainModShared
     Public Property BATCH As BatchExecutor
@@ -135,9 +136,11 @@ Namespace Editors
         Public Shared Function GetProgramEnvirText(ByVal EnvirData As IDownloaderSettings, ByVal IsYouTube As Boolean) As String
             Try
                 Dim output$ = String.Empty
+                Dim verAfter As RParams = RParams.DM("\A\w\:\\.*", 0, EDP.ReturnValue)
                 Using b As New BatchExecutor(True)
                     Dim f As SFile
                     Dim cmd$, ff$, vText$
+                    Dim ii%
 
                     For i% = 0 To IIf(IsYouTube, 1, 3)
                         cmd = "--version"
@@ -154,7 +157,17 @@ Namespace Editors
                             Else
                                 b.Reset()
                                 b.Execute($"""{f}"" {cmd}", EDP.None)
-                                If b.OutputData.Count > 3 Then vText = b.OutputData(3) Else vText = "undefined"
+                                'If b.OutputData.Count > 3 Then vText = b.OutputData(3) Else vText = "undefined"
+
+                                vText = String.Empty
+                                With b.OutputData
+                                    If .Count > 0 Then
+                                        ii = .FindIndex(Function(bb) Not CStr(RegexReplace(bb, verAfter)).IsEmptyString)
+                                        If ii >= 0 And ii + 1 <= .Count - 1 Then vText = .Item(ii + 1)
+                                    End If
+                                End With
+                                If vText.IsEmptyString Then vText = "undefined"
+
                                 output.StringAppendLine($"{ff} version: {vText}")
                             End If
                         End If

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("2025.6.1.0")>
+<Assembly: AssemblyVersion("2025.6.12.0")>
-<Assembly: AssemblyFileVersion("2025.6.1.0")>
+<Assembly: AssemblyFileVersion("2025.6.12.0")>
 <Assembly: NeutralResourcesLanguage("en")>

SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb

@@ -738,6 +738,7 @@ Namespace API.YouTube.Objects
 #Region "Command"
         <XMLEC> Public Property UseCookies As Boolean = MyYouTubeSettings.DefaultUseCookies Implements IYouTubeMediaContainer.UseCookies
         Protected Const mp3 As String = "mp3"
+        Private Const mp4 As String = "mp4"
         Private Const aac As String = "aac"
         Private Const ac3 As String = "ac3"
         Protected PostProcessing_AudioAC3 As Boolean = False
@@ -773,7 +774,12 @@ Namespace API.YouTube.Objects
                         '2023.3.4 -> 2023.7.6
                         'cmd.StringAppend($"ba*[format_id={SelectedAudio.ID}]", "+")
                         cmd.StringAppend(SelectedAudio.ID, "+")
-                        If OutputAudioCodec.StringToLower = ac3 Then
+                        If SelectedVideoIndex >= 0 And SelectedAudio.ProtocolType = Protocols.m3u8 And
+                           (SelectedAudio.Codec.StringToLower = mp4 Or OutputAudioCodec.StringToLower = mp4) Then
+                            PostProcessing_AudioAC3 = True
+                            formats.StringAppend($"--merge-output-format ""{mp4}{IIf(OutputVideoExtension.IsEmptyString, String.Empty, $"/{OutputVideoExtension.StringToLower}")}""", " ")
+                            atCodec = aac
+                        ElseIf OutputAudioCodec.StringToLower = ac3 Then
                             PostProcessing_AudioAC3 = True
                             formats.StringAppend($"--audio-format {aac}", " ")
                             atCodec = aac
@@ -1753,9 +1759,12 @@ Namespace API.YouTube.Objects
             If If(e({"formats"})?.Count, 0) > 0 Then
                 Dim obj As MediaObject
                 Dim nValue#
-                Dim sValue$
+                Dim sValue$ = String.Empty
                 Dim allowWebm As Boolean = MyYouTubeSettings.DefaultVideoAllowWebm
-                Dim validCodecValue As Func(Of String, Boolean) = Function(codec) Not codec.IsEmptyString AndAlso Not codec = "none"
+                Dim validCodecValue As Func(Of String, Boolean) = Function(ByVal codec As String) As Boolean
+                                                                      sValue = codec
+                                                                      Return Not codec.IsEmptyString AndAlso Not codec = "none"
+                                                                  End Function
 
                 For Each ee In e({"formats"})
                     obj = New MediaObject With {
@@ -1779,19 +1788,30 @@ Namespace API.YouTube.Objects
                     If obj.Size <= 0 And obj.Bitrate > 0 And Duration.TotalSeconds > 0 Then _
                        obj.Size = (obj.Bitrate / 8 * Duration.TotalSeconds).RoundVal(2)
 
-                    sValue = ee.Value("vcodec")
+                    'sValue = ee.Value("vcodec")
-                    If validCodecValue(sValue) Then
+                    If validCodecValue(ee.Value("vcodec")) Then
                         obj.Type = UMTypes.Video
                         obj.Codec = sValue.Split(".").First
                         If validCodecValue(ee.Value("acodec")) Then obj.Type = av
-                    Else
+                    ElseIf validCodecValue(ee.Value("acodec")) Then
-                        sValue = ee.Value("acodec")
-                        If validCodecValue(sValue) Then
                         obj.Type = UMTypes.Audio
                         obj.Codec = sValue.Split(".").First
                     Else
-                            Continue For
+                        Dim fd As Boolean = False
+                        sValue = ee.Value("format_note")
+                        If Not sValue.IsEmptyString Then
+                            With ListAddList(Nothing, sValue.Split(","), CType(Function(v) CStr(v).StringToLower.StringTrim, Func(Of Object, Object)), EDP.ReturnValue)
+                                If .ListContains({"high", "low"}) Then
+                                    obj.Type = UMTypes.Audio
+                                    obj.Codec = ee.Value("ext")
+                                    If obj.Protocol.StringToLower.StartsWith("m3u8") Then obj.Protocol = "m3u8"
+                                    If obj.Bitrate <= 0 Then obj.Bitrate = IIf(.Contains("high"), 129, 53)
+                                    If obj.Size <= 0 Then obj.Size = 1
+                                    fd = True
                                 End If
+                            End With
+                        End If
+                        If Not fd Then Continue For
                     End If
                     MediaObjects.Add(obj)
                 Next
@@ -1803,8 +1823,9 @@ Namespace API.YouTube.Objects
                         Dim data As New List(Of MediaObject)(MediaObjects.Where(Function(mo) mo.Type = t And mo.Extension = webm))
                         If data.Count > 0 Then
                             Dim d As MediaObject = Nothing
-                            Dim expWebm As Predicate(Of MediaObject) = Function(mo) mo.Extension = webm
+                            Dim allWebm As Boolean = False, allAVC As Boolean = False
-                            Dim expAVC As Predicate(Of MediaObject) = Function(mo) mo.Codec.IfNullOrEmpty("/").ToLower.StartsWith(avc)
+                            Dim expWebm As Predicate(Of MediaObject) = Function(mo) Not allWebm And mo.Extension = webm
+                            Dim expAVC As Predicate(Of MediaObject) = Function(mo) Not allAVC And mo.Codec.IfNullOrEmpty("/").ToLower.StartsWith(avc)
                             Dim comp As Func(Of MediaObject, Predicate(Of MediaObject), Boolean, Boolean, Boolean) =
                                 Function(mo, exp, isTrue, checkHttp) mo.Type = t And exp.Invoke(mo) = isTrue And mo.Width = d.Width And
                                                                      (Not checkHttp OrElse mo.ProtocolType = Protocols.https)
@@ -1812,6 +1833,8 @@ Namespace API.YouTube.Objects
                             Dim RemoveWebm As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expWebm, True, allowWebm)
                             Dim CountAVC As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expAVC, True, False)
                             Dim RemoveAVC As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expAVC, False, False)
+                            allWebm = data.All(FPredicate(Of MediaObject).ToFunc(expWebm))
+                            allAVC = data.All(FPredicate(Of MediaObject).ToFunc(expAVC))
                             For Each d In data
                                 If MediaObjects.Count = 0 Then Exit For
                                 If MediaObjects.LongCount(CountWebm) > 0 Then MediaObjects.RemoveAll(RemoveWebm)

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("2025.6.1.0")>
+<Assembly: AssemblyVersion("2025.6.12.0")>
-<Assembly: AssemblyFileVersion("2025.6.1.0")>
+<Assembly: AssemblyFileVersion("2025.6.12.0")>
 <Assembly: NeutralResourcesLanguage("en")>

SCrawler/API/Base/EditorExchangeOptionsBase_P.vb

@@ -0,0 +1,43 @@
+' Copyright (C) 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.Plugin.Attributes
+Namespace API.Base
+    Friend Interface IPSite
+        Property QueryString As String
+    End Interface
+    Friend Class EditorExchangeOptionsBase_P : Inherits EditorExchangeOptionsBase : Implements IPSite
+        <PSetting(Address:=SettingAddress.None)> Friend Overrides Property UserName As String
+        <PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadText As Boolean
+        <PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadTextPosts As Boolean
+        <PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadTextSpecialFolder As Boolean
+        <PSetting(Address:=SettingAddress.User, Caption:="Query",
+                  ToolTip:="Query string. Don't change this field when creating a user! Change it only for the same request.")>
+        Friend Property QueryString As String Implements IPSite.QueryString
+        Friend Sub New()
+            DisableBase()
+        End Sub
+        Friend Sub New(ByVal u As UserDataBase)
+            MyBase.New(u)
+            DisableBase()
+            If TypeOf u Is IPSite Then QueryString = DirectCast(u, IPSite).QueryString
+        End Sub
+        Friend Sub New(ByVal s As SiteSettingsBase)
+            MyBase.New(s)
+            DisableBase()
+        End Sub
+        Friend Overridable Sub Apply(ByRef u As IPSite)
+            ApplyBase(u)
+            u.QueryString = QueryString
+        End Sub
+        Protected Overridable Sub DisableBase()
+            _ApplyBase_Name = False
+            _ApplyBase_Text = False
+        End Sub
+    End Class
+End Namespace

SCrawler/API/Base/UserDataBase.vb

@@ -252,7 +252,20 @@ Namespace API.Base
 #End Region
 #Region "User name, ID, exist, suspend, options"
         Friend User As UserInfo
+        Private _IsSavedPosts As Boolean = False
         Friend Property IsSavedPosts As Boolean Implements IPluginContentProvider.IsSavedPosts
+            Get
+                Return _IsSavedPosts
+            End Get
+            Set(ByVal __IsSavedPosts As Boolean)
+                _IsSavedPosts = __IsSavedPosts
+                If _IsSavedPosts Then
+                    DownloadText = True
+                    DownloadTextPosts = True
+                    DownloadTextSpecialFolder = True
+                End If
+            End Set
+        End Property
         Private _UserExists As Boolean = True
         Friend Overridable Property UserExists As Boolean Implements IUserData.Exists, IPluginContentProvider.UserExists
             Get
@@ -300,7 +313,16 @@ Namespace API.Base
                 Return If(Exact, _NameTrue, _NameTrue.IfNullOrEmpty(Name))
             End Get
         End Property
-        Friend Overridable Property ID As String = String.Empty Implements IUserData.ID, IPluginContentProvider.ID
+        Private _ID As String = String.Empty
+        Friend Property ID As String Implements IUserData.ID, IPluginContentProvider.ID
+            Get
+                Return _ID
+            End Get
+            Set(ByVal NewId As String)
+                If Not _ID = NewId Then EnvirChanged(NewId)
+                _ID = NewId
+            End Set
+        End Property
         Protected _FriendlyName As String = String.Empty
         Friend Overridable Property FriendlyName As String Implements IUserData.FriendlyName
             Get
@@ -985,8 +1007,8 @@ BlockNullPicture:
                         ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
                         DownloadImages = x.Value(Name_DownloadImages).FromXML(Of Boolean)(True)
                         DownloadVideos = x.Value(Name_DownloadVideos).FromXML(Of Boolean)(True)
-                        DownloadText = x.Value(Name_DownloadText).FromXML(Of Boolean)(False)
+                        DownloadText = x.Value(Name_DownloadText).FromXML(Of Boolean)(IsSavedPosts)
-                        DownloadTextPosts = x.Value(Name_DownloadTextPosts).FromXML(Of Boolean)(False)
+                        DownloadTextPosts = x.Value(Name_DownloadTextPosts).FromXML(Of Boolean)(IsSavedPosts)
                         DownloadTextSpecialFolder = x.Value(Name_DownloadTextSpecialFolder).FromXML(Of Boolean)(True)
                         _IconBannerDownloaded = x.Value(Name_IconBannerDownloaded).FromXML(Of Boolean)(False)
                         DownloadedVideos(True) = x.Value(Name_VideoCount).FromXML(Of Integer)(0)
@@ -1222,7 +1244,8 @@ BlockNullPicture:
                 Select Case Caller
                     Case NameOf(UserExists) : If Not _EnvirUserExists = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
                     Case NameOf(UserSuspended) : If Not _EnvirUserSuspended = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
-                    Case NameOf(NameTrue) : _EnvirChanged = True : _EnvirInvokeUserUpdated = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True
+                    Case NameOf(NameTrue) : _EnvirChanged = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True
+                    Case NameOf(ID) : _EnvirChanged = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True
                     Case Else : _EnvirChanged = True
                 End Select
             End If
@@ -2265,6 +2288,7 @@ stxt:
         End Function
 #End Region
 #Region "Errors functions"
+        ''' <summary>ToStringForLog(): Message</summary>
         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

SCrawler/API/Bluesky/UserData.vb

@@ -27,6 +27,7 @@ Namespace API.Bluesky
                 Return If(ID.IsEmptyString, String.Empty, SymbolsConverter.ASCII.EncodeSymbolsOnly(ID))
             End Get
         End Property
+        Private ReadOnly _TmpPosts2 As List(Of String)
 #End Region
 #Region "Loader"
         Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
@@ -42,6 +43,7 @@ Namespace API.Bluesky
 #Region "Initializer"
         Friend Sub New()
             UseInternalM3U8Function = True
+            _TmpPosts2 = New List(Of String)
         End Sub
 #End Region
 #Region "Token"
@@ -62,11 +64,17 @@ Namespace API.Bluesky
 #Region "Download"
         Private _PostCount As Integer = 0
         Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
+            _TmpPosts2.Clear()
+            Try
                 If Not CBool(MySettings.CookiesEnabled.Value) Then Responser.Cookies.Clear()
                 UpdateToken(, True)
                 _TokenUpdateCount = 0
                 _PostCount = 0
                 DownloadData(String.Empty, Token)
+            Finally
+                _TempPostsList.ListAddList(_TmpPosts2, LNC)
+                _TmpPosts2.Clear()
+            End Try
         End Sub
         Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
             Dim URL$ = String.Empty
@@ -117,7 +125,8 @@ Namespace API.Bluesky
         Private Function DefaultParser(ByVal e As EContainer, Optional ByVal CheckDateLimits As Boolean = True, Optional ByRef NextCursor As String = Nothing,
                                        Optional ByVal CheckTempPosts As Boolean = True, Optional ByVal State As UStates = UStates.Unknown) As Integer
             Const exitReturn% = CInt(DateResult.Exit) * -1
-            Dim postID$, postDate$, __url$, __urlBase$, __txt$
+            Const skipReturn% = CInt(DateResult.Skip) * -1
+            Dim postID$, postDate$, __url$, __urlBase$, __txt$, __userId$
             Dim updateUrl As Boolean
             Dim c% = 0
             Dim m As UserMedia
@@ -128,6 +137,7 @@ Namespace API.Bluesky
                     postDate = String.Empty
                     __urlBase = String.Empty
                     __txt = String.Empty
+                    __userId = .Value({"author"}, "did")
                     With .Item({"record"})
                         If .ListExists Then
                             '2025-01-28T02:42:12.415Z
@@ -135,14 +145,18 @@ Namespace API.Bluesky
                             NextCursor = postDate
                             If CheckDateLimits Then
                                 Select Case CheckDatesLimit(postDate, DateProvider)
-                                    Case DateResult.Skip : Return CInt(DateResult.Skip) * -1 'Continue For
+                                    Case DateResult.Skip : Return skipReturn 'Continue For
                                     Case DateResult.Exit : Return exitReturn 'Exit Sub
                                 End Select
                             End If
 
                             If CheckTempPosts Then
-                                If _TempPostsList.Contains(postID) Then Return exitReturn Else _TempPostsList.Add(postID)
+                                'If _TempPostsList.Contains(postID) Then Return exitReturn Else _TempPostsList.Add(postID)
+                                If _TempPostsList.Contains(postID) Then Return exitReturn Else _TmpPosts2.Add(postID)
                             End If
+
+                            If ParseUserMediaOnly And Not ID.IsEmptyString And Not __userId.IsEmptyString And Not ID = __userId Then Return skipReturn
+
                             __urlBase = $"https://bsky.app/profile/{NameTrue}/post/{postID}"
                         End If
                     End With
@@ -338,6 +352,12 @@ Namespace API.Bluesky
                 Return 0
             End If
         End Function
+#End Region
+#Region "IDisposable Support"
+        Protected Overrides Sub Dispose(ByVal disposing As Boolean)
+            If disposing Then _TmpPosts2.Clear()
+            MyBase.Dispose(disposing)
+        End Sub
 #End Region
     End Class
 End Namespace

SCrawler/API/Facebook/UserData.vb

@@ -676,10 +676,7 @@ Namespace API.Facebook
                     End If
                     Token_Photosby = RegexReplace(r, Regex_Photos_by)
                     If StoryBucket.IsEmptyString Then StoryBucket = RegexReplace(r, Regex_StoryBucket)
-                    If ID.IsEmptyString Then
+                    If ID.IsEmptyString Then ID = RegexReplace(r, Regex_UserID)
-                        ID = RegexReplace(r, Regex_UserID)
-                        If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
-                    End If
                 End If
             Catch ex As Exception
                 ProcessException(ex, Token, "get user token",, resp)

SCrawler/API/Instagram/UserData.vb

@@ -1151,12 +1151,30 @@ NextPageBlock:
                     If TryExtractImage Then
                         t = 1
                         abstractDecision = True
-                        If Not SpecialFolder.IsEmptyString AndAlso PutImageVideoFolder Then
+                        Dim endsAbs As Boolean
-                            Dim endsAbs As Boolean = SpecialFolder.EndsWith("*")
+                        Dim newFolderName$
-                            If endsAbs Then SpecialFolder = SpecialFolder.TrimEnd("*")
+                        If PutImageVideoFolder Then
-                            If Not SpecialFolder.IsEmptyString Then SpecialFolder = $"{SpecialFolder.TrimEnd("\")}\{VideoFolderName}{IIf(Not endsAbs, "*", String.Empty)}"
+                            If SpecialFolder.IsEmptyString Then
-                            If endsAbs Then SpecialFolder &= "*"
+                                newFolderName = $"{VideoFolderName}\*"
+                            Else
+                                endsAbs = SpecialFolder.EndsWith("*")
+                                SpecialFolder = SpecialFolder.TrimEnd({CChar("\"), CChar("*")})
+                                If Not endsAbs Then SpecialFolder = $"{SpecialFolder}\{VideoFolderName}"
+                                newFolderName = $"{SpecialFolder}*"
                             End If
+                            'Dim endsAbs As Boolean = SpecialFolder.EndsWith("*")
+                            'If endsAbs Then SpecialFolder = SpecialFolder.TrimEnd("*")
+                            'If Not SpecialFolder.IsEmptyString Then SpecialFolder = $"{SpecialFolder.TrimEnd("\")}\{VideoFolderName}{IIf(Not endsAbs, "*", String.Empty)}"
+                            'If endsAbs Then SpecialFolder &= "*"
+                        ElseIf Not SpecialFolder.IsEmptyString Then
+                            endsAbs = SpecialFolder.EndsWith("*")
+                            SpecialFolder = SpecialFolder.TrimEnd({CChar("\"), CChar("*")})
+                            If endsAbs Then SpecialFolder = $"{SpecialFolder}\Photos"
+                            newFolderName = $"{SpecialFolder}*"
+                        Else
+                            newFolderName = SpecialFolder
+                        End If
+                        SpecialFolder = newFolderName
                     ElseIf t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then
                         If n.Contains(vid) Then
                             t = 2
@@ -1234,7 +1252,6 @@ NextPageBlock:
                         If Not j Is Nothing AndAlso j.Contains({"data", "user"}) Then
                             With j({"data", "user"})
                                 ID = .Value("id")
-                                _ForceSaveUserData = True
                                 __idFound = True
                                 UserSiteNameUpdate(.Value("full_name"))
                                 Dim descr$ = .Value("biography")

SCrawler/API/OnlyFans/UserData.vb

@@ -116,6 +116,7 @@ Namespace API.OnlyFans
                         If MediaDownloadHighlights And FunctionErr = FunctionErrDef Then DownloadHighlights(Token)
                         If MediaDownloadChatMedia And FunctionErr = FunctionErrDef Then DownloadChatMedia(0, Token)
                     End If
+                    If _TempMediaList.Count > 0 And Not _NameUpdated Then GetUserID(True)
                 End If
             Finally
                 Responser_ResponseReceived_RemoveHandler()
@@ -430,7 +431,7 @@ Namespace API.OnlyFans
             Result = False
             With n("media")
                 If .ListExists Then
-                    For Each m In .Self
+                    For Each m As EContainer In .Self
                         postUrl = GetMediaURL(m)
                         'If IsHL Then
                         '    'postUrl = m.Value({"files", "source"}, "url")
@@ -439,10 +440,11 @@ Namespace API.OnlyFans
                         '    'postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
                         '    postUrl = GetMediaURL(m)
                         'End If
+                        If m.Value("canView").FromXML(Of Boolean)(True) Then
                             postUrlBase = String.Empty
                             Select Case m.Value("type")
                                 Case "photo" : t = UTypes.Picture : ext = "jpg"
-                            Case "video"
+                                Case "video", "gif"
                                     t = UTypes.Video
                                     ext = "mp4"
                                     If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then
@@ -466,6 +468,7 @@ Namespace API.OnlyFans
                                 Result = True
                                 mList.Add(media)
                             End If
+                        End If
                     Next
                 End If
             End With
@@ -486,7 +489,6 @@ Namespace API.OnlyFans
                                 _NameUpdated = True
                                 If UpdateNameOnly Then Exit Sub
                                 ID = j.Value("id")
-                                If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
                                 UserSiteNameUpdate(j.Value("name"))
                                 Dim descr$ = j.Value("about")
                                 If Not descr.IsEmptyString Then descr = descr.Replace(brTag, String.Empty)

SCrawler/API/PornHub/UserData.vb

@@ -15,7 +15,7 @@ Imports PersonalUtilities.Tools.Web.Clients
 Imports PersonalUtilities.Tools.Web.Documents.JSON
 Imports UTypes = SCrawler.API.Base.UserMedia.Types
 Namespace API.PornHub
-    Friend Class UserData : Inherits UserDataBase
+    Friend Class UserData : Inherits UserDataBase : Implements IPSite
         Private Const UrlPattern As String = "https://www.pornhub.com/{0}"
 #Region "Declarations"
 #Region "XML names"
@@ -140,7 +140,7 @@ Namespace API.PornHub
             End Get
         End Property
         Friend Property SiteMode As SiteModes = SiteModes.User
-        Friend Property QueryString As String
+        Friend Property QueryString As String Implements IPSite.QueryString
             Get
                 If IsUser Then
                     Return String.Empty
@@ -163,17 +163,7 @@ Namespace API.PornHub
             Return New UserExchangeOptions(Me)
         End Function
         Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
-            If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
+            If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
-                With DirectCast(Obj, UserExchangeOptions)
-                    DownloadUHD = .DownloadUHD
-                    DownloadUploaded = .DownloadUploaded
-                    DownloadTagged = .DownloadTagged
-                    DownloadPrivate = .DownloadPrivate
-                    DownloadFavorite = .DownloadFavorite
-                    DownloadGifs = .DownloadGifs
-                    QueryString = .QueryString
-                End With
-            End If
         End Sub
 #End Region
         Private ReadOnly Property MySettings As SiteSettings

SCrawler/API/PornHub/UserExchangeOptions.vb

@@ -6,9 +6,10 @@
 '
 ' This program is distributed in the hope that it will be useful,
 ' but WITHOUT ANY WARRANTY
+Imports SCrawler.API.Base
 Imports SCrawler.Plugin.Attributes
 Namespace API.PornHub
-    Friend Class UserExchangeOptions : Inherits Xhamster.UserExchangeOptions
+    Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase_P
         <PSetting(NameOf(SiteSettings.DownloadUHD), NameOf(MySettings))>
         Friend Property DownloadUHD As Boolean
         <PSetting(NameOf(SiteSettings.DownloadUploaded), NameOf(MySettings))>
@@ -23,16 +24,17 @@ Namespace API.PornHub
         Friend Property DownloadGifs As Boolean
         Private ReadOnly Property MySettings As SiteSettings
         Friend Sub New(ByVal u As UserData)
+            MyBase.New(u)
             DownloadUHD = u.DownloadUHD
             DownloadUploaded = u.DownloadUploaded
             DownloadTagged = u.DownloadTagged
             DownloadPrivate = u.DownloadPrivate
             DownloadFavorite = u.DownloadFavorite
             DownloadGifs = u.DownloadGifs
-            QueryString = u.QueryString
             MySettings = u.HOST.Source
         End Sub
         Friend Sub New(ByVal s As SiteSettings)
+            MyBase.New(s)
             Dim v As CheckState = CInt(s.DownloadGifs.Value)
             DownloadUHD = s.DownloadUHD.Value
             DownloadUploaded = s.DownloadUploaded.Value
@@ -42,5 +44,16 @@ Namespace API.PornHub
             DownloadGifs = Not v = CheckState.Unchecked
             MySettings = s
         End Sub
+        Friend Overrides Sub Apply(ByRef u As IPSite)
+            MyBase.Apply(u)
+            With DirectCast(u, UserData)
+                .DownloadUHD = DownloadUHD
+                .DownloadUploaded = DownloadUploaded
+                .DownloadTagged = DownloadTagged
+                .DownloadPrivate = DownloadPrivate
+                .DownloadFavorite = DownloadFavorite
+                .DownloadGifs = DownloadGifs
+            End With
+        End Sub
     End Class
 End Namespace

SCrawler/API/Reddit/IRedditView.vb

@@ -32,22 +32,26 @@ Namespace API.Reddit
         Property RedditAccount As String
         Sub SetView(ByVal Options As IRedditView)
     End Interface
-    Friend Class RedditViewExchange : Implements IRedditView
+    Friend Class RedditViewExchange : Inherits Base.EditorExchangeOptionsBase : Implements IRedditView
         Friend Const Name_ViewMode As String = "ViewMode"
         Friend Const Name_ViewPeriod As String = "ViewPeriod"
         Friend Const Name_RedGifsAccount As String = "RedGifsAccount"
         Friend Const Name_RedditAccount As String = "RedditAccount"
         Friend Property ViewMode As IRedditView.View Implements IRedditView.ViewMode
         Friend Property ViewPeriod As IRedditView.Period Implements IRedditView.ViewPeriod
-        Friend Property DownloadText As Boolean Implements IRedditView.DownloadText
+        Friend Overrides Property DownloadText As Boolean Implements IRedditView.DownloadText
-        Friend Property DownloadTextPosts As Boolean Implements IRedditView.DownloadTextPosts
+        Friend Overrides Property DownloadTextPosts As Boolean Implements IRedditView.DownloadTextPosts
-        Friend Property DownloadTextSpecialFolder As Boolean Implements IRedditView.DownloadTextSpecialFolder
+        Friend Overrides Property DownloadTextSpecialFolder As Boolean Implements IRedditView.DownloadTextSpecialFolder
         Friend Property RedGifsAccount As String Implements IRedditView.RedGifsAccount
         Friend Property RedditAccount As String Implements IRedditView.RedditAccount
-        Friend Sub New()
-        End Sub
         Friend Sub New(ByVal Options As IRedditView)
+            MyBase.New(DirectCast(Options, UserData))
             SetView(Options)
+            _ApplyBase_Name = False
+        End Sub
+        Friend Sub New(ByVal s As SiteSettings)
+            MyBase.New(s)
+            _ApplyBase_Name = False
         End Sub
         Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView
             If Not Options Is Nothing Then

SCrawler/API/Reddit/SiteSettings.vb

@@ -9,6 +9,7 @@
 Imports SCrawler.API.Base
 Imports SCrawler.Plugin
 Imports SCrawler.Plugin.Attributes
+Imports System.Reflection
 Imports PersonalUtilities.Tools.Web.Clients
 Imports PersonalUtilities.Tools.Web.Clients.Base
 Imports PersonalUtilities.Tools.Web.Documents.JSON
@@ -58,6 +59,48 @@ Namespace API.Reddit
                 Return {AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString)
             End Get
         End Property
+        <PropertiesDataChecker({NameOf(AuthUserName), NameOf(AuthPassword), NameOf(ApiClientID), NameOf(ApiClientSecret),
+                                NameOf(UseTokenForTimelines), NameOf(UseCookiesForTimelines)})>
+        Private Function OAuthCredentialsChecker(ByVal p As IEnumerable(Of PropertyData)) As Boolean
+            Const msgTitle$ = "OAuth credentials"
+            If p.ListExists Then
+                Dim useToken As Boolean = False, useCookies As Boolean = False
+                Dim d$ = String.Empty
+                Dim dCount As Byte = 0
+                Dim members As IEnumerable(Of MemberInfo) = GetObjectMembers(Me)
+                Dim getPropText As Func(Of String, String) = Function(name) members.First(Function(m) m.Name = name).GetCustomAttribute(Of PropertyOption).ControlText
+                Dim dataStr As Action(Of String, String) = Sub(dd, name) If dd.IsEmptyString Then d.StringAppendLine(getPropText(name)) : dCount += 1
+                For Each pp As PropertyData In p
+                    Select Case pp.Name
+                        Case NameOf(AuthUserName) : dataStr(pp.Value, NameOf(AuthUserName))
+                        Case NameOf(AuthPassword) : dataStr(pp.Value, NameOf(AuthPassword))
+                        Case NameOf(ApiClientID) : dataStr(pp.Value, NameOf(ApiClientID))
+                        Case NameOf(ApiClientSecret) : dataStr(pp.Value, NameOf(ApiClientSecret))
+                        Case NameOf(UseTokenForTimelines) : useToken = pp.Value
+                        Case NameOf(UseCookiesForTimelines) : useCookies = pp.Value
+                        Case Else : Throw New ArgumentException($"Property name '{pp.Name}' is not implemented", "Property Name")
+                    End Select
+                Next
+                If d.IsEmptyString Then
+                    If useToken And useCookies Then
+                        Return True
+                    Else
+                        If Not useToken Then d.StringAppendLine(getPropText(NameOf(UseTokenForTimelines)))
+                        If Not useCookies Then d.StringAppendLine(getPropText(NameOf(UseCookiesForTimelines)))
+                        MsgBoxE({$"You need to check the following options:{vbCr}{d}", msgTitle}, vbCritical)
+                        Return False
+                    End If
+                ElseIf dCount = 4 Then
+                    Return MsgBoxE({$"You haven't configured OAuth. It's highly recommended to use OAuth.{vbCr}Do you still want to continue?", msgTitle},
+                                   vbExclamation,,, {"Process", "Cancel"}) = 0
+                Else
+                    MsgBoxE({$"You haven't filled in the following fields:{vbCr}{d}.{vbCr}{vbCr}" &
+                            "To use OAuth authorization, you must fill in all authorization fields.", msgTitle}, vbCritical)
+                    Return False
+                End If
+            End If
+            Return True
+        End Function
 #End Region
 #Region "Other"
         <PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML, PClonable>
@@ -212,7 +255,7 @@ Namespace API.Reddit
 #End Region
 #Region "UserOptions"
         Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
-            If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange
+            If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange(Me)
             If OpenForm Then
                 Using f As New RedditViewSettingsForm(Options, True) : f.ShowDialog() : End Using
             End If
@@ -233,23 +276,6 @@ Namespace API.Reddit
         End Sub
 #End Region
 #Region "Token"
-        <PropertiesDataChecker({NameOf(AuthUserName), NameOf(AuthPassword), NameOf(ApiClientID), NameOf(ApiClientSecret)})>
-        Private Function TokenPropertiesChecker(ByVal p As IEnumerable(Of PropertyData)) As Boolean
-            If p.ListExists Then
-                Dim wrong As New List(Of String)
-                For i% = 0 To p.Count - 1
-                    If CStr(p(i).Value).IsEmptyString Then wrong.Add(p(i).Name)
-                Next
-                If wrong.Count > 0 And wrong.Count <> 4 Then
-                    MsgBoxE({$"You have not completed the following fields: {wrong.ListToString}." & vbCr &
-                            "To use OAuth authorization, all authorization fields must be filled in.", "Validate token fields"}, vbCritical)
-                    Return False
-                Else
-                    Return True
-                End If
-            End If
-            Return False
-        End Function
         Private Function UpdateTokenIfRequired() As Boolean
             UpdateRedGifsToken()
             If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso CredentialsExists Then

SCrawler/API/Reddit/UserData.vb

@@ -135,6 +135,7 @@ Namespace API.Reddit
                     DownloadTextSpecialFolder = .DownloadTextSpecialFolder
                     RedGifsAccount = .RedGifsAccount
                     RedditAccount = .RedditAccount
+                    If TypeOf Options Is RedditViewExchange Then DirectCast(Options, RedditViewExchange).ApplyBase(Me)
                 End With
             End If
         End Sub
@@ -1089,25 +1090,28 @@ Namespace API.Reddit
                 ElseIf .StatusCode = HttpStatusCode.Forbidden Then '403
                     UserSuspended = True
                 ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then '502, 503
-                    MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] Reddit is currently unavailable"
+                    LogError(Nothing, $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable")
                     Throw New Plugin.ExitException With {.Silent = True}
                 ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then '504
                     Return 1
                 ElseIf .StatusCode = HttpStatusCode.Unauthorized Then '401
-                    MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] Reddit credentials expired"
+                    LogError(Nothing, $"[{CInt(Responser.StatusCode)}] Reddit credentials expired")
                     MySiteSettings.SessionInterrupted = True
                     Throw New Plugin.ExitException With {.Silent = True}
                 ElseIf .StatusCode = HttpStatusCode.InternalServerError Then '500
                     If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1
                     Return HttpStatusCode.InternalServerError
-                ElseIf .StatusCode = 429 And IsSavedPosts And Err429Count = 0 Then
+                ElseIf .StatusCode = 429 And IsSavedPosts And Err429Count = 0 Then '429 (saved)
                     Err429Count += 1
                     Return 429
-                ElseIf .StatusCode = 429 AndAlso
+                ElseIf .StatusCode = 429 Then '429 (all)
-                       ((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso
+                    If ((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso
-                       Not MySiteSettings.CredentialsExists Then '429
+                       Not MySiteSettings.CredentialsExists Then
-                    MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] You should use OAuth authorization or disable " &
+                        LogError(Nothing, $"[{CInt(Responser.StatusCode)}] You should use OAuth authorization or disable " &
-                                IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines")
+                                          IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines"))
+                    Else
+                        LogError(Nothing, "Too many requests (429). Try again later!")
+                    End If
                     MySiteSettings.SessionInterrupted = True
                     Throw New Plugin.ExitException With {.Silent = True}
                 Else

SCrawler/API/ThisVid/UserData.vb

@@ -14,7 +14,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
 Imports PersonalUtilities.Tools
 Imports PersonalUtilities.Tools.Web.Documents.JSON
 Namespace API.ThisVid
-    Friend Class UserData : Inherits UserDataBase
+    Friend Class UserData : Inherits UserDataBase : Implements IPSite
 #Region "XML names"
         Private Const Name_DownloadPublic As String = "DownloadPublic"
         Private Const Name_DownloadPrivate As String = "DownloadPrivate"
@@ -51,7 +51,7 @@ Namespace API.ThisVid
                 Return {SearchRequestLabelName}
             End Get
         End Property
-        Friend Property QueryString As String
+        Friend Property QueryString As String Implements IPSite.QueryString
             Get
                 If SiteMode = SiteModes.User Then
                     Return String.Empty
@@ -161,15 +161,7 @@ Namespace API.ThisVid
             Return New UserExchangeOptions(Me)
         End Function
         Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
-            If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
+            If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
-                With DirectCast(Obj, UserExchangeOptions)
-                    DownloadPublic = .DownloadPublic
-                    DownloadPrivate = .DownloadPrivate
-                    DownloadFavourite = .DownloadFavourite
-                    DifferentFolders = .DifferentFolders
-                    QueryString = .QueryString
-                End With
-            End If
         End Sub
 #End Region
 #Region "Initializer"

SCrawler/API/ThisVid/UserExchangeOptions.vb

@@ -6,9 +6,10 @@
 '
 ' This program is distributed in the hope that it will be useful,
 ' but WITHOUT ANY WARRANTY
+Imports SCrawler.API.Base
 Imports SCrawler.Plugin.Attributes
 Namespace API.ThisVid
-    Friend Class UserExchangeOptions : Inherits Xhamster.UserExchangeOptions
+    Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase_P
         <PSetting(Caption:="Download public videos")>
         Friend Property DownloadPublic As Boolean = True
         <PSetting(Caption:="Download private videos")>
@@ -19,6 +20,7 @@ Namespace API.ThisVid
         Friend Property DifferentFolders As Boolean = True
         Private ReadOnly Property MySettings As SiteSettings
         Friend Sub New(ByVal s As SiteSettings)
+            MyBase.New(s)
             DownloadPublic = s.DownloadPublic.Value
             DownloadPrivate = s.DownloadPrivate.Value
             DownloadFavourite = s.DownloadFavourite.Value
@@ -26,12 +28,21 @@ Namespace API.ThisVid
             MySettings = s
         End Sub
         Friend Sub New(ByVal u As UserData)
+            MyBase.New(u)
             DownloadPublic = u.DownloadPublic
             DownloadPrivate = u.DownloadPrivate
             DownloadFavourite = u.DownloadFavourite
             DifferentFolders = u.DifferentFolders
-            QueryString = u.QueryString
             MySettings = u.HOST.Source
         End Sub
+        Friend Overrides Sub Apply(ByRef u As IPSite)
+            MyBase.Apply(u)
+            With DirectCast(u, UserData)
+                .DownloadPublic = DownloadPublic
+                .DownloadPrivate = DownloadPrivate
+                .DownloadFavourite = DownloadFavourite
+                .DifferentFolders = DifferentFolders
+            End With
+        End Sub
     End Class
 End Namespace

SCrawler/API/TikTok/UserData.vb

@@ -256,10 +256,7 @@ Namespace API.TikTok
                                 If j.Value("_type").StringToLower = "video" Then
                                     If Not baseDataObtained Then
                                         baseDataObtained = True
-                                        If ID.IsEmptyString Then
+                                        If ID.IsEmptyString Then ID = j.Value("uploader_id")
-                                            ID = j.Value("uploader_id")
-                                            If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
-                                        End If
                                         newName = j.Value("uploader")
                                         If Not newName.IsEmptyString Then NameTrue = newName
                                         newName = j.Value("creator")

SCrawler/API/Twitter/UserData.vb

@@ -487,10 +487,7 @@ Namespace API.Twitter
                                                 Else
                                                     With j({"data", "user", "result"})
                                                         If .ListExists Then
-                                                            If ID.IsEmptyString Then
+                                                            If ID.IsEmptyString Then ID = .Value("rest_id")
-                                                                ID = .Value("rest_id")
-                                                                If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
-                                                            End If
                                                             With .Item({"legacy"})
                                                                 If .ListExists Then
                                                                     If .Value("screen_name").StringToLower = NameTrue.ToLower Then

SCrawler/API/XVIDEOS/SiteSettings.vb

@@ -50,6 +50,7 @@ Namespace API.XVIDEOS
 
             _SubscriptionsAllowed = True
             UrlPatternUser = "https://xvideos.com/{0}"
+            UserOptionsType = GetType(EditorExchangeOptionsBase_P)
         End Sub
         Friend Overrides Sub EndInit()
             Domains.PopulateInitialDomains(SiteDomains.Value)
@@ -152,14 +153,6 @@ Namespace API.XVIDEOS
             Return Nothing
         End Function
 #End Region
-#Region "UserOptions"
-        Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
-            If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions
-            If OpenForm Then
-                Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
-            End If
-        End Sub
-#End Region
 #Region "IDisposable Support"
         Protected Overrides Sub Dispose(ByVal disposing As Boolean)
             If Not disposedValue And disposing Then _Domains.Dispose()

SCrawler/API/XVIDEOS/UserData.vb

@@ -15,7 +15,7 @@ Imports PersonalUtilities.Tools.Web.Clients
 Imports PersonalUtilities.Tools.Web.Documents.JSON
 Imports UTypes = SCrawler.API.Base.UserMedia.Types
 Namespace API.XVIDEOS
-    Friend Class UserData : Inherits UserDataBase
+    Friend Class UserData : Inherits UserDataBase : Implements IPSite
 #Region "XML names"
         Private Const Name_PersonType As String = "PersonType"
 #End Region
@@ -62,7 +62,7 @@ Namespace API.XVIDEOS
                 Return {SearchRequestLabelName}
             End Get
         End Property
-        Friend Property QueryString As String
+        Friend Property QueryString As String Implements IPSite.QueryString
             Get
                 If SiteMode = SiteModes.User Then
                     Return String.Empty
@@ -82,10 +82,10 @@ Namespace API.XVIDEOS
 #End Region
 #Region "Load"
         Friend Overrides Function ExchangeOptionsGet() As Object
-            Return New UserExchangeOptions(Me)
+            Return New EditorExchangeOptionsBase_P(Me)
         End Function
         Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
-            If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then QueryString = DirectCast(Obj, UserExchangeOptions).QueryString
+            If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptionsBase_P Then DirectCast(Obj, EditorExchangeOptionsBase_P).Apply(Me)
         End Sub
         Private Function UpdateUserOptions(Optional ByVal Force As Boolean = False, Optional ByVal NewUrl As String = Nothing) As Boolean
             If Not Force OrElse (Not SiteMode = SiteModes.User AndAlso Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then

SCrawler/API/XVIDEOS/UserExchangeOptions.vb

@@ -1,17 +0,0 @@
-' 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
-Namespace API.XVIDEOS
-    Friend Class UserExchangeOptions : Inherits Xhamster.UserExchangeOptions
-        Friend Sub New()
-        End Sub
-        Friend Sub New(ByVal u As UserData)
-            QueryString = u.QueryString
-        End Sub
-    End Class
-End Namespace

SCrawler/API/Xhamster/SiteSettings.vb

@@ -51,6 +51,7 @@ Namespace API.Xhamster
             UrlPatternUser = "https://xhamster.com/{0}/{1}"
             UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption}|{P_Creators})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch)
             ImageVideoContains = "xhamster"
+            UserOptionsType = GetType(UserExchangeOptions)
         End Sub
         Friend Overrides Sub EndInit()
             Domains.PopulateInitialDomains(SiteDomains.Value)
@@ -163,14 +164,6 @@ Namespace API.Xhamster
             Return Nothing
         End Function
 #End Region
-#Region "UserOptions"
-        Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
-            If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions
-            If OpenForm Then
-                Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
-            End If
-        End Sub
-#End Region
 #Region "IDisposable Support"
         Protected Overrides Sub Dispose(ByVal disposing As Boolean)
             If Not disposedValue And disposing Then _Domains.Dispose()

SCrawler/API/Xhamster/UserData.vb

@@ -16,10 +16,11 @@ Imports PersonalUtilities.Tools.Web.Clients
 Imports PersonalUtilities.Tools.Web.Documents.JSON
 Imports UTypes = SCrawler.API.Base.UserMedia.Types
 Namespace API.Xhamster
-    Friend Class UserData : Inherits UserDataBase
+    Friend Class UserData : Inherits UserDataBase : Implements IPSite
 #Region "XML names"
         Private Const Name_Gender As String = "Gender"
         Private Const Name_IsCreator As String = "IsCreator"
+        Private Const Name_GetMoments As String = "GetMoments"
 #End Region
 #Region "Declarations"
         Friend Overrides ReadOnly Property FeedIsUser As Boolean
@@ -29,6 +30,7 @@ Namespace API.Xhamster
         End Property
         Friend Property IsChannel As Boolean = False
         Friend Property IsCreator As Boolean = False
+        Friend Property GetMoments As Boolean = False
         Friend Property Gender As String = String.Empty
         Friend Property SiteMode As SiteModes = SiteModes.User
         Friend Property Arguments As String = String.Empty
@@ -47,7 +49,7 @@ Namespace API.Xhamster
                 Return {SearchRequestLabelName}
             End Get
         End Property
-        Friend Property QueryString As String
+        Friend Property QueryString As String Implements IPSite.QueryString
             Get
                 If SiteMode = SiteModes.User Then
                     Return String.Empty
@@ -143,6 +145,7 @@ Namespace API.Xhamster
                 If Loading Then
                     IsChannel = .Value(Name_IsChannel).FromXML(Of Boolean)(False)
                     IsCreator = .Value(Name_IsCreator).FromXML(Of Boolean)(False)
+                    GetMoments = .Value(Name_GetMoments).FromXML(Of Boolean)(False)
                     Gender = .Value(Name_Gender)
                     SiteMode = .Value(Name_SiteMode).FromXML(Of Integer)(SiteModes.User)
                     Arguments = .Value(Name_Arguments)
@@ -155,6 +158,7 @@ Namespace API.Xhamster
                     End If
                     .Add(Name_IsChannel, IsChannel.BoolToInteger)
                     .Add(Name_IsCreator, IsCreator.BoolToInteger)
+                    .Add(Name_GetMoments, GetMoments.BoolToInteger)
                     .Add(Name_TrueName, NameTrue(True))
                     .Add(Name_Gender, Gender)
                     .Add(Name_SiteMode, CInt(SiteMode))
@@ -169,7 +173,7 @@ Namespace API.Xhamster
             Return New UserExchangeOptions(Me)
         End Function
         Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
-            If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then QueryString = DirectCast(Obj, UserExchangeOptions).QueryString
+            If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
         End Sub
 #End Region
 #Region "Initializer"
@@ -237,21 +241,23 @@ Namespace API.Xhamster
                 _PageVideosRepeat = 0
                 SessionPosts.Clear()
                 Responser.CookiesAsHeader = True
-                If DownloadVideos Then DownloadData(1, True, Token)
+                If DownloadVideos Then DownloadData(1, True, False, Token)
+                If GetMoments Then DownloadData(1, True, True, Token)
                 If Not IsChannel And Not IsCreator And DownloadImages And Not IsSubscription Then
-                    DownloadData(1, False, Token)
+                    DownloadData(1, False, False, Token)
                     ReparsePhoto(Token)
                 End If
             Finally
                 Responser.CookiesAsHeader = False
             End Try
         End Sub
-        Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal IsVideo As Boolean, ByVal Token As CancellationToken)
+        Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal IsVideo As Boolean, ByVal GetMoments As Boolean, ByVal Token As CancellationToken)
             Dim URL$ = String.Empty
             Try
                 Dim MaxPage% = -1
                 Dim Type As UTypes = IIf(IsVideo, UTypes.VideoPre, UTypes.Picture)
                 Dim mPages$ = IIf(IsVideo, "maxVideoPages", "maxPhotoPages")
+                Dim specFolder$ = IIf(GetMoments, "Moments*", String.Empty)
                 Dim listNode$()
                 Dim containerNodes As New List(Of String())
                 Dim skipped As Boolean = False
@@ -271,6 +277,7 @@ Namespace API.Xhamster
                     End If
                 ElseIf Not SiteMode = SiteModes.Search Then
                     If IsVideo Then
+                        If GetMoments Then containerNodes.Add({"momentListComponent", "videoThumbProps"})
                         containerNodes.Add({"trendingVideoListComponent", "models"})
                         containerNodes.Add({"pagesCategoryComponent", "trendingVideoListProps", "models"})
                         containerNodes.Add({"trendingVideoSectionComponent", "videoModels"})
@@ -294,7 +301,7 @@ Namespace API.Xhamster
                 ElseIf IsCreator Or SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories Or SiteMode = SiteModes.Pornstars Then
                     URL = GetNonUserUrl(Page)
                 Else
-                    URL = $"https://xhamster.com/users/{NameTrue}/{IIf(IsVideo, "videos", "photos")}{IIf(Page = 1, String.Empty, $"/{Page}")}"
+                    URL = $"https://xhamster.com/users/{NameTrue}/{If(GetMoments, "moments", IIf(IsVideo, "videos", "photos"))}{IIf(Page = 1, String.Empty, $"/{Page}")}"
                 End If
                 ThrowAny(Token)
 
@@ -314,7 +321,7 @@ Namespace API.Xhamster
                                         ProgressPre.ChangeMax(.Count)
                                         For Each e As EContainer In .Self
                                             ProgressPre.Perform()
-                                            m = ExtractMedia(e, Type)
+                                            m = ExtractMedia(e, Type,,,, specFolder)
                                             If Not m.URL.IsEmptyString Then
                                                 pids.ListAddValue(m.Post.ID, LNC)
                                                 If m.File.IsEmptyString Then Continue For
@@ -374,7 +381,7 @@ Namespace API.Xhamster
                     (MaxPage = -1 Or Page < MaxPage) And
                     ((Not _TempMediaList.Count = cBefore Or skipped) And (IsUser Or Page < 1000))
                    ) Or
-                   (IsChannel Or (Not IsUser And Page < 1000 And prevPostsFound And Not newPostsFound))) Then DownloadData(Page + 1, IsVideo, Token)
+                   (IsChannel Or (Not IsUser And Page < 1000 And prevPostsFound And Not newPostsFound))) Then DownloadData(Page + 1, IsVideo, GetMoments, Token)
             Catch ex As Exception
                 ProcessException(ex, Token, $"data downloading error [{URL}]")
             End Try
@@ -396,7 +403,7 @@ Namespace API.Xhamster
                                 If Not m.URL_BASE.IsEmptyString Then
                                     m2 = Nothing
                                     ThrowAny(Token)
-                                    If GetM3U8(m2, m.URL_BASE) Then
+                                    If GetM3U8(m2, m.URL_BASE, m.SpecialFolder) Then
                                         m2.URL_BASE = m.URL_BASE
                                         _TempMediaList(i) = m2
                                     Else
@@ -426,7 +433,7 @@ Namespace API.Xhamster
                                 If Not m.URL_BASE.IsEmptyString Then
                                     m2 = Nothing
                                     ThrowAny(Token)
-                                    If GetM3U8(m2, m.URL_BASE) Then
+                                    If GetM3U8(m2, m.URL_BASE, String.Empty) Then
                                         m2.URL_BASE = m.URL_BASE
                                         _TempMediaList(i) = m2
                                         c += 1
@@ -507,7 +514,7 @@ Namespace API.Xhamster
                         If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
                             ThrowAny(Token)
                             m2 = Nothing
-                            If GetM3U8(m2, m.URL_BASE) Then
+                            If GetM3U8(m2, m.URL_BASE, m.SpecialFolder) Then
                                 m2.URL_BASE = m.URL_BASE
                                 m2.State = UserMedia.States.Missing
                                 m2.Attempts = m.Attempts
@@ -528,7 +535,7 @@ Namespace API.Xhamster
         End Sub
 #End Region
 #Region "GetM3U8"
-        Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal URL As String) As Boolean
+        Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal URL As String, ByVal SpecFolder As String) As Boolean
             Try
                 If Not URL.IsEmptyString Then
                     Dim r$ = Responser.GetResponse(URL)
@@ -536,7 +543,7 @@ Namespace API.Xhamster
                     If Not r.IsEmptyString Then
                         Using j As EContainer = JsonDocument.Parse(r)
                             If j.ListExists Then
-                                m = ExtractMedia(j("videoModel"), UTypes.VideoPre)
+                                m = ExtractMedia(j("videoModel"), UTypes.VideoPre,,,, SpecFolder)
                                 m.URL_BASE = URL
                                 If IsSubscription Then
                                     With j("videoModel")
@@ -546,7 +553,7 @@ Namespace API.Xhamster
                                         End If
                                     End With
                                 Else
-                                    Return GetM3U8(m, j)
+                                    Return GetM3U8(m, j, SpecFolder)
                                 End If
                             End If
                         End Using
@@ -557,7 +564,7 @@ Namespace API.Xhamster
                 Return ErrorsDescriber.Execute(EDP.ReturnValue, ex, $"[{ToStringForLog()}]: API.Xhamster.GetM3U8({URL})", False)
             End Try
         End Function
-        Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal j As EContainer) As Boolean
+        Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal j As EContainer, ByVal SpecFolder As String) As Boolean
             Dim node As EContainer = j({"xplayerSettings", "sources", "hls"})
             If node.ListExists Then
                 Dim url$ = node.GetNode({New NodeParams("url", True, True, True, True, 2)}).XmlIfNothingValue
@@ -583,7 +590,8 @@ Namespace API.Xhamster
 #End Region
 #Region "Create media"
         Private Function ExtractMedia(ByVal j As EContainer, ByVal t As UTypes, Optional ByVal UrlNode As String = "pageURL",
-                                      Optional ByVal DetectGalery As Boolean = True, Optional ByVal PostDate As Date? = Nothing) As UserMedia
+                                      Optional ByVal DetectGalery As Boolean = True, Optional ByVal PostDate As Date? = Nothing,
+                                      Optional ByVal SpecFolder As String = Nothing) As UserMedia
             If Not j Is Nothing Then
                 Dim m As New UserMedia(j.Value(UrlNode).Replace("\", String.Empty), t) With {
                     .Post = New UserPost With {
@@ -626,6 +634,8 @@ Namespace API.Xhamster
                     End If
                     m.File.Separator = "\"
                 End If
+                If Not SpecFolder.IsEmptyString Then _
+                   m.SpecialFolder = $"{m.SpecialFolder.StringTrimEnd("\")}{IIf(m.SpecialFolder.IsEmptyString, String.Empty, "\")}{SpecFolder}"
                 Return m
             Else
                 Return Nothing

SCrawler/API/Xhamster/UserExchangeOptions.vb

@@ -6,16 +6,22 @@
 '
 ' This program is distributed in the hope that it will be useful,
 ' but WITHOUT ANY WARRANTY
+Imports SCrawler.API.Base
 Imports SCrawler.Plugin.Attributes
 Namespace API.Xhamster
-    Friend Class UserExchangeOptions
+    Friend NotInheritable Class UserExchangeOptions : Inherits API.Base.EditorExchangeOptionsBase_P
-        <PSetting(Address:=SettingAddress.User, Caption:="Query",
+        <PSetting(Address:=SettingAddress.User, Caption:="Get moments")>
-                  ToolTip:="Query string. Don't change this field when creating a user! Change it only for the same request.")>
+        Friend Property GetMoments As Boolean = False
-        Friend Property QueryString As String
         Friend Sub New()
+            MyBase.New
         End Sub
-        Friend Sub New(ByVal u As UserData)
+        Friend Sub New(ByVal u As IPSite)
-            QueryString = u.QueryString
+            MyBase.New(DirectCast(u, UserData))
+            GetMoments = DirectCast(u, UserData).GetMoments
+        End Sub
+        Friend Overrides Sub Apply(ByRef u As IPSite)
+            MyBase.Apply(u)
+            DirectCast(u, UserData).GetMoments = GetMoments
         End Sub
     End Class
 End Namespace

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("2025.6.1.0")>
+<Assembly: AssemblyVersion("2025.7.18.0")>
-<Assembly: AssemblyFileVersion("2025.6.1.0")>
+<Assembly: AssemblyFileVersion("2025.7.18.0")>
 <Assembly: NeutralResourcesLanguage("en")>

SCrawler/SCrawler.vbproj

@@ -169,6 +169,7 @@
     <Compile Include="API\Base\DeclaredNames.vb" />
     <Compile Include="API\Base\DownDetector.vb" />
     <Compile Include="API\Base\EditorExchangeOptionsBase.vb" />
+    <Compile Include="API\Base\EditorExchangeOptionsBase_P.vb" />
     <Compile Include="API\Base\GDL.vb" />
     <Compile Include="API\Base\IUserData.vb" />
     <Compile Include="API\Base\M3U8Base.vb" />
@@ -268,7 +269,6 @@
     <Compile Include="API\XVIDEOS\M3U8.vb" />
     <Compile Include="API\XVIDEOS\SiteSettings.vb" />
     <Compile Include="API\XVIDEOS\UserData.vb" />
-    <Compile Include="API\XVIDEOS\UserExchangeOptions.vb" />
     <Compile Include="API\YouTube\SiteSettings.vb" />
     <Compile Include="API\YouTube\UserData.vb" />
     <Compile Include="API\YouTube\UserExchangeOptions.vb" />