Compare commits

...

6 Commits

Author SHA1 Message Date
Andy
aef4ce1c8f 2024.6.10.0
YT
YouTubeSettings: add 'VideoPlaylist_AddExtractedMP3' property
MediaItem: improve visualization of height and bitrate
YouTubeMediaContainerBase: fix bugs on default post-processing formats; add 'HeightBase' and 'BitrateBase' properties; add extracted MP3 to playlist
VideoListForm: add 'UpdateLogButton' handlers

SCrawler
Feed: add settings to show/hide site name and file type from media title; add move/copy files of a loaded feed/session to another location; add the ability to reset current session
DownloadFeedForm: when moving saved posts files without replacing the profile, some data is lost
FeedVideo: add double-click handler to open video in external player
API.Instagram: update settings
2024-06-10 08:40:40 +03:00
Andy
93ea2a55ac 2024.6.6.0
YT
VideoOptionsForm: file path is cleared when the cancel button is clicked (browse button); remove the context menu when the right clicking on browse button; add 'ButtonRC' class

SCrawler
API.OnlyFans: add check config to the SiteSettings; update config; add 'Keydb_Api' property; reset 'LastDateUpdated' when rules change; add support 'prefix/suffix' and 'start/end' to support other rules formats
DownloadFeedForm: update 'BTT_CURR_SESSION_SET_Click' function
TDownloader: update 'FilesLoadLastSession' function
2024-06-06 05:49:50 +03:00
Andy
2ae8c3acfc 2024.6.4.0
API.Twitter: add communities downloading, change post opening URL
Feed: add the ability to select one of the download sessions and set it as the current session
2024-06-04 03:28:05 +03:00
Andy
53dcb3e2c6 2024.6.2.0
YT
Add 'FileAddDateToFileName', 'FileAddDateToFileName_VideoForm' and 'FileAddDateToFileName_VideoList' properties
Update 'YouTubeMediaContainerBase', 'VideoOptionsForm' and 'MediaItem' (new options)

SCrawler
API.Instagram: update settings values
API.Reddit: fix 'ReparseMissing' function (remove bearer token)
2024-06-02 01:19:41 +03:00
Andy
ca384e54d6 2024.5.29.0
YT
Trim urls to get rid of 'cr' & 'lf'
Get the correct 'music' url for 'url' files

SCrawler
Remove the no longer needed 'MainFrameObj.UpdateLogButton' from the classes
ProfileSaved: swap the 'ReadyToDownload' and 'Available' checks; remove the 'DownloadStarted' and 'DownloadDone' calls because they are called in the root function
API.Instagram: improve availability checking
API.Twitter: fix deleting user directory when redownloading missing posts
AutoDownloader: improve statuses; move the check thread to the scheduler; add highlighting of scheduler plans (working, stopped, pending, etc.); replace 'ListBox' with 'ListView'; highlight undownloaded plans in gray
2024-05-29 02:45:37 +03:00
Andy
5a1b5c828a 2024.5.25.0
Move files to another directory
2024-05-25 10:06:50 +03:00
62 changed files with 1104 additions and 368 deletions

View File

@@ -1,3 +1,51 @@
# 2024.6.10.0
*2024-06-10*
- Added
- YouTube (standalone app): add option to add extracted MP3 to playlist (`Settings` - `Defaults Video` - `Add extracted MP3 to playlist`)
- Feed
- settings to show/hide site name and file type from media title
- ability to move/copy files of a loaded feed/session to another location
- ability to reset current session
- Fixed
- Minor bugs
# 2024.6.6.0
*2024-06-06*
**ATTENTION!**
1. **To support downloading of DRM protected videos (OnlyFans), please update OF-Scraper to version [3.10](https://github.com/datawhores/OF-Scraper/releases/tag/3.10) (download `zip`, not `exe`).**
2. **If there is a `OFScraperConfigPattern.json` file in the SCrawler settings folder, replace the text of the file with [this text](https://github.com/AAndyProgram/SCrawler/blob/main/SCrawler/API/OnlyFans/OFScraperConfigPattern.json).**
3. **Set the value to `Dynamic rules` (in the site settings) = `https://raw.githubusercontent.com/Growik/onlyfans-dynamic-rules/main/rules.json`.**
- Added
- OnlyFans: new OF-Scraper option (`keydb_api`)
- Minor improvements
- Fixed
- OnlyFans: **data is not downloading**
- Minor bugs
# 2024.6.4.0
*2024-06-04*
**If you were using the [`yt-dlp-TTUser`](https://github.com/bashonly/yt-dlp-TTUser) plugin, you should remove it because this plugin was added to yt-dlp itself! Read more [here](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-requirements).**
- Added
- Added highlighting of scheduler plans (working, stopped, pending, etc.)
- YouTube (standalone app): add option to add the video upload date before/after the file name (`Settings` - `Defaults` - `Add date to file name`)
- Twitter: **`Communities` downloading**
- Feed: ability to select one of the download sessions and set it as the current session
- Minor improvements
- Updated
- yt-dlp up to version **2024.05.27**
- gallery-dl up to version **1.27.0**
- Fixed
- Twitter: deleting user directory when redownloading missing posts
- Minor bugs
# 2024.5.19.0
*2024-05-19*

Binary file not shown.

Before

Width:  |  Height:  |  Size: 20 KiB

After

Width:  |  Height:  |  Size: 22 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 20 KiB

After

Width:  |  Height:  |  Size: 22 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 30 KiB

After

Width:  |  Height:  |  Size: 32 KiB

View File

@@ -1,5 +1,5 @@
<!-- # :rainbow_flag: Happy LGBT Pride Month :tada:
-->
# 🏳️‍🌈 Happy LGBT Pride Month 🎉
# 🏳️‍🌈 Social networks crawler 🏳️‍🌈
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
@@ -37,8 +37,8 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- YouTube videos, shorts, community feeds, users, artists, playlists, music, tracks;
- Reddit images, galleries of images, videos, saved posts;
- Redgifs videos (https://www.redgifs.com/);
- Twitter images and videos, saved (bookmarked) posts;
- OnlyFans images and videos, saved (bookmarked) posts;
- Twitter images and videos, saved (bookmarked) posts, likes, communities;
- OnlyFans images and videos, saved (bookmarked) posts, stories;
- JustForFans images and videos, saved (bookmarked) posts;
- Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories, saved posts;
@@ -79,11 +79,11 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **Reddit**
- **Twitter**
- **OnlyFans** *(partial support)*[^1]
- **Mastodon**
- **Instagram**
- **Threads**
- **Facebook**
- JustForFans *(partial support)*[^1]
- Mastodon *(out of support)*
- TikTok
- RedGifs
- Pinterest

View File

@@ -78,6 +78,12 @@ Namespace API.YouTube.Base
https = 1
m3u8 = 2
End Enum
<Editor(GetType(EnumDropDownEditor), GetType(UITypeEditor))>
Public Enum FileDateMode As Integer
None = 0
Before = 1
After = 2
End Enum
Public Structure MediaObject : Implements IIndexable, IComparable(Of MediaObject)
Public Type As Plugin.UserMediaTypes
Public ID As String

View File

@@ -22,6 +22,7 @@ Namespace API.YouTube.Base
End Sub
Public Shared Function StandardizeURL(ByVal URL As String) As String
Try
URL = URL.StringTrim
Dim isMusic As Boolean = False, isShorts As Boolean = False
If Info_GetUrlType(URL, isMusic, isShorts) = YouTubeMediaType.Single Then
If Not isMusic And Not isShorts Then
@@ -45,6 +46,7 @@ Namespace API.YouTube.Base
End Function
Public Shared Function StandardizeURL_Channel(ByVal URL As String, Optional ByVal Process As Boolean = True) As String
Try
URL = URL.StringTrim
Dim ct As YouTubeChannelTab = YouTubeChannelTab.All
Dim isMusic As Boolean = False
If Process AndAlso Info_GetUrlType(URL, isMusic,,,, ct) = YouTubeMediaType.Channel AndAlso Not isMusic Then
@@ -72,6 +74,7 @@ Namespace API.YouTube.Base
Public Shared Function Info_GetUrlType(ByVal URL As String, Optional ByRef IsMusic As Boolean = False, Optional ByRef IsShorts As Boolean = False,
Optional ByRef IsChannelUser As Boolean = False, Optional ByRef Id As String = Nothing,
Optional ByRef ChannelOptions As YouTubeChannelTab = YouTubeChannelTab.All) As YouTubeMediaType
URL = URL.StringTrim
If Not URL.IsEmptyString Then
IsMusic = URL.Contains("music.youtube.com")
IsChannelUser = False
@@ -118,6 +121,7 @@ Namespace API.YouTube.Base
Optional ByVal Token As Threading.CancellationToken = Nothing, Optional ByVal Progress As IMyProgress = Nothing,
Optional ByVal DateAfter As Date? = Nothing, Optional ByVal DateBefore As Date? = Nothing,
Optional ByVal ChannelOption As YouTubeChannelTab? = Nothing, Optional ByVal UrlAsIs As Boolean = False) As IYouTubeMediaContainer
URL = URL.StringTrim
If URL.IsEmptyString Then Throw New ArgumentNullException("URL", "URL cannot be null")
If Not MyYouTubeSettings.YTDLP.Value.Exists Then Throw New IO.FileNotFoundException("Path to 'yt-dlp.exe' not set or program not found at destination", MyYouTubeSettings.YTDLP.Value.ToString)
Dim urlOrig$ = URL
@@ -162,7 +166,7 @@ Namespace API.YouTube.Base
If result Then
container.Parse(Nothing, _CachePathDefault, isMusic, Token, Progress)
If Not container.HasError Then container.URL = URL : container.IsShorts = isShorts : Return container
If Not container.HasError Then container.URL = URL.ToMusicUrl(isMusic) : container.IsShorts = isShorts : Return container
End If
container.Dispose()
End If

View File

@@ -249,9 +249,18 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Program description"),
Description("Add some additional info to the program info if you need")>
Friend ReadOnly Property ProgramDescription As XMLValue(Of String)
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}, "%"""), Category("Defaults"), DisplayName("Remove characters"),
<Browsable(True), GridVisible, XMLVN({"Defaults"}, "%"""), Category("Defaults"), DisplayName("Remove characters"),
Description("Remove specific characters from a file name")>
Friend ReadOnly Property FileRemoveCharacters As XMLValue(Of String)
Public ReadOnly Property FileRemoveCharacters As XMLValue(Of String)
<Browsable(True), GridVisible, XMLVN({"Defaults"}, FileDateMode.None), Category("Defaults"), DisplayName("Add date to file name"),
Description("Add the video upload date before/after the file name")>
Public ReadOnly Property FileAddDateToFileName As XMLValue(Of FileDateMode)
<Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Add date to title: video form"),
Description("Add video upload date before video title (visual only) in the video form")>
Public ReadOnly Property FileAddDateToFileName_VideoForm As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Add date to title: video list"),
Description("Add video upload date before video title (visual only) in the video list")>
Public ReadOnly Property FileAddDateToFileName_VideoList As XMLValue(Of Boolean)
#End Region
#Region "Defaults ChannelsDownload"
<Browsable(True), GridVisible, XMLVN({"Defaults", "Channels"}), Category("Defaults"), DisplayName("Default download tabs for channels"),
@@ -373,6 +382,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, -1), Category("Defaults Video"), DisplayName("Highlight FPS (lower)"),
Description("Highlight frame rates lower than this value." & vbCr & "Default: -1" & vbCr & "-1 to disable")>
Public ReadOnly Property DefaultVideoHighlightFPS_L As XMLValue(Of Integer)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}), Category("Defaults Video"), DisplayName("Add extracted MP3 to playlist"),
Description("If you also extract MP3 when download the video, add the extracted MP3 to the playlist. Default: false.")>
Public ReadOnly Property VideoPlaylist_AddExtractedMP3 As XMLValue(Of Boolean)
#End Region
#Region "Defaults Audio"
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, "AAC"), Category("Defaults Audio"), DisplayName("Default codec"),

View File

@@ -0,0 +1,23 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.YouTube.Controls
Public Class ButtonRC : Inherits Button
Private Const WM_CONTEXTMENU As Integer = 123 '&H7B
Private Const WM_CANCELMODE As Integer = 31 '&H1F
Private Const WM_INITMENUPOPUP As Integer = 279 '&H117
Private Const SMTO_NOTIMEOUTIFNOTHUNG As Integer = 8
Protected Overrides Sub WndProc(ByRef m As Message)
If m.Msg = WM_CONTEXTMENU Or m.Msg = WM_CANCELMODE Or m.Msg = WM_INITMENUPOPUP Or m.Msg = SMTO_NOTIMEOUTIFNOTHUNG Then
m.Result = IntPtr.Zero
Else
MyBase.WndProc(m)
End If
End Sub
End Class
End Namespace

View File

@@ -65,11 +65,11 @@ Namespace API.YouTube.Controls
Me.LBL_TIME = New System.Windows.Forms.Label()
Me.LBL_URL = New System.Windows.Forms.LinkLabel()
Me.TXT_FILE = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.BTT_BROWSE = New System.Windows.Forms.Button()
Me.BTT_BROWSE = New SCrawler.API.YouTube.Controls.ButtonRC()
Me.BTT_DOWN = New System.Windows.Forms.Button()
Me.BTT_CANCEL = New System.Windows.Forms.Button()
Me.CMB_PLS = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.BTT_PLS_BROWSE = New System.Windows.Forms.Button()
Me.BTT_PLS_BROWSE = New SCrawler.API.YouTube.Controls.ButtonRC()
Me.OPT_VIDEO = New System.Windows.Forms.RadioButton()
Me.OPT_AUDIO = New System.Windows.Forms.RadioButton()
Me.LBL_AUDIO_CODEC = New System.Windows.Forms.Label()
@@ -912,13 +912,13 @@ Namespace API.YouTube.Controls
Private WithEvents TXT_SUBS_ADDIT As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_EXTRA_AUDIO_FORMATS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_FILE As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents BTT_BROWSE As Button
Private WithEvents BTT_BROWSE As SCrawler.API.YouTube.Controls.ButtonRC
Private WithEvents BTT_DOWN As Button
Private WithEvents BTT_CANCEL As Button
Private WithEvents TP_HEADER_INFO_2 As TableLayoutPanel
Private WithEvents TXT_FPS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CMB_PLS As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents BTT_PLS_BROWSE As Button
Private WithEvents BTT_PLS_BROWSE As SCrawler.API.YouTube.Controls.ButtonRC
Private WithEvents TXT_AUDIO_BITRATE As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class
End Namespace

View File

@@ -121,7 +121,7 @@ Namespace API.YouTube.Controls
img = ImageRenderer.GetImage(SFile.GetBytesFromNet(imgUrl, EDP.ReturnValue), EDP.ReturnValue)
If Not img Is Nothing Then ICON_VIDEO.Image = img : ICON_VIDEO.InitialImage = img
End If
LBL_TITLE.Text = .Title
LBL_TITLE.Text = $"{If(MyYouTubeSettings.FileAddDateToFileName_VideoForm.Value, $"[{ .DateAdded:yyyy-MM-dd}] ", String.Empty)}{ .Title}"
LBL_TIME.Text = AConvert(Of String)(.Duration, TimeToStringProvider, String.Empty)
TP_HEADER_INFO_2.ColumnStyles(1).Width = MeasureTextDefault(LBL_TIME.Text, LBL_TIME.Font).Width + PaddingE.GetOf({LBL_TIME}).Horizontal
TP_HEADER_INFO_2.Refresh()
@@ -610,7 +610,7 @@ Namespace API.YouTube.Controls
$"Video|{AvailableVideoFormats.Select(Function(vf) $"*.{vf.ToLower}").ListToString(";")}" &
$"|Audio|{AvailableAudioFormats.Select(Function(af) $"*.{af.ToLower}").ListToString(";")}"
f = SFile.SaveAs(f, "Select the destination of the video file",, ext, sPattern, EDP.ReturnValue)
f.Extension = ext
If Not f.IsEmptyString Then f.Extension = ext
End If
#Enable Warning
f = CleanFileName(f)

View File

@@ -6,6 +6,7 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Runtime.CompilerServices
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.RegularExpressions
@@ -56,6 +57,11 @@ Namespace API.YouTube
Friend ReadOnly TitleHtmlConverter As Func(Of String, String) = Function(Input) Input.StringRemoveWinForbiddenSymbols().StringTrim()
Friend ReadOnly ProgressProvider As IMyProgressNumberProvider = MyProgressNumberProvider.Percentage
Public ReadOnly TrueUrlRegEx As RParams = RParams.DM(Base.YouTubeFunctions.TrueUrlPattern, 0, EDP.ReturnValue)
Friend ReadOnly MusicUrlApply As RParams = RParams.DMS("https://([w\.]*)youtube.com.+", 1, RegexReturn.Replace, EDP.ReturnValue,
CType(Function(input$) "music.", Func(Of String, String)), String.Empty)
<Extension> Friend Function ToMusicUrl(ByVal URL As String, ByVal IsMusic As Boolean) As String
Try : Return If(IsMusic And Not URL.IsEmptyString, CStr(RegexReplace(URL, MusicUrlApply)).IfNullOrEmpty(URL), URL) : Catch : Return URL : End Try
End Function
Friend Function CleanFileName(ByVal f As SFile) As SFile
If Not f.IsEmptyString And Not f.Name.IsEmptyString Then
Dim ff As SFile = f

View File

