Skip to content

Commit 05772a9

Browse files
AAndyProgramAAndyProgram
committed
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
1 parent 24ad338 commit 05772a9

19 files changed

+251
-148
lines changed

‎Changelog.md‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,21 @@
1+
# 2025.7.18.0
2+
3+
*2025-07-18*
4+
5+
- Added
6+
- Sites:
7+
- OnlyFans:
8+
- **bypass unpurchased videos**
9+
- support for GIF files
10+
- Reddit: extended `429` error handling
11+
- Xhamster: support for downloading 'moments'
12+
- Minor improvements
13+
- Updated
14+
- yt-dlp up to version **2025.06.30**
15+
- gallery-dl up to version **1.30.0**
16+
- Fixed
17+
- Minor bugs
18+
119
# 2025.6.12.0
220

321
*2025-06-12*

‎SCrawler/API/Base/EditorExchangeOptionsBase_P.vb‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
' Copyright (C) Andy https://github.com/AAndyProgram
2+
' This program is free software: you can redistribute it and/or modify
3+
' it under the terms of the GNU General Public License as published by
4+
' the Free Software Foundation, either version 3 of the License, or
5+
' (at your option) any later version.
6+
'
7+
' This program is distributed in the hope that it will be useful,
8+
' but WITHOUT ANY WARRANTY
9+
Imports SCrawler.Plugin.Attributes
10+
Namespace API.Base
11+
Friend Interface IPSite
12+
Property QueryString As String
13+
End Interface
14+
Friend Class EditorExchangeOptionsBase_P : Inherits EditorExchangeOptionsBase : Implements IPSite
15+
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property UserName As String
16+
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadText As Boolean
17+
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadTextPosts As Boolean
18+
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadTextSpecialFolder As Boolean
19+
<PSetting(Address:=SettingAddress.User, Caption:="Query",
20+
ToolTip:="Query string. Don't change this field when creating a user! Change it only for the same request.")>
21+
Friend Property QueryString As String Implements IPSite.QueryString
22+
Friend Sub New()
23+
DisableBase()
24+
End Sub
25+
Friend Sub New(ByVal u As UserDataBase)
26+
MyBase.New(u)
27+
DisableBase()
28+
If TypeOf u Is IPSite Then QueryString = DirectCast(u, IPSite).QueryString
29+
End Sub
30+
Friend Sub New(ByVal s As SiteSettingsBase)
31+
MyBase.New(s)
32+
DisableBase()
33+
End Sub
34+
Friend Overridable Sub Apply(ByRef u As IPSite)
35+
ApplyBase(u)
36+
u.QueryString = QueryString
37+
End Sub
38+
Protected Overridable Sub DisableBase()
39+
_ApplyBase_Name = False
40+
_ApplyBase_Text = False
41+
End Sub
42+
End Class
43+
End Namespace

