2023.11.15.0

ADD FACEBOOK
SiteSettingsBase: update 'CLONE_PROPERTIES' function (exclude 'DoNotUse' attribute)
API.Instagram: handle 401 error
API.ThreadsNet.SiteSettings: make the class compatible for Facebook
xHanster, XVideos, PornHub, ThisVid: update download function for search queries
Hosts.PropertyValueHost: set the 'Exists' value based on the 'DoNotUse' attribute
Hosts.SettingsHost: use 'GetObjectMembers' instead of 'GetTypeInfo.DeclaredMembers' to get class members
This commit is contained in:
Andy
2023-11-15 23:50:34 +03:00
parent 96705f1c59
commit 496c9487cd
22 changed files with 1125 additions and 60 deletions

View File

@@ -65,6 +65,12 @@ Namespace Plugin.Attributes
End Class End Class
''' <summary>Attribute to disable some properties for host use</summary> ''' <summary>Attribute to disable some properties for host use</summary>
<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class DoNotUse : Inherits Attribute <AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class DoNotUse : Inherits Attribute
Public ReadOnly Value As Boolean = True
Public Sub New()
End Sub
Public Sub New(ByVal Value As Boolean)
Me.Value = Value
End Sub
End Class End Class
''' <summary>Special property updater</summary> ''' <summary>Special property updater</summary>
<AttributeUsage(AttributeTargets.Method, AllowMultiple:=True, Inherited:=False)> Public NotInheritable Class PropertyUpdater : Inherits Attribute <AttributeUsage(AttributeTargets.Method, AllowMultiple:=True, Inherited:=False)> Public NotInheritable Class PropertyUpdater : Inherits Attribute

View File

@@ -11,6 +11,8 @@ Namespace API.Base
Friend Const Header_Authorization As String = "authorization" Friend Const Header_Authorization As String = "authorization"
Friend Const Header_CSRFToken As String = "x-csrf-token" Friend Const Header_CSRFToken As String = "x-csrf-token"
Friend Const Header_FB_FRIENDLY_NAME As String = "x-fb-friendly-name"
Friend Const ConcurrentDownloadsCaption As String = "Concurrent downloads" Friend Const ConcurrentDownloadsCaption As String = "Concurrent downloads"
Friend Const ConcurrentDownloadsToolTip As String = "The number of concurrent downloads." Friend Const ConcurrentDownloadsToolTip As String = "The number of concurrent downloads."
Friend Const SavedPostsUserNameCaption As String = "Saved posts user" Friend Const SavedPostsUserNameCaption As String = "Saved posts user"

View File

@@ -278,9 +278,13 @@ Namespace API.Base
'1 = clone '1 = clone
'2 = any '2 = any
Dim filterUC As Func(Of MemberInfo, Byte, Boolean) = Function(ByVal m As MemberInfo, ByVal __mode As Byte) As Boolean Dim filterUC As Func(Of MemberInfo, Byte, Boolean) = Function(ByVal m As MemberInfo, ByVal __mode As Byte) As Boolean
With m.GetCustomAttribute(Of PClonableAttribute) If m.GetCustomAttribute(Of DoNotUse) Is Nothing Then
Return Not .Self Is Nothing AndAlso (__mode = 2 OrElse If(__mode = 0, .Update, .Clone)) Return False
End With Else
With m.GetCustomAttribute(Of PClonableAttribute)
Return Not .Self Is Nothing AndAlso (__mode = 2 OrElse If(__mode = 0, .Update, .Clone))
End With
End If
End Function End Function
Dim filterAll As Func(Of MemberInfo, Boolean) = Function(m) filterUC.Invoke(m, 2) Dim filterAll As Func(Of MemberInfo, Boolean) = Function(m) filterUC.Invoke(m, 2)
Dim filterC As Func(Of MemberInfo, Boolean) = Function(m) If(Full, filterAll.Invoke(m), filterUC.Invoke(m, 1)) Dim filterC As Func(Of MemberInfo, Boolean) = Function(m) If(Full, filterAll.Invoke(m), filterUC.Invoke(m, 1))

View File

