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

2024.3.17.0

Browse Source 
API.OnlyFans: add stories download
API.PornHub: fix list trim
This commit is contained in:
Andy
2024-03-17 23:02:00 +03:00
parent 7a68067d77
commit 2bacc17ac4
5 changed files with 94 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
SCrawler/API/OnlyFans/SiteSettings.vb
View File

@@ -18,10 +18,14 @@ Namespace API.OnlyFans
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
#Region "Options" #Region "Options"
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download user timeline"), PXML, PClonable>
Friend ReadOnly Property DownloadTimeline As PropertyValue
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download profile stories if they exists"), PXML, PClonable>
Friend ReadOnly Property DownloadStories As PropertyValue
<PropertyOption(ControlText:="Download highlights", ControlToolTip:="Download profile highlights if they exists"), PXML, PClonable> <PropertyOption(ControlText:="Download highlights", ControlToolTip:="Download profile highlights if they exists"), PXML, PClonable>
Friend Property DownloadHighlights As PropertyValue Friend ReadOnly Property DownloadHighlights As PropertyValue
<PropertyOption(ControlText:="Download chat", ControlToolTip:="Download unlocked chat media"), PXML, PClonable> <PropertyOption(ControlText:="Download chat", ControlToolTip:="Download unlocked chat media"), PXML, PClonable>
Friend Property DownloadChatMedia As PropertyValue Friend ReadOnly Property DownloadChatMedia As PropertyValue
#End Region #End Region
#Region "Headers" #Region "Headers"
Private Const HeaderBrowser As String = "sec-ch-ua" Private Const HeaderBrowser As String = "sec-ch-ua"
@@ -145,6 +149,8 @@ Namespace API.OnlyFans
UserAgent = New PropertyValue(IIf(.UserAgentExists, .UserAgent, String.Empty), GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v)) UserAgent = New PropertyValue(IIf(.UserAgentExists, .UserAgent, String.Empty), GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v))
End With End With
DownloadTimeline = New PropertyValue(True)
DownloadStories = New PropertyValue(True)
DownloadHighlights = New PropertyValue(True) DownloadHighlights = New PropertyValue(True)
DownloadChatMedia = New PropertyValue(True) DownloadChatMedia = New PropertyValue(True)

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

