From 05772a9fc4c22f5753ff270a152e82afb022e3d8 Mon Sep 17 00:00:00 2001 From: Andy <88590076+AAndyProgram@users.noreply.github.com> Date: Fri, 18 Jul 2025 20:29:35 +0300 Subject: [PATCH] 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 | 18 ++++++ .../API/Base/EditorExchangeOptionsBase_P.vb | 43 +++++++++++++ SCrawler/API/Base/UserDataBase.vb | 1 + SCrawler/API/Instagram/UserData.vb | 28 +++++++-- SCrawler/API/OnlyFans/UserData.vb | 56 ++++++++--------- SCrawler/API/PornHub/UserData.vb | 16 +---- SCrawler/API/PornHub/UserExchangeOptions.vb | 17 +++++- SCrawler/API/Reddit/SiteSettings.vb | 60 +++++++++++++------ SCrawler/API/Reddit/UserData.vb | 20 ++++--- SCrawler/API/ThisVid/UserData.vb | 14 +---- SCrawler/API/ThisVid/UserExchangeOptions.vb | 15 ++++- SCrawler/API/XVIDEOS/SiteSettings.vb | 9 +-- SCrawler/API/XVIDEOS/UserData.vb | 8 +-- SCrawler/API/XVIDEOS/UserExchangeOptions.vb | 17 ------ SCrawler/API/Xhamster/SiteSettings.vb | 9 +-- SCrawler/API/Xhamster/UserData.vb | 44 ++++++++------ SCrawler/API/Xhamster/UserExchangeOptions.vb | 18 ++++-- SCrawler/My Project/AssemblyInfo.vb | 4 +- SCrawler/SCrawler.vbproj | 2 +- 19 files changed, 251 insertions(+), 148 deletions(-) create mode 100644 SCrawler/API/Base/EditorExchangeOptionsBase_P.vb delete mode 100644 SCrawler/API/XVIDEOS/UserExchangeOptions.vb diff --git a/Changelog.md b/Changelog.md index f4abeb7..8215e13 100644 --- 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* diff --git a/SCrawler/API/Base/EditorExchangeOptionsBase_P.vb b/SCrawler/API/Base/EditorExchangeOptionsBase_P.vb new file mode 100644 index 0000000..a98bb01 --- /dev/null +++ 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 + Friend Overrides Property UserName As String + Friend Overrides Property DownloadText As Boolean + Friend Overrides Property DownloadTextPosts As Boolean + Friend Overrides Property DownloadTextSpecialFolder As Boolean + + 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 \ No newline at end of file diff --git a/SCrawler/API/Base/UserDataBase.vb b/SCrawler/API/Base/UserDataBase.vb index 896be0c..60e383e 100644 --- a/SCrawler/API/Base/UserDataBase.vb +++ b/SCrawler/API/Base/UserDataBase.vb @@ -2288,6 +2288,7 @@ stxt: End Function #End Region #Region "Errors functions" + ''' ToStringForLog(): Message Protected Sub LogError(ByVal ex As Exception, ByVal Message As String, Optional ByVal e As ErrorsDescriber = Nothing) ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}") End Sub diff --git a/SCrawler/API/Instagram/UserData.vb b/SCrawler/API/Instagram/UserData.vb index 2bcfb54..2131beb 100644 --- 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 diff --git a/SCrawler/API/OnlyFans/UserData.vb b/SCrawler/API/OnlyFans/UserData.vb index bd4b416..33e72c7 100644 --- 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 diff --git a/SCrawler/API/PornHub/UserData.vb b/SCrawler/API/PornHub/UserData.vb index 82d4ee2..82709f8 100644 --- 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 diff --git a/SCrawler/API/PornHub/UserExchangeOptions.vb b/SCrawler/API/PornHub/UserExchangeOptions.vb index e2961e7..a2a0633 100644 --- 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 Friend Property DownloadUHD As Boolean @@ -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 \ No newline at end of file diff --git a/SCrawler/API/Reddit/SiteSettings.vb b/SCrawler/API/Reddit/SiteSettings.vb index 4a884d7..ea3e8fb 100644 --- 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 + + 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" @@ -233,23 +276,6 @@ Namespace API.Reddit End Sub #End Region #Region "Token" - - 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 diff --git a/SCrawler/API/Reddit/UserData.vb b/SCrawler/API/Reddit/UserData.vb index 9558129..b8113c8 100644 --- 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 diff --git a/SCrawler/API/ThisVid/UserData.vb b/SCrawler/API/ThisVid/UserData.vb index ea1d6b5..4f3f761 100644 --- 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" diff --git a/SCrawler/API/ThisVid/UserExchangeOptions.vb b/SCrawler/API/ThisVid/UserExchangeOptions.vb index 3bf8a38..d995726 100644 --- 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 Friend Property DownloadPublic As Boolean = True @@ -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 \ No newline at end of file diff --git a/SCrawler/API/XVIDEOS/SiteSettings.vb b/SCrawler/API/XVIDEOS/SiteSettings.vb index 0e59f69..3f25dc6 100644 --- 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() diff --git a/SCrawler/API/XVIDEOS/UserData.vb b/SCrawler/API/XVIDEOS/UserData.vb index 275d7ae..270c4b9 100644 --- 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 diff --git a/SCrawler/API/XVIDEOS/UserExchangeOptions.vb b/SCrawler/API/XVIDEOS/UserExchangeOptions.vb deleted file mode 100644 index 593fefc..0000000 --- a/SCrawler/API/XVIDEOS/UserExchangeOptions.vb +++ /dev/null @@ -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 \ No newline at end of file diff --git a/SCrawler/API/Xhamster/SiteSettings.vb b/SCrawler/API/Xhamster/SiteSettings.vb index 2dc4d78..0d0724e 100644 --- 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() diff --git a/SCrawler/API/Xhamster/UserData.vb b/SCrawler/API/Xhamster/UserData.vb index e0d6d8b..4a064dc 100644 --- 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 diff --git a/SCrawler/API/Xhamster/UserExchangeOptions.vb b/SCrawler/API/Xhamster/UserExchangeOptions.vb index 39ae828..0c7f3a1 100644 --- 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 - - Friend Property QueryString As String + Friend NotInheritable Class UserExchangeOptions : Inherits API.Base.EditorExchangeOptionsBase_P + + 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 \ No newline at end of file diff --git a/SCrawler/My Project/AssemblyInfo.vb b/SCrawler/My Project/AssemblyInfo.vb index 5a496b1..d4c040d 100644 --- a/SCrawler/My Project/AssemblyInfo.vb +++ b/SCrawler/My Project/AssemblyInfo.vb @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices ' by using the '*' as shown below: ' - - + + diff --git a/SCrawler/SCrawler.vbproj b/SCrawler/SCrawler.vbproj index c3df7fd..b94e128 100644 --- a/SCrawler/SCrawler.vbproj +++ b/SCrawler/SCrawler.vbproj @@ -169,6 +169,7 @@ + @@ -268,7 +269,6 @@ -