2024.1.12.0

DownloadFeedForm: add an option to create a new feed when adding checked items; add a prompt before clearing the current session
MainFrame: add scheduler to tray menu

API.Instagram: fix tagged posts downloading
API.xHamster: fix profiles downloading; add creators downloading
API.YouTube: add error to log (communities)

Author: AAndyProgram

Changelog.md

@@ -1,3 +1,19 @@
+# 2024.1.12.0
+
+*2024-01-12*
+
+- Added
+  - Feed: added a prompt before clearing the current session
+  - xHamster: creators
+  - YouTube communities: add error to log
+  - Added scheduler to tray menu
+  - Other improvements
+- Fixed
+  - Feed: there is no option to create a new feed when adding checked items
+  - **Instagram**: downloading of tagged posts
+  - xHamster: profiles are not downloading
+  - Minor bugs
+
 # 2023.12.27.0
 
 *2023-12-27*

SCrawler/API/Base/UserDataBase.vb

@@ -1403,7 +1403,7 @@ BlockNullPicture:
                         End If
                         ff.Name &= "_thumb"
                         ff.Extension = "jpg"
-                        f = Web.FFMPEG.TakeSnapshot(f, ff, Settings.FfmpegFile, TimeSpan.FromSeconds(1),,, EDP.LogMessageValue)
+                        f = Web.FFMPEG.TakeSnapshot(f, ff, Settings.FfmpegFile, TimeSpan.FromSeconds(1),,, EDP.SendToLog + EDP.ReturnValue)
                         If f.Exists Then DirectCast(Data, IDownloadableMedia).ThumbnailFile = f
                     End If
                 Else

SCrawler/API/Instagram/SiteSettings.vb

@@ -63,8 +63,6 @@ Namespace API.Instagram
         Friend Const Header_Browser As String = "Sec-Ch-Ua"
         Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
         Friend Const Header_Platform As String = "Sec-Ch-Ua-Platform-Version"
-        <PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash for tagged posts", IsAuth:=True), PXML("InstaHash"), ControlNumber(0), PClonable(Clone:=False)>
-        Friend ReadOnly Property HashTagged As PropertyValue
         <PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(2), PClonable(Clone:=False)>
         Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue
         <PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3), PClonable(Clone:=False)>
@@ -236,7 +234,6 @@ Namespace API.Instagram
                 .CookiesExtractedAutoSave = False
             End With
 
-            HashTagged = New PropertyValue(String.Empty, GetType(String))
             HH_CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_CSRF_TOKEN), v))
             HH_IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_IG_APP_ID), v))
             HH_ASBD_ID = New PropertyValue(asbd, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_ASBD_ID), v))
@@ -249,7 +246,7 @@ Namespace API.Instagram
             DownloadTimeline = New PropertyValue(True)
             DownloadStories = New PropertyValue(True)
             DownloadStoriesUser = New PropertyValue(True)
-            DownloadTagged = New PropertyValue(False)
+            DownloadTagged = New PropertyValue(True)
 
             RequestsWaitTimer = New PropertyValue(1000)
             RequestsWaitTimerProvider = New TimersChecker(100)

SCrawler/API/Instagram/UserData.vb

@@ -255,7 +255,12 @@ Namespace API.Instagram
                 If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then
                     If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
                     If CBool(MySiteSettings.DownloadStoriesUser.Value) And GetStoriesUser Then s = Sections.UserStories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
-                    If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
+                    If CBool(MySiteSettings.DownloadTagged.Value) And GetTaggedData Then
+                        s = Sections.Tagged
+                        DownloadData(String.Empty, s, Token)
+                        ProgressPre.Done()
+                        If PostsToReparse.Count > 0 Then DownloadPosts(Token, True)
+                    End If
                 End If
                 If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
             Catch eex As ExitException
@@ -460,12 +465,10 @@ Namespace API.Instagram
                                 SavedPostsDownload(String.Empty, Token)
                                 Exit Sub
                             Case Sections.Tagged
-                                Dim h$ = AConvert(Of String)(MySiteSettings.HashTagged.Value, String.Empty)
-                                If h.IsEmptyString Then Throw New ExitException
                                 Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}"
                                 vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)
