Compare commits

...

3 Commits

Author SHA1 Message Date
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
Andy
94edf23570 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)
2024-01-11 23:39:56 +03:00
22 changed files with 364 additions and 140 deletions

View File

@@ -1,3 +1,42 @@
# 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*
- 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.0
*2023-12-27* *2023-12-27*

View File

@@ -100,6 +100,7 @@ Namespace API.YouTube.Controls
Me.TXT_URLS.MaxLength = 2147483647 Me.TXT_URLS.MaxLength = 2147483647
Me.TXT_URLS.Multiline = True Me.TXT_URLS.Multiline = True
Me.TXT_URLS.Name = "TXT_URLS" 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.Size = New System.Drawing.Size(372, 261)
Me.TXT_URLS.TabIndex = 0 Me.TXT_URLS.TabIndex = 0
' '

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("2023.12.14.0")> <Assembly: AssemblyVersion("2024.1.18.0")>
<Assembly: AssemblyFileVersion("2023.12.14.0")> <Assembly: AssemblyFileVersion("2024.1.18.0")>
<Assembly: NeutralResourcesLanguage("en")> <Assembly: NeutralResourcesLanguage("en")>

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("2023.12.14.0")> <Assembly: AssemblyVersion("2024.1.18.0")>
<Assembly: AssemblyFileVersion("2023.12.14.0")> <Assembly: AssemblyFileVersion("2024.1.18.0")>
<Assembly: NeutralResourcesLanguage("en")> <Assembly: NeutralResourcesLanguage("en")>

View File

@@ -1403,7 +1403,7 @@ BlockNullPicture:
End If End If
ff.Name &= "_thumb" ff.Name &= "_thumb"
ff.Extension = "jpg" 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 If f.Exists Then DirectCast(Data, IDownloadableMedia).ThumbnailFile = f
End If End If
Else Else

View File

@@ -63,8 +63,6 @@ Namespace API.Instagram
Friend Const Header_Browser As String = "Sec-Ch-Ua" Friend Const Header_Browser As String = "Sec-Ch-Ua"
Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List" Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
Friend Const Header_Platform As String = "Sec-Ch-Ua-Platform-Version" 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)> <PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(2), PClonable(Clone:=False)>
Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3), PClonable(Clone:=False)> <PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3), PClonable(Clone:=False)>
@@ -236,7 +234,6 @@ Namespace API.Instagram
.CookiesExtractedAutoSave = False .CookiesExtractedAutoSave = False
End With 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_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_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)) 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) DownloadTimeline = New PropertyValue(True)
DownloadStories = New PropertyValue(True) DownloadStories = New PropertyValue(True)
DownloadStoriesUser = New PropertyValue(True) DownloadStoriesUser = New PropertyValue(True)
DownloadTagged = New PropertyValue(False) DownloadTagged = New PropertyValue(True)
RequestsWaitTimer = New PropertyValue(1000) RequestsWaitTimer = New PropertyValue(1000)
RequestsWaitTimerProvider = New TimersChecker(100) RequestsWaitTimerProvider = New TimersChecker(100)

View File