@@ -22,6 +22,8 @@ Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.OnlyFans Namespace API.OnlyFans
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
#Region "XML names" #Region "XML names"
Private Const Name_MediaDownloadTimeline As String = "MediaDownloadTimeline"
Private Const Name_MediaDownloadStories As String = "MediaDownloadStories"
Private Const Name_MediaDownloadHighlights As String = "DownloadHighlights" Private Const Name_MediaDownloadHighlights As String = "DownloadHighlights"
Private Const Name_MediaDownloadChatMedia As String = "DownloadChatMedia" Private Const Name_MediaDownloadChatMedia As String = "DownloadChatMedia"
#End Region #End Region
@@ -30,6 +32,8 @@ Namespace API.OnlyFans
Private Const HeaderSign As String = "Sign" Private Const HeaderSign As String = "Sign"
Private Const HeaderTime As String = "Time" Private Const HeaderTime As String = "Time"
Private ReadOnly HighlightsList As List(Of String) Private ReadOnly HighlightsList As List(Of String)
Friend Property MediaDownloadTimeline As Boolean = True
Friend Property MediaDownloadStories As Boolean = True
Friend Property MediaDownloadHighlights As Boolean = True Friend Property MediaDownloadHighlights As Boolean = True
Friend Property MediaDownloadChatMedia As Boolean = True Friend Property MediaDownloadChatMedia As Boolean = True
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
@@ -42,9 +46,13 @@ Namespace API.OnlyFans
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container With Container
If Loading Then If Loading Then
MediaDownloadTimeline = .Value(Name_MediaDownloadTimeline).FromXML(Of Boolean)(True)
MediaDownloadStories = .Value(Name_MediaDownloadStories).FromXML(Of Boolean)(True)
MediaDownloadHighlights = .Value(Name_MediaDownloadHighlights).FromXML(Of Boolean)(True) MediaDownloadHighlights = .Value(Name_MediaDownloadHighlights).FromXML(Of Boolean)(True)
MediaDownloadChatMedia = .Value(Name_MediaDownloadChatMedia).FromXML(Of Boolean)(True) MediaDownloadChatMedia = .Value(Name_MediaDownloadChatMedia).FromXML(Of Boolean)(True)
Else Else
.Add(Name_MediaDownloadTimeline, MediaDownloadTimeline.BoolToInteger)
.Add(Name_MediaDownloadStories, MediaDownloadStories.BoolToInteger)
.Add(Name_MediaDownloadHighlights, MediaDownloadHighlights.BoolToInteger) .Add(Name_MediaDownloadHighlights, MediaDownloadHighlights.BoolToInteger)
.Add(Name_MediaDownloadChatMedia, MediaDownloadChatMedia.BoolToInteger) .Add(Name_MediaDownloadChatMedia, MediaDownloadChatMedia.BoolToInteger)
End If End If
@@ -58,6 +66,8 @@ Namespace API.OnlyFans
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
With DirectCast(Obj, UserExchangeOptions) With DirectCast(Obj, UserExchangeOptions)
MediaDownloadTimeline = .DownloadTimeline
MediaDownloadStories = .DownloadStories
MediaDownloadHighlights = .DownloadHighlights MediaDownloadHighlights = .DownloadHighlights
MediaDownloadChatMedia = .DownloadChatMedia MediaDownloadChatMedia = .DownloadChatMedia
End With End With
@@ -90,8 +100,15 @@ Namespace API.OnlyFans
Responser.Cookies.Clear() Responser.Cookies.Clear()
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
UpdateCookieHeader() UpdateCookieHeader()
DownloadTimeline(IIf(IsSavedPosts, 0, String.Empty), Token)
If Not IsSavedPosts Then If Not IsSavedPosts Then
If ID.IsEmptyString Then GetUserID()
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "Unable to get user ID")
End If
If MediaDownloadTimeline Then DownloadTimeline(IIf(IsSavedPosts, 0, String.Empty), Token)
If Not IsSavedPosts Then
If MediaDownloadStories And FunctionErr = FunctionErrDef Then DownloadStories(Token)
If MediaDownloadHighlights And FunctionErr = FunctionErrDef Then DownloadHighlights(Token) If MediaDownloadHighlights And FunctionErr = FunctionErrDef Then DownloadHighlights(Token)
If MediaDownloadChatMedia And FunctionErr = FunctionErrDef Then DownloadChatMedia(0, Token) If MediaDownloadChatMedia And FunctionErr = FunctionErrDef Then DownloadChatMedia(0, Token)
End If End If
@@ -114,6 +131,7 @@ Namespace API.OnlyFans
Return ErrValue <> 2 Return ErrValue <> 2
End Function End Function
Friend Const A_HIGHLIGHT As String = "HL" Friend Const A_HIGHLIGHT As String = "HL"
Friend Const A_STORIES As String = "ST"
Friend Const A_MESSAGE As String = "MSG" Friend Const A_MESSAGE As String = "MSG"
Private Const BaseUrlPattern As String = "https://onlyfans.com{0}" Private Const BaseUrlPattern As String = "https://onlyfans.com{0}"
#Region "Download timeline" #Region "Download timeline"
@@ -133,9 +151,6 @@ Namespace API.OnlyFans
If IsSavedPosts Then If IsSavedPosts Then
path = $"/api2/v2/posts/bookmarks/all/?format=infinite&limit=10&offset={Cursor}" path = $"/api2/v2/posts/bookmarks/all/?format=infinite&limit=10&offset={Cursor}"
Else Else
If ID.IsEmptyString Then GetUserID()
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "Unable to get user ID")
path = $"/api2/v2/users/{ID}/posts/medias?limit=50&order=publish_date_desc&skip_users=all&format=infinite&counters=1" path = $"/api2/v2/users/{ID}/posts/medias?limit=50&order=publish_date_desc&skip_users=all&format=infinite&counters=1"
If Not Cursor.IsEmptyString Then path &= $"&counters=0&beforePublishTime={Cursor}" Else path &= "&counters=1" If Not Cursor.IsEmptyString Then path &= $"&counters=0&beforePublishTime={Cursor}" Else path &= "&counters=1"
End If End If
@@ -250,7 +265,7 @@ Namespace API.OnlyFans
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
specFolder = j.Value("title").StringRemoveWinForbiddenSymbols.IfNullOrEmpty(HLID) specFolder = "Highlights\" & j.Value("title").StringRemoveWinForbiddenSymbols.IfNullOrEmpty(HLID)
specFolder &= "*" specFolder &= "*"
With j("stories") With j("stories")
If .ListExists Then If .ListExists Then
@@ -280,6 +295,57 @@ Namespace API.OnlyFans
Loop While Not _complete Loop While Not _complete
End Sub End Sub
#End Region #End Region
#Region "Download stories"
Private Sub DownloadStories(ByVal Token As CancellationToken)
Dim url$ = String.Empty
Dim _complete As Boolean = True
Do
Try
Dim specFolder$ = "Stories"
Dim postID$, postDate$
Dim media As List(Of UserMedia)
Dim result As Boolean
Dim path$ = $"/api2/v2/users/{ID}/stories"
If UpdateSignature(path) Then
url = String.Format(BaseUrlPattern, path)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(url)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
ProgressPre.ChangeMax(j.Count)
For Each n As EContainer In j
ProgressPre.Perform()
With n.ItemF({"media", 0})
If .ListExists Then
postID = $"{A_STORIES}_{ .Value("id")}"
postDate = .Value("createdAt")
Else
postID = String.Empty
postDate = String.Empty
End If
End With
If Not postID.IsEmptyString Then
If Not _TempPostsList.Contains(postID) Then
_TempPostsList.Add(postID)
Else
Exit Sub
End If
End If
result = False
media = TryCreateMedia(n, postID, postDate, result, True, specFolder,, False)
If result Then _TempMediaList.ListAddList(media, LNC)
Next
End If
End Using
End If
End If
Catch ex As Exception
_complete = ProcessFunctionErrComplete(ProcessException(ex, Token, $"stories downloading error [{url}]"))
End Try
Loop While Not _complete
End Sub
#End Region
#Region "Download chat media" #Region "Download chat media"
Private Sub DownloadChatMedia(ByVal Cursor As Integer, ByVal Token As CancellationToken) Private Sub DownloadChatMedia(ByVal Cursor As Integer, ByVal Token As CancellationToken)
Dim url$ = String.Empty Dim url$ = String.Empty
@@ -329,7 +395,8 @@ Namespace API.OnlyFans
#End Region #End Region
Private Function TryCreateMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal PostDate As String = Nothing, Private Function TryCreateMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal PostDate As String = Nothing,
Optional ByRef Result As Boolean = False, Optional ByVal IsHL As Boolean = False, Optional ByRef Result As Boolean = False, Optional ByVal IsHL As Boolean = False,
Optional ByVal SpecFolder As String = Nothing, Optional ByVal PostUserID As String = Nothing) As List(Of UserMedia) Optional ByVal SpecFolder As String = Nothing, Optional ByVal PostUserID As String = Nothing,
Optional ByVal TryUseOFS As Boolean = True) As List(Of UserMedia)
Dim postUrl$, postUrlBase$, ext$ Dim postUrl$, postUrlBase$, ext$
Dim t As UTypes Dim t As UTypes
Dim mList As New List(Of UserMedia) Dim mList As New List(Of UserMedia)
@@ -348,7 +415,7 @@ Namespace API.OnlyFans
Case "video" Case "video"
t = UTypes.Video t = UTypes.Video
ext = "mp4" ext = "mp4"
If postUrl.IsEmptyString And Not IsHL Then If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then
t = UTypes.VideoPre t = UTypes.VideoPre
_AbsMediaIndex += 1 _AbsMediaIndex += 1
If Not PostUserID.IsEmptyString And IsSingleObjectDownload Then _ If Not PostUserID.IsEmptyString And IsSingleObjectDownload Then _

