From d99243ce465befbec968ac0dd2b24484d719be30 Mon Sep 17 00:00:00 2001 From: Andy <88590076+AAndyProgram@users.noreply.github.com> Date: Tue, 5 Dec 2023 12:05:20 +0300 Subject: [PATCH] 2023.12.5.0 YT VideoListForm: add a check of adding a URL if it has already been downloaded ('ValidateContainerURL') YouTubeMediaContainerBase: add 'GetUrls' and 'GetFiles' functions; make 'Files' protected friend; update 'CreateUrlFile' function SCrawler Add downloaded saved posts to the feed API.ProfileSaved: add token verification for multi-acc API.SiteSettingsBase: update 'UpdateResponserFile' and 'CLONE_PROPERTIES.filterUC' functions API.UserDataBase: add a null host check before request a new key; update 'OpenFolder' function (for saved posts) API.YouTube: add the ability to download YouTube user community feeds DownloadProgress: add 'KeyClickEventArgs' to download saved posts excluding from feed; add 'FeedFilesChanged' event; update 'Start' function DownloadSavedPostsForm: add 'FeedFilesChanged' event and handler; update 'Start' function Feed.FeedMedia: make the class compatible to work with saved posts StandaloneDownloader.VideoDownloaderForm: add a check of adding a URL if it has already been downloaded ('ValidateContainerURL') TDownloader: add the 'IsSavedPosts' field to the 'UserMediaD' structure; update 'UserMediaD.New(EContainer)' function (for saved posts); update 'UserMediaD.ToEContainer' function; add 'SessionSavedPosts' property MainFrame: add 'Alt+A' hotkey to show scheduler; add 'Alt+P' hotkey to show progress form Hosts.DownloadableMediaHost: add URL file to files list --- SCrawler.YouTube/Downloader/VideoListForm.vb | 57 ++++- .../Objects/YouTubeMediaContainerBase.vb | 19 +- SCrawler/API/Base/ProfileSaved.vb | 33 ++- SCrawler/API/Base/SiteSettingsBase.vb | 4 +- SCrawler/API/Base/UserDataBase.vb | 3 +- SCrawler/API/YouTube/SiteSettings.vb | 6 + SCrawler/API/YouTube/UserData.vb | 217 +++++++++++++++++- SCrawler/API/YouTube/UserExchangeOptions.vb | 11 + SCrawler/Download/DownloadProgress.vb | 21 +- .../DownloadSavedPostsForm.Designer.vb | 4 +- SCrawler/Download/DownloadSavedPostsForm.resx | 14 +- SCrawler/Download/DownloadSavedPostsForm.vb | 17 +- SCrawler/Download/Feed/FeedMedia.vb | 50 +++- .../STDownloader/VideoDownloaderForm.vb | 4 +- SCrawler/Download/TDownloader.vb | 46 +++- SCrawler/MainFrame.vb | 32 ++- SCrawler/MyProgressExt.vb | 2 +- .../Hosts/DownloadableMediaHost.vb | 5 +- 18 files changed, 497 insertions(+), 48 deletions(-) diff --git a/SCrawler.YouTube/Downloader/VideoListForm.vb b/SCrawler.YouTube/Downloader/VideoListForm.vb index 963f707..72dcc25 100644 --- a/SCrawler.YouTube/Downloader/VideoListForm.vb +++ b/SCrawler.YouTube/Downloader/VideoListForm.vb @@ -326,7 +326,7 @@ Namespace DownloadObjects.STDownloader If Not f Is Nothing Then If TypeOf f Is IDesignXMLContainer Then DirectCast(f, IDesignXMLContainer).DesignXML = DesignXML f.ShowDialog() - If f.DialogResult = DialogResult.OK Then ControlCreateAndAdd(c, disableDown) + If f.DialogResult = DialogResult.OK AndAlso ValidateContainerURL(c) Then ControlCreateAndAdd(c, disableDown) f.Dispose() End If End If @@ -340,6 +340,61 @@ Namespace DownloadObjects.STDownloader If Not pForm Is Nothing Then pForm.Dispose() End Try End Sub + Protected Function ValidateContainerURL(ByVal c As IYouTubeMediaContainer) As Boolean + Try + If Not c Is Nothing AndAlso Not c.IsMusic Then + Dim urls As List(Of String) = Nothing + Dim files As List(Of SFile) = Nothing + Dim msg As New MMessage("The media file to be added is already downloaded. Do you want to download it again?", "Download media file", {"Process", "Cancel"}, vbExclamation) + If TP_CONTROLS.Controls.Count > 0 Then + With TP_CONTROLS.Controls.Cast(Of MediaItem) + urls.ListAddList(.SelectMany(Function(ByVal m As MediaItem) As IEnumerable(Of String) + If Not m.MyContainer Is Nothing Then + Return DirectCast(m.MyContainer, YouTubeMediaContainerBase).GetUrls() + Else + Return New String() {} + End If + End Function), LAP.NotContainsOnly, EDP.ReturnValue) + files.ListAddList(.SelectMany(Function(ByVal m As MediaItem) As IEnumerable(Of SFile) + If Not m.MyContainer Is Nothing Then + Return DirectCast(m.MyContainer, YouTubeMediaContainerBase).GetFiles() + Else + Return New SFile() {} + End If + End Function), LAP.NotContainsOnly, EDP.ReturnValue) + End With + End If + If urls.ListExists Then + Dim cUrls As New List(Of String) + cUrls.ListAddList({c.URL, c.URL_BASE}, LAP.NotContainsOnly) + If urls.ListContains(cUrls) Then Return msg.Show = 0 + End If + If files.ListExists And Not c.File.IsEmptyString Then Return Not files.Contains(c.File) OrElse msg.Show = 0 + If c.ObjectType = YouTubeMediaType.Single AndAlso c.File.Exists Then + Dim callBack As MsgBoxButtonCallBack = Sub(r, m, b) + Dim __sfo As SFO = IIf(r.Button.CallBackObject = 0, SFO.File, SFO.Path) + If __sfo = SFO.File Then + c.File.Open(__sfo) + Else + GlobalOpenPath(c.File) + End If + End Sub + Return MsgBoxE(New MMessage("The following file already exists at the destination." & vbCr & + "Do you want to download it again?" & vbCr & vbCr & + $"File: {c.File}", "Download media file", + {"Process", + New MsgBoxButton("Open file") With {.IsDialogResultButton = False, .CallBackObject = 0, .CallBack = callBack}, + New MsgBoxButton("Open folder") With {.IsDialogResultButton = False, .CallBackObject = 1, .CallBack = callBack}, + "Cancel"}, vbExclamation) With {.ButtonsPerRow = 4}) = 0 + End If + urls.ListClearDispose + files.ListClearDispose + End If + Return True + Catch ex As Exception + Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[VideoListForm.ValidateContainerURL]", True) + End Try + End Function Private Sub BTT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_DOWN.Click With TP_CONTROLS If .Controls.Count > 0 Then diff --git a/SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb b/SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb index 616852b..39d0834 100644 --- a/SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb +++ b/SCrawler.YouTube/Objects/YouTubeMediaContainerBase.vb @@ -496,6 +496,12 @@ Namespace API.YouTube.Objects _IUserMedia_URL_BASE = u End Set End Property + Friend Function GetUrls() As IEnumerable(Of String) + Dim urls As New List(Of String) + urls.ListAddList({URL, IUserMedia_URL_BASE}, LAP.NotContainsOnly) + If HasElements And Not IsMusic Then urls.ListAddList(Elements.SelectMany(Function(elem As YouTubeMediaContainerBase) elem.GetUrls()), LAP.NotContainsOnly) + Return urls + End Function Protected Overridable Sub GenerateFileName() End Sub Protected Function GetPlayListTitle() As String @@ -531,7 +537,7 @@ Namespace API.YouTube.Objects If ObjectType = YouTubeMediaType.Single AndAlso Not GetPlayListTitle.IsEmptyString Then _SpecialPath.StringAppend(GetPlayListTitle(), "\") If Elements.Count > 0 Then Elements.ForEach(Sub(e) e.SpecialFolder = Path) End Sub - Friend ReadOnly Property Files As List(Of SFile) Implements IYouTubeMediaContainer.Files + Protected Friend ReadOnly Property Files As List(Of SFile) Implements IYouTubeMediaContainer.Files Protected _File As SFile Protected Friend Property FileSetManually As Boolean = False Public Property FileIgnorePlaylist As Boolean = False @@ -591,6 +597,11 @@ Namespace API.YouTube.Objects File = f End Set End Property + Friend Function GetFiles() As IEnumerable(Of SFile) + Dim urls As New List(Of String)({File}) + If HasElements And Not IsMusic Then urls.ListAddList(Elements.SelectMany(Function(elem As YouTubeMediaContainerBase) elem.GetFiles()), LAP.NotContainsOnly) + Return urls + End Function #End Region #Region "Command" Public Property UseCookies As Boolean = MyYouTubeSettings.DefaultUseCookies Implements IYouTubeMediaContainer.UseCookies @@ -725,7 +736,7 @@ Namespace API.YouTube.Objects End Sub #End Region #Region "Download" - Protected Shared Sub CreateUrlFile(ByVal URL As String, ByVal File As SFile) + Protected Shared Function CreateUrlFile(ByVal URL As String, ByVal File As SFile) As SFile Try File.Extension = "url" Using t As New TextSaver(File) @@ -735,9 +746,11 @@ Namespace API.YouTube.Objects t.AppendLine() t.Save(EDP.None) End Using + Return File Catch ex As Exception + Return Nothing End Try - End Sub + End Function Private ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue) Public Property Progress As MyProgress Implements IYouTubeMediaContainer.Progress Private Property IDownloadableMedia_Progress As Object Implements IDownloadableMedia.Progress diff --git a/SCrawler/API/Base/ProfileSaved.vb b/SCrawler/API/Base/ProfileSaved.vb index 52d6015..3b1658b 100644 --- a/SCrawler/API/Base/ProfileSaved.vb +++ b/SCrawler/API/Base/ProfileSaved.vb @@ -10,12 +10,21 @@ Imports System.Threading Imports SCrawler.Plugin.Hosts Imports PersonalUtilities.Forms.Toolbars Imports PDownload = SCrawler.Plugin.ISiteSettings.Download +Imports UserMediaD = SCrawler.DownloadObjects.TDownloader.UserMediaD Namespace API.Base Friend NotInheritable Class ProfileSaved Private ReadOnly Property HOST As SettingsHostCollection Private ReadOnly Property Progress As MyProgress Private _Unavailable As Integer, _NotReady As Integer, _ErrorCount As Integer Private _TotalImages As Integer, _TotalVideos As Integer + Friend Property Session As Integer + Friend Property IncludeInTheFeed As Boolean = False + Private _FeedDataExists As Boolean = False + Friend ReadOnly Property FeedDataExists As Boolean + Get + Return _FeedDataExists + End Get + End Property Friend Sub New(ByRef h As SettingsHostCollection, ByRef Bar As MyProgress) HOST = h Progress = Bar @@ -23,6 +32,7 @@ Namespace API.Base Friend Overloads Sub Download(ByVal Token As CancellationToken, ByVal Multiple As Boolean) Dim n% = 0 Dim c% = HOST.Sum(Function(h) IIf(h.DownloadSavedPosts, 1, 0)) + _FeedDataExists = False _Unavailable = 0 _NotReady = 0 _ErrorCount = 0 @@ -30,7 +40,7 @@ Namespace API.Base _TotalVideos = 0 If c > 0 Then For i% = 0 To HOST.Count - 1 - If HOST(i).DownloadSavedPosts Then n += 1 : Download(HOST(i), n, c, Token, Multiple) + If Not Token.IsCancellationRequested And HOST(i).DownloadSavedPosts Then n += 1 : Download(HOST(i), n, c, Token, Multiple) Next If c > 1 Then Dim s% = {_Unavailable, _NotReady, _ErrorCount}.Sum @@ -55,13 +65,19 @@ Namespace API.Base .LoadUserInformation() .Progress = Progress If Not .FileExists Then .UpdateUserInformation() + .IncludeInTheFeed = IncludeInTheFeed + + Host.BeforeStartDownload(.Self, PDownload.SavedPosts) + .DownloadData(Token) + _TotalImages += .DownloadedPictures(False) + _TotalVideos += .DownloadedVideos(False) + If IncludeInTheFeed And .LatestData.Count > 0 Then + _FeedDataExists = True + Downloader.Files.AddRange(.LatestData.Select(Function(m) New UserMediaD(m, .Self, Session) With {.IsSavedPosts = True})) + End If + Progress.InformationTemporary = $"{Host.Name}{aStr} Images: { .DownloadedPictures(False)}; Videos: { .DownloadedVideos(False)}" + Host.AfterDownload(.Self, PDownload.SavedPosts) End With - Host.BeforeStartDownload(user, PDownload.SavedPosts) - user.DownloadData(Token) - _TotalImages += user.DownloadedPictures(False) - _TotalVideos += user.DownloadedVideos(False) - Progress.InformationTemporary = $"{Host.Name}{aStr} Images: {user.DownloadedPictures(False)}; Videos: {user.DownloadedVideos(False)}" - Host.AfterDownload(user, PDownload.SavedPosts) End If End Using Else @@ -72,6 +88,9 @@ Namespace API.Base _NotReady += 1 Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is not ready" End If + Catch oex As OperationCanceledException When Token.IsCancellationRequested + _ErrorCount += 1 + Progress.InformationTemporary = $"{Host.Name}{aStr} downloading canceled" Catch ex As Exception _ErrorCount += 1 Progress.InformationTemporary = $"{Host.Name}{aStr} downloading error" diff --git a/SCrawler/API/Base/SiteSettingsBase.vb b/SCrawler/API/Base/SiteSettingsBase.vb index e71009a..cfe824b 100644 --- a/SCrawler/API/Base/SiteSettingsBase.vb +++ b/SCrawler/API/Base/SiteSettingsBase.vb @@ -84,7 +84,7 @@ Namespace API.Base Set : End Set End Property Protected Sub UpdateResponserFile() - Dim acc$ = If(Not AccountName.IsEmptyString, $"_{AccountName}", String.Empty) + Dim acc$ = If(AccountName.IsEmptyString OrElse AccountName = Hosts.SettingsHost.NameAccountNameDefault, String.Empty, $"_{AccountName}") Responser.File = $"{SettingsFolderName}\Responser_{Site}{acc}.xml" _CookiesNetscapeFile = Responser.File _CookiesNetscapeFile.Name &= "_Cookies_Netscape" @@ -285,7 +285,7 @@ Namespace API.Base '1 = clone '2 = any Dim filterUC As Func(Of MemberInfo, Byte, Boolean) = Function(ByVal m As MemberInfo, ByVal __mode As Byte) As Boolean - If m.GetCustomAttribute(Of DoNotUse) Is Nothing Then + If If(m.GetCustomAttribute(Of DoNotUse)?.Value, False) Then Return False Else With m.GetCustomAttribute(Of PClonableAttribute) diff --git a/SCrawler/API/Base/UserDataBase.vb b/SCrawler/API/Base/UserDataBase.vb index e6910eb..c6d06d5 100644 --- a/SCrawler/API/Base/UserDataBase.vb +++ b/SCrawler/API/Base/UserDataBase.vb @@ -202,7 +202,7 @@ Namespace API.Base End Get Set(ByVal h As SettingsHost) _HOST = h - _HostKey = h.Key + If Not h Is Nothing Then _HostKey = h.Key End Set End Property Private Sub ResetHost() @@ -1079,6 +1079,7 @@ BlockNullPicture: End Try End Sub Friend Overridable Sub OpenFolder() Implements IUserData.OpenFolder + If MyFile.IsEmptyString And IsSavedPosts Then UpdateDataFiles() GlobalOpenPath(MyFile.CutPath) End Sub #End Region diff --git a/SCrawler/API/YouTube/SiteSettings.vb b/SCrawler/API/YouTube/SiteSettings.vb index a3d96b9..f2dcee0 100644 --- a/SCrawler/API/YouTube/SiteSettings.vb +++ b/SCrawler/API/YouTube/SiteSettings.vb @@ -20,6 +20,10 @@ Namespace API.YouTube Friend ReadOnly Property DownloadShorts As PropertyValue Friend ReadOnly Property DownloadPlaylists As PropertyValue + + Friend ReadOnly Property DownloadCommunityImages As PropertyValue + + Friend ReadOnly Property DownloadCommunityVideos As PropertyValue Friend ReadOnly Property UseCookies As PropertyValue #End Region @@ -30,6 +34,8 @@ Namespace API.YouTube DownloadVideos = New PropertyValue(True) DownloadShorts = New PropertyValue(False) DownloadPlaylists = New PropertyValue(False) + DownloadCommunityImages = New PropertyValue(False) + DownloadCommunityVideos = New PropertyValue(False) UseCookies = New PropertyValue(False) _SubscriptionsAllowed = True UseNetscapeCookies = True diff --git a/SCrawler/API/YouTube/UserData.vb b/SCrawler/API/YouTube/UserData.vb index 7a7ffc8..697d6ee 100644 --- a/SCrawler/API/YouTube/UserData.vb +++ b/SCrawler/API/YouTube/UserData.vb @@ -11,16 +11,23 @@ Imports SCrawler.API.Base Imports SCrawler.API.YouTube.Base Imports SCrawler.API.YouTube.Objects Imports PersonalUtilities.Functions.XML +Imports PersonalUtilities.Functions.RegularExpressions +Imports PersonalUtilities.Tools.Web.Clients +Imports PersonalUtilities.Tools.Web.Documents.JSON +Imports UTypes = SCrawler.API.Base.UserMedia.Types Namespace API.YouTube Friend Class UserData : Inherits UserDataBase #Region "XML names" Private Const Name_DownloadYTVideos As String = "YTDownloadVideos" Private Const Name_DownloadYTShorts As String = "YTDownloadShorts" Private Const Name_DownloadYTPlaylists As String = "YTDownloadPlaylists" + Private Const Name_DownloadYTCommunityImages As String = "YTDownloadCommunityImages" + Private Const Name_DownloadYTCommunityVideos As String = "YTDownloadCommunityVideos" Private Const Name_YTUseCookies As String = "YTUseCookies" Private Const Name_IsMusic As String = "YTIsMusic" Private Const Name_IsChannelUser As String = "YTIsChannelUser" Private Const Name_YTMediaType As String = "YTMediaType" + Private Const Name_ChannelID As String = "ChannelID" Private Const Name_LastDownloadDateVideos As String = "YTLastDownloadDateVideos" Private Const Name_LastDownloadDateShorts As String = "YTLastDownloadDateShorts" Private Const Name_LastDownloadDatePlaylist As String = "YTLastDownloadDatePlaylist" @@ -29,6 +36,9 @@ Namespace API.YouTube Friend Property DownloadYTVideos As Boolean = True Friend Property DownloadYTShorts As Boolean = False Friend Property DownloadYTPlaylists As Boolean = False + Friend Property DownloadYTCommunityImages As Boolean = False + Friend Property DownloadYTCommunityVideos As Boolean = False + Friend Property ChannelID As String = String.Empty Friend Property YTUseCookies As Boolean = False Friend Property IsMusic As Boolean = False Friend Property IsChannelUser As Boolean = False @@ -70,6 +80,9 @@ Namespace API.YouTube DownloadYTVideos = .Value(Name_DownloadYTVideos).FromXML(Of Boolean)(True) DownloadYTShorts = .Value(Name_DownloadYTShorts).FromXML(Of Boolean)(False) DownloadYTPlaylists = .Value(Name_DownloadYTPlaylists).FromXML(Of Boolean)(False) + DownloadYTCommunityImages = .Value(Name_DownloadYTCommunityImages).FromXML(Of Boolean)(False) + DownloadYTCommunityVideos = .Value(Name_DownloadYTCommunityVideos).FromXML(Of Boolean)(False) + ChannelID = .Value(Name_ChannelID) IsMusic = .Value(Name_IsMusic).FromXML(Of Boolean)(False) IsChannelUser = .Value(Name_IsChannelUser).FromXML(Of Boolean)(False) YTMediaType = .Value(Name_YTMediaType).FromXML(Of Integer)(YouTubeMediaType.Undefined) @@ -83,6 +96,9 @@ Namespace API.YouTube .Add(Name_DownloadYTVideos, DownloadYTVideos.BoolToInteger) .Add(Name_DownloadYTShorts, DownloadYTShorts.BoolToInteger) .Add(Name_DownloadYTPlaylists, DownloadYTPlaylists.BoolToInteger) + .Add(Name_DownloadYTCommunityImages, DownloadYTCommunityImages.BoolToInteger) + .Add(Name_DownloadYTCommunityVideos, DownloadYTCommunityVideos.BoolToInteger) + .Add(Name_ChannelID, ChannelID) .Add(Name_IsMusic, IsMusic.BoolToInteger) .Add(Name_IsChannelUser, IsChannelUser.BoolToInteger) .Add(Name_YTMediaType, CInt(YTMediaType)) @@ -103,7 +119,10 @@ Namespace API.YouTube DownloadYTVideos = .DownloadVideos DownloadYTShorts = .DownloadShorts DownloadYTPlaylists = .DownloadPlaylists + DownloadYTCommunityImages = .DownloadCommunityImages + DownloadYTCommunityVideos = .DownloadCommunityVideos YTUseCookies = .UseCookies + ChannelID = .ChannelID End With End If End Sub @@ -184,6 +203,7 @@ Namespace API.YouTube applySpecFolder.Invoke("Playlists", True) If fillList.Invoke(LastDownloadDatePlaylist) Then LastDownloadDatePlaylist = If(maxDate, Now) End If + If Not IsMusic And (DownloadYTCommunityImages Or DownloadYTCommunityVideos) Then DownloadCommunity(String.Empty, Token) Else Throw New InvalidOperationException($"Media type {YTMediaType} not implemented") End If @@ -203,10 +223,201 @@ Namespace API.YouTube pr.Dispose() End Try End Sub + Private Sub DownloadCommunity(ByVal Cursor As String, ByVal Token As CancellationToken, Optional ByVal Round As Integer = 0) + Dim URL$ = String.Empty + Try + Const postIdTemp$ = "Community_{0}" + Const specFolder$ = "Community" + Dim nextToken$ = String.Empty + Dim postId$ = String.Empty, videoId$ = String.Empty + Dim tmpPID$ + Dim imgCount%, imgNum% + Dim postUrl As Func(Of String) = Function() $"https://www.youtube.com/post/{postId}" + Dim image As EContainer, thumb As EContainer + Dim sl As New List(Of Sizes) + Dim m As UserMedia + Dim v As IYouTubeMediaContainer + + If ChannelID.IsEmptyString Then GetChannelID() + If ChannelID.IsEmptyString Then Throw New ArgumentNullException("ChannelID", "Channel ID cannot be null") + + URL = $"https://yt.lemnoslife.com/channels?part=community&id={ChannelID}" + If Not Cursor.IsEmptyString Then URL &= $"&pageToken={Cursor}" + + ProgressPre.ChangeMax(1) + + Using resp As New Responser + Dim r$ = resp.GetResponse(URL,, EDP.ReturnValue) + ProgressPre.Perform() + If Not r.IsEmptyString Then + Using j As EContainer = JsonDocument.Parse(r) + If j.ListExists Then + With j.ItemF({"items", 0}) + If .ListExists Then + nextToken = .Value("nextPageToken") + With .Item("community") + If .ListExists Then + ProgressPre.ChangeMax(.Count) + For Each jj As EContainer In .Self + With jj + postId = .Value("id") + videoId = .Value("videoId") + tmpPID = String.Format(postIdTemp, postId) + If Not _TempPostsList.Contains(tmpPID) Then _TempPostsList.Add(tmpPID) Else Exit Sub + + If Not videoId.IsEmptyString Then + If DownloadYTCommunityVideos Then + v = Nothing + Try : v = YouTubeFunctions.Parse($"https://www.youtube.com/watch?v={videoId}", YTUseCookies, Token) : Catch : End Try + If Not v Is Nothing Then + With DirectCast(v, YouTubeMediaContainerBase) + .SpecialPath = specFolder & "\Videos" + .SpecialPathDisabled = False + End With + _TempMediaList.ListAddValue(New UserMedia(v) With {.Post = postId}, LNC) + End If + End If + ElseIf DownloadYTCommunityImages Then + With .Item("images") + If .ListExists Then + imgCount = .Count + imgNum = 0 + For Each image In .Self + imgNum += 1 + sl.Clear() + With image("thumbnails") + If .ListExists Then + For Each thumb In .Self : sl.Add(New Sizes(thumb.Value("width"), thumb.Value("url"))) : Next + If sl.Count > 0 Then sl.RemoveAll(Function(s) s.HasError Or s.Data.IsEmptyString) + If sl.Count > 0 Then + sl.Sort() + m = New UserMedia(sl(0).Data, UTypes.Picture) With { + .URL_BASE = postUrl.Invoke, + .Post = postId, + .SpecialFolder = specFolder, + .File = $"{postId}{IIf(imgCount > 1, $"_{imgNum}", String.Empty)}.jpg" + } + _TempMediaList.Add(m) + End If + End If + End With + Next + End If + End With + End If + + ProgressPre.Perform() + End With + Next + End If + End With + End If + End With + End If + End Using + ElseIf resp.HasError Then + If resp.Status = Net.WebExceptionStatus.ConnectFailure And Round < 2 Then + Thread.Sleep(1000) + DownloadCommunity(Cursor, Token, Round + 1) + Else + Throw resp.ErrorException + End If + End If + End Using + + If Not nextToken.IsEmptyString Then DownloadCommunity(nextToken, Token) + Catch ex As Exception + ProcessException(ex, Token, "community data downloading error") + End Try + End Sub + Private Sub GetChannelID() + Try + Dim r$ = GetWebString(GetUserUrl,, EDP.ThrowException) + If Not r.IsEmptyString Then + Dim newUrl$ = RegexReplace(r, RParams.DMS("meta property=.og:url..content=.([^""]+)", 1, EDP.ReturnValue)) + If Not newUrl.IsEmptyString Then + Dim newID$ = String.Empty + YouTubeFunctions.Info_GetUrlType(newUrl,,,, newID) + If Not newID.IsEmptyString And Not ChannelID = newID Then ChannelID = newID : _ForceSaveUserInfo = True + End If + End If + Catch ex As Exception + ProcessException(ex, Nothing, "error getting channel ID") + End Try + End Sub Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) SeparateVideoFolder = False DownloadContentDefault(Token) End Sub + Private Class YTPreProgressContainer : Inherits PersonalUtilities.Forms.Toolbars.MyProgress + Private ReadOnly MyPreProgress As PreProgress + Friend Sub New(ByVal PR As PreProgress) + MyBase.New(PR.Progress.MyControls) + MyPreProgress = PR + End Sub + Private _MaxChanged As Boolean = False + Public Overrides Property Maximum As Double + Get + Return MyPreProgress.Progress.Maximum0 + End Get + Set(ByVal max As Double) + MyPreProgress.Progress.Maximum0 += max + _MaxChanged = True + End Set + End Property + Private _LastValue As Double = -1 + Private _FirstAdded As Boolean = False + Public Overrides Property Value As Double + Get + Return MyPreProgress.Progress.Value0 + End Get + Set(ByVal v As Double) + If _MaxChanged Then + If Not _FirstAdded Then + _FirstAdded = True + ElseIf v > 0 Then + Dim newValue# + If _LastValue = -1 Then + newValue = v + ElseIf _LastValue > v Then + newValue = v + Else + newValue = v - _LastValue + End If + _LastValue = v + MyPreProgress.Progress.Value0 += newValue + End If + End If + End Set + End Property + Public Overrides Sub Perform(Optional ByVal Value As Double = 1) + MyPreProgress.Perform(Value) + End Sub + Public Overrides Sub Reset() + MyPreProgress.Reset() + End Sub + Public Overrides Sub Done() + MyPreProgress.Done() + End Sub + Public Overrides Property Information As String + Get + Return String.Empty + End Get + Set : End Set + End Property + Public Overrides WriteOnly Property InformationTemporary(Optional ByVal AddPercentage As Boolean = False) As String + Set : End Set + End Property + Public Overrides Function GetLabelText() As String + Return String.Empty + End Function + Public Overrides Property Visible(Optional ByVal ProgressBar As Boolean = True, Optional ByVal Label As Boolean = True) As Boolean + Get + Return True + End Get + Set : End Set + End Property + End Class Protected Overrides Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile If Not Media.Object Is Nothing AndAlso TypeOf Media.Object Is IYouTubeMediaContainer Then @@ -215,13 +426,17 @@ Namespace API.YouTube f.Path = DestinationFile.Path If Not IsSingleObjectDownload And Not .FileIsPlaylistObject Then .FileIgnorePlaylist = True .File = f - If IsSingleObjectDownload Then .Progress = Progress + If IsSingleObjectDownload Then .Progress = Progress Else .Progress = New YTPreProgressContainer(ProgressPre) .Download(YTUseCookies, Token) + If Not .Progress Is Nothing AndAlso TypeOf .Progress Is YTPreProgressContainer Then .Progress.Dispose() If .File.Exists Then Return .File End With End If Return Nothing End Function + Protected Overrides Function ValidateDownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByRef Interrupt As Boolean) As Boolean + Return Not Media.Type = UTypes.Picture + End Function Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken) _TempMediaList.Add(New UserMedia(Data)) End Sub diff --git a/SCrawler/API/YouTube/UserExchangeOptions.vb b/SCrawler/API/YouTube/UserExchangeOptions.vb index 1d1ca64..ddac235 100644 --- a/SCrawler/API/YouTube/UserExchangeOptions.vb +++ b/SCrawler/API/YouTube/UserExchangeOptions.vb @@ -15,18 +15,29 @@ Namespace API.YouTube Friend Property DownloadShorts As Boolean Friend Property DownloadPlaylists As Boolean + + Friend Property DownloadCommunityImages As Boolean + + Friend Property DownloadCommunityVideos As Boolean Friend Property UseCookies As Boolean + + Friend Property ChannelID As String Friend Sub New(ByVal u As UserData) DownloadVideos = u.DownloadYTVideos DownloadShorts = u.DownloadYTShorts DownloadPlaylists = u.DownloadYTPlaylists + DownloadCommunityImages = u.DownloadYTCommunityImages + DownloadCommunityVideos = u.DownloadYTCommunityVideos UseCookies = u.YTUseCookies + ChannelID = u.ChannelID End Sub Friend Sub New(ByVal s As SiteSettings) DownloadVideos = s.DownloadVideos.Value DownloadShorts = s.DownloadShorts.Value DownloadPlaylists = s.DownloadPlaylists.Value + DownloadCommunityImages = s.DownloadCommunityImages.Value + DownloadCommunityVideos = s.DownloadCommunityVideos.Value UseCookies = s.UseCookies.Value End Sub End Class diff --git a/SCrawler/Download/DownloadProgress.vb b/SCrawler/Download/DownloadProgress.vb index a28233a..9d05837 100644 --- a/SCrawler/Download/DownloadProgress.vb +++ b/SCrawler/Download/DownloadProgress.vb @@ -7,6 +7,7 @@ ' This program is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY Imports PersonalUtilities.Forms.Toolbars +Imports PersonalUtilities.Forms.Controls.KeyClick Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports TDJob = SCrawler.DownloadObjects.TDownloader.Job Namespace DownloadObjects @@ -14,6 +15,7 @@ Namespace DownloadObjects #Region "Events" Friend Event DownloadDone As NotificationEventHandler Friend Event ProgressChanged(ByVal Main As Boolean, ByVal IsMaxValue As Boolean, ByVal IsDone As Boolean) + Friend Event FeedFilesChanged As TDownloader.FeedFilesChangedEventHandler #End Region #Region "Declarations" #Region "Controls" @@ -26,14 +28,18 @@ Namespace DownloadObjects Private ReadOnly PR_PRE As ProgressBar Private ReadOnly LBL_INFO As Label Private ReadOnly Icon As PictureBox + Private ReadOnly TT_MAIN As ToolTip #End Region Private ReadOnly Property Instance As API.Base.ProfileSaved Friend ReadOnly Property Job As TDJob + Private ReadOnly InternalArgs As KeyClickEventArgs #End Region #Region "Initializer" Friend Sub New(ByVal _Job As TDJob) Job = _Job + InternalArgs = New KeyClickEventArgs + TT_MAIN = New ToolTip TP_MAIN = New TableLayoutPanel With {.Margin = New Padding(0), .Dock = DockStyle.Fill} TP_MAIN.ColumnStyles.Add(New ColumnStyle(SizeType.Percent, 100)) TP_MAIN.ColumnCount = 1 @@ -86,6 +92,7 @@ Namespace DownloadObjects LBL_INFO.Padding = New Padding(3, 0, 3, 0) LBL_INFO.TextAlign = ContentAlignment.TopCenter CreateButton(BTT_START, My.Resources.StartPic_Green_16) + TT_MAIN.SetToolTip(BTT_START, "Ctrl+Click: download, exclude from feed.") CreateButton(BTT_OPEN, PersonalUtilities.My.Resources.FolderOpenPic_Black_16) With TP_CONTROLS With .ColumnStyles @@ -148,7 +155,8 @@ Namespace DownloadObjects End Function #Region "Buttons" Private Sub BTT_START_Click(sender As Object, e As EventArgs) Handles BTT_START.Click - Start() + InternalArgs.Reset() + Start(, Downloader.SessionSavedPosts, Not InternalArgs.Control) End Sub Private Sub BTT_STOP_Click(sender As Object, e As EventArgs) Handles BTT_STOP.Click [Stop]() @@ -159,8 +167,13 @@ Namespace DownloadObjects #End Region #Region "Start, Stop" Private _IsMultiple As Boolean = False - Friend Sub Start(Optional ByVal Multiple As Boolean = False) + Private _Session As Integer = 0 + Private _IncludeInTheFeed As Boolean = True + Friend Sub Start(Optional ByVal Multiple As Boolean = False, Optional ByVal Session As Integer = -1, + Optional ByVal IncludeInTheFeed As Boolean = True) _IsMultiple = Multiple + _Session = Session + _IncludeInTheFeed = IncludeInTheFeed Job.StartThread(AddressOf DownloadData) End Sub Friend Sub [Stop]() @@ -175,7 +188,10 @@ Namespace DownloadObjects btte.Invoke(BTT_STOP, True) Job.Progress.InformationTemporary = $"{Job.HostCollection.Name} downloading started" Job.Start() + Instance.Session = _Session + Instance.IncludeInTheFeed = _IncludeInTheFeed Instance.Download(Job.Token, _IsMultiple) + If _IncludeInTheFeed And Instance.FeedDataExists Then RaiseEvent FeedFilesChanged(True) RaiseEvent DownloadDone(SettingsCLS.NotificationObjects.SavedPosts, $"Downloading saved {Job.HostCollection.Name} posts is completed") Catch ex As Exception Job.Progress.InformationTemporary = $"{Job.HostCollection.Name} downloading error" @@ -220,6 +236,7 @@ Namespace DownloadObjects If Not Icon Is Nothing Then Icon.Dispose() PR_MAIN.DisposeIfReady() LBL_INFO.DisposeIfReady() + If Not TT_MAIN Is Nothing Then TT_MAIN.Dispose() If Not TP_CONTROLS Is Nothing Then TP_CONTROLS.Controls.Clear() TP_CONTROLS.Dispose() diff --git a/SCrawler/Download/DownloadSavedPostsForm.Designer.vb b/SCrawler/Download/DownloadSavedPostsForm.Designer.vb index 185702a..e2d5064 100644 --- a/SCrawler/Download/DownloadSavedPostsForm.Designer.vb +++ b/SCrawler/Download/DownloadSavedPostsForm.Designer.vb @@ -24,7 +24,6 @@ Partial Friend Class DownloadSavedPostsForm : Inherits System.Windows.Forms.Form Me.components = New System.ComponentModel.Container() Dim TP_BUTTONS As System.Windows.Forms.TableLayoutPanel Dim TT_MAIN As System.Windows.Forms.ToolTip - Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(DownloadSavedPostsForm)) Me.BTT_DOWN_ALL = New System.Windows.Forms.Button() Me.BTT_STOP_ALL = New System.Windows.Forms.Button() Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel() @@ -59,6 +58,7 @@ Partial Friend Class DownloadSavedPostsForm : Inherits System.Windows.Forms.Form Me.BTT_DOWN_ALL.Size = New System.Drawing.Size(234, 31) Me.BTT_DOWN_ALL.TabIndex = 0 Me.BTT_DOWN_ALL.Text = "Download ALL" + TT_MAIN.SetToolTip(Me.BTT_DOWN_ALL, "Ctrl+Click: download, exclude from feed.") Me.BTT_DOWN_ALL.UseVisualStyleBackColor = True ' 'BTT_STOP_ALL @@ -92,7 +92,7 @@ Partial Friend Class DownloadSavedPostsForm : Inherits System.Windows.Forms.Form Me.ClientSize = New System.Drawing.Size(484, 41) Me.Controls.Add(Me.TP_MAIN) Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle - Me.Icon = Global.SCrawler.My.Resources.BookmarkIcon_32 + Me.Icon = Global.SCrawler.My.Resources.Resources.BookmarkIcon_32 Me.MaximizeBox = False Me.MaximumSize = New System.Drawing.Size(500, 80) Me.MinimumSize = New System.Drawing.Size(500, 80) diff --git a/SCrawler/Download/DownloadSavedPostsForm.resx b/SCrawler/Download/DownloadSavedPostsForm.resx index 850f28f..c23aae3 100644 --- a/SCrawler/Download/DownloadSavedPostsForm.resx +++ b/SCrawler/Download/DownloadSavedPostsForm.resx @@ -117,15 +117,13 @@ System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089 - - + False - - + + False - - - + + 17, 17 - + \ No newline at end of file diff --git a/SCrawler/Download/DownloadSavedPostsForm.vb b/SCrawler/Download/DownloadSavedPostsForm.vb index 3257351..0ae4abc 100644 --- a/SCrawler/Download/DownloadSavedPostsForm.vb +++ b/SCrawler/Download/DownloadSavedPostsForm.vb @@ -10,8 +10,10 @@ Imports System.ComponentModel Imports SCrawler.DownloadObjects Imports SCrawler.Plugin.Hosts Imports PersonalUtilities.Forms +Imports PersonalUtilities.Forms.Controls.KeyClick Friend Class DownloadSavedPostsForm Friend Event DownloadDone As NotificationEventHandler + Friend Event FeedFilesChanged As TDownloader.FeedFilesChangedEventHandler Private MyView As FormView Private ReadOnly JobsList As List(Of DownloadProgress) Friend ReadOnly Property Working As Boolean @@ -40,6 +42,7 @@ Friend Class DownloadSavedPostsForm If JobsList.Count > 0 Then For Each j As DownloadProgress In JobsList AddHandler j.DownloadDone, AddressOf Jobs_DownloadDone + AddHandler j.FeedFilesChanged, AddressOf Jobs_FeedFilesChanged TP_MAIN.RowStyles.Add(New RowStyle(SizeType.Absolute, 60)) TP_MAIN.RowCount += 1 TP_MAIN.Controls.Add(j.Get, 0, TP_MAIN.RowStyles.Count - 1) @@ -60,7 +63,16 @@ Friend Class DownloadSavedPostsForm MyView.Dispose(Settings.Design) End Sub Private Sub [Start]() Handles BTT_DOWN_ALL.Click - If JobsList.Count > 0 Then JobsList.ForEach(Sub(j) j.Start(True)) + If JobsList.Count > 0 Then + Dim ses% = Downloader.SessionSavedPosts + Dim args As New KeyClickEventArgs + args.Reset() + JobsList.ForEach(Sub(ByVal j As DownloadProgress) + ses += 1 + j.Start(True, ses, Not args.Control) + End Sub) + Downloader.SessionSavedPosts = ses + End If End Sub Friend Sub [Stop]() Handles BTT_STOP_ALL.Click If JobsList.Count > 0 Then JobsList.ForEach(Sub(j) j.Stop()) @@ -68,4 +80,7 @@ Friend Class DownloadSavedPostsForm Private Sub Jobs_DownloadDone(ByVal Obj As SettingsCLS.NotificationObjects, ByVal Message As String) RaiseEvent DownloadDone(SettingsCLS.NotificationObjects.SavedPosts, Message) End Sub + Private Sub Jobs_FeedFilesChanged(ByVal Added As Boolean) + RaiseEvent FeedFilesChanged(Added) + End Sub End Class \ No newline at end of file diff --git a/SCrawler/Download/Feed/FeedMedia.vb b/SCrawler/Download/Feed/FeedMedia.vb index bf06539..dfd820a 100644 --- a/SCrawler/Download/Feed/FeedMedia.vb +++ b/SCrawler/Download/Feed/FeedMedia.vb @@ -300,6 +300,11 @@ Namespace DownloadObjects Throw New ArgumentNullException With {.HelpLink = 1} End If + If Media.IsSavedPosts Then + BTT_CONTEXT_OPEN_USER_URL.Visible = False + BTT_CONTEXT_FIND_USER.Visible = False + End If + If Settings.Feeds.FavoriteExists AndAlso Settings.Feeds.Favorite.Contains(Media) Then BTT_FEED_ADD_FAV.ControlChangeColor(True, False) If Settings.FeedShowSpecialFeedsMediaItem Then With Settings.Feeds @@ -392,14 +397,31 @@ Namespace DownloadObjects End Sub Private Sub BTT_CONTEXT_OPEN_USER_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_USER.Click If Not UserKey.IsEmptyString Then - Dim u As IUserData = Settings.GetUser(UserKey) - If Not u Is Nothing Then u.OpenFolder() + Dim u As IUserData = Nothing + If Not Media.IsSavedPosts Then + u = Settings.GetUser(UserKey) + Else + If Not Media.UserInfo.Plugin.IsEmptyString Then + Dim host As Plugin.Hosts.SettingsHost = Settings(Media.UserInfo.Plugin, Media.UserInfo.AccountName) + If Not host Is Nothing Then + u = host.GetInstance(Plugin.ISiteSettings.Download.SavedPosts, Media.UserInfo, False, False) + With DirectCast(u, UserDataBase) + .IsSavedPosts = True + .HostStatic = True + End With + End If + End If + End If + If Not u Is Nothing Then + u.OpenFolder() + If Media.IsSavedPosts Then u.Dispose() + End If End If End Sub #End Region #Region "Open URL" Private Sub BTT_CONTEXT_OPEN_USER_URL_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_USER_URL.Click - If Not UserKey.IsEmptyString Then + If Not UserKey.IsEmptyString And Not Media.IsSavedPosts Then Dim u As IUserData = Settings.GetUser(UserKey) If Not u Is Nothing Then u.OpenSite() End If @@ -411,8 +433,26 @@ Namespace DownloadObjects url = Post.URL_BASE Else If Not UserKey.IsEmptyString And Not Post.Post.ID.IsEmptyString Then - Dim u As IUserData = Settings.GetUser(UserKey) - If Not u Is Nothing Then url = UserDataBase.GetPostUrl(u, Post) + Dim u As IUserData + If Media.IsSavedPosts Then + If Not Media.UserInfo.Plugin.IsEmptyString Then + Dim host As Plugin.Hosts.SettingsHostCollection = Settings(Media.UserInfo.Plugin) + If Not host Is Nothing Then + u = host.Default.GetInstance(Plugin.ISiteSettings.Download.SavedPosts, Media.UserInfo, False, False) + If Not u Is Nothing AndAlso Not u.HOST Is Nothing Then + With DirectCast(u, UserDataBase) + .IsSavedPosts = True + .HostStatic = True + End With + Try : url = u.HOST.Source.GetUserPostUrl(u, Post) : Catch : End Try + u.Dispose() + End If + End If + End If + Else + u = Settings.GetUser(UserKey) + If Not u Is Nothing Then url = UserDataBase.GetPostUrl(u, Post) + End If End If End If If Not url.IsEmptyString Then diff --git a/SCrawler/Download/STDownloader/VideoDownloaderForm.vb b/SCrawler/Download/STDownloader/VideoDownloaderForm.vb index 077913f..db33567 100644 --- a/SCrawler/Download/STDownloader/VideoDownloaderForm.vb +++ b/SCrawler/Download/STDownloader/VideoDownloaderForm.vb @@ -145,7 +145,7 @@ Namespace DownloadObjects.STDownloader For Each url In urls If Not TryYouTube.Invoke Then media = FindSource(url, output) - If Not media Is Nothing Then media.AccountName = acc : ControlCreateAndAdd(media, disableDown) + If Not media Is Nothing AndAlso ValidateContainerURL(media) Then media.AccountName = acc : ControlCreateAndAdd(media, disableDown) End If Next urls.Clear() @@ -175,7 +175,7 @@ Namespace DownloadObjects.STDownloader End If If media Is Nothing Then MsgBoxE({$"The URL you entered is not recognized by existing plugins.{vbCr}{url}", "Download video"}, vbCritical) - Else + ElseIf ValidateContainerURL(media) Then media.AccountName = acc output.Exists(SFO.Path, True) ControlCreateAndAdd(media, disableDown) diff --git a/SCrawler/Download/TDownloader.vb b/SCrawler/Download/TDownloader.vb index d6b1aed..334dd51 100644 --- a/SCrawler/Download/TDownloader.vb +++ b/SCrawler/Download/TDownloader.vb @@ -34,12 +34,14 @@ Namespace DownloadObjects Private Const Name_Date As String = "Date" Private Const Name_Session As String = "Session" Private Const Name_File As String = "File" + Private Const Name_IsSavedPosts As String = "IsSavedPosts" #End Region Friend ReadOnly User As IUserData Friend ReadOnly Data As UserMedia Friend ReadOnly UserInfo As UserInfo Friend ReadOnly [Date] As Date Friend ReadOnly 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 Me.User = User @@ -54,10 +56,22 @@ Namespace DownloadObjects Private Sub New(ByVal e As EContainer) If Not e Is Nothing Then If e.Contains(Name_User) Then + IsSavedPosts = e.Value(Name_IsSavedPosts).FromXML(Of Boolean)(False) Dim u As UserInfo = e(Name_User) If Not u.Name.IsEmptyString And Not u.Site.IsEmptyString Then - User = Settings.GetUser(u) - If Not User Is Nothing Then UserInfo = DirectCast(User, UserDataBase).User + If Not IsSavedPosts Then + User = Settings.GetUser(u) + If Not User Is Nothing Then UserInfo = DirectCast(User, UserDataBase).User Else UserInfo = u + ElseIf Not u.Plugin.IsEmptyString Then + UserInfo = u + User = Settings(u.Plugin).Default.GetInstance(Download.SavedPosts, u, False, False) + If Not User Is Nothing Then + With DirectCast(User, UserDataBase) + .HostStatic = True + .IsSavedPosts = True + End With + End If + End If End If End If Data = New UserMedia(e(Name_Media), User) @@ -90,8 +104,9 @@ Namespace DownloadObjects Data.ToEContainer, New EContainer(Name_Date, AConvert(Of String)([Date], DateTimeDefaultProvider, String.Empty)), New EContainer(Name_Session, Session), - New EContainer(Name_File, Data.File)}, - If(Not User Is Nothing, DirectCast(User, UserDataBase).User.ToEContainer, Nothing), LAP.IgnoreICopier) + New EContainer(Name_File, Data.File), + New EContainer(Name_IsSavedPosts, IsSavedPosts.BoolToInteger)}, + If(IsSavedPosts, UserInfo.ToEContainer, If(Not User Is Nothing, DirectCast(User, UserDataBase).User.ToEContainer, Nothing)), LAP.IgnoreICopier) End Function End Structure Friend ReadOnly Property Files As List(Of UserMediaD) @@ -415,6 +430,28 @@ Namespace DownloadObjects #Region "Thread" Private CheckerThread As Thread Private MissingPostsDetected As Boolean = False + Private _SessionSavedPosts As Integer = -1 + Friend Property SessionSavedPosts As Integer + Get + If Not Working Then + Session += 1 + Return Session + ElseIf _SessionSavedPosts >= 0 Then + _SessionSavedPosts += 1 + Return _SessionSavedPosts + Else + _SessionSavedPosts = Session + 1 + Return _SessionSavedPosts + End If + End Get + Set(ByVal NewSessionValue As Integer) + If Not Working Then + Session = NewSessionValue + Else + _SessionSavedPosts = NewSessionValue + End If + End Set + End Property Private Session As Integer = 0 Private Sub [Start]() If Not AutoDownloaderWorking AndAlso MyProgressForm.ReadyToOpen AndAlso Pool.LongCount(Function(p) p.Count > 0) > 1 Then MyProgressForm.Show() : MainFrameObj.Focus() @@ -462,6 +499,7 @@ Namespace DownloadObjects RaiseEvent Downloading(False) FilesUpdatePendingUsers() If FilesChanged Then FilesSave() : RaiseEvent FeedFilesChanged(True) + If _SessionSavedPosts <> -1 Then Session = _SessionSavedPosts : _SessionSavedPosts = -1 End Try End Sub Private Sub StartDownloading(ByRef _Job As Job) diff --git a/SCrawler/MainFrame.vb b/SCrawler/MainFrame.vb index adf0819..9101787 100644 --- a/SCrawler/MainFrame.vb +++ b/SCrawler/MainFrame.vb @@ -239,7 +239,20 @@ CloseResume: Case Keys.F6 : BTT_DOWN_ALL_FULL_KeyClick(Nothing, New MyKeyEventArgs(e)) Case Else : b = NumGroup(e) End Select - If Not b And e.Control And e.KeyCode = Keys.F Then MySearch.FormShow() : b = True + + If Not b Then + b = True + If e.Control And e.KeyCode = Keys.F Then + MySearch.FormShow() + ElseIf e.Alt And e.KeyCode = Keys.A Then + BTT_DOWN_AUTOMATION.PerformClick() + ElseIf e.Alt And e.KeyCode = Keys.P Then + BTT_PR_INFO.PerformClick() + Else + b = False + End If + End If + If b Then e.Handled = True End Sub Private Function NumGroup(ByVal e As KeyEventArgs) As Boolean @@ -472,7 +485,11 @@ CloseResume: End Sub #End Region Private Sub ShowFeed() Handles BTT_FEED.Click, BTT_TRAY_FEED_SHOW.Click - If MyFeed Is Nothing Then MyFeed = New DownloadFeedForm : AddHandler Downloader.FeedFilesChanged, AddressOf MyFeed.Downloader_FilesChanged + If MyFeed Is Nothing Then + MyFeed = New DownloadFeedForm + AddHandler Downloader.FeedFilesChanged, AddressOf MyFeed.Downloader_FilesChanged + If Not MySavedPosts Is Nothing Then AddHandler MySavedPosts.FeedFilesChanged, AddressOf MyFeed.Downloader_FilesChanged + End If If MyFeed.Visible Then MyFeed.BringToFront() Else MyFeed.Show() End Sub Private Sub BTT_CHANNELS_Click(sender As Object, e As EventArgs) Handles BTT_CHANNELS.Click, BTT_TRAY_CHANNELS.Click @@ -487,6 +504,7 @@ CloseResume: If MySavedPosts Is Nothing Then MySavedPosts = New DownloadSavedPostsForm AddHandler MySavedPosts.DownloadDone, AddressOf MainFrameObj.ShowNotification + If Not MyFeed Is Nothing Then AddHandler MySavedPosts.FeedFilesChanged, AddressOf MyFeed.Downloader_FilesChanged End If With MySavedPosts If .Visible Then .BringToFront() Else .Show() @@ -910,7 +928,7 @@ CloseResume: #Region "2 - user parameters" Private Sub BTT_CONTEXT_FAV_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_FAV.Click Dim users As List(Of IUserData) = GetSelectedUserArray() - If AskForMassReplace(users, "Favorite") Then users.ForEach(Sub(u) + If AskForMassReplace(users, "Favorite") Then users.ForEach(Sub(ByVal u As IUserData) u.Favorite = Not u.Favorite u.UpdateUserInformation() UserListUpdate(u, False) @@ -918,7 +936,7 @@ CloseResume: End Sub Private Sub BTT_CONTEXT_TEMP_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_TEMP.Click Dim users As List(Of IUserData) = GetSelectedUserArray() - If AskForMassReplace(users, "Temporary") Then users.ForEach(Sub(u) + If AskForMassReplace(users, "Temporary") Then users.ForEach(Sub(ByVal u As IUserData) u.Temporary = Not u.Temporary u.UpdateUserInformation() UserListUpdate(u, False) @@ -928,7 +946,7 @@ CloseResume: Dim users As List(Of IUserData) = GetSelectedUserArray() If AskForMassReplace(users, "Ready for download") Then Dim r As Boolean = MsgBoxE({"What state do you want to set for selected users", "Select ready state"}, vbQuestion,,, {"Not Ready", "Ready"}).Index - users.ForEach(Sub(u) + users.ForEach(Sub(ByVal u As IUserData) u.ReadyForDownload = r u.UpdateUserInformation() End Sub) @@ -1549,7 +1567,7 @@ CloseResume: Friend Function GetUserListProvider(ByVal WithCollections As Boolean) As IFormatProvider If WithCollections Then If OperationsUserListProviderCollections Is Nothing Then _ - OperationsUserListProviderCollections = New CustomProvider(Function(v, d, p, n, ee) + OperationsUserListProviderCollections = New CustomProvider(Function(ByVal v As Object) As Object Dim OutStr$ With DirectCast(v, IUserData) If .IsCollection Then @@ -1563,7 +1581,7 @@ CloseResume: Return OperationsUserListProviderCollections Else If OperationsUserListProvider Is Nothing Then _ - OperationsUserListProvider = New CustomProvider(Function(v, d, p, n, ee) $"[{DirectCast(v, IUserData).Site}] {DirectCast(v, IUserData).Name}") + OperationsUserListProvider = New CustomProvider(Function(v) $"[{DirectCast(v, IUserData).Site}] {DirectCast(v, IUserData).Name}") Return OperationsUserListProvider End If End Function diff --git a/SCrawler/MyProgressExt.vb b/SCrawler/MyProgressExt.vb index b57a71a..a392c33 100644 --- a/SCrawler/MyProgressExt.vb +++ b/SCrawler/MyProgressExt.vb @@ -8,7 +8,7 @@ ' but WITHOUT ANY WARRANTY Imports PersonalUtilities.Forms.Toolbars Friend Class PreProgress : Implements IDisposable - Private ReadOnly Progress As MyProgressExt = Nothing + Friend ReadOnly Progress As MyProgressExt = Nothing Private ReadOnly ProgressExists As Boolean = False Private ReadOnly Property Ready As Boolean Get diff --git a/SCrawler/PluginsEnvironment/Hosts/DownloadableMediaHost.vb b/SCrawler/PluginsEnvironment/Hosts/DownloadableMediaHost.vb index 6039928..dd2ed53 100644 --- a/SCrawler/PluginsEnvironment/Hosts/DownloadableMediaHost.vb +++ b/SCrawler/PluginsEnvironment/Hosts/DownloadableMediaHost.vb @@ -120,7 +120,10 @@ Namespace Plugin.Hosts Instance.DownloadSingleObject(If(ExternalSource, Me), Token) ExchangeData(ExternalSource, Me) Dim __url$ = DirectCast(Me, IDownloadableMedia).URL_BASE.IfNullOrEmpty(URL) - If File.Exists And Not __url.IsEmptyString And MyDownloaderSettings.CreateUrlFiles Then CreateUrlFile(__url, File) + If File.Exists And Not __url.IsEmptyString And MyDownloaderSettings.CreateUrlFiles Then + Dim urlFile As SFile = CreateUrlFile(__url, File) + If urlFile.Exists Then Files.Add(urlFile) + End If If Not ExternalSource Is Nothing Then With ExternalSource : _HasError = .HasError : _Exists = .Exists : End With End If