@@ -255,7 +255,12 @@ Namespace API.Instagram
If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then 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.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.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 End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
Catch eex As ExitException Catch eex As ExitException
@@ -460,12 +465,10 @@ Namespace API.Instagram
SavedPostsDownload(String.Empty, Token) SavedPostsDownload(String.Empty, Token)
Exit Sub Exit Sub
Case Sections.Tagged 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 & """}" Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}"
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars) vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)
URL = $"https://www.instagram.com/graphql/query/?query_hash={h}&variables={vars}" URL = $"https://www.instagram.com/graphql/query/?doc_id=17946422347485809&variables={vars}"
ENode = {"data", "user", 0} ENode = {"data", "user", "edge_user_to_photos_of_you"}
SpecFolder = TaggedFolder SpecFolder = TaggedFolder
Case Sections.Stories Case Sections.Stories
If Not StoriesRequested Then If Not StoriesRequested Then
@@ -581,11 +584,12 @@ Namespace API.Instagram
ProcessException(DoEx, Token, $"data downloading error [{URL}]",, Section) ProcessException(DoEx, Token, $"data downloading error [{URL}]",, Section)
End Try End Try
End Sub 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 URL$ = String.Empty
Dim dValue% = 1 Dim dValue% = 1
Dim _Index% = 0 Dim _Index% = 0
Dim before% Dim before%
Dim specFolder$ = IIf(IsTagged, "Tagged", String.Empty)
If PostsToReparse.Count > 0 Then ProgressPre.ChangeMax(PostsToReparse.Count) If PostsToReparse.Count > 0 Then ProgressPre.ChangeMax(PostsToReparse.Count)
Try Try
Do While dValue = 1 Do While dValue = 1
@@ -616,7 +620,7 @@ Namespace API.Instagram
With j("items") With j("items")
For Each jj In .Self For Each jj In .Self
before = _TempMediaList.Count before = _TempMediaList.Count
ObtainMedia(jj, PostsToReparse(i).ID) ObtainMedia(jj, PostsToReparse(i).ID, specFolder)
If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1 If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
If _Limit > 0 And _TotalPostsParsed >= _Limit Then Throw New ExitException If _Limit > 0 And _TotalPostsParsed >= _Limit Then Throw New ExitException
Next Next
@@ -742,10 +746,16 @@ 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 w + h
'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

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

View File

@@ -741,6 +741,15 @@ Namespace API
Return GetEnumerator() Return GetEnumerator()
End Function End Function
#End Region #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" #Region "IEquatable support"
Friend Overrides Function Equals(ByVal Other As UserDataBase) As Boolean Friend Overrides Function Equals(ByVal Other As UserDataBase) As Boolean
If Other.IsCollection Then If Other.IsCollection Then

View File

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

View File

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

View File

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

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

View File

@@ -30,6 +30,7 @@ Namespace DownloadObjects
Dim MENU_LOAD_SEP_2 As System.Windows.Forms.ToolStripSeparator Dim MENU_LOAD_SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_3 As System.Windows.Forms.ToolStripSeparator Dim MENU_LOAD_SEP_3 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_4 As System.Windows.Forms.ToolStripSeparator Dim MENU_LOAD_SEP_4 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_5 As System.Windows.Forms.ToolStripSeparator
Me.OPT_DEFAULT = New System.Windows.Forms.ToolStripMenuItem() Me.OPT_DEFAULT = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_SUBSCRIPTIONS = New System.Windows.Forms.ToolStripMenuItem() Me.OPT_SUBSCRIPTIONS = New System.Windows.Forms.ToolStripMenuItem()
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip() Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
@@ -43,18 +44,19 @@ Namespace DownloadObjects
Me.BTT_FEED_REMOVE_FAV = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_FEED_REMOVE_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_ADD_SPEC = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_FEED_ADD_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_REMOVE_SPEC = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_FEED_REMOVE_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.SEP_0 = New System.Windows.Forms.ToolStripSeparator()
Me.MENU_DOWN = New System.Windows.Forms.ToolStripDropDownButton()
Me.BTT_DOWN_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_DOWN_SELECTED = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.BTT_CLEAR = New System.Windows.Forms.ToolStripButton()
Me.TP_DATA = New System.Windows.Forms.TableLayoutPanel()
Me.BTT_FEED_CLEAR_FAV = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_FEED_CLEAR_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_CLEAR_SPEC = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_FEED_CLEAR_SPEC = New System.Windows.Forms.ToolStripMenuItem()
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.SEP_0 = New System.Windows.Forms.ToolStripSeparator()
Me.MENU_DOWN = New System.Windows.Forms.ToolStripDropDownButton()
Me.BTT_DOWN_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_DOWN_SELECTED = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.TP_DATA = New System.Windows.Forms.TableLayoutPanel()
SEP_1 = New System.Windows.Forms.ToolStripSeparator() SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator() SEP_2 = New System.Windows.Forms.ToolStripSeparator()
MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton() MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton()
@@ -62,6 +64,7 @@ Namespace DownloadObjects
MENU_LOAD_SEP_2 = New System.Windows.Forms.ToolStripSeparator() MENU_LOAD_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_3 = New System.Windows.Forms.ToolStripSeparator() MENU_LOAD_SEP_3 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_4 = New System.Windows.Forms.ToolStripSeparator() MENU_LOAD_SEP_4 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_5 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout() Me.ToolbarTOP.SuspendLayout()
Me.SuspendLayout() Me.SuspendLayout()
' '
@@ -112,10 +115,20 @@ Namespace DownloadObjects
MENU_LOAD_SEP_3.Name = "MENU_LOAD_SEP_3" MENU_LOAD_SEP_3.Name = "MENU_LOAD_SEP_3"
MENU_LOAD_SEP_3.Size = New System.Drawing.Size(264, 6) MENU_LOAD_SEP_3.Size = New System.Drawing.Size(264, 6)
' '
'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_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
Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.MENU_LOAD_SESSION, Me.SEP_0, MENU_VIEW, SEP_1, Me.MENU_DOWN, Me.BTT_REFRESH, Me.BTT_CLEAR, SEP_2}) Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.MENU_LOAD_SESSION, Me.SEP_0, MENU_VIEW, SEP_1, Me.MENU_DOWN, Me.BTT_REFRESH, SEP_2})
Me.ToolbarTOP.Location = New System.Drawing.Point(0, 0) Me.ToolbarTOP.Location = New System.Drawing.Point(0, 0)
Me.ToolbarTOP.Name = "ToolbarTOP" Me.ToolbarTOP.Name = "ToolbarTOP"
Me.ToolbarTOP.Size = New System.Drawing.Size(484, 25) Me.ToolbarTOP.Size = New System.Drawing.Size(484, 25)
@@ -124,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}) 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"
@@ -194,6 +207,59 @@ Namespace DownloadObjects
Me.BTT_FEED_REMOVE_SPEC.Size = New System.Drawing.Size(267, 22) Me.BTT_FEED_REMOVE_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_REMOVE_SPEC.Text = "Remove checked from special feed..." Me.BTT_FEED_REMOVE_SPEC.Text = "Remove checked from special feed..."
' '
'BTT_FEED_CLEAR_FAV
'
Me.BTT_FEED_CLEAR_FAV.Image = Global.SCrawler.My.Resources.Resources.BrushToolPic_16
Me.BTT_FEED_CLEAR_FAV.Name = "BTT_FEED_CLEAR_FAV"
Me.BTT_FEED_CLEAR_FAV.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_CLEAR_FAV.Text = "Clear Favorite"
'
'BTT_FEED_CLEAR_SPEC
'
Me.BTT_FEED_CLEAR_SPEC.Image = Global.SCrawler.My.Resources.Resources.BrushToolPic_16
Me.BTT_FEED_CLEAR_SPEC.Name = "BTT_FEED_CLEAR_SPEC"
Me.BTT_FEED_CLEAR_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_CLEAR_SPEC.Text = "Clear special feed..."
'
'BTT_FEED_DELETE_SPEC
'
Me.BTT_FEED_DELETE_SPEC.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_SPEC.Name = "BTT_FEED_DELETE_SPEC"
Me.BTT_FEED_DELETE_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_SPEC.Text = "Delete special feed..."
'
'BTT_FEED_DELETE_DAILY_LIST
'
Me.BTT_FEED_DELETE_DAILY_LIST.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_DAILY_LIST.Name = "BTT_FEED_DELETE_DAILY_LIST"
Me.BTT_FEED_DELETE_DAILY_LIST.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_DAILY_LIST.Text = "Delete daily feed (by list)"
'
'BTT_FEED_DELETE_DAILY_DATE
'
Me.BTT_FEED_DELETE_DAILY_DATE.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_DAILY_DATE.Name = "BTT_FEED_DELETE_DAILY_DATE"
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
Me.BTT_CLEAR_DAILY.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR_DAILY.Name = "BTT_CLEAR_DAILY"
Me.BTT_CLEAR_DAILY.Size = New System.Drawing.Size(267, 22)
Me.BTT_CLEAR_DAILY.Text = "Clear session"
Me.BTT_CLEAR_DAILY.ToolTipText = "Clear data list (session)"
'
'SEP_0 'SEP_0
' '
Me.SEP_0.Name = "SEP_0" Me.SEP_0.Name = "SEP_0"
@@ -235,15 +301,6 @@ Namespace DownloadObjects
Me.BTT_REFRESH.Text = "Refresh" Me.BTT_REFRESH.Text = "Refresh"
Me.BTT_REFRESH.ToolTipText = "Refresh data list" Me.BTT_REFRESH.ToolTipText = "Refresh data list"
' '
'BTT_CLEAR
'
Me.BTT_CLEAR.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_CLEAR.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR.Name = "BTT_CLEAR"
Me.BTT_CLEAR.Size = New System.Drawing.Size(54, 22)
Me.BTT_CLEAR.Text = "Clear"
Me.BTT_CLEAR.ToolTipText = "Clear data list"
'
'TP_DATA 'TP_DATA
' '
Me.TP_DATA.AutoScroll = True Me.TP_DATA.AutoScroll = True
@@ -269,46 +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_4
'
MENU_LOAD_SEP_4.Name = "MENU_LOAD_SEP_4"
MENU_LOAD_SEP_4.Size = New System.Drawing.Size(264, 6)
'
'BTT_FEED_CLEAR_FAV
'
Me.BTT_FEED_CLEAR_FAV.Image = Global.SCrawler.My.Resources.Resources.BrushToolPic_16
Me.BTT_FEED_CLEAR_FAV.Name = "BTT_FEED_CLEAR_FAV"
Me.BTT_FEED_CLEAR_FAV.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_CLEAR_FAV.Text = "Clear Favorite"
'
'BTT_FEED_CLEAR_SPEC
'
Me.BTT_FEED_CLEAR_SPEC.Image = Global.SCrawler.My.Resources.Resources.BrushToolPic_16
Me.BTT_FEED_CLEAR_SPEC.Name = "BTT_FEED_CLEAR_SPEC"
Me.BTT_FEED_CLEAR_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_CLEAR_SPEC.Text = "Clear special feed..."
'
'BTT_FEED_DELETE_SPEC
'
Me.BTT_FEED_DELETE_SPEC.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_SPEC.Name = "BTT_FEED_DELETE_SPEC"
Me.BTT_FEED_DELETE_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_SPEC.Text = "Delete special feed..."
'
'BTT_FEED_DELETE_DAILY_LIST
'
Me.BTT_FEED_DELETE_DAILY_LIST.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_DAILY_LIST.Name = "BTT_FEED_DELETE_DAILY_LIST"
Me.BTT_FEED_DELETE_DAILY_LIST.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_DAILY_LIST.Text = "Delete daily feed (by list)"
'
'BTT_FEED_DELETE_DAILY_DATE
'
Me.BTT_FEED_DELETE_DAILY_DATE.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_DAILY_DATE.Name = "BTT_FEED_DELETE_DAILY_DATE"
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)"
'
'DownloadFeedForm 'DownloadFeedForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -330,7 +347,7 @@ Namespace DownloadObjects
End Sub End Sub
Private WithEvents BTT_REFRESH As ToolStripButton Private WithEvents BTT_REFRESH As ToolStripButton
Private WithEvents BTT_CLEAR As ToolStripButton Private WithEvents BTT_CLEAR_DAILY As ToolStripMenuItem
Private WithEvents MENU_LOAD_SESSION As ToolStripDropDownButton Private WithEvents MENU_LOAD_SESSION As ToolStripDropDownButton
Private WithEvents BTT_LOAD_SESSION_LAST As ToolStripMenuItem Private WithEvents BTT_LOAD_SESSION_LAST As ToolStripMenuItem
Private WithEvents BTT_LOAD_SESSION_CHOOSE As ToolStripMenuItem Private WithEvents BTT_LOAD_SESSION_CHOOSE As ToolStripMenuItem
@@ -354,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

@@ -144,10 +144,13 @@
<metadata name="MENU_LOAD_SEP_3.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> <metadata name="MENU_LOAD_SEP_3.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_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="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> </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()
@@ -105,7 +106,7 @@ Namespace DownloadObjects
Private Sub DownloadFeedForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed Private Sub DownloadFeedForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
ClearTable() ClearTable()
MyRange.Dispose() MyRange.Dispose()
BTT_CLEAR.Dispose() BTT_CLEAR_DAILY.Dispose()
DataList.Clear() DataList.Clear()
End Sub End Sub
Private Sub DownloadFeedForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown Private Sub DownloadFeedForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
@@ -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()
@@ -414,7 +421,7 @@ Namespace DownloadObjects
Private Sub BTT_FEED_ADD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_SPEC.Click Private Sub BTT_FEED_ADD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_SPEC.Click
Dim c As IEnumerable(Of UserMediaD) = GetCheckedMedia() Dim c As IEnumerable(Of UserMediaD) = GetCheckedMedia()
If c.ListExists Then If c.ListExists Then
With FeedSpecialCollection.ChooseFeeds(False) With FeedSpecialCollection.ChooseFeeds(True)
If .ListExists Then .ForEach(Sub(f) f.Add(c)) If .ListExists Then .ForEach(Sub(f) f.Add(c))
End With End With
Else Else
@@ -518,6 +525,77 @@ Namespace DownloadObjects
End Try End Try
End Sub End Sub
#End Region #End Region
#Region "Clear session"
Private Sub BTT_CLEAR_DAILY_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DAILY.Click
If MsgBoxE({"Are you sure you want to clear this session data?", "Clear session"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
Downloader.Files.Clear()
ClearTable()
RefillList()
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 #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
@@ -544,11 +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
RefillList() IsSession = True
End Sub
Private Sub BTT_CLEAR_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR.Click
Downloader.Files.Clear()
ClearTable()
RefillList() RefillList()
End Sub End Sub
#End Region #End Region
@@ -759,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

@@ -139,6 +139,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_FEED_SHOW = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_TRAY_FEED_SHOW = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CHANNELS = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_TRAY_CHANNELS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_DOWNLOADER = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_TRAY_DOWNLOADER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_SCHEDULER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_SHOW_HIDE = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_TRAY_SHOW_HIDE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_TRAY_CLOSE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_TRAY_CLOSE_NO_SCRIPT = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_TRAY_CLOSE_NO_SCRIPT = New System.Windows.Forms.ToolStripMenuItem()
@@ -987,9 +988,9 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
' '
'TRAY_CONTEXT 'TRAY_CONTEXT
' '
Me.TRAY_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_TRAY_PAUSE_AUTOMATION, Me.BTT_TRAY_SILENT_MODE, Me.BTT_TRAY_FEED_SHOW, Me.BTT_TRAY_CHANNELS, Me.BTT_TRAY_DOWNLOADER, TRAY_SEP_1, Me.BTT_TRAY_SHOW_HIDE, TRAY_SEP_2, Me.BTT_TRAY_CLOSE, Me.BTT_TRAY_CLOSE_NO_SCRIPT}) Me.TRAY_CONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_TRAY_PAUSE_AUTOMATION, Me.BTT_TRAY_SILENT_MODE, Me.BTT_TRAY_FEED_SHOW, Me.BTT_TRAY_CHANNELS, Me.BTT_TRAY_DOWNLOADER, Me.BTT_TRAY_SCHEDULER, TRAY_SEP_1, Me.BTT_TRAY_SHOW_HIDE, TRAY_SEP_2, Me.BTT_TRAY_CLOSE, Me.BTT_TRAY_CLOSE_NO_SCRIPT})
Me.TRAY_CONTEXT.Name = "TRAY_CONTEXT" Me.TRAY_CONTEXT.Name = "TRAY_CONTEXT"
Me.TRAY_CONTEXT.Size = New System.Drawing.Size(171, 192) Me.TRAY_CONTEXT.Size = New System.Drawing.Size(171, 214)
' '
'BTT_TRAY_PAUSE_AUTOMATION 'BTT_TRAY_PAUSE_AUTOMATION
' '
@@ -1032,6 +1033,13 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_TRAY_DOWNLOADER.Size = New System.Drawing.Size(170, 22) Me.BTT_TRAY_DOWNLOADER.Size = New System.Drawing.Size(170, 22)
Me.BTT_TRAY_DOWNLOADER.Text = "Downloader" Me.BTT_TRAY_DOWNLOADER.Text = "Downloader"
' '
'BTT_TRAY_SCHEDULER
'
Me.BTT_TRAY_SCHEDULER.Image = Global.SCrawler.My.Resources.Resources.ScriptPic_32
Me.BTT_TRAY_SCHEDULER.Name = "BTT_TRAY_SCHEDULER"
Me.BTT_TRAY_SCHEDULER.Size = New System.Drawing.Size(170, 22)
Me.BTT_TRAY_SCHEDULER.Text = "Scheduler"
'
'BTT_TRAY_SHOW_HIDE 'BTT_TRAY_SHOW_HIDE
' '
Me.BTT_TRAY_SHOW_HIDE.Image = Global.SCrawler.My.Resources.Resources.ApplicationPic_16 Me.BTT_TRAY_SHOW_HIDE.Image = Global.SCrawler.My.Resources.Resources.ApplicationPic_16
@@ -1181,4 +1189,5 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Private WithEvents MENU_INFO_SHOW_QUEUE As ToolStripMenuItem Private WithEvents MENU_INFO_SHOW_QUEUE As ToolStripMenuItem
Private WithEvents BTT_DOWN_SPEC As ToolStripKeyMenuItem Private WithEvents BTT_DOWN_SPEC As ToolStripKeyMenuItem
Private WithEvents BTT_SHOW_FILTER_ADV As ToolStripMenuItem Private WithEvents BTT_SHOW_FILTER_ADV As ToolStripMenuItem
Private WithEvents BTT_TRAY_SCHEDULER As ToolStripMenuItem
End Class End Class

View File

@@ -603,7 +603,7 @@ CloseResume:
ControlInvokeFast(Toolbar_TOP, BTT_DOWN_AUTOMATION_PAUSE, Sub() BTT_DOWN_AUTOMATION_PAUSE.Visible = b) ControlInvokeFast(Toolbar_TOP, BTT_DOWN_AUTOMATION_PAUSE, Sub() BTT_DOWN_AUTOMATION_PAUSE.Visible = b)
ControlInvokeFast(Me, Sub() BTT_TRAY_PAUSE_AUTOMATION.Visible = b) ControlInvokeFast(Me, Sub() BTT_TRAY_PAUSE_AUTOMATION.Visible = b)
End Sub End Sub
Private Async Sub BTT_DOWN_AUTOMATION_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION.Click Private Async Sub BTT_DOWN_AUTOMATION_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION.Click, BTT_TRAY_SCHEDULER.Click
Try Try
Using f As New SchedulerEditorForm : f.ShowDialog() : End Using Using f As New SchedulerEditorForm : f.ShowDialog() : End Using
Await Settings.Automation.Start(False) Await Settings.Automation.Start(False)

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("2023.12.27.0")> <Assembly: AssemblyVersion("2024.1.18.0")>
<Assembly: AssemblyFileVersion("2023.12.27.0")> <Assembly: AssemblyFileVersion("2024.1.18.0")>
<Assembly: NeutralResourcesLanguage("en")> <Assembly: NeutralResourcesLanguage("en")>