diff --git a/Changelog.md b/Changelog.md index 348f5d9..49a8afb 100644 --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,28 @@ +# 2025.1.12.0 + +*2025-01-12* + +- Added + - Sites: + - YouTube (standalone app): + - ability to add channel name to file name (`Add channel to file name`) + - adding channel name and video URL to info file + - OnlyFans: **built-in usage of DRM keys** + - Threads: automatically change `heic` extension to `jpg` + - Twitter: download broadcasts *(user option)* + - Minor improvements +- Updated + - yt-dlp up to version **2024.12.23** + - gallery-dl up to version **1.28.3** + - **OF-Scraper** up to version **3.12.9** *(you must update it personally)* +- Fixed + - Sites: + - DownDetector: fixed 403 error + - OnlyFans: **DRM videos not downloading** + - xHamster: some videos are not downloading + - YouTube: **communities are not downloading** *(see settings in wiki)* + - Minor bugs + # 2024.11.21.0 *2024-11-21* diff --git a/FAQ.md b/FAQ.md index 5a9d053..601c5db 100644 --- a/FAQ.md +++ b/FAQ.md @@ -55,7 +55,7 @@ I strongly recommend you to **regularly** create backup copies of the settings f - [Video how to configure](#video-how-to-configure) - **Antivirus** - **Antivirus detects SCrawler as a virus** :arrow_forward: SCrawler doesn't contain any viruses at all. All code is posted on GitHub. You can review it. I have nothing to hide. SCrawler just downloads pictures and videos. That's all. If you trust SCrawler, you should just add it to the antivirus exceptions, as I did. Sometimes antiviruses identify SCawler as a virus. This is usually related to the number of files being edited (users' settings files) and the number of files being downloaded. In this case, the antivirus can also remove these files, which will damage users' settings. **If you don't trust SCrawler, just delete it.** - - **Antivirus detects gallery-dl as a virus** :arrow_forward: it's a trustworthy program that is trusted by thousands of people around the world. Antiviruses identify some builds as containing viruses, but this is not true. **If you don't trust gallery-dl, you can simply delete it**. **But if you delete it, you won't be able to download [Twitter & Pinterest](https://github.com/AAndyProgram/SCrawler/wiki/Settings#gallery-dl).** You should decide for yourself. + - **Antivirus detects gallery-dl as a virus** :arrow_forward: it's a trustworthy program that is trusted by thousands of people around the world. Antiviruses identify some builds as containing viruses, but this is not true. **If you don't trust gallery-dl, you can simply delete it. But if you delete it, you won't be able to download [Twitter & Pinterest](https://github.com/AAndyProgram/SCrawler/wiki/Settings#gallery-dl).** You should decide for yourself. ## Sites questions @@ -67,7 +67,7 @@ I strongly recommend you to **regularly** create backup copies of the settings f - TikTok: works via yt-dlp. If something doesn't download, we need to wait until yt-dlp fixes it. TikTok doesn't require cookies to download. - Porn sites: **COOKIES**! - ThisVid: https://github.com/AAndyProgram/SCrawler/wiki/Settings#thisvid-faq -- **OnlyFans**: cookies + **all fields** + [OF-Scraper (download the correct version that I pointed)](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper) & [mp4decrypt](https://www.bento4.com/downloads/) to download DRM protected videos. [OF-Scraper support](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper-support). Also read [this](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans-faq) +- **OnlyFans**: cookies + **all fields** + [OF-Scraper (download the correct version that I pointed)](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper) & [mp4decrypt](https://www.bento4.com/downloads/) & **DRM keys** to download DRM protected videos. [OF-Scraper support](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper-support). Also read [this](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans-faq) - **JustForFans**: **THE VIDEO ISN'T DOWNLOADING AT THE MOMENT** ([Issue](https://discord.com/channels/1124032649682493462/1205547615199039551/1231349555132366870)) ## Other questions diff --git a/SCrawler.YouTube/Base/YouTubeSettings.vb b/SCrawler.YouTube/Base/YouTubeSettings.vb index ca38164..ac676d5 100644 --- a/SCrawler.YouTube/Base/YouTubeSettings.vb +++ b/SCrawler.YouTube/Base/YouTubeSettings.vb @@ -191,7 +191,7 @@ Namespace API.YouTube.Base Public ReadOnly Property DefaultUseCookies As XMLValue(Of Boolean) - Public ReadOnly Property DefaultProtocol As XMLValue(Of Protocols) Public ReadOnly Property FileAddDateToFileName_VideoList As XMLValue(Of Boolean) + + Public ReadOnly Property FileAddChannelToFileName As XMLValue(Of FileDateMode) #End Region #Region "Defaults ChannelsDownload" - + @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices ' by using the '*' as shown below: ' - - + + diff --git a/SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb b/SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb index e805ac7..f4a4b8f 100644 --- a/SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb +++ b/SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb @@ -685,10 +685,17 @@ Namespace API.YouTube.Objects Friend Sub FileDateUpdate() Dim n$ = _File.Name.StringTrim Dim s$ = IIf(n.IsEmptyString, String.Empty, " ") + Dim c$ = AccountName.IfNullOrEmpty(UserID) Select Case MyYouTubeSettings.FileAddDateToFileName.Value Case FileDateMode.Before : n = $"[{DateAdded:yyyy-MM-dd}]{s}{n}" Case FileDateMode.After : n = $"{n}{s}[{DateAdded:yyyy-MM-dd}]" End Select + If Not c.IsEmptyString Then + Select Case MyYouTubeSettings.FileAddChannelToFileName.Value + Case FileDateMode.Before : n = $"[{c}] {n}" + Case FileDateMode.After : n = $"{n} [{c}]" + End Select + End If _File.Name = n End Sub Public Property FileSettings As SFile @@ -1214,6 +1221,9 @@ Namespace API.YouTube.Objects fileDesr.Extension = "txt" Using fileDesrText As New TextSaver(fileDesr) If .CreateDescriptionFiles_AddUploadDate Then fileDesrText.Append($"Uploaded: {DateAdded:yyyy-MM-dd HH:mm:ss}") + fileDesrText.AppendLine($"URL: {URL}") + fileDesrText.AppendLine($"Channel name: {AccountName}") + fileDesrText.AppendLine($"Channel ID: {UserID}") If Not Description.IsEmptyString Then If Not fileDesrText.IsEmptyString Then fileDesrText.AppendLine.AppendLine() fileDesrText.Append(Description) diff --git a/SCrawler.YouTubeDownloader/My Project/AssemblyInfo.vb b/SCrawler.YouTubeDownloader/My Project/AssemblyInfo.vb index 708032d..bbc8c74 100644 --- a/SCrawler.YouTubeDownloader/My Project/AssemblyInfo.vb +++ b/SCrawler.YouTubeDownloader/My Project/AssemblyInfo.vb @@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices - + @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices ' by using the '*' as shown below: ' - - + + diff --git a/SCrawler/API/Base/DownDetector.vb b/SCrawler/API/Base/DownDetector.vb index e766a28..f2bd5c6 100644 --- a/SCrawler/API/Base/DownDetector.vb +++ b/SCrawler/API/Base/DownDetector.vb @@ -6,8 +6,9 @@ ' ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY -Imports System.Net +Imports SCrawler.Plugin Imports PersonalUtilities.Functions.RegularExpressions +Imports Download = SCrawler.Plugin.ISiteSettings.Download Namespace API.Base Friend NotInheritable Class DownDetector Private Shared ReadOnly Property Params As New RParams("x:.'([\S]+?)',.y:.(\d+)", -1, Nothing, RegexReturn.List) @@ -34,34 +35,106 @@ Namespace API.Base Try Dim l As List(Of Data) = Nothing Dim l2 As List(Of Data) = Nothing - Using w As New WebClient - Dim r$ = w.DownloadString($"https://downdetector.co.uk/status/{Site}/") - If Not r.IsEmptyString Then - l = RegexFields(Of Data)(r, {Params}, {1, 2}) - If l.ListExists(2) Then - l.Sort() - l2 = New List(Of Data) - Dim d As Data - Dim eDates As New List(Of Date) - Dim MaxValue As Func(Of Date, Integer) = Function(dd) (From ddd In l Where ddd.Date = dd Select ddd.Value).DefaultIfEmpty(0).Max - For i% = 0 To l.Count - 1 - If Not eDates.Contains(l(i).Date) Then - d = l(i) - d.Value = MaxValue(d.Date) - l2.Add(d) - eDates.Add(d.Date) - End If - Next - eDates.Clear() - l.Clear() - l2.Sort() - End If + Dim r$ = GetWebString($"https://downdetector.co.uk/status/{Site}/",, EDP.ThrowException) + If Not r.IsEmptyString Then + l = RegexFields(Of Data)(r, {Params}, {1, 2}) + If l.ListExists(2) Then + l.Sort() + l2 = New List(Of Data) + Dim d As Data + Dim eDates As New List(Of Date) + Dim MaxValue As Func(Of Date, Integer) = Function(dd) (From ddd As Data In l Where ddd.Date = dd Select ddd.Value).DefaultIfEmpty(0).Max + For i% = 0 To l.Count - 1 + If Not eDates.Contains(l(i).Date) Then + d = l(i) + d.Value = MaxValue(d.Date) + l2.Add(d) + eDates.Add(d.Date) + End If + Next + eDates.Clear() + l.Clear() + l2.Sort() End If - End Using + End If Return l2 Catch ex As Exception Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"[DownDetector.GetData({Site})]") End Try End Function + Friend Interface IDownDetector + ReadOnly Property Value As Integer + ReadOnly Property AddToLog As Boolean + ReadOnly Property CheckSite As String + Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean + End Interface + Friend Class Checker(Of T As {ISiteSettings, IDownDetector}) + Protected ReadOnly Property Source As T + Private ReadOnly NP As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral} + Friend Sub New(ByRef _Source As T) + Source = _Source + End Sub + Private ____AvailableChecked As Boolean = False + Private ____AvailableResult As Boolean = False + Friend Overridable Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean + If Settings.DownDetectorEnabled And Source.Value >= 0 Then + If Not ____AvailableChecked Then + ____AvailableResult = AvailableImpl(What, Silent) + ____AvailableChecked = True + End If + Return ____AvailableResult + Else + Return True + End If + End Function + Protected Overridable Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean + Try + Source.AvailableText = String.Empty + If Source.Value < 0 Then + Return True + Else + Dim dl As List(Of Data) = GetData(Source.CheckSite) + If dl.ListExists Then + dl = dl.Take(4).ToList + Dim avg% = dl.Average(Function(d) d.Value) + If avg > Source.Value Then + Source.AvailableText = $"Over the past hour, {Source.Site} has received an average of {avg.NumToString(NP)} outage reports:{vbCr}{dl.ListToString(vbCr)}" + If Source.AddToLog Then MyMainLOG = Source.AvailableText + If Silent Then + Return AvailableImpl_FALSE_SILENT() + Else + If MsgBoxE({$"{Source.AvailableText}{vbCr}{vbCr}Do you want to continue parsing {Source.Site} data?", + $"There are outage reports on {Source.Site}"}, vbYesNo) = vbYes Then + Return AvailableImpl_FALSE_SILENT_NOT_MSG_YES() + Else + Return AvailableImpl_FALSE_SILENT_NOT_MSG_NO() + End If + End If + End If + End If + Return AvailableImpl_TRUE() + End If + Catch ex As Exception + Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"[API.{Source.Site}.SiteSettings.Available([DownDetector])]", True) + End Try + End Function + Protected Overridable Function AvailableImpl_TRUE() As Boolean + Return True + End Function + Protected Overridable Function AvailableImpl_FALSE_SILENT() As Boolean + Return False + End Function + Protected Overridable Function AvailableImpl_FALSE_SILENT_NOT_MSG_YES() As Boolean + Return True + End Function + Protected Overridable Function AvailableImpl_FALSE_SILENT_NOT_MSG_NO() As Boolean + Return False + End Function + Friend Overridable Sub Reset() + ____AvailableChecked = False + ____AvailableResult = False + Source.AvailableText = String.Empty + End Sub + End Class End Class End Namespace \ No newline at end of file diff --git a/SCrawler/API/Instagram/SiteSettings.vb b/SCrawler/API/Instagram/SiteSettings.vb index bb920e9..7167104 100644 --- a/SCrawler/API/Instagram/SiteSettings.vb +++ b/SCrawler/API/Instagram/SiteSettings.vb @@ -16,8 +16,8 @@ Imports PersonalUtilities.Tools.Web.Cookies Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports DN = SCrawler.API.Base.DeclaredNames Namespace API.Instagram - - Friend Class SiteSettings : Inherits SiteSettingsBase + + Friend Class SiteSettings : Inherits SiteSettingsBase : Implements DownDetector.IDownDetector #Region "Declarations" #Region "Providers" Friend Class TimersChecker : Inherits FieldsCheckerProviderBase @@ -270,6 +270,26 @@ Namespace API.Instagram Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider #End Region #End Region +#Region "IDownDetector Support" + Private ReadOnly Property IDownDetector_Value As Integer Implements DownDetector.IDownDetector.Value + Get + Return DownDetectorValue.Value + End Get + End Property + Private ReadOnly Property IDownDetector_AddToLog As Boolean Implements DownDetector.IDownDetector.AddToLog + Get + Return DownDetectorValueAddToLog.Value + End Get + End Property + Private ReadOnly Property IDownDetector_CheckSite As String Implements DownDetector.IDownDetector.CheckSite + Get + Return "instagram" + End Get + End Property + Private Function IDownDetector_Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean Implements DownDetector.IDownDetector.Available + Return MDD.Available(What, Silent) + End Function +#End Region #Region "429 bypass" Private ReadOnly Property DownloadingErrorDate As PropertyValue @@ -504,6 +524,8 @@ Namespace API.Instagram LastRequestsCountLabel = New PropertyValue(String.Empty, GetType(String)) MyLastRequests = New Dictionary(Of Date, Integer) + MDD = New DownDetector.Checker(Of SiteSettings)(Me) + _AllowUserAgentUpdate = False UrlPatternUser = "https://www.instagram.com/{0}/" UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "instagram.com/"), 1) @@ -551,18 +573,10 @@ Namespace API.Instagram End Function #End Region #Region "Downloading" - Private ____DownloadStarted As Boolean = False - Private ____AvailableRequested As Boolean = False - Private ____AvailableSilent As Boolean = True - Private ____AvailableChecked As Boolean = False - Private ____AvailableResult As Boolean = False + Private ReadOnly MDD As DownDetector.Checker(Of SiteSettings) Private Sub ResetDownloadOptions() If ActiveJobs < 1 Then - ____DownloadStarted = False - ____AvailableRequested = False - ____AvailableChecked = False - ____AvailableSilent = True - ____AvailableResult = False + MDD.Reset() If ActiveSessionRequestsExists Then RefreshMyLastRequests(Now) ActiveSessionRequestsExists = False _NextWNM = UserData.WNM.Notify @@ -573,69 +587,11 @@ Namespace API.Instagram End If End Sub Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean - If MyBase.Available(What, Silent) And ActiveJobs < 2 Then - If CInt(DownDetectorValue.Value) >= 0 Then - If ____DownloadStarted Then - ____AvailableRequested = True - ____AvailableSilent = Silent - Return True - Else - Return AvailableImpl(What, Silent) - End If - Else - Return True - End If - Else - Return False - End If - End Function -#Disable Warning IDE0060 - Private Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean -#Enable Warning - Try - AvailableText = String.Empty - If CInt(DownDetectorValue.Value) = -1 Then - Return True - Else - Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("instagram") - If dl.ListExists Then - dl = dl.Take(4).ToList - Dim avg% = dl.Average(Function(d) d.Value) - If avg > CInt(DownDetectorValue.Value) Then - AvailableText = "Over the past hour, Instagram has received an average of " & - avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr & - dl.ListToString(vbCr) - If CBool(DownDetectorValueAddToLog.Value) Then MyMainLOG = AvailableText - If Silent Then - Return False - Else - Return MsgBoxE({$"{AvailableText}{vbCr}{vbCr}Do you want to continue parsing Instagram data?", - "There are outage reports on Instagram"}, vbYesNo) = vbYes - End If - End If - End If - Return True - End If - Catch ex As Exception - Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[API.Instagram.SiteSettings.Available]", True) - End Try + Return MyBase.Available(What, Silent) And ActiveJobs < 2 End Function Friend Property SkipUntilNextSession As Boolean = False Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean - If ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso CBool(DownloadTimeline.Value) Then - If ____DownloadStarted And ____AvailableRequested Then - ____AvailableResult = AvailableImpl(What, ____AvailableSilent) - ____AvailableChecked = True - ____AvailableRequested = False - Return ____AvailableResult - ElseIf ____AvailableChecked Then - Return ____AvailableResult - Else - Return True - End If - Else - Return False - End If + Return ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso CBool(DownloadTimeline.Value) End Function Private ActiveJobs As Integer = 0 Private ActiveSessionDate As Date @@ -645,7 +601,7 @@ Namespace API.Instagram Friend Overrides Sub DownloadStarted(ByVal What As Download) ResetDownloadOptions() ActiveJobs += 1 - If ActiveJobs = 1 Then ____DownloadStarted = True : ActiveSessionDate = Now + If ActiveJobs = 1 Then ActiveSessionDate = Now If Not HH_IG_WWW_CLAIM_IS_ZERO AndAlso ( (CBool(HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO.Value) AndAlso MyLastRequestsDate.AddMinutes(HH_IG_WWW_CLAIM_UPDATE_INTERVAL.Value) < Now) Or diff --git a/SCrawler/API/Instagram/UserData.vb b/SCrawler/API/Instagram/UserData.vb index d9d8323..8ec70cd 100644 --- a/SCrawler/API/Instagram/UserData.vb +++ b/SCrawler/API/Instagram/UserData.vb @@ -42,7 +42,7 @@ Namespace API.Instagram Private Const Name_ForceUpdateUserInfo As String = "ForceUpdateUserInfo" #End Region #Region "Declarations" - Protected Structure PostKV : Implements IEContainerProvider + Friend Structure PostKV : Implements IEContainerProvider Private Const Name_Code As String = "Code" Private Const Name_Section As String = "Section" Friend Code As String @@ -252,25 +252,28 @@ Namespace API.Instagram End If End Get End Property - Protected Sub LoadSavePostsKV(ByVal Load As Boolean) + Friend Overloads Shared Sub LoadSavePostsKV(ByVal Load As Boolean, ByVal fPosts As SFile, ByRef List As List(Of PostKV)) Dim x As XmlFile - Dim f As SFile = MyFilePostsKV + Dim f As SFile = fPosts If Not f.IsEmptyString Then If Load Then - PostsKVIDs.Clear() + List.Clear() x = New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True} x.LoadData() - If x.Count > 0 Then PostsKVIDs.ListAddList(x, LAP.IgnoreICopier) + If x.Count > 0 Then List.ListAddList(x, LAP.IgnoreICopier) x.Dispose() Else x = New XmlFile With {.AllowSameNames = True} - x.AddRange(PostsKVIDs) + x.AddRange(List) x.Name = "Posts" x.Save(f, EDP.SendToLog) x.Dispose() End If End If End Sub + Protected Overloads Sub LoadSavePostsKV(ByVal Load As Boolean) + LoadSavePostsKV(Load, MyFilePostsKV, PostsKVIDs) + End Sub Protected Overloads Function PostKvExists(ByVal pkv As PostKV) As Boolean Return PostKvExists(pkv.ID, False, pkv.Section) OrElse PostKvExists(pkv.Code, True, pkv.Section) End Function @@ -476,7 +479,7 @@ Namespace API.Instagram If Not errorFound Then LoadSavePostsKV(False) End Try End Sub - Private Sub ValidateExtension() + Protected Sub ValidateExtension() Try Const heic$ = "heic" If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = heic) Then @@ -503,7 +506,7 @@ Namespace API.Instagram Protected Overrides Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse) Declarations.UpdateResponser(e, Responser, WwwClaimUpdate) End Sub - Protected Enum Sections : Timeline : Reels : Tagged : Stories : UserStories : SavedPosts : End Enum + Friend Enum Sections : Timeline : Reels : Tagged : Stories : UserStories : SavedPosts : End Enum Protected Const StoriesFolder As String = "Stories" Private Const TaggedFolder As String = "Tagged" #Region "429 bypass" diff --git a/SCrawler/API/Mastodon/EditorExchangeOptions.vb b/SCrawler/API/Mastodon/EditorExchangeOptions.vb index c5fbf01..2398d33 100644 --- a/SCrawler/API/Mastodon/EditorExchangeOptions.vb +++ b/SCrawler/API/Mastodon/EditorExchangeOptions.vb @@ -15,6 +15,7 @@ Namespace API.Mastodon Friend Overrides Property DownloadModelSearch As Boolean Friend Overrides Property DownloadModelForceApply As Boolean Friend Overrides Property DownloadModelLikes As Boolean + Friend Overrides Property DownloadBroadcasts As Boolean Friend Overrides Property UserName As String Friend Sub New(ByVal s As SiteSettings) MyBase.New(s) diff --git a/SCrawler/API/OnlyFans/SiteSettings.vb b/SCrawler/API/OnlyFans/SiteSettings.vb index d26d37b..43a29cd 100644 --- a/SCrawler/API/OnlyFans/SiteSettings.vb +++ b/SCrawler/API/OnlyFans/SiteSettings.vb @@ -73,6 +73,10 @@ Namespace API.OnlyFans End If Return String.Empty End Function + + Friend ReadOnly Property EnableCookiesUpdate As PropertyValue #End Region #Region "Errors" Private ReadOnly Property UpdateRules401_XML As PropertyValue @@ -112,7 +116,7 @@ Namespace API.OnlyFans End Property Friend Const KeyModeDefault_Default As String = "cdrm" Private ReadOnly Property KeyModeDefault_XML As PropertyValue - + Friend ReadOnly Property KeyModeDefault As PropertyValue Get If Not DefaultInstance Is Nothing Then @@ -133,6 +137,62 @@ Namespace API.OnlyFans End If End Get End Property + Private ReadOnly Property OFS_KEYS_Key_XML As PropertyValue + + Friend ReadOnly Property OFS_KEYS_Key As PropertyValue + Get + If Not DefaultInstance Is Nothing Then + Return DirectCast(DefaultInstance, SiteSettings).OFS_KEYS_Key_XML + Else + Return OFS_KEYS_Key_XML + End If + End Get + End Property + Private ReadOnly Property OFS_KEYS_ClientID_XML As PropertyValue + + Friend ReadOnly Property OFS_KEYS_ClientID As PropertyValue + Get + If Not DefaultInstance Is Nothing Then + Return DirectCast(DefaultInstance, SiteSettings).OFS_KEYS_ClientID_XML + Else + Return OFS_KEYS_ClientID_XML + End If + End Get + End Property + + Private Function OFS_KEYS_CHECKER(ByVal p As IEnumerable(Of PropertyData)) As Boolean + Const manualMode$ = "manual" + If p.ListExists Then + Dim m$ = String.Empty, k$ = String.Empty, cid$ = String.Empty + For Each pp As PropertyData In p + Select Case pp.Name + Case NameOf(KeyModeDefault) : m = pp.Value + Case NameOf(OFS_KEYS_Key) : k = pp.Value + Case NameOf(OFS_KEYS_ClientID) : cid = pp.Value + Case Else : Throw New ArgumentException($"Property name '{pp.Name}' is not implemented", "Property Name") + End Select + Next + If k.IsEmptyString And cid.IsEmptyString Then + Return True + ElseIf Not k.IsEmptyString And Not cid.IsEmptyString Then + If m = manualMode Then + Return True + Else + Return MsgBoxE({$"You are using key files and have selected '{m}' mode." & vbCr & + $"To use key files, you should use the '{manualMode}' mode" & vbCr & + "Are you sure you want to use this mode?", "Incorrect mode"}, vbExclamation + vbYesNo) = vbYes + End If + End If + Dim t As New MMessage("", "Key missing",, vbCritical) + If k.IsEmptyString Then + t.Text = "'Private key' is missing" + ElseIf cid.IsEmptyString Then + t.Text = "'Client ID' is missing" + End If + If Not t.Text.IsEmptyString Then t.Show() + End If + Return False + End Function #End Region #End Region #Region "Initializer" @@ -171,6 +231,8 @@ Namespace API.OnlyFans UserAgent = New PropertyValue(IIf(.UserAgentExists, .UserAgent, String.Empty), GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v)) End With + EnableCookiesUpdate = New PropertyValue(True) + DownloadTimeline = New PropertyValue(True) DownloadStories = New PropertyValue(True) DownloadHighlights = New PropertyValue(True) @@ -191,6 +253,8 @@ Namespace API.OnlyFans OFScraperMP4decrypt_XML = New PropertyValue(String.Empty, GetType(String)) KeyModeDefault_XML = New PropertyValue(KeyModeDefault_Default) Keydb_Api_XML = New PropertyValue(String.Empty, GetType(String)) + OFS_KEYS_Key_XML = New PropertyValue(String.Empty, GetType(String)) + OFS_KEYS_ClientID_XML = New PropertyValue(String.Empty, GetType(String)) UpdateRules401_XML = New PropertyValue(False) diff --git a/SCrawler/API/OnlyFans/UserData.vb b/SCrawler/API/OnlyFans/UserData.vb index cbcd09b..75e81c7 100644 --- a/SCrawler/API/OnlyFans/UserData.vb +++ b/SCrawler/API/OnlyFans/UserData.vb @@ -99,7 +99,7 @@ Namespace API.OnlyFans If Not CCookie Is Nothing Then CCookie.Dispose() CCookie = Responser.Cookies.Copy Responser.Cookies.Clear() - AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived + If MySettings.EnableCookiesUpdate.Value Then AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived UpdateCookieHeader() If Not IsSavedPosts Then @@ -119,7 +119,7 @@ Namespace API.OnlyFans End Try End Sub Protected Overrides Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As WebDataResponse) - If e.CookiesExists Then + If e.CookiesExists And CBool(MySettings.EnableCookiesUpdate.Value) Then CCookie.Update(e.Cookies, CookieKeeper.UpdateModes.ReplaceByNameAll,, EDP.ReturnValue) UpdateCookieHeader() End If @@ -612,7 +612,7 @@ Namespace API.OnlyFans '#If DEBUG Then 'Debug.WriteLine(command) '#End If - Using b As New TokenBatch(Token) : b.Execute(command) : End Using + Using b As New TokenBatch(Token) With {.DebugMode = False} : b.Execute(command) : End Using Return SFile.GetFiles(conf, "*.mp4", IO.SearchOption.AllDirectories, EDP.ReturnValue) End If Return Nothing @@ -623,7 +623,13 @@ Namespace API.OnlyFans Private Function OFS_CreateConfig() As SFile Try Const confMainPattern$ = "{0}"": ""([^""]*)""" + Const confMainPattern_Keys$ = "{0}"": ([^,]*)" Const confMainPatternRulesManual$ = "DYNAMIC_RULE"": (""[^""]*"")" + + Const m1 As Byte = 0 'not rules + Const m2 As Byte = 1 'rules + Const m3 As Byte = 2 'keys + If OFSCache Is Nothing Then OFSCache = If(IsSingleObjectDownload, Settings.Cache.NewInstance, CreateCache()) Dim currentCache As CacheKeeper = OFSCache.NewInstance currentCache.Validate() @@ -637,35 +643,47 @@ Namespace API.OnlyFans CType(Function(input) replaceValue, Func(Of String, String)), String.Empty, EDP.ReturnValue) Dim ff As SFile configText = f.GetText - Dim updateConf As Action(Of String, String, Boolean) = - Sub(ByVal patternValue As String, ByVal __replaceValue As String, ByVal __isRules As Boolean) - rp.Pattern = String.Format(IIf(__isRules, confMainPatternRulesManual, confMainPattern), patternValue) + Dim updateConf As Action(Of String, String, Byte) = + Sub(ByVal patternValue As String, ByVal __replaceValue As String, ByVal mode As Byte) + Select Case mode + Case m1 : rp.Pattern = String.Format(confMainPattern, patternValue) + Case m2 : rp.Pattern = String.Format(confMainPatternRulesManual, patternValue) + Case m3 : rp.Pattern = String.Format(confMainPattern_Keys, patternValue) : __replaceValue = $"""{__replaceValue}""" + Case Else : Throw New ArgumentException($"Mode '{mode}' is not implemented", "mode") + End Select rp.Nothing = configText replaceValue = __replaceValue configText = RegexReplace(configText, rp) End Sub If Not configText.IsEmptyString Then - updateConf("save_location", cacheRoot.PathNoSeparator.Replace("\", "/"), False) + updateConf("save_location", cacheRoot.PathNoSeparator.Replace("\", "/"), m1) If ACheck(MySettings.OFScraperMP4decrypt.Value) Then ff = CStr(MySettings.OFScraperMP4decrypt.Value) - If ff.Exists Then updateConf("mp4decrypt", ff.ToString.Replace("\", "/"), False) + If ff.Exists Then updateConf("mp4decrypt", ff.ToString.Replace("\", "/"), m1) End If - If Settings.FfmpegFile.Exists Then updateConf("ffmpeg", Settings.FfmpegFile.File.ToString.Replace("\", "/"), False) - updateConf("key-mode-default", CStr(MySettings.KeyModeDefault.Value).IfNullOrEmpty(SiteSettings.KeyModeDefault_Default), False) - updateConf("keydb_api", CStr(MySettings.Keydb_Api.Value), False) + If Settings.FfmpegFile.Exists Then updateConf("ffmpeg", Settings.FfmpegFile.File.ToString.Replace("\", "/"), m1) + + updateConf("key-mode-default", CStr(MySettings.KeyModeDefault.Value).IfNullOrEmpty(SiteSettings.KeyModeDefault_Default), m1) + updateConf("keydb_api", CStr(MySettings.Keydb_Api.Value), m1) + + If Not CStr(MySettings.OFS_KEYS_Key.Value).IsEmptyString And Not CStr(MySettings.OFS_KEYS_ClientID.Value).IsEmptyString Then + updateConf("private-key", CStr(MySettings.OFS_KEYS_Key.Value).Replace("\", "/"), m3) + updateConf("client-id", CStr(MySettings.OFS_KEYS_ClientID.Value).Replace("\", "/"), m3) + End If + If Rules.RulesReplaceConfig Then If Rules.RulesConfigManualMode Then - updateConf(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName, "manual", False) + updateConf(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName, "manual", m1) configText = configText.Replace(DynamicRulesEnv.DynamicRulesConfigNodeName_URL, DynamicRulesEnv.DynamicRulesConfigNodeName_RULES) - updateConf(DynamicRulesEnv.DynamicRulesConfigNodeName_RULES, Rules.CurrentContainerRulesText, True) + updateConf(DynamicRulesEnv.DynamicRulesConfigNodeName_RULES, Rules.CurrentContainerRulesText, m2) Else Dim confUrlNode$ = If(Rules.RulesConstants.ContainsKey(DynamicRulesEnv.DynamicRulesConfigNodeName_URL_CONST_NAME), Rules.RulesConstants(DynamicRulesEnv.DynamicRulesConfigNodeName_URL_CONST_NAME), DynamicRulesEnv.DynamicRulesConfigNodeName_URL) - updateConf(DynamicRulesEnv.DynamicRulesConfigNodeName_URL, Rules.CurrentRule.UrlRaw, False) + updateConf(DynamicRulesEnv.DynamicRulesConfigNodeName_URL, Rules.CurrentRule.UrlRaw, m1) configText = configText.Replace(DynamicRulesEnv.DynamicRulesConfigNodeName_URL, confUrlNode) If Rules.RulesConstants.ContainsKey(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName) Then _ - updateConf(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName, Rules.RulesConstants(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName), False) + updateConf(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName, Rules.RulesConstants(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName), m1) End If End If f = currentCache diff --git a/SCrawler/API/Pinterest/Declarations.vb b/SCrawler/API/Pinterest/Declarations.vb index faf2bc9..70d61e9 100644 --- a/SCrawler/API/Pinterest/Declarations.vb +++ b/SCrawler/API/Pinterest/Declarations.vb @@ -7,9 +7,11 @@ ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY Imports System.Globalization +Imports PersonalUtilities.Tools.Web.Clients Namespace API.Pinterest Friend Module Declarations Friend ReadOnly DateProvider As ADateTime = GetDateProvider() + Friend ReadOnly PwsHeader As New HttpHeader("x-pinterest-pws-handler", "www/[username]/pins.js") Private Function GetDateProvider() As ADateTime Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone n.FullDateTimePattern = "ddd dd MMM yyyy HH:mm:ss" diff --git a/SCrawler/API/Pinterest/UserData.vb b/SCrawler/API/Pinterest/UserData.vb index 0e64c1e..047aecd 100644 --- a/SCrawler/API/Pinterest/UserData.vb +++ b/SCrawler/API/Pinterest/UserData.vb @@ -186,6 +186,7 @@ Namespace API.Pinterest Dim l As List(Of String) = GetDataFromGalleryDL(Board.URL, False, Token) If l.ListExists Then l.RemoveAll(Function(ll) Not ll.Contains("BoardFeedResource/get/")) If l.ListExists Then + Responser.Headers.Add(PwsHeader) ProgressPre.ChangeMax(l.Count) For Each bUrl In l ProgressPre.Perform() @@ -252,6 +253,8 @@ Namespace API.Pinterest End If Catch ex As Exception ProcessException(ex, Token, $"data (gallery-dl images) downloading error [{bUrl}]") + Finally + Responser.Headers.Remove(PwsHeader) End Try End Sub #End Region diff --git a/SCrawler/API/Reddit/SiteSettings.vb b/SCrawler/API/Reddit/SiteSettings.vb index c8d7bfb..9f520e0 100644 --- a/SCrawler/API/Reddit/SiteSettings.vb +++ b/SCrawler/API/Reddit/SiteSettings.vb @@ -17,8 +17,8 @@ Imports PersonalUtilities.Functions.RegularExpressions Imports DownDetector = SCrawler.API.Base.DownDetector Imports Download = SCrawler.Plugin.ISiteSettings.Download Namespace API.Reddit - - Friend Class SiteSettings : Inherits SiteSettingsBase + + Friend Class SiteSettings : Inherits SiteSettingsBase : Implements DownDetector.IDownDetector #Region "Declarations" #Region "Authorization" @@ -67,6 +67,26 @@ Namespace API.Reddit Friend ReadOnly Property CheckImageReturnOrig As PropertyValue #End Region +#Region "IDownDetector Support" + Private ReadOnly Property IDownDetector_Value As Integer Implements DownDetector.IDownDetector.Value + Get + Return 100 + End Get + End Property + Private ReadOnly Property IDownDetector_AddToLog As Boolean Implements DownDetector.IDownDetector.AddToLog + Get + Return False + End Get + End Property + Private ReadOnly Property IDownDetector_CheckSite As String Implements DownDetector.IDownDetector.CheckSite + Get + Return "reddit" + End Get + End Property + Private Function IDownDetector_Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean Implements DownDetector.IDownDetector.Available + Return MDD.Available(What, Silent) + End Function +#End Region #End Region #Region "Initializer" Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean) @@ -97,6 +117,8 @@ Namespace API.Reddit CheckImage = New PropertyValue(False) CheckImageReturnOrig = New PropertyValue(True) + MDD = New MyDownDetector(Me) + UrlPatternUser = "https://www.reddit.com/{0}/{1}/" ImageVideoContains = "reddit.com" UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/\?&]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue) @@ -116,81 +138,48 @@ Namespace API.Reddit End Function #End Region #Region "DownloadStarted, ReadyToDownload, Available, DownloadDone, UpdateRedGifsToken" - Private ____DownloadStarted As Boolean = False - Friend Overrides Sub DownloadStarted(ByVal What As Download) - If What = Download.Main Then ____DownloadStarted = True - MyBase.DownloadStarted(What) - End Sub + Private ReadOnly MDD As MyDownDetector + Private Class MyDownDetector : Inherits DownDetector.Checker(Of SiteSettings) + Private __TrueValue As Boolean = False + Friend Sub New(ByRef _Source As SiteSettings) + MyBase.New(_Source) + End Sub + Protected Overrides Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean + __TrueValue = Source.AvailableTrueValue(What) + Return MyBase.AvailableImpl(What, Silent) + End Function + Protected Overrides Function AvailableImpl_TRUE() As Boolean + Return AvailableImpl_TrueValueReturn() + End Function + Protected Overrides Function AvailableImpl_FALSE_SILENT_NOT_MSG_YES() As Boolean + Return AvailableImpl_TrueValueReturn() + End Function + Private Function AvailableImpl_TrueValueReturn() As Boolean + If __TrueValue Then Source.UpdateRedGifsToken() + Return __TrueValue AndAlso Source.UpdateTokenIfRequired() + End Function + Friend Overrides Sub Reset() + __TrueValue = False + MyBase.Reset() + End Sub + End Class Friend Property SessionInterrupted As Boolean = False Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean If What = Download.Main Then - Dim result As Boolean = Not SessionInterrupted - If result Then - If ____DownloadStarted And ____AvailableRequested Then - ____AvailableResult = AvailableImpl(What, ____AvailableSilent) - ____AvailableChecked = True - ____AvailableRequested = False - result = ____AvailableResult - ElseIf ____AvailableChecked Then - result = ____AvailableResult - End If - End If - Return result + Return Not SessionInterrupted Else Return True End If End Function - Private ____AvailableRequested As Boolean = False - Private ____AvailableSilent As Boolean = True - Private ____AvailableChecked As Boolean = False - Private ____AvailableResult As Boolean = False Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean - If What = Download.Main And ____DownloadStarted Then - ____AvailableRequested = True - ____AvailableSilent = Silent - Return True - Else - Return AvailableImpl(What, Silent) - End If + Return AvailableTrueValue(What) End Function - Private Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean - Try - AvailableText = String.Empty - Dim trueValue As Boolean = Not What = Download.SavedPosts OrElse (Responser.CookiesExists And ACheck(SavedPostsUserName.Value)) - If Not trueValue Then Return False - Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("reddit") - If dl.ListExists Then - dl = dl.Take(4).ToList - Dim avg% = dl.Average(Function(d) d.Value) - If avg > 100 Then - AvailableText = "Over the past hour, Reddit has received an average of " & - avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr & - dl.ListToString(vbCr) - If Silent Then - Return False - Else - If MsgBoxE({$"{AvailableText}{vbCr}{vbCr}Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes Then - If trueValue Then UpdateRedGifsToken() - Return trueValue AndAlso UpdateTokenIfRequired() - Else - Return False - End If - End If - End If - End If - If trueValue Then UpdateRedGifsToken() - Return trueValue AndAlso UpdateTokenIfRequired() - Catch ex As Exception - Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True) - End Try + Private Function AvailableTrueValue(ByVal What As Download) As Boolean + Return Not What = Download.SavedPosts OrElse (Responser.CookiesExists And ACheck(SavedPostsUserName.Value)) End Function Friend Overrides Sub DownloadDone(ByVal What As Download) SessionInterrupted = False - ____DownloadStarted = False - ____AvailableRequested = False - ____AvailableChecked = False - ____AvailableSilent = True - ____AvailableResult = False + MDD.Reset() MyBase.DownloadDone(What) End Sub Private Sub UpdateRedGifsToken() diff --git a/SCrawler/API/ThisVid/UserData.vb b/SCrawler/API/ThisVid/UserData.vb index 5afa933..33f5bb7 100644 --- a/SCrawler/API/ThisVid/UserData.vb +++ b/SCrawler/API/ThisVid/UserData.vb @@ -473,35 +473,47 @@ Namespace API.ThisVid Dim u As UserMedia Dim n$, r$ Dim c% = 0 + Dim ii As Byte + Dim repeat As Boolean Progress.Maximum += _TempMediaList.Count For i% = _TempMediaList.Count - 1 To 0 Step -1 Progress.Perform() u = _TempMediaList(i) If u.Type = UserMedia.Types.VideoPre Then If Not DownloadTopCount.HasValue OrElse c <= DownloadTopCount.Value Then - ThrowAny(Token) - r = Responser.GetResponse(u.URL,, EDP.ReturnValue) - If Not r.IsEmptyString Then - n = TitleHtmlConverter(RegexReplace(r, RegExVideoTitle)) - u.Post.ID = u.URL - If Not n.IsEmptyString Then n = n.Replace("ThisVid.com", String.Empty).StringTrim.StringTrimEnd("-").StringTrim - If n.IsEmptyString Then n = TitleHtmlConverter(u.URL.Replace("https://thisvid.com/videos/", String.Empty).StringTrim.StringTrimEnd("-").StringTrim) - If n.IsEmptyString Then n = "VideoFile" - u.File = $"{n}.mp4" - u.PictureOption = n - u.URL = RegexReplace(r, Regex_VideosThumb_OG_IMAGE) - If u.URL.IsEmptyString Then u.URL = RegexReplace(r, RegExVideosThumb1) - If u.URL.IsEmptyString Then u.URL = RegexReplace(r, RegExVideosThumb2) - If Not u.URL.IsEmptyString Then - u.URL = LinkFormatterSecure(u.URL) - u.Type = UserMedia.Types.Video - _TempPostsList.Add(u.Post.ID) - _TempMediaList(i) = u - c += 1 - Else - _TempMediaList.RemoveAt(i) + repeat = False + For ii = 0 To 1 + ThrowAny(Token) + r = Responser.GetResponse(u.URL,, EDP.ReturnValue) + If Not r.IsEmptyString Then + n = TitleHtmlConverter(RegexReplace(r, RegExVideoTitle)) + u.Post.ID = u.URL + If Not n.IsEmptyString Then n = n.Replace("ThisVid.com", String.Empty).StringTrim.StringTrimEnd("-").StringTrim + If n.IsEmptyString Then n = TitleHtmlConverter(u.URL.Replace("https://thisvid.com/videos/", String.Empty).StringTrim.StringTrimEnd("-").StringTrim) + If n.IsEmptyString Then n = "VideoFile" + u.File = $"{n}.mp4" + u.PictureOption = n + u.URL = RegexReplace(r, Regex_VideosThumb_OG_IMAGE) + If u.URL.IsEmptyString And Not repeat And ii = 0 Then + Thread.Sleep(250) + u = _TempMediaList(i) + repeat = True + Continue For + End If + If u.URL.IsEmptyString Then u.URL = RegexReplace(r, RegExVideosThumb1) + If u.URL.IsEmptyString Then u.URL = RegexReplace(r, RegExVideosThumb2) + If Not u.URL.IsEmptyString Then + u.URL = LinkFormatterSecure(u.URL) + u.Type = UserMedia.Types.Video + _TempPostsList.Add(u.Post.ID) + _TempMediaList(i) = u + c += 1 + Else + _TempMediaList.RemoveAt(i) + End If End If - End If + If Not repeat Then Exit For + Next Else _TempMediaList.RemoveAt(i) End If diff --git a/SCrawler/API/ThreadsNet/UserData.vb b/SCrawler/API/ThreadsNet/UserData.vb index 0accb93..b95a31d 100644 --- a/SCrawler/API/ThreadsNet/UserData.vb +++ b/SCrawler/API/ThreadsNet/UserData.vb @@ -115,6 +115,7 @@ Namespace API.ThreadsNet Responser.Method = "POST" UpdateResponser() MySettings.UpdateResponserData(Responser) + ValidateExtension() If Not errorFound Then LoadSavePostsKV(False) End Try End If diff --git a/SCrawler/API/Twitter/Declarations.vb b/SCrawler/API/Twitter/Declarations.vb index 46d4de1..ddc6458 100644 --- a/SCrawler/API/Twitter/Declarations.vb +++ b/SCrawler/API/Twitter/Declarations.vb @@ -16,6 +16,7 @@ Namespace API.Twitter Friend ReadOnly DateProvider As ADateTime = GetDateProvider() Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue) Friend ReadOnly StatusRegEx As RParams = RParams.DM(".*?(twitter|x)\.com/\S+/status/\d+", 0, EDP.ReturnValue) + Friend ReadOnly BroadcastsUrls As Object() = {"entities", "urls", 0, "expanded_url"} Private Function GetDateProvider() As ADateTime Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone n.FullDateTimePattern = "ddd MMM dd HH:mm:ss +ffff yyyy" diff --git a/SCrawler/API/Twitter/EditorExchangeOptions.vb b/SCrawler/API/Twitter/EditorExchangeOptions.vb index 1109160..0141ade 100644 --- a/SCrawler/API/Twitter/EditorExchangeOptions.vb +++ b/SCrawler/API/Twitter/EditorExchangeOptions.vb @@ -43,6 +43,10 @@ Namespace API.Twitter Caption:="Download model 'Likes'", ToolTip:="Download the data using the 'https://x.com/UserName/likes' command.", LeftOffset:=DefaultOffset)> Friend Overridable Property DownloadModelLikes As Boolean = False + + Friend Overridable Property DownloadBroadcasts As Boolean = False @@ -75,6 +79,7 @@ Namespace API.Twitter MediaModelAllowNonUserTweets = u.MediaModelAllowNonUserTweets If Not TypeOf u Is Mastodon.UserData Then DownloadModelForceApply = u.DownloadModelForceApply + DownloadBroadcasts = u.DownloadBroadcasts Dim dm As DModels() = EnumExtract(Of DModels)(u.DownloadModel) If dm.ListExists Then DownloadModelMedia = dm.Contains(DModels.Media) diff --git a/SCrawler/API/Twitter/SiteSettings.vb b/SCrawler/API/Twitter/SiteSettings.vb index 1b06d23..c47abcf 100644 --- a/SCrawler/API/Twitter/SiteSettings.vb +++ b/SCrawler/API/Twitter/SiteSettings.vb @@ -162,6 +162,13 @@ Namespace API.Twitter Return Nothing End If End Function + Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions + If Not URL.IsEmptyString AndAlso (URL.Contains("twitter") Or URL.Contains("x.com")) Then + Return New ExchangeOptions(Site, String.Empty) With {.Exists = True} + Else + Return Nothing + End If + End Function Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String Return DirectCast(User, UserData).GetUserUrl End Function diff --git a/SCrawler/API/Twitter/UserData.vb b/SCrawler/API/Twitter/UserData.vb index e73ce52..2a0d83b 100644 --- a/SCrawler/API/Twitter/UserData.vb +++ b/SCrawler/API/Twitter/UserData.vb @@ -7,6 +7,7 @@ ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY Imports System.Threading +Imports System.Text.RegularExpressions Imports SCrawler.API.Base Imports SCrawler.API.YouTube.Objects Imports PersonalUtilities.Functions.XML @@ -16,6 +17,7 @@ Imports PersonalUtilities.Tools.Web.Documents Imports PersonalUtilities.Tools.Web.Documents.JSON Imports UStates = SCrawler.API.Base.UserMedia.States Imports UTypes = SCrawler.API.Base.UserMedia.Types +Imports PKV = SCrawler.API.Instagram.UserData.PostKV Namespace API.Twitter Friend Class UserData : Inherits UserDataBase #Region "XML names" @@ -23,12 +25,15 @@ Namespace API.Twitter Private Const Name_DownloadModel As String = "DownloadModel" Private Const Name_DownloadModelForceApply As String = "DownloadModelForceApply" Private Const Name_MediaModelAllowNonUserTweets As String = "MediaModelAllowNonUserTweets" + Private Const Name_DownloadBroadcasts As String = "DownloadBroadcasts" Private Const Name_GifsDownload As String = "GifsDownload" Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder" Private Const Name_GifsPrefix As String = "GifsPrefix" Private Const Name_IsCommunity As String = "IsCommunity" + Private Const Name_DownloadModelChanged As String = "DownloadModelChanged" #End Region #Region "Declarations" + Private Const BroadCastPartUrl As String = "i/broadcasts" Private Const Label_Community As String = "Community" Private _NameTrue As String = String.Empty Friend Property NameTrue(Optional ByVal Exact As Boolean = False) As String @@ -54,12 +59,20 @@ Namespace API.Twitter Private FirstDownloadComplete As Boolean = False Friend Property DownloadModelForceApply As Boolean = False Friend Property DownloadModel As DownloadModels = DownloadModels.Undefined + Private ReadOnly Property IsMultiMode As Boolean + Get + Return EnumExtract(Of DownloadModels)(DownloadModel).ListIfNothing.Count > 1 + End Get + End Property + Private Property DownloadModelChanged As Boolean = False Friend Property MediaModelAllowNonUserTweets As Boolean = False + Friend Property DownloadBroadcasts As Boolean = False Friend Property GifsDownload As Boolean = True Friend Property GifsSpecialFolder As String = String.Empty Friend Property GifsPrefix As String = String.Empty Friend Property IsCommunity As Boolean = False Private ReadOnly LikesPosts As List(Of String) + Private ReadOnly PostsKV As List(Of PKV) Private ReadOnly _DataNames As List(Of String) Private ReadOnly Property MySettings As SiteSettings Get @@ -94,10 +107,13 @@ Namespace API.Twitter DownloadModel = DownloadModels.Undefined DownloadModelForceApply = .DownloadModelForceApply MediaModelAllowNonUserTweets = .MediaModelAllowNonUserTweets + DownloadBroadcasts = .DownloadBroadcasts + Dim dModel As DownloadModels = DownloadModel If .DownloadModelMedia Then DownloadModel += DownloadModels.Media - If .DownloadModelProfile Then DownloadModel += DownloadModels.Profile + If .DownloadModelProfile Or .DownloadBroadcasts Then DownloadModel += DownloadModels.Profile If .DownloadModelSearch Then DownloadModel += DownloadModels.Search If .DownloadModelLikes Then DownloadModel += DownloadModels.Likes + If Not dModel = DownloadModel Then DownloadModelChanged = True _NameTrue = .UserName End With End If @@ -107,11 +123,15 @@ Namespace API.Twitter Friend Sub New() _DataNames = New List(Of String) LikesPosts = New List(Of String) + PostsKV = New List(Of PKV) + UseInternalM3U8Function = True End Sub Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) With Container If Loading Then + DownloadBroadcasts = .Value(Name_DownloadBroadcasts).FromXML(Of Boolean)(False) DownloadModelForceApply = .Value(Name_DownloadModelForceApply).FromXML(Of Boolean)(False) + DownloadModelChanged = .Value(Name_DownloadModelChanged).FromXML(Of Boolean)(False) If .Contains(Name_FirstDownloadComplete) Then FirstDownloadComplete = .Value(Name_FirstDownloadComplete).FromXML(Of Boolean)(False) DownloadModel = .Value(Name_DownloadModel).FromXML(Of Integer)(DownloadModels.Undefined) @@ -159,7 +179,9 @@ Namespace API.Twitter End If .Add(Name_FirstDownloadComplete, FirstDownloadComplete.BoolToInteger) .Add(Name_DownloadModelForceApply, DownloadModelForceApply.BoolToInteger) + .Add(Name_DownloadModelChanged, DownloadModelChanged.BoolToInteger) .Add(Name_DownloadModel, CInt(DownloadModel)) + .Add(Name_DownloadBroadcasts, DownloadBroadcasts.BoolToInteger) .Add(Name_GifsDownload, GifsDownload.BoolToInteger) .Add(Name_GifsSpecialFolder, GifsSpecialFolder) .Add(Name_GifsPrefix, GifsPrefix) @@ -182,6 +204,68 @@ Namespace API.Twitter {{"item", "itemContent", "tweet_results", "result", "tweet", "legacy"}} } End Function + Private Function ExtractBroadcast(ByVal e As EContainer, Optional ByVal PostID As String = Nothing, Optional ByVal PostDate As String = Nothing, + Optional ByVal Nodes As List(Of String()) = Nothing, + Optional ByVal IgnoreNodes As Boolean = False) As UserMedia + If e.ListExists Then + Dim __nodes As List(Of String()) = If(Nodes, GetContainerSubnodes()) + Dim urlValue$ + Dim m As UserMedia = Nothing + Dim __parseContainer As Func(Of EContainer, Boolean) = + Function(ByVal ee As EContainer) As Boolean + With ee + If .ListExists Then + urlValue = .ItemF(BroadcastsUrls, EDP.ReturnValue).XmlIfNothingValue + If Not urlValue.IsEmptyString AndAlso urlValue.Contains(BroadCastPartUrl) Then + m = MediaFromData(urlValue, PostID, PostDate,,, UTypes.m3u8) + If Not IsSingleObjectDownload Then m.SpecialFolder = "Broadcasts*" + Return True + End If + End If + End With + Return False + End Function + If IgnoreNodes Then + If __parseContainer(e) Then Return m + Else + For Each n As String() In __nodes + If __parseContainer(e(n)) Then Return m + Next + End If + m = ExtractBroadcast(e.ItemF(Of Object)({0}), PostID, PostDate, Nodes) + If Not m.URL.IsEmptyString Then Return m + End If + Return Nothing + End Function + Private ReadOnly Property MyFilePostsKV As SFile + Get + Dim f As SFile = MyFilePosts + If Not f.IsEmptyString Then + f.Name &= "_KV" + f.Extension = "xml" + Return f + Else + Return Nothing + End If + End Get + End Property + Protected Sub LoadSavePostsKV(ByVal Load As Boolean) + Instagram.UserData.LoadSavePostsKV(Load, MyFilePostsKV, PostsKV) + End Sub + Private Function PostKVExists(ByVal PID As String, ByVal Model As DownloadModels, + ByVal MultiMode As Boolean, ByVal IgnorePKV As Boolean, ByVal AutoAdd As Boolean) As Boolean + Dim result As Boolean + If IgnorePKV Or PostsKV.Count = 0 Then + result = _TempPostsList.Contains(PID) + Else + result = PostsKV.Contains(New PKV(PID, PID, Model)) Or (Not MultiMode AndAlso _TempPostsList.Contains(PID)) + End If + If Not result And AutoAdd Then + PostsKV.ListAddValue(New PKV(PID, PID, Model), LNC) + _TempPostsList.ListAddValue(PID, LNC) + End If + Return result + End Function Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Try If MySettings.LIMIT_ABORT Then @@ -191,9 +275,17 @@ Namespace API.Twitter If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.Post.ID), LAP.ClearBeforeAdd, LAP.NotContainsOnly) DownloadData_SavedPosts(Token) Else + LoadSavePostsKV(True) + If PostsKV.Count = 0 And (_ContentList.Count > 0 Or _TempPostsList.Count > 0) Then + Dim m As DownloadModels = IIf(IsMultiMode, DownloadModels.Media, DownloadModel) + PostsKV.ListAddList(_TempPostsList.Select(Function(p) New PKV(p, p, m)), LNC) + PostsKV.ListAddList(_ContentList.Select(Function(p) New PKV(p.Post.ID, p.Post.ID, m)), LNC) + _ForceSaveUserData = True + End If LikesPosts.Clear() If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly) DownloadData_Timeline(Token) + LoadSavePostsKV(False) If LikesPosts.Count > 0 Then _ReparseLikes = True ReparseMissing(Token) @@ -228,6 +320,8 @@ Namespace API.Twitter Dim indxChanged As Boolean = False Dim isOneNode As Boolean, isPins As Boolean, ExistsDetected As Boolean, userInfoParsed As Boolean = False Dim j As EContainer, rootNode As EContainer, optionalNode As EContainer, workingNode As EContainer, tmpNode As EContainer, nn As EContainer = Nothing + Dim multiMode As Boolean = IsMultiMode + Dim currentModel As DownloadModels = DownloadModels.Undefined Dim __parseContainer As Func(Of EContainer, Boolean) = Function(ByVal ee As EContainer) As Boolean @@ -250,14 +344,13 @@ Namespace API.Twitter Case DateResult.Skip, DateResult.Exit : Return False End Select - If Not _TempPostsList.Contains(PostID) Then - _TempPostsList.Add(PostID) + If Not PostKVExists(PostID, currentModel, multiMode, False, True) Then ElseIf dirIndx = 3 Then ElseIf isPins Then Return False Else - ExistsDetected = True - Return False + ExistsDetected = Not multiMode + Return multiMode End If tmpUserId = nn({"retweeted_status_result", "result", "legacy", "user_id_str"}).XmlIfNothingValue @@ -268,12 +361,21 @@ Namespace API.Twitter If (Not ParseUserMediaOnly Or dirIndx = 3) OrElse (dirIndx = 0 AndAlso MediaModelAllowNonUserTweets) OrElse (Not ID.IsEmptyString AndAlso tmpUserId = ID) Then + If dirIndx = 1 And DownloadBroadcasts Then + Dim m As UserMedia = ExtractBroadcast(nn, PostID, PostDate, nodes) + If Not m.URL.IsEmptyString Then + _TempMediaList.ListAddValue(m, LNC) + Else + m = ExtractBroadcast(ee, PostID, PostDate, nodes) + If Not m.URL.IsEmptyString Then _TempMediaList.ListAddValue(m, LNC) + End If + End If If dirIndx = 3 Then Dim lUrl$ = nn.ItemF({"content", "itemContent", "tweet_results", "result", "legacy", "entities", "media", 0}, "expanded_url").XmlIfNothingValue If Not lUrl.IsEmptyString Then lUrl = RegexReplace(lUrl, StatusRegEx) If Not lUrl.IsEmptyString Then - If Not _TempPostsList.Contains(lUrl) Then _TempPostsList.Add(lUrl) Else Return False + If PostKVExists(lUrl, currentModel, multiMode, False, True) Then Return multiMode LikesPosts.ListAddValue(lUrl, LNC) End If End If @@ -287,11 +389,23 @@ Namespace API.Twitter tCache = CreateCache() + '0 - media + '1 - profile + '2 - search + '3 - likes Dim dirs As List(Of SFile) = GetTimelineFromGalleryDL(tCache, Token) If dirs.ListExists Then For Each dir As SFile In dirs dirIndx += 1 + Select Case dirIndx + Case 0 : currentModel = DownloadModels.Media + Case 1 : currentModel = DownloadModels.Profile + Case 2 : currentModel = DownloadModels.Search + Case 3 : currentModel = DownloadModels.Likes + Case Else : currentModel = DownloadModels.Undefined + End Select + If dirIndx = 3 Then likesDetected = True ExistsDetected = False @@ -431,7 +545,7 @@ Namespace API.Twitter ProgressPre.ChangeMax(If(isOneNode, 1, .Count)) If isOneNode Then ProgressPre.Perform() - If Not __parseContainer(.Self) Then Exit For + If Not __parseContainer(.Self) Then Continue For 'Exit For Else For nodeIndx = 0 To 1 If nodeIndx = 0 Then @@ -446,14 +560,19 @@ Namespace API.Twitter .ItemF(newTwitterNodes), .Self) ProgressPre.Perform() - If Not __parseContainer(tmpNode) Then Exit For + If Not __parseContainer(tmpNode) Then + If isPins Then GoTo nextpIndx + Exit For + End If Next End With End If +nextNodeIndx: Next End If End With End If +nextpIndx: Next If ExistsDetected And i = 1 Then Exit For Else ExistsDetected = False @@ -473,6 +592,7 @@ Namespace API.Twitter If DownloadModel = DownloadModels.Undefined Then If ParseUserMediaOnly Then DownloadModel = DownloadModels.Media + If DownloadBroadcasts Then DownloadModel += DownloadModels.Profile Else DownloadModel = DownloadModels.Media + DownloadModels.Profile + DownloadModels.Search End If @@ -731,7 +851,9 @@ Namespace API.Twitter Dim conf As SFile = GdlCreateConf(confCache.RootDirectory) If DownloadModel = DownloadModels.Undefined And Not FirstDownloadComplete And DownloadModelForceApply Then - If ParseUserMediaOnly Then + If ParseUserMediaOnly And DownloadBroadcasts Then + DownloadModel = DownloadModels.Media + DownloadModels.Profile + ElseIf ParseUserMediaOnly Then DownloadModel = DownloadModels.Media Else DownloadModel = DownloadModels.Media + DownloadModels.Profile + DownloadModels.Search @@ -742,11 +864,15 @@ Namespace API.Twitter Dim rootDir As CacheKeeper = Cache.NewInstance Dim dir As SFile Dim dm As List(Of DownloadModels) = EnumExtract(Of DownloadModels)(DownloadModel).ListIfNothing - Dim process As Boolean + Dim process As Boolean, multiMode As Boolean + Dim currentModel As DownloadModels Dim urlPrePattern$ = $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/" + If DownloadBroadcasts AndAlso Not dm.Contains(DownloadModels.Profile) Then dm.Add(DownloadModels.Profile) + + multiMode = dm.Count > 1 + Using tgdl As New TwitterGDL(Nothing, Token, MySettings.AbortOnLimit.Value) With { - .TempPostsList = _TempPostsList, .AutoClear = True, .AutoReset = True, .CommandPermanent = $"chcp {BatchExecutor.UnicodeEncoding}", @@ -760,12 +886,16 @@ Namespace API.Twitter outList.Add(dir) tgdl.ChangeDirectory(dir) command = $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip --config ""{conf}"" --write-pages " - command &= GdlGetIdFilterString() + If multiMode Then + command &= "{0}" + Else + command &= GdlGetIdFilterString() + End If Select Case i - Case 0 : command &= $"{urlPrePattern}{NameTrue}/media" : process = dm.Contains(DownloadModels.Media) Or IsCommunity - Case 1 : command &= $"{urlPrePattern}{NameTrue}" : process = dm.Contains(DownloadModels.Profile) - Case 2 : command &= $"-o search-endpoint=graphql https://x.com/search?q=from:{NameTrue}+include:nativeretweets" : process = dm.Contains(DownloadModels.Search) And Not IsCommunity - Case 3 : command &= $"{urlPrePattern}{NameTrue}/likes" : process = dm.Contains(DownloadModels.Likes) + Case 0 : command &= $"{urlPrePattern}{NameTrue}/media" : currentModel = DownloadModels.Media : process = dm.Contains(currentModel) Or IsCommunity + Case 1 : command &= $"{urlPrePattern}{NameTrue}" : currentModel = DownloadModels.Profile : process = dm.Contains(currentModel) + Case 2 : command &= $"-o search-endpoint=graphql https://x.com/search?q=from:{NameTrue}+include:nativeretweets" : currentModel = DownloadModels.Search : process = dm.Contains(currentModel) And Not IsCommunity + Case 3 : command &= $"{urlPrePattern}{NameTrue}/likes" : currentModel = DownloadModels.Likes : process = dm.Contains(currentModel) Case Else : process = False End Select '#If DEBUG Then @@ -773,6 +903,16 @@ Namespace API.Twitter '#End If ThrowAny(Token) If process Then + If multiMode Then + If PostsKV.Count = 0 Then + tgdl.TempPostsList = New List(Of String) + Else + tgdl.TempPostsList = (From p As PKV In PostsKV Where p.Section = currentModel Select p.ID).ListIfNothing + End If + command = String.Format(command, GdlGetIdFilterString(tgdl.TempPostsList)) + Else + tgdl.TempPostsList = _TempPostsList + End If tgdl.Execute(command) If tgdl.LimitReached Then If CBool(MySettings.DownloadAlreadyParsed.Value) And @@ -798,8 +938,9 @@ Namespace API.Twitter Return Nothing End Try End Function - Private Function GdlGetIdFilterString() As String - Return If(_TempPostsList.Count > 0, $"--filter ""int(tweet_id) > {_TempPostsList.Last} or abort()"" ", String.Empty) + Private Function GdlGetIdFilterString(Optional ByVal TL As List(Of String) = Nothing) As String + If TL.ListExists Then TL.Sort() + With If(TL, _TempPostsList) : Return If(.Count > 0, $"--filter ""int(tweet_id) > { .Last} or abort()"" ", String.Empty) : End With End Function Private Function GdlCreateConf(ByVal Path As SFile) As SFile Try @@ -824,7 +965,7 @@ Namespace API.Twitter Dim cache As CacheKeeper = Nothing Try If ContentMissingExists Or (_ReparseLikes And LikesPosts.Count > 0) Then - Dim m As UserMedia + Dim m As UserMedia, mTmp As UserMedia Dim PostDate$ Dim nodes As List(Of String()) = GetContainerSubnodes() Dim node$() @@ -844,7 +985,11 @@ Namespace API.Twitter m = If(_ReparseLikes, Nothing, _ContentList(i)) If Not m.Post.ID.IsEmptyString Or (IsSingleObjectDownload And Not m.URL_BASE.IsEmptyString) Or _ReparseLikes Then ThrowAny(Token) - If IsSingleObjectDownload Then + If m.Type = UTypes.m3u8 Then + _TempMediaList.Add(m) + rList.ListAddValue(i, LNC) + Continue For + ElseIf IsSingleObjectDownload Then URL = m.URL_BASE ElseIf _ReparseLikes Then URL = LikesPosts(i) @@ -861,6 +1006,13 @@ Namespace API.Twitter If Not j Is Nothing Then With j.ItemF({"data", 0, "instructions", 0, "entries"}) If .ListExists Then + If IsSingleObjectDownload Or DownloadBroadcasts Then + mTmp = ExtractBroadcast(.Self, m.Post.ID, String.Empty, nodes) + If Not mTmp.URL.IsEmptyString Then + _TempMediaList.ListAddValue(mTmp, LNC) + rList.ListAddValue(i, LNC) + End If + End If For Each n In .Self For Each node In nodes With n(node) @@ -898,7 +1050,9 @@ Namespace API.Twitter #End Region #Region "DownloadSingleObject" Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken) - _ContentList.Add(New UserMedia(Data.URL) With {.State = UStates.Missing}) + Dim um As New UserMedia(Data.URL) With {.State = UStates.Missing} + If Not Data.URL.IsEmptyString AndAlso Data.URL.Contains(BroadCastPartUrl) Then um.Type = UTypes.m3u8 + _ContentList.Add(um) ReparseMissing(Token) End Sub #End Region @@ -955,6 +1109,13 @@ Namespace API.Twitter End Try End Function #End Region +#Region "Clear" + Protected Overrides Sub EraseData_AdditionalDataFiles() + MyFilePostsKV.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.SendToLog + EDP.ReturnValue) + _DataNames.Clear() + MyBase.EraseData_AdditionalDataFiles() + End Sub +#End Region #Region "Create media" Private Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String, Optional ByVal _PictureOption As String = Nothing, @@ -977,6 +1138,31 @@ Namespace API.Twitter Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) DownloadContentDefault(Token) End Sub + Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile + Const ytDest$ = "[download] destination" + Dim f As SFile = Nothing + If MySettings.CookiesNetscapeFile.Exists And Settings.YtdlpFile.Exists And (Not URL.IsEmptyString AndAlso URL.Contains(BroadCastPartUrl)) Then + Dim destPath$ = DestinationFile.PathWithSeparator.Replace("\", "\\") + Dim rr As RParams = RParams.DM($"{destPath}.+mp4", 0, RegexOptions.IgnoreCase, EDP.ReturnValue) + Dim cmd$ = $"""{Settings.YtdlpFile.File}"" --no-cookies-from-browser --cookies ""{MySettings.CookiesNetscapeFile}"" " + cmd &= $"{URL} -P ""{destPath}"" --no-mtime" + Using ytdlp As New YTDLP.YTDLPBatch(Token) + With ytdlp + .Execute(cmd) + If .OutputData.Count > 0 Then + For Each outStr$ In .OutputData + If Not outStr.IsEmptyString AndAlso outStr.ToLower.Trim.StartsWith(ytDest) Then + f = CStr(RegexReplace(outStr, rr)) + If Not f.Exists Then f = Nothing + Exit For + End If + Next + End If + End With + End Using + End If + Return f + End Function #End Region #Region "Exception" Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, @@ -986,7 +1172,7 @@ Namespace API.Twitter #End Region #Region "IDisposable support" Protected Overrides Sub Dispose(ByVal disposing As Boolean) - If Not disposedValue And disposing Then _DataNames.Clear() : LikesPosts.Clear() + If Not disposedValue And disposing Then _DataNames.Clear() : LikesPosts.Clear() : PostsKV.Clear() MyBase.Dispose(disposing) End Sub #End Region diff --git a/SCrawler/API/Xhamster/M3U8.vb b/SCrawler/API/Xhamster/M3U8.vb index 5509dd6..4a5b328 100644 --- a/SCrawler/API/Xhamster/M3U8.vb +++ b/SCrawler/API/Xhamster/M3U8.vb @@ -93,7 +93,11 @@ Namespace API.Xhamster Dim position% = InStr(URL, sk) If position > 0 Then appender = URL.Remove(position - 1) End If - URL = M3U8Base.CreateUrl(appender, file) + If file.StartsWith("//") Then + URL = LinkFormatterSecure(file.TrimStart("/")) + Else + URL = M3U8Base.CreateUrl(appender, file) + End If Dim l As List(Of M3U8URL) = ParseSecondM3U8(URL, Responser, appender) If l.ListExists Then Return l End If diff --git a/SCrawler/API/YouTube/SiteSettings.vb b/SCrawler/API/YouTube/SiteSettings.vb index 2cd549f..d916867 100644 --- a/SCrawler/API/YouTube/SiteSettings.vb +++ b/SCrawler/API/YouTube/SiteSettings.vb @@ -10,36 +10,52 @@ Imports SCrawler.Plugin Imports SCrawler.Plugin.Attributes Imports SCrawler.API.Base Imports SCrawler.API.YouTube.Base +Imports DN = SCrawler.API.Base.DeclaredNames Namespace API.YouTube Friend Class SiteSettings : Inherits SiteSettingsBase +#Region "Categories" + Private Const CAT_COMMUNITY As String = "Communities" +#End Region #Region "Declarations" - - Friend ReadOnly Property DownloadVideos As PropertyValue - - Friend ReadOnly Property DownloadShorts As PropertyValue - - Friend ReadOnly Property DownloadPlaylists As PropertyValue - - Friend ReadOnly Property DownloadCommunityImages As PropertyValue - - Friend ReadOnly Property DownloadCommunityVideos As PropertyValue - - Friend ReadOnly Property IgnoreCommunityErrors As PropertyValue - + Friend ReadOnly Property UseCookies As PropertyValue +#Region "New user defaults" + + Friend ReadOnly Property DownloadVideos As PropertyValue + + Friend ReadOnly Property DownloadShorts As PropertyValue + + Friend ReadOnly Property DownloadPlaylists As PropertyValue + + Friend ReadOnly Property DownloadCommunityImages As PropertyValue + + Friend ReadOnly Property DownloadCommunityVideos As PropertyValue +#End Region +#Region "Communities" + + Friend ReadOnly Property CommunityHost As PropertyValue + + Friend ReadOnly Property YouTubeAPIKey As PropertyValue + + Friend ReadOnly Property IgnoreCommunityErrors As PropertyValue +#End Region #End Region #Region "Initializer" Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean) MyBase.New(YouTubeSite, "youtube.com", AccName, Temp, My.Resources.SiteYouTube.YouTubeIcon_32, My.Resources.SiteYouTube.YouTubePic_96) Responser.Cookies.ChangedAllowInternalDrop = False + UseCookies = New PropertyValue(False) DownloadVideos = New PropertyValue(True) DownloadShorts = New PropertyValue(False) DownloadPlaylists = New PropertyValue(False) DownloadCommunityImages = New PropertyValue(False) DownloadCommunityVideos = New PropertyValue(False) + CommunityHost = New PropertyValue(String.Empty, GetType(String)) + YouTubeAPIKey = New PropertyValue(String.Empty, GetType(String)) IgnoreCommunityErrors = New PropertyValue(False) - UseCookies = New PropertyValue(False) _SubscriptionsAllowed = True UseNetscapeCookies = True End Sub diff --git a/SCrawler/API/YouTube/UserData.vb b/SCrawler/API/YouTube/UserData.vb index 70492db..fa40bca 100644 --- a/SCrawler/API/YouTube/UserData.vb +++ b/SCrawler/API/YouTube/UserData.vb @@ -33,6 +33,11 @@ Namespace API.YouTube Private Const Name_LastDownloadDatePlaylist As String = "YTLastDownloadDatePlaylist" #End Region #Region "Declarations" + Private ReadOnly Property MySettings As SiteSettings + Get + Return HOST.Source + End Get + End Property Friend Property DownloadYTVideos As Boolean = True Friend Property DownloadYTShorts As Boolean = False Friend Property DownloadYTPlaylists As Boolean = False @@ -263,7 +268,17 @@ Namespace API.YouTube If ChannelID.IsEmptyString Then GetChannelID() If ChannelID.IsEmptyString Then Throw New ArgumentNullException("ChannelID", "Channel ID cannot be null") - URL = $"https://yt.lemnoslife.com/channels?part=community&id={ChannelID}" + URL = MySettings.CommunityHost.Value + If URL.IsEmptyString Then + If Not CBool(MySettings.IgnoreCommunityErrors.Value) Then _ + MyMainLOG = $"{ToStringForLog()}: YouTube API instance host is not specified for downloading communities" + Exit Sub + Else + URL = LinkFormatterSecure(URL.Trim, "http").TrimEnd("/") + End If + + URL = $"{URL}/channels?part=community&id={ChannelID}" + If Not CStr(MySettings.YouTubeAPIKey.Value).IsEmptyString Then URL &= $"&key={CStr(MySettings.YouTubeAPIKey.Value).Trim}" If Not Cursor.IsEmptyString Then URL &= $"&pageToken={Cursor}" ProgressPre.ChangeMax(1) diff --git a/SCrawler/Editors/SiteEditorForm.vb b/SCrawler/Editors/SiteEditorForm.vb index 053cd03..7ce1a8d 100644 --- a/SCrawler/Editors/SiteEditorForm.vb +++ b/SCrawler/Editors/SiteEditorForm.vb @@ -357,6 +357,9 @@ Namespace Editors MyDefs.InvokeLoaderError(ex) End Try End Sub + Private Sub SiteEditorForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown + If e.Control And e.KeyCode = Keys.Enter Then MyDefs_ButtonOkClick(sender, New KeyHandleEventArgs With {.KeyEventArgs = e}) + End Sub Private Sub SiteEditorForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed If Host.PropList.Count > 0 Then Host.PropList.ForEach(Sub(p) p.DisposeControl()) If Not SpecialButton Is Nothing Then SpecialButton.Dispose() @@ -366,7 +369,11 @@ Namespace Editors If Not Cookies Is Nothing Then Cookies.Dispose() End Sub Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick - If MyDefs.MyFieldsChecker.AllParamsOK Then + Dim ctrl As Boolean = Not e Is Nothing AndAlso (If(e.KeyEventArgs?.Control, False) OrElse e.Key.Control) + If ctrl OrElse MyDefs.MyFieldsChecker.AllParamsOK Then + If (Not MyDefs.MyFieldsCheckerE.AllParamsOK(EDP.ReturnValue) And ctrl) AndAlso + MsgBoxE({$"Some required fields are not filled in!{vbCr}{vbCr}{MyDefs.MyFieldsChecker.ComparisonInformation} + {vbCr}{vbCr}Are you sure you want to process?", "Required fields are missing"}, vbCritical,,, {"Process", "Cancel"}) = 1 Then Exit Sub Dim i%, ii% With Host Dim indxList As New List(Of Integer) @@ -376,6 +383,7 @@ Namespace Editors If indxList.Count > 0 Then Dim pList As New List(Of PropertyData) Dim n$() + Dim errorsDetected As Boolean = False For i = 0 To indxList.Count - 1 n = .PropList(indxList(i)).PropertiesChecking For ii = 0 To .PropList.Count - 1 @@ -383,8 +391,13 @@ Namespace Editors If n.Contains(.Name) Then pList.Add(New PropertyData(.Name, .GetControlValue)) End With Next - If pList.Count > 0 AndAlso Not CBool(.PropList(indxList(i)).PropertiesCheckingMethod.Invoke(.Source, {pList})) Then Exit Sub + If pList.Count > 0 AndAlso Not CBool(.PropList(indxList(i)).PropertiesCheckingMethod.Invoke(.Source, {pList})) Then + If ctrl Then errorsDetected = True Else Exit Sub + End If Next + If (ctrl And errorsDetected) AndAlso MsgBoxE({$"Some settings may be incorrect. Do you still want to save?", + "Incorrect settings detected"}, + vbCritical,,, {"Process", "Cancel"}) = 1 Then Exit Sub End If If TXT_PATH.Text.IsEmptyString Then TXT_PATH.Text = .PathGenerate.CSFilePS diff --git a/SCrawler/My Project/AssemblyInfo.vb b/SCrawler/My Project/AssemblyInfo.vb index 0a11c73..9c8133c 100644 --- a/SCrawler/My Project/AssemblyInfo.vb +++ b/SCrawler/My Project/AssemblyInfo.vb @@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices - + @@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices ' by using the '*' as shown below: ' - - + + diff --git a/SCrawler/PluginsEnvironment/Attributes/Attributes.vb b/SCrawler/PluginsEnvironment/Attributes/Attributes.vb index d5cc4e3..0b26d15 100644 --- a/SCrawler/PluginsEnvironment/Attributes/Attributes.vb +++ b/SCrawler/PluginsEnvironment/Attributes/Attributes.vb @@ -60,4 +60,7 @@ Namespace Plugin.Attributes PropertyName = _PropertyName End Sub End Class + + Public Class UseDownDetectorAttribute : Inherits Attribute + End Class End Namespace \ No newline at end of file diff --git a/SCrawler/PluginsEnvironment/Hosts/SettingsHost.vb b/SCrawler/PluginsEnvironment/Hosts/SettingsHost.vb index 5a7371d..fe630d8 100644 --- a/SCrawler/PluginsEnvironment/Hosts/SettingsHost.vb +++ b/SCrawler/PluginsEnvironment/Hosts/SettingsHost.vb @@ -184,6 +184,16 @@ Namespace Plugin.Hosts End Sub Friend ReadOnly Property IsSeparatedTasks As Boolean = False Friend ReadOnly Property IsSavedPostsCompatible As Boolean = False + Friend ReadOnly Property IsDownDetectorCompatible As Boolean = False + Friend ReadOnly Property DownDetectorValue As Integer + Get + If IsDownDetectorCompatible Then + Return DirectCast(Source, DownDetector.IDownDetector).Value + Else + Return -1 + End If + End Get + End Property Private ReadOnly _TaskCountDefined As Integer? = Nothing Friend ReadOnly Property TaskCount As Integer Get @@ -296,6 +306,8 @@ Namespace Plugin.Hosts End With ElseIf TypeOf a Is ReplaceInternalPluginAttribute Then Replacer = a + ElseIf TypeOf a Is UseDownDetectorAttribute Then + IsDownDetectorCompatible = True End If Next End If @@ -521,18 +533,34 @@ Namespace Plugin.Hosts Friend Function GetUserPostUrl(ByVal User As IPluginContentProvider, ByVal Media As IUserMedia) As String Return Source.GetUserPostUrl(User, Media) End Function - Private _AvailableValue As Boolean = True - Private _AvailableAsked As Boolean = False + Friend Property AvailableValue As Boolean = True + Friend Property AvailableAsked As Boolean = False + Friend Property AvailableDownDetectorAsked As Boolean = False Private _ActiveTaskCount As Integer = 0 Friend Property AvailableText As String = String.Empty + Friend Function AvailableDownDetector(ByVal What As Download, ByVal Silent As Boolean) As Boolean + If Not AvailableDownDetectorAsked Then + AvailableDownDetectorAsked = True + If IsDownDetectorCompatible Then + AvailableValue = DirectCast(Source, DownDetector.IDownDetector).Available(What, Silent) + If Not AvailableValue Then AvailableText = Source.AvailableText : AvailableAsked = True + Return AvailableValue + Else + Return True + End If + Else + Return AvailableValue + End If + End Function Friend Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean If DownloadSiteData Then - If Not _AvailableAsked Then - _AvailableValue = Source.Available(What, Silent) + If Not AvailableDownDetectorAsked AndAlso Not AvailableDownDetector(What, Silent) Then Return AvailableValue + If Not AvailableAsked Then + AvailableValue = Source.Available(What, Silent) AvailableText = Source.AvailableText - _AvailableAsked = True + AvailableAsked = True End If - Return _AvailableValue + Return AvailableValue Else AvailableText = $"Downloading data for the site {Name} - {AccountName.IfNullOrEmpty(NameAccountNameDefault)} has been disabled by you." If Not Silent Then MsgBoxE({AvailableText, $"{Name} downloading disabled"}, vbExclamation) @@ -551,7 +579,7 @@ Namespace Plugin.Hosts End Sub Friend Sub DownloadDone(ByVal What As Download) _ActiveTaskCount -= 1 - If _ActiveTaskCount = 0 Then _AvailableAsked = False : AvailableText = String.Empty + If _ActiveTaskCount = 0 Then AvailableAsked = False : AvailableDownDetectorAsked = False : AvailableText = String.Empty Source.DownloadDone(What) End Sub Private Function ConvertUser(ByVal User As IUserData) As Object diff --git a/SCrawler/PluginsEnvironment/Hosts/SettingsHostCollection.vb b/SCrawler/PluginsEnvironment/Hosts/SettingsHostCollection.vb index 1093da7..2bcccdb 100644 --- a/SCrawler/PluginsEnvironment/Hosts/SettingsHostCollection.vb +++ b/SCrawler/PluginsEnvironment/Hosts/SettingsHostCollection.vb @@ -469,37 +469,59 @@ Namespace Plugin.Hosts Return False End If Else - Dim a As Boolean = False, n As Boolean = False + Dim a As Boolean = False, n As Boolean = False, aDown As Boolean = True Dim t$ = String.Empty Dim tExists As Boolean = False Dim singleHost As Boolean = hnExists AndAlso HostNames.Count = 1 Dim m As New MMessage("", "Some of the hosts are unavailable",, vbExclamation) - For i% = 0 To Count - 1 - If Not hnExists OrElse HostNames.Contains(Hosts(i).AccountName) Then - If Hosts(i).Available(What, True) Then - a = True - Else - n = True - If Not Hosts(i).AvailableText.IsEmptyString Then - t &= vbCr - t.StringAppendLine($"{Name} - {Hosts(i).AccountName.IfNullOrEmpty(SettingsHost.NameAccountNameDefault)}:") - t.StringAppendLine(Hosts(i).AvailableText) - tExists = True + If [Default].IsDownDetectorCompatible Then + Dim sh As SettingsHost = Nothing + Dim defdvalue% = [Default].DownDetectorValue + If hnExists AndAlso Not Hosts.All(Function(h) h.DownDetectorValue = defdvalue) Then _ + sh = Hosts.Find(Function(h) h.AccountName = HostNames(0)) + If sh Is Nothing Then sh = [Default] + aDown = sh.AvailableDownDetector(What, Silent) + Hosts.ForEach(Sub(ByVal h As SettingsHost) + h.AvailableDownDetectorAsked = True + If Not aDown And Not Silent Then h.AvailableValue = False : h.AvailableAsked = True + End Sub) + End If + If aDown Then + For i% = 0 To Count - 1 + If Not hnExists OrElse HostNames.Contains(Hosts(i).AccountName) Then + If Hosts(i).Available(What, True) Then + a = True Else - t.StringAppendLine($"{Name} - {Hosts(i).AccountName.IfNullOrEmpty(SettingsHost.NameAccountNameDefault)}") + n = True + If Not Hosts(i).AvailableText.IsEmptyString Then + t &= vbCr + t.StringAppendLine($"{Name} - {Hosts(i).AccountName.IfNullOrEmpty(SettingsHost.NameAccountNameDefault)}:") + t.StringAppendLine(Hosts(i).AvailableText) + tExists = True + Else + t.StringAppendLine($"{Name} - {Hosts(i).AccountName.IfNullOrEmpty(SettingsHost.NameAccountNameDefault)}") + End If + If FillIndexes Then HostsUnavailableIndexes.Add(i) End If - If FillIndexes Then HostsUnavailableIndexes.Add(i) End If - End If - Next + Next + Else + If Not Silent Then Silent = True + a = False + n = True + If Not [Default].AvailableText.IsEmptyString Then t = [Default].AvailableText : tExists = Not t.IsEmptyString + End If + t = t.StringTrim If singleHost Then m.Text = "The host is unavailable." Else m.Text = "Some of the hosts are unavailable." End If - If HostNamesPassed And Not hnExists Then Silent = True - If a And Not n Then + If HostNamesPassed And Not hnExists And aDown Then Silent = True + If Not aDown And Not Silent Then + Return False + ElseIf a And Not n Then Return True ElseIf Not a And n Then If Not Silent And tExists Then m.Text &= $"{vbCr}{vbCr}{t}" : m.Show() diff --git a/SCrawler/SettingsCLS.vb b/SCrawler/SettingsCLS.vb index 106dc44..1e99242 100644 --- a/SCrawler/SettingsCLS.vb +++ b/SCrawler/SettingsCLS.vb @@ -366,6 +366,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) 'Downloading: file naming n = {"Downloading", "FileName"} @@ -1064,6 +1065,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable Friend ReadOnly Property ReparseMissingInTheRoutine As XMLValue(Of Boolean) Friend ReadOnly Property UseDefaultAccountIfMissing As XMLValue(Of Boolean) Friend ReadOnly Property AutomationBrushUndownloadedPlansMinutes As XMLValue(Of Integer) + Friend ReadOnly Property DownDetectorEnabled As XMLValue(Of Boolean) #End Region #Region "Downloading: file naming" Friend ReadOnly Property FileAddDateToFileName As XMLValue(Of Boolean)