@@ -133,18 +133,25 @@ Namespace DownloadObjects.STDownloader
ICON_SITE.Image = .SiteIcon
LBL_TIME.Text = AConvert(Of String)(.Duration, TimeToStringProvider, String.Empty)
LBL_TITLE.Text = .ToString(True)
LBL_TITLE.Text = $"{If(MyYouTubeSettings.FileAddDateToFileName_VideoList.Value, $"[{ .DateAdded:yyyy-MM-dd}] ", String.Empty)}{ .ToString(True)}"
Dim h%, b%
If .Self.GetType Is GetType(YouTubeMediaContainerBase) OrElse (Not .Self.GetType.BaseType Is Nothing AndAlso .Self.GetType.BaseType Is GetType(YouTubeMediaContainerBase)) Then
With DirectCast(.Self, YouTubeMediaContainerBase) : h = .HeightBase : b = .BitrateBase : End With
Else
h = .Height
b = .Bitrate
End If
If Not .SiteKey = YouTubeSiteKey And .ContentType = Plugin.UserMediaTypes.Picture Then
LBL_INFO.Text = .File.Extension.StringToUpper
ElseIf Not .IsMusic And Not (.MediaType = Plugin.UserMediaTypes.Audio Or .MediaType = Plugin.UserMediaTypes.AudioPre) Then
If .Height > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{ .Height}p"
If h > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{h}p"
Else
LBL_INFO.Text = .File.Extension.StringToUpper
End If
Else
If .Bitrate > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{ .Bitrate}k"
If b > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{b}k"
Else
LBL_INFO.Text = .File.Extension.StringToUpper
End If
@@ -221,7 +228,7 @@ Namespace DownloadObjects.STDownloader
t = 0
End If
LBL_TITLE.Text = MyContainer.ToString(True)
LBL_TITLE.Text = $"{If(MyYouTubeSettings.FileAddDateToFileName_VideoList.Value, $"[{ .DateAdded:yyyy-MM-dd}] ", String.Empty)}{ .ToString(True)}"
If Not .SiteKey = YouTubeSiteKey Then BTT_VIEW_SETTINGS.Visible = False

View File

@@ -57,6 +57,12 @@ Namespace DownloadObjects.STDownloader
End If
MyNotificator = New YTNotificator(Me)
MyDownloaderSettings = MyYouTubeSettings
ProgramLogInitialize()
With ProgramLog
AddHandler .TextAdded, AddressOf ProgramLog_TextAdded
AddHandler .TextCleared, AddressOf ProgramLog_TextCleared
End With
UpdateLogButton()
End If
With MyView : .Import() : .SetFormSize() : End With
@@ -157,7 +163,7 @@ Namespace DownloadObjects.STDownloader
If PerformClick Then cnt.PerformClick()
If Not DisableDownload And MyDownloaderSettings.DownloadAutomatically Then AddToDownload(cnt, True)
End With
End Sub, EDP.None)
End Sub, EDP.SendToLog)
End Sub
#Region "Controls rendering"
Private Overloads Sub OffsetControls()
@@ -247,7 +253,7 @@ Namespace DownloadObjects.STDownloader
Dim useCookiesParse As Boolean? = Nothing
If useCookies Then useCookiesParse = True
Dim standardizeUrls As Boolean = MyYouTubeSettings.StandardizeURLs
Dim standardize As Func(Of String, String) = Function(input) If(standardizeUrls, YouTubeFunctions.StandardizeURL(input), input)
Dim standardize As Func(Of String, String) = Function(input) If(standardizeUrls, YouTubeFunctions.StandardizeURL(input), input.StringTrim)
Dim c As IYouTubeMediaContainer = Nothing
Dim url$ = String.Empty
@@ -449,12 +455,26 @@ Namespace DownloadObjects.STDownloader
End Try
End Sub
#End Region
#Region "LOG"
Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click
MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton)
End Sub
Friend Sub UpdateLogButton()
If AppMode Then MyMainLOG_UpdateLogButton(BTT_LOG, TOOLBAR_TOP)
Private Sub UpdateLogButton()
If AppMode Then
Try : MyMainLOG_UpdateLogButton(BTT_LOG, TOOLBAR_TOP) : Catch : End Try
End If
End Sub
Private _LogUpdateButtonSuspended As Boolean = False
Private Sub ProgramLog_TextAdded(ByVal Sender As Object, ByVal e As EventArgs)
If Not _LogUpdateButtonSuspended Then
_LogUpdateButtonSuspended = True
Try : ControlInvokeFast(TOOLBAR_TOP, BTT_LOG, AddressOf UpdateLogButton, EDP.None) : Catch : End Try
End If
End Sub
Private Sub ProgramLog_TextCleared(ByVal Sender As Object, ByVal e As EventArgs)
_LogUpdateButtonSuspended = False
End Sub
#End Region
Private Sub BTT_BUG_REPORT_Click(sender As Object, e As EventArgs) Handles BTT_BUG_REPORT.Click
Try
With MyYouTubeSettings

View File

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

View File

@@ -267,12 +267,11 @@ Namespace API.YouTube.Objects
<XMLEC(CollectionMode:=CollectionModes.String)>
Friend ReadOnly Property PostProcessing_OutputAudioFormats As List(Of String)
Friend Sub PostProcessing_OutputAudioFormats_Reset()
PostProcessing_OutputAudioFormats.Clear()
PostProcessing_OutputAudioFormats.ListAddList(MyYouTubeSettings.DefaultAudioCodecAddit)
If PostProcessing_OutputAudioFormats.Count > 0 Then
PostProcessing_OutputAudioFormats.Sort()
PostProcessing_OutputAudioFormats.RemoveAll(Function(s) s = -1)
End If
With PostProcessing_OutputAudioFormats
.Clear()
.ListAddList(MyYouTubeSettings.DefaultAudioCodecAddit)
If .Count > 0 Then .Sort()
End With
End Sub
<XMLEC("OutputAudioBitrate")> Protected _OutputAudioBitrate As Integer = -1
Friend Property OutputAudioBitrate As Integer
@@ -322,21 +321,19 @@ Namespace API.YouTube.Objects
<XMLEC(CollectionMode:=CollectionModes.String)>
Friend ReadOnly Property PostProcessing_OutputSubtitlesFormats As List(Of String)
Friend Sub PostProcessing_OutputSubtitlesFormats_Reset()
PostProcessing_OutputSubtitlesFormats.Clear()
PostProcessing_OutputSubtitlesFormats.ListAddList(MyYouTubeSettings.DefaultSubtitlesFormatAddit)
If PostProcessing_OutputSubtitlesFormats.Count > 0 Then
PostProcessing_OutputSubtitlesFormats.Sort()
PostProcessing_OutputSubtitlesFormats.RemoveAll(Function(s) s = -1)
End If
With PostProcessing_OutputSubtitlesFormats
.Clear()
.ListAddList(MyYouTubeSettings.DefaultSubtitlesFormatAddit)
If .Count > 0 Then .Sort()
End With
End Sub
Friend Sub SubtitlesSelectedIndexesReset()
SubtitlesSelectedIndexes.Clear()
With SubtitlesSelectedIndexes
.Clear()
Dim subs As List(Of Subtitles) = Subtitles
SubtitlesSelectedIndexes.ListAddList(MyYouTubeSettings.DefaultSubtitles.Select(Function(s) subs.FindIndex(Function(ss) ss.ID = s)))
If SubtitlesSelectedIndexes.Count > 0 Then
SubtitlesSelectedIndexes.Sort()
SubtitlesSelectedIndexes.RemoveAll(Function(s) s = -1)
End If
.ListAddList(MyYouTubeSettings.DefaultSubtitles.Select(Function(s) subs.FindIndex(Function(ss) ss.ID = s)))
If .Count > 0 Then .Sort() : .RemoveAll(Function(s) s = -1)
End With
End Sub
Private Sub SetElementsSubtitles(ByVal Source As YouTubeMediaContainerBase)
If Not Source Is Nothing And HasElements Then
@@ -442,6 +439,19 @@ Namespace API.YouTube.Objects
End Get
End Property
<XMLEC> Public Property Height As Integer Implements IYouTubeMediaContainer.Height
Friend ReadOnly Property HeightBase As Integer
Get
If Height > 0 Then
Return Height
ElseIf SelectedVideoIndex.ValueBetween(0, MediaObjects.Count - 1) Then
Return SelectedVideo.Height
ElseIf SelectedAudioIndex.ValueBetween(0, MediaObjects.Count - 1) Then
Return SelectedAudio.Height
Else
Return 0
End If
End Get
End Property
Protected _Bitrate As Integer = 0
<XMLEC> Public Overridable Property Bitrate As Integer Implements IYouTubeMediaContainer.Bitrate
Get
@@ -459,6 +469,20 @@ Namespace API.YouTube.Objects
Me._Bitrate = _Bitrate
End Set
End Property
Friend ReadOnly Property BitrateBase As Integer
Get
If Bitrate > 0 Then
Return Bitrate
ElseIf OutputAudioBitrate > 0 Then
Return OutputAudioBitrate
ElseIf HasElements Then
Try : Return Elements.Average(Function(e) DirectCast(e, YouTubeMediaContainerBase).BitrateBase) : Catch : End Try
ElseIf SelectedAudioIndex.ValueBetween(0, MediaObjects.Count - 1) Then
Return SelectedAudio.Bitrate
End If
Return 0
End Get
End Property
<XMLEC> Public Property DateCreated As Date = Now Implements IYouTubeMediaContainer.DateCreated
<XMLEC> Public Property DateAdded As Date Implements IYouTubeMediaContainer.DateAdded
Private Property IUserMedia_PostDate As Date? Implements IUserMedia.PostDate
@@ -656,6 +680,15 @@ Namespace API.YouTube.Objects
End If
End Set
End Property
Friend Sub FileDateUpdate()
Dim n$ = _File.Name.StringTrim
Dim s$ = IIf(n.IsEmptyString, String.Empty, " ")
Select Case MyYouTubeSettings.FileAddDateToFileName.Value
Case FileDateMode.Before : n = $"[{DateAdded:yyyy-MM-dd}]{s}{n}"
Case FileDateMode.After : n = $"{n}{s}[{DateAdded:yyyy-MM-dd}]"
End Select
_File.Name = n
End Sub
Public Property FileSettings As SFile
Private Property IUserMedia_File As String Implements IUserMedia.File
Get
@@ -966,7 +999,7 @@ Namespace API.YouTube.Objects
.Visible = True
.Value = 0
.Maximum = DownloadGetElemCountSingle()
.Information = $"Download {ObjectType}"
.Information = "Downloading"
End With
End If
@@ -1111,7 +1144,7 @@ Namespace API.YouTube.Objects
.Value = 0
.Maximum = 100
.Provider = ProgressProvider
.Information = $"Download {MediaType}"
.Information = "Downloading"
End With
End If
.MainProcessName = MyYouTubeSettings.YTDLP.Name '"yt-dlp"
@@ -1296,6 +1329,7 @@ Namespace API.YouTube.Objects
If format = mp3 And Not mp3ThumbEmbedded And MyYouTubeSettings.DefaultAudioEmbedThumbnail_ExtractedFiles Then _
embedThumbTo.Invoke(f) : mp3ThumbEmbedded = True
If Not M3U8_PlaylistFiles.ListExists AndAlso f.Exists Then M3U8_Append(f)
If format = mp3 AndAlso f.Exists AndAlso MyYouTubeSettings.VideoPlaylist_AddExtractedMP3.Value Then M3U8_Append(f)
End If
Next
End If
@@ -1544,7 +1578,7 @@ Namespace API.YouTube.Objects
ID = .Value("id")
Title = TitleHtmlConverter.Invoke(.Value("title"))
Description = .Value("description")
URL = .Value("webpage_url")
URL = .Value("webpage_url").ToMusicUrl(IsMusic)
PlaylistID = .Value("playlist_id")
PlaylistCount = .Value("n_entries").IfNullOrEmpty(.Value("playlist_count")).FromXML(Of Integer)(0)
@@ -1582,6 +1616,7 @@ Namespace API.YouTube.Objects
If tValue.HasValue Then Duration = TimeSpan.FromSeconds(tValue.Value)
End If
DateAdded = AConvert(Of Date)(.Value("release_date").IfNullOrEmpty(.Value("upload_date")), DateAddedProvider, New Date)
If Not IsMusic Then FileDateUpdate()
ParseFormats(.Self)

View File

@@ -115,6 +115,9 @@
<ItemGroup>
<Compile Include="Attributes\GridVisibleAttribute.vb" />
<Compile Include="Base\TableControlsProcessor.vb" />
<Compile Include="Controls\ButtonRC.vb">
<SubType>Component</SubType>
</Compile>
<Compile Include="Controls\ChannelTabsChooserForm.Designer.vb">
<DependentUpon>ChannelTabsChooserForm.vb</DependentUpon>
</Compile>

View File

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

View File

@@ -54,9 +54,8 @@ Namespace API.Base
Dim aStr$ = String.Empty
If Count > 1 Then aStr = $" ({Number}/{Count})"
Try
If Host.Source.ReadyToDownload(PDownload.SavedPosts) Then
If Host.Available(PDownload.SavedPosts, Multiple Or Count > 1) Then
Host.DownloadStarted(PDownload.SavedPosts)
If Host.Source.ReadyToDownload(PDownload.SavedPosts) Then
If Count > 1 Then Progress.Information = $"{Host.Name} - {Host.AccountName.IfNullOrEmpty(SettingsHost.NameAccountNameDefault)}"
Using user As IUserData = Host.GetInstance(PDownload.SavedPosts, Nothing, False, False)
If Not user Is Nothing Then
@@ -83,11 +82,11 @@ Namespace API.Base
End Using
Else
_Unavailable += 1
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is unavailable"
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is not ready"
End If
Else
_NotReady += 1
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is not ready"
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is unavailable"
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
_ErrorCount += 1
@@ -96,9 +95,6 @@ Namespace API.Base
_ErrorCount += 1
Progress.InformationTemporary = $"{Host.Name}{aStr} downloading error"
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"[API.Base.ProfileSaved.Download({Host.Key}{aStr})]")
Finally
Host.DownloadDone(PDownload.SavedPosts)
MainFrameObj.UpdateLogButton()
End Try
End Sub
End Class

View File

@@ -143,7 +143,7 @@ Namespace API.Base
Protected Const Name_UserID As String = "UserID"
Protected Const Name_Options As String = "Options"
Protected Const Name_Description As String = "Description"
Private Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly"
Protected Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly"
Private Const Name_IsSubscription As String = UserInfo.Name_IsSubscription
Private Const Name_Temporary As String = "Temporary"
Private Const Name_Favorite As String = "Favorite"

View File

@@ -446,6 +446,12 @@ Namespace API.Instagram
Friend Overrides Sub EndInit()
Try : MyLastRequests.Add(LastDownloadDate.Value, LastRequestsCount.Value) : Catch : End Try
If Not CBool(HH_IG_WWW_CLAIM_USE.Value) Then Responser.Headers.Remove(Header_IG_WWW_CLAIM)
If CInt(SettingsVersion.Value) < 2 Then
SettingsVersion.Value = 2
HH_IG_WWW_CLAIM_UPDATE_INTERVAL.Value = 120
HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO.Value = 1
HH_IG_WWW_CLAIM_RESET_EACH_TARGET.Value = 0
End If
MyBase.EndInit()
End Sub
#End Region
@@ -480,8 +486,24 @@ Namespace API.Instagram
Private ____AvailableSilent As Boolean = True
Private ____AvailableChecked As Boolean = False
Private ____AvailableResult As Boolean = False
Private Sub ResetDownloadOptions()
If ActiveJobs < 1 Then
____DownloadStarted = False
____AvailableRequested = False
____AvailableChecked = False
____AvailableSilent = True
____AvailableResult = False
If ActiveSessionRequestsExists Then RefreshMyLastRequests(Now)
ActiveSessionRequestsExists = False
_NextWNM = UserData.WNM.Notify
_NextTagged = True
SkipUntilNextSession = False
AvailableText = String.Empty
ActiveJobs = 0
End If
End Sub
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
If MyBase.Available(What, Silent) Then
If MyBase.Available(What, Silent) And ActiveJobs < 2 Then
If CInt(DownDetectorValue.Value) >= 0 Then
If ____DownloadStarted Then
____AvailableRequested = True
@@ -551,10 +573,9 @@ Namespace API.Instagram
Private _NextWNM As UserData.WNM = UserData.WNM.Notify
Private _NextTagged As Boolean = True
Friend Overrides Sub DownloadStarted(ByVal What As Download)
If ActiveJobs = 0 Then ActiveSessionRequestsExists = False
ResetDownloadOptions()
ActiveJobs += 1
If What = Download.Main Then ____DownloadStarted = True
If ActiveJobs = 1 Then ActiveSessionDate = Now
If ActiveJobs = 1 Then ____DownloadStarted = True : ActiveSessionDate = Now
If Not HH_IG_WWW_CLAIM_IS_ZERO AndAlso
(
(CBool(HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO.Value) AndAlso MyLastRequestsDate.AddMinutes(HH_IG_WWW_CLAIM_UPDATE_INTERVAL.Value) < Now) Or
@@ -594,18 +615,8 @@ Namespace API.Instagram
End With
End Sub
Friend Overrides Sub DownloadDone(ByVal What As Download)
_NextWNM = UserData.WNM.Notify
_NextTagged = True
If ActiveSessionRequestsExists Then RefreshMyLastRequests(Now)
ActiveJobs -= 1
SkipUntilNextSession = False
If What = Download.Main Then ____DownloadStarted = False
If ActiveJobs = 0 Then
____AvailableRequested = False
____AvailableChecked = False
____AvailableSilent = True
____AvailableResult = False
End If
ResetDownloadOptions()
End Sub
#End Region
#Region "Settings"

View File

@@ -11,5 +11,15 @@ Namespace API.OnlyFans
Friend Module Declarations
Friend ReadOnly DateProvider As New ADateTime("O")
Friend ReadOnly RegExPostID As RParams = RParams.DM("(?<=onlyfans\.com/)(\d+)", 0, EDP.ReturnValue)
Friend ReadOnly OFScraperConfigPatternFile As SFile = $"{SettingsFolderName}\OFScraperConfigPattern.json"
Friend Function CheckOFSConfig() As Boolean
If Not OFScraperConfigPatternFile.Exists Then
Dim t$ = Text.Encoding.UTF8.GetString(My.Resources.OFResources.OFScraperConfigPattern)
TextSaver.SaveTextToFile(t, OFScraperConfigPatternFile, True)
Return OFScraperConfigPatternFile.Exists
Else
Return True
End If
End Function
End Module
End Namespace

View File

@@ -38,14 +38,18 @@
},
"advanced_options": {
"code-execution": false,
"dynamic-mode-default": "deviint",
"dynamic-mode-default": "sneaky",
"backend": "aio",
"downloadbars": false,
"cache-mode": "sqlite",
"appendlog": true,
"custom": null,
"sanitize_text": false,
"avatar": true
"avatar": true,
"custom_values": {
"SNEAKY": "https://raw.githubusercontent.com/Growik/onlyfans-dynamic-rules/main/rules.json",
"CDRM": "https://old.cdrm-project.com/wv"
}
},
"responsetype": {
"timeline": "Posts",

View File

@@ -133,12 +133,25 @@ Namespace API.OnlyFans
End If
End Get
End Property
<PClonable, PXML("keydb_api")> Private ReadOnly Property Keydb_Api_XML As PropertyValue
<PropertyOption(ControlText:="keydb_api", Category:=CAT_OFS)>
Friend ReadOnly Property Keydb_Api As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
Return DirectCast(DefaultInstance, SiteSettings).Keydb_Api_XML
Else
Return Keydb_Api_XML
End If
End Get
End Property
#End Region
#End Region
#Region "Initializer"
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("OnlyFans", ".onlyfans.com", AccName, Temp, My.Resources.SiteResources.OnlyFansIcon_32, My.Resources.SiteResources.OnlyFansPic_32)
CheckOFSConfig()
_AllowUserAgentUpdate = False
With Responser
@@ -192,6 +205,7 @@ Namespace API.OnlyFans
End If
OFScraperMP4decrypt_XML = New PropertyValue(String.Empty, GetType(String))
KeyModeDefault_XML = New PropertyValue(KeyModeDefault_Default)
Keydb_Api_XML = New PropertyValue(String.Empty, GetType(String))
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "onlyfans.com/"), 1, EDP.ReturnValue)
UrlPatternUser = "https://onlyfans.com/{0}"
@@ -204,8 +218,19 @@ Namespace API.OnlyFans
End Function
#End Region
#Region "Update"
Private __UseOldAuthRules As Boolean = True
Private __DynamicRules As String = String.Empty
Friend Overrides Sub BeginUpdate()
__UseOldAuthRules = UseOldAuthRules.Value
__DynamicRules = AConvert(Of String)(DynamicRules.Value, String.Empty)
MyBase.BeginUpdate()
End Sub
Friend Overrides Sub Update()
If _SiteEditorFormOpened Then Responser.Cookies.Changed = False
If _SiteEditorFormOpened Then
If Not __UseOldAuthRules = CBool(UseOldAuthRules.Value) Or Not AEquals(Of String)(__DynamicRules, DynamicRules.Value) Then _
LastDateUpdated = Now.AddYears(-1)
Responser.Cookies.Changed = False
End If
MyBase.Update()
End Sub
#End Region