8
SCrawler/API/OnlyFans/UserExchangeOptions.vb
View File

@@ -9,17 +9,25 @@
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.OnlyFans Namespace API.OnlyFans
Friend Class UserExchangeOptions Friend Class UserExchangeOptions
<PSetting(NameOf(SiteSettings.DownloadTimeline), NameOf(MySettings))>
Friend Property DownloadTimeline As Boolean
<PSetting(NameOf(SiteSettings.DownloadStories), NameOf(MySettings))>
Friend Property DownloadStories As Boolean
<PSetting(NameOf(SiteSettings.DownloadHighlights), NameOf(MySettings))> <PSetting(NameOf(SiteSettings.DownloadHighlights), NameOf(MySettings))>
Friend Property DownloadHighlights As Boolean Friend Property DownloadHighlights As Boolean
<PSetting(NameOf(SiteSettings.DownloadChatMedia), NameOf(MySettings))> <PSetting(NameOf(SiteSettings.DownloadChatMedia), NameOf(MySettings))>
Friend Property DownloadChatMedia As Boolean Friend Property DownloadChatMedia As Boolean
Private ReadOnly MySettings As SiteSettings Private ReadOnly MySettings As SiteSettings
Friend Sub New(ByVal u As UserData) Friend Sub New(ByVal u As UserData)
DownloadTimeline = u.MediaDownloadTimeline
DownloadStories = u.MediaDownloadStories
DownloadHighlights = u.MediaDownloadHighlights DownloadHighlights = u.MediaDownloadHighlights
DownloadChatMedia = u.MediaDownloadChatMedia DownloadChatMedia = u.MediaDownloadChatMedia
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)
DownloadTimeline = s.DownloadTimeline.Value
DownloadStories = s.DownloadStories.Value
DownloadHighlights = s.DownloadHighlights.Value DownloadHighlights = s.DownloadHighlights.Value
DownloadChatMedia = s.DownloadChatMedia.Value DownloadChatMedia = s.DownloadChatMedia.Value
MySettings = s MySettings = s

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

