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
2026-03-14 15:52:18 +00:00 · 2025-07-18 20:29:35 +03:00
parent 24ad338c60
commit 05772a9fc4
19 changed files with 251 additions and 148 deletions
--- a/Changelog.md
+++ b/Changelog.md
@@ -1,3 +1,21 @@
+# 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*
--- a/SCrawler/API/Base/EditorExchangeOptionsBase_P.vb
+++ b/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
--- a/SCrawler/API/Base/UserDataBase.vb
+++ b/SCrawler/API/Base/UserDataBase.vb
@@ -2288,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
--- a/SCrawler/API/Instagram/UserData.vb
+++ b/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 = 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 &= "*"
+                        Dim endsAbs As Boolean
+                        Dim newFolderName$
+                        If PutImageVideoFolder Then
+                            If SpecialFolder.IsEmptyString Then
+                                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
--- a/SCrawler/API/OnlyFans/UserData.vb
+++ b/SCrawler/API/OnlyFans/UserData.vb
@@ -431,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")
@@ -440,32 +440,34 @@ Namespace API.OnlyFans
                        '    'postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
                        '    postUrl = GetMediaURL(m)
                        'End If
-                        postUrlBase = String.Empty
-                        Select Case m.Value("type")
-                            Case "photo" : t = UTypes.Picture : ext = "jpg"
-                            Case "video"
-                                t = UTypes.Video
-                                ext = "mp4"
-                                If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then
-                                    t = UTypes.VideoPre
-                                    _AbsMediaIndex += 1
-                                    If Not PostUserID.IsEmptyString And IsSingleObjectDownload Then _
-                                       postUrlBase = String.Format(SiteSettings.UserPostPattern, PostID, $"u{PostUserID}")
-                                End If
-                            Case Else : t = UTypes.Undefined : ext = String.Empty
-                        End Select
-                        If Not t = UTypes.Undefined And (Not postUrl.IsEmptyString Or t = UTypes.VideoPre) Then
-                            Dim media As New UserMedia(postUrl.IfNullOrEmpty(IIf(t = UTypes.VideoPre, $"{t}{_AbsMediaIndex}", String.Empty)), t) With {
-                                .Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing)),
-                                .SpecialFolder = SpecFolder,
-                                .PostText = PostText,
-                                .PostTextFileSpecialFolder = DownloadTextSpecialFolder
-                            }
-                            If postUrlBase.IsEmptyString And Not IsSingleObjectDownload Then postUrlBase = GetPostUrl(Me, media)
-                            If Not postUrlBase.IsEmptyString Then media.URL_BASE = postUrlBase
-                            media.File.Extension = ext
-                            Result = True
-                            mList.Add(media)
+                        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", "gif"
+                                    t = UTypes.Video
+                                    ext = "mp4"
+                                    If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then
+                                        t = UTypes.VideoPre
+                                        _AbsMediaIndex += 1
+                                        If Not PostUserID.IsEmptyString And IsSingleObjectDownload Then _
+                                           postUrlBase = String.Format(SiteSettings.UserPostPattern, PostID, $"u{PostUserID}")
+                                    End If
+                                Case Else : t = UTypes.Undefined : ext = String.Empty
+                            End Select
+                            If Not t = UTypes.Undefined And (Not postUrl.IsEmptyString Or t = UTypes.VideoPre) Then
+                                Dim media As New UserMedia(postUrl.IfNullOrEmpty(IIf(t = UTypes.VideoPre, $"{t}{_AbsMediaIndex}", String.Empty)), t) With {
+                                    .Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing)),
+                                    .SpecialFolder = SpecFolder,
+                                    .PostText = PostText,
+                                    .PostTextFileSpecialFolder = DownloadTextSpecialFolder
+                                }
+                                If postUrlBase.IsEmptyString And Not IsSingleObjectDownload Then postUrlBase = GetPostUrl(Me, media)
+                                If Not postUrlBase.IsEmptyString Then media.URL_BASE = postUrlBase
+                                media.File.Extension = ext
+                                Result = True
+                                mList.Add(media)
+                            End If
                        End If
                    Next
                End If
--- a/SCrawler/API/PornHub/UserData.vb
+++ b/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
-                With DirectCast(Obj, UserExchangeOptions)
-                    DownloadUHD = .DownloadUHD
-                    DownloadUploaded = .DownloadUploaded
-                    DownloadTagged = .DownloadTagged
-                    DownloadPrivate = .DownloadPrivate
-                    DownloadFavorite = .DownloadFavorite
-                    DownloadGifs = .DownloadGifs
-                    QueryString = .QueryString
-                End With
-            End If
+            If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
        End Sub
 #End Region
        Private ReadOnly Property MySettings As SiteSettings
--- a/SCrawler/API/PornHub/UserExchangeOptions.vb
+++ b/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
--- a/SCrawler/API/Reddit/SiteSettings.vb
+++ b/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>
@@ -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
--- a/SCrawler/API/Reddit/UserData.vb
+++ b/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
-                       ((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso
-                       Not MySiteSettings.CredentialsExists Then '429
-                    MyMainLOG = $"{ToStringForLog()}: [{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")
+                ElseIf .StatusCode = 429 Then '429 (all)
+                    If ((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso
+                       Not MySiteSettings.CredentialsExists Then
+                        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"))
+                    Else
+                        LogError(Nothing, "Too many requests (429). Try again later!")
+                    End If
                    MySiteSettings.SessionInterrupted = True
                    Throw New Plugin.ExitException With {.Silent = True}
                Else
--- a/SCrawler/API/ThisVid/UserData.vb
+++ b/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
-                With DirectCast(Obj, UserExchangeOptions)
-                    DownloadPublic = .DownloadPublic
-                    DownloadPrivate = .DownloadPrivate
-                    DownloadFavourite = .DownloadFavourite
-                    DifferentFolders = .DifferentFolders
-                    QueryString = .QueryString
-                End With
-            End If
+            If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
        End Sub
 #End Region
 #Region "Initializer"
--- a/SCrawler/API/ThisVid/UserExchangeOptions.vb
+++ b/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
--- a/SCrawler/API/XVIDEOS/SiteSettings.vb
+++ b/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()
--- a/SCrawler/API/XVIDEOS/UserData.vb
+++ b/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
--- a/SCrawler/API/XVIDEOS/UserExchangeOptions.vb
+++ b/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
--- a/SCrawler/API/Xhamster/SiteSettings.vb
+++ b/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()
--- a/SCrawler/API/Xhamster/UserData.vb
+++ b/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
--- a/SCrawler/API/Xhamster/UserExchangeOptions.vb
+++ b/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
-        <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
+    Friend NotInheritable Class UserExchangeOptions : Inherits API.Base.EditorExchangeOptionsBase_P
+        <PSetting(Address:=SettingAddress.User, Caption:="Get moments")>
+        Friend Property GetMoments As Boolean = False
        Friend Sub New()
+            MyBase.New
        End Sub
-        Friend Sub New(ByVal u As UserData)
-            QueryString = u.QueryString
+        Friend Sub New(ByVal u As IPSite)
+            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
--- a/Project/AssemblyInfo.vb
+++ b/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.12.0")>
-<Assembly: AssemblyFileVersion("2025.6.12.0")>
+<Assembly: AssemblyVersion("2025.7.18.0")>
+<Assembly: AssemblyFileVersion("2025.7.18.0")>
 <Assembly: NeutralResourcesLanguage("en")>
--- a/SCrawler/SCrawler.vbproj
+++ b/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" />