View File

@@ -549,7 +549,8 @@ Namespace API.OnlyFans
Optional ByVal Round As Integer = 0) As Boolean
Try
If UpdateAuthFile(ForceUpdateAuth) Then
Const nullMsg$ = "The auth parameter is null"
Const nullMsg$ = "The auth parameter(s) is null"
Const formatMidPart$ = ":{0}:{1:x}:"
Dim j As EContainer
Try
j = JsonDocument.Parse(AuthFile.GetText)
@@ -565,8 +566,16 @@ Namespace API.OnlyFans
End Try
If Not j Is Nothing Then
Dim pattern$ = j.Value("format")
If pattern.IsEmptyString Then Throw New ArgumentNullException("format", nullMsg)
If Not pattern.IsEmptyString Then
pattern = pattern.Replace("{}", "{0}").Replace("{:x}", "{1:x}")
ElseIf Not j.Value("prefix").IsEmptyString And Not j.Value("suffix").IsEmptyString Then
pattern = j.Value("prefix") & formatMidPart & j.Value("suffix")
ElseIf Not j.Value("start").IsEmptyString And Not j.Value("end").IsEmptyString Then
pattern = j.Value("start") & formatMidPart & j.Value("end")
Else
Throw New ArgumentNullException("format", nullMsg)
End If
Dim li%() = j("checksum_indexes").Select(Function(e) CInt(e(0).Value)).ToArray
@@ -607,10 +616,14 @@ Namespace API.OnlyFans
Dim r$ = GetWebString(If(ACheck(Of String)(MySettings.DynamicRules.Value),
CStr(MySettings.DynamicRules.Value),
IIf(MySettings.UseOldAuthRules.Value, urlOld, urlNew)),, EDP.ReturnValue)
Dim checkFormat As Func(Of EContainer, Boolean) =
Function(jj) Not jj.Value("format").IsEmptyString OrElse
(Not jj.Value("prefix").IsEmptyString And Not jj.Value("suffix").IsEmptyString) OrElse
(Not jj.Value("start").IsEmptyString And Not jj.Value("end").IsEmptyString)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If j.ListExists Then
If Not j.Value("format").IsEmptyString And j("checksum_indexes").ListExists And
If checkFormat(j) And j("checksum_indexes").ListExists And
Not j.Value("static_param").IsEmptyString And Not j.Value("checksum_constant").IsEmptyString Then _
TextSaver.SaveTextToFile(r, AuthFile, True, False, EDP.ThrowException) : MySettings.LastDateUpdated = Now
End If
@@ -658,12 +671,9 @@ Namespace API.OnlyFans
currentCache.Validate()
Dim cacheRoot As SFile = currentCache.NewPath
cacheRoot.Exists(SFO.Path, True, EDP.ThrowException)
Dim f As SFile = $"{SettingsFolderName}\OFScraperConfigPattern.json"
Dim f As SFile = OFScraperConfigPatternFile
Dim configText$
If Not f.Exists Then
configText = Text.Encoding.UTF8.GetString(My.Resources.OFResources.OFScraperConfigPattern)
TextSaver.SaveTextToFile(configText, f, True)
End If
CheckOFSConfig()
If f.Exists Then
Dim replaceValue$ = String.Empty
Dim rp As RParams = RParams.DMS(String.Empty, 1, RegexReturn.Replace, RegexOptions.IgnoreCase,
@@ -684,6 +694,7 @@ Namespace API.OnlyFans
End If
If Settings.FfmpegFile.Exists Then updateConf("ffmpeg", Settings.FfmpegFile.File.ToString.Replace("\", "/"))
updateConf("key-mode-default", CStr(MySettings.KeyModeDefault.Value).IfNullOrEmpty(SiteSettings.KeyModeDefault_Default))
updateConf("keydb_api", CStr(MySettings.Keydb_Api.Value))
f = currentCache
f.Name = "config"
f.Extension = "json"

View File

@@ -914,19 +914,24 @@ Namespace API.Reddit
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey, RedGifsAccount)
If RedGifsHost Is Nothing Then RedGifsHost = Settings(RedGifs.RedGifsSiteKey).Default
RedGifsResponser = RedGifsHost.Responser.Copy
Dim respNoHeaders As Responser = Responser.Copy
Dim m As UserMedia, m2 As UserMedia
Dim r$
Dim r$, url$
Dim j As EContainer
Dim lastCount%, li%
Dim rv As New ErrorsDescriber(EDP.ReturnValue)
respNoHeaders.Headers.Clear()
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
ProgressPre.Perform()
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
r = Responser.GetResponse($"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json",, EDP.ReturnValue)
url = $"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json"
r = Responser.GetResponse(url,, rv)
If r.IsEmptyString Then r = respNoHeaders.GetResponse(url,, rv)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, EDP.ReturnValue)
j = JsonDocument.Parse(r, rv)
If Not j Is Nothing Then
If j.Count > 0 Then
lastCount = _TempMediaList.Count

View File

@@ -101,7 +101,7 @@ Namespace API.Twitter
ConcurrentDownloads = New PropertyValue(1)
MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "/(twitter|x).com/"), 2)
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, $"/(twitter|x).com({CommunitiesUser}|)/"), 3)
UrlPatternUser = "https://x.com/{0}"
ImageVideoContains = "twitter"
CheckNetscapeCookiesOnEndInit = True
@@ -110,8 +110,9 @@ Namespace API.Twitter
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Const SinglePostPattern As String = "https://x.com/i/web/status/{0}"
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return $"https://x.com/{User.Name}/status/{Media.Post.ID}"
Return String.Format(SinglePostPattern, Media.Post.ID)
End Function
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists
@@ -151,5 +152,18 @@ Namespace API.Twitter
End If
MyBase.Update()
End Sub
Friend Const CommunitiesUser As String = "/i/communities"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim e As ExchangeOptions = MyBase.IsMyUser(UserURL)
If Not e.UserName.IsEmptyString Then
If UserURL.Contains(CommunitiesUser) Then e.Options = CommunitiesUser : e.UserName &= "@c"
Return e
Else
Return Nothing
End If
End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return DirectCast(User, UserData).GetUserUrl
End Function
End Class
End Namespace

View File

