Compare commits

...

3 Commits

Author SHA1 Message Date
Andy
e09752a2d5 2025.8.1.0
YT
Update 'ReplaceModificationDate'

SCrawler
API.Instagram: fix 'LastCursor' issue
API.Reddit: add OAuth validation; add default credentials; hide unused controls; add 'SeparatedTasks'; bypass 429 error; fix crossposts downloading
API.Redgifs: force delete cookies if user added them
API.TikTok: yt-dlp modification (date change)
API.Twitter: simplify large profiles download
SettingsCLS: change default max value for channel downloads
2025-08-01 21:49:40 +03:00
Andy
05772a9fc4 2025.7.18.0
API.Instagram: fix special folder issue
API.OnlyFans: bypass unpurchased videos; add support for GIF files
API.Reddit: add OAuth credentials validation; add extended 429 error handling
API.Xhamster: remove 'UserOptions' function ('SiteSettings'); add support for downloading 'moments'
API.XVIDEOS: remove 'UserOptions' function ('SiteSettings'); remove 'UserExchangeOptions' class
Add 'EditorExchangeOptionsBase_P' and update base classes for user options
2025-07-18 20:29:35 +03:00
Andy
24ad338c60 2025.6.12.0
YT
MainModShared: fix environment output
YouTubeMediaContainerBase: fix 'm3u8' audio formats

SCrawler
UserDataBase: text downloading with saved posts; update 'ID' property (handle '_ForceSaveUserInfo')
API.Bluesky: data is not downloaded
API.Reddit: update 'RedditViewExchange'; set base inheritance; inherit default settings for new users
API.ALL: update functions with property 'ID'
2025-06-12 20:29:59 +03:00
35 changed files with 623 additions and 264 deletions

View File

@@ -1,3 +1,50 @@
# 2025.8.1.0
*2025-08-01*
- Added
- Sites:
- Reddit: **bypass error `429`**
- Twitter: **[large profile option](https://github.com/AAndyProgram/SCrawler/wiki/Settings#twitter-user-settings) in user settings**
- Minor improvements
- Updated
- yt-dlp up to version **2025.27.21**
- gallery-dl up to version **1.30.2**
- Fixed
- Reddit: in some cases crossposts don't download
- Minor bugs
# 2025.7.18.0
*2025-07-18*
- Added
- Sites:
- OnlyFans: support for GIF files
- Reddit: extended `429` error handling
- Xhamster: support for downloading 'moments'
- Minor improvements
- Updated
- yt-dlp up to version **2025.06.30**
- gallery-dl up to version **1.30.0**
- Fixed
- OnlyFans: **hanging on purchased content**
- Minor bugs
# 2025.6.12.0
*2025-06-12*
- Updated
- yt-dlp up to version **2025.06.09**
- Fixed
- Sites:
- YouTube: audio formats of protocol `m3u8` are not handled correctly
- BlueSky: data is not downloaded in some cases
- Reddit: new users do not inherit default text settings
- Saved posts: text downloading with saved posts
- Environment incorrect output
# 2025.6.1.0 # 2025.6.1.0
*2025-06-01* *2025-06-01*

View File

@@ -35,15 +35,15 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
# What can program do: # What can program do:
- Download pictures and videos from user profiles: - Download pictures and videos from user profiles:
- YouTube videos, shorts, community feeds, users, artists, playlists, music, tracks; - YouTube videos, shorts, community feeds, users, artists, playlists, music, tracks;
- Reddit images, galleries of images, videos, saved posts; - Reddit images, galleries of images, videos, text, saved posts;
- Redgifs images and videos (https://www.redgifs.com/); - Redgifs images and videos (https://www.redgifs.com/);
- Twitter images and videos, saved (bookmarked) posts, likes, communities; - Twitter images and videos, text, saved (bookmarked) posts, likes, communities;
- Bluesky images and videos; - Bluesky images and videos, text;
- OnlyFans images and videos, saved (bookmarked) posts, stories; - OnlyFans images and videos, text, saved (bookmarked) posts, stories;
- JustForFans images and videos, saved (bookmarked) posts; - JustForFans images and videos, saved (bookmarked) posts;
- Mastodon images and videos, saved (bookmarked) posts; - Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories, saved posts; - Instagram images and videos, text, tagged posts, stories, saved posts;
- Threads images and videos, saved posts; - Threads images and videos, text, saved posts;
- Facebook images and videos, stories, saved posts; - Facebook images and videos, stories, saved posts;
- TikTok images and videos; - TikTok images and videos;
- Pinterest boards, users, saved posts; - Pinterest boards, users, saved posts;

View File

@@ -10,6 +10,7 @@ Imports System.Threading
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web Imports PersonalUtilities.Tools.Web
Imports PersonalUtilities.Functions.Messaging Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Functions.RegularExpressions
Imports SCrawler.DownloadObjects.STDownloader Imports SCrawler.DownloadObjects.STDownloader
Public Module MainModShared Public Module MainModShared
Public Property BATCH As BatchExecutor Public Property BATCH As BatchExecutor
@@ -135,9 +136,11 @@ Namespace Editors
Public Shared Function GetProgramEnvirText(ByVal EnvirData As IDownloaderSettings, ByVal IsYouTube As Boolean) As String Public Shared Function GetProgramEnvirText(ByVal EnvirData As IDownloaderSettings, ByVal IsYouTube As Boolean) As String
Try Try
Dim output$ = String.Empty Dim output$ = String.Empty
Dim verAfter As RParams = RParams.DM("\A\w\:\\.*", 0, EDP.ReturnValue)
Using b As New BatchExecutor(True) Using b As New BatchExecutor(True)
Dim f As SFile Dim f As SFile
Dim cmd$, ff$, vText$ Dim cmd$, ff$, vText$
Dim ii%
For i% = 0 To IIf(IsYouTube, 1, 3) For i% = 0 To IIf(IsYouTube, 1, 3)
cmd = "--version" cmd = "--version"
@@ -154,7 +157,17 @@ Namespace Editors
Else Else
b.Reset() b.Reset()
b.Execute($"""{f}"" {cmd}", EDP.None) b.Execute($"""{f}"" {cmd}", EDP.None)
If b.OutputData.Count > 3 Then vText = b.OutputData(3) Else vText = "undefined" 'If b.OutputData.Count > 3 Then vText = b.OutputData(3) Else vText = "undefined"
vText = String.Empty
With b.OutputData
If .Count > 0 Then
ii = .FindIndex(Function(bb) Not CStr(RegexReplace(bb, verAfter)).IsEmptyString)
If ii >= 0 And ii + 1 <= .Count - 1 Then vText = .Item(ii + 1)
End If
End With
If vText.IsEmptyString Then vText = "undefined"
output.StringAppendLine($"{ff} version: {vText}") output.StringAppendLine($"{ff} version: {vText}")
End If End If
End If End If

View File

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

View File

@@ -738,6 +738,7 @@ Namespace API.YouTube.Objects
#Region "Command" #Region "Command"
<XMLEC> Public Property UseCookies As Boolean = MyYouTubeSettings.DefaultUseCookies Implements IYouTubeMediaContainer.UseCookies <XMLEC> Public Property UseCookies As Boolean = MyYouTubeSettings.DefaultUseCookies Implements IYouTubeMediaContainer.UseCookies
Protected Const mp3 As String = "mp3" Protected Const mp3 As String = "mp3"
Private Const mp4 As String = "mp4"
Private Const aac As String = "aac" Private Const aac As String = "aac"
Private Const ac3 As String = "ac3" Private Const ac3 As String = "ac3"
Protected PostProcessing_AudioAC3 As Boolean = False Protected PostProcessing_AudioAC3 As Boolean = False
@@ -773,7 +774,12 @@ Namespace API.YouTube.Objects
'2023.3.4 -> 2023.7.6 '2023.3.4 -> 2023.7.6
'cmd.StringAppend($"ba*[format_id={SelectedAudio.ID}]", "+") 'cmd.StringAppend($"ba*[format_id={SelectedAudio.ID}]", "+")
cmd.StringAppend(SelectedAudio.ID, "+") cmd.StringAppend(SelectedAudio.ID, "+")
If OutputAudioCodec.StringToLower = ac3 Then If SelectedVideoIndex >= 0 And SelectedAudio.ProtocolType = Protocols.m3u8 And
(SelectedAudio.Codec.StringToLower = mp4 Or OutputAudioCodec.StringToLower = mp4) Then
PostProcessing_AudioAC3 = True
formats.StringAppend($"--merge-output-format ""{mp4}{IIf(OutputVideoExtension.IsEmptyString, String.Empty, $"/{OutputVideoExtension.StringToLower}")}""", " ")
atCodec = aac
ElseIf OutputAudioCodec.StringToLower = ac3 Then
PostProcessing_AudioAC3 = True PostProcessing_AudioAC3 = True
formats.StringAppend($"--audio-format {aac}", " ") formats.StringAppend($"--audio-format {aac}", " ")
atCodec = aac atCodec = aac
@@ -817,7 +823,9 @@ Namespace API.YouTube.Objects
'cmd = $"yt-dlp -f ""{cmd}""" 'cmd = $"yt-dlp -f ""{cmd}"""
'cmd = $"yt-dlp -f {cmd}" 'cmd = $"yt-dlp -f {cmd}"
cmd = $"{YTDLP_NAME} -f {cmd}" cmd = $"{YTDLP_NAME} -f {cmd}"
If Not MyYouTubeSettings.ReplaceModificationDate Then cmd &= " --no-mtime" 'yt-dlp 2025.07.21
'If Not MyYouTubeSettings.ReplaceModificationDate Then cmd &= " --no-mtime"
cmd &= $" --{IIf(MyYouTubeSettings.ReplaceModificationDate.Value, String.Empty, "no-")}mtime"
cmd.StringAppend(formats, " ") cmd.StringAppend(formats, " ")
cmd.StringAppend(subs, " ") cmd.StringAppend(subs, " ")
cmd.StringAppend(YouTubeFunctions.GetCookiesCommand(WithCookies, YouTubeCookieNetscapeFile), " ") cmd.StringAppend(YouTubeFunctions.GetCookiesCommand(WithCookies, YouTubeCookieNetscapeFile), " ")
@@ -1753,9 +1761,12 @@ Namespace API.YouTube.Objects
If If(e({"formats"})?.Count, 0) > 0 Then If If(e({"formats"})?.Count, 0) > 0 Then
Dim obj As MediaObject Dim obj As MediaObject
Dim nValue# Dim nValue#
Dim sValue$ Dim sValue$ = String.Empty
Dim allowWebm As Boolean = MyYouTubeSettings.DefaultVideoAllowWebm Dim allowWebm As Boolean = MyYouTubeSettings.DefaultVideoAllowWebm
Dim validCodecValue As Func(Of String, Boolean) = Function(codec) Not codec.IsEmptyString AndAlso Not codec = "none" Dim validCodecValue As Func(Of String, Boolean) = Function(ByVal codec As String) As Boolean
sValue = codec
Return Not codec.IsEmptyString AndAlso Not codec = "none"
End Function
For Each ee In e({"formats"}) For Each ee In e({"formats"})
obj = New MediaObject With { obj = New MediaObject With {
@@ -1779,19 +1790,30 @@ Namespace API.YouTube.Objects
If obj.Size <= 0 And obj.Bitrate > 0 And Duration.TotalSeconds > 0 Then _ If obj.Size <= 0 And obj.Bitrate > 0 And Duration.TotalSeconds > 0 Then _
obj.Size = (obj.Bitrate / 8 * Duration.TotalSeconds).RoundVal(2) obj.Size = (obj.Bitrate / 8 * Duration.TotalSeconds).RoundVal(2)
sValue = ee.Value("vcodec") 'sValue = ee.Value("vcodec")
If validCodecValue(sValue) Then If validCodecValue(ee.Value("vcodec")) Then
obj.Type = UMTypes.Video obj.Type = UMTypes.Video
obj.Codec = sValue.Split(".").First obj.Codec = sValue.Split(".").First
If validCodecValue(ee.Value("acodec")) Then obj.Type = av If validCodecValue(ee.Value("acodec")) Then obj.Type = av
ElseIf validCodecValue(ee.Value("acodec")) Then
obj.Type = UMTypes.Audio
obj.Codec = sValue.Split(".").First
Else Else
sValue = ee.Value("acodec") Dim fd As Boolean = False
If validCodecValue(sValue) Then sValue = ee.Value("format_note")
obj.Type = UMTypes.Audio If Not sValue.IsEmptyString Then
obj.Codec = sValue.Split(".").First With ListAddList(Nothing, sValue.Split(","), CType(Function(v) CStr(v).StringToLower.StringTrim, Func(Of Object, Object)), EDP.ReturnValue)
Else If .ListContains({"high", "low"}) Then
Continue For obj.Type = UMTypes.Audio
obj.Codec = ee.Value("ext")
If obj.Protocol.StringToLower.StartsWith("m3u8") Then obj.Protocol = "m3u8"
If obj.Bitrate <= 0 Then obj.Bitrate = IIf(.Contains("high"), 129, 53)
If obj.Size <= 0 Then obj.Size = 1
fd = True
End If
End With
End If End If
If Not fd Then Continue For
End If End If
MediaObjects.Add(obj) MediaObjects.Add(obj)
Next Next
@@ -1803,8 +1825,9 @@ Namespace API.YouTube.Objects
Dim data As New List(Of MediaObject)(MediaObjects.Where(Function(mo) mo.Type = t And mo.Extension = webm)) Dim data As New List(Of MediaObject)(MediaObjects.Where(Function(mo) mo.Type = t And mo.Extension = webm))
If data.Count > 0 Then If data.Count > 0 Then
Dim d As MediaObject = Nothing Dim d As MediaObject = Nothing
Dim expWebm As Predicate(Of MediaObject) = Function(mo) mo.Extension = webm Dim allWebm As Boolean = False, allAVC As Boolean = False
Dim expAVC As Predicate(Of MediaObject) = Function(mo) mo.Codec.IfNullOrEmpty("/").ToLower.StartsWith(avc) Dim expWebm As Predicate(Of MediaObject) = Function(mo) Not allWebm And mo.Extension = webm
Dim expAVC As Predicate(Of MediaObject) = Function(mo) Not allAVC And mo.Codec.IfNullOrEmpty("/").ToLower.StartsWith(avc)
Dim comp As Func(Of MediaObject, Predicate(Of MediaObject), Boolean, Boolean, Boolean) = Dim comp As Func(Of MediaObject, Predicate(Of MediaObject), Boolean, Boolean, Boolean) =
Function(mo, exp, isTrue, checkHttp) mo.Type = t And exp.Invoke(mo) = isTrue And mo.Width = d.Width And Function(mo, exp, isTrue, checkHttp) mo.Type = t And exp.Invoke(mo) = isTrue And mo.Width = d.Width And
(Not checkHttp OrElse mo.ProtocolType = Protocols.https) (Not checkHttp OrElse mo.ProtocolType = Protocols.https)
@@ -1812,6 +1835,8 @@ Namespace API.YouTube.Objects
Dim RemoveWebm As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expWebm, True, allowWebm) Dim RemoveWebm As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expWebm, True, allowWebm)
Dim CountAVC As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expAVC, True, False) Dim CountAVC As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expAVC, True, False)
Dim RemoveAVC As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expAVC, False, False) Dim RemoveAVC As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expAVC, False, False)
allWebm = data.All(FPredicate(Of MediaObject).ToFunc(expWebm))
allAVC = data.All(FPredicate(Of MediaObject).ToFunc(expAVC))
For Each d In data For Each d In data
If MediaObjects.Count = 0 Then Exit For If MediaObjects.Count = 0 Then Exit For
If MediaObjects.LongCount(CountWebm) > 0 Then MediaObjects.RemoveAll(RemoveWebm) If MediaObjects.LongCount(CountWebm) > 0 Then MediaObjects.RemoveAll(RemoveWebm)

