Compare commits

..

3 Commits

Author SHA1 Message Date
Andy
5bc559c448 2024.1.20.0
API.Instagram: add reels support (separate)
API.LPSG: handle 404 error
2024-01-20 00:00:23 +03:00
Andy
b37f641582 2024.1.18.0
YT: url array form doesn't show scrollbars
API.Instagram: change aspect ratio determining
API.xHamster: some user videos were not downloaded
API.UserDataBind: incorrect collection sorting
DownloadFeedForm: change separator in result dialog when merging feeds
2024-01-18 01:23:55 +03:00
Andy
e00dfec701 2024.1.12.1
API.Instagram: stories (user) downloading with the wrong aspect ratio for some users
API.YouTube: fix incorrect opening of a post from the feed; fix wrong date to data parsing; add data downloading by dates

DownloadFeedForm: add merging multiple session feeds into one
2024-01-12 19:58:17 +03:00
20 changed files with 388 additions and 75 deletions

View File

@@ -1,3 +1,34 @@
# 2024.1.20.0
*2024-01-20*
- Added
- Instagram: **the ability to download reels**
- LPSG: handle 404 error
# 2024.1.18.0
*2024-01-18*
- Fixed
- Main window: incorrect collection sorting
- xHamster: some user videos were not downloaded
- YouTube (standalone app): URL array form doesn't show scrollbars
- Minor bugs
# 2024.1.12.1
*2024-01-12*
- Added
- YouTube (SCrawler): data downloading by dates
- Feed: ability to merge multiple session feeds into one
- Feed: remove session number from special feeds
- Fixed
- **Instagram**: stories (user) downloading with the wrong aspect ratio for some users
- YouTube: incorrect opening of a post from the feed
- YouTube: wrong date to data parsing
# 2024.1.12.0
*2024-01-12*

View File

@@ -100,6 +100,7 @@ Namespace API.YouTube.Controls
Me.TXT_URLS.MaxLength = 2147483647
Me.TXT_URLS.Multiline = True
Me.TXT_URLS.Name = "TXT_URLS"
Me.TXT_URLS.ScrollBars = System.Windows.Forms.ScrollBars.Both
Me.TXT_URLS.Size = New System.Drawing.Size(372, 261)
Me.TXT_URLS.TabIndex = 0
'

View File

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

View File

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

View File

@@ -15,6 +15,9 @@ Namespace API.Instagram
Friend Const InstagramSite As String = "Instagram"
Friend Const InstagramSiteKey As String = "AndyProgram_Instagram"
Friend ReadOnly FilesPattern As RParams = RParams.DMS(".+?([^/\?]+?\.[\w\d]{3,4})(?=(\?|\Z))", 1, EDP.ReturnValue)
Friend ReadOnly ObtainMedia_SizeFuncPic_RegexP As RParams = RParams.DMS("_p(\d+)x(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly ObtainMedia_SizeFuncPic_RegexS As RParams = RParams.DMS("_s(\d+)x(\d+)", 1, EDP.ReturnValue)
Friend Const PageTokenRegexPatternDefault As String = "\[\],{""token"":""(.*?)""},\d+\]"
Friend Sub UpdateResponser(ByVal Source As IResponse, ByRef Destination As Responser)
Const r_wwwClaimName$ = "x-ig-set-www-claim"
Const r_tokenName$ = SiteSettings.Header_CSRF_TOKEN_COOKIE

View File

@@ -11,6 +11,8 @@ Namespace API.Instagram
Friend Class EditorExchangeOptions
<PSetting(Caption:="Get timeline", ToolTip:="Download user timeline")>
Friend Property GetTimeline As Boolean
<PSetting(Caption:="Get Reels", ToolTip:="Download user Reels")>
Friend Property GetReels As Boolean
<PSetting(Caption:="Get stories", ToolTip:="Download user stories (pinned)")>
Friend Property GetStories As Boolean
<PSetting(Caption:="Get stories: user", ToolTip:="Download user stories")>
@@ -20,6 +22,7 @@ Namespace API.Instagram
Friend Sub New(ByVal u As UserData)
With u
GetTimeline = .GetTimeline
GetReels = .GetReels
GetStories = .GetStories
GetStoriesUser = .GetStoriesUser
GetTagged = .GetTaggedData
@@ -28,6 +31,7 @@ Namespace API.Instagram
Friend Sub New(ByVal s As SiteSettings)
With s
GetTimeline = CBool(.GetTimeline.Value)
GetReels = CBool(.GetReels.Value)
GetStories = CBool(.GetStories.Value)
GetStoriesUser = CBool(.GetStoriesUser.Value)
GetTagged = CBool(.GetTagged.Value)

View File

@@ -121,11 +121,13 @@ Namespace API.Instagram
Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider
<PropertyOption(ControlText:="Get timeline", ControlToolTip:="Default value for new users"), PXML, ControlNumber(23), PClonable>
Friend ReadOnly Property GetTimeline As PropertyValue
<PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users"), PXML, ControlNumber(24), PClonable>
<PropertyOption(ControlText:="Get Reels", ControlToolTip:="Default value for new users"), PXML, ControlNumber(24), PClonable>
Friend ReadOnly Property GetReels As PropertyValue
<PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users"), PXML, ControlNumber(25), PClonable>
Friend ReadOnly Property GetStories As PropertyValue
<PropertyOption(ControlText:="Get stories: user", ControlToolTip:="Default value for new users"), PXML, ControlNumber(25), PClonable>
<PropertyOption(ControlText:="Get stories: user", ControlToolTip:="Default value for new users"), PXML, ControlNumber(26), PClonable>
Friend ReadOnly Property GetStoriesUser As PropertyValue
<PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), PXML, ControlNumber(26), PClonable>
<PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), PXML, ControlNumber(27), PClonable>
Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr &
@@ -137,11 +139,13 @@ Namespace API.Instagram
#Region "Download ready"
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline"), PXML, ControlNumber(10), PClonable>
Friend ReadOnly Property DownloadTimeline As PropertyValue
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories"), PXML, ControlNumber(11), PClonable>
<PropertyOption(ControlText:="Download Reels", ControlToolTip:="Download Reels"), PXML, ControlNumber(11), PClonable>
Friend ReadOnly Property DownloadReels As PropertyValue
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories"), PXML, ControlNumber(12), PClonable>
Friend ReadOnly Property DownloadStories As PropertyValue
<PropertyOption(ControlText:="Download stories: user", ControlToolTip:="Download stories (user)"), PXML, ControlNumber(12), PClonable>
<PropertyOption(ControlText:="Download stories: user", ControlToolTip:="Download stories (user)"), PXML, ControlNumber(13), PClonable>
Friend ReadOnly Property DownloadStoriesUser As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(13), PClonable>
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(14), PClonable>
Friend ReadOnly Property DownloadTagged As PropertyValue
#End Region
#Region "429 bypass"
@@ -244,6 +248,7 @@ Namespace API.Instagram
HH_USER_AGENT = New PropertyValue(useragent, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_USER_AGENT), v))
DownloadTimeline = New PropertyValue(True)
DownloadReels = New PropertyValue(True)
DownloadStories = New PropertyValue(True)
DownloadStoriesUser = New PropertyValue(True)
DownloadTagged = New PropertyValue(True)
@@ -256,6 +261,7 @@ Namespace API.Instagram
SleepTimerOnPostsLimitProvider = New TimersChecker(10000)
GetTimeline = New PropertyValue(True)
GetReels = New PropertyValue(False)
GetStories = New PropertyValue(False)
GetStoriesUser = New PropertyValue(False)
GetTagged = New PropertyValue(False)