@@ -26,8 +26,24 @@ Namespace API.Twitter
Private Const Name_GifsDownload As String = "GifsDownload"
Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder"
Private Const Name_GifsPrefix As String = "GifsPrefix"
Private Const Name_IsCommunity As String = "IsCommunity"
#End Region
#Region "Declarations"
Private Const Label_Community As String = "Community"
Private _NameTrue As String = String.Empty
Friend Property NameTrue As String
Get
Return _NameTrue.IfNullOrEmpty(Name)
End Get
Set(ByVal NewName As String)
_NameTrue = NewName
End Set
End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {Label_Community}
End Get
End Property
Friend Enum DownloadModels As Integer
Undefined = 0
Media = 1
@@ -42,6 +58,7 @@ Namespace API.Twitter
Friend Property GifsDownload As Boolean = True
Friend Property GifsSpecialFolder As String = String.Empty
Friend Property GifsPrefix As String = String.Empty
Friend Property IsCommunity As Boolean = False
Private ReadOnly LikesPosts As List(Of String)
Private ReadOnly _DataNames As List(Of String)
Private ReadOnly Property MySettings As SiteSettings
@@ -57,6 +74,9 @@ Namespace API.Twitter
Private Function RenameGdlFile(ByVal Input As SFile, ByVal i As Integer) As SFile
Return SFile.Rename(Input, $"{Input.PathWithSeparator}{i.NumToString(FileNameProvider)}.{Input.Extension}",, EDP.ThrowException)
End Function
Friend Function GetUserUrl() As String
Return $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/{NameTrue}"
End Function
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object
@@ -121,7 +141,20 @@ Namespace API.Twitter
RemoveExistingDuplicates = .Value(Name_RemoveExistingDuplicates).FromXML(Of Boolean)(False)
StartMD5Checked = .Value(Name_StartMD5Checked).FromXML(Of Boolean)(False)
MediaModelAllowNonUserTweets = .Value(Name_MediaModelAllowNonUserTweets).FromXML(Of Boolean)(False)
IsCommunity = .Value(Name_IsCommunity).FromXML(Of Boolean)(False)
_NameTrue = .Value(Name_TrueName)
Else
If Name.Contains("@") And Not IsCommunity Then
IsCommunity = True
_NameTrue = Name.Split("@")(0)
ID = _NameTrue
ParseUserMediaOnly = False
Labels.ListAddValue(Label_Community, LNC)
Labels.Sort()
.Add(Name_UserID, ID)
.Add(Name_LabelsName, LabelsString)
.Add(Name_ParseUserMediaOnly, ParseUserMediaOnly.BoolToInteger)
End If
.Add(Name_FirstDownloadComplete, FirstDownloadComplete.BoolToInteger)
.Add(Name_DownloadModelForceApply, DownloadModelForceApply.BoolToInteger)
.Add(Name_DownloadModel, CInt(DownloadModel))
@@ -132,6 +165,8 @@ Namespace API.Twitter
.Add(Name_RemoveExistingDuplicates, RemoveExistingDuplicates.BoolToInteger)
.Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger)
.Add(Name_MediaModelAllowNonUserTweets, MediaModelAllowNonUserTweets.BoolToInteger)
.Add(Name_IsCommunity, IsCommunity.BoolToInteger)
.Add(Name_TrueName, _NameTrue)
End If
End With
End Sub
@@ -188,14 +223,15 @@ Namespace API.Twitter
Dim newTwitterNodes() As Object = {0, "content", "items"}
Dim p As Predicate(Of EContainer)
Dim pIndx%
Dim indxChanged As Boolean = False
Dim isOneNode As Boolean, isPins As Boolean, ExistsDetected As Boolean, userInfoParsed As Boolean = False
Dim j As EContainer, rootNode As EContainer, optionalNode As EContainer, workingNode As EContainer, tmpNode As EContainer, nn As EContainer = Nothing
Dim __parseContainer As Func(Of EContainer, Boolean) =
Function(ByVal ee As EContainer) As Boolean
nn = Nothing
If dirIndx > 1 Then nn = ee
If Not nn.ListExists Then
If dirIndx > 1 Or IsCommunity Then nn = ee
If Not nn.ListExists Or IsCommunity Then
For Each node In nodes
nn = ee(node)
If nn.ListExists Then Exit For
@@ -269,30 +305,11 @@ Namespace API.Twitter
For i = 0 To timelineFiles.Count - 1
j = JsonDocument.Parse(timelineFiles(i).GetText)
If Not j Is Nothing Then
If i = 0 Then
If i = 0 And Not indxChanged Then
If Not userInfoParsed Then
userInfoParsed = True
Dim resValue$ = j.Value({"data", "user", "result"}, "__typename").StringTrim.StringToLower
If resValue.IsEmptyString Then
UserExists = False
j.Dispose()
Exit Sub
ElseIf resValue = "userunavailable" Then
UserSuspended = True
j.Dispose()
Exit Sub
Else
With j({"data", "user", "result"})
If .ListExists Then
If ID.IsEmptyString Then
ID = .Value("rest_id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
With .Item({"legacy"})
If .ListExists Then
If .Value("screen_name").StringToLower = Name.ToLower Then
UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description"))
Dim resValue$ = j.Value({"data", IIf(IsCommunity, "communityResults", "user"), "result"}, "__typename").StringTrim.StringToLower
Dim icon$
Dim __getImage As Action(Of String) = Sub(ByVal img As String)
If Not img.IsEmptyString Then
Dim __imgFile As SFile = UrlFile(img, True)
@@ -304,7 +321,51 @@ Namespace API.Twitter
End If
End If
End Sub
Dim icon$ = .Value("profile_image_url_https")
If resValue.IsEmptyString Then
UserExists = False
j.Dispose()
Exit Sub
ElseIf resValue = "userunavailable" Then
UserSuspended = True
j.Dispose()
Exit Sub
ElseIf IsCommunity Then
With j({"data", "communityResults", "result", "community_media_timeline", "timeline", "instructions"})
If .ListExists Then
With .Find(entriesNode, True)
If .ListExists Then
With .ItemF({0, "content", "items", 0, "item", "itemContent", "tweet_results", "result", "tweet", "community_results", "result"})
If .ListExists Then
If ID = .Value("id_str") Then
UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description"))
icon = .Value({"custom_banner_media", "media_info"}, "original_img_url").
IfNullOrEmpty(.Value({"default_banner_media", "media_info"}, "original_img_url"))
If Not icon.IsEmptyString And DownloadIconBanner Then __getImage.Invoke(icon)
End If
End If
End With
End If
End With
End If
End With
i = -1
indxChanged = True
Else
With j({"data", "user", "result"})
If .ListExists Then
If ID.IsEmptyString Then
ID = .Value("rest_id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
With .Item({"legacy"})
If .ListExists Then
If .Value("screen_name").StringToLower = NameTrue.ToLower Then
UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description"))
icon = .Value("profile_image_url_https")
If Not icon.IsEmptyString Then icon = icon.Replace("_normal", String.Empty)
If DownloadIconBanner Then
__getImage.Invoke(.Value("profile_banner_url"))
@@ -316,10 +377,26 @@ Namespace API.Twitter
End If
End With
End If
ElseIf IsCommunity Then
i = -1
indxChanged = True
End If
Else
For pIndx = 0 To IIf(dirIndx < 2 Or dirIndx = 3, 1, 0)
optionalNode = Nothing
rootNode = Nothing
If IsCommunity Then
With j({"data", "communityResults", "result", "community_media_timeline", "timeline", "instructions"})
If .ListExists Then
If i = 0 Then
rootNode = .Find(entriesNode, True)
Else
rootNode = .Find(moduleItemsPredicate, True)
End If
optionalNode = rootNode
End If
End With
Else
Select Case dirIndx
Case 0, 1, 3
rootNode = j({"data", "user", "result", "timeline_v2", "timeline", "instructions"})
@@ -340,10 +417,15 @@ Namespace API.Twitter
rootNode = j({"globalObjects", "tweets"})
optionalNode = rootNode
End Select
End If
If rootNode.ListExists Then
With rootNode
If IsCommunity Then
isOneNode = pIndx = 0
Else
isOneNode = dirIndx < 2 AndAlso .Name = entry
End If
ProgressPre.ChangeMax(If(isOneNode, 1, .Count))
If isOneNode Then
ProgressPre.Perform()
@@ -660,6 +742,7 @@ Namespace API.Twitter
Dim dir As SFile
Dim dm As List(Of DownloadModels) = EnumExtract(Of DownloadModels)(DownloadModel).ListIfNothing
Dim process As Boolean
Dim urlPrePattern$ = $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/"
Using tgdl As New TwitterGDL(Nothing, Token, MySettings.AbortOnLimit.Value) With {
.TempPostsList = _TempPostsList,
@@ -670,7 +753,7 @@ Namespace API.Twitter
}
tgdl.FileExchanger.DeleteCacheOnDispose = False
tgdl.FileExchanger.DeleteRootOnDispose = False
For i As Byte = 0 To 3
For i As Byte = 0 To IIf(IsCommunity, 0, 3)
dir = rootDir.NewPath
dir.Exists(SFO.Path, True, EDP.ThrowException)
outList.Add(dir)
@@ -678,10 +761,10 @@ Namespace API.Twitter
command = $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip --config ""{conf}"" --write-pages "
command &= GdlGetIdFilterString()
Select Case i
Case 0 : command &= $"https://x.com/{Name}/media" : process = dm.Contains(DownloadModels.Media)
Case 1 : command &= $"https://x.com/{Name}" : process = dm.Contains(DownloadModels.Profile)
Case 2 : command &= $"-o search-endpoint=graphql https://x.com/search?q=from:{Name}+include:nativeretweets" : process = dm.Contains(DownloadModels.Search)
Case 3 : command &= $"https://x.com/{Name}/likes" : process = dm.Contains(DownloadModels.Likes)
Case 0 : command &= $"{urlPrePattern}{NameTrue}/media" : process = dm.Contains(DownloadModels.Media) Or IsCommunity
Case 1 : command &= $"{urlPrePattern}{NameTrue}" : process = dm.Contains(DownloadModels.Profile)
Case 2 : command &= $"-o search-endpoint=graphql https://x.com/search?q=from:{NameTrue}+include:nativeretweets" : process = dm.Contains(DownloadModels.Search) And Not IsCommunity
Case 3 : command &= $"{urlPrePattern}{NameTrue}/likes" : process = dm.Contains(DownloadModels.Likes)
Case Else : process = False
End Select
'#If DEBUG Then
@@ -735,7 +818,6 @@ Namespace API.Twitter
#Region "ReparseMissing"
Private _ReparseLikes As Boolean = False
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Const SinglePostPattern$ = "https://x.com/{0}/status/{1}"
Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
Dim cache As CacheKeeper = Nothing
@@ -752,14 +834,7 @@ Namespace API.Twitter
Dim lim%
Dim specFolder$ = IIf(_ReparseLikes, "Likes", String.Empty)
ResetFileNameProvider()
If IsSingleObjectDownload Then
cache = Settings.Cache
ElseIf _ReparseLikes Then
cache = CreateCache()
Else
cache = New CacheKeeper(DownloadContentDefault_GetRootDir.CSFilePS)
cache.CacheDeleteError = CacheDeletionError(cache)
End If
cache = If(IsSingleObjectDownload, Settings.Cache, CreateCache())
If _ReparseLikes Then lim = LikesPosts.Count Else lim = _ContentList.Count
ProgressPre.ChangeMax(lim)
For i = 0 To lim - 1
@@ -773,7 +848,7 @@ Namespace API.Twitter
ElseIf _ReparseLikes Then
URL = LikesPosts(i)
Else
URL = String.Format(SinglePostPattern, Name, m.Post.ID)
URL = String.Format(SiteSettings.SinglePostPattern, m.Post.ID)
End If
f = GetDataFromGalleryDL(URL, cache, False, Token)
If Not f.IsEmptyString Then

View File

@@ -58,7 +58,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Change 'ActiveDownloadingProgress' size")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub Downloader_Reconfigured()

View File

@@ -16,6 +16,7 @@ Imports PersonalUtilities.Tools.Notifications
Namespace DownloadObjects
Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider, IComparable(Of AutoDownloader)
Friend Event PauseChanged(ByVal Value As PauseModes)
Friend Event PlanChanged As Scheduler.PlanChangedEventHandler
Friend Enum Modes As Integer
None = 0
Specified = 3
@@ -199,6 +200,52 @@ Namespace DownloadObjects
Private Const Name_ShowSimpleNotification As String = "ShowSimpleNotification"
#End Region
#Region "Declarations"
Private _LVIState As Integer = 0
Friend Function LVIStateChanged() As Boolean
Dim ____LVIState%
Dim result As Boolean
If Downloading Then
____LVIState = 1
ElseIf DownloadReady(True, True) Or ForceStartRequested Then
____LVIState = 2
ElseIf Not Working And Not IsManual Then
____LVIState = 3
ElseIf IsPaused Then
____LVIState = 4
ElseIf Settings.AutomationBrushUndownloadedPlansMinutes.Value > 0 AndAlso
LastDownloadDate.AddMinutes(Settings.AutomationBrushUndownloadedPlansMinutes.Value) < Now Then
____LVIState = 5
Else
____LVIState = 0
End If
result = Not _LVIState = ____LVIState
_LVIState = ____LVIState
Return result
End Function
Friend ReadOnly Property LVI As ListViewItem
Get
Dim l As New ListViewItem(ToString)
If Downloading Then
l.BackColor = MyColor.OkBack
l.ForeColor = MyColor.OkFore
ElseIf DownloadReady(True, True) Or ForceStartRequested Then
l.BackColor = MyColor.EditBack
l.ForeColor = MyColor.EditFore
ElseIf Not Working And Not IsManual Then
l.BackColor = MyColor.DeleteBack
l.ForeColor = MyColor.DeleteFore
ElseIf Working And IsPaused And Not IsManual Then
l.BackColor = MyColor.UpdateBack
l.ForeColor = MyColor.UpdateFore
ElseIf Settings.AutomationBrushUndownloadedPlansMinutes.Value > 0 AndAlso
LastDownloadDate.AddMinutes(Settings.AutomationBrushUndownloadedPlansMinutes.Value) < Now Then
l.BackColor = Color.FromArgb(224, 224, 224)
l.ForeColor = Color.FromArgb(64, 64, 64)
End If
LVIStateChanged()
Return l
End Get
End Property
Friend Property Source As Scheduler
Private _Mode As Modes = Modes.None
Friend Property Mode As Modes
@@ -267,11 +314,15 @@ Namespace DownloadObjects
End Property
Private Function GetWorkingState() As String
Dim OutStr$
If Working Then
If StartupDelay > 0 And _StartTime.AddMinutes(StartupDelay) > Now Then
OutStr = $"delayed until {_StartTime.AddMinutes(StartupDelay).ToStringDate(ADateTime.Formats.BaseDateTime)}"
If Working And Not IsManual Then
If _Downloading Then
OutStr = "downloading"
ElseIf _ForceStartRequested Then
OutStr = "force start pending"
ElseIf _StopRequested Then
OutStr = "stopping"
ElseIf StartupDelay > 0 And _StartTime.AddMinutes(StartupDelay) > Now Then
OutStr = $"delayed ({StartupDelay}) until {_StartTime.AddMinutes(StartupDelay).ToStringDate(ADateTime.Formats.BaseDateTime)}"
Else
OutStr = "working"
End If
@@ -282,14 +333,26 @@ Namespace DownloadObjects
Case Else : OutStr &= $", paused ([{Pause}] until {AConvert(Of String)(_PauseValue, ADateTime.Formats.BaseDateTime, "?")})"
End Select
End If
ElseIf IsManual Then
If _Downloading Then
OutStr = "downloading"
ElseIf _ForceStartRequested Then
OutStr = "force start pending"
Else
OutStr = String.Empty
End If
Else
OutStr = "stopped"
End If
Return OutStr
End Function
Private Function GetWorkingState_Manual() As String
Dim OutStr$ = GetWorkingState()
If Not OutStr.IsEmptyString Then Return $" ({OutStr})" Else Return String.Empty
End Function
Public Overrides Function ToString() As String
If IsManual Then
Return $"{Name} (manual): last download date: {GetLastDateString()}"
Return $"{Name} (manual{GetWorkingState_Manual()}): last download date: {GetLastDateString()}"
Else
Return $"{Name} ({GetWorkingState()}): last download date: {GetLastDateString()}; next run: {GetNextDateString()}"
End If
@@ -316,6 +379,7 @@ Namespace DownloadObjects
Friend Sub New(ByVal x As EContainer)
Me.New
Initialization = True
'URGENT: replace this line
Dim m% = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
If m = 1 Or m = 2 Then m = Modes.Specified
Mode = m
@@ -395,10 +459,10 @@ Namespace DownloadObjects
End Function
#End Region
#Region "Execution"
Private AThread As Thread
Private _Working As Boolean = False
Friend ReadOnly Property Working As Boolean
Get
Return If(AThread?.IsAlive, False)
Return _Working
End Get
End Property
Private _StartTime As Date = Now
@@ -406,11 +470,8 @@ Namespace DownloadObjects
If Not IsManual Or Force Then
If Init Then _StartTime = Now
_IsNewPlan = False
If Not Working And Not Mode = Modes.None Then
AThread = New Thread(New ThreadStart(AddressOf Checker))
AThread.SetApartmentState(ApartmentState.MTA)
AThread.Start()
End If
If Not Working And Not Mode = Modes.None Then _Working = True
RaiseEvent PlanChanged(Me)
End If
End Sub
Private _StopRequested As Boolean = False
@@ -434,6 +495,7 @@ Namespace DownloadObjects
Case Else : _PauseValue = Nothing
End Select
RaiseEvent PauseChanged(p)
RaiseEvent PlanChanged(Me)
End Set
End Property
Private ReadOnly Property IsPaused As Boolean
@@ -457,7 +519,10 @@ Namespace DownloadObjects
End Get
End Property
Friend Sub [Stop]()
If Working Then _StopRequested = True
If Working Then
If Downloading Then _StopRequested = True Else _Working = False
RaiseEvent PlanChanged(Me)
End If
End Sub
Friend Overloads Sub Skip()
If LastDownloadDate.AddMinutes(Timer) <= Now Then
@@ -465,65 +530,59 @@ Namespace DownloadObjects
Else
_LastDownloadDateSkip = LastDownloadDate.AddMinutes(Timer)
End If
RaiseEvent PlanChanged(Me)
End Sub
Friend Overloads Sub Skip(ByVal Minutes As Integer)
_LastDownloadDateSkip = If(_LastDownloadDateSkip, Now).AddMinutes(Minutes)
RaiseEvent PlanChanged(Me)
End Sub
Friend Overloads Sub Skip(ByVal ToDate As Date)
_LastDownloadDateSkip = ToDate
RaiseEvent PlanChanged(Me)
End Sub
Friend Sub SkipReset()
_LastDownloadDateSkip = Nothing
RaiseEvent PlanChanged(Me)
End Sub
Friend Sub ForceStart()
_ForceStartRequested = True
If IsManual Then Start(False, True)
RaiseEvent PlanChanged(Me)
End Sub
Private _ForceStartRequested As Boolean = False
Private _SpecialDelayUse As Boolean = False
Private _SpecialDelayTime As Date? = Nothing
Private Sub Checker()
Try
Dim _StartDownload As Boolean
While (Not _StopRequested Or Downloader.Working) And Not Mode = Modes.None
If ((IsManual And _ForceStartRequested) Or (NextExecutionDate < Now And Not IsPaused) Or _ForceStartRequested) And
Not _StopRequested And Not Mode = Modes.None Then
If Downloader.Working Then
_SpecialDelayUse = True
Else
If _SpecialDelayUse And Not _SpecialDelayTime.HasValue Then _SpecialDelayTime = Now.AddSeconds(10)
If Not _SpecialDelayUse OrElse (_SpecialDelayTime.HasValue AndAlso _SpecialDelayTime.Value < Now) Then
_SpecialDelayUse = False
_SpecialDelayTime = Nothing
_StartDownload = False
If Settings.Automation.Count = 1 Or _ForceStartRequested Or Index = -1 Then
_StartDownload = True
Else
_StartDownload = NextExecutionDate.AddMilliseconds(1000 * (Index + 1)).Ticks <= Now.Ticks
End If
If _StartDownload Then
Download()
If IsManual Then Exit While
Friend ReadOnly Property ForceStartRequested As Boolean
Get
Return _ForceStartRequested
End Get
End Property
Friend ReadOnly Property DownloadReady(Optional ByVal IgnorePause As Boolean = False, Optional ByVal IgnoreDownloaderWorking As Boolean = False) As Boolean
Get
If _StopRequested Then _Working = False
Return (Working Or IsManual) And ((IsManual And _ForceStartRequested) Or (Not IsManual And NextExecutionDate < Now And (Not IsPaused Or IgnorePause)) Or _ForceStartRequested) And
Not _StopRequested And Not Mode = Modes.None And (Not Downloader.Working Or IgnoreDownloaderWorking)
End Get
End Property
Friend ReadOnly Property NextDate As Date?
Get
If Not _StopRequested And Not Mode = Modes.None Then
If IsManual Or _ForceStartRequested Then
Return Now.AddYears(-10)
ElseIf Not IsPaused And Not IsManual And Working Then
Return NextExecutionDate
End If
End If
End If
End If
Thread.Sleep(500)
End While
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[AutoDownloader.Checker]")
Finally
_StopRequested = False
End Try
End Sub
Return Nothing
End Get
End Property
Private _Downloading As Boolean = False
Friend ReadOnly Property Downloading As Boolean
Get
Return _Downloading
End Get
End Property
Private Sub Download()
Friend Sub Download()
_Downloading = True
RaiseEvent PlanChanged(Me)
Dim Keys As New List(Of String)
Try
Dim users As New List(Of IUserData)
@@ -589,7 +648,7 @@ Namespace DownloadObjects
While .Working Or .Count > 0 : notify.Invoke() : Thread.Sleep(200) : End While
.AutoDownloaderWorking = False
notify.Invoke
If simple And DownloadedUsersCount + DownloadedSubscriptionsCount > 0 Then
If simple And (DownloadedUsersCount + DownloadedSubscriptionsCount) > 0 Then
Dim msg$ = String.Empty
If DownloadedUsersCount > 0 Then msg = $"{DownloadedUsersCount} user(s) "
If DownloadedSubscriptionsCount > 0 Then msg &= $"{IIf(DownloadedUsersCount > 0, "and ", String.Empty)}{DownloadedSubscriptionsCount} subscription(s) "
@@ -607,6 +666,8 @@ Namespace DownloadObjects
_Downloading = False
_ForceStartRequested = False
_LastDownloadDateSkip = Nothing
If _StopRequested Then _Working = False
RaiseEvent PlanChanged(Me)
End Try
End Sub
Private Sub ShowNotification(ByVal u As IUserData)

View File

@@ -14,15 +14,19 @@ Imports PauseModes = SCrawler.DownloadObjects.AutoDownloader.PauseModes
Namespace DownloadObjects
Friend Class Scheduler : Implements IEnumerable(Of AutoDownloader), IMyEnumerator(Of AutoDownloader), IDisposable
Friend Const Name_Plan As String = "Plan"
Friend Delegate Sub PlanChangedEventHandler(ByVal Plan As AutoDownloader)
Friend Event PauseChanged As AutoDownloader.PauseChangedEventHandler
Private Sub OnPauseChanged(ByVal Value As PauseModes)
RaiseEvent PauseChanged(Pause)
End Sub
Friend Event PlanChanged As PlanChangedEventHandler
Private Sub OnPlanChanged(ByVal Plan As AutoDownloader)
Try : RaiseEvent PlanChanged(Plan) : Catch : End Try
End Sub
Private ReadOnly Plans As List(Of AutoDownloader)
Friend Const FileNameDefault As String = "AutoDownload"
Friend ReadOnly FileDefault As SFile = $"{SettingsFolderName}\{FileNameDefault}.xml"
Friend File As SFile = Nothing
Private ReadOnly PlanWorking As Predicate(Of AutoDownloader) = Function(Plan) Plan.Working
Private ReadOnly PlanDownloading As Predicate(Of AutoDownloader) = Function(Plan) Plan.Downloading
Private ReadOnly PlansWaiter As Action(Of Predicate(Of AutoDownloader)) = Sub(ByVal Predicate As Predicate(Of AutoDownloader))
While Plans.Exists(Predicate) : Thread.Sleep(200) : End While
@@ -69,6 +73,7 @@ Namespace DownloadObjects
Friend Sub Add(ByVal Plan As AutoDownloader)
Plan.Source = Me
AddHandler Plan.PauseChanged, AddressOf OnPauseChanged
AddHandler Plan.PlanChanged, AddressOf OnPlanChanged
Plans.Add(Plan)
Plans.ListReindex
Update()
@@ -77,9 +82,9 @@ Namespace DownloadObjects
If Index.ValueBetween(0, Count - 1) Then
With Plans(Index)
.Stop()
If .Working Then
If .Downloading Then
Await Task.Run(Sub()
While .Working : Thread.Sleep(510) : End While
While .Downloading : Thread.Sleep(510) : End While
End Sub)
End If
.Dispose()
@@ -103,10 +108,10 @@ Namespace DownloadObjects
End Try
End Sub
Friend Function Reset(ByVal f As SFile, ByVal IsInit As Boolean) As Boolean
If Plans.Count > 0 Then
If Not Plans.Exists(PlanWorking) Then
If Count > 0 Then
If Not Plans.Exists(PlanDownloading) Then
Pause = PauseModes.Unlimited
If Plans.Exists(PlanWorking) Then
If Plans.Exists(PlanDownloading) Then
MsgBoxE({$"Some plans are already being worked.{vbCr}Wait for the plans to complete their work and try again.",
"Change scheduler"}, vbCritical)
Pause = PauseModes.Unlimited
@@ -114,6 +119,7 @@ Namespace DownloadObjects
End If
End If
[Stop]()
While Working : Thread.Sleep(200) : End While
If _UpdateRequired Then Update()
Plans.ListClearDispose(,, EDP.LogMessageValue)
End If
@@ -127,10 +133,11 @@ Namespace DownloadObjects
Plans.Add(New AutoDownloader(x))
End If
End Using
If Plans.Count > 0 Then Plans.ForEach(Sub(ByVal p As AutoDownloader)
If Count > 0 Then Plans.ForEach(Sub(ByVal p As AutoDownloader)
p.Source = Me
If Not IsInit Then p.Pause = PauseModes.Unlimited
AddHandler p.PauseChanged, AddressOf OnPauseChanged
AddHandler p.PlanChanged, AddressOf OnPlanChanged
End Sub) : Plans.ListReindex
End If
Return True
@@ -163,38 +170,94 @@ Namespace DownloadObjects
End Sub
#End Region
#Region "Execution"
Private AThread As Thread = Nothing
Private _StopRequested As Boolean = False
Friend ReadOnly Property Working As Boolean
Get
Return If(AThread?.IsAlive, False)
End Get
End Property
Friend Async Function Start(ByVal Init As Boolean) As Task
Try
_StopRequested = False
Await Task.Run(Sub()
Dim r% = 0
Do
r += 1
Try
If Count > 0 Then
If Plans.Exists(PlanDownloading) Then PlansWaiter(PlanDownloading)
For Each Plan In Plans
Plan.Start(Init)
PlansWaiter(PlanDownloading)
Thread.Sleep(1000)
Next
End If
If Count > 0 Then PlansWaiter(PlanDownloading) : Plans.ForEach(Sub(p) p.Start(Init))
Exit Do
Catch io_ex As InvalidOperationException 'Collection was modified; enumeration operation may not execute
End Try
Loop While r < 10
End Sub)
If Not Working Then
AThread = New Thread(New ThreadStart(AddressOf Checker))
AThread.SetApartmentState(ApartmentState.MTA)
AThread.Start()
End If
Catch ex As Exception
If Init Then
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Start automation")
MainFrameObj.UpdateLogButton()
Else
Throw ex
End If
End Try
End Function
Friend Sub [Stop]()
If Working Then _StopRequested = True
If Count > 0 Then Plans.ForEach(Sub(p) p.Stop())
End Sub
Private Sub Checker()
Do
Try
If Count = 0 Or _StopRequested Then Exit Sub
PlansWaiter.Invoke(PlanDownloading)
Dim i% = Checker_GetNextPlanIndex()
If i >= 0 Then Checker_DownloadPlan(i)
Thread.Sleep(500)
Catch dex As ArgumentOutOfRangeException When disposedValue Or _StopRequested
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[Scheduler.Checker]")
End Try
Loop While Not _StopRequested
_StopRequested = False
End Sub
Private Sub Checker_DownloadPlan(ByVal PlanIndex As Integer)
While Downloader.Working : Thread.Sleep(200) : End While
With Plans(PlanIndex)
If .Downloading Then
PlansWaiter.Invoke(PlanDownloading)
ElseIf .DownloadReady Then
.Download()
End If
End With
End Sub
Private Function Checker_GetNextPlanIndex() As Integer
Try
Dim result% = -1
Dim l As New List(Of KeyValuePair(Of Integer, Date))
Dim d As Date?
If Count > 0 Then
For i% = 0 To Count - 1
With Plans(i)
If .DownloadReady Then
d = .NextDate
If d.HasValue Then l.Add(New KeyValuePair(Of Integer, Date)(i, d.Value))
End If
End With
Next
End If
If l.Count > 0 Then
Dim md As Date = l.Min(Function(p) p.Value)
result = l.Find(Function(p) p.Value = md).Key
l.Clear()
End If
Return result
Catch
Return -1
End Try
End Function
Friend Property Pause(Optional ByVal LimitDate As Date? = Nothing) As PauseModes
Get
If Count > 0 Then Return Plans.FirstOrDefault(Function(p) p.Pause >= PauseModes.Disabled).Pause Else Return PauseModes.Disabled
@@ -218,7 +281,8 @@ Namespace DownloadObjects
If Not disposedValue Then
If disposing Then
[Stop]()
If Plans.Exists(PlanWorking) Then Task.WaitAll(Task.Run(Sub() PlansWaiter(PlanWorking)))
If Plans.Exists(PlanDownloading) Then Task.WaitAll(Task.Run(Sub() PlansWaiter(PlanDownloading)))
While Working : Thread.Sleep(200) : End While
If _UpdateRequired Then Update()
Plans.ListClearDispose
End If

View File

@@ -23,7 +23,8 @@ Namespace DownloadObjects
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Me.LIST_PLANS = New System.Windows.Forms.ListBox()
Me.LIST_PLANS = New System.Windows.Forms.ListView()
Me.COL_MAIN = CType(New System.Windows.Forms.ColumnHeader(), System.Windows.Forms.ColumnHeader)
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
@@ -47,12 +48,25 @@ Namespace DownloadObjects
'
'LIST_PLANS
'
Me.LIST_PLANS.Alignment = System.Windows.Forms.ListViewAlignment.Left
Me.LIST_PLANS.Columns.AddRange(New System.Windows.Forms.ColumnHeader() {Me.COL_MAIN})
Me.LIST_PLANS.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_PLANS.FormattingEnabled = True
Me.LIST_PLANS.FullRowSelect = True
Me.LIST_PLANS.HeaderStyle = System.Windows.Forms.ColumnHeaderStyle.None
Me.LIST_PLANS.HideSelection = False
Me.LIST_PLANS.Location = New System.Drawing.Point(0, 0)
Me.LIST_PLANS.MultiSelect = False
Me.LIST_PLANS.Name = "LIST_PLANS"
Me.LIST_PLANS.ShowGroups = False
Me.LIST_PLANS.Size = New System.Drawing.Size(414, 316)
Me.LIST_PLANS.TabIndex = 0
Me.LIST_PLANS.UseCompatibleStateImageBehavior = False
Me.LIST_PLANS.View = System.Windows.Forms.View.Details
'
'COL_MAIN
'
Me.COL_MAIN.Text = "Task"
Me.COL_MAIN.Width = 410
'
'SchedulerEditorForm
'
@@ -63,7 +77,6 @@ Namespace DownloadObjects
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(430, 380)
Me.Name = "SchedulerEditorForm"
Me.ShowIcon = True
Me.ShowInTaskbar = False
Me.Text = "Scheduler"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
@@ -72,6 +85,7 @@ Namespace DownloadObjects
Me.ResumeLayout(False)
End Sub
Private WithEvents LIST_PLANS As ListBox
Private WithEvents LIST_PLANS As ListView
Private WithEvents COL_MAIN As ColumnHeader
End Class
End Namespace

View File

@@ -6,6 +6,8 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Forms.Controls.Base
@@ -131,6 +133,16 @@ Namespace DownloadObjects
SetTitle()
.EndLoaderOperations(False)
End With
SchedulerCheckerThread = New Thread(New ThreadStart(AddressOf SchedulerChecker))
SchedulerCheckerThread.SetApartmentState(ApartmentState.MTA)
SchedulerCheckerThread.Start()
Try : AddHandler Settings.Automation.PlanChanged, AddressOf Scheduler_PauseChanged : Catch : End Try
End Sub
Private _CloseRequested As Boolean = False
Private Sub SchedulerEditorForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
_CloseRequested = True
While If(SchedulerCheckerThread?.IsAlive, False) : Thread.Sleep(200) : End While
Try : RemoveHandler Settings.Automation.PlanChanged, AddressOf Scheduler_PauseChanged : Catch : End Try
End Sub
Private Sub SchedulerEditorForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.Escape Then
@@ -143,21 +155,48 @@ Namespace DownloadObjects
Private Sub SchedulerEditorForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
PauseArr.Dispose()
End Sub
Private Sub SchedulerEditorForm_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
Try : ControlInvokeFast(LIST_PLANS, Sub()
COL_MAIN.Width = -2
LIST_PLANS.Refresh()
End Sub, EDP.None) : Catch : End Try
End Sub
#End Region
Private Property ListSelectedIndex As Integer
Get
Return If(LIST_PLANS.SelectedIndices.Count > 0, LIST_PLANS.SelectedIndices(0), -1)
End Get
Set(ByVal indx As Integer)
Try : ControlInvokeFast(LIST_PLANS, Sub()
With LIST_PLANS
.SelectedItems.Clear()
.Items(indx).Selected = True
.FocusedItem = .Items(indx)
.Refresh()
.EnsureVisible(indx)
End With
End Sub, EDP.None) : Catch : End Try
End Set
End Property
Private _RefillInProgress As Boolean = False
Private Sub Refill() Handles MyDefs.ButtonUpdateClick
Try
ControlInvokeFast(LIST_PLANS,
Sub()
If Not _RefillInProgress Then
_RefillInProgress = True
LIST_PLANS.Items.Clear()
With LIST_PLANS.Items
.Clear()
If Settings.Automation.Count > 0 Then
LIST_PLANS.Items.AddRange(Settings.Automation.Select(Function(a) a.ToString()).Cast(Of Object).ToArray)
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then LIST_PLANS.SelectedIndex = _LatestSelected
.AddRange(Settings.Automation.Select(Function(a) a.LVI).ToArray)
If _LatestSelected.ValueBetween(0, .Count - 1) Then ListSelectedIndex = _LatestSelected
Else
_LatestSelected = -1
End If
End With
_RefillInProgress = False
End If
End Sub)
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.SchedulerEditorForm.Refill]")
End Try
@@ -196,7 +235,7 @@ Namespace DownloadObjects
Private Sub Edit() Handles MyDefs.ButtonEditClick
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
Using f As New AutoDownloaderEditorForm(Settings.Automation(_LatestSelected)) : f.ShowDialog() : End Using
Refill()
LIST_PLANS_Refresh(_LatestSelected)
Else
MsgBoxE("You have not selected a plan to edit.", vbExclamation)
End If
@@ -224,14 +263,59 @@ Namespace DownloadObjects
#End Region
#Region "List handlers"
Private _LatestSelected As Integer = -1
Private _LatestSelectedChangeEnabled As Boolean = True
Private Sub LIST_PLANS_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_PLANS.SelectedIndexChanged
_LatestSelected = LIST_PLANS.SelectedIndex
If _LatestSelectedChangeEnabled Then
_LatestSelected = ListSelectedIndex
PauseArr.PlanIndex = _LatestSelected
PauseArr.UpdatePauseButtons(False)
End If
End Sub
Private Sub LIST_PLANS_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles LIST_PLANS.MouseDoubleClick
Edit()
End Sub
Private Sub LIST_PLANS_Refresh(Optional ByVal PlanIndex As Integer = -1)
_LatestSelectedChangeEnabled = False
Try
ControlInvokeFast(LIST_PLANS,
Sub()
Dim indx% = If(PlanIndex >= 0, PlanIndex, ListSelectedIndex)
If indx = -1 And PlanIndex = -1 Then indx = _LatestSelected
If indx.ValueBetween(0, Settings.Automation.Count - 1) Then _
LIST_PLANS.Items(indx) = Settings.Automation(indx).LVI
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then ListSelectedIndex = _LatestSelected
End Sub, EDP.None)
Catch
Finally
_LatestSelectedChangeEnabled = True
End Try
End Sub
Private Sub Scheduler_PauseChanged(ByVal Plan As AutoDownloader)
LIST_PLANS_Refresh(Plan.Index)
End Sub
Private SchedulerCheckerThread As Thread
Private Sub SchedulerChecker()
Try
While Not _CloseRequested
Try
With Settings.Automation
If .Count > 0 Then
For i% = 0 To .Count - 1
If .Item(i).LVIStateChanged Then LIST_PLANS_Refresh(i)
If _CloseRequested Then Exit Sub
Thread.Sleep(200)
Next
Else
If _CloseRequested Then Exit Sub
Thread.Sleep(200)
End If
End With
Catch
End Try
End While
Catch
End Try
End Sub
#End Region
#Region "Settings, Start, Skip, Pause"
Private Function GetSchedulerFiles() As List(Of SFile)
@@ -372,13 +456,13 @@ Namespace DownloadObjects
Private Sub BTT_START_Click(sender As Object, e As EventArgs) Handles BTT_START.Click
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
With Settings.Automation(_LatestSelected) : .Start(.IsNewPlan) : End With
Refill()
LIST_PLANS_Refresh(_LatestSelected)
End If
End Sub
Private Sub BTT_START_FORCE_Click(sender As Object, e As EventArgs) Handles BTT_START_FORCE.Click
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
With Settings.Automation(_LatestSelected)
If .Working Or .IsManual Then .ForceStart() : Refill()
If .Working Or .IsManual Then .ForceStart() : LIST_PLANS_Refresh(_LatestSelected)
End With
End If
End Sub
@@ -388,10 +472,10 @@ Namespace DownloadObjects
Select Case mode
Case String.Empty
Settings.Automation(_LatestSelected).Skip()
Refill()
LIST_PLANS_Refresh(_LatestSelected)
Case "m"
Dim mins% = AConvert(Of Integer)(InputBoxE("Enter a number of minutes you want to delay:", Sender.Text, 60), -1)
If mins > 0 Then Settings.Automation(_LatestSelected).Skip(mins) : Refill()
If mins > 0 Then Settings.Automation(_LatestSelected).Skip(mins) : LIST_PLANS_Refresh(_LatestSelected)
Case "d"
Dim d As Date? = Nothing
Using f As New DateTimeSelectionForm(DateTimeSelectionForm.Modes.Date +
@@ -402,16 +486,13 @@ Namespace DownloadObjects
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then d = f.MyDateStart
End Using
If d.HasValue Then Settings.Automation(_LatestSelected).Skip(d.Value) : Refill()
If d.HasValue Then Settings.Automation(_LatestSelected).Skip(d.Value) : LIST_PLANS_Refresh(_LatestSelected)
Case "r"
Settings.Automation(_LatestSelected).SkipReset()
Refill()
LIST_PLANS_Refresh(_LatestSelected)
End Select
End If
End Sub
Private Sub PauseArr_Updating() Handles PauseArr.Updating
Refill()
End Sub
#End Region
#Region "Move"
Private Sub BTT_MOVE_UP_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_MOVE_UP.Click, BTT_MOVE_DOWN.Click

View File

@@ -35,6 +35,7 @@ Namespace DownloadObjects
Dim MENU_LOAD_SEP_7 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_0 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_8 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_9 As System.Windows.Forms.ToolStripSeparator
Me.OPT_DEFAULT = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_SUBSCRIPTIONS = New System.Windows.Forms.ToolStripMenuItem()
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
@@ -57,19 +58,23 @@ Namespace DownloadObjects
Me.BTT_FEED_DELETE_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_LIST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_DATE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CURR_SESSION_SET = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MERGE_SESSIONS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CLEAR_DAILY = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MERGE_FEEDS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CHECK_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CHECK_NONE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_SAVE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_LOAD = 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()
Me.BTT_VIEW_SAVE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_LOAD = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_COPY_SPEC_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MOVE_SPEC_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_RESET_DAILY = New System.Windows.Forms.ToolStripMenuItem()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton()
@@ -82,6 +87,7 @@ Namespace DownloadObjects
MENU_LOAD_SEP_7 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_0 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_8 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_9 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout()
Me.SuspendLayout()
'
@@ -157,6 +163,11 @@ Namespace DownloadObjects
MENU_LOAD_SEP_0.Name = "MENU_LOAD_SEP_0"
MENU_LOAD_SEP_0.Size = New System.Drawing.Size(349, 6)
'
'MENU_LOAD_SEP_8
'
MENU_LOAD_SEP_8.Name = "MENU_LOAD_SEP_8"
MENU_LOAD_SEP_8.Size = New System.Drawing.Size(349, 6)
'
'ToolbarTOP
'
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
@@ -170,7 +181,7 @@ Namespace DownloadObjects
'
Me.MENU_LOAD_SESSION.AutoToolTip = False
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_0, Me.BTT_COPY_TO, Me.BTT_MOVE_TO, MENU_LOAD_SEP_1, Me.BTT_LOAD_FAV, Me.BTT_LOAD_SPEC, MENU_LOAD_SEP_2, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_ADD_FAV_REMOVE, Me.BTT_FEED_REMOVE_FAV, MENU_LOAD_SEP_3, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_ADD_SPEC_REMOVE, 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, MENU_LOAD_SEP_6, Me.BTT_MERGE_FEEDS, MENU_LOAD_SEP_7, Me.BTT_CHECK_ALL, Me.BTT_CHECK_NONE, MENU_LOAD_SEP_8, Me.BTT_VIEW_SAVE, Me.BTT_VIEW_LOAD})
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_0, Me.BTT_COPY_TO, Me.BTT_MOVE_TO, MENU_LOAD_SEP_1, Me.BTT_COPY_SPEC_TO, Me.BTT_MOVE_SPEC_TO, MENU_LOAD_SEP_2, Me.BTT_LOAD_FAV, Me.BTT_LOAD_SPEC, MENU_LOAD_SEP_3, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_ADD_FAV_REMOVE, Me.BTT_FEED_REMOVE_FAV, MENU_LOAD_SEP_4, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_ADD_SPEC_REMOVE, Me.BTT_FEED_REMOVE_SPEC, MENU_LOAD_SEP_5, 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_6, Me.BTT_CURR_SESSION_SET, Me.BTT_MERGE_SESSIONS, Me.BTT_CLEAR_DAILY, Me.BTT_RESET_DAILY, MENU_LOAD_SEP_7, Me.BTT_MERGE_FEEDS, MENU_LOAD_SEP_8, Me.BTT_CHECK_ALL, Me.BTT_CHECK_NONE, MENU_LOAD_SEP_9, Me.BTT_VIEW_SAVE, Me.BTT_VIEW_LOAD})
Me.MENU_LOAD_SESSION.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.MENU_LOAD_SESSION.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_LOAD_SESSION.Name = "MENU_LOAD_SESSION"
@@ -303,6 +314,15 @@ Namespace DownloadObjects
Me.BTT_FEED_DELETE_DAILY_DATE.Size = New System.Drawing.Size(352, 22)
Me.BTT_FEED_DELETE_DAILY_DATE.Text = "Delete daily feed (by date)"
'
'BTT_CURR_SESSION_SET
'
Me.BTT_CURR_SESSION_SET.AutoToolTip = True
Me.BTT_CURR_SESSION_SET.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_CURR_SESSION_SET.Name = "BTT_CURR_SESSION_SET"
Me.BTT_CURR_SESSION_SET.Size = New System.Drawing.Size(352, 22)
Me.BTT_CURR_SESSION_SET.Text = "Set current session..."
Me.BTT_CURR_SESSION_SET.ToolTipText = "Select one of the download sessions and set it as the current session"
'
'BTT_MERGE_SESSIONS
'
Me.BTT_MERGE_SESSIONS.AutoToolTip = True
@@ -343,6 +363,20 @@ Namespace DownloadObjects
Me.BTT_CHECK_NONE.Size = New System.Drawing.Size(352, 22)
Me.BTT_CHECK_NONE.Text = "Select none"
'
'BTT_VIEW_SAVE
'
Me.BTT_VIEW_SAVE.Name = "BTT_VIEW_SAVE"
Me.BTT_VIEW_SAVE.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_SAVE.Text = "Save current view"
'
'BTT_VIEW_LOAD
'
Me.BTT_VIEW_LOAD.AutoToolTip = True
Me.BTT_VIEW_LOAD.Name = "BTT_VIEW_LOAD"
Me.BTT_VIEW_LOAD.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_LOAD.Text = "Load view (from saved)"
Me.BTT_VIEW_LOAD.ToolTipText = "Load one of your previously saved views"
'
'SEP_0
'
Me.SEP_0.Name = "SEP_0"
@@ -409,24 +443,37 @@ Namespace DownloadObjects
Me.TP_DATA.Size = New System.Drawing.Size(484, 436)
Me.TP_DATA.TabIndex = 1
'
'MENU_LOAD_SEP_8
'MENU_LOAD_SEP_9
'
MENU_LOAD_SEP_8.Name = "MENU_LOAD_SEP_8"
MENU_LOAD_SEP_8.Size = New System.Drawing.Size(349, 6)
MENU_LOAD_SEP_9.Name = "MENU_LOAD_SEP_9"
MENU_LOAD_SEP_9.Size = New System.Drawing.Size(349, 6)
'
'BTT_VIEW_SAVE
'BTT_COPY_SPEC_TO
'
Me.BTT_VIEW_SAVE.Name = "BTT_VIEW_SAVE"
Me.BTT_VIEW_SAVE.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_SAVE.Text = "Save current view"
Me.BTT_COPY_SPEC_TO.AutoToolTip = True
Me.BTT_COPY_SPEC_TO.Image = Global.SCrawler.My.Resources.Resources.PastePic_32
Me.BTT_COPY_SPEC_TO.Name = "BTT_COPY_SPEC_TO"
Me.BTT_COPY_SPEC_TO.Size = New System.Drawing.Size(352, 22)
Me.BTT_COPY_SPEC_TO.Text = "Copy feed/session files to..."
Me.BTT_COPY_SPEC_TO.ToolTipText = "Copy all the files of the loaded feed/session to..."
'
'BTT_VIEW_LOAD
'BTT_MOVE_SPEC_TO
'
Me.BTT_VIEW_LOAD.AutoToolTip = True
Me.BTT_VIEW_LOAD.Name = "BTT_VIEW_LOAD"
Me.BTT_VIEW_LOAD.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_LOAD.Text = "Load view (from saved)"
Me.BTT_VIEW_LOAD.ToolTipText = "Load one of your previously saved views"
Me.BTT_MOVE_SPEC_TO.AutoToolTip = True
Me.BTT_MOVE_SPEC_TO.Image = Global.SCrawler.My.Resources.Resources.CutPic_48
Me.BTT_MOVE_SPEC_TO.Name = "BTT_MOVE_SPEC_TO"
Me.BTT_MOVE_SPEC_TO.Size = New System.Drawing.Size(352, 22)
Me.BTT_MOVE_SPEC_TO.Text = "Move feed/session files to..."
Me.BTT_MOVE_SPEC_TO.ToolTipText = "Move all the files of the loaded feed/session to..."
'
'BTT_RESET_DAILY
'
Me.BTT_RESET_DAILY.AutoToolTip = True
Me.BTT_RESET_DAILY.Image = Global.SCrawler.My.Resources.Resources.RefreshPic_24
Me.BTT_RESET_DAILY.Name = "BTT_RESET_DAILY"
Me.BTT_RESET_DAILY.Size = New System.Drawing.Size(352, 22)
Me.BTT_RESET_DAILY.Text = "Reset current session"
Me.BTT_RESET_DAILY.ToolTipText = "A new file will be created for the current session"
'
'DownloadFeedForm
'
@@ -483,5 +530,9 @@ Namespace DownloadObjects
Private WithEvents BTT_MOVE_TO As ToolStripMenuItem
Private WithEvents BTT_VIEW_SAVE As ToolStripMenuItem
Private WithEvents BTT_VIEW_LOAD As ToolStripMenuItem
Private WithEvents BTT_CURR_SESSION_SET As ToolStripMenuItem
Private WithEvents BTT_COPY_SPEC_TO As ToolStripMenuItem
Private WithEvents BTT_MOVE_SPEC_TO As ToolStripMenuItem
Private WithEvents BTT_RESET_DAILY As ToolStripMenuItem
End Class
End Namespace

