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
This commit is contained in:
Andy
2024-01-12 19:58:17 +03:00
parent 94edf23570
commit e00dfec701
10 changed files with 167 additions and 42 deletions

View File

@@ -1,3 +1,16 @@
# 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.1.12.0
*2024-01-12* *2024-01-12*

View File

@@ -746,10 +746,15 @@ Namespace API.Instagram
Optional ByVal PostOriginUrl As String = Nothing, Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0) Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0)
Try 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 Math.Max(w, h)
End Function
Dim wrongData As Predicate(Of Sizes) = Function(_ss) _ss.HasError Or _ss.Data.IsEmptyString 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 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 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 ssVid As Func(Of EContainer, Sizes) = ss
Dim ssPic 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 Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String

View File

@@ -90,7 +90,11 @@ Namespace API.YouTube
End Function End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String 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 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 Else
Return String.Empty Return String.Empty
End If End If

View File

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

View File

@@ -49,6 +49,7 @@ Namespace DownloadObjects
Me.BTT_FEED_DELETE_SPEC = New System.Windows.Forms.ToolStripMenuItem() 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_LIST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_DATE = 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.BTT_CLEAR_DAILY = New System.Windows.Forms.ToolStripMenuItem()
Me.SEP_0 = New System.Windows.Forms.ToolStripSeparator() Me.SEP_0 = New System.Windows.Forms.ToolStripSeparator()
Me.MENU_DOWN = New System.Windows.Forms.ToolStripDropDownButton() 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.Name = "MENU_LOAD_SEP_4"
MENU_LOAD_SEP_4.Size = New System.Drawing.Size(264, 6) 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 'ToolbarTOP
' '
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
@@ -131,7 +137,7 @@ Namespace DownloadObjects
'MENU_LOAD_SESSION 'MENU_LOAD_SESSION
' '
Me.MENU_LOAD_SESSION.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image 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.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.MENU_LOAD_SESSION.ImageTransparentColor = System.Drawing.Color.Magenta Me.MENU_LOAD_SESSION.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_LOAD_SESSION.Name = "MENU_LOAD_SESSION" 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.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_DAILY_DATE.Text = "Delete daily feed (by date)" 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 'BTT_CLEAR_DAILY
' '
Me.BTT_CLEAR_DAILY.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24 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.Size = New System.Drawing.Size(484, 436)
Me.TP_DATA.TabIndex = 1 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 'DownloadFeedForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) 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_SPEC As ToolStripMenuItem
Private WithEvents BTT_FEED_DELETE_DAILY_LIST As ToolStripMenuItem Private WithEvents BTT_FEED_DELETE_DAILY_LIST As ToolStripMenuItem
Private WithEvents BTT_FEED_DELETE_DAILY_DATE As ToolStripMenuItem Private WithEvents BTT_FEED_DELETE_DAILY_DATE As ToolStripMenuItem
Private WithEvents BTT_MERGE_SESSIONS As ToolStripMenuItem
End Class End Class
End Namespace 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"> <metadata name="MENU_LOAD_SEP_4.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </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"> <metadata name="MENU_LOAD_SEP_5.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </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> </root>

View File