View File

@@ -15,6 +15,7 @@ Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.Base
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
@@ -24,6 +25,7 @@ Namespace API.Instagram
Private Const Name_LastCursor As String = "LastCursor"
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
Private Const Name_GetTimeline As String = "GetTimeline"
Private Const Name_GetReels As String = "GetReels"
Private Const Name_GetStories As String = "GetStories"
Private Const Name_GetStoriesUser As String = "GetStoriesUser"
Private Const Name_GetTagged As String = "GetTaggedData"
@@ -66,6 +68,7 @@ Namespace API.Instagram
Return New EContainer("Post", ID, {New EAttribute(Name_Section, CInt(Section)), New EAttribute(Name_Code, Code)})
End Function
End Structure
Friend Const Header_FB_LSD As String = "x-fb-lsd"
Private ReadOnly Property MySiteSettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
@@ -76,6 +79,7 @@ Namespace API.Instagram
Private LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = False
Friend Property GetTimeline As Boolean = True
Friend Property GetReels As Boolean = False
Friend Property GetStories As Boolean
Friend Property GetStoriesUser As Boolean
Friend Property GetTaggedData As Boolean
@@ -94,6 +98,7 @@ Namespace API.Instagram
LastCursor = .Value(Name_LastCursor)
FirstLoadingDone = .Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
GetTimeline = .Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value))
GetReels = .Value(Name_GetReels).FromXML(Of Boolean)(MySiteSettings.GetReels.Value)
GetStories = .Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
GetStoriesUser = .Value(Name_GetStoriesUser).FromXML(Of Boolean)(MySiteSettings.GetStoriesUser.Value)
GetTaggedData = .Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
@@ -103,6 +108,7 @@ Namespace API.Instagram
.Add(Name_LastCursor, LastCursor)
.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
.Add(Name_GetReels, GetReels.BoolToInteger)
.Add(Name_GetStories, GetStories.BoolToInteger)
.Add(Name_GetStoriesUser, GetStoriesUser.BoolToInteger)
.Add(Name_GetTagged, GetTaggedData.BoolToInteger)
@@ -120,6 +126,7 @@ Namespace API.Instagram
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions)
GetTimeline = .GetTimeline
GetReels = .GetReels
GetStories = .GetStories
GetStoriesUser = .GetStoriesUser
GetTaggedData = .GetTagged
@@ -253,6 +260,14 @@ Namespace API.Instagram
End If
If FirstLoadingDone Then LastCursor = String.Empty
If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then
If CBool(MySiteSettings.DownloadReels.Value) And GetReels Then
s = Sections.Reels
DefaultParser_ElemNode = {"node", "media"}
DownloadData(String.Empty, s, Token)
DefaultParser_ElemNode = Nothing
DownloadReels_SetEnvir = False
ProgressPre.Done()
End If
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 GetTaggedData Then
@@ -268,6 +283,8 @@ Namespace API.Instagram
errorFound = True
Throw ex
Finally
DefaultParser_ElemNode = Nothing
DownloadReels_SetEnvir = False
E560Thrown = False
UpdateResponser()
ValidateExtension()
@@ -301,7 +318,7 @@ Namespace API.Instagram
Protected Overridable Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
Declarations.UpdateResponser(e, Responser)
End Sub
Protected Enum Sections : Timeline : Tagged : Stories : UserStories : SavedPosts : End Enum
Protected 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"
@@ -441,6 +458,7 @@ Namespace API.Instagram
ReconfigureAwaiter()
Try
Dim r$ = String.Empty
Dim n As EContainer, nn As EContainer
Dim HasNextPage As Boolean = False
Dim EndCursor$ = String.Empty
@@ -461,6 +479,9 @@ Namespace API.Instagram
URL = $"https://www.instagram.com/api/v1/feed/user/{NameTrue}/username/?count=50" &
If(Cursor.IsEmptyString, String.Empty, $"&max_id={Cursor}")
ENode = Nothing
Case Sections.Reels
r = DownloadReels(Cursor, Token)
ENode = {"data", "xdt_api__v1__clips__user__connection_v2"}
Case Sections.SavedPosts
SavedPostsDownload(String.Empty, Token)
Exit Sub
@@ -496,7 +517,7 @@ Namespace API.Instagram
End Select
'Get response
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
If Not Section = Sections.Reels Then r = Responser.GetResponse(URL,, EDP.ThrowException)
MySiteSettings.TooManyRequests(False)
RequestsCount += 1
ThrowAny(Token)
@@ -518,6 +539,20 @@ Namespace API.Instagram
HasNextPage = False
End If
End With
Case Sections.Reels
With n
If .Contains("page_info") Then
With .Item("page_info")
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
EndCursor = .Value("end_cursor")
End With
Else
HasNextPage = False
End If
If If(.Item("edges")?.Count, 0) > 0 Then
If Not DefaultParser(.Item("edges"), Section, Token, "Reels*") Then Throw New ExitException
End If
End With
Case Sections.Tagged
With n
If .Contains("page_info") Then
@@ -577,7 +612,7 @@ Namespace API.Instagram
End Try
Loop
Catch eex2 As ExitException
If (Section = Sections.Timeline Or Section = Sections.Tagged) And Not Cursor.IsEmptyString Then Throw eex2
If Not Section = Sections.Reels And (Section = Sections.Timeline Or Section = Sections.Tagged) And Not Cursor.IsEmptyString Then Throw eex2
Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted
If oex2.HelpLink = InstAborted Then HasError = True
Catch DoEx As Exception
@@ -668,6 +703,7 @@ Namespace API.Instagram
End Sub
Protected DefaultParser_ElemNode() As Object = Nothing
Protected DefaultParser_IgnorePass As Boolean = False
Private ReadOnly DefaultParser_PostUrlCreator_Default As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/"
Protected DefaultParser_PostUrlCreator As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/"
Protected Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
Optional ByVal SpecFolder As String = Nothing, Optional ByVal State As UStates = UStates.Unknown,
@@ -717,6 +753,106 @@ Namespace API.Instagram
End If
End Function
#End Region
#Region "Get reels"
Private _GetReels_LSD As String = String.Empty
Private _GetReels_dtsg As String = String.Empty
Private ReadOnly Property DownloadReels_Tokens_Valid As Boolean
Get
Return Not _GetReels_LSD.IsEmptyString And Not _GetReels_dtsg.IsEmptyString
End Get
End Property
Private WriteOnly Property DownloadReels_SetEnvir As Boolean
Set(ByVal init As Boolean)
If init Then
ObtainMedia_SetReelsFunc()
DefaultParser_PostUrlCreator = Function(post) $"{MySiteSettings.GetUserUrl(Me).TrimEnd("/")}/reel/{post.Code}"
Else
ObtainMedia_SizeFuncPic = Nothing
ObtainMedia_SizeFuncVid = Nothing
DefaultParser_PostUrlCreator = DefaultParser_PostUrlCreator_Default
End If
End Set
End Property
Private Class Responser2 : Inherits Responser
Friend Sub New(ByVal Source As Responser)
MyBase.New
Copy(Source)
ErrorProcessor = New ResponserErrorProcessor(Source)
End Sub
End Class
''' <returns>Response</returns>
Private Function DownloadReels(ByVal Cursor As String, ByVal Token As CancellationToken) As String
Const requestPattern$ = "https://www.instagram.com/api/graphql?fb_dtsg={0}&fb_api_req_friendly_name=PolarisProfileReelsTabContentQuery&lsd={1}&doc_id=7191572580905225&variables={2}"
DownloadReels_SetEnvir = True
If Cursor.IsEmptyString And Not DownloadReels_Tokens_Valid Then GetPageTokens()
If Cursor.IsEmptyString And Not DownloadReels_Tokens_Valid Then Throw New ExitException
Using resp As New Responser2(Responser)
Try
resp.Method = "POST"
AddHandler resp.ResponseReceived, AddressOf Responser_ResponseReceived
resp.Headers.Add(Header_FB_LSD, _GetReels_LSD)
Dim vars$ = """data"":{""include_feed_video"":true,""page_size"":50,""target_user_id"":""" & ID & """}"
If Not Cursor.IsEmptyString Then vars = $"""after"":""{Cursor}"",""before"":null,{vars},""first"":4,""last"":null"
vars = "{" & vars & "}"
Dim url$ = String.Format(requestPattern, _GetReels_dtsg, _GetReels_LSD, SymbolsConverter.ASCII.EncodeSymbolsOnly(vars))
Return resp.GetResponse(url,, EDP.ThrowException)
Finally
With resp
Responser.Cookies.Update(.Cookies)
With .Headers
If .Contains(SiteSettings.Header_IG_WWW_CLAIM) Then Responser.Headers.Add(SiteSettings.Header_IG_WWW_CLAIM, .Value(SiteSettings.Header_IG_WWW_CLAIM))
If .Contains(SiteSettings.Header_CSRF_TOKEN) Then Responser.Headers.Add(SiteSettings.Header_CSRF_TOKEN, .Value(SiteSettings.Header_CSRF_TOKEN))
End With
End With
End Try
End Using
End Function
Private Function GetPageTokens() As Boolean
_GetReels_LSD = String.Empty
_GetReels_dtsg = String.Empty
Try
Dim r$ = Responser.GetResponse(MySiteSettings.GetUserUrl(Me),, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim rr As RParams = RParams.DM(PageTokenRegexPatternDefault, 0, RegexReturn.List, EDP.ReturnValue)
Dim tokens As List(Of String) = RegexReplace(r, rr)
Dim tt$, ttVal$
If tokens.ListExists Then
With rr
.Match = Nothing
.MatchSub = 1
.WhatGet = RegexReturn.Value
End With
For Each tt In tokens
If Not _GetReels_LSD.IsEmptyString And Not _GetReels_dtsg.IsEmptyString Then
Exit For
Else
ttVal = RegexReplace(tt, rr)
If Not ttVal.IsEmptyString Then
If ttVal.Contains(":") Then
If _GetReels_dtsg.IsEmptyString Then _GetReels_dtsg = ttVal
Else
If _GetReels_LSD.IsEmptyString Then _GetReels_LSD = ttVal
End If
End If
End If
Next
End If
End If
Catch ex As Exception
Dim notFound$ = String.Empty
If _GetReels_dtsg.IsEmptyString Then notFound.StringAppend(Header_FB_LSD)
If _GetReels_LSD.IsEmptyString Then notFound.StringAppend("lsd")
LogError(ex, $"failed to update some{IIf(notFound.IsEmptyString, String.Empty, $" ({notFound})")} credentials", EDP.SendToLog)
End Try
Return DownloadReels_Tokens_Valid
End Function
#End Region
#Region "Code ID converters"
Protected Function CodeToID(ByVal Code As String) As String
Const CodeSymbols$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
@@ -741,15 +877,38 @@ Namespace API.Instagram
Protected ObtainMedia_SizeFuncVid As Func(Of EContainer, Sizes) = Nothing
Protected ObtainMedia_SizeFuncPic As Func(Of EContainer, Sizes) = Nothing
Protected ObtainMedia_AllowAbstract As Boolean = False
Protected Sub ObtainMedia_SetReelsFunc()
ObtainMedia_SizeFuncPic = Function(ByVal ss As EContainer) As Sizes
If ss.Value("url").IsEmptyString Then
Return New Sizes("----", "")
ElseIf Not ss.Value("width").IsEmptyString Or Not ss.Value("width").IsEmptyString Then
Return New Sizes(CInt(AConvert(Of Integer)(ss.Value("width"), 0)) +
CInt(AConvert(Of Integer)(ss.Value("height"), 0)), ss.Value("url"))
Else
Dim rval$ = RegexReplace(ss.Value("url"), ObtainMedia_SizeFuncPic_RegexP)
If Not rval.IsEmptyString Then Return New Sizes(rval, ss.Value("url"))
rval = RegexReplace(ss.Value("url"), ObtainMedia_SizeFuncPic_RegexS)
If Not rval.IsEmptyString Then Return New Sizes(AConvert(Of Integer)(rval, 1) * -1, ss.Value("url"))
Return New Sizes(10000, ss.Value("url"))
End If
End Function
ObtainMedia_SizeFuncVid = Function(ss) If(ss.Value("url").IsEmptyString, New Sizes("----", ""), New Sizes(10000, ss.Value("url")))
End Sub
Protected Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj As String = Nothing, Optional ByVal InitialType As Integer = -1,
Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0)
Try
Dim maxSize As Func(Of EContainer, Integer) = Function(ByVal _ss As EContainer) As Integer
Dim w% = AConvert(Of Integer)(_ss.Value("width"), 0)
Dim h% = AConvert(Of Integer)(_ss.Value("height"), 0)
Return w + h
'Return Math.Max(w, h)
End Function
Dim wrongData As Predicate(Of Sizes) = Function(_ss) _ss.HasError Or _ss.Data.IsEmptyString
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0
Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url"))
Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(maxSize(_ss), _ss.Value("url"))
Dim ssVid As Func(Of EContainer, Sizes) = ss
Dim ssPic As Func(Of EContainer, Sizes) = ss
Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String
@@ -1045,11 +1204,12 @@ Namespace API.Instagram
Dim s As Sections = DirectCast(Section, Sections)
Select Case s
Case Sections.Timeline : MySiteSettings.DownloadTimeline.Value = False
Case Sections.Reels : MySiteSettings.DownloadReels.Value = False
Case Sections.Tagged : MySiteSettings.DownloadTagged.Value = False
Case Sections.Stories, Sections.UserStories
MySiteSettings.DownloadTimeline.Value = False
MySiteSettings.DownloadStories.Value = False
MySiteSettings.DownloadStoriesUser.Value = False
Case Else : MySiteSettings.DownloadTagged.Value = False
End Select
MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper
End If

View File

@@ -106,9 +106,12 @@ Namespace API.LPSG
End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
If Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then '503
MyMainLOG = $"{ToStringForLog()}: LPSG not available"
Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then '404
UserExists = False
Return 1
Else
Return 0
End If

View File

@@ -18,14 +18,11 @@ Imports IGS = SCrawler.API.Instagram.SiteSettings
Namespace API.ThreadsNet
Friend Class UserData : Inherits Instagram.UserData
#Region "Declarations"
Friend Const Header_FB_LSD As String = "x-fb-lsd"
Private ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
End Get
End Property
Private ReadOnly ObtainMedia_SizeFuncPic_RegexP As RParams = RParams.DMS("_p(\d+)x(\d+)", 1, EDP.ReturnValue)
Private ReadOnly ObtainMedia_SizeFuncPic_RegexS As RParams = RParams.DMS("_s(\d+)x(\d+)", 1, EDP.ReturnValue)
Private ReadOnly DefaultParser_ElemNode_Default() As Object = {"node", "thread_items", 0, "post"}
Private OPT_LSD As String = String.Empty
Private OPT_FB_DTSG As String = String.Empty
@@ -48,20 +45,7 @@ Namespace API.ThreadsNet
#End Region
#Region "Initializer"
Friend Sub New()
ObtainMedia_SizeFuncPic = Function(ByVal ss As EContainer) As Sizes
If ss.Value("url").IsEmptyString Then
Return New Sizes("----", "")
ElseIf Not ss.Value("width").IsEmptyString Then
Return New Sizes(ss.Value("height").IfNullOrEmpty(ss.Value("width")), ss.Value("url"))
Else
Dim rval$ = RegexReplace(ss.Value("url"), ObtainMedia_SizeFuncPic_RegexP)
If Not rval.IsEmptyString Then Return New Sizes(rval, ss.Value("url"))
rval = RegexReplace(ss.Value("url"), ObtainMedia_SizeFuncPic_RegexS)
If Not rval.IsEmptyString Then Return New Sizes(AConvert(Of Integer)(rval, 1) * -1, ss.Value("url"))
Return New Sizes(10000, ss.Value("url"))
End If
End Function
ObtainMedia_SizeFuncVid = Function(ss) If(ss.Value("url").IsEmptyString, New Sizes("----", ""), New Sizes(10000, ss.Value("url")))
ObtainMedia_SetReelsFunc()
ObtainMedia_AllowAbstract = True
DefaultParser_ElemNode = DefaultParser_ElemNode_Default
DefaultParser_PostUrlCreator = Function(post) $"https://www.threads.net/@{NameTrue}/post/{post.Code}"
@@ -174,7 +158,7 @@ Namespace API.ThreadsNet
Dim rr As RParams
Dim tt$, ttVal$
If Not r.IsEmptyString Then
rr = RParams.DM("\[\],{""token"":""(.*?)""},\d+\]", 0, RegexReturn.List, EDP.ReturnValue)
rr = RParams.DM(Instagram.PageTokenRegexPatternDefault, 0, RegexReturn.List, EDP.ReturnValue)
Dim tokens As List(Of String) = RegexReplace(r, rr)
If tokens.ListExists Then
With rr

View File

@@ -741,6 +741,15 @@ Namespace API
Return GetEnumerator()
End Function
#End Region
#Region "IComparable Support"
Friend Overrides Function CompareTo(ByVal Other As UserDataBase) As Integer
If TypeOf Other Is UserDataBind Then
Return CollectionName.CompareTo(Other.CollectionName)
Else
Return -1
End If
End Function
#End Region
#Region "IEquatable support"
Friend Overrides Function Equals(ByVal Other As UserDataBase) As Boolean
If Other.IsCollection Then

View File

@@ -84,10 +84,15 @@ Namespace API.Xhamster
End Function
Private Shared Function ObtainUrls(ByVal URL As String, ByVal Responser As Responser, ByVal UHD As Boolean) As List(Of M3U8URL)
Try
Const sk$ = "/key="
Dim file$ = ParseFirstM3U8(URL, Responser, UHD)
If Not file.IsEmptyString Then
Responser.UseGZipStream = False
Dim appender$ = URL.Replace(URL.Split("/").LastOrDefault, String.Empty)
If file.StartsWith(sk) Then
Dim position% = InStr(URL, sk)
If position > 0 Then appender = URL.Remove(position - 1)
End If
URL = M3U8Base.CreateUrl(appender, file)
Dim l As List(Of M3U8URL) = ParseSecondM3U8(URL, Responser, appender)
If l.ListExists Then Return l

View File

@@ -90,7 +90,11 @@ Namespace API.YouTube
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
If Not User Is Nothing AndAlso TypeOf User Is UserData Then
Return $"https://{IIf(DirectCast(User, UserData).IsMusic, "music", "www")}.youtube.com/watch?v={Media.Post.ID}"
If DirectCast(User, UserData).IsMusic Or Media.URL_BASE.IsEmptyString Then
Return $"https://{IIf(DirectCast(User, UserData).IsMusic, "music", "www")}.youtube.com/watch?v={Media.Post.ID}"
Else
Return Media.URL_BASE
End If
Else
Return String.Empty
End If

View File

@@ -137,6 +137,26 @@ Namespace API.YouTube
Dim list As New List(Of IYouTubeMediaContainer)
Dim url$ = String.Empty
Dim maxDate As Date? = Nothing
Dim __minDate As Date? = DownloadDateFrom
Dim __maxDate As Date? = DownloadDateTo
Dim __getMinDate As Func(Of Date?, Date?) = Function(ByVal dInput As Date?) As Date?
If dInput.HasValue Then
If __minDate.HasValue Then
Return {__minDate.Value, dInput.Value}.Min
Else
Return dInput
End If
ElseIf __minDate.HasValue Then
Return __minDate
Else
Return Nothing
End If
End Function
Dim shortsUrlStandardize As Action(Of IYouTubeMediaContainer, Integer) = Sub(ByVal c As IYouTubeMediaContainer, ByVal ii As Integer)
Dim sUrl$ = $"https://www.youtube.com/shorts/{c.ID}"
'c.URL = sUrl
c.URL_BASE = sUrl
End Sub
Dim nDate As Func(Of Date?, Date?) = Function(ByVal dInput As Date?) As Date?
If dInput.HasValue Then
If dInput.Value.AddDays(3) < Now Then Return dInput.Value.AddDays(1) Else Return dInput
@@ -144,22 +164,23 @@ Namespace API.YouTube
Return Nothing
End If
End Function
Dim fillList As Func(Of Date?, Boolean) = Function(ByVal lDate As Date?) As Boolean
If Not container Is Nothing AndAlso container.HasElements Then
Dim ce As IEnumerable(Of IYouTubeMediaContainer)
ce = container.Elements
If ce.ListExists Then ce = ce.Where(Function(e) e.ObjectType = YouTubeMediaType.Single)
If ce.ListExists AndAlso lDate.HasValue Then _
ce = ce.Where(Function(e) e.DateAdded <= lDate.Value AndAlso
Not e.ID.IsEmptyString AndAlso Not _TempPostsList.Contains(e.ID))
If ce.ListExists Then
maxDate = ce.Max(Function(e) e.DateAdded)
list.AddRange(ce)
Return True
End If
End If
Return False
End Function
Dim fillList As Func(Of Date?, Boolean, Boolean) = Function(ByVal lDate As Date?, ByVal ___isShorts As Boolean) As Boolean
If Not container Is Nothing AndAlso container.HasElements Then
Dim ce As IEnumerable(Of IYouTubeMediaContainer)
ce = container.Elements
If ce.ListExists Then ce = ce.Where(Function(e) e.ObjectType = YouTubeMediaType.Single)
If ce.ListExists AndAlso lDate.HasValue Then _
ce = ce.Where(Function(e) e.DateAdded >= lDate.Value AndAlso
Not e.ID.IsEmptyString AndAlso Not _TempPostsList.Contains(e.ID))
If ce.ListExists Then
maxDate = ce.Max(Function(e) e.DateAdded)
If ___isShorts Then ce.ListForEach(shortsUrlStandardize, EDP.None)
list.AddRange(ce)
Return True
End If
End If
Return False
End Function
Dim applySpecFolder As Action(Of String, Boolean) = Sub(ByVal fName As String, ByVal isPls As Boolean)
If If(container?.Count, 0) > 0 Then _
container.Elements.ForEach(Sub(ByVal el As YouTubeMediaContainerBase)
@@ -175,33 +196,33 @@ Namespace API.YouTube
maxDate = Nothing
LastDownloadDatePlaylist = nDate(LastDownloadDatePlaylist)
url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={ID}"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr,, LastDownloadDatePlaylist,, True)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, __getMinDate(LastDownloadDatePlaylist), __maxDate,, True)
applySpecFolder.Invoke(String.Empty, False)
If fillList.Invoke(LastDownloadDatePlaylist) Then LastDownloadDatePlaylist = If(maxDate, Now)
If fillList.Invoke(LastDownloadDatePlaylist, False) Then LastDownloadDatePlaylist = If(maxDate, Now)
ElseIf YTMediaType = YouTubeMediaType.Channel Then
If IsMusic Or DownloadYTVideos Then
maxDate = Nothing
LastDownloadDateVideos = nDate(LastDownloadDateVideos)
url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/{IIf(IsMusic Or IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr,, LastDownloadDateVideos,, True)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, __getMinDate(LastDownloadDateVideos), __maxDate,, True)
applySpecFolder.Invoke(IIf(IsMusic, String.Empty, "Videos"), False)
If fillList.Invoke(LastDownloadDateVideos) Then LastDownloadDateVideos = If(maxDate, Now)
If fillList.Invoke(LastDownloadDateVideos, False) Then LastDownloadDateVideos = If(maxDate, Now)
End If
If Not IsMusic And DownloadYTShorts Then
maxDate = Nothing
LastDownloadDateShorts = nDate(LastDownloadDateShorts)
url = $"https://www.youtube.com/{IIf(IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}/shorts"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr,, LastDownloadDateShorts,, True)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, __getMinDate(LastDownloadDateShorts), __maxDate,, True)
applySpecFolder.Invoke("Shorts", False)
If fillList.Invoke(LastDownloadDateShorts) Then LastDownloadDateShorts = If(maxDate, Now)
If fillList.Invoke(LastDownloadDateShorts, True) Then LastDownloadDateShorts = If(maxDate, Now)
End If
If Not IsMusic And DownloadYTPlaylists Then
maxDate = Nothing
LastDownloadDatePlaylist = nDate(LastDownloadDatePlaylist)
url = $"https://www.youtube.com/{IIf(IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}/playlists"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr,, LastDownloadDatePlaylist,, True)
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, __getMinDate(LastDownloadDatePlaylist), __maxDate,, True)
applySpecFolder.Invoke("Playlists", True)
If fillList.Invoke(LastDownloadDatePlaylist) Then LastDownloadDatePlaylist = If(maxDate, Now)
If fillList.Invoke(LastDownloadDatePlaylist, False) Then LastDownloadDatePlaylist = If(maxDate, Now)
End If
If Not IsMusic And (DownloadYTCommunityImages Or DownloadYTCommunityVideos) Then DownloadCommunity(String.Empty, Token)
Else

View File

@@ -49,6 +49,7 @@ Namespace DownloadObjects
Me.BTT_FEED_DELETE_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_LIST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_DATE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MERGE_SESSIONS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CLEAR_DAILY = New System.Windows.Forms.ToolStripMenuItem()
Me.SEP_0 = New System.Windows.Forms.ToolStripSeparator()
Me.MENU_DOWN = New System.Windows.Forms.ToolStripDropDownButton()
@@ -119,6 +120,11 @@ Namespace DownloadObjects
MENU_LOAD_SEP_4.Name = "MENU_LOAD_SEP_4"
MENU_LOAD_SEP_4.Size = New System.Drawing.Size(264, 6)
'
'MENU_LOAD_SEP_5
'
MENU_LOAD_SEP_5.Name = "MENU_LOAD_SEP_5"
MENU_LOAD_SEP_5.Size = New System.Drawing.Size(264, 6)
'
'ToolbarTOP
'
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
@@ -131,7 +137,7 @@ Namespace DownloadObjects
'MENU_LOAD_SESSION
'
Me.MENU_LOAD_SESSION.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_CURRENT, Me.BTT_LOAD_SESSION_LAST, Me.BTT_LOAD_SESSION_CHOOSE, MENU_LOAD_SEP_1, Me.BTT_LOAD_FAV, Me.BTT_LOAD_SPEC, MENU_LOAD_SEP_2, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_REMOVE_FAV, MENU_LOAD_SEP_3, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_REMOVE_SPEC, MENU_LOAD_SEP_4, Me.BTT_FEED_CLEAR_FAV, Me.BTT_FEED_CLEAR_SPEC, Me.BTT_FEED_DELETE_SPEC, Me.BTT_FEED_DELETE_DAILY_LIST, Me.BTT_FEED_DELETE_DAILY_DATE, MENU_LOAD_SEP_5, Me.BTT_CLEAR_DAILY})
Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_CURRENT, Me.BTT_LOAD_SESSION_LAST, Me.BTT_LOAD_SESSION_CHOOSE, MENU_LOAD_SEP_1, Me.BTT_LOAD_FAV, Me.BTT_LOAD_SPEC, MENU_LOAD_SEP_2, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_REMOVE_FAV, MENU_LOAD_SEP_3, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_REMOVE_SPEC, MENU_LOAD_SEP_4, Me.BTT_FEED_CLEAR_FAV, Me.BTT_FEED_CLEAR_SPEC, Me.BTT_FEED_DELETE_SPEC, Me.BTT_FEED_DELETE_DAILY_LIST, Me.BTT_FEED_DELETE_DAILY_DATE, MENU_LOAD_SEP_5, Me.BTT_MERGE_SESSIONS, Me.BTT_CLEAR_DAILY})
Me.MENU_LOAD_SESSION.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.MENU_LOAD_SESSION.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_LOAD_SESSION.Name = "MENU_LOAD_SESSION"
@@ -236,6 +242,15 @@ Namespace DownloadObjects
Me.BTT_FEED_DELETE_DAILY_DATE.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_DAILY_DATE.Text = "Delete daily feed (by date)"
'
'BTT_MERGE_SESSIONS
'
Me.BTT_MERGE_SESSIONS.AutoToolTip = True
Me.BTT_MERGE_SESSIONS.Image = Global.SCrawler.My.Resources.Resources.DBPic_32
Me.BTT_MERGE_SESSIONS.Name = "BTT_MERGE_SESSIONS"
Me.BTT_MERGE_SESSIONS.Size = New System.Drawing.Size(267, 22)
Me.BTT_MERGE_SESSIONS.Text = "Merge sessions"
Me.BTT_MERGE_SESSIONS.ToolTipText = "Merge multiple session feeds into one"
'
'BTT_CLEAR_DAILY
'
Me.BTT_CLEAR_DAILY.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
@@ -311,11 +326,6 @@ Namespace DownloadObjects
Me.TP_DATA.Size = New System.Drawing.Size(484, 436)
Me.TP_DATA.TabIndex = 1
'
'MENU_LOAD_SEP_5
'
MENU_LOAD_SEP_5.Name = "MENU_LOAD_SEP_5"
MENU_LOAD_SEP_5.Size = New System.Drawing.Size(264, 6)
'
'DownloadFeedForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -361,5 +371,6 @@ Namespace DownloadObjects
Private WithEvents BTT_FEED_DELETE_SPEC As ToolStripMenuItem
Private WithEvents BTT_FEED_DELETE_DAILY_LIST As ToolStripMenuItem
Private WithEvents BTT_FEED_DELETE_DAILY_DATE As ToolStripMenuItem
Private WithEvents BTT_MERGE_SESSIONS As ToolStripMenuItem
End Class
End Namespace

View File

@@ -147,10 +147,10 @@
<metadata name="MENU_LOAD_SEP_4.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="ToolbarTOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<metadata name="MENU_LOAD_SEP_5.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="ToolbarTOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
</root>

View File

@@ -37,6 +37,7 @@ Namespace DownloadObjects
Return OPT_SUBSCRIPTIONS.Checked
End Get
End Property
Private IsSession As Boolean = True
#End Region
#Region "Initializer"
Friend Sub New()
@@ -171,6 +172,7 @@ Namespace DownloadObjects
End Try
End Sub
Private Sub Feed_SPEC_LOAD(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
IsSession = False
Dim f As FeedSpecial = Source.Tag
If Not f Is Nothing AndAlso Not f.Disposed Then
DataList.Clear()
@@ -291,12 +293,15 @@ Namespace DownloadObjects
#Region "Feed"
#Region "Load"
Private Sub BTT_LOAD_SESSION_CURRENT_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CURRENT.Click
IsSession = True
RefillList()
End Sub
Private Sub BTT_LOAD_SESSION_LAST_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_LAST.Click
IsSession = True
SessionChooser(True)
End Sub
Private Sub BTT_LOAD_SESSION_CHOOSE_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CHOOSE.Click
IsSession = True
SessionChooser(False)
End Sub
Private Sub SessionChooser(ByVal GetLast As Boolean, Optional ByVal GetFilesOnly As Boolean = False,
@@ -382,6 +387,7 @@ Namespace DownloadObjects
#End Region
#Region "Load fav, spec"
Private Sub BTT_LOAD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_FAV.Click
IsSession = False
DataList.Clear()
With Settings.Feeds.Favorite
.RemoveNotExist(FileNotExist)
@@ -389,6 +395,7 @@ Namespace DownloadObjects
End With
End Sub
Private Sub BTT_LOAD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SPEC.Click
IsSession = False
With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then
DataList.Clear()
@@ -527,6 +534,68 @@ Namespace DownloadObjects
End If
End Sub
#End Region
#Region "Merge feeds"
Private Sub MergeFeeds() Handles BTT_MERGE_SESSIONS.Click
Try
Const msgTitle$ = "Merge feeds"
Dim files As New List(Of SFile)
Dim abs% = 0, prev% = 0, curr%, i%
Dim x As XmlFile
Dim f As SFile
Dim um As UserMediaD
Dim data As New List(Of UserMediaD)
Dim tmpData As New List(Of UserMediaD)
Dim lrc As New ListAddParams(LAP.NotContainsOnly + LAP.IgnoreICopier)
SessionChooser(False, True, files)
If files.ListExists(2) Then
files.Sort()
For Each f In files
x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData(EDP.None)
If x.Count > 0 Then tmpData.ListAddList(x, lrc)
If tmpData.Count > 0 Then tmpData.Reverse() : data.AddRange(tmpData) : tmpData.Clear()
x.Dispose()
Next
If data.Count > 0 Then
For i = 0 To data.Count - 1
um = data(i)
curr = um.Session
If i = 0 Then
abs = curr
Else
If curr < abs And prev <> curr Then
abs += 1
ElseIf curr >= abs Then
abs = curr
End If
End If
prev = curr
um.Session = abs
data(i) = um
Next
data.Reverse()
x = New XmlFile With {.Name = TDownloader.Name_SessionXML, .AllowSameNames = True}
x.AddRange(data)
x.Save(files(0))
x.Dispose()
For i = 1 To files.Count - 1 : files(i).Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.ReturnValue) : Next
MsgBoxE({$"Session data was combined into '{files(0).Name}'.{vbCr}{vbCr}" &
files.ListToStringE(vbCr, New CustomProvider(Function(ff As SFile) ff.Name),,, EDP.ReturnValue), msgTitle})
files.Clear()
data.Clear()
Else
MsgBoxE({"There is no session data in the selected files", msgTitle}, vbExclamation)
End If
ElseIf files.ListExists(1) Then
MsgBoxE({"You must select two or more files to merge feeds", msgTitle}, vbExclamation)
Else
MsgBoxE({"You haven't selected any feeds", msgTitle}, vbExclamation)
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadFeedForm.MergeFeeds]")
End Try
End Sub
#End Region
#End Region
#Region "View modes"
Private Sub OPT_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_DEFAULT.Click, OPT_SUBSCRIPTIONS.Click
@@ -553,6 +622,7 @@ Namespace DownloadObjects
BTT_REFRESH.ControlChangeColor(ToolbarTOP, Added, False)
End Sub
Private Sub BTT_REFRESH_Click(sender As Object, e As EventArgs) Handles BTT_REFRESH.Click
IsSession = True
RefillList()
End Sub
#End Region
@@ -763,7 +833,7 @@ Namespace DownloadObjects
Dim p As New TPCELL(DataRows, DataColumns)
Dim fmList As New List(Of FeedMedia)
d.ForEach(Sub(ByVal de As UserMediaD)
fmList.Add(New FeedMedia(de, w, h))
fmList.Add(New FeedMedia(de, w, h, IsSession))
With fmList.Last
AddHandler .MediaDeleted, AddressOf FeedMedia_MediaDeleted
AddHandler .MediaDownload, AddressOf FeedMedia_Download

View File

@@ -159,7 +159,7 @@ Namespace DownloadObjects
Public Sub New()
InitializeComponent()
End Sub
Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Height As Integer)
Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Height As Integer, ByVal IsSession As Boolean)
Try
InitializeComponent()
Me.Media = Media
@@ -278,7 +278,7 @@ Namespace DownloadObjects
End With
End If
If Settings.FeedAddSessionToCaption Then info = $"[{Media.Session}] {info}"
If Settings.FeedAddSessionToCaption And IsSession Then info = $"[{Media.Session}] {info}"
If Settings.FeedAddDateToCaption Then info &= $" ({Media.Date.ToStringDate(ADateTime.Formats.BaseDateTime)})"
LBL_INFO.Text = info
If Not Media.User Is Nothing AndAlso Not Media.User.HOST Is Nothing Then

View File

@@ -26,6 +26,7 @@ Namespace DownloadObjects
#End Region
#Region "Declarations"
#Region "Files"
Friend Const Name_SessionXML As String = "Session"
Friend Structure UserMediaD : Implements IComparable(Of UserMediaD), IEquatable(Of UserMediaD), IEContainerProvider
#Region "XML Names"
Private Const Name_Data As String = "Data"
@@ -40,7 +41,7 @@ Namespace DownloadObjects
Friend ReadOnly Data As UserMedia
Friend ReadOnly UserInfo As UserInfo
Friend ReadOnly [Date] As Date
Friend ReadOnly Session As Integer
Friend Session As Integer
Friend IsSavedPosts As Boolean
Friend Sub New(ByVal Data As UserMedia, ByVal User As IUserData, ByVal Session As Integer)
Me.Data = Data
@@ -133,7 +134,7 @@ Namespace DownloadObjects
Try
If Settings.FeedStoreSessionsData And Files.Count > 0 Then
ClearSessions()
Using x As New XmlFile With {.Name = "Session", .AllowSameNames = True}
Using x As New XmlFile With {.Name = Name_SessionXML, .AllowSameNames = True}
x.AddRange(Files)
x.Save(FilesSessionActual)
End Using

View File

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