View File

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

View File

@@ -276,7 +276,6 @@ Namespace DownloadObjects
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Feed removed")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub Feed_SPEC_LOAD(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
@@ -440,7 +439,9 @@ Namespace DownloadObjects
End Sub
Private Sub SessionChooser(ByVal GetLast As Boolean, Optional ByVal GetFilesOnly As Boolean = False,
Optional ByRef ResultFilesList As List(Of SFile) = Nothing,
Optional ByVal SelectedMode As FeedModes = -1)
Optional ByVal SelectedMode As FeedModes = -1,
Optional ByVal GetSessionFile As Boolean = False,
Optional ByRef SessionFile As SFile = Nothing)
Try
LoadedSessionName = String.Empty
Downloader.ClearSessions()
@@ -475,6 +476,12 @@ Namespace DownloadObjects
If fList.ListExists Then
If GetFilesOnly Then
ResultFilesList.AddRange(fList)
ElseIf GetSessionFile Then
If fList.Count > 1 Then
MsgBoxE({"You must select one session file", "Get session file"}, vbExclamation)
Else
SessionFile = fList(0)
End If
Else
DataList.Clear()
If SelectedMode >= 0 Then
@@ -533,14 +540,19 @@ Namespace DownloadObjects
Private Sub BTT_COPY_MOVE_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_TO.Click, BTT_MOVE_TO.Click
MoveCopyFiles(True, sender, Nothing, Nothing)
End Sub
Private Function MoveCopyFiles(ByVal IsInternal As Boolean, ByVal Sender As Object, ByVal MCTOptions As FeedMoveCopyTo, ByVal FeedMediaData As FeedMedia) As Boolean
Private Sub BTT_COPY_MOVE_SPEC_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_SPEC_TO.Click, BTT_MOVE_SPEC_TO.Click
MoveCopyFiles(True, sender, Nothing, Nothing, False)
End Sub
Private Function MoveCopyFiles(ByVal IsInternal As Boolean, ByVal Sender As Object, ByVal MCTOptions As FeedMoveCopyTo,
ByVal FeedMediaData As FeedMedia, Optional ByVal GetChecked As Boolean = True) As Boolean
Const MsgTitle$ = "Copy/Move checked files"
Try
Dim isCopy As Boolean = Not Sender Is Nothing AndAlso Sender Is BTT_COPY_TO
Dim isCopy As Boolean = Not Sender Is Nothing AndAlso (Sender Is BTT_COPY_TO OrElse Sender Is BTT_COPY_SPEC_TO)
Dim moveOptions As FeedMoveCopyTo = Nothing
Dim ff As SFile = Nothing, df As SFile
Dim data As IEnumerable(Of UserMediaD) = Nothing
Dim dd As UserMediaD
Dim __user As UserInfo
Dim data_files As IEnumerable(Of SFile) = Nothing
Dim new_files As New List(Of SFile)
Dim mm As UserMediaD
@@ -559,7 +571,12 @@ Namespace DownloadObjects
Dim result As Boolean = False
If FeedMediaData Is Nothing Then
If GetChecked Then
data = GetCheckedMedia()
ElseIf DataList.Count > 0 Then
data = DataList.Where(Function(__dd) Not If(__dd.User?.IsSubscription, __dd.UserInfo.IsSubscription) AndAlso __dd.Data.File.Exists)
End If
With data
If .ListExists Then data_files = .Select(Function(m) m.Data.File)
End With
@@ -580,7 +597,6 @@ Namespace DownloadObjects
With moveOptions
If Not .Destination.IsEmptyString And .ReplaceUserProfile And .ReplaceUserProfile_CreateIfNull And .ReplaceUserProfile_Profile Is Nothing Then
Dim existingPathInstances As IEnumerable(Of String) = Nothing
Dim __user As UserInfo
Dim __host As Plugin.Hosts.SettingsHost = Settings(API.PathPlugin.PluginKey).Default
Dim __userName$ = .Destination.Segments.LastOrDefault
If Settings.UsersList.Count > 0 Then _
@@ -652,9 +668,11 @@ Namespace DownloadObjects
indx = Downloader.Files.FindIndex(finder)
If indx >= 0 Then
mm = Downloader.Files(indx)
__user = mm.UserInfo
mm_data = mm.Data
mm_data.File = df
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date)
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date) With {.IsSavedPosts = mm.IsSavedPosts}
If moveOptions.ReplaceUserProfile_Profile Is Nothing And mm.IsSavedPosts Then mm.UserInfo = __user
Downloader.Files(indx) = mm
downloaderFilesUpdated = True
End If
@@ -680,9 +698,11 @@ Namespace DownloadObjects
indx = sessionData.FindIndex(finder)
If indx >= 0 Then
mm = sessionData(indx)
__user = mm.UserInfo
mm_data = mm.Data
mm_data.File = df
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date)
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date) With {.IsSavedPosts = mm.IsSavedPosts}
If moveOptions.ReplaceUserProfile_Profile Is Nothing And mm.IsSavedPosts Then mm.UserInfo = __user
sessionData(indx) = mm
sesFilesReplaced = True
If DataList.Count > 0 Then
@@ -861,7 +881,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Delete daily sessions (by list)")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub BTT_FEED_DELETE_DAILY_DATE_Click(sender As Object, e As EventArgs) Handles BTT_FEED_DELETE_DAILY_DATE.Click
@@ -899,20 +918,23 @@ Namespace DownloadObjects
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Delete daily sessions (by date)")
MainFrameObj.UpdateLogButton()
End Try
End Sub
#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()
#Region "Sessions set, merge, clear"
Private Sub BTT_CURR_SESSION_SET_Click(sender As Object, e As EventArgs) Handles BTT_CURR_SESSION_SET.Click
Try
Dim f As SFile = Nothing
SessionChooser(False,,,, True, f)
If Not f.IsEmptyString AndAlso f.Exists Then
Downloader.FilesLoadLastSession(f)
FeedChangeMode(FeedModes.Current)
RefillList(True, False)
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Replace current session")
End Try
End Sub
#End Region
#Region "Merge feeds"
Private Sub BTT_MERGE_SESSIONS_Click(sender As Object, e As EventArgs) Handles BTT_MERGE_SESSIONS.Click
Try
Const msgTitle$ = "Merge feeds"
@@ -973,6 +995,23 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadFeedForm.MergeSessions]")
End Try
End Sub
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
Private Sub BTT_RESET_DAILY_Click(sender As Object, e As EventArgs) Handles BTT_RESET_DAILY.Click
If MsgBoxE({"Are you sure you want to reset the current session?" & vbCr &
"A new file will be created for the current session", "Reset current session"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
Downloader.ResetSession()
FeedChangeMode(FeedModes.Current)
RefillList(True, False)
End If
End Sub
#End Region
#Region "Merge feeds"
Private Sub BTT_MERGE_FEEDS_Click(sender As Object, e As EventArgs) Handles BTT_MERGE_FEEDS.Click
Try
Const msgTitle$ = "Merge feeds"

View File

@@ -221,8 +221,8 @@ Namespace DownloadObjects
Information = $"Type: {Media.Data.Type}"
Information.StringAppendLine($"File: {File.File}")
Information.StringAppendLine($"Address: {File}")
Information.StringAppendLine($"Downloaded: {Media.Date.ToStringDate(ADateTime.Formats.BaseDateTime)}")
If Media.Data.Post.Date.HasValue Then Information.StringAppendLine($"Posted: {Media.Data.Post.Date.Value.ToStringDate(ADateTime.Formats.BaseDateTime)}")
Information.StringAppendLine($"Downloaded: {Media.Date.ToStringDateDef}")
If Media.Data.Post.Date.HasValue Then Information.StringAppendLine($"Post date: {Media.Data.Post.Date.Value.ToStringDateDef}")
Dim infoType As UserMedia.Types = If(IsSubscription, UserMedia.Types.Picture, Media.Data.Type)
Dim h%
Dim s As Size
@@ -267,23 +267,27 @@ Namespace DownloadObjects
BTT_CONTEXT_OPEN_MEDIA.Text &= " video"
BTT_CONTEXT_DELETE.Text &= " video"
h = VideoHeight
AddHandler MyVideo.DoubleClick, AddressOf MyPicture_DoubleClick
Case Else : Throw New ArgumentNullException With {.HelpLink = 1}
End Select
Dim info$ = $"[{infoType}] - "
Dim info$ = If(Settings.FeedAddTypeToCaption.Value And Not IsSubscription, $"[{infoType}] - ", String.Empty)
If Not Media.User Is Nothing Then
With Media.User
Dim otherName$ = If(Media.IsSavedPosts, "Saved", Media.UserInfo.Name)
Dim site$ = If(Settings.FeedAddSiteToCaption.Value, $"{ .Site} - ", String.Empty)
UserKey = .Key
Information &= vbNewLine.StringDup(2)
If .IncludedInCollection Then Information.StringAppendLine($"User collection: { .CollectionName}")
Information.StringAppendLine($"User site: { .Site}")
Information.StringAppendLine($"User name: {IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)}")
Information.StringAppendLine($"User name: {CStr(IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)).IfNullOrEmpty(otherName)}")
If .IncludedInCollection Then info &= $"[{ .CollectionName}]: "
If Settings.FeedShowFriendlyNames Or Not DirectCast(.Self, UserDataBase).FeedIsUser Then
info &= $"{ .Site} - { .FriendlyName.IfNullOrEmpty(.Name)}"
info &= $"{site}{ .FriendlyName.IfNullOrEmpty(.Name).IfNullOrEmpty(otherName)}"
Else
info &= $"{ .Site} - {IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)}"
info &= $"{site}{CStr(IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)).IfNullOrEmpty(otherName)}"
End If
End With
End If

View File

@@ -139,7 +139,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[FeedSpecial.UpdateUsers]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Friend Overloads Shared Function UpdateUsers(ByVal Item As UserMediaD, ByVal InitialUser As UserInfo, ByVal NewUser As UserInfo,
@@ -148,6 +147,7 @@ Namespace DownloadObjects
Dim user As IUserData
Dim path$ = InitialUser.File.CutPath.PathWithSeparator
Dim pathNew$ = NewUser.File.CutPath.PathWithSeparator
Dim isSaved As Boolean = Item.IsSavedPosts
If Item.UserInfo.Equals(InitialUser) Or Item.UserInfo.Equals(NewUser) Then
If Item.Data.File.PathWithSeparator.Contains(path) Then
data = Item.Data
@@ -158,7 +158,7 @@ Namespace DownloadObjects
user = Item.User
End If
If Not If(user?.IsSubscription, False) Then
Item = New UserMediaD(data, user, Item.Session, Item.Date)
Item = New UserMediaD(data, user, Item.Session, Item.Date) With {.IsSavedPosts = isSaved}
Result = True
Return Item
End If
@@ -175,8 +175,10 @@ Namespace DownloadObjects
If indx >= 0 Then
Dim m As UserMediaD = Items(indx)
Dim mm As UserMedia = m.Data
Dim user As UserInfo = m.UserInfo
mm.File = NewFile
m = New UserMediaD(mm, If(MCTOptions.ReplaceUserProfile_Profile, m.User), m.Session, m.Date)
m = New UserMediaD(mm, If(MCTOptions.ReplaceUserProfile_Profile, m.User), m.Session, m.Date) With {.IsSavedPosts = m.IsSavedPosts}
If MCTOptions.ReplaceUserProfile_Profile Is Nothing And m.IsSavedPosts Then m.UserInfo = user
Items(indx) = m
_FilesUpdated = True
End If

View File

@@ -111,7 +111,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[FeedSpecialCollection.Load]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub Feeds_FeedDeleted(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial)
@@ -245,7 +244,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[FeedSpecialCollection.UpdateUsers]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
#End Region

View File

@@ -176,5 +176,9 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"An error occurred while performing action [{ActionName}] on file [{MediaFile}]")
End Try
End Function
Private Sub MyVideo_DoubleClick(sender As Object, e As EventArgs) Handles MyVideo.DoubleClick
[Stop]()
OnDoubleClick(e)
End Sub
End Class
End Namespace

View File

@@ -93,7 +93,6 @@ Namespace DownloadObjects.STDownloader
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[STDownloader.DownloaderUrlForm.TXT_URL_ActionOnTextChanged]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub TXT_PATH_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_PATH.ActionOnButtonClick

View File

@@ -108,7 +108,6 @@ Namespace DownloadObjects.STDownloader
Catch ex As Exception
_UseAccountName = True
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[STDownloader.DownloaderUrlsArrForm.TXT_URLS_TextChanged]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
End Class

View File

@@ -226,9 +226,5 @@ Namespace DownloadObjects.STDownloader
RemoveControls(ControlNonYT, False)
End If
End Sub
Protected Overrides Sub MyJob_Finished(ByVal Sender As Object, ByVal e As EventArgs)
MainFrameObj.UpdateLogButton()
MyBase.MyJob_Finished(Sender, e)
End Sub
End Class
End Namespace

View File

@@ -39,7 +39,7 @@ Namespace DownloadObjects
#End Region
Friend ReadOnly User As IUserData
Friend ReadOnly Data As UserMedia
Friend ReadOnly UserInfo As UserInfo
Friend UserInfo As UserInfo
Friend ReadOnly [Date] As Date
Friend Session As Integer
Friend IsSavedPosts As Boolean
@@ -149,29 +149,35 @@ Namespace DownloadObjects
End Try
End Function
Private _FilesSessionChecked_Impl As Boolean = False
Friend Sub FilesLoadLastSession()
Friend Sub FilesLoadLastSession(Optional ByVal SelectedSessionFile As SFile = Nothing)
Try
If Not _FilesSessionChecked And Not _FilesSessionChecked_Impl And _FilesSessionActual.IsEmptyString Then
If Not SelectedSessionFile.IsEmptyString Or (Not _FilesSessionChecked And Not _FilesSessionChecked_Impl And _FilesSessionActual.IsEmptyString) Then
_FilesSessionChecked = True
_FilesSessionChecked_Impl = True
Dim settingValue% = Settings.FeedCurrentTryLoadLastSession
If settingValue >= 0 Then
Dim ssfExists As Boolean = Not SelectedSessionFile.IsEmptyString AndAlso SelectedSessionFile.Exists
If settingValue >= 0 Or ssfExists Then
Dim startTime As Date = Process.GetCurrentProcess.StartTime
Dim files As List(Of SFile) = SFile.GetFiles(SessionsPath.CSFileP, "*.xml",, EDP.ReturnValue)
Dim files As List(Of SFile)
If ssfExists Then
files = New List(Of SFile) From {SelectedSessionFile}
Else
files = SFile.GetFiles(SessionsPath.CSFileP, "*.xml",, EDP.ReturnValue)
If files.ListExists Then files.RemoveAll(Settings.Feeds.FeedSpecialRemover)
If files.ListExists Then
Dim nd$ = Now.ToString("yyyyMMdd")
files.RemoveAll(Function(f) Not f.Name.StartsWith(nd))
End If
End If
If files.ListExists Then
files.Sort()
Dim lastDate As Date = AConvert(Of Date)(files.Last.Name, SessionDateTimeProvider)
If lastDate.Date = startTime.Date Then
If ssfExists Or lastDate.Date = startTime.Date Then
Dim __files As New List(Of UserMediaD)
Using x As New XmlFile(files.Last, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then __files.ListAddList(x, LAP.IgnoreICopier)
If __files.Count > 0 AndAlso (settingValue = 0 OrElse
If __files.Count > 0 AndAlso (settingValue = 0 OrElse ssfExists OrElse
(startTime - {lastDate, __files.Max(Function(f) f.Date)}.Max).TotalMinutes <= settingValue) Then
_Session = __files.Max(Function(f) f.Session)
Me.Files.AddRange(__files)
@@ -228,7 +234,6 @@ Namespace DownloadObjects
Catch ex As Exception
_FilesUpdating = False
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[TDownloader.FilesUpdatePendingUsers]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Friend Sub ClearSessions()
@@ -252,6 +257,13 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.TDownloader.ClearSessions]")
End Try
End Sub
Friend Sub ResetSession()
Files.Clear()
_FilesSessionActual = Nothing
_FilesSessionChecked = True
_Session = 0
_SessionSavedPosts = -1
End Sub
#End Region
Friend ReadOnly Property Downloaded As List(Of IUserData)
Private ReadOnly NProv As IFormatProvider
@@ -536,10 +548,8 @@ Namespace DownloadObjects
If Pool.Count > 0 Then Pool.ForEach(Sub(p) If Not p.Progress Is Nothing Then p.Progress.Maximum = 0)
ExecuteCommand(Settings.DownloadsCompleteCommand)
UpdateJobsLabel()
If MissingPostsDetected And Settings.AddMissingToLog Then
If MissingPostsDetected And Settings.AddMissingToLog Then _
MyMainLOG = "Some posts didn't download. You can see them in the 'Missing posts' form."
MainFrameObj.UpdateLogButton()
End If
Files.Sort()
FilesChanged = Not fBefore = Files.Count
RaiseEvent Downloading(False)
@@ -612,6 +622,7 @@ Namespace DownloadObjects
Dim limitIndex%
Dim limits As New List(Of HostLimit)
Dim Keys As New List(Of String)
Dim KeysSkipped As New List(Of String)
Dim h As Boolean = False
Dim host As SettingsHost = Nothing
Dim hostAvailable As Boolean
@@ -638,6 +649,8 @@ Namespace DownloadObjects
limit = limit.Next
limits(limitIndex) = limit
If limit.Value >= limit.Limit Then Exit For
Else
KeysSkipped.Add(_Item.Key)
End If
End If
End If
@@ -655,6 +668,7 @@ Namespace DownloadObjects
For Each k$ In Keys
i = _Job.Items.FindIndex(Function(ii) ii.Key = k)
If i >= 0 Then
If KeysSkipped.Count = 0 OrElse Not KeysSkipped.Contains(k) Then
With _Job.Items(i)
If DirectCast(.Self, UserDataBase).ContentMissingExists Then MissingPostsDetected = True
RaiseEvent UserDownloadStateChanged(.Self, False)
@@ -668,11 +682,13 @@ Namespace DownloadObjects
dcc = True
End If
End With
End If
_Job.Items.RemoveAt(i)
End If
Next
End If
Keys.Clear()
KeysSkipped.Clear()
_Job.Items.RemoveAll(Function(ii) ii.Disposed)
If dcc Then Downloaded.RemoveAll(Function(u) u Is Nothing)
If dcc And Downloaded.Count > 0 Then RaiseEvent DownloadCountChange()

View File

@@ -167,6 +167,7 @@ Namespace Editors
Me.TXT_DOWN_COMPLETE_SCRIPT = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_UNAME_UP = New System.Windows.Forms.CheckBox()
Me.CH_UICON_UP = New System.Windows.Forms.CheckBox()
Me.TXT_AUTO_BRUSH_MIN = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_FEED_ROWS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_FEED_COLUMNS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_FEED_ENDLESS = New System.Windows.Forms.CheckBox()
@@ -178,6 +179,7 @@ Namespace Editors
Me.CH_FEED_SHOW_SPEC_MEDIAITEM = New System.Windows.Forms.CheckBox()
Me.NUM_FEED_STORE_SESSION_DATA = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.NUM_FEED_SES_CURR_LOAD_LAST = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_FEED_ADD_SITE = New System.Windows.Forms.CheckBox()
Me.TXT_YTDLP = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_FFMPEG = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_CURL = New PersonalUtilities.Forms.Controls.TextBoxExtended()
@@ -203,6 +205,7 @@ Namespace Editors
Me.TAB_MAIN = New System.Windows.Forms.TabControl()
Me.TAB_ENVIR = New System.Windows.Forms.TabPage()
Me.CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
Me.CH_FEED_ADD_TYPE = New System.Windows.Forms.CheckBox()
TP_BASIS = New System.Windows.Forms.TableLayoutPanel()
TP_IMAGES = New System.Windows.Forms.TableLayoutPanel()
TP_FILE_NAME = New System.Windows.Forms.TableLayoutPanel()
@@ -269,6 +272,7 @@ Namespace Editors
CType(Me.TXT_SCRIPT, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_DOWN_COMPLETE_SCRIPT, System.ComponentModel.ISupportInitialize).BeginInit()
TP_MISSING_DATA.SuspendLayout()
CType(Me.TXT_AUTO_BRUSH_MIN, System.ComponentModel.ISupportInitialize).BeginInit()
TAB_FEED.SuspendLayout()
TP_FEED.SuspendLayout()
TP_FEED_IMG_COUNT.SuspendLayout()
@@ -947,10 +951,10 @@ Namespace Editors
'
Me.CH_FEED_OPEN_LAST_MODE.AutoSize = True
Me.CH_FEED_OPEN_LAST_MODE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_OPEN_LAST_MODE.Location = New System.Drawing.Point(4, 195)
Me.CH_FEED_OPEN_LAST_MODE.Location = New System.Drawing.Point(4, 247)
Me.CH_FEED_OPEN_LAST_MODE.Name = "CH_FEED_OPEN_LAST_MODE"
Me.CH_FEED_OPEN_LAST_MODE.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_OPEN_LAST_MODE.TabIndex = 7
Me.CH_FEED_OPEN_LAST_MODE.TabIndex = 9
Me.CH_FEED_OPEN_LAST_MODE.Text = "Open last mode (users or subscriptions)"
TT_MAIN.SetToolTip(Me.CH_FEED_OPEN_LAST_MODE, "If disabled, the user mode will be used when initializing the feed.")
Me.CH_FEED_OPEN_LAST_MODE.UseVisualStyleBackColor = True
@@ -1060,10 +1064,10 @@ Namespace Editors
'
Me.CH_FEED_UP_FILE_LOC_MOVE.AutoSize = True
Me.CH_FEED_UP_FILE_LOC_MOVE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_UP_FILE_LOC_MOVE.Location = New System.Drawing.Point(4, 273)
Me.CH_FEED_UP_FILE_LOC_MOVE.Location = New System.Drawing.Point(4, 325)
Me.CH_FEED_UP_FILE_LOC_MOVE.Name = "CH_FEED_UP_FILE_LOC_MOVE"
Me.CH_FEED_UP_FILE_LOC_MOVE.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_UP_FILE_LOC_MOVE.TabIndex = 10
Me.CH_FEED_UP_FILE_LOC_MOVE.TabIndex = 12
Me.CH_FEED_UP_FILE_LOC_MOVE.Text = "Update file location when moved"
TT_MAIN.SetToolTip(Me.CH_FEED_UP_FILE_LOC_MOVE, "The file location will be updated in the session data and in the feeds data")
Me.CH_FEED_UP_FILE_LOC_MOVE.UseVisualStyleBackColor = True
@@ -1488,10 +1492,11 @@ Namespace Editors
TP_DOWNLOADING.Controls.Add(Me.CH_UNAME_UP, 0, 1)
TP_DOWNLOADING.Controls.Add(Me.CH_UICON_UP, 0, 2)
TP_DOWNLOADING.Controls.Add(Me.CH_USE_DEF_ACC, 0, 9)
TP_DOWNLOADING.Controls.Add(Me.TXT_AUTO_BRUSH_MIN, 0, 10)
TP_DOWNLOADING.Dock = System.Windows.Forms.DockStyle.Fill
TP_DOWNLOADING.Location = New System.Drawing.Point(0, 0)
TP_DOWNLOADING.Name = "TP_DOWNLOADING"
TP_DOWNLOADING.RowCount = 11
TP_DOWNLOADING.RowCount = 12
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
@@ -1502,6 +1507,7 @@ Namespace Editors
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_DOWNLOADING.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_DOWNLOADING.Size = New System.Drawing.Size(621, 399)
TP_DOWNLOADING.TabIndex = 1
@@ -1584,12 +1590,30 @@ Namespace Editors
Me.CH_UICON_UP.Text = "Update user icon and banner every time (where supported)"
Me.CH_UICON_UP.UseVisualStyleBackColor = True
'
'TXT_AUTO_BRUSH_MIN
'
Me.TXT_AUTO_BRUSH_MIN.CaptionText = "Highlight undownloaded plans (minutes)"
Me.TXT_AUTO_BRUSH_MIN.CaptionToolTipEnabled = True
Me.TXT_AUTO_BRUSH_MIN.CaptionToolTipText = "Highlight (in gray) the scheduler plans that have not been downloaded in 'x' minu" &
"tes." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "-1 to disable."
Me.TXT_AUTO_BRUSH_MIN.CaptionWidth = 200.0R
Me.TXT_AUTO_BRUSH_MIN.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
Me.TXT_AUTO_BRUSH_MIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_AUTO_BRUSH_MIN.Location = New System.Drawing.Point(4, 280)
Me.TXT_AUTO_BRUSH_MIN.Name = "TXT_AUTO_BRUSH_MIN"
Me.TXT_AUTO_BRUSH_MIN.NumberMaximum = New Decimal(New Integer() {2147483646, 0, 0, 0})
Me.TXT_AUTO_BRUSH_MIN.NumberMinimum = New Decimal(New Integer() {1, 0, 0, -2147483648})
Me.TXT_AUTO_BRUSH_MIN.NumberUpDownAlign = System.Windows.Forms.LeftRightAlignment.Left
Me.TXT_AUTO_BRUSH_MIN.Size = New System.Drawing.Size(613, 22)
Me.TXT_AUTO_BRUSH_MIN.TabIndex = 10
Me.TXT_AUTO_BRUSH_MIN.Text = "-1"
'
'TAB_FEED
'
TAB_FEED.Controls.Add(TP_FEED)
TAB_FEED.Location = New System.Drawing.Point(4, 22)
TAB_FEED.Name = "TAB_FEED"
TAB_FEED.Size = New System.Drawing.Size(621, 399)
TAB_FEED.Size = New System.Drawing.Size(621, 374)
TAB_FEED.TabIndex = 7
TAB_FEED.Text = "Feed"
'
@@ -1601,32 +1625,35 @@ Namespace Editors
TP_FEED.Controls.Add(TP_FEED_IMG_COUNT, 0, 0)
TP_FEED.Controls.Add(Me.CH_FEED_ENDLESS, 0, 3)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_SESSION, 0, 4)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_DATE, 0, 5)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_DATE, 0, 7)
TP_FEED.Controls.Add(Me.TXT_FEED_CENTER_IMAGE, 0, 1)
TP_FEED.Controls.Add(Me.COLORS_FEED, 0, 2)
TP_FEED.Controls.Add(Me.CH_FEED_OPEN_LAST_MODE, 0, 7)
TP_FEED.Controls.Add(Me.CH_FEED_SHOW_FRIENDLY, 0, 8)
TP_FEED.Controls.Add(Me.CH_FEED_SHOW_SPEC_MEDIAITEM, 0, 9)
TP_FEED.Controls.Add(Me.CH_FEED_UP_FILE_LOC_MOVE, 0, 10)
TP_FEED.Controls.Add(TP_FEED_SES, 0, 6)
TP_FEED.Controls.Add(Me.CH_FEED_OPEN_LAST_MODE, 0, 9)
TP_FEED.Controls.Add(Me.CH_FEED_SHOW_FRIENDLY, 0, 10)
TP_FEED.Controls.Add(Me.CH_FEED_SHOW_SPEC_MEDIAITEM, 0, 11)
TP_FEED.Controls.Add(Me.CH_FEED_UP_FILE_LOC_MOVE, 0, 12)
TP_FEED.Controls.Add(TP_FEED_SES, 0, 8)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_SITE, 0, 5)
TP_FEED.Controls.Add(Me.CH_FEED_ADD_TYPE, 0, 6)
TP_FEED.Dock = System.Windows.Forms.DockStyle.Fill
TP_FEED.Location = New System.Drawing.Point(0, 0)
TP_FEED.Name = "TP_FEED"
TP_FEED.RowCount = 12
TP_FEED.RowCount = 14
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_FEED.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_FEED.Size = New System.Drawing.Size(621, 399)
TP_FEED.Size = New System.Drawing.Size(621, 374)
TP_FEED.TabIndex = 0
'
'TP_FEED_IMG_COUNT
@@ -1704,10 +1731,10 @@ Namespace Editors
'
Me.CH_FEED_ADD_DATE.AutoSize = True
Me.CH_FEED_ADD_DATE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_ADD_DATE.Location = New System.Drawing.Point(4, 140)
Me.CH_FEED_ADD_DATE.Location = New System.Drawing.Point(4, 192)
Me.CH_FEED_ADD_DATE.Name = "CH_FEED_ADD_DATE"
Me.CH_FEED_ADD_DATE.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_ADD_DATE.TabIndex = 5
Me.CH_FEED_ADD_DATE.TabIndex = 7
Me.CH_FEED_ADD_DATE.Text = "Add the date to the post title"
Me.CH_FEED_ADD_DATE.UseVisualStyleBackColor = True
'
@@ -1747,10 +1774,10 @@ Namespace Editors
'
Me.CH_FEED_SHOW_FRIENDLY.AutoSize = True
Me.CH_FEED_SHOW_FRIENDLY.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_SHOW_FRIENDLY.Location = New System.Drawing.Point(4, 221)
Me.CH_FEED_SHOW_FRIENDLY.Location = New System.Drawing.Point(4, 273)
Me.CH_FEED_SHOW_FRIENDLY.Name = "CH_FEED_SHOW_FRIENDLY"
Me.CH_FEED_SHOW_FRIENDLY.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_SHOW_FRIENDLY.TabIndex = 8
Me.CH_FEED_SHOW_FRIENDLY.TabIndex = 10
Me.CH_FEED_SHOW_FRIENDLY.Text = "Show friendly names instead of usernames"
Me.CH_FEED_SHOW_FRIENDLY.UseVisualStyleBackColor = True
'
@@ -1758,10 +1785,10 @@ Namespace Editors
'
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.AutoSize = True
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Location = New System.Drawing.Point(4, 247)
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Location = New System.Drawing.Point(4, 299)
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Name = "CH_FEED_SHOW_SPEC_MEDIAITEM"
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.TabIndex = 9
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.TabIndex = 11
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.Text = "Show special feeds in media items"
Me.CH_FEED_SHOW_SPEC_MEDIAITEM.UseVisualStyleBackColor = True
'
@@ -1773,14 +1800,14 @@ Namespace Editors
TP_FEED_SES.Controls.Add(Me.NUM_FEED_STORE_SESSION_DATA, 0, 0)
TP_FEED_SES.Controls.Add(Me.NUM_FEED_SES_CURR_LOAD_LAST, 1, 0)
TP_FEED_SES.Dock = System.Windows.Forms.DockStyle.Fill
TP_FEED_SES.Location = New System.Drawing.Point(1, 163)
TP_FEED_SES.Location = New System.Drawing.Point(1, 215)
TP_FEED_SES.Margin = New System.Windows.Forms.Padding(0)
TP_FEED_SES.Name = "TP_FEED_SES"
TP_FEED_SES.RowCount = 1
TP_FEED_SES.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_FEED_SES.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_FEED_SES.Size = New System.Drawing.Size(619, 28)
TP_FEED_SES.TabIndex = 6
TP_FEED_SES.TabIndex = 8
'
'NUM_FEED_STORE_SESSION_DATA
'
@@ -1829,6 +1856,17 @@ Namespace Editors
Me.NUM_FEED_SES_CURR_LOAD_LAST.TabIndex = 1
Me.NUM_FEED_SES_CURR_LOAD_LAST.Text = "0"
'
'CH_FEED_ADD_SITE
'
Me.CH_FEED_ADD_SITE.AutoSize = True
Me.CH_FEED_ADD_SITE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_ADD_SITE.Location = New System.Drawing.Point(4, 140)
Me.CH_FEED_ADD_SITE.Name = "CH_FEED_ADD_SITE"
Me.CH_FEED_ADD_SITE.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_ADD_SITE.TabIndex = 5
Me.CH_FEED_ADD_SITE.Text = "Add the site name to the post title"
Me.CH_FEED_ADD_SITE.UseVisualStyleBackColor = True
'
'TAB_NOTIFY
'
TAB_NOTIFY.Controls.Add(TP_NOTIFY_MAIN)
@@ -2397,7 +2435,7 @@ Namespace Editors
Me.TAB_MAIN.Location = New System.Drawing.Point(0, 0)
Me.TAB_MAIN.Name = "TAB_MAIN"
Me.TAB_MAIN.SelectedIndex = 0
Me.TAB_MAIN.Size = New System.Drawing.Size(629, 425)
Me.TAB_MAIN.Size = New System.Drawing.Size(629, 400)
Me.TAB_MAIN.TabIndex = 1
'
'TAB_ENVIR
@@ -2415,7 +2453,7 @@ Namespace Editors
'CONTAINER_MAIN.ContentPanel
'
Me.CONTAINER_MAIN.ContentPanel.Controls.Add(Me.TAB_MAIN)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(629, 425)
Me.CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(629, 400)
Me.CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.CONTAINER_MAIN.LeftToolStripPanelVisible = False
Me.CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -2425,6 +2463,17 @@ Namespace Editors
Me.CONTAINER_MAIN.TabIndex = 0
Me.CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'CH_FEED_ADD_TYPE
'
Me.CH_FEED_ADD_TYPE.AutoSize = True
Me.CH_FEED_ADD_TYPE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FEED_ADD_TYPE.Location = New System.Drawing.Point(4, 166)
Me.CH_FEED_ADD_TYPE.Name = "CH_FEED_ADD_TYPE"
Me.CH_FEED_ADD_TYPE.Size = New System.Drawing.Size(613, 19)
Me.CH_FEED_ADD_TYPE.TabIndex = 6
Me.CH_FEED_ADD_TYPE.Text = "Add the file type to the post title"
Me.CH_FEED_ADD_TYPE.UseVisualStyleBackColor = True
'
'GlobalSettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -2486,6 +2535,7 @@ Namespace Editors
CType(Me.TXT_DOWN_COMPLETE_SCRIPT, System.ComponentModel.ISupportInitialize).EndInit()
TP_MISSING_DATA.ResumeLayout(False)
TP_MISSING_DATA.PerformLayout()
CType(Me.TXT_AUTO_BRUSH_MIN, System.ComponentModel.ISupportInitialize).EndInit()
TAB_FEED.ResumeLayout(False)
TP_FEED.ResumeLayout(False)
TP_FEED.PerformLayout()
@@ -2636,5 +2686,8 @@ Namespace Editors
Private WithEvents CH_DOWN_ALL_NOTIFY As CheckBox
Private WithEvents CH_CHANNELS_USERS_READY_MARK As CheckBox
Private WithEvents NUM_FEED_SES_CURR_LOAD_LAST As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_AUTO_BRUSH_MIN As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_FEED_ADD_SITE As CheckBox
Private WithEvents CH_FEED_ADD_TYPE As CheckBox
End Class
End Namespace