-                                URL = $"https://www.instagram.com/graphql/query/?query_hash={h}&variables={vars}"
-                                ENode = {"data", "user", 0}
+                                URL = $"https://www.instagram.com/graphql/query/?doc_id=17946422347485809&variables={vars}"
+                                ENode = {"data", "user", "edge_user_to_photos_of_you"}
                                 SpecFolder = TaggedFolder
                             Case Sections.Stories
                                 If Not StoriesRequested Then
@@ -581,11 +584,12 @@ Namespace API.Instagram
                 ProcessException(DoEx, Token, $"data downloading error [{URL}]",, Section)
             End Try
         End Sub
-        Private Sub DownloadPosts(ByVal Token As CancellationToken)
+        Private Sub DownloadPosts(ByVal Token As CancellationToken, Optional ByVal IsTagged As Boolean = False)
             Dim URL$ = String.Empty
             Dim dValue% = 1
             Dim _Index% = 0
             Dim before%
+            Dim specFolder$ = IIf(IsTagged, "Tagged", String.Empty)
             If PostsToReparse.Count > 0 Then ProgressPre.ChangeMax(PostsToReparse.Count)
             Try
                 Do While dValue = 1
@@ -616,7 +620,7 @@ Namespace API.Instagram
                                             With j("items")
                                                 For Each jj In .Self
                                                     before = _TempMediaList.Count
-                                                    ObtainMedia(jj, PostsToReparse(i).ID)
+                                                    ObtainMedia(jj, PostsToReparse(i).ID, specFolder)
                                                     If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
                                                     If _Limit > 0 And _TotalPostsParsed >= _Limit Then Throw New ExitException
                                                 Next

SCrawler/API/OnlyFans/SiteSettings.vb

@@ -148,7 +148,8 @@ Namespace API.OnlyFans
             DownloadChatMedia = New PropertyValue(True)
 
             LastDateUpdated_XML = New PropertyValue(Now.AddYears(-1), GetType(Date))
-            UseOldAuthRules = New PropertyValue(False)
+            'URGENT: OF [UseOldAuthRules = True]
+            UseOldAuthRules = New PropertyValue(True)
             DynamicRulesUpdateInterval = New PropertyValue(60 * 24)
             DynamicRulesUpdateIntervalProvider = New FieldsCheckerProviderSimple(Function(v) IIf(AConvert(Of Integer)(v, 0) > 0, v, Nothing),
                                                                                  "The value of [{0}] field must be greater than 0")

SCrawler/API/Xhamster/SiteSettings.vb

@@ -46,7 +46,7 @@ Namespace API.Xhamster
 
             _SubscriptionsAllowed = True
             UrlPatternUser = "https://xhamster.com/{0}/{1}"
-            UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch)
+            UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption}|{P_Creators})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch)
             ImageVideoContains = "xhamster"
         End Sub
         Friend Overrides Sub EndInit()
@@ -96,8 +96,9 @@ Namespace API.Xhamster
         Friend Const P_Search As String = "search"
         Friend Const P_Tags As String = "tags"
         Friend Const P_Categories As String = "categories"