@@ -404,7 +404,9 @@ Namespace API.PornHub
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim l As List(Of UserVideo) = RegexFields(Of UserVideo)(r, {RegexUserVideos}, {6, 7, 3, 10}) Dim l As List(Of UserVideo) = RegexFields(Of UserVideo)(r, {RegexUserVideos}, {6, 7, 3, 10})
If l.ListExists And Not SiteMode = SiteModes.Playlists Then l = l.ListTake(3, l.Count).ToList 'URGENT: PornHub: changed list trimming
'If l.ListExists And Not SiteMode = SiteModes.Playlists Then l = l.ListTake(3, l.Count).ToList
If l.ListExists And Not SiteMode = SiteModes.Playlists Then l = l.ListTake(1, l.Count).ToList
If l.ListExists Then If l.ListExists Then
If IsUser Then If IsUser Then
If Type = VideoTypes.Favorite Then If Type = VideoTypes.Favorite Then

2
SCrawler/Download/Feed/FeedMedia.vb
View File

@@ -498,7 +498,7 @@ Namespace DownloadObjects
If f.DialogResult = DialogResult.OK Then moveOptions = f.Result If f.DialogResult = DialogResult.OK Then moveOptions = f.Result
End Using End Using
If Not moveOptions.Destination.IsEmptyString Then If Not moveOptions.Destination.IsEmptyString Then
ff.Path = moveOptions.Destination.Path ff.Path = moveOptions.DestinationTrue(Media).Path
If isCopy Then If isCopy Then
result = File.Copy(ff) result = File.Copy(ff)
Else Else