View File

@@ -123,6 +123,7 @@ Namespace Editors
CH_ADD_MISSING_ERROS_TO_LOG.Checked = .AddMissingErrorsToLog
CH_DOWN_REPARSE_MISSING.Checked = .ReparseMissingInTheRoutine
CH_USE_DEF_ACC.Checked = .UseDefaultAccountIfMissing
TXT_AUTO_BRUSH_MIN.Value = .AutomationBrushUndownloadedPlansMinutes.Value
'Downloading: file names
CH_FILE_NAME_CHANGE.Checked = Not .FileReplaceNameByDate.Value = FileNameReplaceMode.None
OPT_FILE_NAME_REPLACE.Checked = .FileReplaceNameByDate.Value = FileNameReplaceMode.Replace
@@ -150,6 +151,8 @@ Namespace Editors
COLORS_FEED.ColorsSet(.FeedBackColor, .FeedForeColor, SystemColors.Window, SystemColors.WindowText)
CH_FEED_ENDLESS.Checked = .FeedEndless
CH_FEED_ADD_SESSION.Checked = .FeedAddSessionToCaption
CH_FEED_ADD_SITE.Checked = .FeedAddSiteToCaption
CH_FEED_ADD_TYPE.Checked = .FeedAddTypeToCaption
CH_FEED_ADD_DATE.Checked = .FeedAddDateToCaption
NUM_FEED_STORE_SESSION_DATA.Checked = .FeedStoreSessionsData
NUM_FEED_STORE_SESSION_DATA.Value = .FeedStoredSessionsNumber.Value
@@ -331,6 +334,7 @@ Namespace Editors
.AddMissingErrorsToLog.Value = CH_ADD_MISSING_ERROS_TO_LOG.Checked
.ReparseMissingInTheRoutine.Value = CH_DOWN_REPARSE_MISSING.Checked
.UseDefaultAccountIfMissing.Value = CH_USE_DEF_ACC.Checked
.AutomationBrushUndownloadedPlansMinutes.Value = TXT_AUTO_BRUSH_MIN.Value
'Downloading: file names
If CH_FILE_NAME_CHANGE.Checked Then
.FileReplaceNameByDate.Value = If(OPT_FILE_NAME_REPLACE.Checked, FileNameReplaceMode.Replace, FileNameReplaceMode.Add)
@@ -359,6 +363,8 @@ Namespace Editors
COLORS_FEED.ColorsGet(.FeedBackColor, .FeedForeColor)
.FeedEndless.Value = CH_FEED_ENDLESS.Checked
.FeedAddSessionToCaption.Value = CH_FEED_ADD_SESSION.Checked
.FeedAddSiteToCaption.Value = CH_FEED_ADD_SITE.Checked
.FeedAddTypeToCaption.Value = CH_FEED_ADD_TYPE.Checked
.FeedAddDateToCaption.Value = CH_FEED_ADD_DATE.Checked
.FeedStoreSessionsData.Value = NUM_FEED_STORE_SESSION_DATA.Checked
.FeedStoredSessionsNumber.Value = NUM_FEED_STORE_SESSION_DATA.Value

