geonu/SCrawler
1
0
Fork 0
mirror of https://github.com/AAndyProgram/SCrawler.git synced 2026-03-14 15:52:18 +00:00
Code Issues Packages Projects Releases Wiki Activity

2025.7.18.0

Browse Source 
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
This commit is contained in:
Andy
2025-07-18 20:29:35 +03:00
parent 24ad338c60
commit 05772a9fc4
19 changed files with 251 additions and 148 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
Changelog.md
View File

@@ -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.6.12.0
*2025-06-12* *2025-06-12*

43
SCrawler/API/Base/EditorExchangeOptionsBase_P.vb Normal file
View File

@@ -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

1
SCrawler/API/Base/UserDataBase.vb
View File

@@ -2288,6 +2288,7 @@ stxt:
End Function End Function
#End Region #End Region
#Region "Errors functions" #Region "Errors functions"
''' <summary>ToStringForLog(): Message</summary>
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String, Optional ByVal e As ErrorsDescriber = Nothing) 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}") ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}")
End Sub End Sub

28
SCrawler/API/Instagram/UserData.vb
View File

@@ -1151,12 +1151,30 @@ NextPageBlock:
If TryExtractImage Then If TryExtractImage Then
t = 1 t = 1
abstractDecision = True 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 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 ElseIf t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then
If n.Contains(vid) Then If n.Contains(vid) Then
t = 2 t = 2

6
SCrawler/API/OnlyFans/UserData.vb
View File

@@ -431,7 +431,7 @@ Namespace API.OnlyFans
Result = False Result = False
With n("media") With n("media")
If .ListExists Then If .ListExists Then
For Each m In .Self For Each m As EContainer In .Self
postUrl = GetMediaURL(m) postUrl = GetMediaURL(m)
'If IsHL Then 'If IsHL Then
' 'postUrl = m.Value({"files", "source"}, "url") ' 'postUrl = m.Value({"files", "source"}, "url")
@@ -440,10 +440,11 @@ Namespace API.OnlyFans
' 'postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full")) ' 'postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
' postUrl = GetMediaURL(m) ' postUrl = GetMediaURL(m)
'End If 'End If
If m.Value("canView").FromXML(Of Boolean)(True) Then
postUrlBase = String.Empty postUrlBase = String.Empty
Select Case m.Value("type") Select Case m.Value("type")
Case "photo" : t = UTypes.Picture : ext = "jpg" Case "photo" : t = UTypes.Picture : ext = "jpg"
Case "video" Case "video", "gif"
t = UTypes.Video t = UTypes.Video
ext = "mp4" ext = "mp4"
If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then
@@ -467,6 +468,7 @@ Namespace API.OnlyFans
Result = True Result = True
mList.Add(media) mList.Add(media)
End If End If
End If
Next Next
End If End If
End With End With

16
SCrawler/API/PornHub/UserData.vb
View File

@@ -15,7 +15,7 @@ Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.PornHub 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}" Private Const UrlPattern As String = "https://www.pornhub.com/{0}"
#Region "Declarations" #Region "Declarations"
#Region "XML names" #Region "XML names"
@@ -140,7 +140,7 @@ Namespace API.PornHub
End Get End Get
End Property End Property
Friend Property SiteMode As SiteModes = SiteModes.User Friend Property SiteMode As SiteModes = SiteModes.User
Friend Property QueryString As String Friend Property QueryString As String Implements IPSite.QueryString
Get Get
If IsUser Then If IsUser Then
Return String.Empty Return String.Empty
@@ -163,17 +163,7 @@ Namespace API.PornHub
Return New UserExchangeOptions(Me) Return New UserExchangeOptions(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) 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 Sub
#End Region #End Region
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings

17
SCrawler/API/PornHub/UserExchangeOptions.vb
View File

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

60
SCrawler/API/Reddit/SiteSettings.vb
View File

@@ -9,6 +9,7 @@
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports System.Reflection
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.Base Imports PersonalUtilities.Tools.Web.Clients.Base
Imports PersonalUtilities.Tools.Web.Documents.JSON 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) Return {AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString)
End Get End Get
End Property 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 #End Region
#Region "Other" #Region "Other"
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML, PClonable> <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 Sub
#End Region #End Region
#Region "Token" #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 Private Function UpdateTokenIfRequired() As Boolean
UpdateRedGifsToken() UpdateRedGifsToken()
If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso CredentialsExists Then If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso CredentialsExists Then

20
SCrawler/API/Reddit/UserData.vb
View File

@@ -135,6 +135,7 @@ Namespace API.Reddit
DownloadTextSpecialFolder = .DownloadTextSpecialFolder DownloadTextSpecialFolder = .DownloadTextSpecialFolder
RedGifsAccount = .RedGifsAccount RedGifsAccount = .RedGifsAccount
RedditAccount = .RedditAccount RedditAccount = .RedditAccount
If TypeOf Options Is RedditViewExchange Then DirectCast(Options, RedditViewExchange).ApplyBase(Me)
End With End With
End If End If
End Sub End Sub
@@ -1089,25 +1090,28 @@ Namespace API.Reddit
ElseIf .StatusCode = HttpStatusCode.Forbidden Then '403 ElseIf .StatusCode = HttpStatusCode.Forbidden Then '403
UserSuspended = True UserSuspended = True
ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then '502, 503 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} Throw New Plugin.ExitException With {.Silent = True}
ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then '504 ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then '504
Return 1 Return 1
ElseIf .StatusCode = HttpStatusCode.Unauthorized Then '401 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 MySiteSettings.SessionInterrupted = True
Throw New Plugin.ExitException With {.Silent = True} Throw New Plugin.ExitException With {.Silent = True}
ElseIf .StatusCode = HttpStatusCode.InternalServerError Then '500 ElseIf .StatusCode = HttpStatusCode.InternalServerError Then '500
If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1 If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1
Return HttpStatusCode.InternalServerError 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 Err429Count += 1
Return 429 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 MySiteSettings.SessionInterrupted = True
Throw New Plugin.ExitException With {.Silent = True} Throw New Plugin.ExitException With {.Silent = True}
Else Else

14
SCrawler/API/ThisVid/UserData.vb
View File

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

15
SCrawler/API/ThisVid/UserExchangeOptions.vb
View File

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

9
SCrawler/API/XVIDEOS/SiteSettings.vb
View File

@@ -50,6 +50,7 @@ Namespace API.XVIDEOS
_SubscriptionsAllowed = True _SubscriptionsAllowed = True
UrlPatternUser = "https://xvideos.com/{0}" UrlPatternUser = "https://xvideos.com/{0}"
UserOptionsType = GetType(EditorExchangeOptionsBase_P)
End Sub End Sub
Friend Overrides Sub EndInit() Friend Overrides Sub EndInit()
Domains.PopulateInitialDomains(SiteDomains.Value) Domains.PopulateInitialDomains(SiteDomains.Value)
@@ -152,14 +153,6 @@ Namespace API.XVIDEOS
Return Nothing Return Nothing
End Function End Function
#End Region #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" #Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _Domains.Dispose() If Not disposedValue And disposing Then _Domains.Dispose()

8
SCrawler/API/XVIDEOS/UserData.vb
View File

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

17
SCrawler/API/XVIDEOS/UserExchangeOptions.vb
View File

@@ -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

9
SCrawler/API/Xhamster/SiteSettings.vb
View File

@@ -51,6 +51,7 @@ Namespace API.Xhamster
UrlPatternUser = "https://xhamster.com/{0}/{1}" UrlPatternUser = "https://xhamster.com/{0}/{1}"
UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption}|{P_Creators})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch) UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption}|{P_Creators})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch)
ImageVideoContains = "xhamster" ImageVideoContains = "xhamster"
UserOptionsType = GetType(UserExchangeOptions)
End Sub End Sub
Friend Overrides Sub EndInit() Friend Overrides Sub EndInit()
Domains.PopulateInitialDomains(SiteDomains.Value) Domains.PopulateInitialDomains(SiteDomains.Value)
@@ -163,14 +164,6 @@ Namespace API.Xhamster
Return Nothing Return Nothing
End Function End Function
#End Region #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" #Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _Domains.Dispose() If Not disposedValue And disposing Then _Domains.Dispose()

44
SCrawler/API/Xhamster/UserData.vb
View File

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

18
SCrawler/API/Xhamster/UserExchangeOptions.vb
View File

@@ -6,16 +6,22 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.Xhamster 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() Friend Sub New()
MyBase.New
End Sub 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 Sub
End Class End Class
End Namespace End Namespace

4
SCrawler/My Project/AssemblyInfo.vb
View File

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

2
SCrawler/SCrawler.vbproj
View File

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