‎SCrawler/API/Base/UserDataBase.vb‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2288,6 +2288,7 @@ stxt:
22882288
End Function
22892289
#End Region
22902290
#Region "Errors functions"
2291+
''' <summary>ToStringForLog(): Message</summary>
22912292
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String, Optional ByVal e As ErrorsDescriber = Nothing)
22922293
ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}")
22932294
End Sub

‎SCrawler/API/Instagram/UserData.vb‎

Lines changed: 23 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1151,12 +1151,30 @@ NextPageBlock:
11511151
If TryExtractImage Then
11521152
t = 1
11531153
abstractDecision = True
1154-
If Not SpecialFolder.IsEmptyString AndAlso PutImageVideoFolder Then
1155-
Dim endsAbs As Boolean = SpecialFolder.EndsWith("*")
1156-
If endsAbs Then SpecialFolder = SpecialFolder.TrimEnd("*")
1157-
If Not SpecialFolder.IsEmptyString Then SpecialFolder = $"{SpecialFolder.TrimEnd("\")}\{VideoFolderName}{IIf(Not endsAbs, "*", String.Empty)}"
1158-
If endsAbs Then SpecialFolder &= "*"
1154+
Dim endsAbs As Boolean
1155+
Dim newFolderName$
1156+
If PutImageVideoFolder Then
1157+
If SpecialFolder.IsEmptyString Then
1158+
newFolderName = $"{VideoFolderName}\*"
1159+
Else
1160+
endsAbs = SpecialFolder.EndsWith("*")
1161+
SpecialFolder = SpecialFolder.TrimEnd({CChar("\"), CChar("*")})
1162+
If Not endsAbs Then SpecialFolder = $"{SpecialFolder}\{VideoFolderName}"
1163+
newFolderName = $"{SpecialFolder}*"
1164+
End If
1165+
'Dim endsAbs As Boolean = SpecialFolder.EndsWith("*")
1166+
'If endsAbs Then SpecialFolder = SpecialFolder.TrimEnd("*")
1167+
'If Not SpecialFolder.IsEmptyString Then SpecialFolder = $"{SpecialFolder.TrimEnd("\")}\{VideoFolderName}{IIf(Not endsAbs, "*", String.Empty)}"
1168+
'If endsAbs Then SpecialFolder &= "*"
1169+
ElseIf Not SpecialFolder.IsEmptyString Then
1170+
endsAbs = SpecialFolder.EndsWith("*")
1171+
SpecialFolder = SpecialFolder.TrimEnd({CChar("\"), CChar("*")})
1172+
If endsAbs Then SpecialFolder = $"{SpecialFolder}\Photos"
1173+
newFolderName = $"{SpecialFolder}*"
1174+
Else
1175+
newFolderName = SpecialFolder
11591176
End If
1177+
SpecialFolder = newFolderName
11601178
ElseIf t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then
11611179
If n.Contains(vid) Then
11621180
t = 2

‎SCrawler/API/OnlyFans/UserData.vb‎

Lines changed: 29 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -431,7 +431,7 @@ Namespace API.OnlyFans
431431
Result = False
432432
With n("media")
433433
If .ListExists Then
434-
For Each m In .Self
434+
For Each m As EContainer In .Self
435435
postUrl = GetMediaURL(m)
436436
'If IsHL Then
437437
' 'postUrl = m.Value({"files", "source"}, "url")
@@ -440,32 +440,34 @@ Namespace API.OnlyFans
440440
' 'postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
441441
' postUrl = GetMediaURL(m)
442442
'End If
443-
postUrlBase = String.Empty
444-
Select Case m.Value("type")
445-
Case "photo" : t = UTypes.Picture : ext = "jpg"
446-
Case "video"
447-
t = UTypes.Video
448-
ext = "mp4"
449-
If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then
450-
t = UTypes.VideoPre
451-
_AbsMediaIndex += 1
452-
If Not PostUserID.IsEmptyString And IsSingleObjectDownload Then _
453-
postUrlBase = String.Format(SiteSettings.UserPostPattern, PostID, $"u{PostUserID}")
454-
End If
455-
Case Else : t = UTypes.Undefined : ext = String.Empty
456-
End Select
457-
If Not t = UTypes.Undefined And (Not postUrl.IsEmptyString Or t = UTypes.VideoPre) Then
458-
Dim media As New UserMedia(postUrl.IfNullOrEmpty(IIf(t = UTypes.VideoPre, $"{t}{_AbsMediaIndex}", String.Empty)), t) With {
459-
.Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing)),
460-
.SpecialFolder = SpecFolder,
461-
.PostText = PostText,
462-
.PostTextFileSpecialFolder = DownloadTextSpecialFolder
463-
}
464-
If postUrlBase.IsEmptyString And Not IsSingleObjectDownload Then postUrlBase = GetPostUrl(Me, media)
465-
If Not postUrlBase.IsEmptyString Then media.URL_BASE = postUrlBase
466-
media.File.Extension = ext
467-
Result = True
468-
mList.Add(media)
443+
If m.Value("canView").FromXML(Of Boolean)(True) Then
444+
postUrlBase = String.Empty
445+
Select Case m.Value("type")
446+
Case "photo" : t = UTypes.Picture : ext = "jpg"
447+
Case "video", "gif"
448+
t = UTypes.Video
449+
ext = "mp4"
450+
If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then
451+
t = UTypes.VideoPre
452+
_AbsMediaIndex += 1
453+
If Not PostUserID.IsEmptyString And IsSingleObjectDownload Then _
454+
postUrlBase = String.Format(SiteSettings.UserPostPattern, PostID, $"u{PostUserID}")
455+
End If
456+
Case Else : t = UTypes.Undefined : ext = String.Empty
457+
End Select
458+
If Not t = UTypes.Undefined And (Not postUrl.IsEmptyString Or t = UTypes.VideoPre) Then
459+
Dim media As New UserMedia(postUrl.IfNullOrEmpty(IIf(t = UTypes.VideoPre, $"{t}{_AbsMediaIndex}", String.Empty)), t) With {
460+
.Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing)),
461+
.SpecialFolder = SpecFolder,
462+
.PostText = PostText,
463+
.PostTextFileSpecialFolder = DownloadTextSpecialFolder
464+
}
465+
If postUrlBase.IsEmptyString And Not IsSingleObjectDownload Then postUrlBase = GetPostUrl(Me, media)
466+
If Not postUrlBase.IsEmptyString Then media.URL_BASE = postUrlBase
467+
media.File.Extension = ext
468+
Result = True
469+
mList.Add(media)
470+
End If
469471
End If
470472
Next
471473
End If

‎SCrawler/API/PornHub/UserData.vb‎

Lines changed: 3 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ Imports PersonalUtilities.Tools.Web.Clients
1515
Imports PersonalUtilities.Tools.Web.Documents.JSON
1616
Imports UTypes = SCrawler.API.Base.UserMedia.Types
1717
Namespace API.PornHub
18-
Friend Class UserData : Inherits UserDataBase
18+
Friend Class UserData : Inherits UserDataBase : Implements IPSite
1919
Private Const UrlPattern As String = "https://www.pornhub.com/{0}"
2020
#Region "Declarations"
2121
#Region "XML names"
@@ -140,7 +140,7 @@ Namespace API.PornHub
140140
End Get
141141
End Property
142142
Friend Property SiteMode As SiteModes = SiteModes.User
143-
Friend Property QueryString As String
143+
Friend Property QueryString As String Implements IPSite.QueryString
144144
Get
145145
If IsUser Then
146146
Return String.Empty
@@ -163,17 +163,7 @@ Namespace API.PornHub
163163
Return New UserExchangeOptions(Me)
164164
End Function
165165
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
166-
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
167-
With DirectCast(Obj, UserExchangeOptions)
168-
DownloadUHD = .DownloadUHD
169-
DownloadUploaded = .DownloadUploaded
170-
DownloadTagged = .DownloadTagged
171-
DownloadPrivate = .DownloadPrivate
172-
DownloadFavorite = .DownloadFavorite
173-
DownloadGifs = .DownloadGifs
174-
QueryString = .QueryString
175-
End With
176-
End If
166+
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
177167
End Sub
178168
#End Region
179169
Private ReadOnly Property MySettings As SiteSettings

‎SCrawler/API/PornHub/UserExchangeOptions.vb‎

Lines changed: 15 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,9 +6,10 @@
66
'
77
' This program is distributed in the hope that it will be useful,
88
' but WITHOUT ANY WARRANTY
9+
Imports SCrawler.API.Base
910
Imports SCrawler.Plugin.Attributes
1011
Namespace API.PornHub
11-
Friend Class UserExchangeOptions : Inherits Xhamster.UserExchangeOptions
12+
Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase_P
1213
<PSetting(NameOf(SiteSettings.DownloadUHD), NameOf(MySettings))>
1314
Friend Property DownloadUHD As Boolean
1415
<PSetting(NameOf(SiteSettings.DownloadUploaded), NameOf(MySettings))>
@@ -23,16 +24,17 @@ Namespace API.PornHub
2324
Friend Property DownloadGifs As Boolean
2425
Private ReadOnly Property MySettings As SiteSettings
2526
Friend Sub New(ByVal u As UserData)
27+
MyBase.New(u)
2628
DownloadUHD = u.DownloadUHD
2729
DownloadUploaded = u.DownloadUploaded
2830
DownloadTagged = u.DownloadTagged
2931
DownloadPrivate = u.DownloadPrivate
3032
DownloadFavorite = u.DownloadFavorite
3133
DownloadGifs = u.DownloadGifs
32-
QueryString = u.QueryString
3334
MySettings = u.HOST.Source
3435
End Sub
3536
Friend Sub New(ByVal s As SiteSettings)
37+
MyBase.New(s)
3638
Dim v As CheckState = CInt(s.DownloadGifs.Value)
3739
DownloadUHD = s.DownloadUHD.Value
3840
DownloadUploaded = s.DownloadUploaded.Value
@@ -42,5 +44,16 @@ Namespace API.PornHub
4244
DownloadGifs = Not v = CheckState.Unchecked
4345
MySettings = s
4446
End Sub
47+
Friend Overrides Sub Apply(ByRef u As IPSite)
48+
MyBase.Apply(u)
49+
With DirectCast(u, UserData)
50+
.DownloadUHD = DownloadUHD
51+
.DownloadUploaded = DownloadUploaded
52+
.DownloadTagged = DownloadTagged
53+
.DownloadPrivate = DownloadPrivate
54+
.DownloadFavorite = DownloadFavorite
55+
.DownloadGifs = DownloadGifs
56+
End With
57+
End Sub
4558
End Class
4659
End Namespace

‎SCrawler/API/Reddit/SiteSettings.vb‎

Lines changed: 43 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@
99
Imports SCrawler.API.Base
1010
Imports SCrawler.Plugin
1111
Imports SCrawler.Plugin.Attributes
12+
Imports System.Reflection
1213
Imports PersonalUtilities.Tools.Web.Clients
1314
Imports PersonalUtilities.Tools.Web.Clients.Base
1415
Imports PersonalUtilities.Tools.Web.Documents.JSON
@@ -58,6 +59,48 @@ Namespace API.Reddit
5859
Return {AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString)
5960
End Get
6061
End Property
62+
<PropertiesDataChecker({NameOf(AuthUserName), NameOf(AuthPassword), NameOf(ApiClientID), NameOf(ApiClientSecret),
63+
NameOf(UseTokenForTimelines), NameOf(UseCookiesForTimelines)})>
64+
Private Function OAuthCredentialsChecker(ByVal p As IEnumerable(Of PropertyData)) As Boolean
65+
Const msgTitle$ = "OAuth credentials"
66+
If p.ListExists Then
67+
Dim useToken As Boolean = False, useCookies As Boolean = False
68+
Dim d$ = String.Empty
69+
Dim dCount As Byte = 0
70+
Dim members As IEnumerable(Of MemberInfo) = GetObjectMembers(Me)
71+
Dim getPropText As Func(Of String, String) = Function(name) members.First(Function(m) m.Name = name).GetCustomAttribute(Of PropertyOption).ControlText
72+
Dim dataStr As Action(Of String, String) = Sub(dd, name) If dd.IsEmptyString Then d.StringAppendLine(getPropText(name)) : dCount += 1
73+
For Each pp As PropertyData In p
74+
Select Case pp.Name
75+
Case NameOf(AuthUserName) : dataStr(pp.Value, NameOf(AuthUserName))
76+
Case NameOf(AuthPassword) : dataStr(pp.Value, NameOf(AuthPassword))
77+
Case NameOf(ApiClientID) : dataStr(pp.Value, NameOf(ApiClientID))
78+
Case NameOf(ApiClientSecret) : dataStr(pp.Value, NameOf(ApiClientSecret))
79+
Case NameOf(UseTokenForTimelines) : useToken = pp.Value
80+
Case NameOf(UseCookiesForTimelines) : useCookies = pp.Value
81+
Case Else : Throw New ArgumentException($"Property name '{pp.Name}' is not implemented", "Property Name")
82+
End Select
83+
Next
84+
If d.IsEmptyString Then
85+
If useToken And useCookies Then
86+
Return True
87+
Else
88+
If Not useToken Then d.StringAppendLine(getPropText(NameOf(UseTokenForTimelines)))
89+
If Not useCookies Then d.StringAppendLine(getPropText(NameOf(UseCookiesForTimelines)))
90+
MsgBoxE({$"You need to check the following options:{vbCr}{d}", msgTitle}, vbCritical)
91+
Return False
92+
End If
93+
ElseIf dCount = 4 Then
94+
Return MsgBoxE({$"You haven't configured OAuth. It's highly recommended to use OAuth.{vbCr}Do you still want to continue?", msgTitle},
95+
vbExclamation,,, {"Process", "Cancel"}) = 0
96+
Else
97+
MsgBoxE({$"You haven't filled in the following fields:{vbCr}{d}.{vbCr}{vbCr}" &
98+
"To use OAuth authorization, you must fill in all authorization fields.", msgTitle}, vbCritical)
99+
Return False
100+
End If
101+
End If
102+
Return True
103+
End Function
61104
#End Region
62105
#Region "Other"
63106
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML, PClonable>
@@ -233,23 +276,6 @@ Namespace API.Reddit
233276
End Sub
234277
#End Region
235278
#Region "Token"
236-
<PropertiesDataChecker({NameOf(AuthUserName), NameOf(AuthPassword), NameOf(ApiClientID), NameOf(ApiClientSecret)})>
237-
Private Function TokenPropertiesChecker(ByVal p As IEnumerable(Of PropertyData)) As Boolean
238-
If p.ListExists Then
239-
Dim wrong As New List(Of String)
240-
For i% = 0 To p.Count - 1
241-
If CStr(p(i).Value).IsEmptyString Then wrong.Add(p(i).Name)
242-
Next
243-
If wrong.Count > 0 And wrong.Count <> 4 Then
244-
MsgBoxE({$"You have not completed the following fields: {wrong.ListToString}." & vbCr &
245-
"To use OAuth authorization, all authorization fields must be filled in.", "Validate token fields"}, vbCritical)
246-
Return False
247-
Else
248-
Return True
249-
End If
250-
End If
251-
Return False
252-
End Function
253279
Private Function UpdateTokenIfRequired() As Boolean
254280
UpdateRedGifsToken()
255281
If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso CredentialsExists Then

0 commit comments

Comments
 (0)