View File

@@ -313,7 +313,6 @@ Namespace Editors
BTT_START.Enabled = Not Working
BTT_CANCEL.Enabled = Working
End Sub, EDP.None)
If Not Working Then MainFrameObj.UpdateLogButton()
Catch
End Try
End Sub

View File

@@ -131,7 +131,6 @@ Public Class MainFrame
Await .Automation.Start(True)
End With
UpdatePauseButtonsVisibility()
MainFrameObj.UpdateLogButton()
End Sub
Private _CloseInvoked As Boolean = False
Private _IgnoreTrayOptions As Boolean = False
@@ -625,7 +624,6 @@ CloseResume:
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[MainFrame.ShowGroups]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
#End Region
@@ -652,7 +650,6 @@ CloseResume:
MainFrameObj.PauseButtons.UpdatePauseButtons()
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Start automation")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub BTT_DOWN_AUTOMATION_PAUSE_Click(sender As Object, e As EventArgs) Handles BTT_DOWN_AUTOMATION_PAUSE.Click, BTT_TRAY_PAUSE_AUTOMATION.Click
@@ -2022,7 +2019,6 @@ ResumeDownloadingOperation:
End Sub
Private Sub Downloader_UpdateJobsCount(ByVal TotalCount As Integer)
ControlInvokeFast(Toolbar_BOTTOM, LBL_JOBS_COUNT, Sub() LBL_JOBS_COUNT.Text = IIf(TotalCount = 0, String.Empty, $"[Jobs {TotalCount}]"))
MainFrameObj.UpdateLogButton()
End Sub
Private Sub Downloader_Downloading(ByVal Value As Boolean)
Dim __isDownloading As Boolean = Value Or Downloader.Working(False)