-        Friend Const P_Pornstars = "pornstars"
-        Private ReadOnly NonUsersRegex As RParams = RParams.DM("https?://[^/]+/((gay)/|(shemale)/|)(pornstars|tags|categories|search)/([^/\?]+)[/\?]?(.*)", 0,
+        Friend Const P_Pornstars As String = "pornstars"
+        Friend Const P_Creators As String = "creators"
+        Private ReadOnly NonUsersRegex As RParams = RParams.DM("https?://[^/]+/((gay)/|(shemale)/|)(pornstars|creators|tags|categories|search)/([^/\?]+)[/\?]?(.*)", 0,
                                                                RegexReturn.ListByMatch, EDP.ReturnValue)
         Private ReadOnly PageRemover_1 As RParams = RParams.DM("[\?&]?[Pp]age=\d+", 0, RegexReturn.Replace, EDP.ReturnValue,
                                                                CType(Function(input) String.Empty, Func(Of String, String)))
@@ -106,12 +107,23 @@ Namespace API.Xhamster
         Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
             If Not UserURL.IsEmptyString AndAlso Domains.Domains.Count > 0 AndAlso Domains.Domains.Exists(Function(d) UserURL.ToLower.Contains(d.ToLower)) Then
                 Dim n$, opt$
+                Dim tryNext As Boolean = False
                 Dim data As List(Of String) = RegexReplace(UserURL, UserRegex)
                 If data.ListExists(3) AndAlso Not data(2).IsEmptyString Then
                     n = data(2)
-                    If Not data(1).IsEmptyString AndAlso data(1) = ChannelOption Then n &= $"@{data(1)}"
-                    Return New ExchangeOptions(Site, n)
+                    If Not data(1).IsEmptyString Then
+                        If data(1) = ChannelOption Then
+                            n &= $"@{data(1)}"
+                        ElseIf data(1) = P_Creators Then
+                            tryNext = True
+                        End If
+                    End If
+                    If Not tryNext Then Return New ExchangeOptions(Site, n)
                 Else
+                    tryNext = True
+                End If
+
+                If tryNext Then
                     data = RegexReplace(UserURL, NonUsersRegex)
                     If data.ListExists(7) AndAlso Not data(5).IsEmptyString Then
                         n = data(5).StringRemoveWinForbiddenSymbols
@@ -122,6 +134,7 @@ Namespace API.Xhamster
                                 Case P_Tags : mode = SiteModes.Tags
                                 Case P_Categories : mode = SiteModes.Categories
                                 Case P_Pornstars : mode = SiteModes.Pornstars
+                                Case P_Creators : mode = SiteModes.User
                                 Case Else : Return Nothing
                             End Select
                             n = $"{CInt(mode)}@{n}"

SCrawler/API/Xhamster/UserData.vb

@@ -19,6 +19,7 @@ Namespace API.Xhamster
     Friend Class UserData : Inherits UserDataBase
 #Region "XML names"
         Private Const Name_Gender As String = "Gender"
+        Private Const Name_IsCreator As String = "IsCreator"
 #End Region
 #Region "Declarations"
         Friend Overrides ReadOnly Property FeedIsUser As Boolean
@@ -27,6 +28,7 @@ Namespace API.Xhamster
             End Get
         End Property
         Friend Property IsChannel As Boolean = False
+        Friend Property IsCreator As Boolean = False
         Friend Property TrueName As String = String.Empty
         Friend Property Gender As String = String.Empty
         Friend Property SiteMode As SiteModes = SiteModes.User
@@ -77,7 +79,8 @@ Namespace API.Xhamster
                         If n.Length = 2 And If(Force, eObj.Options, Options).IsEmptyString Then
                             If Force Then Return False
                             TrueName = n(0)
-                            IsChannel = True
+                            IsChannel = n(1) = SiteSettings.ChannelOption
+                            IsCreator = n(1) = SiteSettings.P_Creators
                         ElseIf IsChannel Then
                             If Force Then Return False
                             TrueName = Name
@@ -89,6 +92,7 @@ Namespace API.Xhamster
                             If n2.ListExists Then
                                 IsChannel = False
                                 __Mode = CInt(n2(0))
+                                IsCreator = __Mode = SiteModes.User
                                 __Gender = n2(1)
                                 __Arguments = n2(3)
                                 __TrueName = n2.ListTake(3, 100, EDP.ReturnValue).ListToString(String.Empty)
@@ -139,6 +143,7 @@ Namespace API.Xhamster
             With Container
                 If Loading Then
                     IsChannel = .Value(Name_IsChannel).FromXML(Of Boolean)(False)
+                    IsCreator = .Value(Name_IsCreator).FromXML(Of Boolean)(False)
                     TrueName = .Value(Name_TrueName)
                     Gender = .Value(Name_Gender)
                     SiteMode = .Value(Name_SiteMode).FromXML(Of Integer)(SiteModes.User)
@@ -151,6 +156,7 @@ Namespace API.Xhamster
                         .Value(Name_FriendlyName) = FriendlyName
                     End If
                     .Add(Name_IsChannel, IsChannel.BoolToInteger)
+                    .Add(Name_IsCreator, IsCreator.BoolToInteger)
                     .Add(Name_TrueName, TrueName)
                     .Add(Name_Gender, Gender)
                     .Add(Name_SiteMode, CInt(SiteMode))
@@ -178,7 +184,7 @@ Namespace API.Xhamster
 #End Region
 #Region "Download functions"
         Friend Function GetNonUserUrl(ByVal Page As Integer) As String
-            If SiteMode = SiteModes.User Then
+            If SiteMode = SiteModes.User And Not IsCreator Then
                 Return String.Empty
             Else
                 Dim url$ = "https://xhamster.com/"
@@ -188,6 +194,7 @@ Namespace API.Xhamster
                     Case SiteModes.Categories : url &= SiteSettings.P_Categories
                     Case SiteModes.Search : url &= SiteSettings.P_Search
                     Case SiteModes.Pornstars : url &= SiteSettings.P_Pornstars
+                    Case SiteModes.User : url &= SiteSettings.P_Creators
                     Case Else : Return String.Empty
                 End Select
                 url &= $"/{TrueName}"
@@ -224,15 +231,20 @@ Namespace API.Xhamster
         Private ReadOnly SessionPosts As List(Of String)
         Private _PageVideosRepeat As Integer = 0
         Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
-            _TempPhotoData.Clear()
-            SearchPostsCount = 0
-            _PageVideosRepeat = 0
-            SessionPosts.Clear()
-            If DownloadVideos Then DownloadData(1, True, Token)
-            If Not IsChannel And DownloadImages And Not IsSubscription Then
-                DownloadData(1, False, Token)
-                ReparsePhoto(Token)
-            End If
+            Try
+                _TempPhotoData.Clear()
+                SearchPostsCount = 0
+                _PageVideosRepeat = 0
+                SessionPosts.Clear()
+                Responser.CookiesAsHeader = True
+                If DownloadVideos Then DownloadData(1, True, Token)
+                If Not IsChannel And Not IsCreator And DownloadImages And Not IsSubscription Then
+                    DownloadData(1, 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)
             Dim URL$ = String.Empty
@@ -260,7 +272,7 @@ Namespace API.Xhamster
                 ElseIf SiteMode = SiteModes.Search Then
                     URL = GetNonUserUrl(Page)
                     containerNodes.Add({"searchResult", "models"})
-                ElseIf SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories Or SiteMode = SiteModes.Pornstars Then
+                ElseIf IsCreator Or SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories Or SiteMode = SiteModes.Pornstars Then
                     URL = GetNonUserUrl(Page)
                     If SiteMode = SiteModes.Pornstars Then
                         containerNodes.Add({"trendingVideoListComponent", "models"})
@@ -269,9 +281,11 @@ Namespace API.Xhamster
                         containerNodes.Add({"pagesCategoryComponent", "trendingVideoListProps", "models"})
                         containerNodes.Add({"trendingVideoListComponent", "models"})
                     End If
+                    containerNodes.Add({"trendingVideoSectionComponent", "videoModels"})
                 Else
                     URL = $"https://xhamster.com/users/{TrueName}/{IIf(IsVideo, "videos", "photos")}{IIf(Page = 1, String.Empty, $"/{Page}")}"
                     containerNodes.Add({If(IsVideo, "userVideoCollection", "userGalleriesCollection")})
+                    containerNodes.Add(If(IsVideo, {"videoListComponent", "models"}, {"userGalleriesCollection"}))
                 End If
                 ThrowAny(Token)
 

SCrawler/API/YouTube/UserData.vb

@@ -225,6 +225,7 @@ Namespace API.YouTube
         End Sub
         Private Sub DownloadCommunity(ByVal Cursor As String, ByVal Token As CancellationToken, Optional ByVal Round As Integer = 0)
             Dim URL$ = String.Empty
+            Const errMsg$ = "community data downloading error"
             Try
                 Const postIdTemp$ = "Community_{0}"
                 Const specFolder$ = "Community"
@@ -311,6 +312,10 @@ Namespace API.YouTube
                                                 Next
                                             End If
                                         End With
+                                    Else
+                                        With j({"error"})
+                                            If .ListExists Then MyMainLOG = $"{ToStringForLog()} {errMsg} [{ .Value("code")}]: { .Value("message")}"
+                                        End With
                                     End If
                                 End With
                             End If
@@ -327,7 +332,7 @@ Namespace API.YouTube
 
                 If Not nextToken.IsEmptyString Then DownloadCommunity(nextToken, Token)
             Catch ex As Exception
-                ProcessException(ex, Token, "community data downloading error")
+                ProcessException(ex, Token, errMsg)
             End Try
         End Sub
         Private Sub GetChannelID()