Compare commits

..

2 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
30 changed files with 483 additions and 211 deletions

View File

@@ -1,3 +1,36 @@
# 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*

View File

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

View File

@@ -823,7 +823,9 @@ Namespace API.YouTube.Objects
'cmd = $"yt-dlp -f ""{cmd}"""
'cmd = $"yt-dlp -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(subs, " ")
cmd.StringAppend(YouTubeFunctions.GetCookiesCommand(WithCookies, YouTubeCookieNetscapeFile), " ")

View File

@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2025.6.12.0")>
<Assembly: AssemblyFileVersion("2025.6.12.0")>
<Assembly: AssemblyVersion("2025.8.1.0")>
<Assembly: AssemblyFileVersion("2025.8.1.0")>
<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

@@ -2288,6 +2288,7 @@ stxt:
End Function
#End Region
#Region "Errors functions"
''' <summary>ToStringForLog(): Message</summary>
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}")
End Sub

View File

@@ -412,6 +412,7 @@ Namespace API.Instagram
ThrowAny(Token)
HasError = False
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
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
upClaimRequest.Invoke
@@ -1151,12 +1152,30 @@ NextPageBlock:
If TryExtractImage Then
t = 1
abstractDecision = True
If Not SpecialFolder.IsEmptyString AndAlso PutImageVideoFolder Then
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 &= "*"
Dim endsAbs As Boolean
Dim newFolderName$
If PutImageVideoFolder Then
If SpecialFolder.IsEmptyString Then
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
SpecialFolder = newFolderName
ElseIf t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then
If n.Contains(vid) Then
t = 2

View File

@@ -431,7 +431,7 @@ Namespace API.OnlyFans
Result = False
With n("media")
If .ListExists Then
For Each m In .Self
For Each m As EContainer In .Self
postUrl = GetMediaURL(m)
'If IsHL Then
' 'postUrl = m.Value({"files", "source"}, "url")
@@ -440,32 +440,34 @@ Namespace API.OnlyFans
' 'postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
' postUrl = GetMediaURL(m)
'End If
postUrlBase = String.Empty
Select Case m.Value("type")
Case "photo" : t = UTypes.Picture : ext = "jpg"
Case "video"
t = UTypes.Video
ext = "mp4"
If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then
t = UTypes.VideoPre
_AbsMediaIndex += 1
If Not PostUserID.IsEmptyString And IsSingleObjectDownload Then _
postUrlBase = String.Format(SiteSettings.UserPostPattern, PostID, $"u{PostUserID}")
End If
Case Else : t = UTypes.Undefined : ext = String.Empty
End Select
If Not t = UTypes.Undefined And (Not postUrl.IsEmptyString Or t = UTypes.VideoPre) Then
Dim media As New UserMedia(postUrl.IfNullOrEmpty(IIf(t = UTypes.VideoPre, $"{t}{_AbsMediaIndex}", String.Empty)), t) With {
.Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing)),
.SpecialFolder = SpecFolder,
.PostText = PostText,
.PostTextFileSpecialFolder = DownloadTextSpecialFolder
}
If postUrlBase.IsEmptyString And Not IsSingleObjectDownload Then postUrlBase = GetPostUrl(Me, media)
If Not postUrlBase.IsEmptyString Then media.URL_BASE = postUrlBase
media.File.Extension = ext
Result = True
mList.Add(media)
If m.Value("canView").FromXML(Of Boolean)(True) Then
postUrlBase = String.Empty
Select Case m.Value("type")
Case "photo" : t = UTypes.Picture : ext = "jpg"
Case "video", "gif"
t = UTypes.Video
ext = "mp4"
If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then
t = UTypes.VideoPre
_AbsMediaIndex += 1
If Not PostUserID.IsEmptyString And IsSingleObjectDownload Then _
postUrlBase = String.Format(SiteSettings.UserPostPattern, PostID, $"u{PostUserID}")
End If
Case Else : t = UTypes.Undefined : ext = String.Empty
End Select
If Not t = UTypes.Undefined And (Not postUrl.IsEmptyString Or t = UTypes.VideoPre) Then
Dim media As New UserMedia(postUrl.IfNullOrEmpty(IIf(t = UTypes.VideoPre, $"{t}{_AbsMediaIndex}", String.Empty)), t) With {
.Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing)),
.SpecialFolder = SpecFolder,
.PostText = PostText,
.PostTextFileSpecialFolder = DownloadTextSpecialFolder
}
If postUrlBase.IsEmptyString And Not IsSingleObjectDownload Then postUrlBase = GetPostUrl(Me, media)
If Not postUrlBase.IsEmptyString Then media.URL_BASE = postUrlBase
media.File.Extension = ext
Result = True
mList.Add(media)
End If
End If
Next
End If

View File

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

View File

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

View File

@@ -9,26 +9,38 @@
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports System.Reflection
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.Base
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Imports DownDetector = SCrawler.API.Base.DownDetector
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Reddit
<Manifest(RedditSiteKey), SavedPosts, SpecialForm(False), UseDownDetector>
<Manifest(RedditSiteKey), SavedPosts, SeparatedTasks, SpecialForm(False), UseDownDetector>
Friend Class SiteSettings : Inherits SiteSettingsBase : Implements DownDetector.IDownDetector
#Region "Declarations"
#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)>
Friend ReadOnly Property AuthUserName As PropertyValue
<PropertyOption(ControlText:="Password", ControlToolTip:="Your authorization password", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property AuthPassword As PropertyValue
<PropertyOption(ControlText:="Client ID", ControlToolTip:="Your registered app client ID", IsAuth:=True), PXML, PClonable(Clone:=False)>
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)>
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",
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 &
@@ -58,14 +70,59 @@ Namespace API.Reddit
Return {AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString)
End Get
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
#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
<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
<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
<PropertyOption(ControlText:=DN.ConcurrentDownloadsCaption,
ControlToolTip:=DN.ConcurrentDownloadsToolTip, AllowNull:=False), PXML, TaskCounter, PClonable>
Friend ReadOnly Property ConcurrentDownloads As PropertyValue
#End Region
#Region "IDownDetector Support"
Private ReadOnly Property IDownDetector_Value As Integer Implements DownDetector.IDownDetector.Value
@@ -117,6 +174,7 @@ Namespace API.Reddit
UseM3U8 = New PropertyValue(True)
CheckImage = New PropertyValue(False)
CheckImageReturnOrig = New PropertyValue(True)
ConcurrentDownloads = New PropertyValue(1)
MDD = New MyDownDetector(Me)
@@ -124,10 +182,13 @@ Namespace API.Reddit
ImageVideoContains = "reddit.com"
UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/\?&]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
End Sub
Private Const SettingsVersionCurrent As Integer = 2
Private Const SettingsVersionCurrent As Integer = 3
Friend Overrides Sub EndInit()
If CInt(SettingsVersion.Value) < SettingsVersionCurrent Then
SettingsVersion.Value = SettingsVersionCurrent
UseM3U8.Value = True
CheckImage.Value = False
CheckImageReturnOrig.Value = True
BearerTokenUseCurl.Value = False
End If
MyBase.EndInit()
@@ -165,6 +226,7 @@ Namespace API.Reddit
End Sub
End Class
Friend Property SessionInterrupted As Boolean = False
Friend Property RequestCount As Integer = 0
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If What = Download.Main Then
Return Not SessionInterrupted
@@ -180,6 +242,7 @@ Namespace API.Reddit
End Function
Friend Overrides Sub DownloadDone(ByVal What As Download)
SessionInterrupted = False
RequestCount = 0
MDD.Reset()
MyBase.DownloadDone(What)
End Sub
@@ -233,23 +296,6 @@ Namespace API.Reddit
End Sub
#End Region
#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
UpdateRedGifsToken()
If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso CredentialsExists Then

View File

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

View File

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

View File

@@ -36,6 +36,7 @@ Namespace API.RedGifs
#End Region
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not MySettings.UseCookies.Value Then Responser.Cookies.Clear()
DownloadData(1, Token)
End Sub
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.Web.Documents.JSON
Namespace API.ThisVid
Friend Class UserData : Inherits UserDataBase
Friend Class UserData : Inherits UserDataBase : Implements IPSite
#Region "XML names"
Private Const Name_DownloadPublic As String = "DownloadPublic"
Private Const Name_DownloadPrivate As String = "DownloadPrivate"
@@ -51,7 +51,7 @@ Namespace API.ThisVid
Return {SearchRequestLabelName}
End Get
End Property
Friend Property QueryString As String
Friend Property QueryString As String Implements IPSite.QueryString
Get
If SiteMode = SiteModes.User Then
Return String.Empty
@@ -161,15 +161,7 @@ Namespace API.ThisVid
Return New UserExchangeOptions(Me)
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions)
DownloadPublic = .DownloadPublic
DownloadPrivate = .DownloadPrivate
DownloadFavourite = .DownloadFavourite
DifferentFolders = .DifferentFolders
QueryString = .QueryString
End With
End If
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
End Sub
#End Region
#Region "Initializer"

View File

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

View File

@@ -422,7 +422,11 @@ Namespace API.TikTok
End If
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 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}"" "
command &= $"{URL} "
If SupportOutput Then

View File

@@ -50,6 +50,10 @@ Namespace API.Twitter
Caption:="Force apply",
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
<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
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
@@ -76,6 +80,7 @@ Namespace API.Twitter
UseMD5Comparison = u.UseMD5Comparison
RemoveExistingDuplicates = u.RemoveExistingDuplicates
MediaModelAllowNonUserTweets = u.MediaModelAllowNonUserTweets
LargeProfile = u.LargeProfile
If Not TypeOf u Is Mastodon.UserData Then
DownloadModelForceApply = u.DownloadModelForceApply
DownloadBroadcasts = u.DownloadBroadcasts

View File

@@ -38,6 +38,7 @@ Namespace API.Twitter
Private Const CAT_DOWN As String = "Downloading"
#End Region
#Region "Auth"
Friend Property CookiesUpdateForce As Boolean = False
<PropertyOption(ControlText:="Update cookies", ControlToolTip:="Update cookies during requests", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property CookiesUpdate As PropertyValue
<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),
PXML("UserAgent", OnlyForChecked:=True), PClonable>
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
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
Else
Return String.Empty
@@ -73,6 +74,7 @@ Namespace API.Twitter
#Region "Limits"
Friend Const TimerDisabled As Integer = -1
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>
Friend Property AbortOnLimit As PropertyValue
<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 Region
#Region "Initializer"
Private Const SettingsVersionCurrent As Integer = 1
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)
@@ -153,7 +156,7 @@ Namespace API.Twitter
.Cookies.Changed = False
End With
UseNewIconXML = New PropertyValue(False)
UseNewIconXML = New PropertyValue(True)
CookiesUpdate = New PropertyValue(False)
UserAgentUse = New PropertyValue(True)
@@ -192,6 +195,10 @@ Namespace API.Twitter
UseNetscapeCookies = True
End Sub
Friend Overrides Sub EndInit()
If Not SettingsVersion.Value = SettingsVersionCurrent Then
UseNewIconXML.Value = True
SettingsVersion.Value = SettingsVersionCurrent
End If
UpdateIcon()
MyBase.EndInit()
End Sub
@@ -223,7 +230,7 @@ Namespace API.Twitter
End Sub
Friend Overrides Sub DownloadDone(ByVal What As ISiteSettings.Download)
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)
If .ListExists Then
Responser.Cookies.Clear()
@@ -250,6 +257,7 @@ Namespace API.Twitter
End With
End If
LIMIT_ABORT = False
CookiesUpdateForce = False
MyBase.DownloadDone(What)
End Sub
#End Region

View File

@@ -30,6 +30,7 @@ Namespace API.Twitter
Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder"
Private Const Name_GifsPrefix As String = "GifsPrefix"
Private Const Name_IsCommunity As String = "IsCommunity"
Private Const Name_LargeProfile As String = "LargeProfile"
Private Const Name_DownloadModelChanged As String = "DownloadModelChanged"
#End Region
#Region "Declarations"
@@ -62,6 +63,47 @@ Namespace API.Twitter
Friend Property GifsSpecialFolder As String = String.Empty
Friend Property GifsPrefix As String = String.Empty
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 PostsKV As List(Of PKV)
Private ReadOnly _DataNames As List(Of String)
@@ -100,6 +142,7 @@ Namespace API.Twitter
DownloadModelForceApply = .DownloadModelForceApply
MediaModelAllowNonUserTweets = .MediaModelAllowNonUserTweets
DownloadBroadcasts = .DownloadBroadcasts
LargeProfile = .LargeProfile
Dim dModel As DownloadModels = DownloadModel
If .DownloadModelMedia Then DownloadModel += DownloadModels.Media
If .DownloadModelProfile Or .DownloadBroadcasts Then DownloadModel += DownloadModels.Profile
@@ -155,6 +198,7 @@ Namespace API.Twitter
StartMD5Checked = .Value(Name_StartMD5Checked).FromXML(Of Boolean)(False)
MediaModelAllowNonUserTweets = .Value(Name_MediaModelAllowNonUserTweets).FromXML(Of Boolean)(False)
IsCommunity = .Value(Name_IsCommunity).FromXML(Of Boolean)(False)
LargeProfile = .Value(Name_LargeProfile).FromXML(Of Boolean)(False)
Else
If Name.Contains("@") And Not IsCommunity Then
IsCommunity = True
@@ -180,6 +224,7 @@ Namespace API.Twitter
.Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger)
.Add(Name_MediaModelAllowNonUserTweets, MediaModelAllowNonUserTweets.BoolToInteger)
.Add(Name_IsCommunity, IsCommunity.BoolToInteger)
.Add(Name_LargeProfile, LargeProfile.BoolToInteger)
.Add(Name_TrueName, NameTrue(True))
End If
End With
@@ -615,6 +660,7 @@ nextpIndx:
End If
DownloadModelForceApply = False
FirstDownloadComplete = True
LargeProfile = False
Catch jsonNull_ex As JsonDocumentException When jsonNull_ex.State = WebDocumentEventArgs.States.Error
Throw New Plugin.ExitException("No deserialized data found")
Catch limit_ex As TwitterLimitException
@@ -839,8 +885,8 @@ nextpIndx:
End Class
Private ReadOnly Property SleepTimerValue(ByVal First As Boolean) As Integer
Get
Dim fTimer% = If(First, MySettings.SleepTimerBeforeFirst, MySettings.SleepTimer).Value
If First And fTimer = SiteSettings.TimerFirstUseTheSame Then fTimer = MySettings.SleepTimer.Value
Dim fTimer% = If(First, SleepTimerBeforeFirst, SleepTimer)
If First And fTimer = SiteSettings.TimerFirstUseTheSame Then fTimer = SleepTimer
Return fTimer
End Get
End Property
@@ -1060,10 +1106,10 @@ nextpIndx:
Private Function GdlCreateConf(ByVal Path As SFile) As SFile
Try
Dim conf As SFile = $"{Path.PathWithSeparator}TwitterGdlConfig.conf"
Dim __userAgent$ = MySettings.UserAgent
Dim __userAgent$ = UserAgent
If Not __userAgent.IsEmptyString Then __userAgent = $"""user-agent"": ""{__userAgent}"","
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}}}"
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)

View File

@@ -50,6 +50,7 @@ Namespace API.XVIDEOS
_SubscriptionsAllowed = True
UrlPatternUser = "https://xvideos.com/{0}"
UserOptionsType = GetType(EditorExchangeOptionsBase_P)
End Sub
Friend Overrides Sub EndInit()
Domains.PopulateInitialDomains(SiteDomains.Value)
@@ -152,14 +153,6 @@ Namespace API.XVIDEOS
Return Nothing
End Function
#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"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
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 UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.XVIDEOS
Friend Class UserData : Inherits UserDataBase
Friend Class UserData : Inherits UserDataBase : Implements IPSite
#Region "XML names"
Private Const Name_PersonType As String = "PersonType"
#End Region
@@ -62,7 +62,7 @@ Namespace API.XVIDEOS
Return {SearchRequestLabelName}
End Get
End Property
Friend Property QueryString As String
Friend Property QueryString As String Implements IPSite.QueryString
Get
If SiteMode = SiteModes.User Then
Return String.Empty
@@ -82,10 +82,10 @@ Namespace API.XVIDEOS
#End Region
#Region "Load"
Friend Overrides Function ExchangeOptionsGet() As Object
Return New UserExchangeOptions(Me)
Return New EditorExchangeOptionsBase_P(Me)
End Function
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
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

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

View File

@@ -6,16 +6,22 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes
Namespace API.Xhamster
Friend Class UserExchangeOptions
<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
Friend NotInheritable Class UserExchangeOptions : Inherits API.Base.EditorExchangeOptionsBase_P
<PSetting(Address:=SettingAddress.User, Caption:="Get moments")>
Friend Property GetMoments As Boolean = False
Friend Sub New()
MyBase.New
End Sub
Friend Sub New(ByVal u As UserData)
QueryString = u.QueryString
Friend Sub New(ByVal u As IPSite)
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 Class
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
If MyDefs.MyFieldsChecker.AllParamsOK Then
With Settings
Dim a As Func(Of String, Object, Integer) =
Function(t, v) MsgBoxE({$"You are set up higher than default count of along {t} downloading tasks." & vbNewLine &
$"Default: {SettingsCLS.DefaultMaxDownloadingTasks}" & vbNewLine &
$"Your value: {CInt(v)}" & vbNewLine &
"Increasing this value may lead to higher CPU usage." & vbNewLine &
"Do you really want to continue?",
"Increasing download tasks"},
vbExclamation,,, {"Confirm", $"Set to default ({SettingsCLS.DefaultMaxDownloadingTasks})", "Cancel"})
Dim a As Func(Of String, Integer, Object, Integer) =
Function(t, vc, v) MsgBoxE({$"You are set up higher than default count of along {t} downloading tasks." & vbNewLine &
$"Default: {vc}" & vbNewLine &
$"Your value: {CInt(v)}" & vbNewLine &
"Increasing this value may lead to higher CPU usage." & vbNewLine &
"Do you really want to continue?",
"Increasing download tasks"},
vbExclamation,,, {"Confirm", $"Set to default ({vc})", "Cancel"})
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 2 : Exit Sub
End Select
End If
If CInt(TXT_MAX_JOBS_CHANNELS.Value) > SettingsCLS.DefaultMaxDownloadingTasks Then
Select Case a.Invoke("channels", TXT_MAX_JOBS_CHANNELS.Value)
Case 1 : TXT_MAX_JOBS_CHANNELS.Value = SettingsCLS.DefaultMaxDownloadingTasks
If CInt(TXT_MAX_JOBS_CHANNELS.Value) > SettingsCLS.DefaultMaxDownloadingTasks_Channels Then
Select Case a.Invoke("channels", SettingsCLS.DefaultMaxDownloadingTasks_Channels, TXT_MAX_JOBS_CHANNELS.Value)
Case 1 : TXT_MAX_JOBS_CHANNELS.Value = SettingsCLS.DefaultMaxDownloadingTasks_Channels
Case 2 : Exit Sub
End Select
End If
@@ -407,7 +407,7 @@ Namespace Editors
If Sender.DefaultButton = ADB.Refresh Then TXT_MAX_JOBS_USERS.Value = SettingsCLS.DefaultMaxDownloadingTasks
End Sub
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
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

View File

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

View File

@@ -169,6 +169,7 @@
<Compile Include="API\Base\DeclaredNames.vb" />
<Compile Include="API\Base\DownDetector.vb" />
<Compile Include="API\Base\EditorExchangeOptionsBase.vb" />
<Compile Include="API\Base\EditorExchangeOptionsBase_P.vb" />
<Compile Include="API\Base\GDL.vb" />
<Compile Include="API\Base\IUserData.vb" />
<Compile Include="API\Base\M3U8Base.vb" />
@@ -268,7 +269,6 @@
<Compile Include="API\XVIDEOS\M3U8.vb" />
<Compile Include="API\XVIDEOS\SiteSettings.vb" />
<Compile Include="API\XVIDEOS\UserData.vb" />
<Compile Include="API\XVIDEOS\UserExchangeOptions.vb" />
<Compile Include="API\YouTube\SiteSettings.vb" />
<Compile Include="API\YouTube\UserData.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
#Region "Constants: defaults"
Friend Const DefaultMaxDownloadingTasks As Integer = 5
Friend Const DefaultMaxDownloadingTasks_Channels As Integer = 1
Friend Const TaskStackNamePornSite As String = "Porn sites"
Friend Const Name_Node_Sites As String = "Sites"
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 UsersSettingsFile As SFile = $"{SettingsFolderName}\Users.xml"
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 ShortcutOpenSearch As New ButtonKey(Keys.F,, True)
Private Sub ChangeFeedOpenMode()
@@ -366,9 +367,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
ReparseMissingInTheRoutine = New XMLValue(Of Boolean)("ReparseMissingInTheRoutine", False, MyXML, n)
UseDefaultAccountIfMissing = New XMLValue(Of Boolean)("UseDefaultAccountIfMissing", True, MyXML, n)
AutomationBrushUndownloadedPlansMinutes = New XMLValue(Of Integer)("AutomationBrushUndownloadedPlansMinutes", 10080, MyXML, n)
DownDetectorEnabled = New XMLValue(Of Boolean)("DownDetectorEnabled", True, MyXML, n)
'TODELETE: DownDetectorEnabled change
If SettingsVersion.Value < SettingsVersionCurrent Then DownDetectorEnabled.Value = False 'SettingsVersionCurrent = 2
DownDetectorEnabled = New XMLValue(Of Boolean)("DownDetectorEnabled", False, MyXML, n)
'Downloading: file naming
n = {"Downloading", "FileName"}
@@ -392,7 +391,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
ChannelsDefaultReadyForDownload = New XMLValue(Of Boolean)("ChannelsDefaultReadyForDownload", False, MyXML, n)
ChannelsDefaultTemporary = New XMLValue(Of Boolean)("ChannelsDefaultTemporary", 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"}
FromChannelDownloadTop = New XMLValue(Of Integer)("FromChannelDownloadTop", 10, MyXML, n)
FromChannelDownloadTopUse = New XMLValue(Of Boolean)("FromChannelDownloadTopUse", False, MyXML, n)
@@ -497,6 +496,8 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
AdvancedFilter.IsViewFilter = True
Labels.AddRange({AdvancedFilter}.GetGroupsLabels, False)
'TODELETE: DefaultMaxDownloadingTasks_Channels
If Not SettingsVersion = SettingsVersionCurrent Then ChannelsMaxJobsCount.Value = DefaultMaxDownloadingTasks_Channels 'SettingsVersionCurrent = 3
SettingsVersion.Value = SettingsVersionCurrent
MyXML.EndUpdate()