View File

@@ -66,17 +66,17 @@ Friend Class MainFrameObjects : Implements INotificator
ControlInvokeFast(MF.TRAY_CONTEXT, Sub() MF.BTT_TRAY_CLOSE_NO_SCRIPT.Visible =
Settings.ClosingCommand.Attribute And Not Settings.ClosingCommand.IsEmptyString)
End Sub
Friend Sub UpdateLogButton()
MyMainLOG_UpdateLogButton(MF.BTT_LOG, MF.Toolbar_TOP)
Private Sub UpdateLogButton()
Try : MyMainLOG_UpdateLogButton(MF.BTT_LOG, MF.Toolbar_TOP) : Catch : End Try
End Sub
Friend Function GetUserListProvider(ByVal WithCollections As Boolean) As IFormatProvider
Return MF.GetUserListProvider(WithCollections)
End Function
Friend Sub ShowLog()
MyMainLOG_ShowForm(Settings.Design,,,, Sub()
Try : MyMainLOG_ShowForm(Settings.Design,,,, Sub()
UpdateLogButton()
LogFormClosed()
End Sub)
End Sub) : Catch : End Try
End Sub
#End Region
#Region "Notifications"

View File

@@ -77,6 +77,12 @@ Friend Module MainMod
''' <summary>Alt+F1</summary>
Friend ReadOnly ShowUsersButtonKey As New PersonalUtilities.Forms.ButtonKey(Keys.F1,, True)
Friend ReadOnly DateTimeDefaultProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
<Extension> Friend Function ToStringDateDef(ByVal _DateN As Date?) As String
Return If(_DateN.HasValue, AConvert(Of String)(_DateN, DateTimeDefaultProvider, String.Empty), String.Empty)
End Function
<Extension> Friend Function ToStringDateDef(ByVal _Date As Date) As String
Return ToStringDateDef(_DateN:=_Date)
End Function
Friend ReadOnly SessionDateTimeProvider As New ADateTime("yyyyMMdd_HHmmss")
Friend ReadOnly FeedVideoLengthProvider As New ADateTime("hh\:mm\:ss") With {.TimeParseMode = ADateTime.TimeModes.TimeSpan}
Friend ReadOnly LogConnector As New LogHost

View File

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

View File

@@ -202,7 +202,6 @@ Namespace Plugin.Hosts
Select Case Hosts_Deleted_MoveAcc(Obj)
Case -1 : ShowOperationCanceledMsg(ChngUACC_MsgTitle) : Exit Sub
Case 1
MainFrameObj.UpdateLogButton()
MsgBoxE({$"An error occurred while changing user accounts (see log for details).{vbCr}Operation canceled.", ChngUACC_MsgTitle}, vbCritical)
Exit Sub
End Select

View File

@@ -173,17 +173,17 @@
<Compile Include="API\Base\M3U8Base.vb" />
<Compile Include="API\Base\ProfileSaved.vb" />
<Compile Include="API\Base\SiteSettingsBase.vb" />
<Compile Include="API\Base\SplitCollectionUserInfo.vb" />
<Compile Include="API\Base\SplitCollectionUserInfoChangePathsForm.Designer.vb">
<Compile Include="API\BaseObjects\SplitCollectionUserInfo.vb" />
<Compile Include="API\BaseObjects\SplitCollectionUserInfoChangePathsForm.Designer.vb">
<DependentUpon>SplitCollectionUserInfoChangePathsForm.vb</DependentUpon>
</Compile>
<Compile Include="API\Base\SplitCollectionUserInfoChangePathsForm.vb">
<Compile Include="API\BaseObjects\SplitCollectionUserInfoChangePathsForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="API\Base\SplitCollectionUserInfoPathForm.Designer.vb">
<Compile Include="API\BaseObjects\SplitCollectionUserInfoPathForm.Designer.vb">
<DependentUpon>SplitCollectionUserInfoPathForm.vb</DependentUpon>
</Compile>
<Compile Include="API\Base\SplitCollectionUserInfoPathForm.vb">
<Compile Include="API\BaseObjects\SplitCollectionUserInfoPathForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="API\Base\Structures.vb" />
@@ -531,10 +531,10 @@
<EmbeddedResource Include="API\BaseObjects\InternalSettingsForm.resx">
<DependentUpon>InternalSettingsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\Base\SplitCollectionUserInfoChangePathsForm.resx">
<EmbeddedResource Include="API\BaseObjects\SplitCollectionUserInfoChangePathsForm.resx">
<DependentUpon>SplitCollectionUserInfoChangePathsForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\Base\SplitCollectionUserInfoPathForm.resx">
<EmbeddedResource Include="API\BaseObjects\SplitCollectionUserInfoPathForm.resx">
<DependentUpon>SplitCollectionUserInfoPathForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="API\OnlyFans\OFResources.resx">

View File

@@ -356,6 +356,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
DownloadsCompleteCommand = New XMLValueAttribute(Of String, Boolean)("DownloadsCompleteCommand", "Use",,, MyXML, n)
ReparseMissingInTheRoutine = New XMLValue(Of Boolean)("ReparseMissingInTheRoutine", False, MyXML, n)
UseDefaultAccountIfMissing = New XMLValue(Of Boolean)("UseDefaultAccountIfMissing", True, MyXML, n)
AutomationBrushUndownloadedPlansMinutes = New XMLValue(Of Integer)("AutomationBrushUndownloadedPlansMinutes", 10080, MyXML, n)
'Downloading: file naming
n_old = {"Users", "FileName"}
@@ -401,6 +402,8 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
FeedForeColor.SetExtended("FeedColorFore",, MyXML, n)
FeedEndless = New XMLValue(Of Boolean)("Endless", True, MyXML, n)
FeedAddSessionToCaption = New XMLValue(Of Boolean)("AddSessionToCaption", False, MyXML, n)
FeedAddSiteToCaption = New XMLValue(Of Boolean)("AddSiteToCaption", True, MyXML, n)
FeedAddTypeToCaption = New XMLValue(Of Boolean)("AddTypeToCaption", False, MyXML, n)
FeedAddDateToCaption = New XMLValue(Of Boolean)("AddDateToCaption", True, MyXML, n)
FeedStoreSessionsData = New XMLValue(Of Boolean)("StoreSessionsData", True, MyXML, n)
FeedStoredSessionsNumber = New XMLValue(Of Integer)("StoredSessionsNumber", 20, MyXML, n)
@@ -1001,6 +1004,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
End Get
End Property
#End Region
#Region "Properties"
#Region "Basis"
Friend ReadOnly Property GlobalPath As XMLValue(Of SFile)
Friend ReadOnly Property MaxLargeImageHeight As XMLValue(Of Integer)
@@ -1204,6 +1208,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property DownloadsCompleteCommand As XMLValueAttribute(Of String, Boolean)
Friend ReadOnly Property ReparseMissingInTheRoutine As XMLValue(Of Boolean)
Friend ReadOnly Property UseDefaultAccountIfMissing As XMLValue(Of Boolean)
Friend ReadOnly Property AutomationBrushUndownloadedPlansMinutes As XMLValue(Of Integer)
#End Region
#Region "Downloading: file naming"
Friend ReadOnly Property FileAddDateToFileName As XMLValue(Of Boolean)
@@ -1257,6 +1262,8 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property FeedForeColor As XMLValue(Of Color)
Friend ReadOnly Property FeedEndless As XMLValue(Of Boolean)
Friend ReadOnly Property FeedAddSessionToCaption As XMLValue(Of Boolean)
Friend ReadOnly Property FeedAddSiteToCaption As XMLValue(Of Boolean)
Friend ReadOnly Property FeedAddTypeToCaption As XMLValue(Of Boolean)
Friend ReadOnly Property FeedAddDateToCaption As XMLValue(Of Boolean)
Friend ReadOnly Property FeedStoreSessionsData As XMLValue(Of Boolean)
Friend ReadOnly Property FeedStoredSessionsNumber As XMLValue(Of Integer)
@@ -1309,6 +1316,7 @@ Friend Class SettingsCLS : Implements IDownloaderSettings, IDisposable
Friend ReadOnly Property LatestSavingPath As XMLValue(Of SFile)
Friend ReadOnly Property LatestSelectedChannel As XMLValue(Of String)
#End Region
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)

View File

@@ -0,0 +1,24 @@
REM https://superuser.com/a/577640/1410018
@echo off
set dirname=_MEI
set usewildcard=true
set found=false
if %usewildcard% == true (
set dirname=*%dirname%*
)
set directorytosearch=%UserProfile%\AppData\Local\Temp
echo Searching for %dirname% in %directorytosearch%
for /d %%i in (%directorytosearch%\%dirname%) do (
IF EXIST %%i (
set found=true
echo Deleting the folder %%i
rmdir /s /q "%%i"
)
)
if NOT "%found%" == "true" (
echo No directories were found with the name of %dirname%
)