@@ -0,0 +1,37 @@
' 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
Imports System.Text.RegularExpressions
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Facebook
Friend Module Declarations
Friend ReadOnly Regex_UserToken_dtsg As RParams = RParams.DMS("DTSGInitialData.:.?{\s*.token.:\s*""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_UserToken_lsd As RParams = RParams.DMS("LSD.:.?{\s*.token.:\s*""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_UserID As RParams = RParams.DMS("userid.:.(\d+)", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly Regex_Photos_by As RParams = RParams.DMS("photos_by"",""id"":""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_FileName As RParams = RParams.DM("([^/\?]+\..{3,4})(?=(\?|\Z))", 0, EDP.ReturnValue)
Friend ReadOnly Regex_ProfileUrlID As RParams = RParams.DMS("profile.php\?id=(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_VideoPageID As RParams = RParams.DMS("pageid.:.(\d+)", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly Regex_StoryBucket As RParams = RParams.DMS("story_bucket[^\>]*?(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_VideoIDFromURL As RParams = RParams.DMS("facebook.com/([^/]+/videos/|watch/\D*[\?&]{1}v=)(\d+)", 2, EDP.ReturnValue)
Friend ReadOnly Regex_PostHtmlFullPicture As RParams = RParams.DM("^((?!_[ps]{1}\d+x\d+).)*$", 0, EDP.ReturnValue)
Friend ReadOnly SpecialNode() As NodeParams = {New NodeParams("attachment", True, True, True, True, 30),
New NodeParams("media", True, True, True, True, 0),
New NodeParams("photo_image", True, True, True, True, 0),
New NodeParams("uri", True, True, True, True, 0)}
Friend ReadOnly SpecialNode2() As NodeParams = {New NodeParams("result", True, True, True, True, 30),
New NodeParams("data", True, True, True, True, 0),
New NodeParams("currmedia", True, True, True, True, 0),
New NodeParams("image", True, True, True, True, 0),
New NodeParams("uri", True, True, True, True, 0)}
End Module
End Namespace

View File

@@ -0,0 +1,110 @@
' 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
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Facebook
<Manifest("AndyProgram_Facebook"), SavedPosts, SeparatedTasks(1), SpecialForm(False)>
Friend Class SiteSettings : Inherits ThreadsNet.SiteSettings
#Region "Declarations"
#Region "Auth"
<PropertyOption(AllowNull:=False, ControlText:="Accept", ControlToolTip:="Header 'Accept'", IsAuth:=True), ControlNumber(21), PXML, PClonable>
Friend ReadOnly Property Header_Accept As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", AllowNull:=True, IsAuth:=True)>
Friend Overrides ReadOnly Property HH_IG_APP_ID As PropertyValue
Get
Return __HH_IG_APP_ID
End Get
End Property
<DoNotUse> Friend Overrides ReadOnly Property HH_CSRF_TOKEN As PropertyValue
Get
Return __HH_CSRF_TOKEN
End Get
End Property
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", IsAuth:=True, LeftOffset:=120), ControlNumber(51), PXML, PClonable>
Friend ReadOnly Property HH_PLATFORM_VER As PropertyValue
#End Region
#Region "Defaults"
<PropertyOption(ControlText:="Download photos", IsAuth:=False), PXML, PClonable>
Friend ReadOnly Property ParsePhotoBlock As PropertyValue
<PropertyOption(ControlText:="Download videos", IsAuth:=False), PXML, PClonable>
Friend ReadOnly Property ParseVideoBlock As PropertyValue
<PropertyOption(ControlText:="Download stories", IsAuth:=False), PXML, PClonable>
Friend ReadOnly Property ParseStoriesBlock As PropertyValue
#End Region
#End Region
#Region "Initializer"
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("Facebook", "facebook.com", AccName, Temp, My.Resources.SiteResources.FacebookIcon_32, My.Resources.SiteResources.FacebookPic_37)
With Responser.Headers
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.facebook.com"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Origin, "https://www.facebook.com"))
.Remove(DeclaredNames.Header_FB_FRIENDLY_NAME)
End With
Header_Accept = New PropertyValue(String.Empty, GetType(String))
HH_PLATFORM_VER = New PropertyValue(String.Empty, GetType(String))
ParsePhotoBlock = New PropertyValue(True)
ParseVideoBlock = New PropertyValue(True)
ParseStoriesBlock = New PropertyValue(True)
UrlPatternUser = "https://www.facebook.com/{0}"
UserRegex = RParams.DMS("facebook.com/(profile.php\?id=\d+|[^\?&/]+)", 1)
ImageVideoContains = "facebook.com"
UserOptionsType = GetType(UserExchangeOptions)
End Sub
#End Region
#Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
#End Region
#Region "UpdateResponserData"
Friend Overrides Sub UpdateResponserData(ByVal Resp As Responser)
With Responser.Cookies
.Update(Resp.Cookies)
If .Changed Then Responser.SaveCookies() : .Changed = False
End With
End Sub
#End Region
#Region "BaseAuthExists, GetUserUrl, GetUserPostUrl, IsMyUser, IsMyImageVideo"
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists And ACheck(HH_IG_APP_ID.Value)
End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return DirectCast(User, UserData).GetProfileUrl
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return Media.URL_BASE
End Function
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim e As ExchangeOptions = MyBase.IsMyUser(UserURL)
If e.Exists Then
e.Options = e.UserName
Dim v$ = RegexReplace(e.UserName, Regex_ProfileUrlID)
If Not v.IsEmptyString Then
e.UserName = v
Else
e.UserName = e.UserName.StringRemoveWinForbiddenSymbols
End If
End If
Return e
End Function
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
If Not URL.IsEmptyString AndAlso Not CStr(AConvert(Of String)(URL, Regex_VideoIDFromURL, String.Empty)).IsEmptyString Then
Return New ExchangeOptions(Site, String.Empty) With {.Exists = True}
Else
Return Nothing
End If
End Function
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,713 @@
' 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
Imports System.Threading
Imports System.Text.RegularExpressions
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports IG = SCrawler.API.Instagram.SiteSettings
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Facebook
Friend Class UserData : Inherits Instagram.UserData
#Region "XML names"
Private Const Name_IsNoNameProfile As String = "IsNoNameProfile"
Private Const Name_OptionsParsed As String = "OptionsParsed"
Private Const Name_VideoPageID As String = "VideoPageID"
Private Const Name_StoryBucket As String = "StoryBucket"
Private Const Name_ParsePhotoBlock As String = "ParsePhotoBlock"
Private Const Name_ParseVideoBlock As String = "ParseVideoBlock"
Private Const Name_ParseStoriesBlock As String = "ParseStoriesBlock"
#End Region
#Region "Declarations"
Friend ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
End Get
End Property
Private IsNoNameProfile As Boolean = False
Private OptionsParsed As Boolean = False
Private Property VideoPageID As String = String.Empty
Private Property StoryBucket As String = String.Empty
Friend Property ParsePhotoBlock As Boolean = True
Friend Property ParseVideoBlock As Boolean = True
Friend Property ParseStoriesBlock As Boolean = True
Private Enum PageBlock As Integer
Timeline = Sections.Timeline
Stories = Sections.Stories
Photos = 100
Videos = 101
Undefined = -1
End Enum
#End Region
#Region "GetProfileUrl"
Friend Function GetProfileUrl() As String
If IsNoNameProfile Then
Return $"https://www.facebook.com/profile.php?id={ID}"
Else
Return $"https://www.facebook.com/{NameTrue}"
End If
End Function
#End Region
#Region "Exchange"
Friend Overrides Function ExchangeOptionsGet() As Object
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)
ParsePhotoBlock = .ParsePhotoBlock
ParseVideoBlock = .ParseVideoBlock
ParseStoriesBlock = .ParseStoriesBlock
End With
End If
End Sub
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
Dim updateNames As Action = Sub()
If Not OptionsParsed AndAlso Not Options.IsEmptyString Then
OptionsParsed = True
Dim v$ = RegexReplace(Options, Regex_ProfileUrlID)
If Not v.IsEmptyString Then ID = v : IsNoNameProfile = True
End If
End Sub
With Container
If Loading Then
If .Contains(Name_IsNoNameProfile) Then
IsNoNameProfile = .Value(Name_IsNoNameProfile).FromXML(Of Boolean)(False)
Else
updateNames.Invoke
End If
OptionsParsed = .Value(Name_OptionsParsed).FromXML(Of Boolean)(False)
VideoPageID = .Value(Name_VideoPageID)
StoryBucket = .Value(Name_StoryBucket)
ParsePhotoBlock = .Value(Name_ParsePhotoBlock).FromXML(Of Boolean)(True)
ParseVideoBlock = .Value(Name_ParseVideoBlock).FromXML(Of Boolean)(True)
ParseStoriesBlock = .Value(Name_ParseStoriesBlock).FromXML(Of Boolean)(True)
Else
updateNames.Invoke
.Add(Name_IsNoNameProfile, IsNoNameProfile.BoolToInteger)
.Add(Name_OptionsParsed, OptionsParsed.BoolToInteger)
.Add(Name_VideoPageID, VideoPageID)
.Add(Name_StoryBucket, StoryBucket)
.Add(Name_ParsePhotoBlock, ParsePhotoBlock.BoolToInteger)
.Add(Name_ParseVideoBlock, ParseVideoBlock.BoolToInteger)
.Add(Name_ParseStoriesBlock, ParseStoriesBlock.BoolToInteger)
End If
End With
End Sub
#End Region
#Region "Download functions"
Private Token_dtsg As String = String.Empty
Private Token_lsd As String = String.Empty
Private Token_Photosby As String = String.Empty
Private Limit As Integer = -1
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
GetUserTokens(Token)
LoadSavePostsKV(True)
Limit = If(DownloadTopCount, -1)
If IsSavedPosts Then
DownloadData_SavedPosts(String.Empty, Token)
Else
If DownloadImages And ParsePhotoBlock Then DownloadData_Photo(String.Empty, Token)
If DownloadVideos And ParseVideoBlock Then DownloadData_Video(String.Empty, Token)
If (DownloadImages Or DownloadVideos) And ParseStoriesBlock Then DownloadData_Stories(Token)
End If
LoadSavePostsKV(False)
Finally
MySettings.UpdateResponserData(Responser)
End Try
End Sub
Private Const Header_fb_fr_name_Photo As String = "ProfileCometAppCollectionPhotosRendererPaginationQuery"
Private Const Header_fb_fr_name_Video As String = "PagesCometChannelTabAllVideosCardImplPaginationQuery"
Private Const Header_fb_fr_name_Stories As String = "StoriesSuspenseContentPaneRootWithEntryPointQuery"
Private Const Header_fb_fr_name_SavedPosts As String = "CometSaveDashboardAllItemsPaginationQuery"
Private Const DocID_Photo As String = "6684543058255697"
Private Const DocID_Video As String = "24545934291687581"
Private Const DocID_Stories As String = "6771064226315961"
Private Const DocID_SavedPosts As String = "7112228098805003"
Private Const Graphql_UrlPattern As String = "https://www.facebook.com/api/graphql?lsd={0}&doc_id={1}&server_timestamps=true&fb_dtsg={3}&fb_api_req_friendly_name={2}&variables={4}"
Private Const VideoHtmlUrlPattern As String = "https://www.facebook.com/watch/?v={0}"
Private Sub DownloadData_Photo(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Const VarPattern$ = """count"":8,""cursor"":""{0}"",""scale"":1,""id"":""{1}"""
Try
Dim nextCursor$ = String.Empty
Dim newPostsDetected As Boolean = False
Dim pUrl$, pUrlBase$
Dim pid As PostKV
ValidateBaseTokens()
If Token_Photosby.IsEmptyString Then Throw New ArgumentNullException("Token_Photosby", "Unable to obtain token")
URL = String.Format(Graphql_UrlPattern, Token_lsd, DocID_Photo, Header_fb_fr_name_Photo,
SymbolsConverter.ASCII.EncodeSymbolsOnly(Token_dtsg),
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(VarPattern, Cursor, Token_Photosby) & "}"))
ResponserApplyDefs(Header_fb_fr_name_Photo)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
With j({"data", "node", "pageItems", "edges"})
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each jNode As EContainer In .Self
ProgressPre.Perform()
With jNode
If Not .Value("cursor").IsEmptyString Then nextCursor = .Value("cursor")
With .Item({"node"})
If .ListExists Then
pUrl = .Value({"node", "viewer_image"}, "uri")
pUrlBase = .Value("url")
If Not pUrl.IsEmptyString Then
pid = New PostKV(.Value("id"), .Value({"node"}, "id"), PageBlock.Photos)
If Not PostKvExists(pid) Then
newPostsDetected = True
PostsKVIDs.ListAddValue(pid, LNC)
_TempPostsList.Add(pid.ID)
_TempMediaList.ListAddValue(New UserMedia(pUrl, UTypes.Picture) With {
.URL_BASE = pUrlBase,
.File = CreateFileFromUrl(pUrl),
.Post = pid.ID.IfNullOrEmpty(pid.Code)}, LNC)
If Limit > 0 And _TempMediaList.Count >= Limit Then Exit Sub
Else
Exit Sub
End If
End If
End If
End With
End With
Next
End If
End With
End If
End Using
End If
If newPostsDetected And Not nextCursor.IsEmptyString Then DownloadData_Photo(nextCursor, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data (photo) downloading error [{URL}]",, Responser)
End Try
End Sub
Private Sub DownloadData_Video(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Const VarPattern$ = """alwaysIncludeAudioRooms"":true,""count"":6,""cursor"":{0},""pageID"":""{1}"",""scale"":4,""showReactions"":true,""useDefaultActor"":false,""id"":""{1}"""
Try
Dim nextCursor$ = String.Empty
Dim newPostsDetected As Boolean = False
Dim pid As PostKV
If VideoPageID.IsEmptyString Then GetVideoPageID(Token)
If VideoPageID.IsEmptyString Then Throw New ArgumentNullException("VideoPageID", "Unable to obtain VideoPageID")
ValidateBaseTokens()
URL = String.Format(Graphql_UrlPattern, Token_lsd, DocID_Video, Header_fb_fr_name_Video,
SymbolsConverter.ASCII.EncodeSymbolsOnly(Token_dtsg),
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(VarPattern, If(Cursor.IsEmptyString, "null", $"""{Cursor}"""), VideoPageID) & "}"))
ResponserApplyDefs(Header_fb_fr_name_Video)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
With j({"data", "node", "all_videos", "edges"})
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each jNode As EContainer In .Self
ProgressPre.Perform()
pid = New PostKV(String.Empty, jNode.Value({"node"}, "id"), PageBlock.Videos)
pid.Code = $"Stories:{pid.ID}"
nextCursor = jNode.Value("cursor")
If Not PostKvExists(pid) Then
newPostsDetected = True
PostsKVIDs.ListAddValue(pid, LNC)
_TempPostsList.Add(pid.Code)
_TempMediaList.ListAddValue(New UserMedia(String.Format(VideoHtmlUrlPattern, pid.ID),
UTypes.VideoPre) With {.Post = pid.ID}, LNC)
If Limit > 0 And _TempMediaList.Count >= Limit Then Exit Sub
Else
Exit Sub
End If
Next
End If
End With
End If
End Using
End If
If newPostsDetected And Not nextCursor.IsEmptyString Then DownloadData_Video(nextCursor, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data (video) downloading error [{URL}]",, Responser)
End Try
End Sub
Private Sub DownloadData_Stories(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Const VarPattern$ = """UFI2CommentsProvider_commentsKey"":""StoriesSuspenseContentPaneRootWithEntryPointQuery"",""blur"":10,""bucketID"":""{0}"",""displayCommentsContextEnableComment"":true,""displayCommentsContextIsAdPreview"":false,""displayCommentsContextIsAggregatedShare"":false,""displayCommentsContextIsStorySet"":false,""displayCommentsFeedbackContext"":null,""feedbackSource"":65,""feedLocation"":""COMET_MEDIA_VIEWER"",""focusCommentID"":null,""initialBucketID"":""{0}"",""initialLoad"":true,""isInitialLoadFromCommentsNotification"":false,""isStoriesArchive"":false,""isStoryCommentingEnabled"":false,""scale"":1,""shouldDeferLoad"":false,""shouldEnableArmadilloStoryReply"":false,""shouldEnableLiveInStories"":true,""__relay_internal__pv__StoriesIsCommentEnabledrelayprovider"":false,""__relay_internal__pv__StoriesIsContextualReplyDisabledrelayprovider"":false,""__relay_internal__pv__StoriesIsShareToStoryEnabledrelayprovider"":false,""__relay_internal__pv__StoriesRingrelayprovider"":false,""__relay_internal__pv__StoriesLWRVariantrelayprovider"":""www_new_reactions"""
Try
Dim pUrl$, pUrlBase$
Dim pid As PostKV
Dim t As UTypes
Dim postDate As Date?
ValidateBaseTokens()
If StoryBucket.IsEmptyString Then Throw New ArgumentNullException("StoryBucket", "Unable to obtain StoryBucket")
URL = String.Format(Graphql_UrlPattern, Token_lsd, DocID_Stories, Header_fb_fr_name_Stories,
SymbolsConverter.ASCII.EncodeSymbolsOnly(Token_dtsg),
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(VarPattern, StoryBucket) & "}"))
ResponserApplyDefs(Header_fb_fr_name_Stories)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then r = RegexReplace(r, RParams.DM("[^\r\n]+", 0, EDP.ReturnValue))
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
With j({"data", "bucket", "unified_stories", "edges"})
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each jNode As EContainer In .Self
ProgressPre.Perform()
With jNode({"node"})
If .ListExists Then
pid = New PostKV(.Value("id"), "", Sections.Stories)
With .ItemF({"attachments", 0, "media"})
If .ListExists Then
pid.ID = .Value("id")
pUrl = String.Empty
postDate = AConvert(Of Date)(.Value("creation_time"), UnixDate32Provider, Nothing)
Select Case .Value("__typename")
Case "Photo"
t = UTypes.Picture
pUrl = .Value({"image"}, "uri")
Case "Video"
t = UTypes.Video
pUrl = .Value("browser_native_hd_url").IfNullOrEmpty(.Value("browser_native_sd_url"))
End Select
If Not pUrl.IsEmptyString AndAlso Not PostKvExists(pid) Then
pUrlBase = $"https://www.facebook.com/stories/{StoryBucket}"
PostsKVIDs.Add(pid)
_TempMediaList.ListAddValue(New UserMedia(pUrl, t) With {
.URL_BASE = pUrlBase,
.File = CreateFileFromUrl(pUrl),
.SpecialFolder = $"{StoriesFolder} (user)",
.Post = New UserPost(pid.ID, postDate)}, LNC)
End If
End If
End With
End If
End With
Next
End If
End With
End If
End Using
End If
Catch ex As Exception
ProcessException(ex, Token, $"data (stories) downloading error [{URL}]",, Responser)
End Try
End Sub
Private Sub DownloadData_SavedPosts(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Const VarPattern$ = """content_filter"":[],""count"":10,""cursor"":{0},""scale"":1,""use_case"":""SAVE_DEFAULT"""
Try
Dim nextCursor$ = String.Empty
Dim newPostsDetected As Boolean = False
Dim pUrl$, videoId$, imgUri$
Dim imgFile As SFile
Dim pid As PostKV
ValidateBaseTokens()
URL = String.Format(Graphql_UrlPattern, Token_lsd, DocID_SavedPosts, Header_fb_fr_name_SavedPosts,
SymbolsConverter.ASCII.EncodeSymbolsOnly(Token_dtsg),
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(VarPattern, If(Cursor.IsEmptyString, "null", $"""{Cursor}""")) & "}"))
ResponserApplyDefs(Header_fb_fr_name_SavedPosts)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
With j({"data", "viewer", "saver_info", "all_saves", "edges"})
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each jNode As EContainer In .Self
ProgressPre.Perform()
nextCursor = jNode.Value("cursor")
pid = New PostKV("", jNode.Value({"node"}, "id"), Sections.SavedPosts)
If Not PostKvExists(pid) Then
PostsKVIDs.Add(pid)
newPostsDetected = True
With jNode({"node", "savable"})
If .ListExists Then
pUrl = .Value("savable_permalink")
If Not pUrl.IsEmptyString Then
Select Case .Value("savable_default_category").StringToLower
Case "post_with_photo"
imgUri = .Value({"savable_image"}, "uri")
If Not imgUri.IsEmptyString Then
imgFile = CreateFileFromUrl(imgUri)
If Not imgFile.Name.IsEmptyString Then
ThrowAny(Token)
_TempMediaList.ListAddList(DownloadData_SavedPosts_ParseImagePost(pUrl, imgFile.Name, Token))
End If
End If
Case "video"
videoId = RegexReplace(pUrl, Regex_VideoIDFromURL)
If Not videoId.IsEmptyString Then _
_TempMediaList.ListAddValue(New UserMedia(pUrl, UTypes.VideoPre) With {.Post = videoId}, LNC)
Case Else : Continue For
End Select
End If
End If
End With
End If
Next
End If
End With
End If
End Using
End If
If newPostsDetected And Not nextCursor.IsEmptyString Then DownloadData_SavedPosts(nextCursor, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data (saved posts) downloading error [{URL}]",, Responser)
End Try
End Sub
Private Function DownloadData_SavedPosts_ParseImagePost(ByVal PostUrl As String, ByVal ImageName As String, ByVal Token As CancellationToken,
Optional ByVal Round As Integer = 0) As IEnumerable(Of UserMedia)
Dim resp As Responser = HtmlResponserCreate()
Try
If Round > 0 Then ThrowAny(Token)
Dim script$, newUrl$
Dim jNode As EContainer, jNode2 As EContainer
Dim r$ = resp.GetResponse(PostUrl)
If Not r.IsEmptyString Then
script = RegexReplace(r, RParams.DMS($"<script type=""application/json""[^\>]*data-sjs>([^<]+?{ImageName}[^<]+)<", 1, EDP.ReturnValue))
If Not script.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(script)
If j.ListExists Then
jNode = j.Find(Function(jj) Not jj.Name.IsEmptyString AndAlso jj.Name.ToLower = "prefetch_uris_v2", True)
If jNode.ListExists Then
For Each vNode As EContainer In jNode
newUrl = RegexReplace(vNode.Value("uri"), Regex_PostHtmlFullPicture)
If Not newUrl.IsEmptyString Then _
Return {New UserMedia(newUrl, UTypes.Picture) With {.URL_BASE = PostUrl, .File = CreateFileFromUrl(newUrl)}}
Next
End If
If Round = 0 Then
j.SetSourceReferences()
jNode = j.GetNode(SpecialNode)
If Not jNode Is Nothing AndAlso Not jNode.Value.IsEmptyString AndAlso Not jNode.Source Is Nothing Then
With DirectCast(jNode.Source, EContainer)
If Not .Source Is Nothing Then
newUrl = DirectCast(.Source, EContainer).Value("url")
If Not newUrl.IsEmptyString Then
Dim __data As IEnumerable(Of UserMedia) =
DownloadData_SavedPosts_ParseImagePost(newUrl, CreateFileFromUrl(jNode.Value).Name, Token, Round + 1)
If __data.ListExists Then Return __data
End If
End If
End With
End If
End If
jNode = j.Find(Function(jj) Not jj.Name.IsEmptyString AndAlso jj.Name = "viewer_image", True)
If Not jNode Is Nothing AndAlso Not jNode.Source Is Nothing Then
Dim doRound% = 0
Do : doRound += 1 : jNode = jNode.Source : Loop While doRound <= 30 AndAlso Not jNode Is Nothing AndAlso Not jNode.Name = "nodes"
If Not jNode Is Nothing AndAlso jNode.Name = "nodes" AndAlso jNode.Count > 0 Then
Dim mList As New List(Of UserMedia)
For Each jNode2 In jNode
With jNode2
newUrl = .Value({"media", "viewer_image"}, "uri")
If Not newUrl.IsEmptyString Then _
mList.Add(New UserMedia(newUrl, UTypes.Picture) With {.URL_BASE = PostUrl, .File = CreateFileFromUrl(newUrl)})
End With
Next
Return mList
End If
End If
newUrl = j.GetNode(SpecialNode2).XmlIfNothingValue
If Not newUrl.IsEmptyString Then _
Return {New UserMedia(newUrl, UTypes.Picture) With {.URL_BASE = PostUrl, .File = CreateFileFromUrl(newUrl)}}
End If
End Using
End If
End If
Return Nothing
Catch ex As Exception
ProcessException(ex, Token, $"data (saved posts) downloading error [{PostUrl}]",, resp, False)
Return Nothing
Finally
HtmlResponserDispose(resp)
End Try
End Function
#End Region
#Region "ValidateBaseTokens, GetVideoPageID, GetUserTokens"
''' <exception cref="ArgumentNullException"></exception>
Private Sub ValidateBaseTokens()
If Token_dtsg.IsEmptyString Then Throw New ArgumentNullException("Token_dtsg", "Unable to obtain token")
If Token_lsd.IsEmptyString Then Throw New ArgumentNullException("Token_lsd", "Unable to obtain token")
End Sub
Private Sub GetVideoPageID(ByVal Token As CancellationToken)
Dim URL$ = $"{GetProfileUrl()}\videos"
Dim resp As Responser = HtmlResponserCreate()
Try
Dim r$ = resp.GetResponse(URL)
If Not r.IsEmptyString Then VideoPageID = RegexReplace(r, Regex_VideoPageID)
Catch ex As Exception
ProcessException(ex, Token, "get video page ID",, resp)
Finally
HtmlResponserDispose(resp)
End Try
End Sub
Private Sub GetUserTokens(ByVal Token As CancellationToken)
Dim URL$ = If(IsSavedPosts, "https://www.facebook.com/saved", GetProfileUrl())
Dim resp As Responser = HtmlResponserCreate()
Try
Token_dtsg = String.Empty
Token_lsd = String.Empty
Token_Photosby = String.Empty
Dim r$ = resp.GetResponse(URL)
If Not r.IsEmptyString Then
If Responser.CookiesExists Then Responser.Cookies.Update(resp.Cookies)
Token_dtsg = RegexReplace(r, Regex_UserToken_dtsg)
Token_lsd = RegexReplace(r, Regex_UserToken_lsd)
Token_Photosby = RegexReplace(r, Regex_Photos_by)
If StoryBucket.IsEmptyString Then StoryBucket = RegexReplace(r, Regex_StoryBucket)
If ID.IsEmptyString Then
ID = RegexReplace(r, Regex_UserID)
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
End If
Catch ex As Exception
ProcessException(ex, Token, "get user token",, resp)
Finally
HtmlResponserDispose(resp)
End Try
End Sub
#End Region
#Region "Responser options"
Private Sub ResponserApplyDefs(ByVal __fb_friendly_name As String)
With Responser
.Headers.Add(ThreadsNet.UserData.Header_FB_LSD, Token_lsd)
.Headers.Add(DeclaredNames.Header_FB_FRIENDLY_NAME, __fb_friendly_name)
.Method = "POST"
.Accept = "*/*"
.Referer = GetProfileUrl()
End With
End Sub
Private Function HtmlResponserCreate() As Responser
Dim r As Responser = Responser.Copy
With r
.Accept = CStr(AConvert(Of String)(MySettings.Header_Accept.Value, String.Empty))
.Referer = Nothing
.Method = "GET"
With .Headers
.Clear()
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.facebook.com"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest, "document"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "navigate"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchSite, "none"))
.Add("Sec-Fetch-User", "?1")
.Add("Upgrade-Insecure-Requests", 1)
Dim h$ = Responser.Headers.Value(IG.Header_Browser)
If Not h.IsEmptyString Then .Add(IG.Header_Browser, h)
h = Responser.Headers.Value(IG.Header_BrowserExt)
If Not h.IsEmptyString Then .Add(IG.Header_BrowserExt, h)
h = .Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform))
If Not h.IsEmptyString Then .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform, h))
If ACheck(MySettings.HH_PLATFORM_VER.Value) Then _
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatformVersion, MySettings.HH_PLATFORM_VER.Value))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile, "?0"))
.Add("Sec-Ch-Ua-Model", "")
End With
End With
Return r
End Function
Private Sub HtmlResponserDispose(ByVal r As Responser)
If Not r Is Nothing Then
Responser.Cookies.Update(r.Cookies)
r.Dispose()
End If
End Sub
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Dim resp As Responser = HtmlResponserCreate()
Try
If ContentMissingExists Then
Dim m As UserMedia
Dim result As Boolean
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
m = _ContentList(i)
If (m.State = UStates.Missing And (m.Type = UTypes.Video Or m.Type = UTypes.VideoPre)) AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
result = False
m = ReparseSingleVideo(m, resp, result)
If result Then
rList.Add(i)
m.State = UStates.Missing
_TempMediaList.ListAddValue(m, LNC)
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "missing data downloading error")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
HtmlResponserDispose(resp)
End Try
End Sub
#End Region
#Region "ReparseVideo"
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Dim resp As Responser = HtmlResponserCreate()
Try
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.Type = UTypes.VideoPre) Then
ProgressPre.ChangeMax(_TempMediaList.Count)
Dim m As UserMedia
Dim result As Boolean
For i% = 0 To _TempMediaList.Count - 1
m = _TempMediaList(i)
If m.Type = UTypes.VideoPre Then
ThrowAny(Token)
result = False
m = ReparseSingleVideo(m, resp, result)
If Not result Then m.State = UStates.Missing
_TempMediaList(i) = m
End If
ProgressPre.Perform()
Next
End If
Catch ex As Exception
ProcessException(ex, Token, $"video reparsing error [{URL}]",, resp)
Finally
HtmlResponserDispose(resp)
End Try
End Sub
Protected Function ReparseSingleVideo(ByVal m As UserMedia, ByVal resp As Responser, ByRef result As Boolean) As UserMedia
Const nameSD$ = "browser_native_sd_url"
Const nameHD$ = "browser_native_hd_url"
Const pattern$ = "<script type=""application/json""[^\>]*data-sjs>([^<]+?{0}[^<]+)<"
Dim URL$ = String.Empty
Dim j As EContainer = Nothing
Try
Dim r$, script$, __url$
Dim jNode As EContainer
Dim jf As Predicate(Of EContainer) = Function(ee) Not ee.Name.IsEmptyString AndAlso (ee.Name.ToLower = nameSD Or ee.Name.ToLower = nameHD)
Dim re As RParams = RParams.DMS("", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
If m.Post.ID.IsEmptyString Then
URL = m.URL_BASE
Else
URL = String.Format(VideoHtmlUrlPattern, m.Post.ID)
End If
r = resp.GetResponse(URL)
If Not r.IsEmptyString Then
re.Pattern = String.Format(pattern, nameHD)
script = RegexReplace(r, re)
If script.IsEmptyString Then
re.Pattern = String.Format(pattern, nameSD)
script = RegexReplace(r, re)
End If
If Not script.IsEmptyString Then
j = JsonDocument.Parse(script)
If j.ListExists Then
j.SetSourceReferences()
jNode = j.Find(jf, True)
If Not jNode Is Nothing Then
With DirectCast(jNode.Source, EContainer)
__url = .Value(nameHD).IfNullOrEmpty(.Value(nameSD))
If Not __url.IsEmptyString Then
m.URL = __url
m.URL_BASE = URL
m.Type = UTypes.Video
m.File = CreateFileFromUrl(__url)
m.Post.Date = AConvert(Of Date)(.Value("publish_time"), UnixDate32Provider, Nothing)
result = True
Return m
End If
End With
End If
End If
End If
End If
Catch ex As Exception
End Try
j.DisposeIfReady
result = False
Return m
End Function
#End Region
#Region "CreateFileFromUrl"
Protected Overrides Function CreateFileFromUrl(ByVal URL As String) As SFile
If Not URL.IsEmptyString Then
Dim f$ = RegexReplace(URL, Regex_FileName)
If Not f.IsEmptyString Then
Return f
Else
Dim ff As New SFile(URL)
If Not ff.Extension.IsEmptyString Then
If ff.Length > 4 Then ff.Extension = ff.Extension.Split("?").FirstOrDefault
ff.Extension = ff.Extension.StringRemoveWinForbiddenSymbols
End If
ff.Name = ff.Name.StringRemoveWinForbiddenSymbols
Return ff
End If
End If
Return String.Empty
End Function
#End Region
#Region "DownloadContent"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
#End Region
#Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
_ContentList.Add(New UserMedia(Data.URL, UTypes.VideoPre) With {.Post = CStr(AConvert(Of String)(Data.URL, Regex_VideoIDFromURL, String.Empty))})
ReparseMissing(Token)
End Sub
#End Region
#Region "ThrowAny"
Friend Overrides Sub ThrowAny(ByVal Token As CancellationToken)
ThrowAnyImpl(Token)
End Sub
#End Region
#Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
Return 0
End Function
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,32 @@
' 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
Imports SCrawler.Plugin.Attributes
Namespace API.Facebook
Friend Class UserExchangeOptions
<PSetting(NameOf(SiteSettings.ParsePhotoBlock), NameOf(MySettings))>
Friend Property ParsePhotoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseVideoBlock), NameOf(MySettings))>
Friend Property ParseVideoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseStoriesBlock), NameOf(MySettings))>
Friend Property ParseStoriesBlock As Boolean = True
Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
MySettings = u.HostCollection.Default.Source
ParsePhotoBlock = u.ParsePhotoBlock
ParseVideoBlock = u.ParseVideoBlock
ParseStoriesBlock = u.ParseStoriesBlock
End Sub
Friend Sub New(ByVal s As SiteSettings)
MySettings = s
ParsePhotoBlock = s.ParsePhotoBlock.Value
ParseVideoBlock = s.ParseVideoBlock.Value
ParseStoriesBlock = s.ParseStoriesBlock.Value
End Sub
End Class
End Namespace

View File

@@ -71,7 +71,7 @@ Namespace API.Instagram
Return DirectCast(HOST.Source, SiteSettings) Return DirectCast(HOST.Source, SiteSettings)
End Get End Get
End Property End Property
Private ReadOnly PostsKVIDs As List(Of PostKV) Protected ReadOnly PostsKVIDs As List(Of PostKV)
Private ReadOnly PostsToReparse As List(Of PostKV) Private ReadOnly PostsToReparse As List(Of PostKV)
Private LastCursor As String = String.Empty Private LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = False Private FirstLoadingDone As Boolean = False
@@ -175,7 +175,7 @@ Namespace API.Instagram
End If End If
End If End If
End Sub End Sub
Private Overloads Function PostKvExists(ByVal pkv As PostKV) As Boolean Protected Overloads Function PostKvExists(ByVal pkv As PostKV) As Boolean
Return PostKvExists(pkv.ID, False, pkv.Section) OrElse PostKvExists(pkv.Code, True, pkv.Section) Return PostKvExists(pkv.ID, False, pkv.Section) OrElse PostKvExists(pkv.Code, True, pkv.Section)
End Function End Function
Private Overloads Function PostKvExists(ByVal PostCodeId As String, ByVal IsCode As Boolean, ByVal Section As Sections) As Boolean Private Overloads Function PostKvExists(ByVal PostCodeId As String, ByVal IsCode As Boolean, ByVal Section As Sections) As Boolean
@@ -297,7 +297,7 @@ Namespace API.Instagram
Declarations.UpdateResponser(e, Responser) Declarations.UpdateResponser(e, Responser)
End Sub End Sub
Protected Enum Sections : Timeline : Tagged : Stories : UserStories : SavedPosts : End Enum Protected Enum Sections : Timeline : Tagged : Stories : UserStories : SavedPosts : End Enum
Private Const StoriesFolder As String = "Stories" Protected Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged" Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass" #Region "429 bypass"
Private Const MaxPostsCount As Integer = 200 Private Const MaxPostsCount As Integer = 200
@@ -1011,7 +1011,7 @@ Namespace API.Instagram
Optional ByVal s As Object = Nothing) As Integer Optional ByVal s As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then '404 If Responser.StatusCode = HttpStatusCode.NotFound Then '404
If Not UserNameRequested AndAlso GetUserNameById() Then Return 1 Else UserExists = False If Not UserNameRequested AndAlso GetUserNameById() Then Return 1 Else UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then '400 ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Or Responser.StatusCode = HttpStatusCode.Unauthorized Then '400, 401
HasError = True HasError = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]" MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
DisableSection(s) DisableSection(s)

View File

@@ -194,13 +194,12 @@ Namespace API.PornHub
Return DirectCast(HOST.Source, SiteSettings) Return DirectCast(HOST.Source, SiteSettings)
End Get End Get
End Property End Property
Private ReadOnly LastPageIDs As List(Of String)
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
LastPageIDs = New List(Of String)
UseInternalM3U8Function = True UseInternalM3U8Function = True
UseClientTokens = True UseClientTokens = True
SessionPosts = New List(Of String)
End Sub End Sub
#End Region #End Region
#Region "Loader" #Region "Loader"
@@ -288,10 +287,14 @@ Namespace API.PornHub
#Region "Download override" #Region "Download override"
Private Const PlayListUrlPattern As String = "https://www.pornhub.com/playlist/viewChunked?id={0}&token={1}&page={2}" Private Const PlayListUrlPattern As String = "https://www.pornhub.com/playlist/viewChunked?id={0}&token={1}&page={2}"
Private PlaylistToken As String = String.Empty Private PlaylistToken As String = String.Empty
Private ReadOnly SessionPosts As List(Of String)
Private _PageVideosRepeat As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try Try
PlaylistToken = String.Empty PlaylistToken = String.Empty
Responser.ResetStatus() Responser.ResetStatus()
_PageVideosRepeat = 0
SessionPosts.Clear()
If IsSavedPosts Then If IsSavedPosts Then
PersonType = PersonTypeUser PersonType = PersonTypeUser
@@ -309,24 +312,24 @@ Namespace API.PornHub
DownloadUserVideos(1, VideoTypes.Favorite, False, Token) DownloadUserVideos(1, VideoTypes.Favorite, False, Token)
Else Else
If DownloadUploaded Then If DownloadUploaded Then
LastPageIDs.Clear() SessionPosts.Clear()
DownloadUserVideos(1, VideoTypes.Uploaded, False, Token) DownloadUserVideos(1, VideoTypes.Uploaded, False, Token)
End If End If
If DownloadTagged Then If DownloadTagged Then
LastPageIDs.Clear() SessionPosts.Clear()
Dim lBefore% = _TempMediaList.Count Dim lBefore% = _TempMediaList.Count
DownloadUserVideos(1, VideoTypes.Tagged, False, Token) DownloadUserVideos(1, VideoTypes.Tagged, False, Token)
If PersonType = PersonTypePornstar And lBefore = _TempMediaList.Count Then If PersonType = PersonTypePornstar And lBefore = _TempMediaList.Count Then
LastPageIDs.Clear() SessionPosts.Clear()
DownloadUserVideos(1, VideoTypes.Tagged, True, Token) DownloadUserVideos(1, VideoTypes.Tagged, True, Token)
End If End If
End If End If
If DownloadPrivate Then If DownloadPrivate Then
LastPageIDs.Clear() SessionPosts.Clear()
DownloadUserVideos(1, VideoTypes.Private, False, Token) DownloadUserVideos(1, VideoTypes.Private, False, Token)
End If End If
If DownloadFavorite Then If DownloadFavorite Then
LastPageIDs.Clear() SessionPosts.Clear()
DownloadUserVideos(1, VideoTypes.Favorite, False, Token) DownloadUserVideos(1, VideoTypes.Favorite, False, Token)
End If End If
End If End If
@@ -370,6 +373,7 @@ Namespace API.PornHub
Dim specFolder$ = String.Empty Dim specFolder$ = String.Empty
Dim tryNextPage As Boolean = False Dim tryNextPage As Boolean = False
Dim limit% = If(DownloadTopCount, -1) Dim limit% = If(DownloadTopCount, -1)
Dim cBefore% = _TempMediaList.Count
If IsUser Then If IsUser Then
URL = $"https://www.pornhub.com/{PersonType}/{NameTrue}" URL = $"https://www.pornhub.com/{PersonType}/{NameTrue}"
If Type = VideoTypes.Uploaded Then If Type = VideoTypes.Uploaded Then
@@ -414,23 +418,37 @@ Namespace API.PornHub
Dim lBefore% = l.Count Dim lBefore% = l.Count
Dim nonLastPageDetected As Boolean = False Dim nonLastPageDetected As Boolean = False
Dim newLastPageIDs As New List(Of String) Dim newLastPageIDs As New List(Of String)
Dim pageRepeatSet As Boolean = False, prevPostsFound As Boolean = False, newPostsFound As Boolean = False
l.RemoveAll(Function(ByVal uv As UserVideo) As Boolean l.RemoveAll(Function(ByVal uv As UserVideo) As Boolean
newLastPageIDs.Add(uv.ID)
If Not _TempPostsList.Contains(uv.ID) Then If Not _TempPostsList.Contains(uv.ID) Then
_TempPostsList.Add(uv.ID) _TempPostsList.Add(uv.ID)
newLastPageIDs.Add(uv.ID)
Return False Return False
ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(uv.id) Then
prevPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
Return True
Else Else
If Not LastPageIDs.Contains(uv.ID) Then nonLastPageDetected = True 'TODELETE: PornHub old validating
'If Not SessionPosts.Contains(uv.ID) Then nonLastPageDetected = True
If Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : _PageVideosRepeat += 1
'Debug.WriteLine($"[REMOVED]: {uv.Title}") 'Debug.WriteLine($"[REMOVED]: {uv.Title}")
Return True Return True
End If End If
End Function) End Function)
'Debug.WriteLineIf(l.Count > 0, l.Select(Function(ll) ll.Title).ListToString(vbNewLine)) 'Debug.WriteLineIf(l.Count > 0, l.Select(Function(ll) ll.Title).ListToString(vbNewLine))
If l.Count > 0 Then _TempMediaList.ListAddList(l.Select(Function(uv) uv.ToUserMedia(specFolder))) If l.Count > 0 Then _TempMediaList.ListAddList(l.Select(Function(uv) uv.ToUserMedia(specFolder)))
LastPageIDs.Clear() SessionPosts.ListAddList(newLastPageIDs, LNC)
If newLastPageIDs.Count > 0 Then LastPageIDs.AddRange(newLastPageIDs) : newLastPageIDs.Clear() newLastPageIDs.Clear()
If l.Count > 0 AndAlso (l.Count = lBefore Or Not nonLastPageDetected) AndAlso 'TODELETE: PornHub old validating
Not (limit > 0 And _TempMediaList.Count >= limit) Then tryNextPage = True 'If l.Count > 0 AndAlso (l.Count = lBefore Or Not nonLastPageDetected) AndAlso
' Not (limit > 0 And _TempMediaList.Count >= limit) Then tryNextPage = True
If limit > 0 And _TempMediaList.Count >= limit Then Exit Sub
If (Not IsUser And prevPostsFound And Not newPostsFound And Page < 1000) Or
(Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000)) Then tryNextPage = True
l.Clear()
End If End If
End If End If
End If End If
@@ -965,7 +983,7 @@ Namespace API.PornHub
#End Region #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 LastPageIDs.Clear() If Not disposedValue And disposing Then SessionPosts.Clear()
MyBase.Dispose(disposing) MyBase.Dispose(disposing)
End Sub End Sub
#End Region #End Region

View File

@@ -223,9 +223,12 @@ Namespace API.ThisVid
#Region "Download functions" #Region "Download functions"
Private ReadOnly SessionPosts As List(Of String) Private ReadOnly SessionPosts As List(Of String)
Private AddedCount As Integer = 0 Private AddedCount As Integer = 0
Private _PageVideosRepeat As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
SessionPosts.Clear() SessionPosts.Clear()
AddedCount = 0 AddedCount = 0
_PageVideosRepeat = 0
SessionPosts.Clear()
Responser.Cookies.ChangedAllowInternalDrop = False Responser.Cookies.ChangedAllowInternalDrop = False
Responser.Cookies.Changed = False Responser.Cookies.Changed = False
If ID.IsEmptyString Then ID = Name If ID.IsEmptyString Then ID = Name
@@ -286,7 +289,8 @@ Namespace API.ThisVid
ProgressPre.Perform() ProgressPre.Perform()
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
Dim cBefore% = _TempMediaList.Count Dim cBefore% = _TempMediaList.Count
Dim prevPostsFound As Boolean = False, newPostsFound As Boolean = False Dim pageRepeatSet As Boolean = False, prevPostsFound As Boolean = False, newPostsFound As Boolean = False
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim __SpecialFolder$ = If(DifferentFolders And Not IsSavedPosts And IsUser, Dim __SpecialFolder$ = If(DifferentFolders And Not IsSavedPosts And IsUser,
Interaction.Switch(Model = 0, "Public", Model = 1, "Private", Model = 2, "Favourite"), Interaction.Switch(Model = 0, "Public", Model = 1, "Private", Model = 2, "Favourite"),
@@ -300,12 +304,19 @@ Namespace API.ThisVid
_TempMediaList.Add(New UserMedia(u) With {.Type = UserMedia.Types.VideoPre, .SpecialFolder = __SpecialFolder}) _TempMediaList.Add(New UserMedia(u) With {.Type = UserMedia.Types.VideoPre, .SpecialFolder = __SpecialFolder})
AddedCount += 1 AddedCount += 1
newPostsFound = True newPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
If limit > 0 And AddedCount >= limit Then Exit Sub If limit > 0 And AddedCount >= limit Then Exit Sub
ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(u) Then ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(u) Then
prevPostsFound = True prevPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
Continue For Continue For
Else Else
Exit Sub If _PageVideosRepeat > 2 Then
Exit Sub
ElseIf Not pageRepeatSet And Not newPostsFound Then
pageRepeatSet = True
_PageVideosRepeat += 1
End If
End If End If
End If End If
Next Next

View File

@@ -18,19 +18,29 @@ Namespace API.ThreadsNet
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
#Region "Authorization" #Region "Authorization"
<PropertyOption(ControlText:="x-csrftoken", AllowNull:=False), PClonable(Clone:=False)> <PClonable(Clone:=False)> Protected ReadOnly __HH_CSRF_TOKEN As PropertyValue
Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue <PropertyOption(ControlText:="x-csrftoken", AllowNull:=False, IsAuth:=True), ControlNumber(0)>
<PropertyOption(ControlText:="x-ig-app-id", AllowNull:=False), PClonable> Friend Overridable ReadOnly Property HH_CSRF_TOKEN As PropertyValue
Friend Property HH_IG_APP_ID As PropertyValue Get
<PropertyOption(ControlText:="x-asbd-id", AllowNull:=True), PClonable> Return __HH_CSRF_TOKEN
Friend Property HH_ASBD_ID As PropertyValue End Get
<PropertyOption(ControlText:="sec-ch-ua", AllowNull:=True), PClonable> End Property
Private Property HH_BROWSER As PropertyValue <PClonable> Protected ReadOnly __HH_IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", AllowNull:=True), PClonable> <PropertyOption(ControlText:="x-ig-app-id", AllowNull:=False, IsAuth:=True), ControlNumber(10)>
Private Property HH_BROWSER_EXT As PropertyValue Friend Overridable ReadOnly Property HH_IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", AllowNull:=True, LeftOffset:=120), PClonable> Get
Private Property HH_PLATFORM As PropertyValue Return __HH_IG_APP_ID
<PropertyOption(ControlText:="UserAgent"), PClonable> End Get
End Property
<PropertyOption(ControlText:="x-asbd-id", AllowNull:=True, IsAuth:=True), ControlNumber(20), PClonable>
Friend ReadOnly Property HH_ASBD_ID As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua", AllowNull:=True, IsAuth:=True), ControlNumber(30), PClonable>
Private ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", AllowNull:=True, IsAuth:=True), ControlNumber(40), PClonable>
Private ReadOnly Property HH_BROWSER_EXT As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-platform", ControlToolTip:="sec-ch-ua-platform", AllowNull:=True, IsAuth:=True, LeftOffset:=120), ControlNumber(50), PClonable>
Private ReadOnly Property HH_PLATFORM As PropertyValue
<PropertyOption(ControlText:="UserAgent", IsAuth:=True), ControlNumber(60), PClonable>
Private ReadOnly Property HH_USER_AGENT As PropertyValue Private ReadOnly Property HH_USER_AGENT As PropertyValue
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object) Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then If Not PropName.IsEmptyString Then
@@ -57,7 +67,13 @@ Namespace API.ThreadsNet
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean) Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("Threads", "threads.net", AccName, Temp, My.Resources.SiteResources.ThreadsIcon_192, My.Resources.SiteResources.ThreadsIcon_192.ToBitmap) Me.New("Threads", "threads.net", AccName, Temp, My.Resources.SiteResources.ThreadsIcon_192, My.Resources.SiteResources.ThreadsIcon_192.ToBitmap)
End Sub
Protected Sub New(ByVal SiteName As String, ByVal CookiesDomain As String, ByVal AccName As String, ByVal Temp As Boolean,
Optional ByVal __Icon As Icon = Nothing, Optional ByVal __Image As Image = Nothing)
MyBase.New(SiteName, CookiesDomain, AccName, Temp,
If(__Icon, My.Resources.SiteResources.ThreadsIcon_192),
If(__Image, My.Resources.SiteResources.ThreadsIcon_192.ToBitmap))
_AllowUserAgentUpdate = False _AllowUserAgentUpdate = False
Dim app_id$ = String.Empty Dim app_id$ = String.Empty
@@ -82,17 +98,17 @@ Namespace API.ThreadsNet
browserExt = .Value(IG.Header_BrowserExt) browserExt = .Value(IG.Header_BrowserExt)
platform = .Value(IG.Header_Platform) platform = .Value(IG.Header_Platform)
End If End If
.Add("Authority", "www.threads.net") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.threads.net"))
.Add("Origin", "https://www.threads.net") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Origin, "https://www.threads.net"))
.Add("Upgrade-Insecure-Requests", 1) .Add("Upgrade-Insecure-Requests", 1)
.Add("Sec-Ch-Ua-Model", "") .Add("Sec-Ch-Ua-Model", "")
.Add("Sec-Ch-Ua-Mobile", "?0") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile, "?0"))
.Add("Sec-Ch-Ua-Platform", """Windows""") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform, """Windows"""))
.Add("Sec-Fetch-Dest", "empty") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest, "empty"))
.Add("Sec-Fetch-Mode", "cors") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "cors"))
.Add("Sec-Fetch-Site", "same-origin") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchSite, "same-origin"))
.Add("Sec-Fetch-User", "?1") .Add("Sec-Fetch-User", "?1")
.Add("x-fb-friendly-name", "BarcelonaProfileThreadsTabRefetchableQuery") .Add(DeclaredNames.Header_FB_FRIENDLY_NAME, "BarcelonaProfileThreadsTabRefetchableQuery")
End With End With
.CookiesExtractMode = Responser.CookiesExtractModes.Any .CookiesExtractMode = Responser.CookiesExtractModes.Any
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll .CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
@@ -101,8 +117,8 @@ Namespace API.ThreadsNet
.Cookies.Changed = False .Cookies.Changed = False
End With End With
HH_CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_CSRF_TOKEN), v)) __HH_CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_CSRF_TOKEN), v))
HH_IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_IG_APP_ID), v)) __HH_IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_IG_APP_ID), v))
HH_ASBD_ID = New PropertyValue(asbd, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_ASBD_ID), v)) HH_ASBD_ID = New PropertyValue(asbd, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_ASBD_ID), v))
HH_BROWSER = New PropertyValue(browser, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER), v)) HH_BROWSER = New PropertyValue(browser, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER), v))
HH_BROWSER_EXT = New PropertyValue(browserExt, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER_EXT), v)) HH_BROWSER_EXT = New PropertyValue(browserExt, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER_EXT), v))
@@ -115,7 +131,7 @@ Namespace API.ThreadsNet
End Sub End Sub
#End Region #End Region
#Region "UpdateResponserData" #Region "UpdateResponserData"
Friend Sub UpdateResponserData(ByVal Resp As Responser) Friend Overridable Sub UpdateResponserData(ByVal Resp As Responser)
With Responser.Cookies With Responser.Cookies
Dim csrf$ = String.Empty Dim csrf$ = String.Empty
.Update(Resp.Cookies) .Update(Resp.Cookies)

View File

@@ -18,7 +18,7 @@ Imports IGS = SCrawler.API.Instagram.SiteSettings
Namespace API.ThreadsNet Namespace API.ThreadsNet
Friend Class UserData : Inherits Instagram.UserData Friend Class UserData : Inherits Instagram.UserData
#Region "Declarations" #Region "Declarations"
Private Const Header_FB_LSD As String = "x-fb-lsd" Friend Const Header_FB_LSD As String = "x-fb-lsd"
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Get Get
Return HOST.Source Return HOST.Source

View File

@@ -53,6 +53,11 @@ Namespace API.XVIDEOS
Return SiteMode = SiteModes.User Return SiteMode = SiteModes.User
End Get End Get
End Property End Property
Friend ReadOnly Property IsSearch As Boolean
Get
Return SiteMode = SiteModes.Search Or SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories
End Get
End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String) Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get Get
Return {SearchRequestLabelName} Return {SearchRequestLabelName}
@@ -172,6 +177,7 @@ Namespace API.XVIDEOS
UseClientTokens = True UseClientTokens = True
End Sub End Sub
#End Region #End Region
#Region "GetUserUrl"
Friend Function GetUserUrl(ByVal Page As Integer) As String Friend Function GetUserUrl(ByVal Page As Integer) As String
Dim url$ = String.Empty Dim url$ = String.Empty
If SiteMode = SiteModes.User Then If SiteMode = SiteModes.User Then
@@ -193,6 +199,8 @@ Namespace API.XVIDEOS
End If End If
Return url Return url
End Function End Function
#End Region
#Region "Download functions"
Private Sub Wait429(ByVal Round As Integer) Private Sub Wait429(ByVal Round As Integer)
If (Round Mod 5) = 0 Then If (Round Mod 5) = 0 Then
Thread.Sleep(5000 + (Round / 5).RoundDown) Thread.Sleep(5000 + (Round / 5).RoundDown)
@@ -318,7 +326,11 @@ Namespace API.XVIDEOS
Dim r$ Dim r$
Dim round% = 0 Dim round% = 0
Dim data As List(Of PlayListVideo) Dim data As List(Of PlayListVideo)
Dim pids As New List(Of String)
Dim cBefore% Dim cBefore%
Dim pageRepeatSet As Boolean, prevPostsFound As Boolean, newPostsFound As Boolean
Dim sessionPosts As New List(Of String)
Dim pageVideosRepeat As Integer = 0
Dim limit% = If(DownloadTopCount, -1) Dim limit% = If(DownloadTopCount, -1)
Do Do
@@ -326,7 +338,11 @@ Namespace API.XVIDEOS
Wait429(round) Wait429(round)
ThrowAny(Token) ThrowAny(Token)
NextPage += 1 NextPage += 1
newPostsFound = False
pageRepeatSet = False
prevPostsFound = False
cBefore = _TempMediaList.Count cBefore = _TempMediaList.Count
pids.Clear()
If SiteMode = SiteModes.User Then If SiteMode = SiteModes.User Then
URL = $"{MySettings.SavedVideosPlaylist.Value}{If(NextPage = 0, String.Empty, $"/{NextPage}")}" URL = $"{MySettings.SavedVideosPlaylist.Value}{If(NextPage = 0, String.Empty, $"/{NextPage}")}"
@@ -352,14 +368,35 @@ Namespace API.XVIDEOS
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
data = RegexFields(Of PlayListVideo)(r, {Regex_SavedVideosPlaylist}, {1, 2, 3}, EDP.ReturnValue) data = RegexFields(Of PlayListVideo)(r, {Regex_SavedVideosPlaylist}, {1, 2, 3}, EDP.ReturnValue)
If data.ListExists Then If data.ListExists Then
If data.RemoveAll(Function(d) _TempPostsList.Contains(d.ID)) > 0 Then __continue = False pids.ListAddList(data.Select(Function(d) d.ID), LNC)
If data.RemoveAll(Function(d) _TempPostsList.Contains(d.ID)) > 0 And Not IsSearch Then __continue = False
If data.ListExists Then If data.ListExists Then
_TempPostsList.ListAddList(data.Select(Function(d) d.ID), LNC) _TempPostsList.ListAddList(data.Select(Function(d) d.ID), LNC)
_TempMediaList.ListAddList(data.Select(Function(d) d.ToUserMedia()), LNC) _TempMediaList.ListAddList(data.Select(Function(d) d.ToUserMedia()), LNC)
newPostsFound = cBefore <> _TempMediaList.Count
ElseIf sessionPosts.Count > 0 AndAlso sessionPosts.ListContains(pids) Then
If pageRepeatSet Then pageRepeatSet = False : pageVideosRepeat -= 1
Else
If pageVideosRepeat > 2 Then
Exit Do
ElseIf Not pageRepeatSet And Not newPostsFound Then
pageRepeatSet = True
pageVideosRepeat += 1
End If
End If End If
sessionPosts.ListAddList(pids, LNC)
End If End If
End If End If
Loop While NextPage < 100 And __continue And _TempMediaList.Count > cBefore And (limit < 0 Or _TempMediaList.Count < limit) If limit > 0 And _TempMediaList.Count >= limit Then Exit Do
If IsSearch Then
__continue = NextPage < 1000 And (newPostsFound Or (prevPostsFound And Not newPostsFound))
ElseIf __continue Then
__continue = Not cBefore = _TempMediaList.Count
End If
Loop While NextPage < 1000 And __continue
pids.Clear()
sessionPosts.Clear()
If limit > 0 And _TempMediaList.Count >= limit Then _TempMediaList.ListAddList(_TempMediaList.ListTake(-1, limit), LAP.ClearBeforeAdd) If limit > 0 And _TempMediaList.Count >= limit Then _TempMediaList.ListAddList(_TempMediaList.ListTake(-1, limit), LAP.ClearBeforeAdd)
If _TempMediaList.Count > 0 Then If _TempMediaList.Count > 0 Then
@@ -448,16 +485,22 @@ Namespace API.XVIDEOS
Return Nothing Return Nothing
End Try End Try
End Function End Function
#End Region
#Region "DownloadContent"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
Dim m As UserMedia = GetVideoData(New UserMedia(Data.URL, UTypes.VideoPre))
If Not m.URL.IsEmptyString Then _TempMediaList.Add(m)
End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(Media.URL, Media.PictureOption, DestinationFile, Token, Progress, Not IsSingleObjectDownload) Return M3U8.Download(Media.URL, Media.PictureOption, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function End Function
#End Region
#Region "SingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
Dim m As UserMedia = GetVideoData(New UserMedia(Data.URL, UTypes.VideoPre))
If Not m.URL.IsEmptyString Then _TempMediaList.Add(m)
End Sub
#End Region
#Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer Optional ByVal EObj As Object = Nothing) As Integer
Dim isQuickies As Boolean = False Dim isQuickies As Boolean = False
@@ -471,5 +514,6 @@ Namespace API.XVIDEOS
Return 0 Return 0
End If End If
End Function End Function
#End Region
End Class End Class
End Namespace End Namespace

View File

@@ -36,6 +36,11 @@ Namespace API.Xhamster
Return SiteMode = SiteModes.User Or SiteMode = SiteModes.Pornstars Return SiteMode = SiteModes.User Or SiteMode = SiteModes.Pornstars
End Get End Get
End Property End Property
Friend ReadOnly Property IsSearch As Boolean
Get
Return SiteMode = SiteModes.Search Or SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories
End Get
End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String) Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get Get
Return {SearchRequestLabelName} Return {SearchRequestLabelName}
@@ -168,6 +173,7 @@ Namespace API.Xhamster
UseInternalM3U8Function = True UseInternalM3U8Function = True
UseClientTokens = True UseClientTokens = True
_TempPhotoData = New List(Of UserMedia) _TempPhotoData = New List(Of UserMedia)
SessionPosts = New List(Of String)
End Sub End Sub
#End Region #End Region
#Region "Download functions" #Region "Download functions"
@@ -215,9 +221,13 @@ Namespace API.Xhamster
End If End If
End Function End Function
Private SearchPostsCount As Integer = 0 Private SearchPostsCount As Integer = 0
Private ReadOnly SessionPosts As List(Of String)
Private _PageVideosRepeat As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TempPhotoData.Clear() _TempPhotoData.Clear()
SearchPostsCount = 0 SearchPostsCount = 0
_PageVideosRepeat = 0
SessionPosts.Clear()
If DownloadVideos Then DownloadData(1, True, Token) If DownloadVideos Then DownloadData(1, True, Token)
If Not IsChannel And DownloadImages And Not IsSubscription Then If Not IsChannel And DownloadImages And Not IsSubscription Then
DownloadData(1, False, Token) DownloadData(1, False, Token)
@@ -235,6 +245,8 @@ Namespace API.Xhamster
Dim skipped As Boolean = False Dim skipped As Boolean = False
Dim limit% = If(DownloadTopCount, -1) Dim limit% = If(DownloadTopCount, -1)
Dim cBefore% = _TempMediaList.Count Dim cBefore% = _TempMediaList.Count
Dim pageRepeatSet As Boolean = False, prevPostsFound As Boolean = False, newPostsFound As Boolean = False
Dim pids As New List(Of String)
Dim m As UserMedia Dim m As UserMedia
Dim checkLimit As Func(Of Boolean) = Function() limit > 0 And SearchPostsCount >= limit And IsVideo Dim checkLimit As Func(Of Boolean) = Function() limit > 0 And SearchPostsCount >= limit And IsVideo
@@ -281,6 +293,7 @@ Namespace API.Xhamster
ProgressPre.Perform() ProgressPre.Perform()
m = ExtractMedia(e, Type) m = ExtractMedia(e, Type)
If Not m.URL.IsEmptyString Then If Not m.URL.IsEmptyString Then
pids.ListAddValue(m.Post.ID, LNC)
If m.File.IsEmptyString Then Continue For If m.File.IsEmptyString Then Continue For
If m.Post.Date.HasValue Then If m.Post.Date.HasValue Then
@@ -294,6 +307,8 @@ Namespace API.Xhamster
_TempPostsList.Add(m.Post.ID) _TempPostsList.Add(m.Post.ID)
_TempMediaList.ListAddValue(m, LNC) _TempMediaList.ListAddValue(m, LNC)
SearchPostsCount += 1 SearchPostsCount += 1
newPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
If checkLimit.Invoke Then Exit Sub If checkLimit.Invoke Then Exit Sub
ElseIf Not IsVideo Then ElseIf Not IsVideo Then
If DirectCast(m.Object, ExchObj).IsPhoto Then If DirectCast(m.Object, ExchObj).IsPhoto Then
@@ -304,11 +319,24 @@ Namespace API.Xhamster
Else Else
_TempPhotoData.ListAddValue(m, LNC) _TempPhotoData.ListAddValue(m, LNC)
End If End If
ElseIf IsVideo And _TempPostsList.Contains(m.Post.ID) Then
If SessionPosts.Count > 0 AndAlso SessionPosts.Contains(m.Post.ID) Then
prevPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
Continue For
ElseIf _PageVideosRepeat > 2 Then
Exit Sub
ElseIf Not pageRepeatSet And Not newPostsFound Then
pageRepeatSet = True
_PageVideosRepeat += 1
End If
Else Else
Exit Sub Exit Sub
End If End If
End If End If
Next Next
SessionPosts.ListAddList(pids, LNC)
pids.Clear()
Exit For Exit For
End If End If
End With End With
@@ -319,8 +347,11 @@ Namespace API.Xhamster
containerNodes.Clear() containerNodes.Clear()
If (Not _TempMediaList.Count = cBefore Or skipped) And If (
(IsChannel Or (MaxPage > 0 And Page < MaxPage) Or (Not SiteMode = SiteModes.User And Page < 1000)) Then DownloadData(Page + 1, IsVideo, Token) (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)
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
@@ -341,6 +372,7 @@ Namespace API.Xhamster
m = _TempMediaList(i) m = _TempMediaList(i)
If Not m.URL_BASE.IsEmptyString Then If Not m.URL_BASE.IsEmptyString Then
m2 = Nothing m2 = Nothing
ThrowAny(Token)
If GetM3U8(m2, m.URL_BASE) Then If GetM3U8(m2, m.URL_BASE) Then
m2.URL_BASE = m.URL_BASE m2.URL_BASE = m.URL_BASE
_TempMediaList(i) = m2 _TempMediaList(i) = m2
@@ -370,6 +402,7 @@ Namespace API.Xhamster
m = _TempMediaList(i) m = _TempMediaList(i)
If Not m.URL_BASE.IsEmptyString Then If Not m.URL_BASE.IsEmptyString Then
m2 = Nothing m2 = Nothing
ThrowAny(Token)
If GetM3U8(m2, m.URL_BASE) Then If GetM3U8(m2, m.URL_BASE) Then
m2.URL_BASE = m.URL_BASE m2.URL_BASE = m.URL_BASE
_TempMediaList(i) = m2 _TempMediaList(i) = m2
@@ -585,7 +618,7 @@ Namespace API.Xhamster
#End Region #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 _TempPhotoData.Clear() If Not disposedValue And disposing Then _TempPhotoData.Clear() : SessionPosts.Clear()
MyBase.Dispose(disposing) MyBase.Dispose(disposing)
End Sub End Sub
#End Region #End Region

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

View File

@@ -81,6 +81,7 @@ Namespace Plugin.Hosts
New PluginHost(GetType(API.Mastodon.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids), New PluginHost(GetType(API.Mastodon.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(GetType(API.Instagram.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids), New PluginHost(GetType(API.Instagram.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(GetType(API.ThreadsNet.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids), New PluginHost(GetType(API.ThreadsNet.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(GetType(API.Facebook.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(GetType(API.RedGifs.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids), New PluginHost(GetType(API.RedGifs.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(GetType(API.YouTube.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids), New PluginHost(GetType(API.YouTube.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(GetType(API.Pinterest.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids), New PluginHost(GetType(API.Pinterest.SiteSettings), _XML, GlobalPath, _Temp, _Imgs, _Vids),

View File

@@ -257,7 +257,7 @@ Namespace Plugin.Hosts
_XmlName = If(Member.GetCustomAttribute(Of PXML)()?.ElementName, String.Empty) _XmlName = If(Member.GetCustomAttribute(Of PXML)()?.ElementName, String.Empty)
If Not _XmlName.IsEmptyString Then XValue = CreateXMLValueInstance([Type], True) If Not _XmlName.IsEmptyString Then XValue = CreateXMLValueInstance([Type], True)
DependentNames.ListAddList(Member.GetCustomAttribute(Of DependentFields)?.Fields, LAP.NotContainsOnly) DependentNames.ListAddList(Member.GetCustomAttribute(Of DependentFields)?.Fields, LAP.NotContainsOnly)
Exists = True Exists = Not If(Member.GetCustomAttribute(Of DoNotUse)()?.Value, False)
End If End If
End Sub End Sub
Friend Sub SetXmlEnvironment(ByRef Container As Object, Optional ByVal _Nodes() As String = Nothing, Friend Sub SetXmlEnvironment(ByRef Container As Object, Optional ByVal _Nodes() As String = Nothing,

View File

@@ -13,6 +13,7 @@ Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.XML.Objects Imports PersonalUtilities.Functions.XML.Objects
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace Plugin.Hosts Namespace Plugin.Hosts
@@ -259,7 +260,8 @@ Namespace Plugin.Hosts
Source.BeginInit() Source.BeginInit()
Dim Members As IEnumerable(Of MemberInfo) = Plugin.GetType.GetTypeInfo.DeclaredMembers Dim Members As IEnumerable(Of MemberInfo) = GetObjectMembers(Plugin,,, True, New MembersDistinctComparer) 'Plugin.GetType.GetTypeInfo.DeclaredMembers
_ResponserIsContainer = TypeOf Plugin Is IResponserContainer _ResponserIsContainer = TypeOf Plugin Is IResponserContainer
If Members.ListExists Then If Members.ListExists Then
Dim Updaters As New List(Of MemberInfo) Dim Updaters As New List(Of MemberInfo)

View File

@@ -176,6 +176,10 @@
<Compile Include="API\Base\Structures.vb" /> <Compile Include="API\Base\Structures.vb" />
<Compile Include="API\Base\TokenBatch.vb" /> <Compile Include="API\Base\TokenBatch.vb" />
<Compile Include="API\Base\YTDLP.vb" /> <Compile Include="API\Base\YTDLP.vb" />
<Compile Include="API\Facebook\Declarations.vb" />
<Compile Include="API\Facebook\SiteSettings.vb" />
<Compile Include="API\Facebook\UserData.vb" />
<Compile Include="API\Facebook\UserExchangeOptions.vb" />
<Compile Include="API\Instagram\EditorExchangeOptions.vb" /> <Compile Include="API\Instagram\EditorExchangeOptions.vb" />
<Compile Include="API\JustForFans\Declarations.vb" /> <Compile Include="API\JustForFans\Declarations.vb" />
<Compile Include="API\JustForFans\M3U8.vb" /> <Compile Include="API\JustForFans\M3U8.vb" />
@@ -707,6 +711,12 @@
<ItemGroup> <ItemGroup>
<None Include="Content\Icons\SiteIcons\ThreadsIcon_192.ico" /> <None Include="Content\Icons\SiteIcons\ThreadsIcon_192.ico" />
</ItemGroup> </ItemGroup>
<ItemGroup>
<None Include="Content\Icons\SiteIcons\FacebookIcon_32.ico" />
</ItemGroup>
<ItemGroup>
<None Include="Content\Pictures\SitePictures\FacebookPic_37.png" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" /> <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
<Target Name="EnsureNuGetPackageBuildImports" BeforeTargets="PrepareForBuild"> <Target Name="EnsureNuGetPackageBuildImports" BeforeTargets="PrepareForBuild">
<PropertyGroup> <PropertyGroup>

View File

@@ -64,6 +64,26 @@ Namespace My.Resources
End Set End Set
End Property End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Icon similar to (Icon).
'''</summary>
Friend Shared ReadOnly Property FacebookIcon_32() As System.Drawing.Icon
Get
Dim obj As Object = ResourceManager.GetObject("FacebookIcon_32", resourceCulture)
Return CType(obj,System.Drawing.Icon)
End Get
End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Bitmap.
'''</summary>
Friend Shared ReadOnly Property FacebookPic_37() As System.Drawing.Bitmap
Get
Dim obj As Object = ResourceManager.GetObject("FacebookPic_37", resourceCulture)
Return CType(obj,System.Drawing.Bitmap)
End Get
End Property
'''<summary> '''<summary>
''' Looks up a localized resource of type System.Drawing.Icon similar to (Icon). ''' Looks up a localized resource of type System.Drawing.Icon similar to (Icon).
'''</summary> '''</summary>

View File

@@ -118,6 +118,12 @@
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader> </resheader>
<assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" /> <assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" />
<data name="FacebookIcon_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>Content\Icons\SiteIcons\FacebookIcon_32.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="FacebookPic_37" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>Content\Pictures\SitePictures\FacebookPic_37.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="InstagramIcon_32" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="InstagramIcon_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>Content\Icons\SiteIcons\InstagramIcon_32.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value> <value>Content\Icons\SiteIcons\InstagramIcon_32.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data> </data>