View File

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

View File

@@ -0,0 +1,43 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes
Namespace API.Base
Friend Interface IPSite
Property QueryString As String
End Interface
Friend Class EditorExchangeOptionsBase_P : Inherits EditorExchangeOptionsBase : Implements IPSite
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property UserName As String
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadText As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadTextPosts As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadTextSpecialFolder As Boolean
<PSetting(Address:=SettingAddress.User, Caption:="Query",
ToolTip:="Query string. Don't change this field when creating a user! Change it only for the same request.")>
Friend Property QueryString As String Implements IPSite.QueryString
Friend Sub New()
DisableBase()
End Sub
Friend Sub New(ByVal u As UserDataBase)
MyBase.New(u)
DisableBase()
If TypeOf u Is IPSite Then QueryString = DirectCast(u, IPSite).QueryString
End Sub
Friend Sub New(ByVal s As SiteSettingsBase)
MyBase.New(s)
DisableBase()
End Sub
Friend Overridable Sub Apply(ByRef u As IPSite)
ApplyBase(u)
u.QueryString = QueryString
End Sub
Protected Overridable Sub DisableBase()
_ApplyBase_Name = False
_ApplyBase_Text = False
End Sub
End Class
End Namespace

View File

@@ -252,7 +252,20 @@ Namespace API.Base
#End Region #End Region
#Region "User name, ID, exist, suspend, options" #Region "User name, ID, exist, suspend, options"
Friend User As UserInfo Friend User As UserInfo
Private _IsSavedPosts As Boolean = False
Friend Property IsSavedPosts As Boolean Implements IPluginContentProvider.IsSavedPosts Friend Property IsSavedPosts As Boolean Implements IPluginContentProvider.IsSavedPosts
Get
Return _IsSavedPosts
End Get
Set(ByVal __IsSavedPosts As Boolean)
_IsSavedPosts = __IsSavedPosts
If _IsSavedPosts Then
DownloadText = True
DownloadTextPosts = True
DownloadTextSpecialFolder = True
End If
End Set
End Property
Private _UserExists As Boolean = True Private _UserExists As Boolean = True
Friend Overridable Property UserExists As Boolean Implements IUserData.Exists, IPluginContentProvider.UserExists Friend Overridable Property UserExists As Boolean Implements IUserData.Exists, IPluginContentProvider.UserExists
Get Get
@@ -300,7 +313,16 @@ Namespace API.Base
Return If(Exact, _NameTrue, _NameTrue.IfNullOrEmpty(Name)) Return If(Exact, _NameTrue, _NameTrue.IfNullOrEmpty(Name))
End Get End Get
End Property End Property
Friend Overridable Property ID As String = String.Empty Implements IUserData.ID, IPluginContentProvider.ID Private _ID As String = String.Empty
Friend Property ID As String Implements IUserData.ID, IPluginContentProvider.ID
Get
Return _ID
End Get
Set(ByVal NewId As String)
If Not _ID = NewId Then EnvirChanged(NewId)
_ID = NewId
End Set
End Property
Protected _FriendlyName As String = String.Empty Protected _FriendlyName As String = String.Empty
Friend Overridable Property FriendlyName As String Implements IUserData.FriendlyName Friend Overridable Property FriendlyName As String Implements IUserData.FriendlyName
Get Get
@@ -985,8 +1007,8 @@ BlockNullPicture:
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True) ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
DownloadImages = x.Value(Name_DownloadImages).FromXML(Of Boolean)(True) DownloadImages = x.Value(Name_DownloadImages).FromXML(Of Boolean)(True)
DownloadVideos = x.Value(Name_DownloadVideos).FromXML(Of Boolean)(True) DownloadVideos = x.Value(Name_DownloadVideos).FromXML(Of Boolean)(True)
DownloadText = x.Value(Name_DownloadText).FromXML(Of Boolean)(False) DownloadText = x.Value(Name_DownloadText).FromXML(Of Boolean)(IsSavedPosts)
DownloadTextPosts = x.Value(Name_DownloadTextPosts).FromXML(Of Boolean)(False) DownloadTextPosts = x.Value(Name_DownloadTextPosts).FromXML(Of Boolean)(IsSavedPosts)
DownloadTextSpecialFolder = x.Value(Name_DownloadTextSpecialFolder).FromXML(Of Boolean)(True) DownloadTextSpecialFolder = x.Value(Name_DownloadTextSpecialFolder).FromXML(Of Boolean)(True)
_IconBannerDownloaded = x.Value(Name_IconBannerDownloaded).FromXML(Of Boolean)(False) _IconBannerDownloaded = x.Value(Name_IconBannerDownloaded).FromXML(Of Boolean)(False)
DownloadedVideos(True) = x.Value(Name_VideoCount).FromXML(Of Integer)(0) DownloadedVideos(True) = x.Value(Name_VideoCount).FromXML(Of Integer)(0)
@@ -1222,7 +1244,8 @@ BlockNullPicture:
Select Case Caller Select Case Caller
Case NameOf(UserExists) : If Not _EnvirUserExists = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True Case NameOf(UserExists) : If Not _EnvirUserExists = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
Case NameOf(UserSuspended) : If Not _EnvirUserSuspended = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True Case NameOf(UserSuspended) : If Not _EnvirUserSuspended = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
Case NameOf(NameTrue) : _EnvirChanged = True : _EnvirInvokeUserUpdated = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True Case NameOf(NameTrue) : _EnvirChanged = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True
Case NameOf(ID) : _EnvirChanged = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True
Case Else : _EnvirChanged = True Case Else : _EnvirChanged = True
End Select End Select
End If End If
@@ -2265,6 +2288,7 @@ stxt:
End Function End Function
#End Region #End Region
#Region "Errors functions" #Region "Errors functions"
''' <summary>ToStringForLog(): Message</summary>
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String, Optional ByVal e As ErrorsDescriber = Nothing) Protected Sub LogError(ByVal ex As Exception, ByVal Message As String, Optional ByVal e As ErrorsDescriber = Nothing)
ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}") ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}")
End Sub End Sub

View File

@@ -27,6 +27,7 @@ Namespace API.Bluesky
Return If(ID.IsEmptyString, String.Empty, SymbolsConverter.ASCII.EncodeSymbolsOnly(ID)) Return If(ID.IsEmptyString, String.Empty, SymbolsConverter.ASCII.EncodeSymbolsOnly(ID))
End Get End Get
End Property End Property
Private ReadOnly _TmpPosts2 As List(Of String)
#End Region #End Region
#Region "Loader" #Region "Loader"
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)
@@ -42,6 +43,7 @@ Namespace API.Bluesky
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
UseInternalM3U8Function = True UseInternalM3U8Function = True
_TmpPosts2 = New List(Of String)
End Sub End Sub
#End Region #End Region
#Region "Token" #Region "Token"
@@ -62,11 +64,17 @@ Namespace API.Bluesky
#Region "Download" #Region "Download"
Private _PostCount As Integer = 0 Private _PostCount As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not CBool(MySettings.CookiesEnabled.Value) Then Responser.Cookies.Clear() _TmpPosts2.Clear()
UpdateToken(, True) Try
_TokenUpdateCount = 0 If Not CBool(MySettings.CookiesEnabled.Value) Then Responser.Cookies.Clear()
_PostCount = 0 UpdateToken(, True)
DownloadData(String.Empty, Token) _TokenUpdateCount = 0
_PostCount = 0
DownloadData(String.Empty, Token)
Finally
_TempPostsList.ListAddList(_TmpPosts2, LNC)
_TmpPosts2.Clear()
End Try
End Sub End Sub
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken) Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
@@ -117,7 +125,8 @@ Namespace API.Bluesky
Private Function DefaultParser(ByVal e As EContainer, Optional ByVal CheckDateLimits As Boolean = True, Optional ByRef NextCursor As String = Nothing, Private Function DefaultParser(ByVal e As EContainer, Optional ByVal CheckDateLimits As Boolean = True, Optional ByRef NextCursor As String = Nothing,
Optional ByVal CheckTempPosts As Boolean = True, Optional ByVal State As UStates = UStates.Unknown) As Integer Optional ByVal CheckTempPosts As Boolean = True, Optional ByVal State As UStates = UStates.Unknown) As Integer
Const exitReturn% = CInt(DateResult.Exit) * -1 Const exitReturn% = CInt(DateResult.Exit) * -1
Dim postID$, postDate$, __url$, __urlBase$, __txt$ Const skipReturn% = CInt(DateResult.Skip) * -1
Dim postID$, postDate$, __url$, __urlBase$, __txt$, __userId$
Dim updateUrl As Boolean Dim updateUrl As Boolean
Dim c% = 0 Dim c% = 0
Dim m As UserMedia Dim m As UserMedia
@@ -128,6 +137,7 @@ Namespace API.Bluesky
postDate = String.Empty postDate = String.Empty
__urlBase = String.Empty __urlBase = String.Empty
__txt = String.Empty __txt = String.Empty
__userId = .Value({"author"}, "did")
With .Item({"record"}) With .Item({"record"})
If .ListExists Then If .ListExists Then
'2025-01-28T02:42:12.415Z '2025-01-28T02:42:12.415Z
@@ -135,14 +145,18 @@ Namespace API.Bluesky
NextCursor = postDate NextCursor = postDate
If CheckDateLimits Then If CheckDateLimits Then
Select Case CheckDatesLimit(postDate, DateProvider) Select Case CheckDatesLimit(postDate, DateProvider)
Case DateResult.Skip : Return CInt(DateResult.Skip) * -1 'Continue For Case DateResult.Skip : Return skipReturn 'Continue For
Case DateResult.Exit : Return exitReturn 'Exit Sub Case DateResult.Exit : Return exitReturn 'Exit Sub
End Select End Select
End If End If
If CheckTempPosts Then If CheckTempPosts Then
If _TempPostsList.Contains(postID) Then Return exitReturn Else _TempPostsList.Add(postID) 'If _TempPostsList.Contains(postID) Then Return exitReturn Else _TempPostsList.Add(postID)
If _TempPostsList.Contains(postID) Then Return exitReturn Else _TmpPosts2.Add(postID)
End If End If
If ParseUserMediaOnly And Not ID.IsEmptyString And Not __userId.IsEmptyString And Not ID = __userId Then Return skipReturn
__urlBase = $"https://bsky.app/profile/{NameTrue}/post/{postID}" __urlBase = $"https://bsky.app/profile/{NameTrue}/post/{postID}"
End If End If
End With End With
@@ -338,6 +352,12 @@ Namespace API.Bluesky
Return 0 Return 0
End If End If
End Function End Function
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then _TmpPosts2.Clear()
MyBase.Dispose(disposing)
End Sub
#End Region #End Region
End Class End Class
End Namespace End Namespace

View File

@@ -676,10 +676,7 @@ Namespace API.Facebook
End If End If
Token_Photosby = RegexReplace(r, Regex_Photos_by) Token_Photosby = RegexReplace(r, Regex_Photos_by)
If StoryBucket.IsEmptyString Then StoryBucket = RegexReplace(r, Regex_StoryBucket) If StoryBucket.IsEmptyString Then StoryBucket = RegexReplace(r, Regex_StoryBucket)
If ID.IsEmptyString Then If ID.IsEmptyString Then ID = RegexReplace(r, Regex_UserID)
ID = RegexReplace(r, Regex_UserID)
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
End If End If
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, "get user token",, resp) ProcessException(ex, Token, "get user token",, resp)

View File

@@ -412,6 +412,7 @@ Namespace API.Instagram
ThrowAny(Token) ThrowAny(Token)
HasError = False HasError = False
Dim dt As Func(Of Boolean) = Function() (CBool(MySiteSettings.DownloadTimeline.Value) And GetTimeline) Or IsSavedPosts Dim dt As Func(Of Boolean) = Function() (CBool(MySiteSettings.DownloadTimeline.Value) And GetTimeline) Or IsSavedPosts
If FirstLoadingDone Then LastCursor = String.Empty
If dt.Invoke And Not LastCursor.IsEmptyString Then If dt.Invoke And Not LastCursor.IsEmptyString Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline) s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
upClaimRequest.Invoke upClaimRequest.Invoke
@@ -1151,12 +1152,30 @@ NextPageBlock:
If TryExtractImage Then If TryExtractImage Then
t = 1 t = 1
abstractDecision = True abstractDecision = True
If Not SpecialFolder.IsEmptyString AndAlso PutImageVideoFolder Then Dim endsAbs As Boolean
Dim endsAbs As Boolean = SpecialFolder.EndsWith("*") Dim newFolderName$
If endsAbs Then SpecialFolder = SpecialFolder.TrimEnd("*") If PutImageVideoFolder Then
If Not SpecialFolder.IsEmptyString Then SpecialFolder = $"{SpecialFolder.TrimEnd("\")}\{VideoFolderName}{IIf(Not endsAbs, "*", String.Empty)}" If SpecialFolder.IsEmptyString Then
If endsAbs Then SpecialFolder &= "*" newFolderName = $"{VideoFolderName}\*"
Else
endsAbs = SpecialFolder.EndsWith("*")
SpecialFolder = SpecialFolder.TrimEnd({CChar("\"), CChar("*")})
If Not endsAbs Then SpecialFolder = $"{SpecialFolder}\{VideoFolderName}"
newFolderName = $"{SpecialFolder}*"
End If
'Dim endsAbs As Boolean = SpecialFolder.EndsWith("*")
'If endsAbs Then SpecialFolder = SpecialFolder.TrimEnd("*")
'If Not SpecialFolder.IsEmptyString Then SpecialFolder = $"{SpecialFolder.TrimEnd("\")}\{VideoFolderName}{IIf(Not endsAbs, "*", String.Empty)}"
'If endsAbs Then SpecialFolder &= "*"
ElseIf Not SpecialFolder.IsEmptyString Then
endsAbs = SpecialFolder.EndsWith("*")
SpecialFolder = SpecialFolder.TrimEnd({CChar("\"), CChar("*")})
If endsAbs Then SpecialFolder = $"{SpecialFolder}\Photos"
newFolderName = $"{SpecialFolder}*"
Else
newFolderName = SpecialFolder
End If End If
SpecialFolder = newFolderName
ElseIf t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then ElseIf t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then
If n.Contains(vid) Then If n.Contains(vid) Then
t = 2 t = 2
@@ -1234,7 +1253,6 @@ NextPageBlock:
If Not j Is Nothing AndAlso j.Contains({"data", "user"}) Then If Not j Is Nothing AndAlso j.Contains({"data", "user"}) Then
With j({"data", "user"}) With j({"data", "user"})
ID = .Value("id") ID = .Value("id")
_ForceSaveUserData = True
__idFound = True __idFound = True
UserSiteNameUpdate(.Value("full_name")) UserSiteNameUpdate(.Value("full_name"))
Dim descr$ = .Value("biography") Dim descr$ = .Value("biography")

View File

@@ -116,6 +116,7 @@ Namespace API.OnlyFans
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
If _TempMediaList.Count > 0 And Not _NameUpdated Then GetUserID(True)
End If End If
Finally Finally
Responser_ResponseReceived_RemoveHandler() Responser_ResponseReceived_RemoveHandler()
@@ -430,7 +431,7 @@ Namespace API.OnlyFans
Result = False Result = False
With n("media") With n("media")
If .ListExists Then If .ListExists Then
For Each m In .Self For Each m As EContainer In .Self
postUrl = GetMediaURL(m) postUrl = GetMediaURL(m)
'If IsHL Then 'If IsHL Then
' 'postUrl = m.Value({"files", "source"}, "url") ' 'postUrl = m.Value({"files", "source"}, "url")
@@ -439,32 +440,34 @@ Namespace API.OnlyFans
' 'postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full")) ' 'postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
' postUrl = GetMediaURL(m) ' postUrl = GetMediaURL(m)
'End If 'End If
postUrlBase = String.Empty If m.Value("canView").FromXML(Of Boolean)(True) Then
Select Case m.Value("type") postUrlBase = String.Empty
Case "photo" : t = UTypes.Picture : ext = "jpg" Select Case m.Value("type")
Case "video" Case "photo" : t = UTypes.Picture : ext = "jpg"
t = UTypes.Video Case "video", "gif"
ext = "mp4" t = UTypes.Video
If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then ext = "mp4"
t = UTypes.VideoPre If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then
_AbsMediaIndex += 1 t = UTypes.VideoPre
If Not PostUserID.IsEmptyString And IsSingleObjectDownload Then _ _AbsMediaIndex += 1
postUrlBase = String.Format(SiteSettings.UserPostPattern, PostID, $"u{PostUserID}") If Not PostUserID.IsEmptyString And IsSingleObjectDownload Then _
End If postUrlBase = String.Format(SiteSettings.UserPostPattern, PostID, $"u{PostUserID}")
Case Else : t = UTypes.Undefined : ext = String.Empty End If
End Select Case Else : t = UTypes.Undefined : ext = String.Empty
If Not t = UTypes.Undefined And (Not postUrl.IsEmptyString Or t = UTypes.VideoPre) Then End Select
Dim media As New UserMedia(postUrl.IfNullOrEmpty(IIf(t = UTypes.VideoPre, $"{t}{_AbsMediaIndex}", String.Empty)), t) With { If Not t = UTypes.Undefined And (Not postUrl.IsEmptyString Or t = UTypes.VideoPre) Then
.Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing)), Dim media As New UserMedia(postUrl.IfNullOrEmpty(IIf(t = UTypes.VideoPre, $"{t}{_AbsMediaIndex}", String.Empty)), t) With {
.SpecialFolder = SpecFolder, .Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing)),
.PostText = PostText, .SpecialFolder = SpecFolder,
.PostTextFileSpecialFolder = DownloadTextSpecialFolder .PostText = PostText,
} .PostTextFileSpecialFolder = DownloadTextSpecialFolder
If postUrlBase.IsEmptyString And Not IsSingleObjectDownload Then postUrlBase = GetPostUrl(Me, media) }
If Not postUrlBase.IsEmptyString Then media.URL_BASE = postUrlBase If postUrlBase.IsEmptyString And Not IsSingleObjectDownload Then postUrlBase = GetPostUrl(Me, media)
media.File.Extension = ext If Not postUrlBase.IsEmptyString Then media.URL_BASE = postUrlBase
Result = True media.File.Extension = ext
mList.Add(media) Result = True
mList.Add(media)
End If
End If End If
Next Next
End If End If
@@ -486,7 +489,6 @@ Namespace API.OnlyFans
_NameUpdated = True _NameUpdated = True
If UpdateNameOnly Then Exit Sub If UpdateNameOnly Then Exit Sub
ID = j.Value("id") ID = j.Value("id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
UserSiteNameUpdate(j.Value("name")) UserSiteNameUpdate(j.Value("name"))
Dim descr$ = j.Value("about") Dim descr$ = j.Value("about")
If Not descr.IsEmptyString Then descr = descr.Replace(brTag, String.Empty) If Not descr.IsEmptyString Then descr = descr.Replace(brTag, String.Empty)

View File

@@ -15,7 +15,7 @@ Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.PornHub Namespace API.PornHub
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase : Implements IPSite
Private Const UrlPattern As String = "https://www.pornhub.com/{0}" Private Const UrlPattern As String = "https://www.pornhub.com/{0}"
#Region "Declarations" #Region "Declarations"
#Region "XML names" #Region "XML names"
@@ -140,7 +140,7 @@ Namespace API.PornHub
End Get End Get
End Property End Property
Friend Property SiteMode As SiteModes = SiteModes.User Friend Property SiteMode As SiteModes = SiteModes.User
Friend Property QueryString As String Friend Property QueryString As String Implements IPSite.QueryString
Get Get
If IsUser Then If IsUser Then
Return String.Empty Return String.Empty
@@ -163,17 +163,7 @@ Namespace API.PornHub
Return New UserExchangeOptions(Me) Return New UserExchangeOptions(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
With DirectCast(Obj, UserExchangeOptions)
DownloadUHD = .DownloadUHD
DownloadUploaded = .DownloadUploaded
DownloadTagged = .DownloadTagged
DownloadPrivate = .DownloadPrivate
DownloadFavorite = .DownloadFavorite
DownloadGifs = .DownloadGifs
QueryString = .QueryString
End With
End If
End Sub End Sub
#End Region #End Region
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings

View File

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

View File

@@ -32,22 +32,26 @@ Namespace API.Reddit
Property RedditAccount As String Property RedditAccount As String
Sub SetView(ByVal Options As IRedditView) Sub SetView(ByVal Options As IRedditView)
End Interface End Interface
Friend Class RedditViewExchange : Implements IRedditView Friend Class RedditViewExchange : Inherits Base.EditorExchangeOptionsBase : Implements IRedditView
Friend Const Name_ViewMode As String = "ViewMode" Friend Const Name_ViewMode As String = "ViewMode"
Friend Const Name_ViewPeriod As String = "ViewPeriod" Friend Const Name_ViewPeriod As String = "ViewPeriod"
Friend Const Name_RedGifsAccount As String = "RedGifsAccount" Friend Const Name_RedGifsAccount As String = "RedGifsAccount"
Friend Const Name_RedditAccount As String = "RedditAccount" Friend Const Name_RedditAccount As String = "RedditAccount"
Friend Property ViewMode As IRedditView.View Implements IRedditView.ViewMode Friend Property ViewMode As IRedditView.View Implements IRedditView.ViewMode
Friend Property ViewPeriod As IRedditView.Period Implements IRedditView.ViewPeriod Friend Property ViewPeriod As IRedditView.Period Implements IRedditView.ViewPeriod
Friend Property DownloadText As Boolean Implements IRedditView.DownloadText Friend Overrides Property DownloadText As Boolean Implements IRedditView.DownloadText
Friend Property DownloadTextPosts As Boolean Implements IRedditView.DownloadTextPosts Friend Overrides Property DownloadTextPosts As Boolean Implements IRedditView.DownloadTextPosts
Friend Property DownloadTextSpecialFolder As Boolean Implements IRedditView.DownloadTextSpecialFolder Friend Overrides Property DownloadTextSpecialFolder As Boolean Implements IRedditView.DownloadTextSpecialFolder
Friend Property RedGifsAccount As String Implements IRedditView.RedGifsAccount Friend Property RedGifsAccount As String Implements IRedditView.RedGifsAccount
Friend Property RedditAccount As String Implements IRedditView.RedditAccount Friend Property RedditAccount As String Implements IRedditView.RedditAccount
Friend Sub New()
End Sub
Friend Sub New(ByVal Options As IRedditView) Friend Sub New(ByVal Options As IRedditView)
MyBase.New(DirectCast(Options, UserData))
SetView(Options) SetView(Options)
_ApplyBase_Name = False
End Sub
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
_ApplyBase_Name = False
End Sub End Sub
Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView
If Not Options Is Nothing Then If Not Options Is Nothing Then

View File

@@ -9,26 +9,38 @@
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports System.Reflection
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.Base Imports PersonalUtilities.Tools.Web.Clients.Base
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Imports DownDetector = SCrawler.API.Base.DownDetector Imports DownDetector = SCrawler.API.Base.DownDetector
Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Reddit Namespace API.Reddit
<Manifest(RedditSiteKey), SavedPosts, SpecialForm(False), UseDownDetector> <Manifest(RedditSiteKey), SavedPosts, SeparatedTasks, SpecialForm(False), UseDownDetector>
Friend Class SiteSettings : Inherits SiteSettingsBase : Implements DownDetector.IDownDetector Friend Class SiteSettings : Inherits SiteSettingsBase : Implements DownDetector.IDownDetector
#Region "Declarations" #Region "Declarations"
#Region "Authorization" #Region "Authorization"
Private Const ApiClientID_Default As String = "dYctRA-SIJxyykHe27lGZg"
Private Const ApiClientSecret_Default As String = "_5D6KzplRPDga-es1YlpzDIe9hiFlg"
<PropertyOption(ControlText:="Login", ControlToolTip:="Your authorization username", IsAuth:=True), PXML, PClonable(Clone:=False)> <PropertyOption(ControlText:="Login", ControlToolTip:="Your authorization username", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property AuthUserName As PropertyValue Friend ReadOnly Property AuthUserName As PropertyValue
<PropertyOption(ControlText:="Password", ControlToolTip:="Your authorization password", IsAuth:=True), PXML, PClonable(Clone:=False)> <PropertyOption(ControlText:="Password", ControlToolTip:="Your authorization password", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property AuthPassword As PropertyValue Friend ReadOnly Property AuthPassword As PropertyValue
<PropertyOption(ControlText:="Client ID", ControlToolTip:="Your registered app client ID", IsAuth:=True), PXML, PClonable(Clone:=False)> <PropertyOption(ControlText:="Client ID", ControlToolTip:="Your registered app client ID", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property ApiClientID As PropertyValue Friend ReadOnly Property ApiClientID As PropertyValue
<PropertyUpdater(NameOf(ApiClientID))> Private Function ApiClientID_SetDefault() As Boolean
ApiClientID.Value = ApiClientID_Default
Return True
End Function
<PropertyOption(ControlText:="Client Secret", ControlToolTip:="Your registered app client secret", IsAuth:=True), PXML, PClonable(Clone:=False)> <PropertyOption(ControlText:="Client Secret", ControlToolTip:="Your registered app client secret", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property ApiClientSecret As PropertyValue Friend ReadOnly Property ApiClientSecret As PropertyValue
<PropertyUpdater(NameOf(ApiClientSecret))> Private Function ApiClientSecret_SetDefault() As Boolean
ApiClientSecret.Value = ApiClientSecret_Default
Return True
End Function
<PropertyOption(ControlText:="Bearer token", <PropertyOption(ControlText:="Bearer token",
ControlToolTip:="Bearer token (can be null)." & vbCr & ControlToolTip:="Bearer token (can be null)." & vbCr &
"If you are using cookies to download the timeline, it is highly recommended that you add a token." & vbCr & "If you are using cookies to download the timeline, it is highly recommended that you add a token." & vbCr &
@@ -58,14 +70,59 @@ Namespace API.Reddit
Return {AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString) Return {AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString)
End Get End Get
End Property End Property
<PropertiesDataChecker({NameOf(AuthUserName), NameOf(AuthPassword), NameOf(ApiClientID), NameOf(ApiClientSecret),
NameOf(UseTokenForTimelines), NameOf(UseCookiesForTimelines)})>
Private Function OAuthCredentialsChecker(ByVal p As IEnumerable(Of PropertyData)) As Boolean
Const msgTitle$ = "OAuth credentials"
If p.ListExists Then
Dim useToken As Boolean = False, useCookies As Boolean = False
Dim d$ = String.Empty
Dim dCount As Byte = 0
Dim members As IEnumerable(Of MemberInfo) = GetObjectMembers(Me)
Dim getPropText As Func(Of String, String) = Function(name) members.First(Function(m) m.Name = name).GetCustomAttribute(Of PropertyOption).ControlText
Dim dataStr As Action(Of String, String) = Sub(dd, name) If dd.IsEmptyString Then d.StringAppendLine(getPropText(name)) : dCount += 1
For Each pp As PropertyData In p
Select Case pp.Name
Case NameOf(AuthUserName) : dataStr(pp.Value, NameOf(AuthUserName))
Case NameOf(AuthPassword) : dataStr(pp.Value, NameOf(AuthPassword))
Case NameOf(ApiClientID) : dataStr(pp.Value, NameOf(ApiClientID))
Case NameOf(ApiClientSecret) : dataStr(pp.Value, NameOf(ApiClientSecret))
Case NameOf(UseTokenForTimelines) : useToken = pp.Value
Case NameOf(UseCookiesForTimelines) : useCookies = pp.Value
Case Else : Throw New ArgumentException($"Property name '{pp.Name}' is not implemented", "Property Name")
End Select
Next
If d.IsEmptyString Then
If useToken And useCookies Then
Return True
Else
If Not useToken Then d.StringAppendLine(getPropText(NameOf(UseTokenForTimelines)))
If Not useCookies Then d.StringAppendLine(getPropText(NameOf(UseCookiesForTimelines)))
MsgBoxE({$"You need to check the following options:{vbCr}{d}", msgTitle}, vbCritical)
Return False
End If
ElseIf dCount = 4 Then
Return MsgBoxE({$"You haven't configured OAuth. It's highly recommended to use OAuth.{vbCr}Do you still want to continue?", msgTitle},
vbExclamation,,, {"Process", "Cancel"}) = 0
Else
MsgBoxE({$"You haven't filled in the following fields:{vbCr}{d}.{vbCr}{vbCr}" &
"To use OAuth authorization, you must fill in all authorization fields.", msgTitle}, vbCritical)
Return False
End If
End If
Return True
End Function
#End Region #End Region
#Region "Other" #Region "Other"
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML, PClonable> <PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos"), PXML, PClonable, HiddenControl>
Friend ReadOnly Property UseM3U8 As PropertyValue Friend ReadOnly Property UseM3U8 As PropertyValue
<PropertyOption(ControlText:="Check image", ControlToolTip:="Check the image if it exists before downloading (it makes downloading very slow)", IsAuth:=False), PXML, PClonable> <PropertyOption(ControlText:="Check image", ControlToolTip:="Check the image if it exists before downloading (it makes downloading very slow)"), PXML, PClonable, HiddenControl>
Friend ReadOnly Property CheckImage As PropertyValue Friend ReadOnly Property CheckImage As PropertyValue
<PropertyOption(ControlText:="Check image: get original", ControlToolTip:="Get the original image if it exists", IsAuth:=False), PXML, PClonable> <PropertyOption(ControlText:="Check image: get original", ControlToolTip:="Get the original image if it exists"), PXML, PClonable, HiddenControl>
Friend ReadOnly Property CheckImageReturnOrig As PropertyValue Friend ReadOnly Property CheckImageReturnOrig As PropertyValue
<PropertyOption(ControlText:=DN.ConcurrentDownloadsCaption,
ControlToolTip:=DN.ConcurrentDownloadsToolTip, AllowNull:=False), PXML, TaskCounter, PClonable>
Friend ReadOnly Property ConcurrentDownloads As PropertyValue
#End Region #End Region
#Region "IDownDetector Support" #Region "IDownDetector Support"
Private ReadOnly Property IDownDetector_Value As Integer Implements DownDetector.IDownDetector.Value Private ReadOnly Property IDownDetector_Value As Integer Implements DownDetector.IDownDetector.Value
@@ -117,6 +174,7 @@ Namespace API.Reddit
UseM3U8 = New PropertyValue(True) UseM3U8 = New PropertyValue(True)
CheckImage = New PropertyValue(False) CheckImage = New PropertyValue(False)
CheckImageReturnOrig = New PropertyValue(True) CheckImageReturnOrig = New PropertyValue(True)
ConcurrentDownloads = New PropertyValue(1)
MDD = New MyDownDetector(Me) MDD = New MyDownDetector(Me)
@@ -124,10 +182,13 @@ Namespace API.Reddit
ImageVideoContains = "reddit.com" ImageVideoContains = "reddit.com"
UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/\?&]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue) UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/\?&]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
End Sub End Sub
Private Const SettingsVersionCurrent As Integer = 2 Private Const SettingsVersionCurrent As Integer = 3
Friend Overrides Sub EndInit() Friend Overrides Sub EndInit()
If CInt(SettingsVersion.Value) < SettingsVersionCurrent Then If CInt(SettingsVersion.Value) < SettingsVersionCurrent Then
SettingsVersion.Value = SettingsVersionCurrent SettingsVersion.Value = SettingsVersionCurrent
UseM3U8.Value = True
CheckImage.Value = False
CheckImageReturnOrig.Value = True
BearerTokenUseCurl.Value = False BearerTokenUseCurl.Value = False
End If End If
MyBase.EndInit() MyBase.EndInit()
@@ -165,6 +226,7 @@ Namespace API.Reddit
End Sub End Sub
End Class End Class
Friend Property SessionInterrupted As Boolean = False Friend Property SessionInterrupted As Boolean = False
Friend Property RequestCount As Integer = 0
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If What = Download.Main Then If What = Download.Main Then
Return Not SessionInterrupted Return Not SessionInterrupted
@@ -180,6 +242,7 @@ Namespace API.Reddit
End Function End Function
Friend Overrides Sub DownloadDone(ByVal What As Download) Friend Overrides Sub DownloadDone(ByVal What As Download)
SessionInterrupted = False SessionInterrupted = False
RequestCount = 0
MDD.Reset() MDD.Reset()
MyBase.DownloadDone(What) MyBase.DownloadDone(What)
End Sub End Sub
@@ -212,7 +275,7 @@ Namespace API.Reddit
#End Region #End Region
#Region "UserOptions" #Region "UserOptions"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange(Me)
If OpenForm Then If OpenForm Then
Using f As New RedditViewSettingsForm(Options, True) : f.ShowDialog() : End Using Using f As New RedditViewSettingsForm(Options, True) : f.ShowDialog() : End Using
End If End If
@@ -233,23 +296,6 @@ Namespace API.Reddit
End Sub End Sub
#End Region #End Region
#Region "Token" #Region "Token"
<PropertiesDataChecker({NameOf(AuthUserName), NameOf(AuthPassword), NameOf(ApiClientID), NameOf(ApiClientSecret)})>
Private Function TokenPropertiesChecker(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists Then
Dim wrong As New List(Of String)
For i% = 0 To p.Count - 1
If CStr(p(i).Value).IsEmptyString Then wrong.Add(p(i).Name)
Next
If wrong.Count > 0 And wrong.Count <> 4 Then
MsgBoxE({$"You have not completed the following fields: {wrong.ListToString}." & vbCr &
"To use OAuth authorization, all authorization fields must be filled in.", "Validate token fields"}, vbCritical)
Return False
Else
Return True
End If
End If
Return False
End Function
Private Function UpdateTokenIfRequired() As Boolean Private Function UpdateTokenIfRequired() As Boolean
UpdateRedGifsToken() UpdateRedGifsToken()
If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso CredentialsExists Then If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso CredentialsExists Then

View File

@@ -8,19 +8,20 @@
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Net Imports System.Net
Imports System.Threading Imports System.Threading
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools.ImageRenderer
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.Base
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.API.Reddit.RedditViewExchange Imports SCrawler.API.Reddit.RedditViewExchange
Imports SCrawler.API.YouTube.Objects Imports SCrawler.API.YouTube.Objects
Imports SCrawler.Plugin.Hosts Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.XML Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
Imports PersonalUtilities.Functions.RegularExpressions Imports CView = SCrawler.API.Reddit.IRedditView.View
Imports PersonalUtilities.Tools.ImageRenderer
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports CView = SCrawler.API.Reddit.IRedditView.View
Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit Namespace API.Reddit
Friend Class UserData : Inherits UserDataBase : Implements IChannelLimits, IRedditView Friend Class UserData : Inherits UserDataBase : Implements IChannelLimits, IRedditView
#Region "Declarations" #Region "Declarations"
@@ -135,6 +136,7 @@ Namespace API.Reddit
DownloadTextSpecialFolder = .DownloadTextSpecialFolder DownloadTextSpecialFolder = .DownloadTextSpecialFolder
RedGifsAccount = .RedGifsAccount RedGifsAccount = .RedGifsAccount
RedditAccount = .RedditAccount RedditAccount = .RedditAccount
If TypeOf Options Is RedditViewExchange Then DirectCast(Options, RedditViewExchange).ApplyBase(Me)
End With End With
End If End If
End Sub End Sub
@@ -268,6 +270,8 @@ Namespace API.Reddit
End If End If
End With End With
Responser.ProcessExceptionDecision = AddressOf Err429Process
_TotalPostsDownloaded = 0 _TotalPostsDownloaded = 0
If IsSavedPosts Then If IsSavedPosts Then
Responser.DecodersError = EDP.ReturnValue Responser.DecodersError = EDP.ReturnValue
@@ -303,6 +307,7 @@ Namespace API.Reddit
#End Region #End Region
#Region "Download Functions (User, Channel)" #Region "Download Functions (User, Channel)"
Private Err429Count As Integer = 0 Private Err429Count As Integer = 0
Private Err429TryAgain As Boolean = False
Private _TotalPostsDownloaded As Integer = 0 Private _TotalPostsDownloaded As Integer = 0
Private ReadOnly _CrossPosts As List(Of String) Private ReadOnly _CrossPosts As List(Of String)
Private Const SiteGfycatKey As String = "gfycat" Private Const SiteGfycatKey As String = "gfycat"
@@ -310,6 +315,28 @@ Namespace API.Reddit
Private Const Node_CrosspostRootId As String = "crosspostRootId" Private Const Node_CrosspostRootId As String = "crosspostRootId"
Private Const Node_CrosspostParentId As String = "crosspostParentId" Private Const Node_CrosspostParentId As String = "crosspostParentId"
Private Const Node_CrosspostParent As String = "crosspost_parent" Private Const Node_CrosspostParent As String = "crosspost_parent"
Private Sub Wait429()
With MySiteSettings
If Not Err429TryAgain Then .RequestCount += 1
Err429TryAgain = False
If (.RequestCount Mod 100) = 0 Then Thread.Sleep(60100)
End With
End Sub
Private Function Err429Process(ByVal Status As IResponserStatus, ByVal NullArg As Object, ByVal CurrErr As ErrorsDescriber) As ErrorsDescriber
If Not Status Is Nothing AndAlso Status.StatusCode = 429 Then
If Err429Count = 0 Then
Err429Count += 1
MySiteSettings.RequestCount = 100
Err429TryAgain = True
Return EDP.ReturnValue
End If
End If
Return CurrErr
End Function
Private Sub Err429Reset()
Err429Count = 0
Err429TryAgain = False
End Sub
Private Sub DownloadDataUser(ByVal POST As String, ByVal Token As CancellationToken) Private Sub DownloadDataUser(ByVal POST As String, ByVal Token As CancellationToken)
Dim eObj% = 0 Dim eObj% = 0
Dim round% = 0 Dim round% = 0
@@ -330,8 +357,10 @@ Namespace API.Reddit
'URL = $"https://gateway.reddit.com/desktopapi/v1/user/{NameTrue}/posts?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic" 'URL = $"https://gateway.reddit.com/desktopapi/v1/user/{NameTrue}/posts?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
URL = $"https://oauth.reddit.com/user/{NameTrue}/submitted.json?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic" URL = $"https://oauth.reddit.com/user/{NameTrue}/submitted.json?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
ThrowAny(Token) ThrowAny(Token)
Wait429()
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Err429Reset()
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
If w.Count > 0 Then If w.Count > 0 Then
'n = w.GetNode(JsonNodesJson) 'n = w.GetNode(JsonNodesJson)
@@ -346,6 +375,7 @@ Namespace API.Reddit
If CheckNode(.Self) Then If CheckNode(.Self) Then
'Obtain post ID 'Obtain post ID
PostID = String.Empty
PostTmp = .Value("name") '.Name PostTmp = .Value("name") '.Name
If PostTmp.IsEmptyString Then PostTmp = .Value("id") If PostTmp.IsEmptyString Then PostTmp = .Value("id")
If PostTmp.IsEmptyString Then Continue For If PostTmp.IsEmptyString Then Continue For
@@ -353,8 +383,9 @@ Namespace API.Reddit
If IsCrossPost(.Self) Then If IsCrossPost(.Self) Then
_CrossPosts.ListAddList({ .Value(Node_CrosspostRootId), _CrossPosts.ListAddList({ .Value(Node_CrosspostRootId),
.Value(Node_CrosspostParentId), .Value(Node_CrosspostParentId),
.Value(Node_CrosspostParent)}, LNC) .Value(Node_CrosspostParent),
Continue For PostTmp}, LNC)
If ParseUserMediaOnly Then Continue For
Else Else
If Not _CrossPosts.Contains(PostTmp) Then PostID = PostTmp : PostTmp = String.Empty If Not _CrossPosts.Contains(PostTmp) Then PostID = PostTmp : PostTmp = String.Empty
End If End If
@@ -383,6 +414,8 @@ Namespace API.Reddit
End Using End Using
If POST.IsEmptyString And ExistsDetected Then Exit Sub If POST.IsEmptyString And ExistsDetected Then Exit Sub
If Not _PostID().IsEmptyString And NewPostDetected Then DownloadDataUser(_PostID(), Token) If Not _PostID().IsEmptyString And NewPostDetected Then DownloadDataUser(_PostID(), Token)
ElseIf Err429TryAgain Then
Continue Do
End If End If
_completed = True _completed = True
Catch ex As Exception Catch ex As Exception
@@ -419,9 +452,11 @@ Namespace API.Reddit
End If End If
ThrowAny(Token) ThrowAny(Token)
Wait429()
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
If IsSavedPosts Then Err429Count = 0 'If IsSavedPosts Then Err429Count = 0
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Err429Reset()
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
If w.Count > 0 Then If w.Count > 0 Then
n = w.GetNode(ChannelJsonNodes) n = w.GetNode(ChannelJsonNodes)
@@ -478,6 +513,8 @@ Namespace API.Reddit
End Using End Using
If POST.IsEmptyString And ExistsDetected Then Exit Sub If POST.IsEmptyString And ExistsDetected Then Exit Sub
If Not PostID.IsEmptyString And NewPostDetected Then DownloadDataChannel(PostID, Token) If Not PostID.IsEmptyString And NewPostDetected Then DownloadDataChannel(PostID, Token)
ElseIf Err429TryAgain Then
Continue Do
End If End If
_completed = True _completed = True
Catch ex As Exception Catch ex As Exception
@@ -495,11 +532,13 @@ Namespace API.Reddit
End Sub End Sub
#End Region #End Region
#Region "GetUserInfo" #Region "GetUserInfo"
Private Sub GetUserInfo() Private Sub GetUserInfo(Optional ByVal Round As Integer = 0)
Try Try
If Not IsSavedPosts And ChannelInfo Is Nothing Then If Not IsSavedPosts And ChannelInfo Is Nothing Then
Wait429()
Dim r$ = Responser.GetResponse($"https://reddit.com/{IIf(IsChannel, "r", "user")}/{NameTrue}/about.json",, EDP.ReturnValue) Dim r$ = Responser.GetResponse($"https://reddit.com/{IIf(IsChannel, "r", "user")}/{NameTrue}/about.json",, EDP.ReturnValue)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Err429Reset()
Using j As EContainer = JsonDocument.Parse(r) Using j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing AndAlso j.Contains({"data", "subreddit"}) Then If Not j Is Nothing AndAlso j.Contains({"data", "subreddit"}) Then
If ID.IsEmptyString Then ID = j.Value({"data"}, "id") If ID.IsEmptyString Then ID = j.Value({"data"}, "id")
@@ -515,6 +554,8 @@ Namespace API.Reddit
End With End With
End If End If
End Using End Using
ElseIf Err429TryAgain And Round < 2 Then
GetUserInfo(Round + 1)
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
@@ -630,16 +671,21 @@ Namespace API.Reddit
Else Else
Dim tPostId$ = e.Value(Node_CrosspostParent).IfNullOrEmpty(e.Value(Node_CrosspostParentId)).IfNullOrEmpty(e.Value(Node_CrosspostRootId)) Dim tPostId$ = e.Value(Node_CrosspostParent).IfNullOrEmpty(e.Value(Node_CrosspostParentId)).IfNullOrEmpty(e.Value(Node_CrosspostRootId))
If Not PostID.IsEmptyString Then If Not PostID.IsEmptyString Then
Dim r$ = Responser.GetResponse($"https://www.reddit.com/comments/{tPostId.Split("_").LastOrDefault}/.json",, EDP.ReturnValue) For ri% = 0 To 1
If Not r.IsEmptyString Then Wait429()
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue) Dim r$ = Responser.GetResponse($"https://www.reddit.com/comments/{tPostId.Split("_").LastOrDefault}/.json",, EDP.ReturnValue)
If j.ListExists Then If Not r.IsEmptyString Then
With j.ItemF({0, "data", "children", 0, "data"}) Err429Reset()
If .ListExists Then added = ParseContainer(.Self, PostID, PostDate, UserID, False, PostText) Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
End With If j.ListExists Then
End If With j.ItemF({0, "data", "children", 0, "data"})
End Using If .ListExists Then added = ParseContainer(.Self, PostID, PostDate, UserID, False, PostText)
End If End With
End If
End Using
Exit For
End If
Next
End If End If
End If End If
End If End If
@@ -905,7 +951,10 @@ Namespace API.Reddit
End If End If
Continue For Continue For
Else Else
Wait429()
r = Responser.GetResponse(m.URL,, e) r = Responser.GetResponse(m.URL,, e)
If r.IsEmptyString And Err429TryAgain Then _repeatForRedgifs = True
If Not r.IsEmptyString Then Err429Reset()
End If End If
Loop While _repeatForRedgifs Loop While _repeatForRedgifs
Else Else
@@ -943,11 +992,13 @@ Namespace API.Reddit
RedGifsResponser = RedGifsHost.Responser.Copy RedGifsResponser = RedGifsHost.Responser.Copy
Dim respNoHeaders As Responser = Responser.Copy Dim respNoHeaders As Responser = Responser.Copy
Dim m As UserMedia, m2 As UserMedia Dim m As UserMedia, m2 As UserMedia
Dim r$, url$ Dim r$ = String.Empty, url$
Dim ri As Byte
Dim j As EContainer Dim j As EContainer
Dim lastCount%, li% Dim lastCount%, li%
Dim rv As New ErrorsDescriber(EDP.ReturnValue) Dim rv As New ErrorsDescriber(EDP.ReturnValue)
respNoHeaders.Headers.Clear() respNoHeaders.Headers.Clear()
respNoHeaders.ProcessExceptionDecision = AddressOf Err429Process
ProgressPre.ChangeMax(_ContentList.Count) ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1 For i% = 0 To _ContentList.Count - 1
m = _ContentList(i) m = _ContentList(i)
@@ -955,9 +1006,14 @@ Namespace API.Reddit
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token) ThrowAny(Token)
url = $"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json" url = $"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json"
r = Responser.GetResponse(url,, rv) For ri = 0 To 1
If r.IsEmptyString Then r = respNoHeaders.GetResponse(url,, rv) Wait429()
r = Responser.GetResponse(url,, rv)
If r.IsEmptyString Then Wait429() : r = respNoHeaders.GetResponse(url,, rv)
If Not (r.IsEmptyString And Err429TryAgain) Then Exit For
Next
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Err429Reset()
j = JsonDocument.Parse(r, rv) j = JsonDocument.Parse(r, rv)
If Not j Is Nothing Then If Not j Is Nothing Then
If j.Count > 0 Then If j.Count > 0 Then
@@ -1089,25 +1145,37 @@ Namespace API.Reddit
ElseIf .StatusCode = HttpStatusCode.Forbidden Then '403 ElseIf .StatusCode = HttpStatusCode.Forbidden Then '403
UserSuspended = True UserSuspended = True
ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then '502, 503 ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then '502, 503
MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] Reddit is currently unavailable" LogError(Nothing, $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable")
Throw New Plugin.ExitException With {.Silent = True} Throw New Plugin.ExitException With {.Silent = True}
ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then '504 ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then '504
Return 1 Return 1
ElseIf .StatusCode = HttpStatusCode.Unauthorized Then '401 ElseIf .StatusCode = HttpStatusCode.Unauthorized Then '401
MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] Reddit credentials expired" LogError(Nothing, $"[{CInt(Responser.StatusCode)}] Reddit credentials expired")
MySiteSettings.SessionInterrupted = True MySiteSettings.SessionInterrupted = True
Throw New Plugin.ExitException With {.Silent = True} Throw New Plugin.ExitException With {.Silent = True}
ElseIf .StatusCode = HttpStatusCode.InternalServerError Then '500 ElseIf .StatusCode = HttpStatusCode.InternalServerError Then '500
If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1 If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1
Return HttpStatusCode.InternalServerError Return HttpStatusCode.InternalServerError
ElseIf .StatusCode = 429 And IsSavedPosts And Err429Count = 0 Then 'ElseIf .StatusCode = 429 And IsSavedPosts And Err429Count = 0 Then '429 (saved)
Err429Count += 1 ' Err429Count += 1
Return 429 ' Return 429
ElseIf .StatusCode = 429 AndAlso ElseIf .StatusCode = 429 Then '429 (all)
((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso 'If ((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso
Not MySiteSettings.CredentialsExists Then '429 ' Not MySiteSettings.CredentialsExists Then
MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] You should use OAuth authorization or disable " & ' LogError(Nothing, "[429] You should use OAuth authorization or disable " &
IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines") ' IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines"))
'Else
' LogError(Nothing, "Too many requests (429). Try again later!")
'End If
'MySiteSettings.SessionInterrupted = True
'Throw New Plugin.ExitException With {.Silent = True}
If ((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso
Not MySiteSettings.CredentialsExists Then
LogError(Nothing, "[429] You should use OAuth authorization or disable " &
IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines"))
Else
LogError(Nothing, "Too many requests (429). Try again later!")
End If
MySiteSettings.SessionInterrupted = True MySiteSettings.SessionInterrupted = True
Throw New Plugin.ExitException With {.Silent = True} Throw New Plugin.ExitException With {.Silent = True}
Else Else

View File

@@ -22,6 +22,7 @@ Namespace API.RedGifs
Friend ReadOnly Property Token As PropertyValue Friend ReadOnly Property Token As PropertyValue
<PropertyOption, ControlNumber(2), PClonable, HiddenControl> <PropertyOption, ControlNumber(2), PClonable, HiddenControl>
Private ReadOnly Property UserAgent As PropertyValue Private ReadOnly Property UserAgent As PropertyValue
<PXML> Friend ReadOnly Property UseCookies As PropertyValue
<PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue <PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue
Private Const TokenName As String = "authorization" Private Const TokenName As String = "authorization"
#Region "TokenUpdateInterval" #Region "TokenUpdateInterval"
@@ -47,6 +48,7 @@ Namespace API.RedGifs
End With End With
Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(NameOf(Token), v)) Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(NameOf(Token), v))
UserAgent = New PropertyValue(If(Responser.UserAgentExists, Responser.UserAgent, String.Empty), GetType(String), Sub(v) UpdateResponse(NameOf(UserAgent), v)) UserAgent = New PropertyValue(If(Responser.UserAgentExists, Responser.UserAgent, String.Empty), GetType(String), Sub(v) UpdateResponse(NameOf(UserAgent), v))
UseCookies = New PropertyValue(False)
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date)) TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date))
TokenUpdateInterval = New PropertyValue(60 * 12, GetType(Integer)) TokenUpdateInterval = New PropertyValue(60 * 12, GetType(Integer))
TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider

View File

@@ -36,6 +36,7 @@ Namespace API.RedGifs
#End Region #End Region
#Region "Download functions" #Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not MySettings.UseCookies.Value Then Responser.Cookies.Clear()
DownloadData(1, Token) DownloadData(1, Token)
End Sub End Sub
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken) Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken)

View File

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

View File

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

View File

@@ -256,10 +256,7 @@ Namespace API.TikTok
If j.Value("_type").StringToLower = "video" Then If j.Value("_type").StringToLower = "video" Then
If Not baseDataObtained Then If Not baseDataObtained Then
baseDataObtained = True baseDataObtained = True
If ID.IsEmptyString Then If ID.IsEmptyString Then ID = j.Value("uploader_id")
ID = j.Value("uploader_id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
newName = j.Value("uploader") newName = j.Value("uploader")
If Not newName.IsEmptyString Then NameTrue = newName If Not newName.IsEmptyString Then NameTrue = newName
newName = j.Value("creator") newName = j.Value("creator")
@@ -425,7 +422,11 @@ Namespace API.TikTok
End If End If
If DateBefore.HasValue Then command &= $"--datebefore {DateBefore.Value.AddDays(1).ToStringDate(SimpleDateConverter)} " If DateBefore.HasValue Then command &= $"--datebefore {DateBefore.Value.AddDays(1).ToStringDate(SimpleDateConverter)} "
If DateAfter.HasValue Then command &= $"--dateafter {DateAfter.Value.AddDays(-1).ToStringDate(SimpleDateConverter)} " If DateAfter.HasValue Then command &= $"--dateafter {DateAfter.Value.AddDays(-1).ToStringDate(SimpleDateConverter)} "
If Not CBool(If(IsSingleObjectDownload, MySettings.UseParsedVideoDateSTD, MySettings.UseParsedVideoDate).Value) Then command &= "--no-mtime " If Not CBool(If(IsSingleObjectDownload, MySettings.UseParsedVideoDateSTD, MySettings.UseParsedVideoDate).Value) Then
command &= "--no-mtime "
Else
command &= "--mtime "
End If
If MySettings.CookiesNetscapeFile.Exists Then command &= $"--no-cookies-from-browser --cookies ""{MySettings.CookiesNetscapeFile}"" " If MySettings.CookiesNetscapeFile.Exists Then command &= $"--no-cookies-from-browser --cookies ""{MySettings.CookiesNetscapeFile}"" "
command &= $"{URL} " command &= $"{URL} "
If SupportOutput Then If SupportOutput Then

View File

@@ -50,6 +50,10 @@ Namespace API.Twitter
Caption:="Force apply", Caption:="Force apply",
ToolTip:="Force overrides the default parameters for the first download." & vbCr & "Applies to first download only.", LeftOffset:=DefaultOffset)> ToolTip:="Force overrides the default parameters for the first download." & vbCr & "Applies to first download only.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelForceApply As Boolean = False Friend Overridable Property DownloadModelForceApply As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Large profile",
ToolTip:="This setting is only used on the first download and is intended to temporarily override the default site settings if they are incompatible with downloading large profiles. After the first download is complete, this option will be disabled and cannot be enabled again.")>
Friend Overridable Property LargeProfile As Boolean = False
Private ReadOnly Property MySettings As Object Private ReadOnly Property MySettings As Object
Friend Sub New(ByVal s As SiteSettings) Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s) MyBase.New(s)
@@ -76,6 +80,7 @@ Namespace API.Twitter
UseMD5Comparison = u.UseMD5Comparison UseMD5Comparison = u.UseMD5Comparison
RemoveExistingDuplicates = u.RemoveExistingDuplicates RemoveExistingDuplicates = u.RemoveExistingDuplicates
MediaModelAllowNonUserTweets = u.MediaModelAllowNonUserTweets MediaModelAllowNonUserTweets = u.MediaModelAllowNonUserTweets
LargeProfile = u.LargeProfile
If Not TypeOf u Is Mastodon.UserData Then If Not TypeOf u Is Mastodon.UserData Then
DownloadModelForceApply = u.DownloadModelForceApply DownloadModelForceApply = u.DownloadModelForceApply
DownloadBroadcasts = u.DownloadBroadcasts DownloadBroadcasts = u.DownloadBroadcasts

View File

@@ -38,6 +38,7 @@ Namespace API.Twitter
Private Const CAT_DOWN As String = "Downloading" Private Const CAT_DOWN As String = "Downloading"
#End Region #End Region
#Region "Auth" #Region "Auth"
Friend Property CookiesUpdateForce As Boolean = False
<PropertyOption(ControlText:="Update cookies", ControlToolTip:="Update cookies during requests", IsAuth:=True), PXML, PClonable, HiddenControl> <PropertyOption(ControlText:="Update cookies", ControlToolTip:="Update cookies during requests", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property CookiesUpdate As PropertyValue Friend ReadOnly Property CookiesUpdate As PropertyValue
<PropertyOption(ControlText:="Use UserAgent", ControlToolTip:="Use UserAgent in requests", IsAuth:=True), PXML, PClonable> <PropertyOption(ControlText:="Use UserAgent", ControlToolTip:="Use UserAgent in requests", IsAuth:=True), PXML, PClonable>
@@ -45,9 +46,9 @@ Namespace API.Twitter
<PropertyOption(ControlText:="UserAgent", IsAuth:=True, AllowNull:=True, InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent), <PropertyOption(ControlText:="UserAgent", IsAuth:=True, AllowNull:=True, InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent),
PXML("UserAgent", OnlyForChecked:=True), PClonable> PXML("UserAgent", OnlyForChecked:=True), PClonable>
Private ReadOnly Property UserAgentXML As PropertyValue Private ReadOnly Property UserAgentXML As PropertyValue
Friend ReadOnly Property UserAgent As String Friend ReadOnly Property UserAgent(Optional ByVal Force As Boolean = False) As String
Get Get
If CBool(UserAgentUse.Value) AndAlso Not CStr(UserAgentXML.Value).IsEmptyString Then If (CBool(UserAgentUse.Value) Or Force) AndAlso Not CStr(UserAgentXML.Value).IsEmptyString Then
Return UserAgentXML.Value Return UserAgentXML.Value
Else Else
Return String.Empty Return String.Empty
@@ -73,6 +74,7 @@ Namespace API.Twitter
#Region "Limits" #Region "Limits"
Friend Const TimerDisabled As Integer = -1 Friend Const TimerDisabled As Integer = -1
Friend Const TimerFirstUseTheSame As Integer = -2 Friend Const TimerFirstUseTheSame As Integer = -2
Friend Const TimerDefault As Integer = 20
<PropertyOption(ControlText:="Abort on limit", ControlToolTip:="Abort twitter downloading when limit is reached", Category:=CAT_DOWN), PXML, PClonable> <PropertyOption(ControlText:="Abort on limit", ControlToolTip:="Abort twitter downloading when limit is reached", Category:=CAT_DOWN), PXML, PClonable>
Friend Property AbortOnLimit As PropertyValue Friend Property AbortOnLimit As PropertyValue
<PropertyOption(ControlText:="Download already parsed", ControlToolTip:="Download already parsed content on abort", Category:=CAT_DOWN), PXML, PClonable> <PropertyOption(ControlText:="Download already parsed", ControlToolTip:="Download already parsed content on abort", Category:=CAT_DOWN), PXML, PClonable>
@@ -143,6 +145,7 @@ Namespace API.Twitter
End Property End Property
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Private Const SettingsVersionCurrent As Integer = 1
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean) Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New(TwitterSite, "x.com", AccName, Temp, My.Resources.SiteResources.TwitterIcon_32, My.Resources.SiteResources.TwitterIcon_32.ToBitmap) MyBase.New(TwitterSite, "x.com", AccName, Temp, My.Resources.SiteResources.TwitterIcon_32, My.Resources.SiteResources.TwitterIcon_32.ToBitmap)
@@ -153,7 +156,7 @@ Namespace API.Twitter
.Cookies.Changed = False .Cookies.Changed = False
End With End With
UseNewIconXML = New PropertyValue(False) UseNewIconXML = New PropertyValue(True)
CookiesUpdate = New PropertyValue(False) CookiesUpdate = New PropertyValue(False)
UserAgentUse = New PropertyValue(True) UserAgentUse = New PropertyValue(True)
@@ -192,6 +195,10 @@ Namespace API.Twitter
UseNetscapeCookies = True UseNetscapeCookies = True
End Sub End Sub
Friend Overrides Sub EndInit() Friend Overrides Sub EndInit()
If Not SettingsVersion.Value = SettingsVersionCurrent Then
UseNewIconXML.Value = True
SettingsVersion.Value = SettingsVersionCurrent
End If
UpdateIcon() UpdateIcon()
MyBase.EndInit() MyBase.EndInit()
End Sub End Sub
@@ -223,7 +230,7 @@ Namespace API.Twitter
End Sub End Sub
Friend Overrides Sub DownloadDone(ByVal What As ISiteSettings.Download) Friend Overrides Sub DownloadDone(ByVal What As ISiteSettings.Download)
If UserNumber > 0 Then If UserNumber > 0 Then
If CBool(CookiesUpdate.Value) Then If CBool(CookiesUpdate.Value) Or CookiesUpdateForce Then
With CookieKeeper.ParseNetscapeText(CookiesNetscapeFile.GetText(EDP.ReturnValue), EDP.ReturnValue) With CookieKeeper.ParseNetscapeText(CookiesNetscapeFile.GetText(EDP.ReturnValue), EDP.ReturnValue)
If .ListExists Then If .ListExists Then
Responser.Cookies.Clear() Responser.Cookies.Clear()
@@ -250,6 +257,7 @@ Namespace API.Twitter
End With End With
End If End If
LIMIT_ABORT = False LIMIT_ABORT = False
CookiesUpdateForce = False
MyBase.DownloadDone(What) MyBase.DownloadDone(What)
End Sub End Sub
#End Region #End Region

View File

@@ -30,6 +30,7 @@ Namespace API.Twitter
Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder" Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder"
Private Const Name_GifsPrefix As String = "GifsPrefix" Private Const Name_GifsPrefix As String = "GifsPrefix"
Private Const Name_IsCommunity As String = "IsCommunity" Private Const Name_IsCommunity As String = "IsCommunity"
Private Const Name_LargeProfile As String = "LargeProfile"
Private Const Name_DownloadModelChanged As String = "DownloadModelChanged" Private Const Name_DownloadModelChanged As String = "DownloadModelChanged"
#End Region #End Region
#Region "Declarations" #Region "Declarations"
@@ -62,6 +63,47 @@ Namespace API.Twitter
Friend Property GifsSpecialFolder As String = String.Empty Friend Property GifsSpecialFolder As String = String.Empty
Friend Property GifsPrefix As String = String.Empty Friend Property GifsPrefix As String = String.Empty
Friend Property IsCommunity As Boolean = False Friend Property IsCommunity As Boolean = False
#Region "LargeProfile"
Friend Property LargeProfile As Boolean = False
Private ReadOnly Property LargeProfileOverride As Boolean
Get
Return LargeProfile And Not FirstDownloadComplete
End Get
End Property
Private ReadOnly Property CookiesUpdate As Boolean
Get
If LargeProfileOverride Then
MySettings.CookiesUpdateForce = True
Return True
Else
Return MySettings.CookiesUpdate.Value
End If
End Get
End Property
Private ReadOnly Property UserAgent As String
Get
If LargeProfileOverride Then
Return MySettings.UserAgent(True).IfNullOrEmpty(Settings.UserAgent)
Else
Return MySettings.UserAgent
End If
End Get
End Property
Private ReadOnly Property SleepTimerBeforeFirst As Integer
Get
Dim v% = MySettings.SleepTimerBeforeFirst.Value
If LargeProfileOverride And v <= 0 And v <> SiteSettings.TimerFirstUseTheSame Then v = SiteSettings.TimerFirstUseTheSame
Return v
End Get
End Property
Private ReadOnly Property SleepTimer As Integer
Get
Dim v% = MySettings.SleepTimer.Value
If LargeProfileOverride And v <= 0 Then v = SiteSettings.TimerDefault
Return v
End Get
End Property
#End Region
Private ReadOnly LikesPosts As List(Of String) Private ReadOnly LikesPosts As List(Of String)
Private ReadOnly PostsKV As List(Of PKV) Private ReadOnly PostsKV As List(Of PKV)
Private ReadOnly _DataNames As List(Of String) Private ReadOnly _DataNames As List(Of String)
@@ -100,6 +142,7 @@ Namespace API.Twitter
DownloadModelForceApply = .DownloadModelForceApply DownloadModelForceApply = .DownloadModelForceApply
MediaModelAllowNonUserTweets = .MediaModelAllowNonUserTweets MediaModelAllowNonUserTweets = .MediaModelAllowNonUserTweets
DownloadBroadcasts = .DownloadBroadcasts DownloadBroadcasts = .DownloadBroadcasts
LargeProfile = .LargeProfile
Dim dModel As DownloadModels = DownloadModel Dim dModel As DownloadModels = DownloadModel
If .DownloadModelMedia Then DownloadModel += DownloadModels.Media If .DownloadModelMedia Then DownloadModel += DownloadModels.Media
If .DownloadModelProfile Or .DownloadBroadcasts Then DownloadModel += DownloadModels.Profile If .DownloadModelProfile Or .DownloadBroadcasts Then DownloadModel += DownloadModels.Profile
@@ -155,6 +198,7 @@ Namespace API.Twitter
StartMD5Checked = .Value(Name_StartMD5Checked).FromXML(Of Boolean)(False) StartMD5Checked = .Value(Name_StartMD5Checked).FromXML(Of Boolean)(False)
MediaModelAllowNonUserTweets = .Value(Name_MediaModelAllowNonUserTweets).FromXML(Of Boolean)(False) MediaModelAllowNonUserTweets = .Value(Name_MediaModelAllowNonUserTweets).FromXML(Of Boolean)(False)
IsCommunity = .Value(Name_IsCommunity).FromXML(Of Boolean)(False) IsCommunity = .Value(Name_IsCommunity).FromXML(Of Boolean)(False)
LargeProfile = .Value(Name_LargeProfile).FromXML(Of Boolean)(False)
Else Else
If Name.Contains("@") And Not IsCommunity Then If Name.Contains("@") And Not IsCommunity Then
IsCommunity = True IsCommunity = True
@@ -180,6 +224,7 @@ Namespace API.Twitter
.Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger) .Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger)
.Add(Name_MediaModelAllowNonUserTweets, MediaModelAllowNonUserTweets.BoolToInteger) .Add(Name_MediaModelAllowNonUserTweets, MediaModelAllowNonUserTweets.BoolToInteger)
.Add(Name_IsCommunity, IsCommunity.BoolToInteger) .Add(Name_IsCommunity, IsCommunity.BoolToInteger)
.Add(Name_LargeProfile, LargeProfile.BoolToInteger)
.Add(Name_TrueName, NameTrue(True)) .Add(Name_TrueName, NameTrue(True))
End If End If
End With End With
@@ -487,10 +532,7 @@ Namespace API.Twitter
Else Else
With j({"data", "user", "result"}) With j({"data", "user", "result"})
If .ListExists Then If .ListExists Then
If ID.IsEmptyString Then If ID.IsEmptyString Then ID = .Value("rest_id")
ID = .Value("rest_id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
With .Item({"legacy"}) With .Item({"legacy"})
If .ListExists Then If .ListExists Then
If .Value("screen_name").StringToLower = NameTrue.ToLower Then If .Value("screen_name").StringToLower = NameTrue.ToLower Then
@@ -618,6 +660,7 @@ nextpIndx:
End If End If
DownloadModelForceApply = False DownloadModelForceApply = False
FirstDownloadComplete = True FirstDownloadComplete = True
LargeProfile = False
Catch jsonNull_ex As JsonDocumentException When jsonNull_ex.State = WebDocumentEventArgs.States.Error Catch jsonNull_ex As JsonDocumentException When jsonNull_ex.State = WebDocumentEventArgs.States.Error
Throw New Plugin.ExitException("No deserialized data found") Throw New Plugin.ExitException("No deserialized data found")
Catch limit_ex As TwitterLimitException Catch limit_ex As TwitterLimitException
@@ -842,8 +885,8 @@ nextpIndx:
End Class End Class
Private ReadOnly Property SleepTimerValue(ByVal First As Boolean) As Integer Private ReadOnly Property SleepTimerValue(ByVal First As Boolean) As Integer
Get Get
Dim fTimer% = If(First, MySettings.SleepTimerBeforeFirst, MySettings.SleepTimer).Value Dim fTimer% = If(First, SleepTimerBeforeFirst, SleepTimer)
If First And fTimer = SiteSettings.TimerFirstUseTheSame Then fTimer = MySettings.SleepTimer.Value If First And fTimer = SiteSettings.TimerFirstUseTheSame Then fTimer = SleepTimer
Return fTimer Return fTimer
End Get End Get
End Property End Property
@@ -1063,10 +1106,10 @@ nextpIndx:
Private Function GdlCreateConf(ByVal Path As SFile) As SFile Private Function GdlCreateConf(ByVal Path As SFile) As SFile
Try Try
Dim conf As SFile = $"{Path.PathWithSeparator}TwitterGdlConfig.conf" Dim conf As SFile = $"{Path.PathWithSeparator}TwitterGdlConfig.conf"
Dim __userAgent$ = MySettings.UserAgent Dim __userAgent$ = UserAgent
If Not __userAgent.IsEmptyString Then __userAgent = $"""user-agent"": ""{__userAgent}""," If Not __userAgent.IsEmptyString Then __userAgent = $"""user-agent"": ""{__userAgent}"","
Dim confText$ = "{""extractor"":{""cookies"": """ & MySettings.CookiesNetscapeFile.ToString.Replace("\", "/") & Dim confText$ = "{""extractor"":{""cookies"": """ & MySettings.CookiesNetscapeFile.ToString.Replace("\", "/") &
$""",""cookies-update"": {IIf(CBool(MySettings.CookiesUpdate.Value), "true", "false")}," & __userAgent & $""",""cookies-update"": {IIf(CookiesUpdate, "true", "false")}," & __userAgent &
"""twitter"":{""tweet-endpoint"": ""detail"",""cards"": false,""conversations"": true,""pinned"": false,""quoted"": false,""replies"": true,""retweets"": true,""strategy"": null,""text-tweets"": false,""twitpic"": false,""unique"": true,""users"": ""timeline"",""videos"": true}}}" """twitter"":{""tweet-endpoint"": ""detail"",""cards"": false,""conversations"": true,""pinned"": false,""quoted"": false,""replies"": true,""retweets"": true,""strategy"": null,""text-tweets"": false,""twitpic"": false,""unique"": true,""users"": ""timeline"",""videos"": true}}}"
If conf.Exists(SFO.Path, True, EDP.ThrowException) Then TextSaver.SaveTextToFile(confText, conf) If conf.Exists(SFO.Path, True, EDP.ThrowException) Then TextSaver.SaveTextToFile(confText, conf)
If Not conf.Exists Then Throw New IO.FileNotFoundException("Can't find Twitter GDL config file", conf) If Not conf.Exists Then Throw New IO.FileNotFoundException("Can't find Twitter GDL config file", conf)

View File

@@ -50,6 +50,7 @@ Namespace API.XVIDEOS
_SubscriptionsAllowed = True _SubscriptionsAllowed = True
UrlPatternUser = "https://xvideos.com/{0}" UrlPatternUser = "https://xvideos.com/{0}"
UserOptionsType = GetType(EditorExchangeOptionsBase_P)
End Sub End Sub
Friend Overrides Sub EndInit() Friend Overrides Sub EndInit()
Domains.PopulateInitialDomains(SiteDomains.Value) Domains.PopulateInitialDomains(SiteDomains.Value)
@@ -152,14 +153,6 @@ Namespace API.XVIDEOS
Return Nothing Return Nothing
End Function End Function
#End Region #End Region
#Region "UserOptions"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions
If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
End Sub
#End Region
#Region "IDisposable Support" #Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _Domains.Dispose() If Not disposedValue And disposing Then _Domains.Dispose()

View File

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

View File

@@ -1,17 +0,0 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.XVIDEOS
Friend Class UserExchangeOptions : Inherits Xhamster.UserExchangeOptions
Friend Sub New()
End Sub
Friend Sub New(ByVal u As UserData)
QueryString = u.QueryString
End Sub
End Class
End Namespace

View File

@@ -51,6 +51,7 @@ Namespace API.Xhamster
UrlPatternUser = "https://xhamster.com/{0}/{1}" UrlPatternUser = "https://xhamster.com/{0}/{1}"
UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption}|{P_Creators})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch) UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption}|{P_Creators})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch)
ImageVideoContains = "xhamster" ImageVideoContains = "xhamster"
UserOptionsType = GetType(UserExchangeOptions)
End Sub End Sub
Friend Overrides Sub EndInit() Friend Overrides Sub EndInit()
Domains.PopulateInitialDomains(SiteDomains.Value) Domains.PopulateInitialDomains(SiteDomains.Value)
@@ -163,14 +164,6 @@ Namespace API.Xhamster
Return Nothing Return Nothing
End Function End Function
#End Region #End Region
#Region "UserOptions"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions
If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
End Sub
#End Region
#Region "IDisposable Support" #Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _Domains.Dispose() If Not disposedValue And disposing Then _Domains.Dispose()

View File

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

View File

@@ -6,16 +6,22 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.Xhamster Namespace API.Xhamster
Friend Class UserExchangeOptions Friend NotInheritable Class UserExchangeOptions : Inherits API.Base.EditorExchangeOptionsBase_P
<PSetting(Address:=SettingAddress.User, Caption:="Query", <PSetting(Address:=SettingAddress.User, Caption:="Get moments")>
ToolTip:="Query string. Don't change this field when creating a user! Change it only for the same request.")> Friend Property GetMoments As Boolean = False
Friend Property QueryString As String
Friend Sub New() Friend Sub New()
MyBase.New
End Sub End Sub
Friend Sub New(ByVal u As UserData) Friend Sub New(ByVal u As IPSite)
QueryString = u.QueryString MyBase.New(DirectCast(u, UserData))
GetMoments = DirectCast(u, UserData).GetMoments
End Sub
Friend Overrides Sub Apply(ByRef u As IPSite)
MyBase.Apply(u)
DirectCast(u, UserData).GetMoments = GetMoments
End Sub End Sub
End Class End Class
End Namespace End Namespace

View File

@@ -187,24 +187,24 @@ Namespace Editors
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
If MyDefs.MyFieldsChecker.AllParamsOK Then If MyDefs.MyFieldsChecker.AllParamsOK Then
With Settings With Settings
Dim a As Func(Of String, Object, Integer) = Dim a As Func(Of String, Integer, Object, Integer) =
Function(t, v) MsgBoxE({$"You are set up higher than default count of along {t} downloading tasks." & vbNewLine & Function(t, vc, v) MsgBoxE({$"You are set up higher than default count of along {t} downloading tasks." & vbNewLine &
$"Default: {SettingsCLS.DefaultMaxDownloadingTasks}" & vbNewLine & $"Default: {vc}" & vbNewLine &
$"Your value: {CInt(v)}" & vbNewLine & $"Your value: {CInt(v)}" & vbNewLine &
"Increasing this value may lead to higher CPU usage." & vbNewLine & "Increasing this value may lead to higher CPU usage." & vbNewLine &
"Do you really want to continue?", "Do you really want to continue?",
"Increasing download tasks"}, "Increasing download tasks"},
vbExclamation,,, {"Confirm", $"Set to default ({SettingsCLS.DefaultMaxDownloadingTasks})", "Cancel"}) vbExclamation,,, {"Confirm", $"Set to default ({vc})", "Cancel"})
If CInt(TXT_MAX_JOBS_USERS.Value) > SettingsCLS.DefaultMaxDownloadingTasks Then If CInt(TXT_MAX_JOBS_USERS.Value) > SettingsCLS.DefaultMaxDownloadingTasks Then
Select Case a.Invoke("users", TXT_MAX_JOBS_USERS.Value) Select Case a.Invoke("users", SettingsCLS.DefaultMaxDownloadingTasks, TXT_MAX_JOBS_USERS.Value)
Case 1 : TXT_MAX_JOBS_USERS.Value = SettingsCLS.DefaultMaxDownloadingTasks Case 1 : TXT_MAX_JOBS_USERS.Value = SettingsCLS.DefaultMaxDownloadingTasks
Case 2 : Exit Sub Case 2 : Exit Sub
End Select End Select
End If End If
If CInt(TXT_MAX_JOBS_CHANNELS.Value) > SettingsCLS.DefaultMaxDownloadingTasks Then If CInt(TXT_MAX_JOBS_CHANNELS.Value) > SettingsCLS.DefaultMaxDownloadingTasks_Channels Then
Select Case a.Invoke("channels", TXT_MAX_JOBS_CHANNELS.Value) Select Case a.Invoke("channels", SettingsCLS.DefaultMaxDownloadingTasks_Channels, TXT_MAX_JOBS_CHANNELS.Value)
Case 1 : TXT_MAX_JOBS_CHANNELS.Value = SettingsCLS.DefaultMaxDownloadingTasks Case 1 : TXT_MAX_JOBS_CHANNELS.Value = SettingsCLS.DefaultMaxDownloadingTasks_Channels
Case 2 : Exit Sub Case 2 : Exit Sub
End Select End Select
End If End If
@@ -407,7 +407,7 @@ Namespace Editors
If Sender.DefaultButton = ADB.Refresh Then TXT_MAX_JOBS_USERS.Value = SettingsCLS.DefaultMaxDownloadingTasks If Sender.DefaultButton = ADB.Refresh Then TXT_MAX_JOBS_USERS.Value = SettingsCLS.DefaultMaxDownloadingTasks
End Sub End Sub
Private Sub TXT_MAX_JOBS_CHANNELS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_MAX_JOBS_CHANNELS.ActionOnButtonClick Private Sub TXT_MAX_JOBS_CHANNELS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_MAX_JOBS_CHANNELS.ActionOnButtonClick
If Sender.DefaultButton = ADB.Refresh Then TXT_MAX_JOBS_CHANNELS.Value = SettingsCLS.DefaultMaxDownloadingTasks If Sender.DefaultButton = ADB.Refresh Then TXT_MAX_JOBS_CHANNELS.Value = SettingsCLS.DefaultMaxDownloadingTasks_Channels
End Sub End Sub
Private Sub ChangePositionControlsEnabling() Handles OPT_FILE_NAME_REPLACE.CheckedChanged, OPT_FILE_NAME_ADD_DATE.CheckedChanged Private Sub ChangePositionControlsEnabling() Handles OPT_FILE_NAME_REPLACE.CheckedChanged, OPT_FILE_NAME_ADD_DATE.CheckedChanged
Dim b As Boolean = OPT_FILE_NAME_ADD_DATE.Checked And OPT_FILE_NAME_ADD_DATE.Enabled Dim b As Boolean = OPT_FILE_NAME_ADD_DATE.Checked And OPT_FILE_NAME_ADD_DATE.Enabled

View File

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

View File

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

View File

@@ -23,6 +23,7 @@ Imports DoubleClickBehavior = SCrawler.DownloadObjects.STDownloader.DoubleClickB
Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
#Region "Constants: defaults" #Region "Constants: defaults"
Friend Const DefaultMaxDownloadingTasks As Integer = 5 Friend Const DefaultMaxDownloadingTasks As Integer = 5
Friend Const DefaultMaxDownloadingTasks_Channels As Integer = 1
Friend Const TaskStackNamePornSite As String = "Porn sites" Friend Const TaskStackNamePornSite As String = "Porn sites"
Friend Const Name_Node_Sites As String = "Sites" Friend Const Name_Node_Sites As String = "Sites"
Private Const SitesValuesSeparator As String = "," Private Const SitesValuesSeparator As String = ","
@@ -194,7 +195,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Private ReadOnly BlackListFile As SFile = $"{SettingsFolderName}\BlackList.txt" Private ReadOnly BlackListFile As SFile = $"{SettingsFolderName}\BlackList.txt"
Private ReadOnly UsersSettingsFile As SFile = $"{SettingsFolderName}\Users.xml" Private ReadOnly UsersSettingsFile As SFile = $"{SettingsFolderName}\Users.xml"
Private ReadOnly Property SettingsVersion As XMLValue(Of Integer) Private ReadOnly Property SettingsVersion As XMLValue(Of Integer)
Private Const SettingsVersionCurrent As Integer = 2 Private Const SettingsVersionCurrent As Integer = 3
Friend ShortcutOpenFeed As New ButtonKey(Keys.F, True) Friend ShortcutOpenFeed As New ButtonKey(Keys.F, True)
Friend ShortcutOpenSearch As New ButtonKey(Keys.F,, True) Friend ShortcutOpenSearch As New ButtonKey(Keys.F,, True)
Private Sub ChangeFeedOpenMode() Private Sub ChangeFeedOpenMode()
@@ -366,9 +367,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
ReparseMissingInTheRoutine = New XMLValue(Of Boolean)("ReparseMissingInTheRoutine", False, MyXML, n) ReparseMissingInTheRoutine = New XMLValue(Of Boolean)("ReparseMissingInTheRoutine", False, MyXML, n)
UseDefaultAccountIfMissing = New XMLValue(Of Boolean)("UseDefaultAccountIfMissing", True, MyXML, n) UseDefaultAccountIfMissing = New XMLValue(Of Boolean)("UseDefaultAccountIfMissing", True, MyXML, n)
AutomationBrushUndownloadedPlansMinutes = New XMLValue(Of Integer)("AutomationBrushUndownloadedPlansMinutes", 10080, MyXML, n) AutomationBrushUndownloadedPlansMinutes = New XMLValue(Of Integer)("AutomationBrushUndownloadedPlansMinutes", 10080, MyXML, n)
DownDetectorEnabled = New XMLValue(Of Boolean)("DownDetectorEnabled", True, MyXML, n) DownDetectorEnabled = New XMLValue(Of Boolean)("DownDetectorEnabled", False, MyXML, n)
'TODELETE: DownDetectorEnabled change
If SettingsVersion.Value < SettingsVersionCurrent Then DownDetectorEnabled.Value = False 'SettingsVersionCurrent = 2
'Downloading: file naming 'Downloading: file naming
n = {"Downloading", "FileName"} n = {"Downloading", "FileName"}
@@ -392,7 +391,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
ChannelsDefaultReadyForDownload = New XMLValue(Of Boolean)("ChannelsDefaultReadyForDownload", False, MyXML, n) ChannelsDefaultReadyForDownload = New XMLValue(Of Boolean)("ChannelsDefaultReadyForDownload", False, MyXML, n)
ChannelsDefaultTemporary = New XMLValue(Of Boolean)("ChannelsDefaultTemporary", True, MyXML, n) ChannelsDefaultTemporary = New XMLValue(Of Boolean)("ChannelsDefaultTemporary", True, MyXML, n)
ChannelsHideExistsUser = New XMLValue(Of Boolean)("HideExistsUser", True, MyXML, n) ChannelsHideExistsUser = New XMLValue(Of Boolean)("HideExistsUser", True, MyXML, n)
ChannelsMaxJobsCount = New XMLValue(Of Integer)("MaxJobsCount", DefaultMaxDownloadingTasks, MyXML, n) ChannelsMaxJobsCount = New XMLValue(Of Integer)("MaxJobsCount", DefaultMaxDownloadingTasks_Channels, MyXML, n)
n = {Name_Node_Sites, "Channels", "Users"} n = {Name_Node_Sites, "Channels", "Users"}
FromChannelDownloadTop = New XMLValue(Of Integer)("FromChannelDownloadTop", 10, MyXML, n) FromChannelDownloadTop = New XMLValue(Of Integer)("FromChannelDownloadTop", 10, MyXML, n)
FromChannelDownloadTopUse = New XMLValue(Of Boolean)("FromChannelDownloadTopUse", False, MyXML, n) FromChannelDownloadTopUse = New XMLValue(Of Boolean)("FromChannelDownloadTopUse", False, MyXML, n)
@@ -497,6 +496,8 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
AdvancedFilter.IsViewFilter = True AdvancedFilter.IsViewFilter = True
Labels.AddRange({AdvancedFilter}.GetGroupsLabels, False) Labels.AddRange({AdvancedFilter}.GetGroupsLabels, False)
'TODELETE: DefaultMaxDownloadingTasks_Channels
If Not SettingsVersion = SettingsVersionCurrent Then ChannelsMaxJobsCount.Value = DefaultMaxDownloadingTasks_Channels 'SettingsVersionCurrent = 3
SettingsVersion.Value = SettingsVersionCurrent SettingsVersion.Value = SettingsVersionCurrent
MyXML.EndUpdate() MyXML.EndUpdate()