@@ -37,6 +37,7 @@ Namespace DownloadObjects
Return OPT_SUBSCRIPTIONS.Checked Return OPT_SUBSCRIPTIONS.Checked
End Get End Get
End Property End Property
Private IsSession As Boolean = True
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
@@ -171,6 +172,7 @@ Namespace DownloadObjects
End Try End Try
End Sub End Sub
Private Sub Feed_SPEC_LOAD(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs) Private Sub Feed_SPEC_LOAD(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
IsSession = False
Dim f As FeedSpecial = Source.Tag Dim f As FeedSpecial = Source.Tag
If Not f Is Nothing AndAlso Not f.Disposed Then If Not f Is Nothing AndAlso Not f.Disposed Then
DataList.Clear() DataList.Clear()
@@ -291,12 +293,15 @@ Namespace DownloadObjects
#Region "Feed" #Region "Feed"
#Region "Load" #Region "Load"
Private Sub BTT_LOAD_SESSION_CURRENT_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CURRENT.Click Private Sub BTT_LOAD_SESSION_CURRENT_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CURRENT.Click
IsSession = True
RefillList() RefillList()
End Sub End Sub
Private Sub BTT_LOAD_SESSION_LAST_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_LAST.Click Private Sub BTT_LOAD_SESSION_LAST_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_LAST.Click
IsSession = True
SessionChooser(True) SessionChooser(True)
End Sub End Sub
Private Sub BTT_LOAD_SESSION_CHOOSE_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CHOOSE.Click Private Sub BTT_LOAD_SESSION_CHOOSE_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CHOOSE.Click
IsSession = True
SessionChooser(False) SessionChooser(False)
End Sub End Sub
Private Sub SessionChooser(ByVal GetLast As Boolean, Optional ByVal GetFilesOnly As Boolean = False, Private Sub SessionChooser(ByVal GetLast As Boolean, Optional ByVal GetFilesOnly As Boolean = False,
@@ -382,6 +387,7 @@ Namespace DownloadObjects
#End Region #End Region
#Region "Load fav, spec" #Region "Load fav, spec"
Private Sub BTT_LOAD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_FAV.Click Private Sub BTT_LOAD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_FAV.Click
IsSession = False
DataList.Clear() DataList.Clear()
With Settings.Feeds.Favorite With Settings.Feeds.Favorite
.RemoveNotExist(FileNotExist) .RemoveNotExist(FileNotExist)
@@ -389,6 +395,7 @@ Namespace DownloadObjects
End With End With
End Sub End Sub
Private Sub BTT_LOAD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SPEC.Click Private Sub BTT_LOAD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SPEC.Click
IsSession = False
With FeedSpecialCollection.ChooseFeeds(False) With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then If .ListExists Then
DataList.Clear() DataList.Clear()
@@ -527,6 +534,68 @@ Namespace DownloadObjects
End If End If
End Sub End Sub
#End Region #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(, 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 #End Region
#Region "View modes" #Region "View modes"
Private Sub OPT_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_DEFAULT.Click, OPT_SUBSCRIPTIONS.Click 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) BTT_REFRESH.ControlChangeColor(ToolbarTOP, Added, False)
End Sub End Sub
Private Sub BTT_REFRESH_Click(sender As Object, e As EventArgs) Handles BTT_REFRESH.Click Private Sub BTT_REFRESH_Click(sender As Object, e As EventArgs) Handles BTT_REFRESH.Click
IsSession = True
RefillList() RefillList()
End Sub End Sub
#End Region #End Region
@@ -763,7 +833,7 @@ Namespace DownloadObjects
Dim p As New TPCELL(DataRows, DataColumns) Dim p As New TPCELL(DataRows, DataColumns)
Dim fmList As New List(Of FeedMedia) Dim fmList As New List(Of FeedMedia)
d.ForEach(Sub(ByVal de As UserMediaD) 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 With fmList.Last
AddHandler .MediaDeleted, AddressOf FeedMedia_MediaDeleted AddHandler .MediaDeleted, AddressOf FeedMedia_MediaDeleted
AddHandler .MediaDownload, AddressOf FeedMedia_Download AddHandler .MediaDownload, AddressOf FeedMedia_Download

View File

@@ -159,7 +159,7 @@ Namespace DownloadObjects
Public Sub New() Public Sub New()
InitializeComponent() InitializeComponent()
End Sub 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 Try
InitializeComponent() InitializeComponent()
Me.Media = Media Me.Media = Media
@@ -278,7 +278,7 @@ Namespace DownloadObjects
End With End With
End If 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)})" If Settings.FeedAddDateToCaption Then info &= $" ({Media.Date.ToStringDate(ADateTime.Formats.BaseDateTime)})"
LBL_INFO.Text = info LBL_INFO.Text = info
If Not Media.User Is Nothing AndAlso Not Media.User.HOST Is Nothing Then If Not Media.User Is Nothing AndAlso Not Media.User.HOST Is Nothing Then

View File

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

View File

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