Compare commits

..

24 Commits

Author SHA1 Message Date
Andy
831d9a5a09 2023.10.10.0 2023-10-10 18:10:45 +03:00
Andy
326e61a968 2023.10.9.0
YT.VideoListForm: hide clear and delete buttons in menu; add 'BTT_CLEAR_SELECTED' button
API.Base.TokenBatch: add debug option
API.ALL: fix missing posts
API.JFF: rewrite m3u8 downloader; add ffmpeg requirement for the download; fixed missing posts; fixed download to the date; fixed corrupted files
DownloadableMediaHost: remove thumbnail when removed from list if thumbnail is stored in cache
2023-10-09 18:52:37 +03:00
Andy
61903afe3f 2023.10.6.0
Collections: use the collection name as a friendly name; labels are removed when creating a new collection
API.UserDataBase: update comparator
API.ThisVid: add 'PagePosts' to continue parsing when new posts are added
2023-10-06 15:11:09 +03:00
Andy
fa3f39b905 2023.10.4.0
YT: file name is missing when destination is changed by selecting one of the saved locations; missing files still appear in the list
API.UserDataBase: hide 'OperationCanceledException' and 'ObjectDisposedException'
API.Reddit: unable to save settings without OAuth data
TDownloader: 'ReconfPool'
MainFrame: replace 'DownloadQueue.FormShow' with 'ShowDownloadQueueForm'
SettingsHost: add a notification if the user has disabled downloading from the site
2023-10-04 22:53:17 +03:00
Andy
c76fd7f918 2023.10.3.0
YT: add settings 'CreateUrlFiles' and 'CreateDescriptionFiles'
STDownloader: add setting 'CreateUrlFiles'
2023-10-03 23:33:42 +03:00
Andy
66085e0d95 2023.10.2.0
API.Threads: save new token if found
Feed: add 'Load current session'; update the session file retrieval function
TDownloader: change session files name; files count
SettingsCLS, GlobalSettingsForm: add session file count setting
2023-10-02 11:32:37 +03:00
Andy
0a1602b453 2023.10.1.0
JustForFans: some profiles won't download
2023-10-01 18:35:08 +03:00
Andy
adf788781d 2023.9.30.1
YouTube: add URL standardization; change the 'Browse' button handler in 'VideoOptionsForm'
API.UserDataBase: add 'TokenQueue' to main function exceptions
2023-10-01 18:02:53 +03:00
Andy
77711965c0 2023.9.30.0
Add Threads.net

API.UserDataBase: add 'EraseData_AdditionalDataFiles' function; add 'ThrowAnyImpl' function; add 'e' arg to 'LogError' function
API.Instagram: make classes compatible with threads.net; add top limits; update container parsers; add an override to the 'EraseData_AdditionalDataFiles' function
2023-09-30 09:16:57 +03:00
Andy
7f1ac6f512 2023.9.29.0
UserDataBind: fix labels, colors, script when adding a new user
UserCreatorForm: fix labels issue
2023-09-29 16:24:43 +03:00
Andy
f4eb33d8da 2023.9.28.0
API.Mastodon: hide 503 error
API.PornHub: minor fixes
API.RedGifs: fix 'DataGone'
Minor bugs
2023-09-28 17:38:34 +03:00
Andy
77443cedc4 2023.9.21.0
PornHub: videos are not downloading
2023-09-21 06:22:17 +03:00
Andy
a446df1f66 2023.9.20.0 2023-09-20 12:17:00 +03:00
Andy
0026e905a4 2023.9.19.0
YT: add priority download protocol
2023-09-19 12:55:53 +03:00
Andy
f8116fd048 2023.9.18.0
API.Instagram: handle error 500; fix saved posts bug
API.Reddit: disable token refresh if there are no profiles to download
API.UserDataBind: consolidate colors; update labels only for the added user
AutoDownloader: change pause event; update pause function for scheduler; fix incorrect pause in scheduler; add icon for SchedulerEditorForm
2023-09-18 07:54:26 +03:00
Andy
8d33fdc8f3 Update README.md 2023-09-18 07:34:00 +03:00
Andy
dab94acc32 2023.9.6.0
Add scheduler changer
2023-09-06 23:38:16 +03:00
Andy
c61c817585 2023.9.3.0
API.Instagram: add user (non-pinned) stories
API.UserDataBase: fix 'StartMD5Checked' initial value
2023-09-03 19:54:01 +03:00
Andy
3ea59a6acd 2023.8.27.0
YT: fix 'Shorts' downloading
2023-09-03 19:38:18 +03:00
Andy
2a60ace18f 2023.8.27.0
API.JFF: remove PXML attribute for some properties
API.Reddit.Channels: save channel info right after download; replace date providers with default
API.Reddit.SiteSettings: improve 'UpdateToken' function
AutoDownloader: add 'Copy' function
SchedulerEditorForm: add cloning plans
DownloadedInfoForm: add 'Try...Catch' for some functions
DownloadFeedForm: add button to go to custom page
FeedMedia: color typo
GroupParameters: add 'ICopier'
2023-08-27 19:39:50 +03:00
Andy
f0014d2874 2023.08.19.0
API.Base: update 'TokenBatch', 'GDLBatch'; add 'YTDLPBatch'
API.Base.UserDataBase: update 'EraseData' function
API.Redgifs: fix hd/sd issue
API.TikTok: update dates in commands; replace 'TokenBatch' with 'YTDLPBatch'
UserDownloadQueueForm: update functions
2023-08-19 18:42:01 +03:00
Andy
28ae44f0ae 2023.08.17.0
YT.VideoListForm: hide progress

API.Base.UserDataBase: add 'IsUser' property; remove 'DownloadedPictures' debug line; add a special log for non-existent users
API.Twitter: group 'limit' notifications; update 'TwitterLimitException' (inherits Plugin.ExitException)
AutoDownloader: fix 'Initialization' value bug
DownloadedInfoForm: fix a bug due to which profiles were disposed
FeedMedia: add subscriptions users BackColor & ForeColor; fix file name issue; remove icon cloning
TDownloader, UserDownloadQueueForm: fix progress hang issue
ColorPicker: add 'TooltipText'
GlobalSettingsForm: add new properties; move design properties to new tab
ListImagesLoader: add subscriptions users BackColor & ForeColor
2023-08-17 23:54:19 +03:00
Andy
1b1226025a 2023.08.10.0
Add JFF

Update groups
Add advanced filter
Add advanced download
Disable 'ShowInTaskbar' on several forms
API.Base.M3U8: add external cache support
API.Base.UserDataBase: update token names
Feed.FeedMedia: add clone icon
UserCreatorForm: fix bug collection labels not showing
MainFrame: update 'DownloadSiteFull' function
UserSearchForm: move focus to textbox on form is open
2023-08-10 22:42:29 +03:00
Andy
58927b3113 Update README.md 2023-08-08 17:17:23 +03:00
105 changed files with 3753 additions and 1298 deletions

View File

@@ -1,3 +1,86 @@
# 2023.10.10.0
*2023-10-10*
- Added
- Notification if the user has disabled downloading from the site
- Standalone downloader: new setting `Create URL files`
- Changed the sessions naming method to be more intuitive
- Settings that allow the user to change the number of saved session (`Settings` - `Feed` - `Store session data`)
- **YouTube: new settings `Create URL files` and `Create description files`**
- YouTube: added the `Clear selected` button
- YouTube: group the `Clear and remove` buttons in the menu
- Fixed
- Reddit: unable to save settings without OAuth data
- JustForFans: rewritten m3u8 downloader
- JustForFans: downloading of missing posts
- JustForFans: download to the date
- JustForFans: corrupted files
- Threads: new token is not saved if it was received during download
- ThisVid: parsing stops when new videos are added
- YouTube: file name is missing when destination is changed by selecting one of the saved locations
- YouTube: missing files still appear in the list
- Collections: labels are removed when creating a new collection
- Standalone downloader: cached thumbnail is not removed when item is removed from the list
- Minor bugs
# 2023.10.1.0
*2023-10-01*
- Added
- **Threads.net**
- YouTube: add URL standardization
- Fixed
- UserEditor: disable updating labels if they haven't changed
- Collections: incorrect updating of colors and labels when adding a new user
- RedGifs: incorrect handling of error 410
- Mastodon: hide error 503
- JustForFans: some profiles won't download
- Minor bugs
# 2023.9.21.0
*2023-09-21*
- Fixed
- PornHub: videos are not downloading
# 2023.9.20.0
*2023-09-20*
- Added
- **Instagram: user active (non-pinned) stories (Issue #17)**
- Reddit: reduce the number of token updates (refresh the token if there are Reddit users in the download queue)
- YouTube (standalone app): priority download protocol *(`Settings` - `Defaults` - `Protocol`)* (you can now select the default protocol you want to download media on: `Any`, `https`, `m3u8`))
- Automation: ability to change schedulers (`Download` - `Automation` - `Script icon`)
- Collections: update colors for the added user
- Fixed
- YouTube: can't detect `shorts` links
- Incorrect MD5 validation initial value
- Instagram: handle error 500
- Collections: update labels only for the added user
# 2023.8.27.0
*2023-08-27*
- Added
- **JustForFans**
- Advanced download (`Download` - `Download (advanced)`)
- Advanced filter (`View` - `Advanced filter`)
- Auto downloader: cloning plans
- Feed: add button to go to custom page
- Special log for non-existent users
- Twitter: group 'limit' notifications
- Ability to set custom color for subscription users
- Other improvements
- Fixed
- Auto downloader: new plan date display bug
- Auto downloader: downloading stuck
- Minor bugs
# 2023.8.6.0
*2023-08-06*

Binary file not shown.

Before

Width:  |  Height:  |  Size: 27 KiB

After

Width:  |  Height:  |  Size: 21 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 20 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 34 KiB

After

Width:  |  Height:  |  Size: 36 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 19 KiB

View File

@@ -1,9 +1,10 @@
# :rainbow_flag: Happy LGBT Pride Month :tada:
<!-- # :rainbow_flag: Happy LGBT Pride Month :tada:
-->
# :rainbow_flag: Social networks crawler :rainbow_flag:
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
[![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE)
[![Discord](https://img.shields.io/discord/1124032649682493462?logo=discord)](https://discord.gg/uFNUXvFFmg)
[![GitHub all releases](https://img.shields.io/github/downloads/aandyprogram/scrawler/total?label=Total%20downloads)](https://github.com/AAndyProgram/SCrawler/releases)
[![FAQ](https://img.shields.io/badge/FAQ-green)](FAQ.md)
[![GUIDE](https://img.shields.io/badge/GUIDE-green)](https://github.com/AAndyProgram/SCrawler/wiki)
@@ -11,7 +12,7 @@
:eu:
:greece:
A program to download photo and video from [any site](#supported-sites) (e.g. YouTube, YouTube Music, OnlyFans, Reddit, Twitter, Mastodon, Instagram, TikTok, RedGifs, PornHub, XHamster, XVIDEOS, ThisVid, LPSG, Pinterest).
A program to download photo and video from [any site](#supported-sites) (e.g. YouTube, YouTube Music, OnlyFans, Reddit, Twitter, Mastodon, Instagram, Threads, TikTok, RedGifs, JustForFans, PornHub, XHamster, XVIDEOS, ThisVid, LPSG, Pinterest).
**If you like SCrawler, please like the program on [this site](https://alternativeto.net/software/scrawler/about/) and/or [this](https://www.softpedia.com/get/Internet/Download-Managers/Social-networks-crawler.shtml)**
<!---Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush:
@@ -34,9 +35,11 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- Redgifs videos (https://www.redgifs.com/);
- Twitter images and videos, saved (bookmarked) posts;
- OnlyFans images and videos, saved (bookmarked) posts;
- JustForFans images and videos, saved (bookmarked) posts;
- Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories, saved posts;
- TikTok videos (*currently broken*; [limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits));
- Threads images and videos;
- TikTok videos;
- Pinterest boards, users, saved posts;
- Imgur images, galleries and videos;
- Gfycat videos;
@@ -72,6 +75,8 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **OnlyFans**
- **Mastodon**
- **Instagram**
- **Threads**
- JustForFans
- TikTok
- RedGifs
- Pinterest
@@ -90,14 +95,6 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
First, the program downloads the full profile. After the program downloads only new posts. The program remembers downloaded posts.
## Reddit
The program parses user posts, obtain MD5 images hash and compares them with existing ones to remove duplicates. Then the media will be downloaded.
## Other sites
The program parses user posts and compares file names with existing ones to remove duplicates. Then the media will be downloaded.
## How to request a new site
<!---Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about--->
@@ -128,16 +125,18 @@ The program parses user posts and compares file names with existing ones to remo
- [Reddit](https://github.com/AAndyProgram/SCrawler/wiki/Settings#reddit)
- [Twitter](https://github.com/AAndyProgram/SCrawler/wiki/Settings#twitter)
- [OnlyFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans)
- [Mastodon](https://github.com/AAndyProgram/SCrawler/wiki/Settings#Mastodon)
- [Mastodon](https://github.com/AAndyProgram/SCrawler/wiki/Settings#mastodon)
- [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram)
- [Threads](https://github.com/AAndyProgram/SCrawler/wiki/Settings#threads)
- [JustForFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#justforfans)
- [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok)
- [RedGifs](https://github.com/AAndyProgram/SCrawler/wiki/Settings#redgifs)
- [YouTube](https://github.com/AAndyProgram/SCrawler/wiki/Settings#YouTube)
- [YouTube](https://github.com/AAndyProgram/SCrawler/wiki/Settings#youtube)
- [Pinterest](https://github.com/AAndyProgram/SCrawler/wiki/Settings#Pinterest)
- [PornHub](https://github.com/AAndyProgram/SCrawler/wiki/Settings#pornhub)
- [XHamster](https://github.com/AAndyProgram/SCrawler/wiki/Settings#xhamster)
- [XVIDEOS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#xvideos)
- [ThisVid](https://github.com/AAndyProgram/SCrawler/wiki/Settings#ThisVid)
- [ThisVid](https://github.com/AAndyProgram/SCrawler/wiki/Settings#thisvid)
- [LPSG](https://github.com/AAndyProgram/SCrawler/wiki/Settings#lpsg)
**Full guide you can find [here](https://github.com/AAndyProgram/SCrawler/wiki)**
@@ -194,6 +193,10 @@ F5-->[*]
# Contact me
Discord server: https://discord.gg/uFNUXvFFmg
[e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me
<!--
[e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me
Matrix (Element): https://matrix.to/#/@andyprogram:matrix.org
@@ -203,3 +206,4 @@ Discord (contact the developer): andyprogram
Discord server: https://discord.gg/uFNUXvFFmg
[Wire](https://account.wire.com/user-profile/?id=93985052-cf2c-4b72-ac75-bbe3231cf544): @andyprogram
-->

View File

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

View File

@@ -11,6 +11,6 @@ Namespace Plugin
Overloads Sub Add(ByVal Message As String)
Overloads Sub Add(ByVal ex As Exception, ByVal Message As String,
Optional ByVal ShowMainMsg As Boolean = False, Optional ByVal ShowErrorMsg As Boolean = False,
Optional ByVal SendInLog As Boolean = True)
Optional ByVal SendToLog As Boolean = True)
End Interface
End Namespace

View File

@@ -6,6 +6,10 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Drawing.Design
Imports System.ComponentModel
Imports PersonalUtilities.Tools.Grid.Attributes
Imports PersonalUtilities.Tools.Grid.EnumObjects
Namespace API.YouTube.Base
Public Structure Thumbnail : Implements IIndexable, IComparable(Of Thumbnail)
Public ID As String
@@ -47,6 +51,14 @@ Namespace API.YouTube.Base
Channel = 2
PlayList = 3
End Enum
<Editor(GetType(EnumDropDownEditor), GetType(UITypeEditor))>
Public Enum Protocols As Integer
<EnumValue(ExcludeFromList:=True)>
Undefined = -1
Any = 0
https = 1
m3u8 = 2
End Enum
Public Structure MediaObject : Implements IIndexable, IComparable(Of MediaObject)
Public Type As Plugin.UserMediaTypes
Public ID As String
@@ -59,6 +71,17 @@ Namespace API.YouTube.Base
Public Size As Double
Public Codec As String
Public Protocol As String
Public ReadOnly Property ProtocolType As Protocols
Get
If Not Protocol.IsEmptyString Then
Select Case Protocol.StringToLower.StringTrim
Case "http", "https" : Return Protocols.https
Case "m3u8" : Return Protocols.m3u8
End Select
End If
Return Protocols.Undefined
End Get
End Property
Public URL As String
Public Property Index As Integer Implements IIndexable.Index
Private Function SetIndex(ByVal Obj As Object, ByVal Index As Integer) As Object Implements IIndexable.SetIndex

View File

@@ -20,20 +20,45 @@ Namespace API.YouTube.Base
Public Const UrlTypePattern As String = "(?<=https?://[^/]*?youtube.com/)((@|[^\?/&]+))([/\?]{0,1}(list=|v=|)([^\?/&]*))(?=(\S+|\Z|))"
Private Sub New()
End Sub
Public Shared Function StandardizeURL(ByVal URL As String) As String
Try
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
Dim videoOptionRegex As RParams = RParams.DMS("[\?&]v=([^\?&]+)", 1, EDP.ReturnValue)
Dim data As List(Of String) = RegexReplace(URL, RParams.DMS(UrlTypePattern, 0, RegexReturn.ListByMatch, EDP.ReturnValue))
Dim val$ = String.Empty
If data.ListExists Then
For Each d$ In data
val = RegexReplace(d, videoOptionRegex)
If Not val.IsEmptyString Then Exit For
Next
data.Clear()
End If
If Not val.IsEmptyString Then Return $"https://www.youtube.com/watch?v={val}"
End If
End If
Return URL
Catch ex As Exception
Return URL
End Try
End Function
Public Shared Function IsMyUrl(ByVal URL As String) As Boolean
Return Not Info_GetUrlType(URL) = YouTubeMediaType.Undefined
End Function
Public Shared Function Info_GetUrlType(ByVal URL As String, Optional ByRef IsMusic As Boolean = False,
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) As YouTubeMediaType
If Not URL.IsEmptyString Then
IsMusic = URL.Contains("music.youtube.com")
IsChannelUser = False
IsShorts = False
Dim data As List(Of String) = RegexReplace(URL, RParams.DMS(UrlTypePattern, 0, RegexReturn.ListByMatch, EDP.ReturnValue))
If data.ListExists Then
If data.Count >= 6 Then Id = data(5)
If data.Count >= 3 And Not data(2).IsEmptyString Then
Select Case data(2).ToLower
Case "watch" : Return YouTubeMediaType.Single
Case "shorts" : IsShorts = True : Return YouTubeMediaType.Single
Case "playlist" : Return YouTubeMediaType.PlayList
Case UserChannelOption, "@" : IsChannelUser = data(2).ToLower = UserChannelOption : Return YouTubeMediaType.Channel
End Select
@@ -64,8 +89,8 @@ Namespace API.YouTube.Base
Dim urlOrig$ = URL
URL = RegexReplace(URL, TrueUrlRegEx)
If URL.IsEmptyString Then Throw New ArgumentNullException("URL", $"Can't get true URL from [{urlOrig}]")
Dim isMusic As Boolean = False
Dim objType As YouTubeMediaType = Info_GetUrlType(URL, isMusic)
Dim isMusic As Boolean = False, isShorts As Boolean = False
Dim objType As YouTubeMediaType = Info_GetUrlType(URL, isMusic, isShorts)
If Not objType = YouTubeMediaType.Undefined Then
Dim __GetDefault As Boolean = If(GetDefault, True)
Dim __GetShorts As Boolean = If(GetShorts, True)
@@ -105,7 +130,7 @@ Namespace API.YouTube.Base
If result Then
container.Parse(Nothing, _CachePathDefault, isMusic, Token, Progress)
If Not container.HasError Then container.URL = URL : Return container
If Not container.HasError Then container.URL = URL : container.IsShorts = isShorts : Return container
End If
container.Dispose()
End If

View File

@@ -132,13 +132,32 @@ Namespace API.YouTube.Base
End Set
End Property
#End Region
#Region "Info"
<Browsable(True), GridVisible, XMLVN({"Info"}), Category("Info"), DisplayName("Create URL files"),
Description("Create local URL files to link to the original page. Default: false.")>
Public ReadOnly Property CreateUrlFiles As XMLValue(Of Boolean)
Private ReadOnly Property IDownloaderSettings_CreateUrlFiles As Boolean Implements IDownloaderSettings.CreateUrlFiles
Get
Return CreateUrlFiles
End Get
End Property
<Browsable(True), GridVisible, XMLVN({"Info"}), Category("Info"), DisplayName("Create description files"),
Description("Create video description files. Default: false.")>
Public ReadOnly Property CreateDescriptionFiles As XMLValue(Of Boolean)
#End Region
#Region "Defaults"
<Browsable(True), GridVisible, XMLVN({"Defaults"}, True), Category("Defaults"), DisplayName("Standardize URLs"),
Description("Standardize URLs by eliminating unwanted strings. Default: true.")>
Public ReadOnly Property StandardizeURLs As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Replace modification date"),
Description("Set the file date to the date the video was added (website) (if available). Default: false.")>
Public ReadOnly Property ReplaceModificationDate As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Use cookies"),
Description("By default, use cookies when downloading from YouTube.")>
Public ReadOnly Property DefaultUseCookies As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Defaults"}, Protocols.Any), Category("Defaults"), DisplayName("Protocol"),
Description("Priority download protocol. Default: 'Any'")>
Public ReadOnly Property DefaultProtocol As XMLValue(Of Protocols)
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"),
DisplayName("Auto remove"), Description("Automatically remove downloaded items from the list.")>
Public ReadOnly Property RemoveDownloadedAutomatically As XMLValue(Of Boolean)

View File

@@ -433,7 +433,28 @@ Namespace API.YouTube.Controls
End Sub
#End Region
#Region "Footer"
Private Sub BTT_BROWSE_MouseClick(sender As Object, e As MouseEventArgs) Handles BTT_BROWSE.MouseClick
Private _FilePathBeforeItemChange As SFile = Nothing
Private Sub TXT_FILE_ActionSelectedItemBeforeChanged(ByVal Sender As Object, ByVal e As EventArgs, ByVal Item As ListViewItem) Handles TXT_FILE.ActionSelectedItemBeforeChanged
If Not TXT_FILE.Text.IsEmptyString Then _FilePathBeforeItemChange = TXT_FILE.Text Else _FilePathBeforeItemChange = Nothing
End Sub
Private Sub TXT_FILE_ActionSelectedItemChanged(ByVal Sender As Object, ByVal e As EventArgs, ByVal Item As ListViewItem) Handles TXT_FILE.ActionSelectedItemChanged
Try
If Not MyContainer.HasElements Then
Dim currentPath As SFile = _FilePathBeforeItemChange
Dim newPath As SFile = TXT_FILE.Text.CSFileP
If Not currentPath.File.IsEmptyString Then
newPath.Name = currentPath.Name
newPath.Extension = currentPath.Extension
TXT_FILE.Text = newPath
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.YouTube.Controls.VideoOptionsForm.ChangeDestinationPath]")
Finally
_FilePathBeforeItemChange = Nothing
End Try
End Sub
Private Sub BTT_BROWSE_MouseDown(sender As Object, e As MouseEventArgs) Handles BTT_BROWSE.MouseDown
Dim f As SFile
#Disable Warning BC40000
If MyContainer.HasElements Then

View File

@@ -18,6 +18,7 @@ Namespace DownloadObjects.STDownloader
ReadOnly Property OpenFolderInOtherProgram_Command As String
ReadOnly Property OutputPathAskForName As Boolean
ReadOnly Property OutputPathAutoAddPaths As Boolean
ReadOnly Property CreateUrlFiles As Boolean
ReadOnly Property ENVIR_FFMPEG As SFile
ReadOnly Property ENVIR_YTDLP As SFile
ReadOnly Property ENVIR_GDL As SFile

View File

@@ -25,7 +25,13 @@ Namespace DownloadObjects.STDownloader
Dim SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim SEP_3 As System.Windows.Forms.ToolStripSeparator
Dim MENU_ADD_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim MENU_DEL_CLEAR As System.Windows.Forms.ToolStripDropDownButton
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(VideoListForm))
Dim MENU_DEL_SEP_1 As System.Windows.Forms.ToolStripSeparator
Me.BTT_DELETE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CLEAR_SELECTED = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CLEAR_DONE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CLEAR_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.TOOLBAR_BOTTOM = New System.Windows.Forms.StatusStrip()
Me.PR_MAIN = New System.Windows.Forms.ToolStripProgressBar()
Me.LBL_INFO = New System.Windows.Forms.ToolStripStatusLabel()
@@ -40,9 +46,6 @@ Namespace DownloadObjects.STDownloader
Me.BTT_ADD_SHORTS_ONLY = New PersonalUtilities.Forms.Controls.KeyClick.ToolStripMenuItemKeyClick()
Me.BTT_DOWN = New System.Windows.Forms.ToolStripButton()
Me.BTT_STOP = New System.Windows.Forms.ToolStripButton()
Me.BTT_DELETE = New System.Windows.Forms.ToolStripButton()
Me.BTT_CLEAR_DONE = New System.Windows.Forms.ToolStripButton()
Me.BTT_CLEAR_ALL = New System.Windows.Forms.ToolStripButton()
Me.SEP_LOG = New System.Windows.Forms.ToolStripSeparator()
Me.BTT_LOG = New System.Windows.Forms.ToolStripButton()
Me.BTT_INFO = New System.Windows.Forms.ToolStripButton()
@@ -51,6 +54,8 @@ Namespace DownloadObjects.STDownloader
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
SEP_3 = New System.Windows.Forms.ToolStripSeparator()
MENU_ADD_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
MENU_DEL_CLEAR = New System.Windows.Forms.ToolStripDropDownButton()
MENU_DEL_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
Me.TOOLBAR_BOTTOM.SuspendLayout()
Me.TOOLBAR_TOP.SuspendLayout()
Me.SuspendLayout()
@@ -70,6 +75,59 @@ Namespace DownloadObjects.STDownloader
MENU_ADD_SEP_1.Name = "MENU_ADD_SEP_1"
MENU_ADD_SEP_1.Size = New System.Drawing.Size(181, 6)
'
'MENU_DEL_CLEAR
'
MENU_DEL_CLEAR.AutoToolTip = False
MENU_DEL_CLEAR.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_DELETE, MENU_DEL_SEP_1, Me.BTT_CLEAR_SELECTED, Me.BTT_CLEAR_DONE, Me.BTT_CLEAR_ALL})
MENU_DEL_CLEAR.Image = CType(resources.GetObject("MENU_DEL_CLEAR.Image"), System.Drawing.Image)
MENU_DEL_CLEAR.ImageTransparentColor = System.Drawing.Color.Magenta
MENU_DEL_CLEAR.Name = "MENU_DEL_CLEAR"
MENU_DEL_CLEAR.Size = New System.Drawing.Size(107, 22)
MENU_DEL_CLEAR.Text = "Delete / Clear"
'
'BTT_DELETE
'
Me.BTT_DELETE.Image = CType(resources.GetObject("BTT_DELETE.Image"), System.Drawing.Image)
Me.BTT_DELETE.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DELETE.Name = "BTT_DELETE"
Me.BTT_DELETE.Size = New System.Drawing.Size(185, 22)
Me.BTT_DELETE.Text = "Delete selected items"
Me.BTT_DELETE.ToolTipText = "Delete selected items"
'
'MENU_DEL_SEP_1
'
MENU_DEL_SEP_1.Name = "MENU_DEL_SEP_1"
MENU_DEL_SEP_1.Size = New System.Drawing.Size(182, 6)
'
'BTT_CLEAR_SELECTED
'
Me.BTT_CLEAR_SELECTED.AutoToolTip = True
Me.BTT_CLEAR_SELECTED.Image = CType(resources.GetObject("BTT_CLEAR_SELECTED.Image"), System.Drawing.Image)
Me.BTT_CLEAR_SELECTED.Name = "BTT_CLEAR_SELECTED"
Me.BTT_CLEAR_SELECTED.Size = New System.Drawing.Size(185, 22)
Me.BTT_CLEAR_SELECTED.Text = "Clear selected"
Me.BTT_CLEAR_SELECTED.ToolTipText = "Remove all checked items from the list"
'
'BTT_CLEAR_DONE
'
Me.BTT_CLEAR_DONE.AutoToolTip = True
Me.BTT_CLEAR_DONE.Image = CType(resources.GetObject("BTT_CLEAR_DONE.Image"), System.Drawing.Image)
Me.BTT_CLEAR_DONE.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR_DONE.Name = "BTT_CLEAR_DONE"
Me.BTT_CLEAR_DONE.Size = New System.Drawing.Size(185, 22)
Me.BTT_CLEAR_DONE.Text = "Clear downloaded"
Me.BTT_CLEAR_DONE.ToolTipText = "Remove all downloaded items from the list"
'
'BTT_CLEAR_ALL
'
Me.BTT_CLEAR_ALL.AutoToolTip = True
Me.BTT_CLEAR_ALL.Image = CType(resources.GetObject("BTT_CLEAR_ALL.Image"), System.Drawing.Image)
Me.BTT_CLEAR_ALL.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR_ALL.Name = "BTT_CLEAR_ALL"
Me.BTT_CLEAR_ALL.Size = New System.Drawing.Size(185, 22)
Me.BTT_CLEAR_ALL.Text = "Clear all"
Me.BTT_CLEAR_ALL.ToolTipText = "Remove all items from the list"
'
'TOOLBAR_BOTTOM
'
Me.TOOLBAR_BOTTOM.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.PR_MAIN, Me.LBL_INFO})
@@ -105,7 +163,7 @@ Namespace DownloadObjects.STDownloader
'TOOLBAR_TOP
'
Me.TOOLBAR_TOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.TOOLBAR_TOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_SETTINGS, Me.SEP_1, Me.MENU_ADD, SEP_2, Me.BTT_DOWN, Me.BTT_STOP, SEP_3, Me.BTT_DELETE, Me.BTT_CLEAR_DONE, Me.BTT_CLEAR_ALL, Me.SEP_LOG, Me.BTT_LOG, Me.BTT_INFO, Me.BTT_DONATE, Me.BTT_BUG_REPORT})
Me.TOOLBAR_TOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_SETTINGS, Me.SEP_1, Me.MENU_ADD, SEP_2, Me.BTT_DOWN, Me.BTT_STOP, SEP_3, MENU_DEL_CLEAR, Me.SEP_LOG, Me.BTT_LOG, Me.BTT_INFO, Me.BTT_DONATE, Me.BTT_BUG_REPORT})
Me.TOOLBAR_TOP.Location = New System.Drawing.Point(0, 0)
Me.TOOLBAR_TOP.Name = "TOOLBAR_TOP"
Me.TOOLBAR_TOP.Size = New System.Drawing.Size(584, 25)
@@ -202,33 +260,6 @@ Namespace DownloadObjects.STDownloader
Me.BTT_STOP.Size = New System.Drawing.Size(51, 22)
Me.BTT_STOP.Text = "Stop"
'
'BTT_DELETE
'
Me.BTT_DELETE.Image = CType(resources.GetObject("BTT_DELETE.Image"), System.Drawing.Image)
Me.BTT_DELETE.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DELETE.Name = "BTT_DELETE"
Me.BTT_DELETE.Size = New System.Drawing.Size(60, 22)
Me.BTT_DELETE.Text = "Delete"
Me.BTT_DELETE.ToolTipText = "Delete selected items"
'
'BTT_CLEAR_DONE
'
Me.BTT_CLEAR_DONE.Image = CType(resources.GetObject("BTT_CLEAR_DONE.Image"), System.Drawing.Image)
Me.BTT_CLEAR_DONE.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR_DONE.Name = "BTT_CLEAR_DONE"
Me.BTT_CLEAR_DONE.Size = New System.Drawing.Size(54, 22)
Me.BTT_CLEAR_DONE.Text = "Clear"
Me.BTT_CLEAR_DONE.ToolTipText = "Remove all downloaded items"
'
'BTT_CLEAR_ALL
'
Me.BTT_CLEAR_ALL.Image = CType(resources.GetObject("BTT_CLEAR_ALL.Image"), System.Drawing.Image)
Me.BTT_CLEAR_ALL.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR_ALL.Name = "BTT_CLEAR_ALL"
Me.BTT_CLEAR_ALL.Size = New System.Drawing.Size(69, 22)
Me.BTT_CLEAR_ALL.Text = "Clear all"
Me.BTT_CLEAR_ALL.ToolTipText = "Remove all items (pending and downloaded)"
'
'SEP_LOG
'
Me.SEP_LOG.Name = "SEP_LOG"
@@ -300,9 +331,9 @@ Namespace DownloadObjects.STDownloader
Private WithEvents LBL_INFO As ToolStripStatusLabel
Protected WithEvents TP_CONTROLS As TableLayoutPanel
Private WithEvents TOOLBAR_TOP As ToolStrip
Private WithEvents BTT_DELETE As ToolStripButton
Private WithEvents BTT_CLEAR_DONE As ToolStripButton
Private WithEvents BTT_CLEAR_ALL As ToolStripButton
Private WithEvents BTT_DELETE As ToolStripMenuItem
Private WithEvents BTT_CLEAR_DONE As ToolStripMenuItem
Private WithEvents BTT_CLEAR_ALL As ToolStripMenuItem
Private WithEvents BTT_SETTINGS As ToolStripButton
Private WithEvents SEP_1 As ToolStripSeparator
Private WithEvents SEP_LOG As ToolStripSeparator
@@ -317,5 +348,6 @@ Namespace DownloadObjects.STDownloader
Protected WithEvents MENU_ADD As ToolStripDropDownButton
Protected WithEvents BTT_DOWN As ToolStripButton
Private WithEvents BTT_BUG_REPORT As ToolStripButton
Private WithEvents BTT_CLEAR_SELECTED As ToolStripMenuItem
End Class
End Namespace

View File

@@ -126,232 +126,296 @@
<metadata name="MENU_ADD_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_DEL_CLEAR.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="BTT_DELETE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVDSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3lls3
FceLFC3YUkHHiJpRcQXFF5QoRmM00fiSLNmH7cP2YctMZtwyXZaNCaNsTsAJAzdcENBhLaXvhctekkV6
9j+l1RnLxpP8cnvPec7/+fc5597LozFQVBRjTkp6v3PJkpGrMtl766XSFzAcFZj8nxhWqdjfZLJro4sX
919OTjZgKAZEBCZpDJpMwptFRZ8ONzeTsfPnyXdNTf6rLNuRJxItx3T0bFb4GGKYV21bttznzpwh0+fO
kZHKSs87qan1stjYeEzPFulYtuzdO/v2kXvHj5OxY8eIFcmWgwdJK8tek4tELyMlbJFRtfo1iFu4s2cJ
h7VcSwuZPnqU3NFqvV9IpW8jRQyieJ0SiZWK32tqIvcPHyZWJE2cOkW6m5v9V1WqH7JEohQkPlEEbSm2
VVVZqXMqPg1x7sABMg1jvpoaYk5IuI00Foh47YmJF0Zqa8kYCliA9dAhYsMCx8mT5Aba1c6y3ZlCYSqS
A0WGFYriicpK69Tp04SDmWmY4rBueu9eMrlzJ2lVqVxbJZJLSC0FYp5+6dIXW5XKa53bt/sfIGkcTMCN
A3viRsuc+/eTThTJFQrTfmKYonGDwTZ14kSgJRwcc2gv19hIpiBuzs31pAgEH0HYCOSAbjgvmpFIUlGk
27J1K7Ht2kXsDQ3EsWcPcaGYF0K9DQ3+HrX61t3ycit35EjAMYc5Drlcff0j8TSB4AL0akFGUDwSBIKf
KxanfaNQdHVVV/vtdXXECdwmE/FAwIdivt27yRTcTlFh3HO4D4ijvV1KpVcuFFJx6jwdLASPj2ow+Cqx
OL09O7vbtmkTcW7bRtzAazQSHxxOouAkNnCyvJz41q4lPrWaeEBXXp4vRyS6iPU7AHUuAE+Jh4K/Ij4+
o10u7x7MyXno2byZuDUa4mYY4pJKiUskIq7oaOJasID0CoX+tqQkLxsXRze0DmSCZ8Gc4qEItOumXD4w
AUE7xBzACahwgKgo0p+d/ZchNfUr5L8FssC8xANhq6kx2dRqi10geFoc0LHB5OSHZq32blpiYjmWxIL5
ifuMxv2uggKXHe7nEh8H94ElI4P063S3X1+5MgdL//O1Egi30djiXLfObY+JeUrcid7TdlHxMTASGUkG
QXtOjn+gouJXA8vSNs1dxLtjx2FHSYknnHOnREIelJT8fSMlxU/Fh4PifaALmBlmZoD+k7mK4Ci22AsK
vHahMCD8RFsWLSJDpaW/n1i9uqdvw4YJS1oa+QWiveA6+J4WoKxYMfOjwXCrQC6nL8jHr3pPbW0zFXeE
E09IIENr1vxRzzDtSG0oycx843ZZ2d0h9D4k3gHaQCstolLN9FRU9H2o1dKN54MInmfjRqsjLi68c4jX
KRRtSDQBupHiPfn5r/Tr9aO3srIeiX8NvgRXwEB6+sNevf4OcpcCPs+u0w15ZLKwzk0M8y2S6oPioS8V
f29hIdtfUTF6OSvL/2/xzyIiSC8KmDWaceQVgXheT3X1lgmNxu2GaMj5YHHxn7vCi4eC35ifn4eNHbmZ
nU0uB8XNeXkzn2g0D0qXL/8AObMFEAvbKiuPWMvKvH0s66fOG5XKDozPJR4KvnHVKgVtx+dYZ1arZy7B
+XMCwTnM6cBsixARTFJSbJ9e//G9sjLnxcJCnL7IRowzQEjnadIcwb9SVfXmzzrd+HWt1lWSkkK/BXog
BfS4PlpLf8QBJVgfvM738X8G0KNJT84G8BII+8AtANQx/VjTK72fT1AT9P3/fBBaMGiMx/sHXLrYtE2a
9iQAAAAASUVORK5CYII=
</value>
</data>
<metadata name="MENU_DEL_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="BTT_CLEAR_SELECTED.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGPC/xhBQAAABl0RVh0U29m
dHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVoSURBVEhLhZVrTJNXGMdfrtNSQIoadKRz2o0CorU3
WkDIVBRaaGNbwAteh+AARRQlitEYTTRekiX7sH3YPmyZH9wtziybigLRCWTaCW5sCBWhlrb0Ci9zSxbo
2f+UliGX7SS/tO85z/k9T57zXhhCCPO7Wh3VIhB83JKQ0Nu4bNlHm5YseZ1hmHC69n+Y5HLFcz7/ft/S
pY+vr1hhwL4oEBJcZ0x793If5uZ+1VNfT/qvXCHP6+p8tzMymqRxcW8hMGKqbDo9MlmWddu2AfbiRTJ6
+TIZKC52fyAUVi2JiYkLJmGaBYIPnx4+TPrOnCH9p08TC4LNx46RWwrF/ZXR0W/PleRZZuY669atZvbS
JcJiL9vQQEZPnSKmwkLPjcTE97GPB8KZlvh4C5X31dWRgRMniAVBtvPnyWB9ve+2XP7jmtjYpOlJTOnp
G60lJRZaOZWPQs4ePUpGUZh3xw7SnJDQhT0KEM3c5fOv9paVkX4kMAPL8ePEig1D584RG9rVpFS2rY6J
EQaTmKTSjbbiYsvIhQuERTGjKIrFvtHaWjK8fz9plsudexYu/BLxKsBj9ALBGzel0vt9e/b4XiBoENhQ
zRDOxIWWOY4cIS0KRZs4Nja5QyLJtRoM1pGzZ/0tYVExi/ayNTVkBPJ76enuJA7nM4j3gVWAHjgTIYqL
E96SStvMu3YR64EDxF5dTYYOHSJOJPNA5Kiu9rUrlZ1mrdbCnjzpr5jFGotYtqpqQi6TuVM4nKvwlYHU
gDzU31OMSGl8fPJtsbjVsn27z15RQRzAVVlJ3BB4kcx78CAZQbUjVIxrFtd+OdrbmpHhEXG5VE4rTwHz
wMRdFDw4jEgFj5dyRyRqsxYVEcfu3cQFPPv2ES8qHEbCYRzgsFZLvO+8Q7xKJXGDVoXCK46Ovob95YBW
Ph/8+xwE/wSTyHi81OZVq9qsGs2Ye8sW4srPJy6JhDgTE4kzOpo4IyKIMyyMOLhcX9Py5R4lj0cPtAKs
BBwwKfc7p174J5BEhHY9FIk6bBDaIRuiQkDFfsLDSbdU+pdBKPwe8e+BNDBD7vdNn6BYd+6stK5da7bP
nz9TDujcoEAw1lJY+CyFz9dCHDubnDJjwltRccS5fr3TjurnlIMBYE5NJY8Nhq7SrCwREsz6xL9y4S4v
b3Bt2uSyR0XNkDvQe9ouKu8HvaGh5FfQIxL5OgyG30qUStqmGUkm/3jKy0+48vLcs1XuiI8nL/Ly/rYl
JfmovCcgN4JW+l8iGe8oKuoqzcyckSQob3CpVB47l+sXv9KWxYtJt0r1x9ns7HZjQYHNnJxMfoH0EXgA
7oFm0CmTjRsNhs6Na9bQF+Tkq57xlJXVu9Rqz9Bs8kWLSG9BwcsqieQONlXnpaaWdul0z7rR+6C8CTSC
m8Aol4+36/XGT7VaevCRIIRx6/WWoQULZq2cyveLxY0IrAT0IHm1OTmZT3Q6U2da2qT8B/Ad+BZ05OSM
GXW6p4hdBiIZZ1FRt5vPn6vyuwiqCsj9Xyq6qXbDBkWnXm/6OS3NN1X+dUgIeZSdPXZPoxlEXC6IY9pL
S7faNBqXC9Iplf95YBb5ZF+RpGbdunQcbO/D1avJ9YC8LT19/Iv8/BeqpKRPEDORAGNeY3HxSYtG43Eq
FL5etfpljUzWhPlZ5VOTlGVliR+hHUbs+0mpHP9GpRqM5XAuY20zmGgRRohYKIx9rNd/3qfTOa7l5uLu
C63BvARw6fp0eRCMyBslJe8+2bx58EFhoVMlFNJvgQ4kgggQEgykvV0ApEAd+J3z8Z8KxmuA3pr0zikA
b4LJZ2FqYBigFdOPNf0NC679Fxi0OPr+XxiAJgwURph/AJfOQQebMR8TAAAAAElFTkSuQmCC
</value>
</data>
<data name="BTT_CLEAR_DONE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVDSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3lls3
FceLFC3YUkHHiJpRcQXFF5QoRmM00fiSLNmH7cP2YctMZtwyXZaNCaNsTsAJAzdcENBhLaXvhctekkV6
9j+l1RnLxpP8cnvPec7/+fc5597LozFQVBRjTkp6v3PJkpGrMtl766XSFzAcFZj8nxhWqdjfZLJro4sX
919OTjZgKAZEBCZpDJpMwptFRZ8ONzeTsfPnyXdNTf6rLNuRJxItx3T0bFb4GGKYV21bttznzpwh0+fO
kZHKSs87qan1stjYeEzPFulYtuzdO/v2kXvHj5OxY8eIFcmWgwdJK8tek4tELyMlbJFRtfo1iFu4s2cJ
h7VcSwuZPnqU3NFqvV9IpW8jRQyieJ0SiZWK32tqIvcPHyZWJE2cOkW6m5v9V1WqH7JEohQkPlEEbSm2
VVVZqXMqPg1x7sABMg1jvpoaYk5IuI00Foh47YmJF0Zqa8kYCliA9dAhYsMCx8mT5Aba1c6y3ZlCYSqS
A0WGFYriicpK69Tp04SDmWmY4rBueu9eMrlzJ2lVqVxbJZJLSC0FYp5+6dIXW5XKa53bt/sfIGkcTMCN
A3viRsuc+/eTThTJFQrTfmKYonGDwTZ14kSgJRwcc2gv19hIpiBuzs31pAgEH0HYCOSAbjgvmpFIUlGk
27J1K7Ht2kXsDQ3EsWcPcaGYF0K9DQ3+HrX61t3ycit35EjAMYc5Drlcff0j8TSB4AL0akFGUDwSBIKf
KxanfaNQdHVVV/vtdXXECdwmE/FAwIdivt27yRTcTlFh3HO4D4ijvV1KpVcuFFJx6jwdLASPj2ow+Cqx
OL09O7vbtmkTcW7bRtzAazQSHxxOouAkNnCyvJz41q4lPrWaeEBXXp4vRyS6iPU7AHUuAE+Jh4K/Ij4+
o10u7x7MyXno2byZuDUa4mYY4pJKiUskIq7oaOJasID0CoX+tqQkLxsXRze0DmSCZ8Gc4qEItOumXD4w
AUE7xBzACahwgKgo0p+d/ZchNfUr5L8FssC8xANhq6kx2dRqi10geFoc0LHB5OSHZq32blpiYjmWxIL5
ifuMxv2uggKXHe7nEh8H94ElI4P063S3X1+5MgdL//O1Egi30djiXLfObY+JeUrcid7TdlHxMTASGUkG
QXtOjn+gouJXA8vSNs1dxLtjx2FHSYknnHOnREIelJT8fSMlxU/Fh4PifaALmBlmZoD+k7mK4Ci22AsK
vHahMCD8RFsWLSJDpaW/n1i9uqdvw4YJS1oa+QWiveA6+J4WoKxYMfOjwXCrQC6nL8jHr3pPbW0zFXeE
E09IIENr1vxRzzDtSG0oycx843ZZ2d0h9D4k3gHaQCstolLN9FRU9H2o1dKN54MInmfjRqsjLi68c4jX
KRRtSDQBupHiPfn5r/Tr9aO3srIeiX8NvgRXwEB6+sNevf4OcpcCPs+u0w15ZLKwzk0M8y2S6oPioS8V
f29hIdtfUTF6OSvL/2/xzyIiSC8KmDWaceQVgXheT3X1lgmNxu2GaMj5YHHxn7vCi4eC35ifn4eNHbmZ
nU0uB8XNeXkzn2g0D0qXL/8AObMFEAvbKiuPWMvKvH0s66fOG5XKDozPJR4KvnHVKgVtx+dYZ1arZy7B
+XMCwTnM6cBsixARTFJSbJ9e//G9sjLnxcJCnL7IRowzQEjnadIcwb9SVfXmzzrd+HWt1lWSkkK/BXog
BfS4PlpLf8QBJVgfvM738X8G0KNJT84G8BII+8AtANQx/VjTK72fT1AT9P3/fBBaMGiMx/sHXLrYtE2a
9iQAAAAASUVORK5CYII=
</value>
</data>
<data name="BTT_CLEAR_ALL.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVDSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3lls3
FceLFC3YUkHHiJpRcQXFF5QoRmM00fiSLNmH7cP2YctMZtwyXZaNCaNsTsAJAzdcENBhLaXvhctekkV6
9j+l1RnLxpP8cnvPec7/+fc5597LozFQVBRjTkp6v3PJkpGrMtl766XSFzAcFZj8nxhWqdjfZLJro4sX
919OTjZgKAZEBCZpDJpMwptFRZ8ONzeTsfPnyXdNTf6rLNuRJxItx3T0bFb4GGKYV21bttznzpwh0+fO
kZHKSs87qan1stjYeEzPFulYtuzdO/v2kXvHj5OxY8eIFcmWgwdJK8tek4tELyMlbJFRtfo1iFu4s2cJ
h7VcSwuZPnqU3NFqvV9IpW8jRQyieJ0SiZWK32tqIvcPHyZWJE2cOkW6m5v9V1WqH7JEohQkPlEEbSm2
VVVZqXMqPg1x7sABMg1jvpoaYk5IuI00Foh47YmJF0Zqa8kYCliA9dAhYsMCx8mT5Aba1c6y3ZlCYSqS
A0WGFYriicpK69Tp04SDmWmY4rBueu9eMrlzJ2lVqVxbJZJLSC0FYp5+6dIXW5XKa53bt/sfIGkcTMCN
A3viRsuc+/eTThTJFQrTfmKYonGDwTZ14kSgJRwcc2gv19hIpiBuzs31pAgEH0HYCOSAbjgvmpFIUlGk
27J1K7Ht2kXsDQ3EsWcPcaGYF0K9DQ3+HrX61t3ycit35EjAMYc5Drlcff0j8TSB4AL0akFGUDwSBIKf
KxanfaNQdHVVV/vtdXXECdwmE/FAwIdivt27yRTcTlFh3HO4D4ijvV1KpVcuFFJx6jwdLASPj2ow+Cqx
OL09O7vbtmkTcW7bRtzAazQSHxxOouAkNnCyvJz41q4lPrWaeEBXXp4vRyS6iPU7AHUuAE+Jh4K/Ij4+
o10u7x7MyXno2byZuDUa4mYY4pJKiUskIq7oaOJasID0CoX+tqQkLxsXRze0DmSCZ8Gc4qEItOumXD4w
AUE7xBzACahwgKgo0p+d/ZchNfUr5L8FssC8xANhq6kx2dRqi10geFoc0LHB5OSHZq32blpiYjmWxIL5
ifuMxv2uggKXHe7nEh8H94ElI4P063S3X1+5MgdL//O1Egi30djiXLfObY+JeUrcid7TdlHxMTASGUkG
QXtOjn+gouJXA8vSNs1dxLtjx2FHSYknnHOnREIelJT8fSMlxU/Fh4PifaALmBlmZoD+k7mK4Ci22AsK
vHahMCD8RFsWLSJDpaW/n1i9uqdvw4YJS1oa+QWiveA6+J4WoKxYMfOjwXCrQC6nL8jHr3pPbW0zFXeE
E09IIENr1vxRzzDtSG0oycx843ZZ2d0h9D4k3gHaQCstolLN9FRU9H2o1dKN54MInmfjRqsjLi68c4jX
KRRtSDQBupHiPfn5r/Tr9aO3srIeiX8NvgRXwEB6+sNevf4OcpcCPs+u0w15ZLKwzk0M8y2S6oPioS8V
f29hIdtfUTF6OSvL/2/xzyIiSC8KmDWaceQVgXheT3X1lgmNxu2GaMj5YHHxn7vCi4eC35ifn4eNHbmZ
nU0uB8XNeXkzn2g0D0qXL/8AObMFEAvbKiuPWMvKvH0s66fOG5XKDozPJR4KvnHVKgVtx+dYZ1arZy7B
+XMCwTnM6cBsixARTFJSbJ9e//G9sjLnxcJCnL7IRowzQEjnadIcwb9SVfXmzzrd+HWt1lWSkkK/BXog
BfS4PlpLf8QBJVgfvM738X8G0KNJT84G8BII+8AtANQx/VjTK72fT1AT9P3/fBBaMGiMx/sHXLrYtE2a
9iQAAAAASUVORK5CYII=
</value>
</data>
<data name="MENU_DEL_CLEAR.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVHSURBVEhLjZVrTJNXGMcLQmdHO6AdarLCHOIAgQJ9a2nx
EpwgLbVWSgWVETWj4gqKF5QoRmM00SgmS/Zh+7B92DKTGbdEl2VzwsDMC0REYJMNARFK6f0CL3NLFujZ
/5TiJZaNJ/mlfc95zv/55znnPS+HRndBQVRrYuJnN5csGbiRkPCpRix+C8MRgcn/iX65XPEkIeHW4OLF
XVeTkgwYigJhgUkaD00mfkdBwTf99fVk+OJFMlhX57+hULTkCATLMR05kxU6+hhmtXXbthH2/Hky2dhI
hkpLPR+npFQnREfHYnqmSMuyZZ88OniQDJ06RYZPniQWJJuPHCHXFYpbEoHgXaSELDKoVL4HcTN74QJh
sZZtaCCTJ06QR1qt9zux+COkCEEE56ZIZKHiQ3V1ZOTYMWJBku3sWWKur/ffkMtvZwgEyUh8qQjassFa
Vmahzqn4JMTZw4fJJIz5KipIa1xcL9IUQMBpjo+/NFBZSYZRwAwsR48SKxY4zpwhFrSrWaFoS+fzU5Ac
KNIvlW6wlZZaJs6dIyzMTMIUi3WTBw6Q8T17SLNc7tohEl1BahEQcvRLl759XSa7NbBrl38USWPABjcO
7IkbLXMeOkRuokg2n5/6gGEKxgwG68Tp04GWsHDMor1sbS2ZgHirTOZJ5vG+hLARSADdcE4kIxKloEib
eccOYt27l9hraohj/37iQjEvhGw1Nf52pbLniU5nYY8fDzhmMccil62unhGXSj2pPN4l6FWCtKB4OAgE
N1soTP1JKr07Ul7ut1dVESdwm0zEAwEfivn27SMTcDtBhfHM4jkgjvbezcnxSvh8Kk6drwALwfOjGgyu
XChc0ZyZ2WbdsoU4d+4kbuA1GokPDsdRcBwbOK7TEd+6dcSnVBIPgLgvSyC4jPW7AXXOA6+IzwZ3ZWxs
WrNE0jaq0Ux5tm4lbrWauBmGuMRi4hIIiCsykrgWLCA2Pt/flJjoVcTE0A2tAungdTCn+GwE2tUhkXTb
IGiHmAM4ARUOEBFBerOz/zakpPyA/A9BBpiXeCCsFRUma26u2c7jvSoO6Jg5KWmqVat9nBofr8OSaDA/
cZ/ReMi1fr3LDvdziY+BEWBOSyNdxcW923Nzs7D0P6+VQLiNxgZnYaHbHhX1irgTvaftouLDYCA8nDwE
f2Rl+btLSn43KBS0TXMX8e7efcyhUnlCOXeKRGRUpfrHkpzsp+L9QfFOcBf0MMx0t17fu32uIjiKDY7C
Qq+dzw8Iv9SWRYtIX1HRn6fXrm3v3LjRZk5NJb9B9D64A34BreDBypXT9wyGnvUSCb0gn1/1nsrKejj3
OkKJx8WRPrX6aTXDNCO1RpWe/n6vTve4D72fFW8BTeA6uCeXT7eXlHR+odXSjeeCMI5n82aLIyYmtHOI
V0mlTUg0AbqRwv15eau69PrBnoyMZ+I/gu/BNdC9evXUfb3+EXKXAi7Hrtf3eRISQjo3MczPSKoOis9+
qbgH8vMVXSUlgx0ZGf4Xxb8NCyP3V62aatVoxpBXAGI57eXl22wajdsN0Rec/7U3tPhscGvz8nKwsQMd
mZnkalD8dk7O9Ndq9WjR8uWfI2emAGJhU2npccumTV67QuHvU6me1spkLRifS3w2uMY1a6S0Hfewrk2p
nL6iVo+9weM1Yq4YzLQIEcYkJkZ36vVfDel0zsv5+Th94bUYZwCfztOkOYJ7razsg1+Li8fuaLUuVXIy
/RbogRjQ4/psLf0TA2RAE/yd7+v/GqBHk56cjeAdEPKFWwCoY/qxpr/0eT5BTdD7/80gtGDQGIfzL+FH
22tl8CvUAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="TOOLBAR_BOTTOM.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<metadata name="TOOLBAR_TOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>177, 17</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="BTT_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN1SURBVEhLrZVZSFRRGMdvKa44TljWuGGWldMyZpYLjpqW
TlrRuGVutLiUkSk6SmUMZfYaRW/Rg0REL2H01PJgEZWaOuod00kZZ7OxwOj9xL/v3EbyQTT0fvBnBs7h
//vOd//nXmG58rnr1eV7zwuLia95tq28uJHapGZZQ1ocHtZCJ5LMWhRbsyWIZ9vKi5vsGlGzgHcCFB8F
hPQLCB/wRo0zTz6ARlSz4E8CNvSvQfSQL+JFBVrdhfIBEgjAO48x+SJhLBiZ4xtx60eFfIBkAsSY/LB/
TIlcSxjNfyvuztXKBzgraliiWYk8SzjKprej1haPh78a5AM0i0lM9zUClbY41NsT0OxIxeNfhv8DLJXz
eVX0ZfyusO3AJXsi2ma0uOHOQdfPFqx/4r+kVM8Cu6QOs+czTvnOH9eiwJKFKmsuLjmO44qrGJ3uKvqf
iKuudNx056JjVoeuuRY8mjNIoAdzDbjzoxo3Z8vR6iqiEeaj3nYSqu5ASABurvhAGe8VEDHkQ7FUSEnR
T8XgjG0nLjuScG3mIBnocHs2TwLc+JZDZlrU2uNRMhWL7IlN0JgViBz0gZJ8Tpr1/wC8c27OFzXmINqs
QqHHvNGZhHZXFjrcOgLk4Pq3LBhcafQs9uH0tBonJjcjYzwUu8UghA15Q9knwJ8uZeHwAkD+mBZRZB5P
HWRbVFIMa+waNDkP4OpMJtrJ9IorAwZnGhod+1FHa5U2NY5NRiOdTiqZD3qDX0ZuvuaVAH3fAsApyyGk
jIVQDCNQbt2BBnqYLZSUNjLkps3OVElNNKo6GglP09HJKKR9CUXcaCBUn70QRCP26xEgvCR1E+D9AsAF
cS8ziCnM+KWSGcfPMeNEHTNaaun3PDOKF9n97xfI/ABqbBqUTm9D3mQk2hxVKPiY8btaTGUVYjIrJaWQ
kkdIA6TeZCYBeEwXi9i8+KZOsY3V2Peg1BqLI3TKJDptvb1UWltSPKbLFd9oFJtYCT2X3Ilw7KMbvcXk
j9PWAsnEs23l9RdQz3ImwqQXHX+bhlBSyiyeGa+2/gKq2V5zMCIoKesozvzbUDSf89UWN2kQy1nkoC+U
FMOAtwK8XlNKTDICzlLCuLkfdb6Wx/AFAT7JCCin+PlT5wJdIOE56SkB3skIKBrVSyPR95LoAul7SG/k
AlCWudGiWjbngvAHbcWtizmLGJwAAAAASUVORK5CYII=
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAANxSURBVEhLrZVJTFNRFIYfQhgD1OBUpiCKQwkUoUA0FBAU
KqixAlpliAODYEQJFAJiCKBujcadcUGMMW4MxpXDAoeoOEDR1woVUjph0QTD/pLfcx8lsiBg8J3kT9vc
k/+797z/vgorlf9N376AW75YSnzN27b64kYqk4rlDWuxf0QLnUgya1Fmy5cg3rbVlwT4omLBrwSEvRMQ
8VFA1Gc/1LiK5AMkiioW/l7A+o8+iBsOQIoYhlZPiXyAZALwncebApBqCUfu6EZc/VUhH0BDgHhTINIt
ChRaI2n+W3FzplY+wBkxkWnMChRZo3Bycjtq7Sm4O9soH6BZTGO679GotO9EgyMVzc49uD9r/DfAcjlf
kOFtzlyFfQcuODRom9Ki21OAvt8tWPcgaFkpH4X0STvMX8g45bt4VIuj1jxU2QpxwXkY7e4yXPNU0XcN
OtzZ6PEUondah76ZFtybMUqgOzONuPGrGj3T5Wh1l9IIi9FgPw5lfwgkADcPe0sZHxQQPewPNcWQJ0U/
EY/T9kRcdGbi8tReMtDh+nSRBOj+UUBmWtQ6UnBsIgH5Y5ugNochZsgfCvI5btb/BfCdc3O+qDaHUrMS
JV7zS65MdLrz0OvREaAAV37kwejOomeRhlOTKhwZ34yc0Q1IEkMROewHxQcBQXQpS0YWAYotWsSSeQrt
IN+qlGJY41CjyZWBjqlcdJJpuzsHRlcWLjnTUUdrlXYVDo3HIZtOKpkP+YFfRm7u80yA/sMiwAnrPuy2
RFAMo1Fu24FGepgtlJQ2MuSmza49kppoVHU0Ep6mg+OxyPq2ATu/hkD5yRehNOLAAQHCU1I/Ad4sAtSL
ScwoprMusZJ0lnWZ61iXpZY+z9Hv8+z2z3oyz0CNXQ3D5DYUjcegzVmFw69z5qrFDFYhapiBlE7SfCF9
Jg1qmATgMV0qYgviTd1iG6txJMNgS8ABOmUmnbbBYZDWlhWP6UrFG7vEJnaMnkvhWBTS6EZvMQXhlO2o
ZOJtW33NAxpYwVik9KLjb9MISspJq3fG/1vzgGq2yxyOaErKWooz/28oXcj5/xY3aRTLWcxQABQUw+CX
AnyfU0pMMgLOUMK4eSDtfA2P4RMCvJcRUE7xC6KdC3SBhMekhwR4JSOg9KteGol+kEQXSD9AeiEXgLLM
jZbUijkXhD9w0a0SO8Tg+AAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_ADD_PLS_ARR.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN2SURBVEhLrZVJTFNRFIafQhgD1OBUpiiKSomUSYmVgoJC
BTVWBpEpigyKESVQiVMa56XRuDMuiDHGjcG4cligMSqCUOAVoZaUTlgkqWF/ze+5zzayIGDwneRPm9yb
/zv3vP++JyxWQXcDuoLvBWA+8TXftqUXN0oxqVj+oBZ7h7TQiSSzFuW2Agni27b04iapwyoW9k5A5EcB
0X0CYr8EotFVLB8gXVSxqE8CVvUtw7rBYKSJkTjvKZUPkEUA3nmiKRgZo1HYNbYGN2Zq5ANoxBSWaArB
tlEFiiwxNP+NuOttkg9QL6azLLMCxZZYVE1uRpM9DQ9nW+UDtIs7mO5bHGrtyWhxZKDdqcHjWcO/ARbK
uV91/Xm/auxbcMaRhc4pLa56CtH1swMrn4QuKOWz8C6pwwJ/xinfJWNaHLbko85WhDPOg7jgLsdNTx39
z8JFdy6ueYpwfVqHLm8HHnkNEuiBtxV3Zhpwbboa591lNMIStNiPQNkdDgnAzSM/UMZ7BcQNBkFNMeRJ
0U8k4rg9BWed2bg0tZsMdLg1XSwBrn4vJDMtmhxpqJhIQsH4WqjNkYgfCIKCfI6Y9X8BvHNuzhfV5gja
rESpz/ycKxuX3fm47tERoBBXvufD4M6hZ5GJY5MqHLKuR97YamwVIxAzGAjFZwGhdClLh+YASka1SCDz
NOqgwKKUYtjoUKPNtR0Xp3bhMplecOfB4MrBOec2NNNarV2FA9Z1yKWTSuYDgeCXkZsveyVA/3kO4Khl
D3aMRlMM41Bt24JWepgdlJROMuSm7S6NpDYaVTONhKdpvzUBOV9XI3kkHMr+AETQiEN6BAgvSd0EeD8H
cErMZAZxJzOO1zKj5QQzfmtmRmsT/Z5kRvE0u//jFJlvR6NdjcrJTSi2xqPTWYey3t2/GsQcViNqWCVp
J0kzTPpC6tUwCcBjOl/E/OKbboudrNGRikpbEvbRKbPptC2OSmltQfGYLlZ8o1FsYxX0XIrGY5FJN3qD
KRTHbIclE9+2pdcfQAsrHI+RXnT8bRpNSamy+Gb8v/UH0MDSzVGIo6SsoDjzb0OZP+f/W9ykVaxm8QPB
UFAMw94KCHhNKTHJCKinhHHzEOp8OY/hCwJ8khFQTfELpc4FukDCc9JTAryTEVA2opdGou8l0QXS95De
yAWgLHOjebVozgXhN40Crc2i/A+XAAAAAElFTkSuQmCC
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN0SURBVEhLrZVJTFNRFIafQhgD1KBoGYzihDXYqtCqoYKg
UEENFUSkQFApKEaUQCVOaQR1azTujAtijHFjNK4cFmocGASKvFaokNIJiiYY99f8nvsskQUBg+8kf9rk
3vzfuef99z1hvgq7FdIRfjsEs4mvBbctvLiRyqZiuf167B3QwyCS7HocduVJkOC2hZcE+KxiUW8FxH4U
EN8jIKk3FGZfoXyAdFHF4joFLOtZhFX94dCIsTgfKJEPoCEA7zzVFo6tjjjkDC3Hte+V8gG0BEi1RSDT
oUCBM5Hmvxa3purkAxwX01mGXYFCZxIqxjagzq3BvZ+N8gGaxUxm+JqMKvdGNHi2otm7Ew9+Wv4NMFfO
p1XRmf2r0p2GM54MtI7rcTWQj44fLVj6MHJOKR9Hd0gd5k1nnPJdNKTHIWcuql0FOOM9iAv+w7geqKb/
Gbjo34W2QAHaJw3omGrB/SmLBLo71Yib32vRNmnCeX8pjbAIDe4jUD6JhgTg5rEfKONdApL7w6CmGPKk
GEdTccy9CWe9Olwa300GBtyYLJQAVyfyyUyPOo8GZaPrkDe8Amp7LFL6wqAgnyN2418A75yb80W1PYY2
K1ESND/n0+GyPxftAQMB8nFlIhcWfxY9i22oGVOheGQ1socS6K7EILE/FIpuAZF0KUsGZgCKHHqsJHMN
dZDnVEoxNHvUaPJpcXE8B5fJ9II/GxZfFs55M1FPa1VuFQ6MrMIuOqlk3hcKfhm5+aIXAozdMwBHnXuw
wxFPMUyGyZWGRnqYLZSUVjLkps2+nZKaaFT1NBKepv0jK5H1JQEbB6Oh/BSCGBpxxGsBwnPSEwK8mwE4
JaqZRdQxq72KWR0nmPVLPbMO1dHvSWYVT7M7306RuRZmtxrlY+tROJKCVm81it9n/6oVt7NKUcvKSTqS
9jOpl9SlZRKAx3S2iE2Lb2oXW5nZsxnlrnXYR6fU0WkbPOXS2pziMZ2v+Ear2MTK6LkUDCdhG93oNbZI
1LgOSSbBbQuvP4AGlj+cKL3o+Ns0npJS4QzO+H/rD6CWbbHHIZmSsoTizL8NpdM5/9/iJo2iiaX0hUNB
MYx6IyDkJaXEJiPgOCWMm0dQ54t5DJ8RoFNGgIniF0mdC3SBhKekRwR4KyOgdNAojcTYRaILZHxNeiUX
gLLMjWbVvDkXhN9lPK1NCDBSGgAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_ADD_NO_SHORTS.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN8SURBVEhLrZVZSJRRGIZ/U1wSdcK2caMsW6nR3Chm1LRZ
UosmTS2XNpc0tEQnaUPMiugmiu6iC4mIbsLoquXCJCpbdMx/XKapcVbHAqP7E2/f+RvJC9Gw/4MXBs7h
fb7znff8I8xXwTcDu0JuBWI28TX/toUXN8owp7DcAQ20gxoYRJJFgwP2PAni37bw4ibbP6Wwxb0CIt8I
iH4vIPZjEGrc+fIB1GIKi3orYNn7AKwaCEGyGIkzviL5ANkE4J0nmkOwbTgKOaMrcPl7hXwArZjBEs2h
SB9WQG+Nofmvxc2pWvkAx0Q1S7MokG+NxaHx9ah1JOPuzyb5AC0ju5jhcxwqHRvR4NyGFtcO3P9p+jfA
XDmfVv2I7leFYwManWlo82rQ4dOh60crlj4Im1PKR+FdUod50xmnfBeMarDfmosqux6Nrr046zmAK74q
+p2Gc54sXPLp0TlpQNdUK+5NmSTQnakm3PhejUuT5TjjKaYRFqDBUQpldzj+XCKZR76mjPcJiBsIhopi
yJNi/JKIo47NOOXKxHnvTjIw4OpkvgTomNCRmQa1zmSUfElC3thKqCyRiO8PhoJ8Si3GvwDeOTfniypL
BG1WoshvftqdiQueXHT6DATQ4eJELkweNd1FKo6Mb8I+22pkjy7HFjECMQNBULwTEEaPsmhwBqBgWIME
Mk+mDvKsSimGNU4Vmt0ZOOfNwQUyPevJhsmtxmlXOupordKxCXtsq5BFJ5XM+4PAHyM3D3gmwPhuBuCg
dRe2D0dTDONQbt+AJrrMVkpKGxly0xb3DknNNKo6GglPU6EtAeqR5dg4FA7lh0BE0IhDewQIT0ndBHg1
A1Bvy2Imu461uytZu+c46/DWsY6JWtbpPcGufT3Jbn+rJ/MM1DhUKBtfh3xbPNpcVTgsFv6qHtGzClHL
ykg6kvYT6SOpT8skAI/pbBGbFt90y97GapxbUWZPwm46ZSadtsFZJq3NKR7T+YpvvP61mZXQvejHYpFK
L3qNOQxH7PslE/+2hRc3af/cwHRjMdKHjn9Noykph6z+Gf9vSYDRapZiiUIcJWUJxZn/NxRP5/x/i5s0
WcpZfH8IFBTDxS8FBD6nlJhlBBwTdYybh1Lni3gMnxDgrYyAcopfGHUu0AMSHpMeEqBXRkDxkFEaibGP
RA/I2EN6IReAssyNZtW8OReE31w2r8aW2OYjAAAAAElFTkSuQmCC
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN6SURBVEhLrZVJTFNRFIYfQhgkQA1OZTCKoqLBVgRRpEpb
hQpqrAwiBYJIQTCiBCpxSuO41GjcGRfEGOPGYFw5LJAYFQco8opQIKUTFEkw7K/5PfelRBYEDL6T/GmT
e/N/55733/eEhSr0XnBb2P1gzCW+Fti2+OJGabZUpuvR4ECvBgaRZNeg2KmXIIFtiy9ukvE9lS3tFBD9
UUDsFwHx30Jg9ubLB9glprKYTwJWfAnC2p4wqMVoXPAXygfYQwDeeZItDGn9McgZWIWbk+XyAbRiGkuy
hSOjX4E8RxzNfwPuTdXKB6gWd7F0uwL5jniUjW5CrUuNR9ON8gGaxRxmGEpAhSsFDe40NHuy8GTa8m+A
+XI+I3Of7ne5azPOutPROqbBNX8u2n61YPnTiHmlfB7ZJnWon8k45btgQINjDh0qnXk46zmCi75i3PJX
0v90XPLtxXV/Hm5MGNA21YLHUxYJ9HCqEXcna3B9woQLviIaYQEaXMehbI+EBODm0R8o410CEnpCoaIY
8qQYR5Jw0rUV5zyZuDymJQMDbk/kS4Br47lkpkGtW42SkWToB1dDZY9GYncoFORz3G78C+Cdc3O+qLJH
0WYlCgPm572ZuOLT4YbfQIBcXB3XweLLpmexA1WjW3B0eB32DaxEqhiFuJ4QKD4LiKBLWdg7C1DQr8Ea
MldTB3qHUoqh2a1Ck3cnLo3l4AqZXvTtg8WbjfOeDNTRWoVrCw4Pr8VeOqlk3h0Cfhm5edBrAcbPswAn
HPuxuz+WYpgAk3MzGulhtlBSWsmQmzZ7syQ10ajqaCQ8TYeG1yD7x0qk9EVC+TUYUTTi8A4BwitSOwHe
zwLUD2Qxy5COWUcrmNV1ilnddczqqaXf0+ym4wx78LOezHfC7FKhdHQj8ocT0eqphMlm+F0j6lm5qGWl
JB1J+530jdSlZRKAx3SuiM2Ib7oz1MrM7m0odSbjIJ0yk07b4C6V1uYVj+lCxTfedjSxEnoueYPx2EE3
er0tAlXOY5JJYNvii5tYfzSw3ME46UXH36axlJQyR2DG/1sSQKxh2+0xSKCkLKM4829D0UzO/7e4SaNo
YondYVBQDJe+ExD8hlJikxFQLeoYNw+nzpfwGL4kwCcZASaKXwR1LtAFEl6QnhGgU0ZAUZ9RGomxi0QX
yNhBeisXgLLMjebUgjkXhD+4Jq73JQ87ogAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_ADD_SHORTS_ONLY.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN8SURBVEhLrZVZSJRRGIZ/U1wSdcK2caMsW6nR3Chm1LRZ
UosmTS2XNpc0tEQnaUPMiugmiu6iC4mIbsLoquXCJCpbdMx/XKapcVbHAqP7E2/f+RvJC9Gw/4MXBs7h
fb7znff8I8xXwTcDu0JuBWI28TX/toUXN8owp7DcAQ20gxoYRJJFgwP2PAni37bw4ibbP6Wwxb0CIt8I
iH4vIPZjEGrc+fIB1GIKi3orYNn7AKwaCEGyGIkzviL5ANkE4J0nmkOwbTgKOaMrcPl7hXwArZjBEs2h
SB9WQG+Nofmvxc2pWvkAx0Q1S7MokG+NxaHx9ah1JOPuzyb5AC0ju5jhcxwqHRvR4NyGFtcO3P9p+jfA
XDmfVv2I7leFYwManWlo82rQ4dOh60crlj4Im1PKR+FdUod50xmnfBeMarDfmosqux6Nrr046zmAK74q
+p2Gc54sXPLp0TlpQNdUK+5NmSTQnakm3PhejUuT5TjjKaYRFqDBUQpldzj+XCKZR76mjPcJiBsIhopi
yJNi/JKIo47NOOXKxHnvTjIw4OpkvgTomNCRmQa1zmSUfElC3thKqCyRiO8PhoJ8Si3GvwDeOTfniypL
BG1WoshvftqdiQueXHT6DATQ4eJELkweNd1FKo6Mb8I+22pkjy7HFjECMQNBULwTEEaPsmhwBqBgWIME
Mk+mDvKsSimGNU4Vmt0ZOOfNwQUyPevJhsmtxmlXOupordKxCXtsq5BFJ5XM+4PAHyM3D3gmwPhuBuCg
dRe2D0dTDONQbt+AJrrMVkpKGxly0xb3DknNNKo6GglPU6EtAeqR5dg4FA7lh0BE0IhDewQIT0ndBHg1
A1Bvy2Imu461uytZu+c46/DWsY6JWtbpPcGufT3Jbn+rJ/MM1DhUKBtfh3xbPNpcVTgsFv6qHtGzClHL
ykg6kvYT6SOpT8skAI/pbBGbFt90y97GapxbUWZPwm46ZSadtsFZJq3NKR7T+YpvvP61mZXQvejHYpFK
L3qNOQxH7PslE/+2hRc3af/cwHRjMdKHjn9Noykph6z+Gf9vSYDRapZiiUIcJWUJxZn/NxRP5/x/i5s0
WcpZfH8IFBTDxS8FBD6nlJhlBBwTdYybh1Lni3gMnxDgrYyAcopfGHUu0AMSHpMeEqBXRkDxkFEaibGP
RA/I2EN6IReAssyNZtW8OReE31w2r8aW2OYjAAAAAElFTkSuQmCC
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN6SURBVEhLrZVJTFNRFIYfQhgkQA1OZTCKoqLBVgRRpEpb
hQpqrAwiBYJIQTCiBCpxSuO41GjcGRfEGOPGYFw5LJAYFQco8opQIKUTFEkw7K/5PfelRBYEDL6T/GmT
e/N/55733/eEhSr0XnBb2P1gzCW+Fti2+OJGabZUpuvR4ECvBgaRZNeg2KmXIIFtiy9ukvE9lS3tFBD9
UUDsFwHx30Jg9ubLB9glprKYTwJWfAnC2p4wqMVoXPAXygfYQwDeeZItDGn9McgZWIWbk+XyAbRiGkuy
hSOjX4E8RxzNfwPuTdXKB6gWd7F0uwL5jniUjW5CrUuNR9ON8gGaxRxmGEpAhSsFDe40NHuy8GTa8m+A
+XI+I3Of7ne5azPOutPROqbBNX8u2n61YPnTiHmlfB7ZJnWon8k45btgQINjDh0qnXk46zmCi75i3PJX
0v90XPLtxXV/Hm5MGNA21YLHUxYJ9HCqEXcna3B9woQLviIaYQEaXMehbI+EBODm0R8o410CEnpCoaIY
8qQYR5Jw0rUV5zyZuDymJQMDbk/kS4Br47lkpkGtW42SkWToB1dDZY9GYncoFORz3G78C+Cdc3O+qLJH
0WYlCgPm572ZuOLT4YbfQIBcXB3XweLLpmexA1WjW3B0eB32DaxEqhiFuJ4QKD4LiKBLWdg7C1DQr8Ea
MldTB3qHUoqh2a1Ck3cnLo3l4AqZXvTtg8WbjfOeDNTRWoVrCw4Pr8VeOqlk3h0Cfhm5edBrAcbPswAn
HPuxuz+WYpgAk3MzGulhtlBSWsmQmzZ7syQ10ajqaCQ8TYeG1yD7x0qk9EVC+TUYUTTi8A4BwitSOwHe
zwLUD2Qxy5COWUcrmNV1ilnddczqqaXf0+ym4wx78LOezHfC7FKhdHQj8ocT0eqphMlm+F0j6lm5qGWl
JB1J+530jdSlZRKAx3SuiM2Ib7oz1MrM7m0odSbjIJ0yk07b4C6V1uYVj+lCxTfedjSxEnoueYPx2EE3
er0tAlXOY5JJYNvii5tYfzSw3ME46UXH36axlJQyR2DG/1sSQKxh2+0xSKCkLKM4829D0UzO/7e4SaNo
YondYVBQDJe+ExD8hlJikxFQLeoYNw+nzpfwGL4kwCcZASaKXwR1LtAFEl6QnhGgU0ZAUZ9RGomxi0QX
yNhBeisXgLLMjebUgjkXhD+4Jq73JQ87ogAAAABJRU5ErkJggg==
</value>
</data>
<data name="MENU_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN9SURBVEhLrZVZSJRRGIZ/U1wSdcK2cYmyzYyayTQrHStn
cdKKJi3NjRaXMrJEJ9EMyza6CqO76EIiopsoumq5qIjSSp3yn1FHbZzNxgSj+yNv3/kZyQvRsP+DFwbO
4X2+8533/CPMVcFtge0hdwIxk/iaf9v8ixulWtQsq0cD/VcNjCLJqsFhh1aC+LfNv7jJ9m9qtvCdgMiP
AqI/C4jtCkKFJ0c+QLqoZlEdApZ8DsDKnhCoxUhc8OXJB8gkAO88wRKCZFsUdvcvw7XxEvkAOjGVJVhC
kWpTINseQ/Nfg7aJSvkAJ8R0lmJVIMcei6KR9ah0qnH/d418gDqblhkH41Dq3IBqVzLq3Dvx8Lf53wCz
5XxKp2z6yRJnIs66UtAwqsEVnwHtv+qx+FHYrFI+CW+XOtROZZzynduvwSF7Fsoc2TjrPoBG72Fc95XR
7xQ0eTPR6svG1TEj2ifq8WDCLIHuTdTg9ng5WseKccGbTyPMRbWzAMqn4ZAA3DzyA2W8U0BcTzBUFEOe
FNNwAo47N+KcOw0XR/eQgRE3xnIkwJUfBjLToNKlxpHhtdAOLIfKGon47mAoyKfAavoL4J1zc76oskbQ
ZiXy/ObnPWlo9mbhqs9IAAMu/ciC2ZtBd7EVx0aScHBoFXb1L8UmMQIxPUFQfBIQRo8y7+s0QK5NgxVk
rqYOtHalFMMKlwq1nm1oGt2NZjJt9O6C2ZOB8+5UVNFaqTMJ+4dWIpNOKpl3B4E/Rm4e8FKA6dM0wFG7
Djts0RTDOBQ7ElFDl1lPSWkgQ25a59kpqZZGVUUj4WnaN7QCGX1LsaE3HMovgYigEYe+ESC8ID0lwPtp
gNODGmb+rmct7lLW4jnJLnur2OXRStbqPcVuDp9hd3+eJvNtqHCqUDiyDjlD8Whwl6GsN3ey3GZgJaKO
FZL0JN03UhepU8ckAI/pTBGbEt/U9r2BVbg2o9CxFnvplGl02mpXobQ2q3hM5yq+8dZwLTtC95I9EIut
9KJXW8JwzHFIMvFvm39xkxZ7NTMMxEgfOv41jaakFNn9M/7fkgB95WyLNQpxlJRFFGf+35A/lfP/LW5S
Ixaz+O4QKCiGC98KCHxFKbHICDgh6hk3D6XOF/AYPidAh4yAYopfGHUu0AMSnpEeE+CdjID8XpM0ElMn
iR6Q6Q3ptVwAyjI3mlFz5lwQ/gBru6+QfGvWdQAAAABJRU5ErkJggg==
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN7SURBVEhLrZVbSJNhGMe/Ujwk6sKy5iHKsqysaVojcbnN
cksrWmqZJ8o8pJEluqQTo6zuIoruoguJiG7C6KrDhUlUdnDTvk23jLmTzQSj+zf+Pe/HJC9Ew74H/mzw
vvx/z/t8//f7hPkq4nZYd+SdMMwmvhbatvDiRtm2TKa3arBnUAOjSLJrUO4ulCChbQsvbpI7lMmW9AmI
eycg4aOA5M/haPAXywdQi5ks/r2A5R8XYbU1ElliHM4FS+UD5BGAd55mi8Q2Rzy0IytwbbJaPoBWzGZp
tihsdyhgcCXR/Nfh9lSjfIA6Uc1y7QoUu5JRObYBjZ4s3P/VKh+gXSxgxq8pqPFsRIt3G9p9eXj4y/xv
gLlyPq36Id3vak8GTntz0TmuwZVgEbp/dmDZo+g5pXwS0y11WDidccp3yYgGh1x61LoNOO07gPOBclwP
1tL/XFwI7MLVoAFdE0Z0T3XgwZRZAt2basWtyXpcnajCuUAZjbAELZ4jUPbEQAJw87i3lPF+ASnWCKgo
hjwppm9pOO7ZjDM+NS6O68jAiBsTxRLgyvciMtOg0ZuFw9/SUehcCZU9DqkDEVCQzxG76S+Ad87N+aLK
HkublSgNmZ/1q3EpoEdX0EiAIlz+roc5kE/PIgfHxjbh4OgaFIwkYosYiyRrOBQfBETTpSwdnAEocWiw
isyzqINCl1KKYYNXhTb/DlwY1+ISmZ4PFMDsz8dZ33Y00VqNZxP2j67GLjqpZD4QDn4ZufmiFwJMH2YA
jrp2Y6cjgWKYgip3BlrpYXZQUjrJkJu2+/MktdGommgkPE37RlchfzgRG7/EQPkpDLE04qheAcJzUg8B
3swANA/vZGaXjlncNcwydoJZPE3M4m2k35Osy3mK3f3RTOY70OBRoWJsPYpHU9Hpq0Wl1fC7XtSzalHL
Kkg6knaI9JnUr2USgMd0tohNi2+66epkDd6tqHCnYy+dUk2nbfFWSGtzisd0vuIbrzvb2GF6LgZnMnLo
Rq+1ReOY+5BkEtq28OImFkcLK3ImSS86/jZNoKRUukIz/t+SAGI9y7bHI4WSspTizL8NZdM5/9/iJq1i
FUsdiISCYrjktYCwl5QSm4yAOlHHuHkUdb6Yx/AZAd7LCKii+EVT5wJdIOEp6TEB+mQElH0xSSMx9ZPo
Apl6Sa/kAlCWudGsmjfngvAH4HCuyOLK/ToAAAAASUVORK5CYII=
</value>
</data>
<data name="BTT_STOP.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVESURBVEhLjZVrTJNXGMcLQmdHO6AdarLSOcQBQgv0raV1
XnBcpGjBlgo6RtSMiisoXlCiGI3RxMVLsmQftg/bhy0zmXFLdFk2JoyaOYFMGKiwlIsOaym9F152SRbo
2f+UVmcsG0/yy9v3nOf8n3+fc9735dDoLyqKM6ekfHxz2bKRGxLJR5vF4lcwHBOc/J8YVipVv0kkt0aX
Lu27lppqwFAciApO0hgwmfh3ioq+HG5uJmOXLpHepqbADZWqI08gWInp2LmsyGFhmLX2HTsesefPk+mL
F8lIZaX3g/T0ekl8fCKm54p0rFjx4dChQ+Th6dNk7NQpYkOy9ehR0qpS3ZIJBK8jJWKRUbX6TYhb2QsX
CIu1bEsLmT55kgxptb6vxeL3kSIEMZybIpGNij9saiKPjh8nNiRNnDtH7jc3B24olT9JBYI0JD5TBG0p
tldV2ahzKj4NcfbIETINY/6aGmJOShpEmgoIOO3JyZdHamvJGApYge3YMWLHAufZs2QQ7WpXqbqy+Px0
JAeLDMvlxROVlbap994jLMxMwxSLddMHD5LJvXtJq1Lp3ikSXUVqKRBy9MuXv9qqUNzq2b078BhJ42AC
bpzYEw9a5jp8mNxEkVw+P+MXhikaNxjsU2fOBFvCwjGL9rKNjWQK4ubcXG8aj/cZhI1ABuiGc2IZkSgd
RbqsO3cS+759xNHQQJwHDhA3ivkgZGloCHSr1XcflJfb2BMngo5ZzLHIZevrn4hn8HiXoVcLMkPi0SAY
3FyhMON7ubzzXnV1wFFXR1zAYzIRLwT8KObfv59Mwe0UFcY9i/ugONrbqVD4ZHw+FafOV4HF4OlRDQVX
KRSuas/O7rJv20Zcu3YRD/AZjcQPh5MoOIkNnCwvJ/6NG4lfrSZe0JmX588RCK5g/R5AnfPAc+Lh4K5O
TMxsl8m6BtaunfFu3048Gg3xMAxxi8XELRAQd2wscS9aRCx8fqAtJcWnSkigG1oHssCLYF7xcATbdUcm
65+AoANiTuACVDhITAzpy87+y5Ce/i3y3wVSsCDxYNhrakx2tdrq4PGeFwd0bCA1dcas1T7ISE4ux5J4
sDBxv9F42F1Q4HbA/Xzi4+ARsGZmkj6dbvCtNWtysPQ/XyvB8BiNLa5NmzyOuLjnxF3oPW0XFR8DI9HR
ZAB05+QE+isqfjWoVLRN8xfx7dlz3FlS4o3k3CUSkcclJX8PpqUFqPhwSLwXdIIfGWa2n/6T+YrgKLY4
Cgp8Dj4/KPxMW5YsIZbS0t/PrF/f3btly4Q1I4Pch2gPuE3FgZmyevXszwbD3QKZjL4gn77qvbW1zVTc
GUk8KYlYNmz4o55h2pHaUJKV9fZgWdkDC3ofFu8AbaCVFlEqZ7srKno/1WrpxnNBFMe7davNmZAQ2TnE
6+TyNiSaAN1I4YH8/Df69PrRu1LpE/HvwDfgOuiXSmd69Poh5C4HXI5Dp7N4JZKIzk0M8wOS6kPi4S8V
92BhoaqvomK0XSoN/Fv8q6go0pOVNWPWaMaRVwQSOd3V1TsmNBqPB6Jh5wPFxX/uiyweDm5jfn4eNnbk
TnY2uRYSN+flzX6h0TwuXbnyE+TMFUAsbqusPGErK/MNqVQB6rxRoejA+Hzi4eAa162T03a0YZ1ZrZ69
Cucv8XgXMacDcy1CRDEpKfG9ev3nD8vKXFcKC3H6ohsxzgA+nadJ8wT3elXVO/d0uvHbWq27JC2Nfgv0
QAzocX2ylv5IAAqwOXRd6OP/AqBHk56cLeA1EPGBWwSoY/qxpld6v5CgJuj7/+UQtGDIGIfzD+o72WmD
vfrkAAAAAElFTkSuQmCC
</value>
</data>
<data name="BTT_DELETE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVCSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3ltZN
xfEiRQu2VNAxomZUXEHxBSWK0RhNNIrJkn3YPmwftsxkxi3RzWxMGCVTgYiMsuGCgA5rKX0vXPaSLNKz
/ymtzlg2nuSX23vOc/7Pv885914ODXNRUYwpKenjrmXLRq9LJB9tFItfwXBUYPJ/YkShUP4mkdwYW7p0
4Epysh5DMSAiMEljyGjk9xUVfTnS3EzGL1wgt5qa/NeVys48gWAlpqPnssLHMMO8adu27SF77hyZaW0l
o5WVng9SU+slsbHxmJ4r0rlixYf3DhwgD06eJOMnThArki2HD5M2pfKGVCB4HSlhi4ypVG9B3MKeP09Y
rGVbWsjM8ePknkbj/Vosfh8pQhDF6RKJrFT8QVMTeXj0KLEiafLMGdLX3Oy/rlDczBIIUpD4TBG0pdhW
VWWlzqn4DMTZQ4fIDIz5amqIKSHhLtKUQMDpSEy8OFpbS8ZRwAKsR44QGxY4Tp8m/WhXh1LZk8nnpyI5
UGREJiuerKy0Tp89S1iYmYEpFutm9u8nU7t3kzaFwrVdJLqM1FIg5OiWL3+1TS6/cXPnTv8jJE2ASbhx
YE/caJnz4EHShSK5fH7aTwxTNKHX26ZPnQq0hIVjFu1lGxvJNMRNubmeFB7vMwgbgBTQDedEMyJRKor0
WLZvJ7Y9e4i9oYE49u0jLhTzQsjc0ODvVakG75eXW9ljxwKOWcyxyGXr65+Ip/F4F6FXCzKC4pEgENxc
oTDte5ms+3Z1td9eV0ecwG00Eg8EfCjm27uXTMPtNBXGPYv7gDja2y2Xe6V8PhWnztPBYvD0qAaDqxAK
0zuys3tsW7YQ544dxA28BgPxweEUCk5hA6fKy4lv/XriU6mIB3Tn5flyBIJLWL8LUOc88Jx4KLir4uMz
OqTSniG5/LFn61biVquJm2GISywmLoGAuKKjiWvRImLm8/3tSUleZVwc3dA6kAleBPOKhyLQrj6p1DwJ
QTvEHMAJqHCAqCgykJ39lz419VvkvweywILEA2GrqTHaVCqLncd7XhzQsaHk5McmjeZ+WmJiOZbEgoWJ
+wyGg66CApcd7ucTnwAPgSUjgwxotXffXr06B0v/87USCLfB0OLcsMFtj4l5TtyJ3tN2UfFxMBoZSYZA
V06O31xR8ateqaRtmr+Id9euo46SEk84506RiDwqKfm7PyXFT8VHguL9oBuYGGbWTP/JfEVwFFvsBQVe
O58fEH6mLUuWkOHS0t9PrV3b279p06QlLY38AtE74Bb4kRagrFo1e1uvHyyQSukL8umr3lNb20zFHeHE
ExLI8Lp1f9QzTAdSG0oyM9+5W1Z2fxi9D4l3gnbQRosoFLO9FRX9n2o0dOO5IILj2bzZ6oiLC+8c4nUy
WTsSjYBupHBffv4bAzrd2GBW1hPx78A1cBWY09Mf39Hp7iF3OeBy7FrtsEciCevcyDA/IKk+KB76UnH3
FxYqByoqxq5lZfn/Lf5VRAS5gwImtXoCeUUgntNbXb1tUq12uyEacj5UXPznnvDioeA25ufnYWNH+7Kz
yZWguCkvb/YLtfpR6cqVnyBnrgBicXtl5TFrWZl3UKn0U+eNcnknxucTDwXXsGaNjLbjG6wzqVSzl+H8
JR6vFXNaMNciRASTlBTbr9N9/qCszHmpsBCnL7IR4wzg03maNE9wr1ZVvfuzVjtxS6NxlaSk0G+BDogB
Pa5P1tIfcUAONgavC338XwD0aNKTswm8BsI+cIsAdUw/1vRK7xcS1AR9/78chBYMGuNw/gGBHdjskDgc
+QAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_CLEAR_DONE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVCSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3ltZN
xfEiRQu2VNAxomZUXEHxBSWK0RhNNIrJkn3YPmwftsxkxi3RzWxMGCVTgYiMsuGCgA5rKX0vXPaSLNKz
/ymtzlg2nuSX23vOc/7Pv885914ODXNRUYwpKenjrmXLRq9LJB9tFItfwXBUYPJ/YkShUP4mkdwYW7p0
4Epysh5DMSAiMEljyGjk9xUVfTnS3EzGL1wgt5qa/NeVys48gWAlpqPnssLHMMO8adu27SF77hyZaW0l
o5WVng9SU+slsbHxmJ4r0rlixYf3DhwgD06eJOMnThArki2HD5M2pfKGVCB4HSlhi4ypVG9B3MKeP09Y
rGVbWsjM8ePknkbj/Vosfh8pQhDF6RKJrFT8QVMTeXj0KLEiafLMGdLX3Oy/rlDczBIIUpD4TBG0pdhW
VWWlzqn4DMTZQ4fIDIz5amqIKSHhLtKUQMDpSEy8OFpbS8ZRwAKsR44QGxY4Tp8m/WhXh1LZk8nnpyI5
UGREJiuerKy0Tp89S1iYmYEpFutm9u8nU7t3kzaFwrVdJLqM1FIg5OiWL3+1TS6/cXPnTv8jJE2ASbhx
YE/caJnz4EHShSK5fH7aTwxTNKHX26ZPnQq0hIVjFu1lGxvJNMRNubmeFB7vMwgbgBTQDedEMyJRKor0
WLZvJ7Y9e4i9oYE49u0jLhTzQsjc0ODvVakG75eXW9ljxwKOWcyxyGXr65+Ip/F4F6FXCzKC4pEgENxc
oTDte5ms+3Z1td9eV0ecwG00Eg8EfCjm27uXTMPtNBXGPYv7gDja2y2Xe6V8PhWnztPBYvD0qAaDqxAK
0zuys3tsW7YQ544dxA28BgPxweEUCk5hA6fKy4lv/XriU6mIB3Tn5flyBIJLWL8LUOc88Jx4KLir4uMz
OqTSniG5/LFn61biVquJm2GISywmLoGAuKKjiWvRImLm8/3tSUleZVwc3dA6kAleBPOKhyLQrj6p1DwJ
QTvEHMAJqHCAqCgykJ39lz419VvkvweywILEA2GrqTHaVCqLncd7XhzQsaHk5McmjeZ+WmJiOZbEgoWJ
+wyGg66CApcd7ucTnwAPgSUjgwxotXffXr06B0v/87USCLfB0OLcsMFtj4l5TtyJ3tN2UfFxMBoZSYZA
V06O31xR8ateqaRtmr+Id9euo46SEk84506RiDwqKfm7PyXFT8VHguL9oBuYGGbWTP/JfEVwFFvsBQVe
O58fEH6mLUuWkOHS0t9PrV3b279p06QlLY38AtE74Bb4kRagrFo1e1uvHyyQSukL8umr3lNb20zFHeHE
ExLI8Lp1f9QzTAdSG0oyM9+5W1Z2fxi9D4l3gnbQRosoFLO9FRX9n2o0dOO5IILj2bzZ6oiLC+8c4nUy
WTsSjYBupHBffv4bAzrd2GBW1hPx78A1cBWY09Mf39Hp7iF3OeBy7FrtsEciCevcyDA/IKk+KB76UnH3
FxYqByoqxq5lZfn/Lf5VRAS5gwImtXoCeUUgntNbXb1tUq12uyEacj5UXPznnvDioeA25ufnYWNH+7Kz
yZWguCkvb/YLtfpR6cqVnyBnrgBicXtl5TFrWZl3UKn0U+eNcnknxucTDwXXsGaNjLbjG6wzqVSzl+H8
JR6vFXNaMNciRASTlBTbr9N9/qCszHmpsBCnL7IR4wzg03maNE9wr1ZVvfuzVjtxS6NxlaSk0G+BDogB
Pa5P1tIfcUAONgavC338XwD0aNKTswm8BsI+cIsAdUw/1vRK7xcS1AR9/78chBYMGuNw/gGBHdjskDgc
+QAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_CLEAR_ALL.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVCSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3ltZN
xfEiRQu2VNAxomZUXEHxBSWK0RhNNIrJkn3YPmwftsxkxi3RzWxMGCVTgYiMsuGCgA5rKX0vXPaSLNKz
/ymtzlg2nuSX23vOc/7Pv885914ODXNRUYwpKenjrmXLRq9LJB9tFItfwXBUYPJ/YkShUP4mkdwYW7p0
4Epysh5DMSAiMEljyGjk9xUVfTnS3EzGL1wgt5qa/NeVys48gWAlpqPnssLHMMO8adu27SF77hyZaW0l
o5WVng9SU+slsbHxmJ4r0rlixYf3DhwgD06eJOMnThArki2HD5M2pfKGVCB4HSlhi4ypVG9B3MKeP09Y
rGVbWsjM8ePknkbj/Vosfh8pQhDF6RKJrFT8QVMTeXj0KLEiafLMGdLX3Oy/rlDczBIIUpD4TBG0pdhW
VWWlzqn4DMTZQ4fIDIz5amqIKSHhLtKUQMDpSEy8OFpbS8ZRwAKsR44QGxY4Tp8m/WhXh1LZk8nnpyI5
UGREJiuerKy0Tp89S1iYmYEpFutm9u8nU7t3kzaFwrVdJLqM1FIg5OiWL3+1TS6/cXPnTv8jJE2ASbhx
YE/caJnz4EHShSK5fH7aTwxTNKHX26ZPnQq0hIVjFu1lGxvJNMRNubmeFB7vMwgbgBTQDedEMyJRKor0
WLZvJ7Y9e4i9oYE49u0jLhTzQsjc0ODvVakG75eXW9ljxwKOWcyxyGXr65+Ip/F4F6FXCzKC4pEgENxc
oTDte5ms+3Z1td9eV0ecwG00Eg8EfCjm27uXTMPtNBXGPYv7gDja2y2Xe6V8PhWnztPBYvD0qAaDqxAK
0zuys3tsW7YQ544dxA28BgPxweEUCk5hA6fKy4lv/XriU6mIB3Tn5flyBIJLWL8LUOc88Jx4KLir4uMz
OqTSniG5/LFn61biVquJm2GISywmLoGAuKKjiWvRImLm8/3tSUleZVwc3dA6kAleBPOKhyLQrj6p1DwJ
QTvEHMAJqHCAqCgykJ39lz419VvkvweywILEA2GrqTHaVCqLncd7XhzQsaHk5McmjeZ+WmJiOZbEgoWJ
+wyGg66CApcd7ucTnwAPgSUjgwxotXffXr06B0v/87USCLfB0OLcsMFtj4l5TtyJ3tN2UfFxMBoZSYZA
V06O31xR8ateqaRtmr+Id9euo46SEk84506RiDwqKfm7PyXFT8VHguL9oBuYGGbWTP/JfEVwFFvsBQVe
O58fEH6mLUuWkOHS0t9PrV3b279p06QlLY38AtE74Bb4kRagrFo1e1uvHyyQSukL8umr3lNb20zFHeHE
ExLI8Lp1f9QzTAdSG0oyM9+5W1Z2fxi9D4l3gnbQRosoFLO9FRX9n2o0dOO5IILj2bzZ6oiLC+8c4nUy
WTsSjYBupHBffv4bAzrd2GBW1hPx78A1cBWY09Mf39Hp7iF3OeBy7FrtsEciCevcyDA/IKk+KB76UnH3
FxYqByoqxq5lZfn/Lf5VRAS5gwImtXoCeUUgntNbXb1tUq12uyEacj5UXPznnvDioeA25ufnYWNH+7Kz
yZWguCkvb/YLtfpR6cqVnyBnrgBicXtl5TFrWZl3UKn0U+eNcnknxucTDwXXsGaNjLbjG6wzqVSzl+H8
JR6vFXNaMNciRASTlBTbr9N9/qCszHmpsBCnL7IR4wzg03maNE9wr1ZVvfuzVjtxS6NxlaSk0G+BDogB
Pa5P1tIfcUAONgavC338XwD0aNKTswm8BsI+cIsAdUw/1vRK7xcS1AR9/78chBYMGuNw/gGBHdjskDgc
+QAAAABJRU5ErkJggg==
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVCSURBVEhLjZVtTFNXGMcLQmdHO1461GSlc4jjvUBvLbdu
Ko4XKVqwpYKOETWj4gqKLyhRjMZoovElWbIP24ftw5aZzLgluiyTCaNmKrApAltZENBhLaXvhctekkV6
9j+l1RnLxpP8cnvPec7/+fc5597Lo9FfXBxjSk7++PqSJSPXpNKP1kskr2A4KjD5PzGsVLK/SaU3Rhcv
7ruckqLHUAyICEzSMBuNwtvFxV8Ot7SQsfPnyY/Nzf5rLNuZLxItx3T0bFb4GGKYN21btjzkzpwh0+fO
kZGqKs8HaWkN0tjYeEzPFulctuzDe/v2kQfHj5OxY8eIFcmWgwdJG8vekIlEryMlbJFRleotiFu4s2cJ
h7VcayuZPnqU3NNovF9LJO8jJQFE8a6LxVYq/qC5mTw8fJhYkTRx6hTpa2nxX1Mqb2aLRKlIfKYI2lJi
q662UudUfBri3IEDZBrGfLW1xJSYOIg0Foh4HUlJF0bq6sgYCliA9dAhYsMCx8mTZADt6mDZ7iyhMA3J
gSLDcnnJRFWVder0acLBzDRMcVg3vXcvmdy5k7Qpla6tYvElpJaBBJ5u6dJX2xSKGz3bt/sfIWkcTMCN
A3viRsuc+/eT6yiSJxSm32WY4nG93jZ14kSgJRwcc2gv19REpiBuysvzpAoEn0HYAGSAbjgvmhGL01Ck
27J1K7Ht2kXsjY3EsWcPcaGYF0LmxkZ/j0o1cL+iwsodORJwzGGOQy7X0PBEPF0guAC9OpAZFI8EgeDn
JSSkfyeXd92tqfHb6+uJE7iNRuKBgA/FfLt3kym4naLCuOdwHxBHe7sUCq9MKKTi1HkGWAieHtVg8JUJ
CRkdOTndtk2biHPbNuIGXoOB+OBwEgUnsYGTFRXEt3Yt8alUxAO68vN9uSLRRazfAahzAXhOPBT8FfHx
mR0yWbeZZR97Nm8mbrWauBmGuCQS4hKJiCs6mrgWLCBmodDfnpzsZePi6IbWgyzwIphTPBSBdt2Wyfon
IGiHmAM4ARUOEBVF+nJy/tKnpX2L/PdANpiXeCBstbVGm0plsQsEz4sDOmZOSXls0mjupyclVWBJLJif
uM9g2O8qLHTZ4X4u8XHwEFgyM0mfVjv49sqVuVj6n6+VQLgNhlbnunVue0zMc+JO9J62i4qPgZHISGIG
N3Nz/f2Vlb/qWZa2ae4i3h07DjtKSz3hnDvFYvKotPTvgdRUPxUfDor3gi5gYpiZfvpP5iqCo9hqLyz0
2oXCgPAzbVm0iAyVlf1+YvXqnt4NGyYs6enkF4jeAbfAD7QAZcWKmZ/0+oFCmYy+IJ++6j11dS1U3BFO
PDGRDK1Z80cDw3QgtbE0K+udwfLy+0PofUi8E7SDNlpEqZzpqazs/VSjoRvPBxE8z8aNVkdcXHjnEK+X
y9uRaAR0IxP2FBS80afTjQ5kZz8Rvwq+AVdAf0bG4zs63T3kLgV8nl2rHfJIpWGdGxnmeyQ1BMVDXyr+
3qIitq+ycrQtO9v/b/GvIiLIHRQwqdXjyCsG8byempotE2q12w3RkHNzScmfu8KLh4LfVFCQj40duZ2T
Qy4HxU35+TNfqNWPypYv/wQ5swUQC9urqo5Yy8u9gyzrp86bFIpOjM8lHgq+YdUqOW3HVawzqVQzl+D8
JYHgHOa0YLZFiAgmOTm2V6f7/EF5ufNiURFOX2QTxhkgpPM0aY7gX6mufvdnrXb8lkbjKk1Npd8CHZAA
elyfrKU/4oACrA9e5/v4vwDo0aQnZwN4DYR94BYA6ph+rOmV3s8nqAn6/n85CC0YNMbj/QOlgNkkdPGc
ugAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_LOG.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">

View File

@@ -247,6 +247,8 @@ Namespace DownloadObjects.STDownloader
If e.Control Then useCookies = True
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 c As IYouTubeMediaContainer = Nothing
Dim url$ = String.Empty
@@ -264,7 +266,7 @@ Namespace DownloadObjects.STDownloader
pForm.SetInitialValues(.Count, "Parsing playlists...")
Dim containers As New List(Of IYouTubeMediaContainer)
For Each u$ In .Self
containers.Add(YouTubeFunctions.Parse(u, useCookiesParse, pForm.Token, pForm.MyProgress, True, False))
containers.Add(YouTubeFunctions.Parse(standardize(u), useCookiesParse, pForm.Token, pForm.MyProgress, True, False))
pForm.NextPlaylist()
pForm.MyProgress.Perform()
Next
@@ -295,7 +297,7 @@ Namespace DownloadObjects.STDownloader
pForm = New ParsingProgressForm
pForm.Show(Me)
pForm.SetInitialValues(1, "Parsing data...")
c = YouTubeFunctions.Parse(url, useCookiesParse, pForm.Token, pForm.MyProgress, GetDefault, GetShorts)
c = YouTubeFunctions.Parse(standardize(url), useCookiesParse, pForm.Token, pForm.MyProgress, GetDefault, GetShorts)
pForm.Dispose()
End If
If Not c Is Nothing Then
@@ -341,15 +343,20 @@ Namespace DownloadObjects.STDownloader
ControlInvoke(TOOLBAR_TOP, BTT_STOP, Sub() BTT_STOP.Enabled = False, EDP.SendToLog)
MyJob.Cancel()
End Sub
#Region "Delete / Clear"
Private Sub BTT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_DELETE.Click
RemoveControls(ControlsChecked, True)
End Sub
Private Sub BTT_CLEAR_SELECTED_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_SELECTED.Click
RemoveControls(ControlsChecked, False)
End Sub
Protected Overridable Sub BTT_CLEAR_DONE_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DONE.Click
RemoveControls(ControlsDownloaded, False)
End Sub
Protected Overridable Sub BTT_CLEAR_ALL_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_ALL.Click
RemoveControls(, False)
End Sub
#End Region
Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click
MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton)
End Sub
@@ -526,6 +533,7 @@ Namespace DownloadObjects.STDownloader
MyProgress.InformationTemporary = "Download error"
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[VideoListForm.DownloadData]")
Finally
MyProgress.Visible(, False) = False
MyJob.Finish()
EnableDownloadButtons(False)
End Try

View File

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

View File

@@ -25,6 +25,7 @@ Namespace API.YouTube.Objects
ReadOnly Property MediaType As UMTypes
ReadOnly Property MediaState As UMStates
Property IsMusic As Boolean
Property IsShorts As Boolean
Property ID As String
Property Description As String
Property PlaylistID As String

View File

@@ -112,7 +112,7 @@ Namespace API.YouTube.Objects
End Set
End Property
<XMLEC(Name_IsMusic)> Public Property IsMusic As Boolean = False Implements IYouTubeMediaContainer.IsMusic
<XMLEC> Public Property IsShorts As Boolean = False
<XMLEC> Public Property IsShorts As Boolean = False Implements IYouTubeMediaContainer.IsShorts
<XMLEC> Public Property ID As String Implements IYouTubeMediaContainer.ID, IUserMedia.PostID
<XMLEC> Public Property Title As String Implements IDownloadableMedia.Title
<XMLEC> Public Property Description As String Implements IYouTubeMediaContainer.Description
@@ -709,6 +709,19 @@ Namespace API.YouTube.Objects
End Sub
#End Region
#Region "Download"
Protected Shared Sub CreateUrlFile(ByVal URL As String, ByVal File As SFile)
Try
File.Extension = "url"
Using t As New TextSaver(File)
t.AppendLine("[InternetShortcut]")
t.AppendLine("IDList=")
t.AppendLine($"URL={URL}")
t.AppendLine()
t.Save(EDP.None)
End Using
Catch ex As Exception
End Try
End Sub
Private ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue)
Public Property Progress As MyProgress Implements IYouTubeMediaContainer.Progress
Private Property IDownloadableMedia_Progress As Object Implements IDownloadableMedia.Progress
@@ -807,6 +820,13 @@ Namespace API.YouTube.Objects
Try
Dim url$ = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={PlsId}"
Dim r$
If DownloadObjects.STDownloader.MyDownloaderSettings.CreateUrlFiles Then
Dim ff As SFile = f
ff.Name = "album"
ff.Extension = "url"
CreateUrlFile(url, ff)
If ff.Exists Then Files.Add(ff)
End If
Using resp As New Responser
If UseCookies And MyYouTubeSettings.Cookies.Count > 0 Then resp.Cookies.AddRange(MyYouTubeSettings.Cookies,, EDP.SendToLog)
r = resp.GetResponse(url,, EDP.ReturnValue)
@@ -882,6 +902,21 @@ Namespace API.YouTube.Objects
End If
If Not File.Exists Then _File.Name = File.File
If File.Exists Then
If DownloadObjects.STDownloader.MyDownloaderSettings.CreateUrlFiles Then
Dim fileUrl As SFile = File
fileUrl.Extension = "url"
CreateUrlFile(URL, fileUrl)
If fileUrl.Exists Then Files.Add(fileUrl)
End If
If MyYouTubeSettings.CreateDescriptionFiles And Not Description.IsEmptyString Then
Dim fileDesr As SFile = File
fileDesr.Extension = "txt"
TextSaver.SaveTextToFile(Description, fileDesr,,, EDP.None)
If fileDesr.Exists Then Files.Add(fileDesr)
End If
If PlaylistCount > 0 And Not CoverDownloaded And Not PlaylistID.IsEmptyString Then DownloadPlaylistCover(PlaylistID, File, UseCookies)
If prExists Then Progress.InformationTemporary = $"Download {MediaType}: post processing"
_ThumbnailFile = File
@@ -1025,7 +1060,11 @@ Namespace API.YouTube.Objects
If fc.Exists(SFO.Path, False) AndAlso SFile.GetFiles(fc, "*.json",, EDP.ReturnValue).Count > 0 Then Parse(Nothing, fc, IsMusic)
XMLPopulateData(Me, x)
_MediaStateOnLoad = _MediaState
_Exists = True
If Me.MediaState = UMStates.Downloaded Then
_Exists = File.Exists(IIf(ObjectType = YouTubeMediaType.Single, SFO.File, SFO.Path), False)
Else
_Exists = True
End If
If If(x(Name_CheckedElements)?.Count, 0) > 0 Then ApplyElementCheckedValue(x(Name_CheckedElements))
If ArrayMaxResolution <> -10 Then SetMaxResolution(ArrayMaxResolution)
End Using
@@ -1309,9 +1348,29 @@ Namespace API.YouTube.Objects
Next
End If
End Sub
Dim protocolCleaner As Action =
Sub()
If Not MyYouTubeSettings.DefaultProtocol.Value = Protocols.Undefined And
Not MyYouTubeSettings.DefaultProtocol.Value = Protocols.Any Then
Dim data As New List(Of MediaObject)(MediaObjects.Where(Function(mo) mo.ProtocolType = MyYouTubeSettings.DefaultProtocol.Value))
If data.ListExists Then
Dim dRem As Protocols = IIf(MyYouTubeSettings.DefaultProtocol.Value = Protocols.https, Protocols.m3u8, Protocols.https)
Dim d As MediaObject
Dim dr As New FPredicate(Of MediaObject)(Function(mo) mo.Height = d.Height And mo.ProtocolType = dRem)
For Each d In data
If MediaObjects.Count = 0 Then
Exit For
ElseIf MediaObjects.LongCount(dr) > 0 Then
MediaObjects.RemoveAll(dr)
End If
Next
End If
End If
End Sub
If MediaObjects.Count > 0 And Not MyYouTubeSettings.DefaultVideoIncludeNullSize Then MediaObjects.RemoveAll(Function(mo) mo.Size <= 0)
If MediaObjects.Count > 0 Then DupRemover.Invoke(UMTypes.Audio)
If MediaObjects.Count > 0 Then DupRemover.Invoke(UMTypes.Video)
If MediaObjects.Count > 0 Then protocolCleaner.Invoke
If MediaObjects.Count > 0 Then
MediaObjects.Sort()
SelectedAudioIndex = MediaObjects.FindIndex(Function(mo) mo.Type = UMTypes.Audio)

View File

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

View File

@@ -67,7 +67,6 @@ Namespace API.Base.GDL
End Function
End Module
Friend Class GDLBatch : Inherits TokenBatch
Friend Property TempPostsList As List(Of String)
Friend Const UrlLibStart As String = "[urllib3.connectionpool][debug]"
Friend Const UrlTextStart As String = UrlLibStart & " https"
Friend Sub New(ByVal _Token As Threading.CancellationToken)
@@ -75,20 +74,11 @@ Namespace API.Base.GDL
MainProcessName = "gallery-dl"
ChangeDirectory(Settings.GalleryDLFile.File)
End Sub
Public Overrides Sub Create()
If TempPostsList Is Nothing Then TempPostsList = New List(Of String)
MyBase.Create()
End Sub
Protected Overrides Async Sub OutputDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
If Not ProcessKilled Then
MyBase.OutputDataReceiver(Sender, e)
Await Validate(e.Data)
End If
End Sub
Protected Overridable Async Function Validate(ByVal Value As String) As Task
If Not ProcessKilled AndAlso Await Task.Run(Of Boolean)(Function() Token.IsCancellationRequested OrElse
(Not Value.IsEmptyString AndAlso
TempPostsList.Exists(Function(v) Value.Contains(v)))) Then Kill()
End Function
End Class
End Namespace

View File

@@ -31,6 +31,7 @@ Namespace API.Base
Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken)
Property ParseUserMediaOnly As Boolean
ReadOnly Property IsSubscription As Boolean
ReadOnly Property IsUser As Boolean
#Region "Images"
Function GetPicture() As Image
Sub SetPicture(ByVal f As SFile)

View File

@@ -34,7 +34,7 @@ Namespace API.Base
End Function
Friend Shared Function Download(ByVal URLs As List(Of String), ByVal DestinationFile As SFile, Optional ByVal Responser As Responser = Nothing,
Optional ByVal Token As CancellationToken = Nothing, Optional ByVal Progress As MyProgress = Nothing,
Optional ByVal UsePreProgress As Boolean = True) As SFile
Optional ByVal UsePreProgress As Boolean = True, Optional ByVal ExistingCache As CacheKeeper = Nothing) As SFile
Dim Cache As CacheKeeper = Nothing
Using tmpPr As New PreProgress(Progress)
Try
@@ -42,8 +42,12 @@ Namespace API.Base
Dim ConcatFile As SFile = DestinationFile
If ConcatFile.Name.IsEmptyString Then ConcatFile.Name = "PlayListFile"
ConcatFile.Extension = "mp4"
Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{TempCacheFolderName}\")
Cache.CacheDeleteError = CacheDeletionError(Cache)
If ExistingCache Is Nothing Then
Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{TempCacheFolderName}\")
Cache.CacheDeleteError = CacheDeletionError(Cache)
Else
Cache = ExistingCache
End If
Dim cache2 As CacheKeeper = Cache.NewInstance
If cache2.RootDirectory.Exists(SFO.Path) Then
Dim progressExists As Boolean = Not Progress Is Nothing

View File

@@ -10,18 +10,39 @@ Imports System.Threading
Imports PersonalUtilities.Tools
Namespace API.Base
Friend Class TokenBatch : Inherits BatchExecutor
Friend Property TempPostsList As List(Of String)
Protected ReadOnly Token As CancellationToken
Friend Property DebugMode As Boolean = False
Friend Sub New(ByVal _Token As CancellationToken)
MyBase.New(True)
Token = _Token
End Sub
Public Overrides Sub Create()
If TempPostsList Is Nothing Then TempPostsList = New List(Of String)
MyBase.Create()
End Sub
Protected Overrides Async Sub OutputDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
MyBase.OutputDataReceiver(Sender, e)
Await Task.Run(Sub() If Token.IsCancellationRequested Then Kill())
Await Task.Run(Sub()
#If DEBUG Then
If DebugMode Then Debug.WriteLineIf(Not e.Data.IsEmptyString, $"Out: {e.Data}")
#End If
If Token.IsCancellationRequested Then Kill()
End Sub)
End Sub
Protected Overrides Async Sub ErrorDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
MyBase.ErrorDataReceiver(Sender, e)
Await Task.Run(Sub() If Token.IsCancellationRequested Then Kill())
Await Task.Run(Sub()
#If DEBUG Then
If DebugMode Then Debug.WriteLineIf(Not e.Data.IsEmptyString, $"Err: {e.Data}")
#End If
If Token.IsCancellationRequested Then Kill()
End Sub)
End Sub
Protected Overridable Async Function Validate(ByVal Value As String) As Task
If Not ProcessKilled AndAlso Await Task.Run(Of Boolean)(Function() Token.IsCancellationRequested OrElse
(Not Value.IsEmptyString AndAlso
TempPostsList.Exists(Function(v) Value.Contains(v)))) Then Kill()
End Function
End Class
End Namespace

View File

@@ -553,6 +553,11 @@ BlockNullPicture:
Return User.IsSubscription
End Get
End Property
Friend Overridable ReadOnly Property IsUser As Boolean Implements IUserData.IsUser
Get
Return True
End Get
End Property
Private Property IPluginContentProvider_IsSubscription As Boolean Implements IPluginContentProvider.IsSubscription
Get
Return IsSubscription
@@ -751,7 +756,6 @@ BlockNullPicture:
End Function
Friend Overridable Sub ExchangeOptionsSet(ByVal Obj As Object) Implements IPluginContentProvider.ExchangeOptionsSet
End Sub
Private _ExternalCompatibilityToken As CancellationToken
#End Region
#Region "IIndexable Support"
Friend Property Index As Integer = 0 Implements IIndexable.Index
@@ -1082,7 +1086,8 @@ BlockNullPicture:
Return __DOWNLOAD_IN_PROGRESS
End Get
End Property
Friend PersonalToken As CancellationToken
Private TokenQueue As CancellationToken
Friend TokenPersonal As CancellationToken
Protected Responser As Responser
Protected UseResponserClient As Boolean = False
Protected UseClientTokens As Boolean = False
@@ -1096,7 +1101,7 @@ BlockNullPicture:
Private _PictureExists As Boolean
Private _EnvirInvokeUserUpdated As Boolean = False
Protected Sub EnvirDownloadSet()
PersonalToken = Nothing
TokenPersonal = Nothing
ProgressPre.Reset()
UpdateDataFiles()
_DownloadInProgress = True
@@ -1128,7 +1133,7 @@ BlockNullPicture:
__DOWNLOAD_IN_PROGRESS = True
OnUserDownloadStateChanged(True)
Dim Canceled As Boolean = False
_ExternalCompatibilityToken = Token
TokenQueue = Token
Try
EnvirDownloadSet()
If Not Responser Is Nothing Then Responser.Dispose()
@@ -1221,7 +1226,7 @@ BlockNullPicture:
End If
ThrowIfDisposed()
If Not _PictureExists Or _EnvirInvokeUserUpdated Then OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested Or PersonalToken.IsCancellationRequested
Catch oex As OperationCanceledException When Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested Or TokenQueue.IsCancellationRequested
MyMainLOG = $"{ToStringForLog()}: downloading canceled"
Canceled = True
Catch exit_ex As ExitException
@@ -1239,9 +1244,10 @@ BlockNullPicture:
LogError(ex, "downloading data error")
HasError = True
Finally
If Not UserExists Then MyMainLOG = $"User '{ToStringForLog()}' not found on the site"
If Not UserExists Then AddNonExistingUserToLog($"User '{ToStringForLog()}' not found on the site")
If Not Responser Is Nothing Then Responser.Dispose() : Responser = Nothing
If Not Canceled Then _DataParsed = True
TokenPersonal = Nothing
_ContentNew.Clear()
_DownloadInProgress = False
DownloadTopCount = Nothing
@@ -1288,6 +1294,7 @@ BlockNullPicture:
Try
Data.DownloadState = UserMediaStates.Tried
Progress = Data.Progress
If Not Progress Is Nothing Then Progress.ResetProgressOnMaximumChanges = False
If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Responser
If Not HOST Is Nothing AndAlso HOST.Available(ISiteSettings.Download.SingleObject, True) AndAlso
@@ -1298,6 +1305,10 @@ BlockNullPicture:
DownloadSingleObject_CreateMedia(Data, Token)
DownloadSingleObject_Download(Data, Token)
DownloadSingleObject_PostProcessing(Data)
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Data.DownloadState = UserMediaStates.Missing
ErrorsDescriber.Execute(EDP.SendToLog, oex, $"{Site} download canceled: {Data.URL}")
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
Data.DownloadState = UserMediaStates.Missing
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"{Site} single data downloader error: {Data.URL}")
@@ -1364,7 +1375,7 @@ BlockNullPicture:
#Region "MD5 support"
Protected Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR"
Friend Property UseMD5Comparison As Boolean = False
Protected Property StartMD5Checked As Boolean = True
Protected Property StartMD5Checked As Boolean = False
Friend Property RemoveExistingDuplicates As Boolean = False
Protected Overridable Sub ValidateMD5(ByVal Token As CancellationToken)
Try
@@ -1441,7 +1452,7 @@ BlockNullPicture:
For i = 0 To _ContentList.Count - 1
data = _ContentList(i)
ProgressPre.Perform()
If (data.Type = UTypes.GIF Or data.Type = UTypes.Picture) Then
If data.Type = UTypes.GIF Or data.Type = UTypes.Picture Then
If data.MD5.IsEmptyString Then
ThrowAny(Token)
eIndx = existingFiles.FindIndex(eFinder)
@@ -1722,7 +1733,7 @@ BlockNullPicture:
Optional ByVal ThrowEx As Boolean = True) As Integer
If TypeOf ex Is ExitException Then
Throw ex
ElseIf Not ((TypeOf ex Is OperationCanceledException And (Token.IsCancellationRequested Or PersonalToken.IsCancellationRequested)) Or
ElseIf Not ((TypeOf ex Is OperationCanceledException And (Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested Or TokenQueue.IsCancellationRequested)) Or
(TypeOf ex Is ObjectDisposedException And Disposed)) Then
If RDE Then
Dim v% = DownloadingException(ex, Message, True, EObj)
@@ -1822,12 +1833,7 @@ BlockNullPicture:
If m.Contains(IUserData.EraseMode.History) Then
If MyFilePosts.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
If MyFileData.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
If result Then
_TempPostsList.Clear()
_TempMediaList.Clear()
_ContentNew.Clear()
_ContentList.Clear()
End If
EraseData_AdditionalDataFiles()
End If
If m.Contains(IUserData.EraseMode.Data) Then
Dim files As List(Of SFile) = SFile.GetFiles(DownloadContentDefault_GetRootDir.CSFileP,, SearchOption.AllDirectories, e)
@@ -1836,6 +1842,12 @@ BlockNullPicture:
LatestData.Clear()
result = True
End If
If result Then
_TempPostsList.Clear()
_TempMediaList.Clear()
_ContentNew.Clear()
_ContentList.Clear()
End If
End If
End If
Return result
@@ -1843,6 +1855,8 @@ BlockNullPicture:
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"EraseData({CInt(Mode)}): {ToStringForLog()}", False)
End Try
End Function
Protected Overridable Sub EraseData_AdditionalDataFiles()
End Sub
Friend Overridable Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer Implements IUserData.Delete
Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then
@@ -2019,8 +2033,8 @@ BlockNullPicture:
End Function
#End Region
#Region "Errors functions"
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String)
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"{ToStringForLog()}: {Message}")
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String, Optional ByVal e As ErrorsDescriber = Nothing)
ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}")
End Sub
Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String)
If Not f.Exists Then MyMainLOG = $"Error downloading from [{URL}] to [{f}]"
@@ -2031,13 +2045,18 @@ BlockNullPicture:
End Sub
''' <inheritdoc cref="ThrowAny(CancellationToken)"/>
Private Overloads Sub ThrowAny() Implements IThrower.ThrowAny
ThrowAny(_ExternalCompatibilityToken)
ThrowAny(TokenQueue)
End Sub
''' <summary><c>ThrowAnyImpl(Token)</c></summary>
''' <exception cref="OperationCanceledException"></exception>
''' <exception cref="ObjectDisposedException"></exception>
Friend Overridable Overloads Sub ThrowAny(ByVal Token As CancellationToken)
ThrowAnyImpl(Token)
End Sub
Protected Sub ThrowAnyImpl(ByVal Token As CancellationToken)
Token.ThrowIfCancellationRequested()
PersonalToken.ThrowIfCancellationRequested()
TokenQueue.ThrowIfCancellationRequested()
TokenPersonal.ThrowIfCancellationRequested()
ThrowIfDisposed()
End Sub
#End Region
@@ -2097,7 +2116,11 @@ BlockNullPicture:
#End Region
#Region "IComparable Support"
Friend Overridable Function CompareTo(ByVal Other As UserDataBase) As Integer Implements IComparable(Of UserDataBase).CompareTo
Return Name.CompareTo(Other.Name)
If IsCollection Then
Return Name.CompareTo(Other.Name)
Else
Return FriendlyName.IfNullOrEmpty(Name).StringTrim.CompareTo(Other.FriendlyName.IfNullOrEmpty(Other.Name).StringTrim)
End If
End Function
Friend Overridable Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserDataBase Then
@@ -2134,6 +2157,7 @@ BlockNullPicture:
LatestData.Clear()
_TempMediaList.Clear()
_TempPostsList.Clear()
TokenPersonal = Nothing
If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose()
If Not Responser Is Nothing Then Responser.Dispose()
If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose()

View File

@@ -0,0 +1,18 @@
' Copyright (C) 2023 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.Base.YTDLP
Friend Class YTDLPBatch : Inherits GDL.GDLBatch
Friend Sub New(ByVal _Token As Threading.CancellationToken)
MyBase.New(_Token)
Commands.Clear()
MainProcessName = "yt-dlp"
ChangeDirectory(Settings.YtdlpFile.File)
End Sub
End Class
End Namespace

View File

@@ -17,7 +17,7 @@ Namespace API.Instagram
Friend ReadOnly FilesPattern As RParams = RParams.DMS(".+?([^/\?]+?\.[\w\d]{3,4})(?=(\?|\Z))", 1, EDP.ReturnValue)
Friend Sub UpdateResponser(ByVal Source As IResponse, ByRef Destination As Responser)
Const r_wwwClaimName$ = "x-ig-set-www-claim"
Const r_tokenName$ = "csrftoken"
Const r_tokenName$ = SiteSettings.Header_CSRF_TOKEN_COOKIE
If Not Source Is Nothing Then
Dim isInternal As Boolean = TypeOf Source Is WebDataResponse
Dim wwwClaimName$, tokenName$

View File

@@ -11,14 +11,17 @@ Namespace API.Instagram
Friend Class EditorExchangeOptions
<PSetting(Caption:="Get timeline", ToolTip:="Download user timeline")>
Friend Property GetTimeline As Boolean
<PSetting(Caption:="Get stories", ToolTip:="Download user stories")>
<PSetting(Caption:="Get stories", ToolTip:="Download user stories (pinned)")>
Friend Property GetStories As Boolean
<PSetting(Caption:="Get stories: user", ToolTip:="Download user stories")>
Friend Property GetStoriesUser As Boolean
<PSetting(Caption:="Get tagged posts", ToolTip:="Download user tagged posts")>
Friend Property GetTagged As Boolean
Friend Sub New(ByVal u As UserData)
With u
GetTimeline = .GetTimeline
GetStories = .GetStories
GetStoriesUser = .GetStoriesUser
GetTagged = .GetTaggedData
End With
End Sub
@@ -26,6 +29,7 @@ Namespace API.Instagram
With s
GetTimeline = CBool(.GetTimeline.Value)
GetStories = CBool(.GetStories.Value)
GetStoriesUser = CBool(.GetStoriesUser.Value)
GetTagged = CBool(.GetTagged.Value)
End With
End Sub

View File

@@ -70,13 +70,14 @@ Namespace API.Instagram
End Class
#End Region
#Region "Authorization properties"
Private Const Header_IG_APP_ID As String = "x-ig-app-id"
Friend Const Header_IG_APP_ID As String = "x-ig-app-id"
Friend Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Friend Const Header_CSRF_TOKEN As String = "x-csrftoken"
Private Const Header_ASBD_ID As String = "X-Asbd-Id"
Private Const Header_Browser As String = "Sec-Ch-Ua"
Private Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
Private Const Header_Platform As String = "Sec-Ch-Ua-Platform-Version"
Friend Const Header_CSRF_TOKEN_COOKIE As String = "csrftoken"
Friend Const Header_ASBD_ID As String = "X-Asbd-Id"
Friend Const Header_Browser As String = "Sec-Ch-Ua"
Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
Friend Const Header_Platform As String = "Sec-Ch-Ua-Platform-Version"
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash for tagged posts", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)>
Friend ReadOnly Property HashTagged As PropertyValue
<PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(2)>
@@ -139,11 +140,13 @@ Namespace API.Instagram
Friend ReadOnly Property GetTimeline As PropertyValue
<PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users"), PXML, ControlNumber(24)>
Friend ReadOnly Property GetStories As PropertyValue
<PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), PXML, ControlNumber(25)>
<PropertyOption(ControlText:="Get stories: user", ControlToolTip:="Default value for new users"), PXML, ControlNumber(25)>
Friend ReadOnly Property GetStoriesUser As PropertyValue
<PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), PXML, ControlNumber(26)>
Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr &
"-1 to disable"), PXML, ControlNumber(26)>
"-1 to disable"), PXML, ControlNumber(27)>
Friend ReadOnly Property TaggedNotifyLimit As PropertyValue
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
@@ -153,7 +156,9 @@ Namespace API.Instagram
Friend ReadOnly Property DownloadTimeline As PropertyValue
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories"), PXML, ControlNumber(11)>
Friend ReadOnly Property DownloadStories As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(12)>
<PropertyOption(ControlText:="Download stories: user", ControlToolTip:="Download stories (user)"), PXML, ControlNumber(12)>
Friend ReadOnly Property DownloadStoriesUser As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(13)>
Friend ReadOnly Property DownloadTagged As PropertyValue
#End Region
#Region "429 bypass"
@@ -259,6 +264,7 @@ Namespace API.Instagram
DownloadTimeline = New PropertyValue(True)
DownloadStories = New PropertyValue(True)
DownloadStoriesUser = New PropertyValue(True)
DownloadTagged = New PropertyValue(False)
RequestsWaitTimer = New PropertyValue(1000)
@@ -270,6 +276,7 @@ Namespace API.Instagram
GetTimeline = New PropertyValue(True)
GetStories = New PropertyValue(False)
GetStoriesUser = New PropertyValue(False)
GetTagged = New PropertyValue(False)
TaggedNotifyLimit = New PropertyValue(200)
TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
@@ -359,13 +366,16 @@ Namespace API.Instagram
SkipUntilNextSession = False
End Sub
#End Region
#Region "UserOptions, GetUserPostUrl"
#Region "UserOptions, GetUserUrl, GetUserPostUrl"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is EditorExchangeOptions Then Options = New EditorExchangeOptions(Me)
If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
End Sub
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return String.Format(UrlPatternUser, DirectCast(User, UserData).NameTrue)
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Try
Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID)

View File

@@ -17,6 +17,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Instagram
Friend Class UserData : Inherits UserDataBase
#Region "XML Names"
@@ -24,12 +25,13 @@ Namespace API.Instagram
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
Private Const Name_GetTimeline As String = "GetTimeline"
Private Const Name_GetStories As String = "GetStories"
Private Const Name_GetStoriesUser As String = "GetStoriesUser"
Private Const Name_GetTagged As String = "GetTaggedData"
Private Const Name_TaggedChecked As String = "TaggedChecked"
Private Const Name_NameTrue As String = "NameTrue"
#End Region
#Region "Declarations"
Private Structure PostKV : Implements IEContainerProvider
Protected Structure PostKV : Implements IEContainerProvider
Private Const Name_Code As String = "Code"
Private Const Name_Section As String = "Section"
Friend Code As String
@@ -75,15 +77,41 @@ Namespace API.Instagram
Private FirstLoadingDone As Boolean = False
Friend Property GetTimeline As Boolean = True
Friend Property GetStories As Boolean
Friend Property GetStoriesUser As Boolean
Friend Property GetTaggedData As Boolean
Private _NameTrue As String = String.Empty
Private ReadOnly Property NameTrue As String
Protected _NameTrue As String = String.Empty
Friend ReadOnly Property NameTrue As String
Get
Return _NameTrue.IfNullOrEmpty(Name)
End Get
End Property
Private UserNameRequested As Boolean = False
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
LastCursor = .Value(Name_LastCursor)
FirstLoadingDone = .Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
GetTimeline = .Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value))
GetStories = .Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
GetStoriesUser = .Value(Name_GetStoriesUser).FromXML(Of Boolean)(MySiteSettings.GetStoriesUser.Value)
GetTaggedData = .Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
TaggedChecked = .Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
_NameTrue = .Value(Name_NameTrue)
Else
.Add(Name_LastCursor, LastCursor)
.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
.Add(Name_GetStories, GetStories.BoolToInteger)
.Add(Name_GetStoriesUser, GetStoriesUser.BoolToInteger)
.Add(Name_GetTagged, GetTaggedData.BoolToInteger)
.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
.Add(Name_NameTrue, _NameTrue)
End If
End With
End Sub
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptions(Me)
@@ -93,37 +121,17 @@ Namespace API.Instagram
With DirectCast(Obj, EditorExchangeOptions)
GetTimeline = .GetTimeline
GetStories = .GetStories
GetStoriesUser = .GetStoriesUser
GetTaggedData = .GetTagged
End With
End If
End Sub
#End Region
#Region "Initializer, loader"
#Region "Initializer"
Friend Sub New()
PostsKVIDs = New List(Of PostKV)
PostsToReparse = New List(Of PostKV)
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
LastCursor = .Value(Name_LastCursor)
FirstLoadingDone = .Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
GetTimeline = .Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value))
GetStories = .Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
GetTaggedData = .Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
TaggedChecked = .Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
_NameTrue = .Value(Name_NameTrue)
Else
.Add(Name_LastCursor, LastCursor)
.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
.Add(Name_GetStories, GetStories.BoolToInteger)
.Add(Name_GetTagged, GetTaggedData.BoolToInteger)
.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
.Add(Name_NameTrue, _NameTrue)
End If
End With
End Sub
#End Region
#Region "Download data"
Private E560Thrown As Boolean = False
@@ -136,12 +144,22 @@ Namespace API.Instagram
Throw New ExitException
End Sub
End Class
Private Sub LoadSavePostsKV(ByVal Load As Boolean)
Private ReadOnly Property MyFilePostsKV As SFile
Get
Dim f As SFile = MyFilePosts
If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
Return f
Else
Return Nothing
End If
End Get
End Property
Protected Sub LoadSavePostsKV(ByVal Load As Boolean)
Dim x As XmlFile
Dim f As SFile = MyFilePosts
Dim f As SFile = MyFilePostsKV
If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
If Load Then
PostsKVIDs.Clear()
x = New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
@@ -175,10 +193,8 @@ Namespace API.Instagram
Friend Function GetPostCodeById(ByVal PostID As String) As String
Try
If Not PostID.IsEmptyString Then
Dim f As SFile = MyFilePosts
Dim f As SFile = MyFilePostsKV
If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
Dim l As List(Of PostKV) = Nothing
Using x As New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
@@ -206,11 +222,15 @@ Namespace API.Instagram
End If
End Function
Private _DownloadingInProgress As Boolean = False
Private _Limit As Integer = -1
Private _TotalPostsParsed As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
UserNameRequested = False
Dim s As Sections = Sections.Timeline
Dim errorFound As Boolean = False
Try
_Limit = If(DownloadTopCount, -1)
_TotalPostsParsed = 0
LoadSavePostsKV(True)
_DownloadingInProgress = True
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
@@ -234,6 +254,7 @@ Namespace API.Instagram
If FirstLoadingDone Then LastCursor = String.Empty
If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then
If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
If CBool(MySiteSettings.DownloadStoriesUser.Value) And GetStoriesUser Then s = Sections.UserStories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
@@ -262,7 +283,7 @@ Namespace API.Instagram
Catch ex As Exception
End Try
End Sub
Private Sub UpdateResponser()
Protected Overridable Sub UpdateResponser()
Try
If _DownloadingInProgress AndAlso Not Responser Is Nothing AndAlso Not Responser.Disposed Then
_DownloadingInProgress = False
@@ -272,10 +293,10 @@ Namespace API.Instagram
Catch
End Try
End Sub
Private Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
Protected Overridable Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
Declarations.UpdateResponser(e, Responser)
End Sub
Private Enum Sections : Timeline : Tagged : Stories : SavedPosts : End Enum
Protected Enum Sections : Timeline : Tagged : Stories : UserStories : SavedPosts : End Enum
Private Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass"
@@ -455,7 +476,7 @@ Namespace API.Instagram
ThrowAny(Token)
End If
If StoriesList.ListExists Then
GetStoriesData(StoriesList, Token)
GetStoriesData(StoriesList, False, Token)
MySiteSettings.TooManyRequests(False)
RequestsCount += 1
End If
@@ -464,6 +485,11 @@ Namespace API.Instagram
Else
Throw New ExitException
End If
Case Sections.UserStories
GetStoriesData(Nothing, True, Token)
MySiteSettings.TooManyRequests(False)
RequestsCount += 1
Throw New ExitException
End Select
'Get response
@@ -559,6 +585,7 @@ Namespace API.Instagram
Dim URL$ = String.Empty
Dim dValue% = 1
Dim _Index% = 0
Dim before%
If PostsToReparse.Count > 0 Then ProgressPre.ChangeMax(PostsToReparse.Count)
Try
Do While dValue = 1
@@ -587,7 +614,12 @@ Namespace API.Instagram
If Not j Is Nothing Then
If If(j("items")?.Count, 0) > 0 Then
With j("items")
For Each jj In .Self : ObtainMedia(jj, PostsToReparse(i).ID) : Next
For Each jj In .Self
before = _TempMediaList.Count
ObtainMedia(jj, PostsToReparse(i).ID)
If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
If _Limit > 0 And _TotalPostsParsed >= _Limit Then Throw New ExitException
Next
End With
End If
j.Dispose()
@@ -624,21 +656,24 @@ Namespace API.Instagram
NextCursor = .Value("next_max_id")
If .Contains("items") Then nodes = (From ee As EContainer In .Item("items") Where ee.Count > 0 Select ee(0))
End With
If nodes.ListExists Then
DefaultParser(nodes, Sections.SavedPosts, Token)
If HasNextPage And Not NextCursor.IsEmptyString Then SavedPostsDownload(NextCursor, Token)
End If
If nodes.ListExists AndAlso DefaultParser(nodes, Sections.SavedPosts, Token) AndAlso
HasNextPage AndAlso Not NextCursor.IsEmptyString Then SavedPostsDownload(NextCursor, Token)
End If
End Using
End If
End Sub
Private Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
Optional ByVal SpecFolder As String = Nothing) As Boolean
Protected DefaultParser_ElemNode() As Object = Nothing
Protected DefaultParser_IgnorePass As Boolean = False
Protected DefaultParser_PostUrlCreator As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/"
Protected Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
Optional ByVal SpecFolder As String = Nothing, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0) As Boolean
ThrowAny(Token)
If Items.Count > 0 Then
Dim PostIDKV As PostKV
Dim Pinned As Boolean
Dim PostDate$
Dim PostDate$, PostOriginUrl$
Dim before%
If SpecFolder.IsEmptyString Then
Select Case Section
Case Sections.Tagged : SpecFolder = TaggedFolder
@@ -649,22 +684,26 @@ Namespace API.Instagram
ProgressPre.ChangeMax(Items.Count)
For Each nn In Items
ProgressPre.Perform()
With nn
With If(Not DefaultParser_ElemNode Is Nothing, nn.ItemF(DefaultParser_ElemNode), nn)
PostIDKV = New PostKV(.Value("code"), .Value("id"), Section)
PostOriginUrl = DefaultParser_PostUrlCreator(PostIDKV)
Pinned = .Contains("timeline_pinned_user_ids")
If PostKvExists(PostIDKV) Then
If Not DefaultParser_IgnorePass AndAlso PostKvExists(PostIDKV) Then
If Not Pinned Then Return False
Else
_TempPostsList.Add(PostIDKV.ID)
PostsKVIDs.ListAddValue(PostIDKV, LNC)
PostDate = .Value("taken_at")
If Not IsSavedPosts Then
If Not DefaultParser_IgnorePass And Not IsSavedPosts Then
Select Case CheckDatesLimit(PostDate, UnixDate32Provider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : If Not Pinned Then Return False
End Select
End If
ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate)
before = _TempMediaList.Count
ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate,, PostOriginUrl, State, Attempts)
If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
If _Limit > 0 And _TotalPostsParsed >= _Limit Then Return False
End If
End With
Next
@@ -675,7 +714,7 @@ Namespace API.Instagram
End Function
#End Region
#Region "Code ID converters"
Private Function CodeToID(ByVal Code As String) As String
Protected Function CodeToID(ByVal Code As String) As String
Const CodeSymbols$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
Try
If Not Code.IsEmptyString Then
@@ -695,12 +734,20 @@ Namespace API.Instagram
End Function
#End Region
#Region "Obtain Media"
Private Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj As String = Nothing)
Protected ObtainMedia_SizeFuncVid As Func(Of EContainer, Sizes) = Nothing
Protected ObtainMedia_SizeFuncPic As Func(Of EContainer, Sizes) = Nothing
Protected ObtainMedia_AllowAbstract As Boolean = False
Protected Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj As String = Nothing, Optional ByVal InitialType As Integer = -1,
Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0)
Try
Dim wrongData As Predicate(Of Sizes) = Function(_ss) _ss.HasError Or _ss.Data.IsEmptyString
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0
Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url"))
Dim ssVid As Func(Of EContainer, Sizes) = ss
Dim ssPic As Func(Of EContainer, Sizes) = ss
Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String
If Not DateObj.IsEmptyString Then Return DateObj
If elem.Contains("taken_at") Then
@@ -720,28 +767,41 @@ Namespace API.Instagram
End If
End If
End Function
If Not ObtainMedia_SizeFuncVid Is Nothing Then ssVid = ObtainMedia_SizeFuncVid
If Not ObtainMedia_SizeFuncPic Is Nothing Then ssPic = ObtainMedia_SizeFuncPic
If n.Count > 0 Then
Dim l As New List(Of Sizes)
Dim d As EContainer
Dim t%
Dim abstractDecision As Boolean = False
'8 - gallery
'2 - one video
'1 - one picture
t = n.Value("media_type").FromXML(Of Integer)(-1)
If t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then
If n.Contains(vid) Then
t = 2
abstractDecision = True
ElseIf n.Contains(img) Then
t = 1
abstractDecision = True
End If
End If
If t >= 0 Then
Select Case t
Case 1
If n.Contains(img) Then
t = n.Value("media_type").FromXML(Of Integer)(-1)
If Not abstractDecision Then t = n.Value("media_type").FromXML(Of Integer)(-1)
DateObj = mDate(n)
If t >= 0 Then
With n.ItemF({img, "candidates"}).XmlIfNothing
If .Count > 0 Then
l.Clear()
l.ListAddList(.Select(ss), LNC)
l.ListAddList(.Select(ssPic), LNC)
If l.Count > 0 Then l.RemoveAll(wrongData)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl, State, Attempts), LNC)
l.Clear()
End If
End If
@@ -754,10 +814,11 @@ Namespace API.Instagram
With n.ItemF({vid}).XmlIfNothing
If .Count > 0 Then
l.Clear()
l.ListAddList(.Select(ss), LNC)
l.ListAddList(.Select(ssVid), LNC)
If l.Count > 0 Then l.RemoveAll(wrongData)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl, State, Attempts), LNC)
l.Clear()
End If
End If
@@ -767,7 +828,7 @@ Namespace API.Instagram
DateObj = mDate(n)
With n("carousel_media").XmlIfNothing
If .Count > 0 Then
For Each d In .Self : ObtainMedia(d, PostID, SpecialFolder, DateObj) : Next
For Each d In .Self : ObtainMedia(d, PostID, SpecialFolder, DateObj, 8, PostOriginUrl) : Next
End If
End With
End Select
@@ -854,17 +915,21 @@ Namespace API.Instagram
End Function
#End Region
#Region "Pinned stories"
Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken)
Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal GetUserStory As Boolean, ByVal Token As CancellationToken)
Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}"
Dim tmpList As IEnumerable(Of String)
Dim tmpList As IEnumerable(Of String) = Nothing
Dim qStr$, r$, sFolder$, storyID$, pid$
Dim i% = -1
Dim jj As EContainer, s As EContainer
ThrowAny(Token)
If StoriesList.ListExists Then
tmpList = StoriesList.Take(5)
If tmpList.ListExists Then
qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids=highlight:{q}").ListToString("&"))
If StoriesList.ListExists Or GetUserStory Then
If Not GetUserStory Then tmpList = StoriesList.Take(5)
If tmpList.ListExists Or GetUserStory Then
If GetUserStory Then
qStr = $"https://www.instagram.com/api/v1/feed/reels_media/?reel_ids={ID}"
Else
qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids=highlight:{q}").ListToString("&"))
End If
r = Responser.GetResponse(qStr,, EDP.ThrowException)
ThrowAny(Token)
If Not r.IsEmptyString Then
@@ -876,9 +941,13 @@ Namespace API.Instagram
i += 1
sFolder = jj.Value("title").StringRemoveWinForbiddenSymbols
storyID = jj.Value("id").Replace("highlight:", String.Empty)
If sFolder.IsEmptyString Then sFolder = $"Story_{storyID}"
If sFolder.IsEmptyString Then sFolder = $"Story_{i}"
sFolder = $"{StoriesFolder}\{sFolder}"
If GetUserStory Then
sFolder = $"{StoriesFolder} (user)"
Else
If sFolder.IsEmptyString Then sFolder = $"Story_{storyID}"
If sFolder.IsEmptyString Then sFolder = $"Story_{i}"
sFolder = $"{StoriesFolder}\{sFolder}"
End If
If Not storyID.IsEmptyString Then storyID &= ":"
With jj("items").XmlIfNothing
If .Count > 0 Then
@@ -896,7 +965,7 @@ Namespace API.Instagram
End If
End Using
End If
StoriesList.RemoveRange(0, tmpList.Count)
If Not GetUserStory Then StoriesList.RemoveRange(0, tmpList.Count)
End If
End If
End Sub
@@ -920,6 +989,12 @@ Namespace API.Instagram
DownloadContentDefault(Token)
End Sub
#End Region
#Region "Erase"
Protected Overrides Sub EraseData_AdditionalDataFiles()
Dim f As SFile = MyFilePostsKV
If f.Exists Then f.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.ReturnValue)
End Sub
#End Region
#Region "Exceptions"
''' <exception cref="ExitException"></exception>
''' <inheritdoc cref="UserDataBase.ThrowAny(CancellationToken)"/>
@@ -933,15 +1008,15 @@ Namespace API.Instagram
''' </summary>
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal s As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then
If Responser.StatusCode = HttpStatusCode.NotFound Then '404
If Not UserNameRequested AndAlso GetUserNameById() Then Return 1 Else UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then '400
HasError = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
DisableSection(s)
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then '403
Return 3
ElseIf Responser.StatusCode = 429 Then
ElseIf Responser.StatusCode = 429 Then '429
With MySiteSettings
Dim WaiterExists As Boolean = .LastApplyingValue.HasValue
.TooManyRequests(True)
@@ -950,10 +1025,10 @@ Namespace API.Instagram
Caught429 = True
MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1
ElseIf Responser.StatusCode = 560 Then
ElseIf Responser.StatusCode = 560 Or Responser.StatusCode = HttpStatusCode.InternalServerError Then '560, 500
MySiteSettings.SkipUntilNextSession = True
Else
MyMainLOG = $"Something is wrong. Your credentials may have expired [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
MyMainLOG = $"Something is wrong. Your credentials may have expired [{CInt(Responser.StatusCode)}/{CInt(Responser.Status)}]: {ToString()} [{s}]"
DisableSection(s)
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0
@@ -965,6 +1040,10 @@ Namespace API.Instagram
Dim s As Sections = DirectCast(Section, Sections)
Select Case s
Case Sections.Timeline : MySiteSettings.DownloadTimeline.Value = False
Case Sections.Stories, Sections.UserStories
MySiteSettings.DownloadTimeline.Value = False
MySiteSettings.DownloadStories.Value = False
MySiteSettings.DownloadStoriesUser.Value = False
Case Else : MySiteSettings.DownloadTagged.Value = False
End Select
MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper
@@ -973,12 +1052,14 @@ Namespace API.Instagram
#End Region
#Region "Create media"
Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal SpecialFolder As String = Nothing) As UserMedia
Optional ByVal SpecialFolder As String = Nothing, Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}}
Dim m As New UserMedia(_URL, t) With {.URL_BASE = PostOriginUrl.IfNullOrEmpty(_URL), .Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, UnixDate32Provider, Nothing) Else m.Post.Date = Nothing
m.SpecialFolder = SpecialFolder
If State = UStates.Missing Then m.State = UStates.Missing : m.Attempts = Attempts
Return m
End Function
#End Region

View File

@@ -0,0 +1,33 @@
' Copyright (C) 2023 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
Imports System.Text.RegularExpressions
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.JustForFans
Friend Module Declarations
Friend Const NamePhotoLarge As String = "expandable"
Friend Const NamePhotoSmall As String = "galThumb"
Private Const PostDateUrlPattern As String = "\<div.class=.mbsc-card-subtitle[^\>]*?location.href='([^']+)[^\>]*?\>([^\<]+?)\<"
Friend ReadOnly RegexUser As RParams = RParams.DMS("GetStats2\(UserID\)\{\s*var Hash = '([^']+)'[;\s/]*(var Hash = '([^']+)'|)", 1)
Friend ReadOnly RegexVideoBlock As RParams =
RParams.DM("((\<div mbsc-card class=""mbsc-card[^\>]*?id=""([^""]+)[^\>]*?\>)\s*\<div class=""mbsc-card-header.+?\<a class=""gridAction[^\>]*?\>[^\<\>]*?\</a\>\s*\</div>)",
0, RegexReturn.List, RegexOptions.Singleline, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly Regex_Video As RParams = RParams.DMS("<script>.\s*/\*\s*\$\(document\).ready\(function\(\) \{\s*MakeMovieVideoJS\(.*?(\{.+?\})", 1,
RegexOptions.IgnoreCase, RegexOptions.Singleline, EDP.ReturnValue)
Friend ReadOnly Regex_Photo As RParams = RParams.DM("\<img.+?class=""(expandable|galThumb)"".*?(data-lazy|src)=""([^""]+)""", 0,
RegexReturn.List, RegexOptions.IgnoreCase, RegexOptions.Singleline, EDP.ReturnValue)
Friend ReadOnly Regex_Gallery As RParams = RParams.DM("\<div[^\>]+?class=.imageGallery", 0, EDP.ReturnValue)
Friend ReadOnly Regex_PostDate As RParams = RParams.DMS(PostDateUrlPattern, 2, RegexOptions.IgnoreCase, RegexOptions.Singleline, EDP.ReturnValue,
CType(Function(Input$) Input.StringTrim, Func(Of String, String)))
Friend ReadOnly Regex_PostURL As RParams = RParams.DMS(PostDateUrlPattern, 1, RegexOptions.IgnoreCase, RegexOptions.Singleline, EDP.ReturnValue,
CType(Function(Input$) Input.StringTrim, Func(Of String, String)))
Friend ReadOnly Regex_PostID As RParams = RParams.DMS("[&\?]{1}post=([^&\?]+)", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly DateProvider As New ADateTime("MMMM d, yyyy, h:mm tt")
Friend ReadOnly DateProviderVideoFileName As New ADateTime("yyyyMMdd_HHmmss")
End Module
End Namespace

View File

@@ -0,0 +1,263 @@
' Copyright (C) 2023 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
Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.RegularExpressions
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.JustForFans
Friend NotInheritable Class M3U8 : Implements IDisposable
#Region "Declarations"
Friend Const AllVid As UTypes = UTypes.m3u8 + UTypes.VideoPre
Private ReadOnly DataVideo As List(Of String)
Private ReadOnly DataAudio As List(Of String)
Private Media As UserMedia
Private DestinationFile As SFile
Private ReadOnly Thrower As Plugin.IThrower
Private ReadOnly Responser As Responser
Private ReadOnly ResponserInternal As Boolean
Private Const R_VIDEO_REGEX_PATTERN As String = "(#EXT-X-STREAM-INF)(.+)(RESOLUTION=\d+x)(\d+)(.+""\s*)(\S+)(\s*)"
Private ReadOnly REGEX_AUDIO_URL As RParams = RParams.DMS("EXT-X-MEDIA.*?URI=.([^""]+)"".*?TYPE=""AUDIO""", 1, EDP.ReturnValue)
Private ReadOnly REGEX_PLS_FILES As RParams = RParams.DM("EXT-X-MAP:URI=""([^""]+)""|EXTINF.+?[\r\n]{1,2}(.+)", 0, RegexReturn.List, EDP.ReturnValue)
Private UrlVideo As String
Private UrlAudio As String
Private FileVideo As SFile
Private FileAudio As SFile
Private RootPlaylistUrl As String
Private ReadOnly Cache As CacheKeeper
Private ReadOnly Progress As MyProgress
Private ReadOnly ProgressPre As PreProgress
Private ReadOnly ProgressExists As Boolean
Private ReadOnly UsePreProgress As Boolean
Private Property Token As CancellationToken
#End Region
#Region "Initializer"
Private Sub New(ByVal m As UserMedia, ByVal Destination As SFile, ByVal Resp As Responser, ByVal _Thrower As Plugin.IThrower,
ByVal _Progress As MyProgress, ByVal _UsePreProgress As Boolean, ByVal _Token As CancellationToken)
Media = m
DataVideo = New List(Of String)
DataAudio = New List(Of String)
DestinationFile = Destination
Thrower = _Thrower
'Responser = Resp
Responser = New Responser
ResponserInternal = True
Progress = _Progress
ProgressExists = Not Progress Is Nothing
If ProgressExists Then ProgressPre = New PreProgress(Progress)
UsePreProgress = _UsePreProgress
Token = _Token
Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{M3U8Base.TempCacheFolderName}\")
With Cache
.CacheDeleteError = CacheDeletionError(Cache)
.DisposeSuspended = True
.Validate()
End With
End Sub
#End Region
#Region "Download functions"
Private Sub DownloadPre()
If Media.Type = AllVid Then
Dim r$ = Responser.GetResponse(Media.URL)
If Not r.IsEmptyString Then
Dim s As List(Of Sizes) = RegexFields(Of Sizes)(r, {RParams.DM(R_VIDEO_REGEX_PATTERN, 0, RegexReturn.List, EDP.ReturnValue)}, {4, 6}, EDP.ReturnValue)
If s.ListExists Then
s.Sort()
RootPlaylistUrl = s(0).Data
s.Clear()
End If
End If
Else
RootPlaylistUrl = Media.URL
End If
End Sub
Private Sub Download()
DownloadPre()
If RootPlaylistUrl.IsEmptyString Then
DestinationFile = Nothing
Else
Thrower.ThrowAny()
Dim r$ = Responser.GetResponse(RootPlaylistUrl)
If Not r.IsEmptyString Then
UrlVideo = RegexReplace(r, RParams.DMS(R_VIDEO_REGEX_PATTERN, 6, EDP.ReturnValue))
UrlAudio = RegexReplace(r, REGEX_AUDIO_URL)
If UrlVideo.IsEmptyString Then Throw New ArgumentException("Unable to identify m3u8 video track", "M3U8 video track")
Thrower.ThrowAny()
GetFiles(UrlVideo, FileVideo, False)
Thrower.ThrowAny()
If Not UrlAudio.IsEmptyString Then GetFiles(UrlAudio, FileAudio, True)
Thrower.ThrowAny()
MergeFiles()
End If
End If
End Sub
Private Sub GetFiles(ByVal URL As String, ByRef File As SFile, ByVal IsAudio As Boolean)
Try
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Dim data As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {REGEX_PLS_FILES}, {1, 2}, EDP.ReturnValue)
If data.ListExists Then
File = $"{Cache.RootDirectory.PathWithSeparator}{IIf(IsAudio, "AUDIO.aac", "VIDEO.mp4")}"
Using b As New TokenBatch(Token) With {.Encoding = Settings.CMDEncoding, .MainProcessName = "ffmpeg"}
AddHandler b.ErrorDataReceived, AddressOf Batch_OutputDataReceived
ProgressChangeMax(data.Count)
b.ChangeDirectory(Cache.RootDirectory)
b.Execute($"""{Settings.FfmpegFile}"" -i {URL} -vcodec copy -strict -2 ""{File}""")
Token.ThrowIfCancellationRequested()
If Not File.Exists Then File = Nothing
End Using
End If
End If
Catch oex As OperationCanceledException
Throw oex
Catch dex As ObjectDisposedException
Throw dex
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog + EDP.ThrowException, ex,
$"API.JustForFans.M3U8.GetFiles({IIf(IsAudio, "audio", "video")}):{vbCr}URL: {URL}{vbCr}File: {File}")
End Try
End Sub
'TODELETE: JFF.M3U8.GetFiles_OLD 20231008
'Private Sub GetFiles_OLD(ByVal URL As String, ByRef File As SFile, ByVal IsAudio As Boolean)
' Try
' Dim r$ = Responser.GetResponse(URL)
' If Not r.IsEmptyString Then
' Dim data As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {REGEX_PLS_FILES}, {1, 2}, EDP.ReturnValue)
' If data.ListExists Then
' Dim appender$ = URL.Replace(URL.Split("/").LastOrDefault, String.Empty)
' With (From d As RegexMatchStruct In data
' Where Not d.Arr(0).IfNullOrEmpty(d.Arr(1)).IsEmptyString
' Select M3U8Base.CreateUrl(appender, d.Arr(0).IfNullOrEmpty(d.Arr(1)).Trim)).ToList
' If .ListExists Then
' File = $"{Cache.RootDirectory.PathWithSeparator}{IIf(IsAudio, "AUDIO.aac", "VIDEO.mp4")}"
' Dim tmpCache As CacheKeeper = Cache.NewInstance
' Dim tmpFile As SFile = .Item(0)
' If tmpFile.Extension.IsEmptyString Then tmpFile.Extension = "ts"
' tmpFile.Path = tmpCache.RootDirectory.Path
' tmpFile.Separator = "\"
' Dim cFile As SFile = tmpFile
' cFile.Name = "all"
' tmpCache.Validate()
' Using bat As New TextSaver
' Using b As New BatchExecutor(True) With {.Encoding = Settings.CMDEncoding}
' AddHandler b.OutputDataReceived, AddressOf Batch_OutputDataReceived
' bat.AppendLine($"chcp {BatchExecutor.UnicodeEncoding}")
' bat.AppendLine(BatchExecutor.GetDirectoryCommand(tmpCache))
' ProgressChangeMax(.Count * 2 + 1)
' Using w As New WebClient
' For i = 0 To .Count - 1
' tmpFile.Name = $"ConPart_{i}"
' Thrower.ThrowAny()
' 'Responser.DownloadFile(.Item(i), tmpFile)
' w.DownloadFile(.Item(i), tmpFile)
' ProgressPerform()
' tmpCache.AddFile(tmpFile, True)
' bat.AppendLine($"type {tmpFile.File} >> {cFile.File}")
' Next
' End Using
' bat.AppendLine($"""{Settings.FfmpegFile}"" -i {cFile.File} -c copy ""{File}""")
' Dim batFile As SFile = bat.SaveAs($"{tmpCache.RootDirectory.PathWithSeparator}command.bat")
' b.Execute($"""{batFile}""")
' If Not File.Exists Then File = Nothing
' End Using
' End Using
' End If
' End With
' End If
' End If
' Catch oex As OperationCanceledException
' Throw oex
' Catch dex As ObjectDisposedException
' Throw dex
' Catch ex As Exception
' ErrorsDescriber.Execute(EDP.SendToLog + EDP.ThrowException, ex,
' $"API.JustForFans.M3U8.GetFiles({IIf(IsAudio, "audio", "video")}):{vbCr}URL: {URL}{vbCr}File: {File}")
' End Try
'End Sub
Private Async Sub Batch_OutputDataReceived(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
Await Task.Run(Sub() If Not e.Data.IsEmptyString AndAlso e.Data.Contains("] Opening") Then ProgressPerform())
End Sub
Private Sub MergeFiles()
Try
Dim p As SFileNumbers = SFileNumbers.Default(DestinationFile.Name)
Dim f As SFile = SFile.IndexReindex(DestinationFile,,, p, EDP.ReturnValue).IfNullOrEmpty(DestinationFile)
If Not FileVideo.IsEmptyString And Not FileAudio.IsEmptyString Then
DestinationFile = FFMPEG.MergeFiles({FileVideo, FileAudio}, Settings.FfmpegFile, f, Settings.CMDEncoding, p, EDP.ThrowException)
Else
If Not SFile.Move(FileVideo, f) Then DestinationFile = FileVideo
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog + EDP.ThrowException, ex, $"[M3U8.MergeFiles]")
End Try
End Sub
#End Region
#Region "Progress support"
Private Sub ProgressChangeMax(ByVal Count As Integer)
If ProgressExists Then
If UsePreProgress Then
ProgressPre.ChangeMax(Count)
Else
Progress.Maximum += Count
End If
End If
End Sub
Private Sub ProgressPerform()
If ProgressExists Then
If UsePreProgress Then
ProgressPre.Perform()
Else
Progress.Perform()
End If
End If
End Sub
#End Region
#Region "Static Download"
Friend Shared Function Download(ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Resp As Responser, ByVal Thrower As Plugin.IThrower,
ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean, ByVal _Token As CancellationToken) As SFile
Using m As New M3U8(Media, DestinationFile, Resp, Thrower, Progress, UsePreProgress, _Token)
m.Download()
If m.DestinationFile.Exists Then Return m.DestinationFile Else Return Nothing
End Using
End Function
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Private Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
DataVideo.Clear()
DataAudio.Clear()
ProgressPre.DisposeIfReady
Cache.Dispose()
If ResponserInternal Then Responser.DisposeIfReady
End If
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,88 @@
' Copyright (C) 2023 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
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.JustForFans
<Manifest("AndyProgram_JustForFans"), SavedPosts, SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.JFFIcon_64
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.JFFPic_76
End Get
End Property
Friend Const UserHash4_CookieName As String = "userhash4"
<PropertyOption(ControlText:="User ID", AllowNull:=False), PXML>
Friend ReadOnly Property UserID As PropertyValue
<PropertyOption, PXML>
Friend ReadOnly Property UserHash4 As PropertyValue
<PropertyOption(ControlText:="Accept", ControlToolTip:="Header 'Accept'")>
Friend ReadOnly Property HeaderAccept As PropertyValue
<PropertyOption> Friend ReadOnly Property UserAgent As PropertyValue
Private Sub UpdateHeader(ByVal HeaderName As String, ByVal HeaderValue As String)
Select Case HeaderName
Case NameOf(HeaderAccept) : If HeaderValue.IsEmptyString Then Responser.Accept = Nothing Else Responser.Accept = HeaderValue
Case NameOf(UserAgent) : If Not HeaderValue.IsEmptyString Then Responser.UserAgent = HeaderValue
End Select
End Sub
Friend Sub New()
MyBase.New("JustForFans", "justfor.fans")
With Responser
.CookiesExtractMode = Responser.CookiesExtractModes.Any
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
.CookiesExtractedAutoSave = False
.Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False
End With
UserID = New PropertyValue(String.Empty, GetType(String))
UserHash4 = New PropertyValue(String.Empty, GetType(String))
HeaderAccept = New PropertyValue(Responser.Accept.Value, GetType(String), Sub(v) UpdateHeader(NameOf(HeaderAccept), v))
UserAgent = New PropertyValue(Responser.UserAgent, GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v))
_AllowUserAgentUpdate = False
UserRegex = RParams.DMS("https://justfor.fans/([^/\?]+)", 1, EDP.ReturnValue)
UrlPatternUser = "https://justfor.fans/{0}"
ImageVideoContains = "justfor.fans"
End Sub
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Overrides Sub Update()
If _SiteEditorFormOpened Then UpdateUserHash4()
MyBase.Update()
End Sub
Private Sub UpdateUserHash4()
If Responser.CookiesExists Then
Dim hv_current$ = UserHash4.Value
Dim hv_cookie$ = If(Responser.Cookies.FirstOrDefault(Function(cc) cc.Name.ToLower = UserHash4_CookieName)?.Value, String.Empty)
If Not hv_cookie.IsEmptyString And Not hv_cookie = hv_current And Responser.Cookies.Changed Then UserHash4.Value = hv_cookie
End If
End Sub
Friend Sub UpdateResponser(ByVal Source As Responser)
If Source.Cookies.Changed Then
Responser.Cookies.Update(Source.Cookies)
UpdateUserHash4()
If Responser.Cookies.Changed Then Responser.SaveCookies() : Responser.Cookies.Changed = False
End If
End Sub
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return Settings.FfmpegFile.Exists And Responser.CookiesExists And ACheck(UserID.Value) And ACheck(UserHash4.Value)
End Function
End Class
End Namespace

View File

@@ -0,0 +1,363 @@
' Copyright (C) 2023 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
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.JustForFans
Friend Class UserData : Inherits UserDataBase
#Region "Declarations"
Private ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
End Get
End Property
Private ResponserNoHandlers As Responser = Nothing
#End Region
#Region "Structures"
Private Class FileSerial
Private InitNumber As Integer
Private ReadOnly Provider As New ANumbers With {.FormatOptions = ANumbers.Options.FormatNumberGroup, .GroupSize = 9}
Friend Sub New(ByVal Root As String)
Try
Dim r$ = Root.CSFilePS
InitNumber = SFile.GetFiles(r,,, EDP.ReturnValue).Count +
SFile.GetFiles($"{r}Video\",,, EDP.ReturnValue).Count +
SFile.GetFiles($"{r}Videos\",,, EDP.ReturnValue).Count
Catch
InitNumber = 0
End Try
End Sub
Friend Function ApplyHash(ByVal f As SFile) As SFile
InitNumber += 1
f.Name &= $"_{InitNumber.NumToString(Provider)}_{$"{Now:O}_{Rnd()}".GetHashCode()}"
Return f
End Function
End Class
Private Structure PhotoData : Implements IRegExCreator
Friend IsLarge As Boolean
Friend URL As String
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists Then
IsLarge = Not ParamsArray(0).IsEmptyString AndAlso ParamsArray(0).StringToLower = NamePhotoLarge
URL = ParamsArray(1)
End If
Return Me
End Function
End Structure
Private Structure PostBlock : Implements IRegExCreator
Friend PostID As String
Friend PostDate As Date?
Friend PostUrl As String
Friend Pinned As Boolean
Private Data As String
Private File As SFile
Private FileNameDefault As String
Friend Type As UTypes
Friend Values As IEnumerable(Of String)
Friend ReadOnly Property Valid As Boolean
Get
Return Values.ListExists And Not Type = UTypes.Undefined And Not PostID.IsEmptyString And Not PostUrl.IsEmptyString
End Get
End Property
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists(3) Then
Data = ParamsArray(0)
Pinned = Not ParamsArray(1).IsEmptyString AndAlso ParamsArray(1).ToLower.Contains("pinned")
PostDate = AConvert(Of Date)(RegexReplace(Data, Regex_PostDate), DateProvider, Nothing)
PostUrl = RegexReplace(Data, Regex_PostURL)
If Not PostUrl.IsEmptyString Then PostUrl = $"https://justfor.fans/{PostUrl.Trim.StringTrimStart("/")}"
PostID = RegexReplace(PostUrl, Regex_PostID)
If Not Data.IsEmptyString Then
FileNameDefault = AConvert(Of String)(If(PostDate, Now), DateProviderVideoFileName, String.Empty)
Dim found As Boolean = False
Dim tmpData$ = RegexReplace(Data, Regex_Video)
If Not tmpData.IsEmptyString Then
found = True
File.Name = FileNameDefault
File.Extension = "mp4"
Using j As EContainer = JsonDocument.Parse(tmpData, EDP.ReturnValue)
If j.ListExists Then
Dim vr As RParams = RParams.DM("(\d+)", 0, EDP.ReturnValue)
Dim l As New List(Of Sizes)
Dim s As Sizes
Dim all$ = String.Empty
Dim t As UTypes = UTypes.m3u8
For Each jj As EContainer In j
If jj.Name.StringToLower = "all" Then
all = jj.Value
Else
s = New Sizes(RegexReplace(jj.Name, vr), jj.Value)
If Not s.HasError Then l.Add(s)
End If
Next
If l.Count = 0 Then l.Add(New Sizes(0, all)) : t = M3U8.AllVid
If l.Count > 0 Then
l.Sort()
Values = {l(0).Data}
Type = t
If Not Values(0).Contains("m3u8") Then Type = UTypes.Video
End If
End If
End Using
End If
If Not found AndAlso Not CStr(RegexReplace(Data, Regex_Gallery)).IsEmptyString Then
found = True
File = Nothing
Dim pData As List(Of PhotoData) = RegexFields(Of PhotoData)(Data, {Regex_Photo}, {1, 3}, EDP.ReturnValue)
If pData.ListExists Then
Type = UTypes.Picture
If pData.Exists(Function(d) d.IsLarge) Then
Values = (From d As PhotoData In pData Where d.IsLarge Select d.URL).ToArray
Else
Values = pData.Select(Function(d) d.URL).Distinct
End If
End If
End If
If Not found Then
File = Nothing
Dim pp As RParams = Regex_Photo.Copy
pp.Match = Nothing
pp.MatchSub = 3
pp.WhatGet = RegexReturn.Value
Dim v$ = RegexReplace(Data, pp)
If Not v.IsEmptyString Then found = True : Type = UTypes.Picture : Values = {v}
End If
End If
End If
Return Me
End Function
Friend Function GetUserMedia(ByVal FS As FileSerial) As IEnumerable(Of UserMedia)
If Values.ListExists Then
Dim m As UserMedia
Dim f As SFile
Dim outList As New List(Of UserMedia)
For Each url$ In Values
m = New UserMedia(url, Type) With {.URL_BASE = PostUrl.IfNullOrEmpty(.URL_BASE), .Post = New UserPost(PostID, PostDate)}
f = New SFile With {.Name = FileNameDefault, .Extension = m.File.Extension}
If Not Type = UTypes.Picture And Not Type = UTypes.GIF Then f.Extension = "mp4"
f = FS.ApplyHash(f)
m.File = f
outList.Add(m)
Next
Return outList
Else
Return New UserMedia() {}
End If
End Function
End Structure
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
#Region "Initializer"
Friend Sub New()
UseInternalM3U8Function = True
'TODELETE: UseResponserClient 20231008
'UseResponserClient = True
End Sub
#End Region
#Region "Download functions"
Private _DownloadedPostsCount As Integer = 0
Private _Limit As Integer = -1
Private FileSerialInstance As FileSerial
Private _UserHash4 As String = String.Empty
Private Sub InitializeFileSerial()
If FileSerialInstance Is Nothing Then FileSerialInstance = New FileSerial(DownloadContentDefault_GetRootDir())
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
_UserHash4 = MySettings.UserHash4.Value
InitializeFileSerial()
Responser.Cookies.Changed = False
If Not ResponserNoHandlers Is Nothing Then ResponserNoHandlers.Dispose() : ResponserNoHandlers = Nothing
ResponserNoHandlers = Responser.Copy
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
_DownloadedPostsCount = 0
_Limit = If(DownloadTopCount, -1)
DownloadData(0, Token)
Finally
If DownloadTopCount.HasValue Then DownloadTopCount = Nothing
Try : RemoveHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived : Catch : End Try
MySettings.UpdateResponser(Responser)
End Try
End Sub
Private Sub Responser_ResponseReceived(ByVal Source As Object, ByVal e As EventArguments.WebDataResponse)
If e.CookiesExists Then
Dim hv$ = If(e.Cookies.FirstOrDefault(Function(cc) cc.Name.StringToLower = SiteSettings.UserHash4_CookieName)?.Value, String.Empty)
If Not hv.IsEmptyString And Not _UserHash4 = hv Then _UserHash4 = hv
End If
End Sub
Private Overloads Sub DownloadData(ByVal Cursor As Integer, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
Dim processed As Boolean = False
ThrowAny(Token)
If IsSavedPosts Then
URL = $"https://justfor.fans/home?Tab=Saved&Page={Cursor + 1}"
Else
If ID.IsEmptyString Then GetUserID() : ThrowAny(Token)
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "The user ID cannot be null")
If _UserHash4.IsEmptyString Then Throw New ArgumentNullException("UserHash4", "[UserHash4] cannot be null")
URL = $"https://justfor.fans/ajax/getPosts.php?Type=One&UserID={MySettings.UserID.Value}&PosterID={ID}&StartAt={Cursor}&Page=Profile&UserHash4={_UserHash4}&SplitTest=0"
End If
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Dim data As List(Of PostBlock) = RegexFields(Of PostBlock)(r, {RegexVideoBlock}, {0, 2, 3}, EDP.ReturnValue)
If data.ListExists Then
For Each post As PostBlock In data
If post.Valid Then
processed = True
If Not post.PostID.IsEmptyString Then
If _TempPostsList.Contains(post.PostID) Then
If post.Pinned Then Continue For Else Exit Sub
Else
_TempPostsList.Add(post.PostID)
End If
End If
Select Case CheckDatesLimit(post.PostDate, Nothing)
Case DateResult.Skip : Continue For
Case DateResult.Exit : If post.Pinned Then Continue For Else Exit Sub
End Select
_DownloadedPostsCount += 1
_TempMediaList.ListAddList(post.GetUserMedia(FileSerialInstance), LNC)
If _Limit > 0 And _DownloadedPostsCount >= _Limit Then Exit For
End If
Next
End If
End If
If processed And (_Limit = -1 Or _DownloadedPostsCount < _Limit) Then DownloadData(Cursor + IIf(IsSavedPosts, 1, 10), Token)
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Private Sub GetUserID()
Try
Dim r$, hash$, new_id$, profilePic$
If ID.IsEmptyString Then
r = Responser.GetResponse($"https://justfor.fans/{Name}")
If Not r.IsEmptyString Then
hash = RegexReplace(r, RegexUser)
profilePic = RegexReplace(r, RParams.DMS("<img class=.mainProfilePic..+?src=""([^""]+)", 1, EDP.ReturnValue))
If Not hash.IsEmptyString Then
r = Responser.GetResponse($"https://justfor.fans/ajax/getAssetCount.php?User={Name}&Ver={hash}")
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
new_id = j.Value("UserID")
If Not new_id.IsEmptyString Then
new_id = RegexReplace(new_id, RParams.DM("\D", -1, RegexReturn.Replace,
CType(Function(input$) String.Empty, Func(Of String, String)),
String.Empty, EDP.ReturnValue))
If Not new_id.IsEmptyString Then
ID = new_id
_ForceSaveUserInfo = True
If Not profilePic.IsEmptyString Then GetWebFile(profilePic, $"{DownloadContentDefault_GetRootDir.CSFilePS}ProfilePic.jpg", EDP.None)
End If
End If
End If
End Using
End If
End If
End If
End If
Catch ex As Exception
LogError(ex, "can't get user ID")
End Try
End Sub
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
If ContentMissingExists Then
InitializeFileSerial()
Dim r$
Dim m As UserMedia
Dim stateRefill As Func(Of UserMedia, Integer, UserMedia) = Function(ByVal input As UserMedia, ii As Integer) As UserMedia
input.State = UserMedia.States.Missing
input.Attempts = m.Attempts
Return input
End Function
Dim p As PostBlock
Dim rErr As New ErrorsDescriber(EDP.ReturnValue)
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
If m.State = UserMedia.States.Missing And Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
r = Responser.GetResponse(m.URL_BASE,, rErr)
If Not r.IsEmptyString Then
With RegexFields(Of PostBlock)(r, {RegexVideoBlock}, {0, 2, 3}, rErr)
If .ListExists Then
rList.Add(i)
For Each p In .Self
If p.Valid Then _TempMediaList.ListAddList(p.GetUserMedia(FileSerialInstance).ListForEachCopy(stateRefill, True), LNC)
Next
End If
End With
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "missing data downloading error")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try
End Sub
#End Region
#Region "DownloadContent"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(Media, DestinationFile, ResponserNoHandlers, Me, Progress, Not IsSingleObjectDownload, Token)
End Function
#End Region
#Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
ResponserNoHandlers = Responser.Copy
_ContentList.Add(New UserMedia(Data.URL) With {.State = UserMedia.States.Missing})
ReparseMissing(Token)
End Sub
#End Region
#Region "DownloadingException"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
Return 0
End Function
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then FileSerialInstance = Nothing
MyBase.Dispose(disposing)
End Sub
#End Region
End Class
End Namespace

View File

@@ -203,17 +203,21 @@ Namespace API.Mastodon
#Region "UpdateServersList"
Private Sub UpdateServersList()
Try
Dim r$ = GetWebString("https://api.joinmastodon.org/servers?language=&category=&region=&ownership=&registrations=",, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If If(j?.Count, 0) > 0 Then
Domains.Domains.ListAddList(j.Select(Function(e) e.Value("domain")), LAP.NotContainsOnly, EDP.ReturnValue)
Domains.Domains.Sort()
Domains.Save()
j.Dispose()
Using resp As New Responser With {
.ProcessExceptionDecision = Function(rr, obj, e) If(rr.StatusCode = Net.HttpStatusCode.ServiceUnavailable,
EDP.ReturnValue, EDP.ThrowException)}
Dim r$ = resp.GetResponse("https://api.joinmastodon.org/servers?language=&category=&region=&ownership=&registrations=")
If Not r.IsEmptyString Then
Dim j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If If(j?.Count, 0) > 0 Then
Domains.Domains.ListAddList(j.Select(Function(e) e.Value("domain")), LAP.NotContainsOnly, EDP.ReturnValue)
Domains.Domains.Sort()
Domains.Save()
j.Dispose()
End If
DomainsLastUpdateDate.Value = Now
End If
End If
DomainsLastUpdateDate.Value = Now
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.Mastodon.SiteSettings.UpdateServersList]")
End Try

View File

@@ -190,7 +190,8 @@ Namespace API.Mastodon
ProcessException(ex, Token, $"data downloading error{IIf(IsSavedPosts, " (Saved Posts)", String.Empty)} [{URL}]")
End Try
End Sub
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal BaseUrl As String = Nothing)
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal BaseUrl As String = Nothing,
Optional ByVal SourceMedia As UserMedia = Nothing)
Dim t As UTypes = UTypes.Undefined
Select Case e.Value("type")
Case "video" : t = UTypes.Video
@@ -207,7 +208,13 @@ Namespace API.Mastodon
If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = GifsSpecialFolder
If Not GifsPrefix.IsEmptyString Then m.File.Name = $"{GifsPrefix}{m.File.Name}"
End If
If Not m.URL.IsEmptyString Then _TempMediaList.ListAddValue(m, LNC)
If Not m.URL.IsEmptyString Then
If SourceMedia.State = UStates.Missing Then
m.State = UStates.Missing
m.Attempts = SourceMedia.Attempts
End If
_TempMediaList.ListAddValue(m, LNC)
End If
End If
End If
End Sub
@@ -261,7 +268,7 @@ Namespace API.Mastodon
If Not j Is Nothing Then
PostDate = String.Empty
If j.Contains("created_at") Then PostDate = j("created_at").Value Else PostDate = String.Empty
ObtainMedia(j, m.Post.ID, PostDate, m.URL_BASE)
ObtainMedia(j, m.Post.ID, PostDate, m.URL_BASE, m)
rList.Add(i)
j.Dispose()
End If

View File

@@ -380,6 +380,11 @@ Namespace API.OnlyFans
Try
If ContentMissingExists Then
Dim m As UserMedia
Dim stateRefill As Func(Of UserMedia, Integer, UserMedia) = Function(ByVal input As UserMedia, ii As Integer) As UserMedia
input.State = UStates.Missing
input.Attempts = m.Attempts
Return input
End Function
Dim mList As List(Of UserMedia)
Dim mediaResult As Boolean
Dim r$, path$, postDate$
@@ -402,7 +407,7 @@ Namespace API.OnlyFans
mediaResult = False
mList = TryCreateMedia(j, m.Post.ID, postDate, mediaResult)
If mediaResult Then
_TempMediaList.ListAddList(mList, LNC)
_TempMediaList.ListAddList(mList.ListForEachCopy(stateRefill, True), LNC)
rList.Add(i)
mList.Clear()
End If

View File

@@ -37,7 +37,7 @@ Namespace API.Pinterest
End Property
Friend Property TrueUserName As String
Friend Property TrueBoardName As String
Friend Property IsUser As Boolean
Friend Property IsUser_NB As Boolean
Private Const BoardLabelName As String = "Board"
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
@@ -51,10 +51,10 @@ Namespace API.Pinterest
Dim n$() = Name.Split("@")
If n.ListExists Then
TrueUserName = n(0)
IsUser = True
If n.Length > 1 Then TrueBoardName = n(1) : IsUser = False
IsUser_NB = True
If n.Length > 1 Then TrueBoardName = n(1) : IsUser_NB = False
If Not IsSavedPosts And Not IsSingleObjectDownload Then
Dim l$ = IIf(IsUser, UserLabelName, BoardLabelName)
Dim l$ = IIf(IsUser_NB, UserLabelName, BoardLabelName)
Settings.Labels.Add(l)
Labels.ListAddValue(l, LNC)
Labels.Sort()
@@ -69,13 +69,13 @@ Namespace API.Pinterest
If Loading Then
TrueUserName = .Value(Name_TrueUserName)
TrueBoardName = .Value(Name_TrueBoardName)
IsUser = .Value(Name_IsUser).FromXML(Of Boolean)(False)
IsUser_NB = .Value(Name_IsUser).FromXML(Of Boolean)(False)
ReconfUserName()
Else
If ReconfUserName() Then .Value(Name_LabelsName) = LabelsString
.Add(Name_TrueUserName, TrueUserName)
.Add(Name_TrueBoardName, TrueBoardName)
.Add(Name_IsUser, IsUser.BoolToInteger)
.Add(Name_IsUser, IsUser_NB.BoolToInteger)
End If
End With
End Sub
@@ -85,7 +85,7 @@ Namespace API.Pinterest
Dim URL$ = String.Empty
Try
If IsSavedPosts Then
IsUser = True
IsUser_NB = True
TrueUserName = MySettings.SavedPostsUserName.Value
If TrueUserName.IsEmptyString Then Throw New ArgumentNullException("SavedPostsUserName", "Saved posts user not set")
End If
@@ -94,7 +94,7 @@ Namespace API.Pinterest
Dim b$ = TrueBoardName
If Not b.IsEmptyString Then b &= "/"
URL = $"https://www.pinterest.com/{TrueUserName}/{b}"
If IsUser Then
If IsUser_NB Then
boards = GetBoards(Token)
Else
boards = New List(Of BoardInfo) From {New BoardInfo With {.URL = URL, .ID = ID, .Title = UserSiteName}}
@@ -107,7 +107,7 @@ Namespace API.Pinterest
boards(i) = board
Next
With boards.First
If IsUser Then
If IsUser_NB Then
If ID.IsEmptyString Then ID = .UserID
UserSiteNameUpdate(.UserTitle)
Else
@@ -175,7 +175,7 @@ Namespace API.Pinterest
Dim r$
Dim j As EContainer, jj As EContainer
Dim u As UserMedia
Dim folder$ = If(IsUser, Board.Title.IfNullOrEmpty(Board.ID), String.Empty)
Dim folder$ = If(IsUser_NB, Board.Title.IfNullOrEmpty(Board.ID), String.Empty)
Dim titleExists As Boolean = Not Board.Title.IsEmptyString
Dim i% = -1
Dim jErr As New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue)
@@ -216,7 +216,7 @@ Namespace API.Pinterest
End If
Board.UserID = .Value({"board", "owner"}, "id")
Board.UserTitle = TitleHtmlConverter(.Value({"board", "owner"}, "full_name"))
If Not titleExists And IsUser Then
If Not titleExists And IsUser_NB Then
If Not Board.Title.IsEmptyString Then
folder = Board.Title
ElseIf Not Board.ID.IsEmptyString Then
@@ -322,7 +322,7 @@ Namespace API.Pinterest
If Not TrueBoardName.IsEmptyString Then Data.Title &= $"/{TrueBoardName}"
End If
Dim additPath$ = TitleHtmlConverter(UserSiteName)
If additPath.IsEmptyString Then additPath = IIf(IsUser, TrueUserName, TrueBoardName)
If additPath.IsEmptyString Then additPath = IIf(IsUser_NB, TrueUserName, TrueBoardName)
If Not additPath.IsEmptyString Then
Dim f As SFile = User.File
f.Path = f.PathWithSeparator & additPath

View File

@@ -14,6 +14,7 @@ Namespace API.PornHub
Private ReadOnly UnicodeHexConverter As Func(Of String, String) = Function(Input) SymbolsConverter.UnicodeHex.Decode(Input, EDP.ReturnValue)
#End Region
#Region "Declarations video"
Friend ReadOnly RegexVideo_MediaDef As RParams = RParams.DMS("mediaDefinitions.:\s*(\[\{.+?\}\])", 1, RegexOptions.Singleline, EDP.ReturnValue)
Friend ReadOnly RegexVideo_FlashVarsBlocks As RParams = RParams.DM("(?<=(flashvars_\['[nN]ext[vV]ideo'\]|flashvars_\d+[^ ]+? = media_\d+?);[\r\n]*?)(.+?)(?=;flashvars_\d+?)",
0, RegexReturn.List, EDP.ReturnValue)
Friend ReadOnly RegexVideo_FlashVars_Vars As RParams = RParams.DM("var ([\w\d]{10,})=("".+?)(?=(;|\Z))", 0, RegexReturn.List)

View File

@@ -144,7 +144,12 @@ Namespace API.PornHub
Friend Property DownloadFavorite As Boolean = False
Friend Property DownloadGifs As Boolean
Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True
Friend Property IsUser As Boolean = True
Private _IsUser As Boolean = True
Friend Overrides ReadOnly Property IsUser As Boolean
Get
Return _IsUser
End Get
End Property
Friend Property QueryString As String
Get
If IsUser Then
@@ -207,7 +212,7 @@ Namespace API.PornHub
If IsUser And Force Then
Return False
Else
IsUser = False
_IsUser = False
Options = If(Force, eObj.Options, Options)
NameTrue = Options
If Not Force Then
@@ -218,7 +223,7 @@ Namespace API.PornHub
End If
End If
Else
IsUser = True
_IsUser = True
Dim n$() = Name.Split("_")
If n.ListExists(2) Then
NameTrue = Name.Replace($"{n(0)}_", String.Empty)
@@ -242,7 +247,7 @@ Namespace API.PornHub
DownloadFavorite = .Value(Name_DownloadFavorite).FromXML(Of Boolean)(False)
DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False)
DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True)
IsUser = .Value(Name_IsUser).FromXML(Of Boolean)(True)
_IsUser = .Value(Name_IsUser).FromXML(Of Boolean)(True)
UpdateUserOptions()
Else
If UpdateUserOptions() Then .Value(Name_LabelsName) = LabelsString
@@ -813,6 +818,15 @@ Namespace API.PornHub
#End Region
#Region "CreateVideoURL"
Private Function CreateVideoURL(ByVal r As String) As String
If r.IsEmptyString Then
Return String.Empty
Else
Dim u$ = CreateVideoURL_FlashVars(r)
If u.IsEmptyString Then u = CreateVideoURL_MediaDef(r)
Return u
End If
End Function
Private Function CreateVideoURL_FlashVars(ByVal r As String) As String
Try
Dim OutStr$ = String.Empty
Dim OutList As New List(Of String)
@@ -871,7 +885,26 @@ Namespace API.PornHub
MyMainLOG = $"{ToStringForLog()}: something is wrong when parsing flashvars.{vbCr}{regex_ex.Message}"
Return String.Empty
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL_FlashVars]", String.Empty)
End Try
End Function
Private Function CreateVideoURL_MediaDef(ByVal r As String) As String
Try
Dim result$ = String.Empty
If Not r.IsEmptyString Then
Dim script$ = RegexReplace(r, RegexVideo_MediaDef)
If Not script.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(script)
If j.ListExists Then
Dim s As List(Of Sizes) = j.Select(Function(jj) New Sizes(jj.Value("quality"), jj.Value("videoUrl"))).ListWithRemove(Function(d) d.HasError Or d.Data.IsEmptyString)
If s.ListExists Then s.Sort() : result = s(0).Data : s.Clear()
End If
End Using
End If
End If
Return result
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL_MediaDef]", String.Empty)
End Try
End Function
#End Region

View File

@@ -270,13 +270,14 @@ Namespace API.Reddit
End With
Dim b% = Posts.Count
Posts.ListAddList(d.GetNewChannelPosts(), LNC)
If Posts.Count - b > 0 Then CountOfLoadedPostsPerSession.Add(Posts.Count - b)
If Posts.Count - b > 0 Then _Saved = False : CountOfLoadedPostsPerSession.Add(Posts.Count - b)
Posts.Sort()
LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate)
UpdateUsersStats()
End Using
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Finally
SaveUnsaved()
_Downloading = False
End Try
End Sub
@@ -344,14 +345,13 @@ Namespace API.Reddit
Using x As New XmlFile(f, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
x.LoadData()
If x.Count > 0 Then
Dim XMLDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Dim lc As New ListAddParams(LAP.ClearBeforeAdd)
Name = x.Value(Name_Name)
ID = x.Value(Name_ID)
ViewMode = x.Value(Name_ViewMode).FromXML(Of Integer)(CInt(View.[New]))
ViewPeriod = x.Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(Period.All))
If FilePosts.Exists Then PostsNames.ListAddList(FilePosts.GetText.StringToList(Of String)("|"), LNC)
LatestParsedDate = AConvert(Of Date)(x.Value(Name_Date), XMLDateProvider, Nothing)
LatestParsedDate = AConvert(Of Date)(x.Value(Name_Date), DateTimeDefaultProvider, Nothing)
CountOfAddedUsers.ListAddList(x.Value(Name_UsersAdded).StringToList(Of Integer)("|"), lc)
CountOfLoadedPostsPerSession.ListAddList(x.Value(Name_PostsDownloaded).StringToList(Of Integer)("|"), lc)
ChannelExistentUserNames.ListAddList(x.Value(Name_UsersExistent).StringToList(Of String)("|"), LNC)
@@ -359,7 +359,7 @@ Namespace API.Reddit
With x(Name_PostsNode).XmlIfNothing
If .Count > 0 Then .ForEach(Sub(ee) PostsLatest.Add(New UserPost With {
.ID = ee.Attribute(Name_ID),
.[Date] = AConvert(Of Date)(ee.Attribute(Name_Date).Value, XMLDateProvider, Nothing)}))
.[Date] = AConvert(Of Date)(ee.Attribute(Name_Date).Value, DateTimeDefaultProvider, Nothing)}))
End With
End If
End If
@@ -367,45 +367,53 @@ Namespace API.Reddit
End If
Return True
End Function
Private _Saved As Boolean = True
Friend Function SaveUnsaved() As Boolean
Return _Saved OrElse Save()
End Function
Friend Overloads Function Save(Optional ByVal f As SFile = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements ILoaderSaver.Save
Dim XMLDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
UpdateUsersStats()
If Not ViewMode = View.New Then
Dim l As New List(Of String)
If Posts.Count > 0 Or PostsLatest.Count > 0 Then l.ListAddList((From p In PostsAll Where Not p.ID.IsEmptyString Select p.ID), LNC)
l.ListAddList(PostsNames, LNC)
If l.Count > 0 Then TextSaver.SaveTextToFile(l.ListToString("|"), FilePosts, True,, EDP.SendToLog)
End If
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Channel"}
x.Add(Name_Name, Name)
x.Add(Name_ID, ID)
x.Add(Name_ViewMode, CInt(ViewMode))
x.Add(Name_ViewPeriod, CInt(ViewPeriod))
x.Add(Name_UsersAdded, CountOfAddedUsers.ListToString("|"))
x.Add(Name_PostsDownloaded, CountOfLoadedPostsPerSession.ListToString("|"))
x.Add(Name_UsersExistent, ChannelExistentUserNames.ListToString("|"))
If Posts.Count > 0 Or PostsLatest.Count > 0 Then
Dim tmpPostList As List(Of UserPost) = Nothing
tmpPostList.ListAddList(Posts).ListAddList(PostsLatest)
tmpPostList.Sort()
LatestParsedDate = tmpPostList.FirstOrDefault(Function(pd) pd.Date.HasValue).Date
x.Add(Name_Date, AConvert(Of String)(LatestParsedDate, XMLDateProvider, String.Empty))
x.Add(Name_PostsNode, String.Empty)
With x(Name_PostsNode)
tmpPostList.Take(200).ToList.ForEach(Sub(p) .Add(New EContainer("Post",
String.Empty,
{
New EAttribute(Name_ID, p.ID),
New EAttribute(Name_Date, AConvert(Of String)(p.Date, XMLDateProvider, String.Empty))
})
)
)
End With
tmpPostList.Clear()
Try
UpdateUsersStats()
If Not ViewMode = View.New Then
Dim l As New List(Of String)
If Posts.Count > 0 Or PostsLatest.Count > 0 Then l.ListAddList((From p In PostsAll Where Not p.ID.IsEmptyString Select p.ID), LNC)
l.ListAddList(PostsNames, LNC)
If l.Count > 0 Then TextSaver.SaveTextToFile(l.ListToString("|"), FilePosts, True,, EDP.SendToLog)
End If
x.Save(File)
End Using
Return True
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Channel"}
x.Add(Name_Name, Name)
x.Add(Name_ID, ID)
x.Add(Name_ViewMode, CInt(ViewMode))
x.Add(Name_ViewPeriod, CInt(ViewPeriod))
x.Add(Name_UsersAdded, CountOfAddedUsers.ListToString("|"))
x.Add(Name_PostsDownloaded, CountOfLoadedPostsPerSession.ListToString("|"))
x.Add(Name_UsersExistent, ChannelExistentUserNames.ListToString("|"))
If Posts.Count > 0 Or PostsLatest.Count > 0 Then
Dim tmpPostList As List(Of UserPost) = Nothing
tmpPostList.ListAddList(Posts).ListAddList(PostsLatest)
tmpPostList.Sort()
LatestParsedDate = tmpPostList.FirstOrDefault(Function(pd) pd.Date.HasValue).Date
x.Add(Name_Date, AConvert(Of String)(LatestParsedDate, DateTimeDefaultProvider, String.Empty))
x.Add(Name_PostsNode, String.Empty)
With x(Name_PostsNode)
tmpPostList.Take(200).ToList.ForEach(Sub(p) .Add(New EContainer("Post",
String.Empty,
{
New EAttribute(Name_ID, p.ID),
New EAttribute(Name_Date, AConvert(Of String)(p.Date, DateTimeDefaultProvider, String.Empty))
})
)
)
End With
tmpPostList.Clear()
End If
_Saved = x.Save(File)
End Using
Return True
Catch ex As Exception
If Not e.Exists Then e = EDP.ReturnValue
Return ErrorsDescriber.Execute(e, ex, "API.Reddit.Channel.Save", _Saved)
End Try
End Function
#End Region
#Region "IDisposable Support"

View File

@@ -90,7 +90,7 @@ Namespace API.Reddit
End If
End Sub
Friend Sub Update()
If Count > 0 Then Channels.ForEach(Sub(c) c.Save())
If Count > 0 Then Channels.ForEach(Sub(c) c.SaveUnsaved())
End Sub
Friend ReadOnly Property Count As Integer Implements ICollection(Of Channel).Count, IMyEnumerator(Of Channel).MyEnumeratorCount
Get

View File

@@ -104,12 +104,45 @@ Namespace API.Reddit
Return New UserData
End Function
#End Region
#Region "Available, UpdateRedGifsToken"
#Region "DownloadStarted, ReadyToDownload, Available, DownloadDone, UpdateRedGifsToken"
Private ____DownloadStarted As Boolean = False
Friend Overrides Sub DownloadStarted(ByVal What As Download)
If What = Download.Main Then ____DownloadStarted = True
MyBase.DownloadStarted(What)
End Sub
Friend Property SessionInterrupted As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If What = Download.Main Then Return Not SessionInterrupted Else Return True
If What = Download.Main Then
Dim result As Boolean = Not SessionInterrupted
If result Then
If ____DownloadStarted And ____AvailableRequested Then
____AvailableResult = AvailableImpl(What, ____AvailableSilent)
____AvailableChecked = True
____AvailableRequested = False
result = ____AvailableResult
ElseIf ____AvailableChecked Then
result = ____AvailableResult
End If
End If
Return result
Else
Return True
End If
End Function
Private ____AvailableRequested As Boolean = False
Private ____AvailableSilent As Boolean = True
Private ____AvailableChecked As Boolean = False
Private ____AvailableResult As Boolean = False
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
If What = Download.Main And ____DownloadStarted Then
____AvailableRequested = True
____AvailableSilent = Silent
Return True
Else
Return AvailableImpl(What, Silent)
End If
End Function
Private Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean
Try
Dim trueValue As Boolean = Not What = Download.SavedPosts OrElse (Responser.CookiesExists And ACheck(SavedPostsUserName.Value))
If Not trueValue Then Return False
@@ -141,6 +174,11 @@ Namespace API.Reddit
End Function
Friend Overrides Sub DownloadDone(ByVal What As Download)
SessionInterrupted = False
____DownloadStarted = False
____AvailableRequested = False
____AvailableChecked = False
____AvailableSilent = True
____AvailableResult = False
MyBase.DownloadDone(What)
End Sub
Private Sub UpdateRedGifsToken()
@@ -200,7 +238,7 @@ Namespace API.Reddit
For i% = 0 To p.Count - 1
If CStr(p(i).Value).IsEmptyString Then wrong.Add(p(i).Name)
Next
If wrong.Count > 0 Then
If wrong.Count > 0 And wrong.Count <> 4 Then
MsgBoxE({$"You have not completed the following fields: {wrong.ListToString}." & vbCr &
"To use OAuth authorization, all authorization fields must be filled in.", "Validate token fields"}, vbCritical)
Return False
@@ -218,39 +256,57 @@ Namespace API.Reddit
Return True
End Function
Private Overloads Function UpdateToken() As Boolean
Return UpdateToken(AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value)
Return UpdateToken(AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value, EDP.SendToLog + EDP.ReturnValue)
End Function
<PropertyUpdater(NameOf(BearerToken), {NameOf(AuthUserName), NameOf(AuthPassword), NameOf(ApiClientID), NameOf(ApiClientSecret)})>
Private Overloads Function UpdateToken(ByVal UserName As String, ByVal Password As String, ByVal ClientID As String, ByVal ClientSecret As String) As Boolean
Return UpdateToken(UserName, Password, ClientID, ClientSecret, EDP.LogMessageValue)
End Function
Private Overloads Function UpdateToken(ByVal UserName As String, ByVal Password As String, ByVal ClientID As String, ByVal ClientSecret As String, ByVal e As ErrorsDescriber) As Boolean
Try
Dim result As Boolean = True
If {UserName, Password, ClientID, ClientSecret}.All(Function(v) Not v.IsEmptyString) Then
result = False
Dim r$ = String.Empty
Using resp As New Responser With {
.Mode = Responser.Modes.Curl,
.Method = "POST",
.CurlArgumentsLeft = $"-d ""grant_type=password&username={UserName}&password={Password}"" --user ""{ClientID}:{ClientSecret}"""
}
r = resp.GetResponse("https://www.reddit.com/api/v1/access_token")
End Using
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
Dim newToken$ = j.Value("access_token")
If Not newToken.IsEmptyString Then
BearerToken.Value = $"Bearer {newToken}"
BearerTokenDateUpdate.Value = Now
Responser.SaveSettings()
result = True
End If
End If
Dim c% = 0
Dim _found As Boolean
Do
c += 1
Using resp As New Responser With {
.Method = "POST",
.ProcessExceptionDecision = Function(status, obj, ee) If(status.StatusCode = 429, EDP.ReturnValue, ee)
}
With resp
With .PayLoadValues
.Add("grant_type", "password")
.Add("username", UserName)
.Add("password", Password)
End With
.CredentialsUserName = ClientID
.CredentialsPassword = ClientSecret
.PreAuthenticate = True
End With
r = resp.GetResponse("https://www.reddit.com/api/v1/access_token",, EDP.ThrowException)
End Using
End If
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
_found = True
Dim newToken$ = j.Value("access_token")
If Not newToken.IsEmptyString Then
BearerToken.Value = $"Bearer {newToken}"
BearerTokenDateUpdate.Value = Now
Responser.SaveSettings()
result = True
End If
End If
End Using
End If
Loop While c < 5 And Not _found
End If
Return result
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[Reddit.SiteSettings.UpdateToken]", False)
Return ErrorsDescriber.Execute(e, ex, "[Reddit.SiteSettings.UpdateToken]", False)
End Try
End Function
#End Region

View File

@@ -877,6 +877,8 @@ Namespace API.Reddit
For li = IIf(lastCount < 0, 0, lastCount) To _TempMediaList.Count - 1
m2 = _TempMediaList(i)
m2.Post.Date = m.Post.Date
m2.State = UStates.Missing
m2.Attempts = m.Attempts
_TempMediaList(i) = m2
Next
End If

View File

@@ -74,16 +74,16 @@ Namespace API.RedGifs
#Region "Media obtain, extract"
Private Sub ObtainMedia(ByVal j As EContainer, ByVal PostID As String,
Optional ByVal PostDateStr As String = Nothing, Optional ByVal PostDateDate As Date? = Nothing,
Optional ByVal State As UStates = UStates.Unknown)
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0)
Dim tMedia As UserMedia = ExtractMedia(j)
If Not tMedia.Type = UTypes.Undefined Then _
_TempMediaList.ListAddValue(MediaFromData(tMedia.Type, tMedia.URL, PostID, PostDateStr, PostDateDate, State))
_TempMediaList.ListAddValue(MediaFromData(tMedia.Type, tMedia.URL, PostID, PostDateStr, PostDateDate, State, Attempts))
End Sub
Private Shared Function ExtractMedia(ByVal j As EContainer) As UserMedia
If Not j Is Nothing Then
With j("urls")
If .ListExists Then
Dim u$ = If(.Item("hd"), .Item("sd")).XmlIfNothingValue
Dim u$ = .Value("hd").IfNullOrEmpty(.Value("sd"))
If Not u.IsEmptyString Then
Dim ut As UTypes = UTypes.Undefined
'Type 1: video
@@ -122,7 +122,7 @@ Namespace API.RedGifs
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
If If(j("gif")?.Count, 0) > 0 Then
ObtainMedia(j("gif"), u.Post.ID,, u.Post.Date, UStates.Missing)
ObtainMedia(j("gif"), u.Post.ID,, u.Post.Date, UStates.Missing, u.Attempts)
rList.Add(i)
End If
End If
@@ -229,7 +229,7 @@ Namespace API.RedGifs
#End Region
#Region "Create media"
Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String,
ByVal PostDateStr As String, ByVal PostDateDate As Date?, ByVal State As UStates) As UserMedia
ByVal PostDateStr As String, ByVal PostDateDate As Date?, ByVal State As UStates, Optional ByVal Attempts As Integer = 0) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
@@ -241,6 +241,7 @@ Namespace API.RedGifs
m.Post.Date = Nothing
End If
m.State = State
m.Attempts = Attempts
Return m
End Function
#End Region
@@ -249,7 +250,7 @@ Namespace API.RedGifs
Optional ByVal EObj As Object = Nothing) As Integer
Dim s As WebExceptionStatus = Responser.Status
Dim sc As HttpStatusCode = Responser.StatusCode
If sc = HttpStatusCode.NotFound Or s = DataGone Then
If sc = HttpStatusCode.NotFound Or s = DataGone Or sc = DataGone Then
UserExists = False
ElseIf sc = HttpStatusCode.Unauthorized Then
MyMainLOG = $"RedGifs credentials have expired [{CInt(sc)}]: {ToStringForLog()}"

View File

@@ -67,7 +67,7 @@ Namespace API.ThisVid
UpdateUserOptions(True, q)
End Set
End Property
Friend ReadOnly Property IsUser As Boolean
Friend Overrides ReadOnly Property IsUser As Boolean
Get
Return SiteMode = SiteModes.User
End Get
@@ -180,6 +180,7 @@ Namespace API.ThisVid
#Region "Initializer"
Friend Sub New()
UseClientTokens = True
PagePosts = New List(Of String)
End Sub
#End Region
#Region "Validation"
@@ -223,8 +224,10 @@ Namespace API.ThisVid
End Function
#End Region
#Region "Download functions"
Private ReadOnly PagePosts As List(Of String)
Private AddedCount As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
PagePosts.Clear()
AddedCount = 0
Responser.Cookies.ChangedAllowInternalDrop = False
Responser.Cookies.Changed = False
@@ -299,11 +302,16 @@ Namespace API.ThisVid
_TempMediaList.Add(New UserMedia(u) With {.Type = UserMedia.Types.VideoPre, .SpecialFolder = __SpecialFolder})
AddedCount += 1
If limit > 0 And AddedCount >= limit Then Exit Sub
ElseIf PagePosts.Count > 0 AndAlso PagePosts.Contains(u) Then
Continue For
Else
Exit Sub
End If
End If
Next
PagePosts.Clear()
PagePosts.AddRange(l)
l.Clear()
End If
End If
If Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000) Then DownloadData(Page + 1, Model, Token)
@@ -537,6 +545,12 @@ Namespace API.ThisVid
Return 0
End If
End Function
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then PagePosts.Clear()
MyBase.Dispose(disposing)
End Sub
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,166 @@
' Copyright (C) 2023 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
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions
Imports IG = SCrawler.API.Instagram.SiteSettings
Namespace API.ThreadsNet
<Manifest("AndyProgram_ThreadsNet"), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.ThreadsIcon_192
End Get
End Property
Private ReadOnly _Image As Image
Friend Overrides ReadOnly Property Image As Image
Get
Return _Image
End Get
End Property
#Region "Authorization"
<PropertyOption(ControlText:="x-csrftoken", AllowNull:=False)>
Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", AllowNull:=False)>
Friend Property HH_IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-asbd-id", AllowNull:=True)>
Friend Property HH_ASBD_ID As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua", AllowNull:=True)>
Private Property HH_BROWSER As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", AllowNull:=True)>
Private Property HH_BROWSER_EXT As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", AllowNull:=True, LeftOffset:=120)>
Private Property HH_PLATFORM As PropertyValue
<PropertyOption(ControlText:="UserAgent")>
Private ReadOnly Property HH_USER_AGENT As PropertyValue
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then
Dim f$ = String.Empty
Dim isUserAgent As Boolean = False
Select Case PropName
Case NameOf(HH_IG_APP_ID) : f = IG.Header_IG_APP_ID
Case NameOf(HH_ASBD_ID) : f = IG.Header_ASBD_ID
Case NameOf(HH_CSRF_TOKEN) : f = IG.Header_CSRF_TOKEN
Case NameOf(HH_BROWSER) : f = IG.Header_Browser
Case NameOf(HH_BROWSER_EXT) : f = IG.Header_BrowserExt
Case NameOf(HH_PLATFORM) : f = IG.Header_Platform
Case NameOf(HH_USER_AGENT) : isUserAgent = True
End Select
If Not f.IsEmptyString Then
Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
ElseIf isUserAgent Then
Responser.UserAgent = CStr(Value)
End If
End If
End Sub
#End Region
#End Region
#Region "Initializer"
Friend Sub New()
MyBase.New("Threads", "threads.net")
_AllowUserAgentUpdate = False
_Image = My.Resources.SiteResources.ThreadsIcon_192.ToBitmap
Dim app_id$ = String.Empty
Dim token$ = String.Empty
Dim asbd$ = String.Empty
Dim browser$ = String.Empty
Dim browserExt$ = String.Empty
Dim platform$ = String.Empty
Dim useragent$ = String.Empty
With Responser
.Accept = "*/*"
'URGENT: remove after debug
.DeclaredError = EDP.SendToLog + EDP.ThrowException
If .UserAgentExists Then useragent = .UserAgent
With .Headers
If .Count > 0 Then
token = .Value(IG.Header_CSRF_TOKEN)
app_id = .Value(IG.Header_IG_APP_ID)
asbd = .Value(IG.Header_ASBD_ID)
browser = .Value(IG.Header_Browser)
browserExt = .Value(IG.Header_BrowserExt)
platform = .Value(IG.Header_Platform)
End If
.Add("Authority", "www.threads.net")
.Add("Origin", "https://www.threads.net")
.Add("Upgrade-Insecure-Requests", 1)
.Add("Sec-Ch-Ua-Model", "")
.Add("Sec-Ch-Ua-Mobile", "?0")
.Add("Sec-Ch-Ua-Platform", """Windows""")
.Add("Sec-Fetch-Dest", "empty")
.Add("Sec-Fetch-Mode", "cors")
.Add("Sec-Fetch-Site", "same-origin")
.Add("Sec-Fetch-User", "?1")
.Add("x-fb-friendly-name", "BarcelonaProfileThreadsTabRefetchableQuery")
End With
.CookiesExtractMode = Responser.CookiesExtractModes.Any
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
.CookiesExtractedAutoSave = False
.Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False
End With
HH_CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_CSRF_TOKEN), v))
HH_IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_IG_APP_ID), v))
HH_ASBD_ID = New PropertyValue(asbd, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_ASBD_ID), v))
HH_BROWSER = New PropertyValue(browser, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER), v))
HH_BROWSER_EXT = New PropertyValue(browserExt, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER_EXT), v))
HH_PLATFORM = New PropertyValue(platform, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_PLATFORM), v))
HH_USER_AGENT = New PropertyValue(useragent, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_USER_AGENT), v))
UrlPatternUser = "https://www.threads.net/@{0}"
UserRegex = RParams.DMS("threads.net/@([^/\?&]+)", 1)
ImageVideoContains = "threads.net"
End Sub
#End Region
#Region "UpdateResponserData"
Friend Sub UpdateResponserData(ByVal Resp As Responser)
With Responser.Cookies
Dim csrf$ = String.Empty
.Update(Resp.Cookies)
If .Changed Then
Responser.SaveCookies()
.Changed = False
csrf = If(.FirstOrDefault(Function(c) c.Name.StringToLower = IG.Header_CSRF_TOKEN_COOKIE)?.Value, String.Empty)
End If
If Not csrf.IsEmptyString AndAlso Not AEquals(Of String)(csrf, HH_CSRF_TOKEN.Value) Then HH_CSRF_TOKEN.Value = csrf : Responser.SaveSettings()
End With
End Sub
#End Region
#Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
#End Region
#Region "BaseAuthExists, GetUserUrl, GetUserPostUrl"
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists And {HH_CSRF_TOKEN, HH_IG_APP_ID}.All(Function(v) ACheck(Of String)(v.Value))
End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return String.Format(UrlPatternUser, DirectCast(User, UserData).NameTrue)
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Try
Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID)
Dim name$ = DirectCast(User, UserData).NameTrue
If Not code.IsEmptyString Then Return $"https://www.threads.net/@{name}/post/{code}/" Else Return String.Empty
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "Can't open user's post", String.Empty)
End Try
End Function
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,290 @@
' Copyright (C) 2023 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
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.EventArguments
Imports IGS = SCrawler.API.Instagram.SiteSettings
Namespace API.ThreadsNet
Friend Class UserData : Inherits Instagram.UserData
#Region "Declarations"
Private Const Header_FB_LSD As String = "x-fb-lsd"
Private ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
End Get
End Property
Private ReadOnly ObtainMedia_SizeFuncPic_RegexP As RParams = RParams.DMS("_p(\d+)x(\d+)", 1, EDP.ReturnValue)
Private ReadOnly ObtainMedia_SizeFuncPic_RegexS As RParams = RParams.DMS("_s(\d+)x(\d+)", 1, EDP.ReturnValue)
Private ReadOnly DefaultParser_ElemNode_Default() As Object = {"node", "thread_items", 0, "post"}
Private OPT_LSD As String = String.Empty
Private OPT_FB_DTSG As String = String.Empty
Private ReadOnly Property Valid As Boolean
Get
Return Not OPT_LSD.IsEmptyString And Not OPT_FB_DTSG.IsEmptyString And Not ID.IsEmptyString
End Get
End Property
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
#Region "Exchange"
Friend Overrides Function ExchangeOptionsGet() As Object
Return Nothing
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
End Sub
#End Region
#Region "Initializer"
Friend Sub New()
ObtainMedia_SizeFuncPic = Function(ByVal ss As EContainer) As Sizes
If ss.Value("url").IsEmptyString Then
Return New Sizes("----", "")
ElseIf Not ss.Value("width").IsEmptyString Then
Return New Sizes(ss.Value("height").IfNullOrEmpty(ss.Value("width")), ss.Value("url"))
Else
Dim rval$ = RegexReplace(ss.Value("url"), ObtainMedia_SizeFuncPic_RegexP)
If Not rval.IsEmptyString Then Return New Sizes(rval, ss.Value("url"))
rval = RegexReplace(ss.Value("url"), ObtainMedia_SizeFuncPic_RegexS)
If Not rval.IsEmptyString Then Return New Sizes(AConvert(Of Integer)(rval, 1) * -1, ss.Value("url"))
Return New Sizes(10000, ss.Value("url"))
End If
End Function
ObtainMedia_SizeFuncVid = Function(ss) If(ss.Value("url").IsEmptyString, New Sizes("----", ""), New Sizes(10000, ss.Value("url")))
ObtainMedia_AllowAbstract = True
DefaultParser_ElemNode = DefaultParser_ElemNode_Default
DefaultParser_PostUrlCreator = Function(post) $"https://www.threads.net/@{NameTrue}/post/{post.Code}"
End Sub
#End Region
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim errorFound As Boolean = False
Try
Responser.Method = "POST"
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
LoadSavePostsKV(True)
OPT_LSD = String.Empty
OPT_FB_DTSG = String.Empty
DownloadData(String.Empty, Token)
Catch ex As Exception
errorFound = True
Throw ex
Finally
Responser.Method = "POST"
UpdateResponser()
MySettings.UpdateResponserData(Responser)
If Not errorFound Then LoadSavePostsKV(False)
End Try
End Sub
Protected Overrides Sub UpdateResponser()
If Not Responser Is Nothing AndAlso Not Responser.Disposed Then
RemoveHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
End If
End Sub
Protected Overrides Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As WebDataResponse)
If e.CookiesExists Then
Dim csrf$ = If(e.Cookies.FirstOrDefault(Function(v) v.Name.StringToLower = IGS.Header_CSRF_TOKEN_COOKIE)?.Value, String.Empty)
If Not csrf.IsEmptyString AndAlso Not AEquals(Of String)(csrf, Responser.Headers.Value(IGS.Header_CSRF_TOKEN)) Then _
Responser.Headers.Add(IGS.Header_CSRF_TOKEN, csrf)
End If
End Sub
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
Const urlPattern$ = "https://www.threads.net/api/graphql?lsd={0}&variables={1}&doc_id=6371597506283707&fb_api_req_friendly_name=BarcelonaProfileThreadsTabRefetchableQuery&server_timestamps=true&fb_dtsg={2}"
Const var_init$ = """userID"":""{0}"""
Const var_cursor$ = """after"":""{1}"",""before"":null,""first"":25,""last"":null,""userID"":""{0}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false"
Dim URL$ = String.Empty
Try
If Not Valid Then
Dim idIsNull As Boolean = ID.IsEmptyString
UpdateCredentials()
If idIsNull And Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
If Not Valid Then Throw New Plugin.ExitException("Some credentials are missing")
Responser.Method = "POST"
Responser.Referer = $"https://www.threads.net/@{NameTrue}"
Responser.Headers.Add(Header_FB_LSD, OPT_LSD)
Dim nextCursor$ = String.Empty
Dim dataFound As Boolean = False
Dim vars$
If Cursor.IsEmptyString Then
vars = String.Format(var_init, ID)
Else
vars = String.Format(var_cursor, ID, Cursor)
End If
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & vars & "}")
URL = String.Format(urlPattern, OPT_LSD, vars, SymbolsConverter.ASCII.EncodeSymbolsOnly(OPT_FB_DTSG))
Using j As EContainer = GetDocument(URL, Token)
If j.ListExists Then
With j({"data", "mediaData"})
If .ListExists Then
nextCursor = .Value({"page_info"}, "end_cursor")
With .Item({"edges"})
If .ListExists Then dataFound = DefaultParser(.Self, Sections.Timeline, Token)
End With
End If
End With
End If
End Using
If dataFound And Not nextCursor.IsEmptyString Then DownloadData(nextCursor, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Private Function GetDocument(ByVal URL As String, ByVal Token As CancellationToken, Optional ByVal Round As Integer = 0) As EContainer
Try
ThrowAny(Token)
If Round > 0 AndAlso Not UpdateCredentials() Then Throw New Exception("Failed to update credentials")
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then Return JsonDocument.Parse(r) Else Throw New Exception("Failed to get a response")
Catch ex As Exception
If Round = 0 Then
Return GetDocument(URL, Token, Round + 1)
Else
Throw ex
End If
End Try
End Function
Private Function UpdateCredentials(Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Dim URL$ = $"https://www.threads.net/@{NameTrue}"
OPT_LSD = String.Empty
OPT_FB_DTSG = String.Empty
Try
Responser.Method = "GET"
Responser.Referer = URL
Responser.Headers.Remove(Header_FB_LSD)
Dim r$ = Responser.GetResponse(URL,, EDP.SendToLog + EDP.ThrowException)
Dim rr As RParams
Dim tt$, ttVal$
If Not r.IsEmptyString Then
rr = RParams.DM("\[\],{""token"":""(.*?)""},\d+\]", 0, RegexReturn.List, EDP.ReturnValue)
Dim tokens As List(Of String) = RegexReplace(r, rr)
If tokens.ListExists Then
With rr
.Match = Nothing
.MatchSub = 1
.WhatGet = RegexReturn.Value
End With
For Each tt In tokens
If Not OPT_FB_DTSG.IsEmptyString And Not OPT_LSD.IsEmptyString Then
Exit For
Else
ttVal = RegexReplace(tt, rr)
If Not ttVal.IsEmptyString Then
If ttVal.Contains(":") Then
If OPT_FB_DTSG.IsEmptyString Then OPT_FB_DTSG = ttVal
Else
If OPT_LSD.IsEmptyString Then OPT_LSD = ttVal
End If
End If
End If
Next
End If
If ID.IsEmptyString Then ID = RegexReplace(r, RParams.DMS("""props"":\{""user_id"":""(\d+)""\},", 1, EDP.ReturnValue))
End If
Return Valid
Catch ex As Exception
Dim notFound$ = String.Empty
If OPT_FB_DTSG.IsEmptyString Then notFound.StringAppend(Header_FB_LSD)
If OPT_LSD.IsEmptyString Then notFound.StringAppend("lsd")
If ID.IsEmptyString Then notFound.StringAppend("User ID")
LogError(ex, $"failed to update some{IIf(notFound.IsEmptyString, String.Empty, $" ({notFound})")} credentials", e)
Return False
End Try
End Function
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Const varsPattern$ = """postID"":""{0}"",""userID"":""{1}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false"
'Const varsPattern$ = "{""postID"":""{0}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false}"
Const urlPattern$ = "https://www.threads.net/api/graphql?lsd={0}&variables={1}&fb_api_req_friendly_name=BarcelonaPostPageQuery&server_timestamps=true&fb_dtsg={2}&doc_id=25460088156920903"
Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
DefaultParser_ElemNode = Nothing
DefaultParser_IgnorePass = True
Try
If ContentMissingExists Then
Responser.Method = "POST"
Responser.Referer = $"https://www.threads.net/@{NameTrue}"
If Not IsSingleObjectDownload AndAlso Not UpdateCredentials() Then Throw New Exception("Failed to update credentials")
Dim m As UserMedia
Dim vars$
Dim j As EContainer
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
m = _ContentList(i)
If m.State = UserMedia.States.Missing And Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(varsPattern, m.Post.ID.Split("_").FirstOrDefault, ID) & "}")
URL = String.Format(urlPattern, OPT_LSD, vars, SymbolsConverter.ASCII.EncodeSymbolsOnly(OPT_FB_DTSG))
j = GetDocument(URL, Token)
If j.ListExists Then
With j.ItemF({"data", "data", "edges", 0, "node", "thread_items", 0, "post"})
If .ListExists AndAlso DefaultParser({ .Self}, Sections.Timeline, Token) Then rList.Add(i)
End With
j.Dispose()
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, $"ReparseMissing error [{URL}]")
Finally
DefaultParser_ElemNode = DefaultParser_ElemNode_Default
DefaultParser_IgnorePass = False
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try
End Sub
#End Region
#Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
Dim url$ = Data.URL_BASE.IfNullOrEmpty(Data.URL)
Dim postCode$ = RegexReplace(url, RParams.DMS("post/([^/\?&]+)", 1, EDP.ReturnValue))
If Not postCode.IsEmptyString Then
Dim postId$ = CodeToID(postCode)
If Not postId.IsEmptyString Then
_NameTrue = MySettings.IsMyUser(url).UserName
DefaultParser_PostUrlCreator = Function(post) url
If Not _NameTrue.IsEmptyString AndAlso UpdateCredentials(EDP.ReturnValue) Then
_ContentList.Add(New UserMedia(url) With {.State = UserMedia.States.Missing, .Post = postId})
ReparseMissing(Token)
End If
End If
End If
End Sub
#End Region
#Region "ThrowAny"
Friend Overrides Sub ThrowAny(ByVal Token As CancellationToken)
ThrowAnyImpl(Token)
End Sub
#End Region
#Region "DownloadingException"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
Return 0
End Function
#End Region
End Class
End Namespace

View File

@@ -71,6 +71,7 @@ Namespace API.TikTok
TitleUseNative = .Value(Name_TitleUseNative).FromXML(Of Boolean)(True)
TitleAddVideoID = .Value(Name_TitleAddVideoID).FromXML(Of Boolean)(True)
LastDownloadDate = AConvert(Of Date)(.Value(Name_LastDownloadDate), ADateTime.Formats.BaseDateTime, Nothing)
If Not LastDownloadDate.HasValue Then LastDownloadDate = LastUpdated
Else
.Add(Name_RemoveTagsFromTitle, RemoveTagsFromTitle.BoolToInteger)
.Add(Name_TitleUseNative, TitleUseNative.BoolToInteger)
@@ -109,12 +110,20 @@ Namespace API.TikTok
End With
If LastDownloadDate.HasValue Then
If dateAfter.HasValue And Not DownloadDateFrom.HasValue Then
If Not DownloadDateTo.HasValue And Not DownloadDateFrom.HasValue Then
If LastDownloadDate.Value.AddDays(1) <= Now Then
dateAfter = LastDownloadDate.Value
Else
dateAfter = LastDownloadDate.Value.AddDays(-1)
End If
dateBefore = Nothing
ElseIf dateAfter.HasValue And Not DownloadDateFrom.HasValue Then
If (LastDownloadDate.Value - dateAfter.Value).TotalDays > 1 Then dateAfter = dateAfter.Value.AddDays(1)
End If
End If
Using b As New TokenBatch(Token)
Using b As New YTDLP.YTDLPBatch(Token) With {.TempPostsList = _TempPostsList}
b.Commands.Clear()
b.ChangeDirectory(cache)
b.Encoding = BatchExecutor.UnicodeEncoding
b.Execute(CreateYTCommand(cache.RootDirectory, URL, False, dateBefore, dateAfter))
@@ -163,6 +172,7 @@ Namespace API.TikTok
End If
Next
End If
If _TempMediaList.Count > 0 Then LastDownloadDate = Now
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
@@ -210,6 +220,9 @@ Namespace API.TikTok
command &= "-o %(id)s"
End If
End If
'#If DEBUG Then
'Debug.WriteLine(command)
'#End If
Return command
End Function
#End Region

View File

@@ -87,6 +87,7 @@ Namespace API.Twitter
MyBase.New(TwitterSite, "twitter.com")
_Image = My.Resources.SiteResources.TwitterIcon_32.ToBitmap
LimitSkippedUsers = New List(Of UserDataBase)
With Responser
.Cookies.ChangedAllowInternalDrop = False
@@ -126,7 +127,19 @@ Namespace API.Twitter
Return Settings.GalleryDLFile.Exists And BaseAuthExists()
End Function
Friend Property LIMIT_ABORT As Boolean = False
Friend ReadOnly Property LimitSkippedUsers As List(Of UserDataBase)
Friend Overrides Sub DownloadDone(ByVal What As ISiteSettings.Download)
If LimitSkippedUsers.Count > 0 Then
With LimitSkippedUsers
If .Count = 1 Then
MyMainLOG = $"{ .Item(0).ToStringForLog}: twitter limit reached. Data has not been downloaded."
Else
MyMainLOG = "The following twitter users have not been downloaded (twitter limit reached):" & vbNewLine &
.ListToStringE(vbNewLine, New CustomProvider(Function(v As UserDataBase) $"{v.Name} ({v.ToStringForLog})"))
End If
.Clear()
End With
End If
LIMIT_ABORT = False
MyBase.DownloadDone(What)
End Sub

View File

@@ -140,7 +140,7 @@ Namespace API.Twitter
End Function
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If MySettings.LIMIT_ABORT Then
TwitterLimitException.LogMessage(ToStringForLog, True)
Throw New TwitterLimitException(Me)
Else
If IsSavedPosts Then
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.Post.ID), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
@@ -340,6 +340,7 @@ Namespace API.Twitter
DownloadModelForceApply = False
FirstDownloadComplete = True
Catch limit_ex As TwitterLimitException
Throw limit_ex
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
Finally
@@ -391,7 +392,8 @@ Namespace API.Twitter
End Sub
#End Region
#Region "Obtain media"
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown)
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0)
Dim s As EContainer = e({"extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status", "extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"})
@@ -405,7 +407,7 @@ Namespace API.Twitter
Dim dName$ = UrlFile(mUrl)
If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then
_DataNames.Add(dName)
_TempMediaList.ListAddValue(MediaFromData(mUrl, PostID, PostDate, GetPictureOption(m), State, UTypes.Picture), LNC)
_TempMediaList.ListAddValue(MediaFromData(mUrl, PostID, PostDate, GetPictureOption(m), State, UTypes.Picture, Attempts), LNC)
End If
End If
End If
@@ -491,12 +493,10 @@ Namespace API.Twitter
End Function
#End Region
#Region "Gallery-DL Support"
Private Class TwitterLimitException : Inherits Exception
Friend Sub New(ByVal User As String, ByVal Skipped As Boolean)
LogMessage(User, Skipped)
End Sub
Friend Shared Sub LogMessage(ByVal User As String, ByVal Skipped As Boolean)
MyMainLOG = $"{User}: twitter limit reached.{IIf(Skipped, "Data has not been downloaded", String.Empty)}"
Private Class TwitterLimitException : Inherits Plugin.ExitException
Friend Sub New(ByVal User As UserData)
Silent = True
User.MySettings.LimitSkippedUsers.Add(User)
End Sub
End Class
Private Class TwitterGDL : Inherits GDL.GDLBatch
@@ -558,7 +558,7 @@ Namespace API.Twitter
MySettings.LIMIT_ABORT = True
Return dir
Else
Throw New TwitterLimitException(ToStringForLog, False)
Throw New TwitterLimitException(Me)
End If
End If
End Using
@@ -626,7 +626,7 @@ Namespace API.Twitter
MySettings.LIMIT_ABORT = True
Exit For
Else
Throw New TwitterLimitException(ToStringForLog, False)
Throw New TwitterLimitException(Me)
End If
End If
End If
@@ -713,7 +713,7 @@ Namespace API.Twitter
If .ListExists Then
PostDate = String.Empty
If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing)
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts)
rList.ListAddValue(i, LNC)
End If
End With
@@ -805,7 +805,8 @@ Namespace API.Twitter
Private Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _PictureOption As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Type As UTypes = UTypes.Undefined) As UserMedia
Optional ByVal Type As UTypes = UTypes.Undefined,
Optional ByVal Attempts As Integer = 0) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL) With {.PictureOption = _PictureOption, .Post = New UserPost With {.ID = PostID}, .Type = Type}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
@@ -814,6 +815,7 @@ Namespace API.Twitter
End If
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, Declarations.DateProvider, Nothing) Else m.Post.Date = Nothing
m.State = State
m.Attempts = Attempts
Return m
End Function
#End Region

View File

@@ -71,17 +71,9 @@ Namespace API
End Property
Friend Overrides Property FriendlyName As String
Get
If Count > 0 Then
Return Collections(0).FriendlyName
Else
Return String.Empty
End If
Return CollectionName
End Get
Set(ByVal NewName As String)
If Count > 0 Then Collections.ForEach(Sub(c)
c.FriendlyName = NewName
c.UpdateUserInformation()
End Sub)
End Set
End Property
Friend Overrides Property UserExists As Boolean
@@ -291,7 +283,7 @@ Namespace API
End Property
Friend Overrides Property ScriptUse As Boolean
Get
Return Count > 0 AndAlso Collections.Exists(Function(c) c.ScriptUse)
Return Count > 0 AndAlso Collections.All(Function(c) c.ScriptUse)
End Get
Set(ByVal u As Boolean)
If Count > 0 Then Collections.ForEach(Sub(ByVal c As IUserData)
@@ -499,19 +491,22 @@ Namespace API
Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add
With _Item
If .MoveFiles(CollectionName, CollectionPath) Then
If Not _Item.IsVirtual And DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
Collections.Add(_Item)
If Not .Self.IsVirtual And DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
ConsolidateLabels(.Self)
ConsolidateScripts(.Self)
ConsolidateColors(.Self)
Collections.Add(.Self)
With Collections.Last
If Count > 1 Then
If _CollectionName.IsEmptyString Then _CollectionName = .CollectionName
.Temporary = Temporary
.Favorite = Favorite
.ReadyForDownload = ReadyForDownload
ConsolidateLabels()
ConsolidateScripts()
.UpdateUserInformation()
End If
MainFrameObj.ImageHandler(_Item, False)
If _CollectionName.IsEmptyString Then _CollectionName = .CollectionName
.Temporary = Temporary
.Favorite = Favorite
.ReadyForDownload = ReadyForDownload
.UpdateUserInformation()
MainFrameObj.ImageHandler(.Self, False)
AddRemoveBttDeleteHandler(.Self, True)
AddHandler .Self.UserUpdated, AddressOf User_OnUserUpdated
End With
@@ -546,11 +541,25 @@ Namespace API
Catch ex As Exception
End Try
End Sub
Private Sub ConsolidateLabels()
UpdateLabels(Me, ListAddList(Nothing, Labels.ListWithRemove(SpecialLabels)), 1, True)
Private Sub ConsolidateLabels(ByVal Destination As UserDataBase)
If Count > 0 Then UpdateLabels(Destination, ListAddList(Nothing, Labels.ListWithRemove(SpecialLabels)), 0, True)
End Sub
Private Sub ConsolidateScripts()
If Count > 1 AndAlso ScriptUse Then Collections.ForEach(Sub(c) c.ScriptUse = True)
Private Sub ConsolidateScripts(ByVal Destination As UserDataBase)
If Count > 0 AndAlso ScriptUse Then
Dim __scriptData$ = Collections(0).ScriptData
Destination.ScriptUse = True
If Collections.All(Function(c) c.ScriptData = __scriptData) Then Destination.ScriptData = __scriptData
End If
End Sub
Private Sub ConsolidateColors(ByVal Destination As UserDataBase)
If Count > 0 And Not Destination.ForeColor.HasValue And Not Destination.BackColor.HasValue Then
Dim b As Color? = BackColor
Dim f As Color? = ForeColor
If b.HasValue AndAlso Not Collections.All(Function(u) Not u Is Destination AndAlso u.BackColor.HasValue AndAlso u.BackColor.Value = b.Value) Then b = Nothing
If f.HasValue AndAlso Not Collections.All(Function(u) Not u Is Destination AndAlso u.ForeColor.HasValue AndAlso u.ForeColor.Value = f.Value) Then f = Nothing
If b.HasValue Then Destination.BackColor = b
If f.HasValue Then Destination.ForeColor = f
End If
End Sub
#End Region
#Region "Move, Merge"

View File

@@ -51,6 +51,11 @@ Namespace API.XVIDEOS
Private Property TrueName As String = String.Empty
Private Property Arguments As String = String.Empty
Private Property PersonType As String = String.Empty
Friend Overrides ReadOnly Property IsUser As Boolean
Get
Return SiteMode = SiteModes.User
End Get
End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {SearchRequestLabelName}

View File

@@ -34,6 +34,11 @@ Namespace API.Xhamster
Friend Property Gender As String = String.Empty
Friend Property SiteMode As SiteModes = SiteModes.User
Friend Property Arguments As String = String.Empty
Friend Overrides ReadOnly Property IsUser As Boolean
Get
Return SiteMode = SiteModes.User Or SiteMode = SiteModes.Pornstars
End Get
End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {SearchRequestLabelName}
@@ -451,6 +456,8 @@ Namespace API.Xhamster
m2 = Nothing
If GetM3U8(m2, m.URL_BASE) Then
m2.URL_BASE = m.URL_BASE
m2.State = UserMedia.States.Missing
m2.Attempts = m.Attempts
_TempMediaList.ListAddValue(m2, LNC)
rList.Add(i)
End If

View File

@@ -82,7 +82,7 @@ Namespace API.YouTube
Dim isMusic As Boolean = False
Dim id$ = String.Empty
Dim isChannelUser As Boolean = False
Dim t As YouTubeMediaType = YouTubeFunctions.Info_GetUrlType(UserURL, isMusic, isChannelUser, id)
Dim t As YouTubeMediaType = YouTubeFunctions.Info_GetUrlType(UserURL, isMusic,, isChannelUser, id)
If Not t = YouTubeMediaType.Undefined And Not t = YouTubeMediaType.Single And Not id.IsEmptyString Then
Return New ExchangeOptions(Site, $"{id}@{CInt(t) + IIf(isMusic, UserMedia.Types.Audio, 0) + IIf(isChannelUser, ChannelUserInt, 0)}")
End If

Binary file not shown.

After

Width:  |  Height:  |  Size: 17 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 166 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

View File

@@ -15,7 +15,7 @@ Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Notifications
Namespace DownloadObjects
Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider
Friend Event PauseDisabled()
Friend Event PauseChanged(ByVal Value As PauseModes)
Friend Enum Modes As Integer
None = 0
[Default] = 1
@@ -297,9 +297,11 @@ Namespace DownloadObjects
Groups = New List(Of String)
UserKeys = New List(Of NotifiedUser)
_IsNewPlan = IsNewPlan
Initialization = False
End Sub
Friend Sub New(ByVal x As EContainer)
Me.New
Initialization = True
Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
Import(x)
If Name.IsEmptyString Then Name = "Default"
@@ -322,6 +324,24 @@ Namespace DownloadObjects
Initialization = False
End Sub
#End Region
#Region "ICopier Support"
Friend Overrides Function Copy() As Object
Dim newObj As New AutoDownloader(True)
newObj.Copy(Me)
With newObj
.Name = String.Empty
._Mode = _Mode
.Groups.ListAddList(Groups, LAP.ClearBeforeAdd)
.Timer = Timer
.StartupDelay = StartupDelay
.ShowNotifications = ShowNotifications
.ShowPictureDownloaded = ShowPictureDownloaded
.ShowPictureUser = ShowPictureUser
.ShowSimpleNotification = ShowSimpleNotification
End With
Return newObj
End Function
#End Region
#Region "Groups Support"
Friend Sub GROUPS_Updated(ByVal Sender As DownloadGroup)
If Groups.Count > 0 Then
@@ -392,6 +412,7 @@ Namespace DownloadObjects
Case PauseModes.Until : _PauseValue = DateLimit
Case Else : _PauseValue = Nothing
End Select
RaiseEvent PauseChanged(p)
End Set
End Property
Private ReadOnly Property IsPaused As Boolean
@@ -403,7 +424,7 @@ Namespace DownloadObjects
Else
_Pause = PauseModes.Disabled
_PauseValue = Nothing
RaiseEvent PauseDisabled()
RaiseEvent PauseChanged(_Pause)
Return False
End If
Else
@@ -541,9 +562,9 @@ Namespace DownloadObjects
Using g As New GroupParameters
g.LabelsExcluded.ListAddList(LabelsExcluded)
g.SitesExcluded.ListAddList(SitesExcluded)
users.ListAddList(DownloadGroup.GetUsers(g, True))
users.ListAddList(DownloadGroup.GetUsers(g))
End Using
Case Modes.Specified : users.ListAddList(DownloadGroup.GetUsers(Me, True))
Case Modes.Specified : users.ListAddList(DownloadGroup.GetUsers(Me))
Case Modes.Groups
If Groups.Count > 0 And Settings.Groups.Count > 0 Then
For Each GName In Groups

View File

@@ -24,28 +24,28 @@ Namespace DownloadObjects
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MODE As System.Windows.Forms.TableLayoutPanel
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(AutoDownloaderEditorForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_MODE As System.Windows.Forms.TableLayoutPanel
Dim TP_NOTIFY As System.Windows.Forms.TableLayoutPanel
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_NOTIFY As System.Windows.Forms.TableLayoutPanel
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.DEF_GROUP = New SCrawler.DownloadObjects.Groups.GroupDefaults()
Me.TXT_GROUPS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.OPT_ALL = New System.Windows.Forms.RadioButton()
Me.OPT_DEFAULT = New System.Windows.Forms.RadioButton()
Me.OPT_SPEC = New System.Windows.Forms.RadioButton()
Me.OPT_DISABLED = New System.Windows.Forms.RadioButton()
Me.OPT_GROUP = New System.Windows.Forms.RadioButton()
Me.TXT_TIMER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.LBL_LAST_TIME_UP = New System.Windows.Forms.Label()
Me.NUM_DELAY = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_GROUPS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_NOTIFY = New System.Windows.Forms.CheckBox()
Me.CH_SHOW_PIC = New System.Windows.Forms.CheckBox()
Me.CH_SHOW_PIC_USER = New System.Windows.Forms.CheckBox()
Me.CH_NOTIFY_SIMPLE = New System.Windows.Forms.CheckBox()
Me.TXT_TIMER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.NUM_DELAY = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.LBL_LAST_TIME_UP = New System.Windows.Forms.Label()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MODE = New System.Windows.Forms.TableLayoutPanel()
TP_NOTIFY = New System.Windows.Forms.TableLayoutPanel()
@@ -53,11 +53,11 @@ Namespace DownloadObjects
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
Me.DEF_GROUP.SuspendLayout()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).BeginInit()
TP_MODE.SuspendLayout()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).BeginInit()
TP_NOTIFY.SuspendLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).BeginInit()
TP_NOTIFY.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
@@ -66,7 +66,7 @@ Namespace DownloadObjects
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DEF_GROUP)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 363)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 388)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -106,26 +106,9 @@ Namespace DownloadObjects
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.DEF_GROUP.Size = New System.Drawing.Size(476, 363)
Me.DEF_GROUP.Size = New System.Drawing.Size(476, 388)
Me.DEF_GROUP.TabIndex = 0
'
'TXT_GROUPS
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Edit"
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Clear"
Me.TXT_GROUPS.Buttons.Add(ActionButton1)
Me.TXT_GROUPS.Buttons.Add(ActionButton2)
Me.TXT_GROUPS.CaptionText = "Groups"
Me.TXT_GROUPS.CaptionWidth = 50.0R
Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 195)
Me.TXT_GROUPS.Name = "TXT_GROUPS"
Me.TXT_GROUPS.Size = New System.Drawing.Size(468, 22)
Me.TXT_GROUPS.TabIndex = 1
Me.TXT_GROUPS.TextBoxReadOnly = True
'
'TP_MODE
'
TP_MODE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
@@ -214,52 +197,23 @@ Namespace DownloadObjects
TT_MAIN.SetToolTip(Me.OPT_GROUP, "Download groups")
Me.OPT_GROUP.UseVisualStyleBackColor = True
'
'TXT_TIMER
'TXT_GROUPS
'
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Refresh"
Me.TXT_TIMER.Buttons.Add(ActionButton3)
Me.TXT_TIMER.CaptionText = "Timer"
Me.TXT_TIMER.CaptionToolTipEnabled = True
Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)"
Me.TXT_TIMER.CaptionWidth = 50.0R
Me.TXT_TIMER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TIMER.Location = New System.Drawing.Point(4, 282)
Me.TXT_TIMER.Name = "TXT_TIMER"
Me.TXT_TIMER.Size = New System.Drawing.Size(468, 22)
Me.TXT_TIMER.TabIndex = 3
'
'LBL_LAST_TIME_UP
'
Me.LBL_LAST_TIME_UP.AutoSize = True
Me.LBL_LAST_TIME_UP.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_LAST_TIME_UP.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Italic, System.Drawing.GraphicsUnit.Point, CType(204, Byte))
Me.LBL_LAST_TIME_UP.Location = New System.Drawing.Point(4, 337)
Me.LBL_LAST_TIME_UP.Name = "LBL_LAST_TIME_UP"
Me.LBL_LAST_TIME_UP.Size = New System.Drawing.Size(468, 25)
Me.LBL_LAST_TIME_UP.TabIndex = 5
Me.LBL_LAST_TIME_UP.Text = "Last download date: "
Me.LBL_LAST_TIME_UP.TextAlign = System.Drawing.ContentAlignment.TopCenter
'
'NUM_DELAY
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Refresh"
Me.NUM_DELAY.Buttons.Add(ActionButton4)
Me.NUM_DELAY.CaptionText = "Delay"
Me.NUM_DELAY.CaptionToolTipEnabled = True
Me.NUM_DELAY.CaptionToolTipText = "Startup delay"
Me.NUM_DELAY.CaptionWidth = 50.0R
Me.NUM_DELAY.ClearTextByButtonClear = False
Me.NUM_DELAY.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
Me.NUM_DELAY.Dock = System.Windows.Forms.DockStyle.Fill
Me.NUM_DELAY.Location = New System.Drawing.Point(4, 311)
Me.NUM_DELAY.Name = "NUM_DELAY"
Me.NUM_DELAY.NumberMaximum = New Decimal(New Integer() {1440, 0, 0, 0})
Me.NUM_DELAY.NumberUpDownAlign = System.Windows.Forms.LeftRightAlignment.Left
Me.NUM_DELAY.Size = New System.Drawing.Size(468, 22)
Me.NUM_DELAY.TabIndex = 4
Me.NUM_DELAY.Text = "0"
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Edit"
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Clear"
Me.TXT_GROUPS.Buttons.Add(ActionButton1)
Me.TXT_GROUPS.Buttons.Add(ActionButton2)
Me.TXT_GROUPS.CaptionText = "Groups"
Me.TXT_GROUPS.CaptionWidth = 50.0R
Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_GROUPS.Lines = New String(-1) {}
Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 224)
Me.TXT_GROUPS.Name = "TXT_GROUPS"
Me.TXT_GROUPS.Size = New System.Drawing.Size(468, 22)
Me.TXT_GROUPS.TabIndex = 1
Me.TXT_GROUPS.TextBoxReadOnly = True
'
'TP_NOTIFY
'
@@ -329,6 +283,55 @@ Namespace DownloadObjects
TT_MAIN.SetToolTip(Me.CH_NOTIFY_SIMPLE, resources.GetString("CH_NOTIFY_SIMPLE.ToolTip"))
Me.CH_NOTIFY_SIMPLE.UseVisualStyleBackColor = True
'
'TXT_TIMER
'
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Refresh"
Me.TXT_TIMER.Buttons.Add(ActionButton3)
Me.TXT_TIMER.CaptionText = "Timer"
Me.TXT_TIMER.CaptionToolTipEnabled = True
Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)"
Me.TXT_TIMER.CaptionWidth = 50.0R
Me.TXT_TIMER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TIMER.Lines = New String(-1) {}
Me.TXT_TIMER.Location = New System.Drawing.Point(4, 282)
Me.TXT_TIMER.Name = "TXT_TIMER"
Me.TXT_TIMER.Size = New System.Drawing.Size(468, 22)
Me.TXT_TIMER.TabIndex = 3
'
'NUM_DELAY
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Refresh"
Me.NUM_DELAY.Buttons.Add(ActionButton4)
Me.NUM_DELAY.CaptionText = "Delay"
Me.NUM_DELAY.CaptionToolTipEnabled = True
Me.NUM_DELAY.CaptionToolTipText = "Startup delay"
Me.NUM_DELAY.CaptionWidth = 50.0R
Me.NUM_DELAY.ClearTextByButtonClear = False
Me.NUM_DELAY.ControlMode = PersonalUtilities.Forms.Controls.TextBoxExtended.ControlModes.NumericUpDown
Me.NUM_DELAY.Dock = System.Windows.Forms.DockStyle.Fill
Me.NUM_DELAY.Lines = New String(-1) {}
Me.NUM_DELAY.Location = New System.Drawing.Point(4, 311)
Me.NUM_DELAY.Name = "NUM_DELAY"
Me.NUM_DELAY.NumberMaximum = New Decimal(New Integer() {1440, 0, 0, 0})
Me.NUM_DELAY.NumberUpDownAlign = System.Windows.Forms.LeftRightAlignment.Left
Me.NUM_DELAY.Size = New System.Drawing.Size(468, 22)
Me.NUM_DELAY.TabIndex = 4
Me.NUM_DELAY.Text = "0"
'
'LBL_LAST_TIME_UP
'
Me.LBL_LAST_TIME_UP.AutoSize = True
Me.LBL_LAST_TIME_UP.Dock = System.Windows.Forms.DockStyle.Fill
Me.LBL_LAST_TIME_UP.Font = New System.Drawing.Font("Microsoft Sans Serif", 8.25!, System.Drawing.FontStyle.Italic, System.Drawing.GraphicsUnit.Point, CType(204, Byte))
Me.LBL_LAST_TIME_UP.Location = New System.Drawing.Point(4, 337)
Me.LBL_LAST_TIME_UP.Name = "LBL_LAST_TIME_UP"
Me.LBL_LAST_TIME_UP.Size = New System.Drawing.Size(468, 25)
Me.LBL_LAST_TIME_UP.TabIndex = 5
Me.LBL_LAST_TIME_UP.Text = "Last download date: "
Me.LBL_LAST_TIME_UP.TextAlign = System.Drawing.ContentAlignment.TopCenter
'
'AutoDownloaderEditorForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -343,6 +346,7 @@ Namespace DownloadObjects
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(492, 427)
Me.Name = "AutoDownloaderEditorForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "AutoDownloader settings"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
@@ -350,13 +354,13 @@ Namespace DownloadObjects
CONTAINER_MAIN.PerformLayout()
Me.DEF_GROUP.ResumeLayout(False)
Me.DEF_GROUP.PerformLayout()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).EndInit()
TP_MODE.ResumeLayout(False)
TP_MODE.PerformLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).EndInit()
TP_NOTIFY.ResumeLayout(False)
TP_NOTIFY.PerformLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub

View File

@@ -120,6 +120,15 @@
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_MODE.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
@@ -187,15 +196,14 @@
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="TP_MODE.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<metadata name="TP_NOTIFY.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<data name="CH_NOTIFY_SIMPLE.ToolTip" xml:space="preserve">
<value>Show a simple notification instead of a user notification.
This means that if any user data has been downloaded with the plan, a simple notification will be shown with the number of users downloaded.
The 'Image' and 'User icon' parameters will be ignored.</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
@@ -228,12 +236,4 @@
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<metadata name="TP_NOTIFY.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="CH_NOTIFY_SIMPLE.ToolTip" xml:space="preserve">
<value>Show a simple notification instead of a user notification.
This means that if any user data has been downloaded with the plan, a simple notification will be shown with the number of users downloaded.
The 'Image' and 'User icon' parameters will be ignored.</value>
</data>
</root>

View File

@@ -92,34 +92,39 @@ Namespace DownloadObjects
BTT_PAUSE_H6.Click, BTT_PAUSE_H12.Click,
BTT_PAUSE_UNTIL.Click, BTT_PAUSE_UNLIMITED.Click,
BTT_PAUSE_DISABLE.Click
If (Place = ButtonsPlace.Scheduler And PlanIndex >= 0 And PlanIndex.ValueBetween(0, Settings.Automation.Count - 1)) Or Not Place = ButtonsPlace.Scheduler Then
Dim p As PauseModes = CInt(AConvert(Of Integer)(Sender.Tag, -10))
If p > -10 Then
Dim d As Date? = Nothing
Dim _SetPauseValue As Action = Sub()
If Place = ButtonsPlace.Scheduler And PlanIndex.ValueBetween(0, Settings.Automation.Count - 1) Then
Settings.Automation(PlanIndex).Pause(d) = p
ElseIf Not Place = ButtonsPlace.Scheduler Then
Settings.Automation.Pause(d) = p
End If
End Sub
If p = PauseModes.Until Then
Using f As New DateTimeSelectionForm(TimeSelectionModes.End + TimeSelectionModes.Date + TimeSelectionModes.Time, Settings.Design)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then d = f.MyDateEnd
End Using
If d.HasValue Then _SetPauseValue.Invoke
Else
_SetPauseValue.Invoke
End If
UpdatePauseButtons()
Dim p As PauseModes = CInt(AConvert(Of Integer)(Sender.Tag, -10))
If p > -10 AndAlso ((Place = ButtonsPlace.Scheduler And PlanIndex >= 0 And PlanIndex.ValueBetween(0, Settings.Automation.Count - 1)) OrElse
Not Place = ButtonsPlace.Scheduler OrElse
(Place = ButtonsPlace.Scheduler AndAlso PlanIndex = -1 AndAlso
MsgBoxE({$"Do you want to turn {IIf(p = PauseModes.Disabled, "off", "on")} pause for all plans?", "Pause plan"},
vbExclamation + vbYesNo) = vbYes)) Then
Dim d As Date? = Nothing
Dim _SetPauseValue As Action = Sub()
If Place = ButtonsPlace.Scheduler And PlanIndex.ValueBetween(0, Settings.Automation.Count - 1) Then
Settings.Automation(PlanIndex).Pause(d) = p
ElseIf Not Place = ButtonsPlace.Scheduler Or Place = ButtonsPlace.Scheduler And PlanIndex = -1 Then
Settings.Automation.Pause(d) = p
End If
End Sub
If p = PauseModes.Until Then
Using f As New DateTimeSelectionForm(TimeSelectionModes.End + TimeSelectionModes.Date + TimeSelectionModes.Time, Settings.Design)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then d = f.MyDateEnd
End Using
If d.HasValue Then _SetPauseValue.Invoke
Else
_SetPauseValue.Invoke
End If
ElseIf Place = ButtonsPlace.Scheduler And PlanIndex = -1 Then
UpdatePauseButtons()
ElseIf p > -10 And Place = ButtonsPlace.Scheduler And PlanIndex = -1 Then
MsgBoxE({"The plan to be paused is not selected", "Pause plan"}, vbExclamation)
End If
End Sub
#End Region
#Region "Update buttons"
Friend Overloads Sub UpdatePauseButtons_Handler(ByVal Value As PauseModes)
UpdatePauseButtons()
End Sub
Friend Overloads Sub UpdatePauseButtons() Handles TrayButtons.Updating
UpdatePauseButtons(True)
End Sub

View File

@@ -14,12 +14,14 @@ 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 Event PauseDisabled As AutoDownloader.PauseDisabledEventHandler
Private Sub OnPauseDisabled()
RaiseEvent PauseDisabled()
Friend Event PauseChanged As AutoDownloader.PauseChangedEventHandler
Private Sub OnPauseChanged(ByVal Value As PauseModes)
RaiseEvent PauseChanged(Pause)
End Sub
Private ReadOnly Plans As List(Of AutoDownloader)
Private ReadOnly File As SFile = $"Settings\AutoDownload.xml"
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))
@@ -27,20 +29,9 @@ Namespace DownloadObjects
End Sub
Friend Sub New()
Plans = New List(Of AutoDownloader)
If File.Exists Then
Using x As New XmlFile(File,, False) With {.AllowSameNames = True}
x.LoadData()
If x.Contains(Name_Plan) Then
For Each e In x : Plans.Add(New AutoDownloader(e)) : Next
Else
Plans.Add(New AutoDownloader(x))
End If
End Using
End If
If Plans.Count > 0 Then Plans.ForEach(Sub(p)
p.Source = Me
AddHandler p.PauseDisabled, AddressOf OnPauseDisabled
End Sub) : Plans.ListReindex
File = Settings.AutomationFile.Value.IfNullOrEmpty(FileDefault)
If Not File.Exists Then File = FileDefault
Reset(File, True)
End Sub
Default Friend ReadOnly Property Item(ByVal Index As Integer) As AutoDownloader Implements IMyEnumerator(Of AutoDownloader).MyEnumeratorObject
Get
@@ -62,7 +53,7 @@ Namespace DownloadObjects
End Function
Friend Sub Add(ByVal Plan As AutoDownloader)
Plan.Source = Me
AddHandler Plan.PauseDisabled, AddressOf OnPauseDisabled
AddHandler Plan.PauseChanged, AddressOf OnPauseChanged
Plans.Add(Plan)
Plans.ListReindex
Update()
@@ -96,6 +87,39 @@ Namespace DownloadObjects
Catch
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
Pause = PauseModes.Unlimited
If Plans.Exists(PlanWorking) 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
Return False
End If
End If
[Stop]()
If _UpdateRequired Then Update()
Plans.ListClearDispose(,, EDP.LogMessageValue)
End If
If f.Exists Then
File = f
Using x As New XmlFile(File,, False) With {.AllowSameNames = True}
x.LoadData()
If x.Contains(Name_Plan) Then
For Each e In x : Plans.Add(New AutoDownloader(e)) : Next
Else
Plans.Add(New AutoDownloader(x))
End If
End Using
If Plans.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
End Sub) : Plans.ListReindex
End If
Return True
End Function
#Region "Groups Support"
Friend Sub GROUPS_Updated(ByVal Sender As DownloadGroup)
If Count > 0 Then Plans.ForEach(Sub(p) p.GROUPS_Updated(Sender))

View File

@@ -63,7 +63,8 @@ Namespace DownloadObjects
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(430, 380)
Me.Name = "SchedulerEditorForm"
Me.ShowIcon = False
Me.ShowIcon = True
Me.ShowInTaskbar = False
Me.Text = "Scheduler"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)

View File

@@ -8,10 +8,15 @@
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools
Imports ECI = PersonalUtilities.Forms.Toolbars.EditToolbar.ControlItem
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Namespace DownloadObjects
Friend Class SchedulerEditorForm
#Region "Declarations"
Private WithEvents MyDefs As DefaultFormOptions
Private WithEvents BTT_SETTINGS As ToolStripButton
Private WithEvents BTT_CLONE As ToolStripButton
Private ReadOnly MENU_SKIP As ToolStripDropDownButton
Private WithEvents BTT_SKIP As ToolStripMenuItem
Private WithEvents BTT_SKIP_MIN As ToolStripMenuItem
@@ -26,6 +31,20 @@ Namespace DownloadObjects
Friend Sub New()
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, Settings.Design)
BTT_SETTINGS = New ToolStripButton With {
.Text = String.Empty,
.AutoToolTip = True,
.ToolTipText = "Change scheduler",
.DisplayStyle = ToolStripItemDisplayStyle.Image,
.Image = My.Resources.ScriptPic_32
}
BTT_CLONE = New ToolStripButton With {
.Text = "Clone",
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText,
.Image = My.Resources.PlusPic_24,
.ToolTipText = "Create a copy of the selected plan",
.AutoToolTip = True
}
MENU_SKIP = New ToolStripDropDownButton With {
.Text = "Skip",
.ToolTipText = String.Empty,
@@ -80,13 +99,15 @@ Namespace DownloadObjects
}
PauseArr = New AutoDownloaderPauseButtons(AutoDownloaderPauseButtons.ButtonsPlace.Scheduler) With {
.MainFrameButtonsInstance = MainFrameObj.PauseButtons}
Icon = ImageRenderer.GetIcon(My.Resources.ScriptPic_32, EDP.ReturnValue)
End Sub
#End Region
#Region "Form handlers"
Private Sub SchedulerEditorForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
.AddEditToolbarPlus({New ToolStripSeparator, BTT_START, BTT_START_FORCE, MENU_SKIP, BTT_PAUSE})
.AddEditToolbar({BTT_SETTINGS, ECI.Separator, ECI.Add, BTT_CLONE, ECI.Edit, ECI.Delete, ECI.Update, ECI.Separator,
BTT_START, BTT_START_FORCE, MENU_SKIP, BTT_PAUSE})
PauseArr.AddButtons(BTT_PAUSE, .MyEditToolbar.ToolStrip)
Refill()
.EndLoaderOperations(False)
@@ -118,17 +139,24 @@ Namespace DownloadObjects
End Try
End Sub
#Region "Add, Edit, Delete"
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
Dim a As New AutoDownloader(True)
Using f As New AutoDownloaderEditorForm(a)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
Settings.Automation.Add(a)
Refill()
Else
a.Dispose()
End If
End Using
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EventArgs) Handles MyDefs.ButtonAddClick, BTT_CLONE.Click
Dim a As AutoDownloader = Nothing
If Sender Is BTT_CLONE Then
If _LatestSelected.ValueBetween(0, Settings.Automation.Count - 1) Then a = Settings.Automation(_LatestSelected).Copy
Else
a = New AutoDownloader(True)
End If
If Not a Is Nothing Then
Using f As New AutoDownloaderEditorForm(a)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
Settings.Automation.Add(a)
Refill()
Else
a.Dispose()
End If
End Using
End If
End Sub
Private Sub Edit() Handles MyDefs.ButtonEditClick
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
@@ -170,7 +198,80 @@ Namespace DownloadObjects
Edit()
End Sub
#End Region
#Region "Start, Skip, Pause"
#Region "Settings, Start, Skip, Pause"
Private Sub BTT_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS.Click
Const msgTitle$ = "Change scheduler"
Try
Const defName$ = "Default"
Dim l As New Dictionary(Of SFile, String)
With SFile.GetFiles(SettingsFolderName.CSFileP, $"{Scheduler.FileNameDefault}*.xml",, EDP.ReturnValue)
If .ListExists Then .ForEach(Sub(ff) l.Add(ff, ff.Name.Replace(Scheduler.FileNameDefault, String.Empty).StringTrimStart("_").IfNullOrEmpty(defName)))
End With
If l.Count > 0 Then
Using chooser As New SimpleListForm(Of String)(l.Values.Cast(Of String), Settings.Design) With {
.DesignXMLNodeName = "SchedulerChooserForm",
.Icon = PersonalUtilities.Tools.ImageRenderer.GetIcon(My.Resources.ScriptPic_32, EDP.ReturnValue),
.FormText = "Schedulers",
.Mode = SimpleListFormModes.SelectedItems,
.MultiSelect = False
}
With chooser
Dim i%
Dim f As SFile
Dim selectedName$
Dim addedObj$ = String.Empty
.ClearButtons()
.Buttons = {ADB.Add, ADB.Delete}
AddHandler .AddClick, Sub(ByVal obj As Object, ByVal args As SimpleListFormEventArgs)
If addedObj.IsEmptyString Then
addedObj = InputBoxE("Enter a new scheduler name:", msgTitle)
args.Result = Not addedObj.IsEmptyString
If args.Result Then args.Item = addedObj
Else
MsgBoxE({"You can only create one scheduler at a time", "Create a new scheduler"}, vbCritical)
End If
End Sub
If Settings.Automation.File.Name = Scheduler.FileNameDefault Then
.DataSelectedIndexes.Add(0)
Else
i = l.Keys.ListIndexOf(Function(ff) ff = Settings.Automation.File)
If i >= 0 Then .DataSelectedIndexes.Add(i)
End If
If .ShowDialog() = DialogResult.OK Then
selectedName = .DataResult.FirstOrDefault
If Not selectedName.IsEmptyString Then
If selectedName = defName Then
f = Settings.Automation.FileDefault
Else
f = $"{SettingsFolderName}\{Scheduler.FileNameDefault}_{selectedName.StringRemoveWinForbiddenSymbols}.xml"
End If
If Not Settings.Automation.File = f AndAlso Settings.Automation.Reset(f, False) Then
Settings.Automation.File = f
If selectedName = defName Then
Settings.AutomationFile.Value = Nothing
Else
Settings.AutomationFile.Value = f
End If
PauseArr.UpdatePauseButtons()
Refill()
If Not .DataSource.Count = l.Count Then
For i = l.Count - 1 To 0 Step -1
If Not .DataSource.Contains(l(l.Keys(i))) Then l.Keys(i).Delete(, SFODelete.DeleteToRecycleBin, EDP.SendToLog)
Next
End If
End If
End If
End If
End With
End Using
l.Clear()
Else
MsgBoxE({"There are no plans created", msgTitle}, vbExclamation)
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, msgTitle)
End Try
End Sub
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

View File

@@ -123,7 +123,7 @@ Namespace DownloadObjects
With Downloader.Downloaded
If .Count > 0 Then
With .Select(Function(u) Settings.GetUser(u, False)).Reverse
If _UsersListSession.Count > 0 Then _UsersListSession.ListWithRemove(.Self)
If _UsersListSession.Count > 0 Then _UsersListSession.ListWithRemove(.Self, New ListAddParams With {.DisableDispose = True})
If _UsersListSession.Count > 0 Then
_UsersListSession.InsertRange(0, .Self)
Else
@@ -165,33 +165,45 @@ Namespace DownloadObjects
#End Region
#Region "Toolbar controls"
Private Sub MENU_VIEW_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles MENU_VIEW_SESSION.Click, MENU_VIEW_ALL.Click
Dim __refill As Boolean = False
Dim clicked As ToolStripMenuItem = Sender
Dim other As ToolStripMenuItem = If(Sender Is MENU_VIEW_SESSION, MENU_VIEW_ALL, MENU_VIEW_SESSION)
If other.Checked Then
clicked.Checked = True
other.Checked = False
__refill = True
Else
clicked.Checked = False
End If
ViewMode = IIf(MENU_VIEW_SESSION.Checked, ViewModes.Session, ViewModes.All)
ControlInvokeFast(ToolbarTOP, BTT_CLEAR, Sub() BTT_CLEAR.Visible = ViewMode = ViewModes.Session)
If __refill Then RefillList()
Try
Dim __refill As Boolean = False
Dim clicked As ToolStripMenuItem = Sender
Dim other As ToolStripMenuItem = If(Sender Is MENU_VIEW_SESSION, MENU_VIEW_ALL, MENU_VIEW_SESSION)
ControlInvokeFast(ToolbarTOP, clicked, Sub()
If other.Checked Then
clicked.Checked = True
other.Checked = False
__refill = True
Else
clicked.Checked = False
End If
ViewMode = IIf(MENU_VIEW_SESSION.Checked, ViewModes.Session, ViewModes.All)
BTT_CLEAR.Visible = ViewMode = ViewModes.Session
End Sub, EDP.SendToLog)
If __refill Then RefillList()
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "DownloadedInfoForm.ViewChange")
End Try
End Sub
Private Sub OPT_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_DEFAULT.Click, OPT_SUBSCRIPTIONS.Click
Dim __refill As Boolean = False
Dim clicked As ToolStripMenuItem = Sender
Dim other As ToolStripMenuItem = If(Sender Is OPT_DEFAULT, OPT_SUBSCRIPTIONS, OPT_DEFAULT)
If other.Checked Then
clicked.Checked = True
other.Checked = False
__refill = True
Else
clicked.Checked = False
End If
Settings.InfoViewDefault.Value = OPT_DEFAULT.Checked
If __refill Then RefillList()
Try
Dim __refill As Boolean = False
Dim clicked As ToolStripMenuItem = Sender
Dim other As ToolStripMenuItem = If(Sender Is OPT_DEFAULT, OPT_SUBSCRIPTIONS, OPT_DEFAULT)
ControlInvokeFast(ToolbarTOP, clicked, Sub()
If other.Checked Then
clicked.Checked = True
other.Checked = False
__refill = True
Else
clicked.Checked = False
End If
End Sub, EDP.SendToLog)
Settings.InfoViewDefault.Value = OPT_DEFAULT.Checked
If __refill Then RefillList()
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "DownloadedInfoForm.SubscriptionChange")
End Try
End Sub
Private Sub BTT_FIND_Click(sender As Object, e As EventArgs) Handles BTT_FIND.Click
Try : RaiseEvent UserFind(If(Settings.GetUser(SelectedUser, True)?.Key, String.Empty)) : Catch : End Try

View File

@@ -39,6 +39,7 @@ Namespace DownloadObjects
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.BTT_CLEAR = New System.Windows.Forms.ToolStripButton()
Me.TP_DATA = New System.Windows.Forms.TableLayoutPanel()
Me.BTT_LOAD_SESSION_CURRENT = 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()
@@ -89,7 +90,7 @@ Namespace DownloadObjects
'MENU_LOAD_SESSION
'
Me.MENU_LOAD_SESSION.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_LAST, Me.BTT_LOAD_SESSION_CHOOSE})
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})
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"
@@ -130,7 +131,7 @@ Namespace DownloadObjects
'
Me.BTT_DOWN_ALL.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_DOWN_ALL.Name = "BTT_DOWN_ALL"
Me.BTT_DOWN_ALL.Size = New System.Drawing.Size(180, 22)
Me.BTT_DOWN_ALL.Size = New System.Drawing.Size(174, 22)
Me.BTT_DOWN_ALL.Tag = "a"
Me.BTT_DOWN_ALL.Text = "Download ALL"
'
@@ -138,7 +139,7 @@ Namespace DownloadObjects
'
Me.BTT_DOWN_SELECTED.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_DOWN_SELECTED.Name = "BTT_DOWN_SELECTED"
Me.BTT_DOWN_SELECTED.Size = New System.Drawing.Size(180, 22)
Me.BTT_DOWN_SELECTED.Size = New System.Drawing.Size(174, 22)
Me.BTT_DOWN_SELECTED.Tag = "s"
Me.BTT_DOWN_SELECTED.Text = "Download selected"
'
@@ -185,6 +186,13 @@ Namespace DownloadObjects
Me.TP_DATA.Size = New System.Drawing.Size(484, 436)
Me.TP_DATA.TabIndex = 1
'
'BTT_LOAD_SESSION_CURRENT
'
Me.BTT_LOAD_SESSION_CURRENT.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_LOAD_SESSION_CURRENT.Name = "BTT_LOAD_SESSION_CURRENT"
Me.BTT_LOAD_SESSION_CURRENT.Size = New System.Drawing.Size(189, 22)
Me.BTT_LOAD_SESSION_CURRENT.Text = "Load current session"
'
'DownloadFeedForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -218,5 +226,6 @@ Namespace DownloadObjects
Private WithEvents MENU_DOWN As ToolStripDropDownButton
Private WithEvents BTT_DOWN_ALL As ToolStripMenuItem
Private WithEvents BTT_DOWN_SELECTED As ToolStripMenuItem
Private WithEvents BTT_LOAD_SESSION_CURRENT As ToolStripMenuItem
End Class
End Namespace

View File

@@ -58,8 +58,10 @@ Namespace DownloadObjects
LastWinState = WindowState
With MyRange
.AutoToolTip = True
.Buttons = {RCI.First, RCI.Previous, RCI.Label, RCI.Next, RCI.Last, RCI.Separator, RCI.GoTo}
.ButtonKey(RCI.Previous) = Keys.F3
.ButtonKey(RCI.Next) = Keys.F4
.ButtonKey(RCI.GoTo) = New ButtonKey(Keys.G, True)
.AddThisToolbar()
End With
ToolbarTOP.Items.AddRange({New ToolStripSeparator, BTT_DELETE_SELECTED})
@@ -88,15 +90,7 @@ Namespace DownloadObjects
DataList.Clear()
End Sub
Private Sub DownloadFeedForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
Dim b As Boolean = True
If e.KeyCode = Keys.F5 Then
RefillList()
ElseIf e.Control And e.KeyCode = Keys.G Then
MyRange.GoToF()
Else
b = False
End If
If b Then e.Handled = True
If e.KeyCode = Keys.F5 Then RefillList() : e.Handled = True
End Sub
#End Region
#Region "Settings"
@@ -187,6 +181,9 @@ Namespace DownloadObjects
ClearTable()
RefillList()
End Sub
Private Sub BTT_LOAD_SESSION_CURRENT_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CURRENT.Click
RefillList()
End Sub
Private Sub BTT_LOAD_SESSION_LAST_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_LAST.Click
SessionChooser(True)
End Sub
@@ -195,6 +192,7 @@ Namespace DownloadObjects
End Sub
Private Sub SessionChooser(ByVal GetLast As Boolean)
Try
Downloader.ClearSessions()
Dim f As SFile = TDownloader.SessionsPath.CSFileP
Dim fList As List(Of SFile) = Nothing
Dim m As New MMessage("Saved sessions not selected", "Sessions",, vbExclamation)
@@ -208,13 +206,23 @@ Namespace DownloadObjects
DataList.RemoveAll(FileNotExist)
End If
End Sub
If Not GetLast AndAlso f.Exists(SFO.Path, False) Then fList = SFile.GetFiles(f, "*.xml",, EDP.ReturnValue)
Dim __getFiles As Func(Of Boolean) = Function() As Boolean
If f.Exists(SFO.Path, False) Then fList = SFile.GetFiles(f, "*.xml",, EDP.ReturnValue)
If fList.ListExists Then
fList.Reverse()
Return True
Else
Return False
End If
End Function
If Not GetLast Then __getFiles.Invoke
If Not GetLast AndAlso fList.ListExists Then
Using chooser As New SimpleListForm(Of SFile)(fList, Settings.Design) With {
.FormText = "Sessions",
.Icon = My.Resources.ArrowDownIcon_Blue_24,
.Mode = SimpleListFormModes.CheckedItems,
.Provider = New CustomProvider(Function(v, d, p, n, ee) DirectCast(v, SFile).File)
.Provider = New CustomProvider(Function(v As SFile) AConvert(Of String)(AConvert(Of Date)(v.Name, SessionDateTimeProvider, v.Name),
DateTimeDefaultProvider, v.Name))
}
chooser.ClearButtons()
If chooser.ShowDialog = DialogResult.OK Then
@@ -236,8 +244,13 @@ Namespace DownloadObjects
MsgBoxE(m)
End If
End Using
ElseIf Downloader.FilesSessionActual.Exists Then
x = New XmlFile(Downloader.FilesSessionActual,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
ElseIf Downloader.FilesSessionActual(False).Exists OrElse __getFiles.Invoke Then
If Downloader.FilesSessionActual(False).Exists Then
f = Downloader.FilesSessionActual(False)
Else
f = fList(0)
End If
x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then DataList.Clear() : DataList.ListAddList(x, lcr)
x.Dispose()

View File

@@ -61,7 +61,6 @@ Namespace DownloadObjects
End Property
Private ReadOnly UserKey As String
Friend ReadOnly Post As UserMedia
Private ReadOnly Media As UserMediaD
Friend Property Checked As Boolean
Get
Return CH_CHECKED.Checked
@@ -106,11 +105,15 @@ Namespace DownloadObjects
Me.Width = Width
End If
End Sub
Private Sub ApplyColors()
Private Sub ApplyColors(ByVal Media As UserMediaD)
Dim b As Color? = Nothing, f As Color? = Nothing
If Not Media.User Is Nothing Then
If Media.User.BackColor.HasValue Then b = Media.User.BackColor
If Media.User.ForeColor.HasValue Then f = Media.User.ForeColor
If Media.User.IsSubscription And Media.User.IsUser Then
If Not b.HasValue And Settings.MainFrameUsersSubscriptionsColorBack_USERS.Exists Then b = Settings.MainFrameUsersSubscriptionsColorBack_USERS.Value
If Not f.HasValue And Settings.MainFrameUsersSubscriptionsColorFore_USERS.Exists Then f = Settings.MainFrameUsersSubscriptionsColorFore_USERS.Value
End If
End If
If Not b.HasValue And Settings.FeedBackColor.Exists Then b = Settings.FeedBackColor.Value
If Not f.HasValue And Settings.FeedForeColor.Exists Then f = Settings.FeedForeColor.Value
@@ -158,7 +161,6 @@ Namespace DownloadObjects
Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Height As Integer)
Try
InitializeComponent()
Me.Media = Media
IsSubscription = If(Media.User?.IsSubscription, False)
If IsSubscription Then
@@ -179,8 +181,9 @@ Namespace DownloadObjects
Dim ext$ = Media.Data.URL.CSFile.Extension
Dim imgFile As New SFile With {.Path = Settings.Cache.RootDirectory.Path}
With Media.User
imgFile.Name = $"{IIf(.IncludedInCollection, "{.CollectionName}", String.Empty)}{ .Site}{ .Name}_"
imgFile.Name = $"{IIf(.IncludedInCollection, .CollectionName, String.Empty)}{ .Site}{ .Name}_"
imgFile.Name &= (CLng(Media.Data.URL.GetHashCode) + CLng(Media.Data.File.GetHashCode)).ToString
imgFile.Name = imgFile.Name.StringRemoveWinForbiddenSymbols
imgFile.Extension = ExtJpg
If Not imgFile.Exists AndAlso Not ext.IsEmptyString AndAlso ext.ToLower = ExtWebp Then imgFile.Extension = ExtWebp
End With
@@ -290,7 +293,7 @@ Namespace DownloadObjects
Size = s
MinimumSize = s
MaximumSize = s
ApplyColors()
ApplyColors(Media)
Else
Throw New ArgumentNullException With {.HelpLink = 1}
End If

View File

@@ -25,6 +25,7 @@ Namespace DownloadObjects.Groups
Private ReadOnly SEP_1 As ToolStripSeparator
Private WithEvents BTT_MENU As ToolStripMenuItem
#End Region
Private File As SFile = Nothing
Friend Property NameBefore As String = String.Empty
Private _Key As String = String.Empty
Friend ReadOnly Property Key As String
@@ -111,7 +112,7 @@ Namespace DownloadObjects.Groups
#End Region
#Region "Buttons"
Private Sub BTT_MENU_Click(sender As Object, e As EventArgs) Handles BTT_MENU.Click
DownloadUsers(True)
DownloadUsers()
End Sub
Private Sub BTT_EDIT_Click(sender As Object, e As EventArgs) Handles BTT_EDIT.Click
Using f As New GroupEditorForm(Me)
@@ -126,24 +127,39 @@ Namespace DownloadObjects.Groups
End If
End Sub
Private Sub BTT_DOWNLOAD_Click(sender As Object, e As EventArgs) Handles BTT_DOWNLOAD.Click
DownloadUsers(True)
DownloadUsers()
End Sub
Private Sub BTT_DOWNLOAD_FULL_Click(sender As Object, e As EventArgs) Handles BTT_DOWNLOAD_FULL.Click
DownloadUsers(False)
DownloadUsers(, False)
End Sub
#End Region
#Region "Get users"
Friend Overloads Function GetUsers() As IEnumerable(Of IUserData)
Return GetUsers(Me, True)
Return GetUsers(Me)
End Function
Friend Overloads Shared Function GetUsers(ByVal Instance As IGroup, ByVal UseReadyOption As Boolean) As IEnumerable(Of IUserData)
Friend Overloads Shared Function GetUsers(ByVal Instance As IGroup, Optional ByVal UseReadyOption As Boolean = True,
Optional ByVal IncludeNonExistentUsers As Boolean = False,
Optional ByVal OnlyNonExistentUsers As Boolean = False) As IEnumerable(Of IUserData)
Try
If Settings.Users.Count > 0 Then
With Instance
Dim CheckUserExists As Predicate(Of IUserData) = Function(ByVal user As IUserData) As Boolean
If user.Exists Then
If IncludeNonExistentUsers And OnlyNonExistentUsers Then
Return False
Else
Return True
End If
ElseIf IncludeNonExistentUsers Then
Return True
Else
Return False
End If
End Function
Dim CheckParams As Predicate(Of IUserData) = Function(user) _
(.Temporary = CheckState.Indeterminate Or user.Temporary = CBool(.Temporary)) And
(.Favorite = CheckState.Indeterminate Or (user.Favorite = CBool(.Favorite))) And
(Not UseReadyOption Or .ReadyForDownloadIgnore Or user.ReadyForDownload = .ReadyForDownload) And user.Exists
(Not UseReadyOption Or .ReadyForDownloadIgnore Or user.ReadyForDownload = .ReadyForDownload) And CheckUserExists.Invoke(user)
Dim CheckSubscription As Predicate(Of IUserData) = Function(ByVal user As IUserData) As Boolean
If .Subscriptions Then
If .SubscriptionsOnly Then
@@ -196,12 +212,14 @@ Namespace DownloadObjects.Groups
End Function
#End Region
#Region "Download users"
Friend Sub DownloadUsers(ByVal UseReadyOption As Boolean)
Friend Sub DownloadUsers(Optional ByVal IncludeInTheFeed As Boolean = True, Optional ByVal UseReadyOption As Boolean = True,
Optional ByVal IncludeNonExistentUsers As Boolean = False,
Optional ByVal OnlyNonExistentUsers As Boolean = False)
Try
If Settings.Users.Count > 0 Then
Dim u As IEnumerable(Of IUserData) = GetUsers(Me, UseReadyOption)
Dim u As IEnumerable(Of IUserData) = GetUsers(Me, UseReadyOption, IncludeNonExistentUsers, OnlyNonExistentUsers)
If u.ListExists Then
Downloader.AddRange(u, True)
Downloader.AddRange(u, IncludeInTheFeed)
Else
MsgBoxE({$"No users found for group [{Name}].", "No users found"}, vbExclamation)
End If
@@ -211,6 +229,21 @@ Namespace DownloadObjects.Groups
End Try
End Sub
#End Region
#Region "Advanced filter support"
Friend Sub LoadFromFile(ByVal f As SFile)
File = f
If f.Exists Then
Using x As New XmlFile(f) With {.XmlReadOnly = True} : Import(x) : End Using
End If
End Sub
Friend Sub UpdateFile()
Using x As New XmlFile
Export(x)
x.Name = "AdvancedFilter"
x.Save(File)
End Using
End Sub
#End Region
#Region "IEContainerProvider Support"
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return Export(New EContainer("Group"))

View File

@@ -83,7 +83,7 @@ Namespace DownloadObjects.Groups
End Using
End Sub
Friend Function DownloadGroupIfExists(ByVal Index As Integer) As Boolean
If Index.ValueBetween(0, Count - 1) Then Item(Index).DownloadUsers(True) : Return True Else Return False
If Index.ValueBetween(0, Count - 1) Then Item(Index).DownloadUsers() : Return True Else Return False
End Function
Friend Function IndexOf(ByVal Name As String) As Integer
If Count > 0 Then

View File

@@ -156,6 +156,10 @@ Namespace DownloadObjects.Groups
Controls.Add(TXT_LABELS, 0, 6)
Controls.Add(TXT_SITES, 0, 7)
End Sub
Friend Sub HideName()
Controls.Remove(TXT_NAME)
RowStyles(1).Height = 0
End Sub
Private Sub NUM_USERS_COUNT_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles NUM_USERS_COUNT.ActionOnButtonClick
If Sender.DefaultButton = ADB.Clear Then NUM_USERS_COUNT.Value = 0
End Sub

View File

@@ -11,6 +11,8 @@ Namespace DownloadObjects.Groups
Friend Class GroupEditorForm
Private WithEvents MyDefs As DefaultFormOptions
Friend Property MyGroup As DownloadGroup
Friend Property DownloadMode As Boolean = False
Friend Property FilterMode As Boolean = False
Friend Sub New(ByRef g As DownloadGroup)
InitializeComponent()
MyGroup = g
@@ -50,12 +52,27 @@ Namespace DownloadObjects.Groups
DEFS_GROUP.Set(MyGroup)
Text &= $" { .Name}"
End With
ElseIf DownloadMode Then
Text = "Download options"
ElseIf FilterMode Then
Text = "Filter options"
Else
Text = "New Group"
End If
.MyFieldsChecker = New FieldsChecker
.MyFieldsCheckerE.AddControl(Of String)(DEFS_GROUP.TXT_NAME, DEFS_GROUP.TXT_NAME.CaptionText,,
New NameChecker(If(MyGroup?.Name, String.Empty), Settings.Groups, "Group"))
If DownloadMode Or FilterMode Then
DEFS_GROUP.HideName()
Dim s As Size = Size
s.Height -= 31
MaximumSize = Nothing
MinimumSize = Nothing
Size = s
MinimumSize = s
MaximumSize = s
Else
.MyFieldsCheckerE.AddControl(Of String)(DEFS_GROUP.TXT_NAME, DEFS_GROUP.TXT_NAME.CaptionText,,
New NameChecker(If(MyGroup?.Name, String.Empty), Settings.Groups, "Group"))
End If
.MyFieldsChecker.EndLoaderOperations()
.EndLoaderOperations()
End With

View File

@@ -22,7 +22,7 @@ Namespace DownloadObjects.Groups
Property SubscriptionsOnly As Boolean
Property UsersCount As Integer
End Interface
Friend Class GroupParameters : Implements IGroup, IDisposable
Friend Class GroupParameters : Implements IGroup, IDisposable, ICopier
Protected Const Name_Name As String = "Name"
Protected Const Name_Temporary As String = "Temporary"
Protected Const Name_Favorite As String = "Favorite"
@@ -53,6 +53,28 @@ Namespace DownloadObjects.Groups
Sites = New List(Of String)
SitesExcluded = New List(Of String)
End Sub
#Region "ICopier Support"
Friend Overridable Overloads Function Copy() As Object Implements ICopier.Copy
Return (New GroupParameters).Copy(Me)
End Function
Friend Overridable Overloads Function Copy(ByVal Source As Object) As Object Implements ICopier.Copy
With DirectCast(Source, GroupParameters)
Name = .Name
Labels.ListAddList(.Labels, LAP.ClearBeforeAdd)
LabelsExcluded.ListAddList(.LabelsExcluded, LAP.ClearBeforeAdd)
Sites.ListAddList(.Sites, LAP.ClearBeforeAdd)
SitesExcluded.ListAddList(.SitesExcluded, LAP.ClearBeforeAdd)
Temporary = .Temporary
Favorite = .Favorite
ReadyForDownload = .ReadyForDownload
ReadyForDownloadIgnore = .ReadyForDownloadIgnore
Subscriptions = .Subscriptions
SubscriptionsOnly = .SubscriptionsOnly
UsersCount = .UsersCount
End With
Return Source
End Function
#End Region
Protected Sub Import(ByVal e As EContainer)
Name = e.Value(Name_Name)
Temporary = e.Value(Name_Temporary).FromXML(Of Integer)(CInt(CheckState.Indeterminate))

View File

@@ -22,7 +22,7 @@ Namespace DownloadObjects
Private WithEvents BTT_INFO As ToolStripButton
#End Region
#Region "Initializer"
Friend Sub New()
Public Sub New()
InitializeComponent()
MUsers = New List(Of IUserData)
MyDefs = New DefaultFormOptions(Me, Settings.Design)

View File

@@ -121,7 +121,6 @@ Namespace DownloadObjects.STDownloader
If isArr Then
Dim urls As List(Of String) = Nothing
Dim cntAdded As Boolean = False
If isExternal Then urls = New List(Of String)(ExternalUrlsTemp)
Using fa As New DownloaderUrlsArrForm(urls)
fa.ShowDialog()
@@ -143,10 +142,9 @@ Namespace DownloadObjects.STDownloader
For Each url In urls
If Not TryYouTube.Invoke Then
media = FindSource(url, output)
If Not media Is Nothing Then ControlCreateAndAdd(media, True) : cntAdded = True
If Not media Is Nothing Then ControlCreateAndAdd(media, disableDown)
End If
Next
If cntAdded And Settings.STDownloader_DownloadAutomatically Then BTT_DOWN.PerformClick()
urls.Clear()
Else
MsgBoxE({"There are no valid URLs in the list", "Add URLs array"}, vbCritical)

View File

@@ -88,14 +88,20 @@ Namespace DownloadObjects
Friend ReadOnly Property Files As List(Of UserMediaD)
Friend Property FilesChanged As Boolean = False
Private ReadOnly FilesLP As New ListAddParams(LAP.NotContainsOnly)
Private FilesLastSessionBackedup As Boolean = False
Friend Const SessionsPath As String = "Settings\Sessions\"
Friend ReadOnly FilesSessionActual As SFile = $"{SessionsPath}Latest.xml"
Private ReadOnly FilesSessionBackup As SFile = $"{SessionsPath}Latest_Backup.xml"
Private _FilesSessionCleared As Boolean = False
Private _FilesSessionActual As SFile = Nothing
Friend ReadOnly Property FilesSessionActual(Optional ByVal GenerateFileName As Boolean = True) As SFile
Get
If _FilesSessionActual.IsEmptyString And GenerateFileName Then _
_FilesSessionActual = $"{SessionsPath}{AConvert(Of String)(Now, SessionDateTimeProvider)}.xml"
Return _FilesSessionActual
End Get
End Property
Private Sub FilesSave()
Try
If Settings.FeedStoreSessionsData And Files.Count > 0 Then
FilesBackupLastSession()
ClearSessions()
Using x As New XmlFile With {.Name = "Session", .AllowSameNames = True}
x.AddRange(Files)
x.Save(FilesSessionActual)
@@ -105,28 +111,43 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.TDownloader.FilesSave]")
End Try
End Sub
Private Sub FilesBackupLastSession()
Friend Sub ClearSessions()
Try
If Not FilesLastSessionBackedup Then
If FilesSessionActual.Exists Then
If FilesSessionBackup.Exists Then
Dim f As SFile = SFile.IndexReindex(FilesSessionBackup)
SFile.Rename(FilesSessionBackup, f)
RemoveLogFiles(FilesSessionBackup, 10)
FilesSessionBackup.Delete()
End If
SFile.Rename(FilesSessionActual, FilesSessionBackup)
If Not _FilesSessionCleared Then
_FilesSessionCleared = True
Dim files As List(Of SFile) = SFile.GetFiles(SessionsPath.CSFileP, "*.xml",, EDP.ReturnValue)
If RenameOldFileNames(files) Then files = SFile.GetFiles(SessionsPath.CSFileP, "*.xml",, EDP.ReturnValue)
Dim filesCount% = Settings.FeedStoredSessionsNumber
If files.ListExists And filesCount > 0 Then
Dim fe As New ErrorsDescriber(EDP.None)
Do While files.Count > filesCount : files(0).Delete(,, fe) : files.RemoveAt(0) : Loop
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.TDownloader.FilesBackupLastSession]")
Finally
FilesLastSessionBackedup = True
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.TDownloader.ClearSessions]")
End Try
End Sub
Private Function RenameOldFileNames(ByVal files As List(Of SFile)) As Boolean
Dim result As Boolean = False
Try
If files.ListExists AndAlso files.Exists(Function(ff) ff.Name.StringToLower.StartsWith("latest")) Then
Dim d As Date
Dim fileCurrent As SFile, fileNew As SFile
For Each fileCurrent In files
If fileCurrent.Name.StringToLower.StartsWith("latest") Then
d = IO.File.GetLastWriteTime(fileCurrent)
fileNew = fileCurrent
fileNew.Name = AConvert(Of String)(d, SessionDateTimeProvider)
SFile.Rename(fileCurrent, fileNew,, EDP.None)
result = True
End If
Next
End If
Catch
End Try
Return result
End Function
#End Region
Friend ReadOnly Property ActiveDownloading As List(Of IUserData)
Friend Property QueueFormOpening As Boolean = False
Friend ReadOnly Property Downloaded As List(Of IUserData)
Private ReadOnly NProv As IFormatProvider
#End Region
@@ -249,6 +270,7 @@ Namespace DownloadObjects
End Sub
Public Overrides Sub Finish()
_Working = False
TokenSource.DisposeIfReady
TokenSource = Nothing
Try
If Not Thread Is Nothing Then
@@ -275,39 +297,46 @@ Namespace DownloadObjects
#Region "Initializer"
Friend Sub New()
Files = New List(Of UserMediaD)
ActiveDownloading = New List(Of IUserData)
Downloaded = New List(Of IUserData)
NProv = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
Pool = New List(Of Job)
End Sub
#End Region
#Region "Pool"
Friend Sub ReconfPool()
If Pool.Count = 0 OrElse Not Pool.Exists(Function(j) j.Working Or j.Count > 0) Then
Dim i%
Pool.ListClearDispose
If Settings.Plugins.Count > 0 Then
Pool.Add(New Job(Download.Main))
For Each p As PluginHost In Settings.Plugins
If p.Settings.IsSeparatedTasks Then
Pool.Add(New Job(Download.Main))
Pool.Last.AddHost(p.Settings)
ElseIf Not p.Settings.TaskGroupName.IsEmptyString Then
i = -1
If Pool.Count > 0 Then i = Pool.FindIndex(Function(pt) pt.GroupName = p.Settings.TaskGroupName)
If i >= 0 Then
Pool(i).AddHost(p.Settings)
Else
Pool.Add(New Job(Download.Main, p.Settings.TaskGroupName))
Friend Sub ReconfPool(Optional ByVal Round As Integer = 0)
Try
If Pool.Count = 0 OrElse Not Pool.Exists(Function(j) j.Working Or j.Count > 0) Then
Dim i%
Pool.ListClearDispose
If Settings.Plugins.Count > 0 Then
Pool.Add(New Job(Download.Main))
For Each p As PluginHost In Settings.Plugins
If p.Settings.IsSeparatedTasks Then
Pool.Add(New Job(Download.Main))
Pool.Last.AddHost(p.Settings)
ElseIf Not p.Settings.TaskGroupName.IsEmptyString Then
i = -1
If Pool.Count > 0 Then i = Pool.FindIndex(Function(pt) pt.GroupName = p.Settings.TaskGroupName)
If i >= 0 Then
Pool(i).AddHost(p.Settings)
Else
Pool.Add(New Job(Download.Main, p.Settings.TaskGroupName))
Pool.Last.AddHost(p.Settings)
End If
Else
Pool(0).AddHost(p.Settings)
End If
Else
Pool(0).AddHost(p.Settings)
End If
Next
Next
End If
RaiseEvent Reconfigured()
End If
RaiseEvent Reconfigured()
End If
Catch ex As Exception
If Round = 0 Then
ReconfPool(Round + 1)
Else
Throw ex
End If
End Try
End Sub
#End Region
#Region "Thread"
@@ -410,9 +439,6 @@ Namespace DownloadObjects
Dim Keys As New List(Of String)
Dim h As Boolean = False
Dim host As SettingsHost = Nothing
Dim waitQueueForm As Action = Sub()
While QueueFormOpening : Thread.Sleep(100) : End While
End Sub
For Each _Item As IUserData In _Job.Items
If Not _Item.Disposed Then
Keys.Add(_Item.Key)
@@ -420,10 +446,8 @@ Namespace DownloadObjects
If host.Source.ReadyToDownload(Download.Main) Then
host.BeforeStartDownload(_Item, Download.Main)
_Job.ThrowIfCancellationRequested()
waitQueueForm.Invoke
DirectCast(_Item, UserDataBase).Progress = _Job.Progress
t.Add(Task.Run(Sub() _Item.DownloadData(Token)))
ActiveDownloading.Add(_Item)
RaiseEvent UserDownloadStateChanged(_Item, True)
i += 1
If i >= limit Then Exit For
@@ -441,12 +465,10 @@ Namespace DownloadObjects
Dim dcc As Boolean = False
If Keys.Count > 0 Then
For Each k$ In Keys
waitQueueForm.Invoke
i = _Job.Items.FindIndex(Function(ii) ii.Key = k)
If i >= 0 Then
With _Job.Items(i)
If DirectCast(.Self, UserDataBase).ContentMissingExists Then MissingPostsDetected = True
If ActiveDownloading.Count > 0 AndAlso ActiveDownloading.Contains(.Self) Then ActiveDownloading.Remove(.Self)
RaiseEvent UserDownloadStateChanged(.Self, False)
host.AfterDownload(.Self, Download.Main)
If Not .Disposed AndAlso Not .IsCollection AndAlso .DownloadedTotal(False) > 0 Then
@@ -531,7 +553,6 @@ Namespace DownloadObjects
[Stop]()
Pool.ListClearDispose
Files.Clear()
ActiveDownloading.Clear()
Downloaded.Clear()
End If
disposedValue = True

View File

@@ -12,10 +12,9 @@ Imports SCrawler.API.Base
Imports PersonalUtilities.Forms
Namespace DownloadObjects
Friend Class UserDownloadQueueForm
Private ReadOnly MyVew As FormView
Private MyVew As FormView
Private ReadOnly Tokens As List(Of CancellationTokenSource)
Private Structure ListUser
Friend ReadOnly User As UserDataBase
Friend IsDownloading As Boolean
Private ReadOnly _UserString As String
Private ReadOnly Property UserString As String
@@ -25,11 +24,10 @@ Namespace DownloadObjects
End Property
Friend ReadOnly Key As String
Friend Sub New(ByVal _User As IUserData)
User = _User
Key = _User.Key
IsDownloading = True
_UserString = DirectCast(User, UserDataBase).ToStringForLog()
If Not User.FriendlyName.IsEmptyString Then _UserString &= $" ({User.FriendlyName})"
_UserString = DirectCast(_User, UserDataBase).ToStringForLog()
If Not _User.FriendlyName.IsEmptyString Then _UserString &= $" ({_User.FriendlyName})"
End Sub
Public Shared Widening Operator CType(ByVal _User As UserDataBase) As ListUser
Return New ListUser(_User)
@@ -47,31 +45,16 @@ Namespace DownloadObjects
End Structure
Public Sub New()
InitializeComponent()
MyVew = New FormView(Me, Settings.Design)
Tokens = New List(Of CancellationTokenSource)
End Sub
Private Sub UserDownloadQueueForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
MyVew.Import()
MyVew.SetFormSize()
With Downloader
.QueueFormOpening = True
If .ActiveDownloading.Count > 0 Then
For Each user As UserDataBase In .ActiveDownloading
ApplyHandlers(user, user.DownloadInProgress)
LIST_QUEUE.Items.Add(New ListUser(user))
Next
End If
AddHandler .UserDownloadStateChanged, AddressOf Downloader_UserDownloadStateChanged
AddHandler .Downloading, AddressOf Downloader_Downloading
.QueueFormOpening = False
End With
Catch aoutex As ArgumentOutOfRangeException
Catch iex As IndexOutOfRangeException
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog + EDP.ShowMainMsg, ex, "Error when opening user download queue form")
Finally
Downloader.QueueFormOpening = False
If MyVew Is Nothing Then
MyVew = New FormView(Me, Settings.Design)
MyVew.Import()
MyVew.SetFormSize()
End If
Catch
End Try
End Sub
Private Sub UserDownloadQueueForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
@@ -79,7 +62,7 @@ Namespace DownloadObjects
Hide()
End Sub
Private Sub UserDownloadQueueForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
MyVew.Dispose()
MyVew.DisposeIfReady
Tokens.ListClearDispose
End Sub
Private Sub UserDownloadQueueForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
@@ -93,45 +76,47 @@ Namespace DownloadObjects
End If
If b Then e.Handled = True
End Sub
Private Sub Downloader_Downloading(ByVal Value As Boolean)
ControlInvokeFast(LIST_QUEUE, Sub() If Not Value Then LIST_QUEUE.Items.Clear() : Tokens.ListClearDispose, EDP.None)
Friend Sub Downloader_Downloading(ByVal Value As Boolean)
Try
If Not Value Then ControlInvokeFast(LIST_QUEUE, Sub()
LIST_QUEUE.Items.Clear()
Tokens.ListClearDispose
End Sub, EDP.None)
Catch
End Try
End Sub
Private Async Sub Downloader_UserDownloadStateChanged(ByVal User As IUserData, ByVal IsDownloading As Boolean)
Await Task.Run(Sub()
Try
ControlInvokeFast(LIST_QUEUE, Sub()
Dim u As New ListUser(User)
ApplyHandlers(User, IsDownloading)
If IsDownloading Then
LIST_QUEUE.Items.Add(u)
Else
LIST_QUEUE.Items.Remove(u)
End If
LIST_QUEUE.Refresh()
End Sub)
Catch ex As Exception
End Try
End Sub)
Friend Sub Downloader_UserDownloadStateChanged(ByVal User As IUserData, ByVal IsDownloading As Boolean)
Try
ControlInvokeFast(LIST_QUEUE, Sub()
Dim u As New ListUser(User)
ApplyHandlers(User, IsDownloading)
If IsDownloading Then
LIST_QUEUE.Items.Add(u)
Else
LIST_QUEUE.Items.Remove(u)
End If
LIST_QUEUE.Refresh()
End Sub, EDP.None)
Catch
End Try
End Sub
Private Async Sub User_UserDownloadStateChanged(ByVal User As IUserData, ByVal IsDownloading As Boolean)
Await Task.Run(Sub()
Try
ControlInvokeFast(LIST_QUEUE,
Sub()
Dim lu As New ListUser(User)
Dim i% = LIST_QUEUE.Items.IndexOf(lu)
If i >= 0 Then
lu = LIST_QUEUE.Items(i)
If Not lu.User Is Nothing And Not lu.IsDownloading = IsDownloading Then
lu.IsDownloading = IsDownloading
LIST_QUEUE.Items(i) = lu
LIST_QUEUE.Refresh()
End If
End If
End Sub)
Catch
End Try
End Sub)
Private Sub User_UserDownloadStateChanged(ByVal User As IUserData, ByVal IsDownloading As Boolean)
Try
ControlInvokeFast(LIST_QUEUE,
Sub()
Dim lu As New ListUser(User)
Dim i% = LIST_QUEUE.Items.IndexOf(lu)
If i >= 0 Then
lu = LIST_QUEUE.Items(i)
If Not lu.Key.IsEmptyString And Not lu.IsDownloading = IsDownloading Then
lu.IsDownloading = IsDownloading
LIST_QUEUE.Items(i) = lu
LIST_QUEUE.Refresh()
End If
End If
End Sub, EDP.None)
Catch
End Try
End Sub
Private Sub ApplyHandlers(ByVal User As IUserData, ByVal IsDownloading As Boolean)
Try
@@ -151,30 +136,33 @@ Namespace DownloadObjects
Const msgTitle$ = "Stop user download"
Try
Dim lu As ListUser = GetUserSelectedUser()
If Not lu.User Is Nothing AndAlso
If Not lu.Key.IsEmptyString AndAlso
MsgBoxE({$"Are you sure you want to stop downloading the following user?{vbCr}{lu}", msgTitle}, vbExclamation + vbYesNo) = vbYes Then
Dim token As New CancellationTokenSource
lu.User.PersonalToken = token.Token
token.Cancel()
Tokens.Add(token)
MsgBoxE({"Cancel user download processed.", msgTitle})
Dim u As IUserData = Settings.GetUser(lu.Key)
If Not u Is Nothing Then
DirectCast(u, UserDataBase).TokenPersonal = token.Token
token.Cancel()
Tokens.Add(token)
End If
End If
Catch ex As Exception
Catch
End Try
End Sub
Private Sub FindUser()
Try
MainFrameObj.FocusUser(GetUserSelectedUser().Key, True)
Catch ex As Exception
End Try
Try : MainFrameObj.FocusUser(GetUserSelectedUser().Key, True) : Catch : End Try
End Sub
Private Function GetUserSelectedUser() As ListUser
Dim lu As ListUser = Nothing
ControlInvokeFast(LIST_QUEUE, Sub()
Dim sIndx% = LIST_QUEUE.SelectedIndex
If sIndx >= 0 Then lu = LIST_QUEUE.Items(sIndx)
End Sub)
Return lu
Try
Dim lu As ListUser = Nothing
ControlInvokeFast(LIST_QUEUE, Sub()
Dim sIndx% = LIST_QUEUE.SelectedIndex
If sIndx >= 0 Then lu = LIST_QUEUE.Items(sIndx)
End Sub, EDP.None)
Return lu
Catch
Return Nothing
End Try
End Function
End Class
End Namespace

View File

@@ -12,9 +12,13 @@ Imports PersonalUtilities.Functions.XML.Objects
Namespace Editors
Public Class ColorPicker : Implements IChangeDetectorCompatible
Private Event DataChanged As EventHandler Implements IChangeDetectorCompatible.DataChanged
Private TT As ToolTip
Public Sub New()
InitializeComponent()
End Sub
Private Sub ColorPicker_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
TT.DisposeIfReady
End Sub
#Region "Appearance"
<Category("Appearance2"), DefaultValue(105)>
Public Property CaptionWidth As Integer
@@ -52,6 +56,20 @@ Namespace Editors
LBL_CAPTION.Text = t
End Set
End Property
Private _TooltipText As String = String.Empty
<Category("Appearance2"), DefaultValue("")>
Public Property TooltipText As String
Get
Return _TooltipText
End Get
Set(ByVal NewText As String)
_TooltipText = NewText
If Not NewText.IsEmptyString Then
If TT Is Nothing Then TT = New ToolTip
TT.SetToolTip(LBL_CAPTION, _TooltipText)
End If
End Set
End Property
#End Region
#Region "Colors"
Private BackColorDefault As Color = DefaultBackColor

View File

@@ -203,6 +203,7 @@ Namespace Editors
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(600, 290)
Me.Name = "GlobalLocationsChooserForm"
Me.ShowInTaskbar = False
Me.Text = "Choose a new location"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)

File diff suppressed because it is too large Load Diff

View File

@@ -121,7 +121,7 @@
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton55.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -132,7 +132,7 @@
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton56.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -143,7 +143,7 @@
<metadata name="TP_IMAGES.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton57.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -151,7 +151,7 @@
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton58.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
@@ -167,7 +167,7 @@
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton59.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
@@ -183,7 +183,7 @@
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton6.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton60.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -197,7 +197,7 @@
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<data name="ActionButton7.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton61.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
@@ -213,42 +213,7 @@
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton8.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton9.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton10.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton11.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton12.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton62.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -265,6 +230,15 @@
<metadata name="LBL_DATE_POS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="LBL_DATE_POS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<data name="CH_SEPARATE_VIDEO_FOLDER.ToolTip" xml:space="preserve">
<value>This is a global setting for newly added users only.
This parameter specifies how the video will be stored in the users' download path.
@@ -304,7 +278,7 @@ You can find more detailed information about the missing posts in the form that
<metadata name="TP_BEHAVIOR.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="ActionButton13.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton63.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -312,7 +286,7 @@ You can find more detailed information about the missing posts in the form that
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton14.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton64.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -332,7 +306,7 @@ You can find more detailed information about the missing posts in the form that
<metadata name="TP_DOWNLOADING.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="ActionButton15.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton65.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -343,7 +317,7 @@ You can find more detailed information about the missing posts in the form that
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton16.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton66.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -372,7 +346,7 @@ You can find more detailed information about the missing posts in the form that
<metadata name="TP_ENVIR.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="ActionButton17.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton67.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -383,7 +357,7 @@ You can find more detailed information about the missing posts in the form that
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton18.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton68.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -391,7 +365,7 @@ You can find more detailed information about the missing posts in the form that
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton19.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton69.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -402,7 +376,7 @@ You can find more detailed information about the missing posts in the form that
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton20.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton70.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -410,7 +384,7 @@ You can find more detailed information about the missing posts in the form that
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton21.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton71.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -421,7 +395,7 @@ You can find more detailed information about the missing posts in the form that
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton22.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton72.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -429,7 +403,7 @@ You can find more detailed information about the missing posts in the form that
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton23.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton73.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -440,7 +414,7 @@ You can find more detailed information about the missing posts in the form that
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton24.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton74.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -448,7 +422,7 @@ You can find more detailed information about the missing posts in the form that
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton25.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton75.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
@@ -464,7 +438,7 @@ You can find more detailed information about the missing posts in the form that
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton26.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton76.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -478,7 +452,7 @@ You can find more detailed information about the missing posts in the form that
<metadata name="TP_STD.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="ActionButton27.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton77.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE65JREFUeF7t
3X2sJWddB/DdLi2lQG2hdOHuvfM887J7Cxca4ELTQMDWKigIFpBAEAgi9g+CJpJo9Q8NJhgBiYZIYspL
@@ -566,6 +540,47 @@ You can find more detailed information about the missing posts in the form that
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA6LEtW/4flgYiLD1qeX0A
AAAASUVORK5CYII=
</value>
</data>
<metadata name="TAB_DESIGN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_DESIGN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="ActionButton78.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton79.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton80.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton81.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
</root>

View File

@@ -33,16 +33,19 @@ Namespace Editors
TXT_MAX_JOBS_USERS.Value = .MaxUsersJobsCount.Value
TXT_MAX_JOBS_CHANNELS.Value = .ChannelsMaxJobsCount.Value
CH_CHECK_VER_START.Checked = .CheckUpdatesAtStart
TXT_PRG_TITLE.Text = .ProgramText
TXT_PRG_DESCR.Text = .ProgramDescription
TXT_USER_AGENT.Text = .UserAgent
TXT_IMGUR_CLIENT_ID.Text = .ImgurClientID
CH_SHOW_GROUPS.Checked = .ShowGroups
CH_USERS_GROUPING.Checked = .UseGrouping
'Design
TXT_PRG_TITLE.Text = .ProgramText
TXT_PRG_DESCR.Text = .ProgramDescription
TXT_USER_LIST_IMAGE.Text = .UserListImage.Value
COLORS_USERLIST.ColorsSet(.UserListBackColor, .UserListForeColor, SystemColors.Window, SystemColors.WindowText)
COLORS_SUBSCRIPTIONS.ColorsSet(.MainFrameUsersSubscriptionsColorBack, .MainFrameUsersSubscriptionsColorFore,
SystemColors.Window, SystemColors.WindowText)
CH_SHOW_GROUPS.Checked = .ShowGroups
CH_USERS_GROUPING.Checked = .UseGrouping
COLORS_SUBSCRIPTIONS_USERS.ColorsSet(.MainFrameUsersSubscriptionsColorBack_USERS, .MainFrameUsersSubscriptionsColorFore_USERS,
SystemColors.Window, SystemColors.WindowText)
'Environment
TXT_FFMPEG.Text = .FfmpegFile.File
TXT_CURL.Text = .CurlFile.File
@@ -94,6 +97,7 @@ Namespace Editors
CH_STD_YT_REMOVE.Checked = .STDownloader_RemoveYTVideosOnClear
CH_STD_YT_OUTPUT_ASK_NAME.Checked = .STDownloader_OutputPathAskForName
CH_STD_YT_OUTPUT_AUTO_ADD.Checked = .STDownloader_OutputPathAutoAddPaths
CH_STD_YT_CREATE_URL.Checked = .STDownloader_CreateUrlFiles
'Downloading
CH_UDESCR_UP.Checked = .UpdateUserDescriptionEveryTime
CH_UNAME_UP.Checked = .UserSiteNameUpdateEveryTime
@@ -132,7 +136,8 @@ Namespace Editors
CH_FEED_ENDLESS.Checked = .FeedEndless
CH_FEED_ADD_SESSION.Checked = .FeedAddSessionToCaption
CH_FEED_ADD_DATE.Checked = .FeedAddDateToCaption
CH_FEED_STORE_SESSION_DATA.Checked = .FeedStoreSessionsData
NUM_FEED_STORE_SESSION_DATA.Checked = .FeedStoreSessionsData
NUM_FEED_STORE_SESSION_DATA.Value = .FeedStoredSessionsNumber.Value
CH_FEED_OPEN_LAST_MODE.Checked = .FeedOpenLastMode
CH_FEED_SHOW_FRIENDLY.Checked = .FeedShowFriendlyNames
End With
@@ -201,16 +206,18 @@ Namespace Editors
.MaxUsersJobsCount.Value = CInt(TXT_MAX_JOBS_USERS.Value)
.ChannelsMaxJobsCount.Value = TXT_MAX_JOBS_CHANNELS.Value
.CheckUpdatesAtStart.Value = CH_CHECK_VER_START.Checked
.ProgramText.Value = TXT_PRG_TITLE.Text
.ProgramDescription.Value = TXT_PRG_DESCR.Text
.UserAgent.Value = TXT_USER_AGENT.Text
DefaultUserAgent = TXT_USER_AGENT.Text
.ImgurClientID.Value = TXT_IMGUR_CLIENT_ID.Text
.ShowGroups.Value = CH_SHOW_GROUPS.Checked
.UseGrouping.Value = CH_USERS_GROUPING.Checked
'Design
.ProgramText.Value = TXT_PRG_TITLE.Text
.ProgramDescription.Value = TXT_PRG_DESCR.Text
.UserListImage.Value = TXT_USER_LIST_IMAGE.Text
COLORS_USERLIST.ColorsGet(.UserListBackColor, .UserListForeColor)
COLORS_SUBSCRIPTIONS.ColorsGet(.MainFrameUsersSubscriptionsColorBack, .MainFrameUsersSubscriptionsColorFore)
.ShowGroups.Value = CH_SHOW_GROUPS.Checked
.UseGrouping.Value = CH_USERS_GROUPING.Checked
COLORS_SUBSCRIPTIONS_USERS.ColorsGet(.MainFrameUsersSubscriptionsColorBack_USERS, .MainFrameUsersSubscriptionsColorFore_USERS)
'Environment
.FfmpegFile.File = TXT_FFMPEG.Text
.CurlFile.File = TXT_CURL.Text
@@ -259,6 +266,7 @@ Namespace Editors
.STDownloader_RemoveYTVideosOnClear.Value = CH_STD_YT_REMOVE.Checked
.STDownloader_OutputPathAskForName.Value = CH_STD_YT_OUTPUT_ASK_NAME.Checked
.STDownloader_OutputPathAutoAddPaths.Value = CH_STD_YT_OUTPUT_AUTO_ADD.Checked
.STDownloader_CreateUrlFiles.Value = CH_STD_YT_CREATE_URL.Checked
'Downloading
.UpdateUserDescriptionEveryTime.Value = CH_UDESCR_UP.Checked
.UserSiteNameUpdateEveryTime.Value = CH_UNAME_UP.Checked
@@ -298,7 +306,8 @@ Namespace Editors
.FeedEndless.Value = CH_FEED_ENDLESS.Checked
.FeedAddSessionToCaption.Value = CH_FEED_ADD_SESSION.Checked
.FeedAddDateToCaption.Value = CH_FEED_ADD_DATE.Checked
.FeedStoreSessionsData.Value = CH_FEED_STORE_SESSION_DATA.Checked
.FeedStoreSessionsData.Value = NUM_FEED_STORE_SESSION_DATA.Checked
.FeedStoredSessionsNumber.Value = NUM_FEED_STORE_SESSION_DATA.Value
.FeedOpenLastMode.Value = CH_FEED_OPEN_LAST_MODE.Checked
.FeedShowFriendlyNames.Value = CH_FEED_SHOW_FRIENDLY.Checked
FeedParametersChanged = .FeedDataRows.ChangesDetected Or .FeedDataColumns.ChangesDetected Or

View File

@@ -64,6 +64,7 @@ Partial Friend Class LabelsForm : Inherits System.Windows.Forms.Form
Me.CMB_LABELS.Buttons.Add(ActionButton2)
Me.CMB_LABELS.Buttons.Add(ActionButton3)
Me.CMB_LABELS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_LABELS.Lines = New String(-1) {}
Me.CMB_LABELS.ListCheckBoxes = True
Me.CMB_LABELS.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple
Me.CMB_LABELS.ListGridVisible = True

View File

@@ -39,7 +39,7 @@ Namespace Editors
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.CMB_SITES)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(284, 251)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(284, 276)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -62,13 +62,14 @@ Namespace Editors
ListColumn1.Width = -1
Me.CMB_SITES.Columns.Add(ListColumn1)
Me.CMB_SITES.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_SITES.Lines = New String(-1) {}
Me.CMB_SITES.ListCheckBoxes = True
Me.CMB_SITES.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple
Me.CMB_SITES.ListGridVisible = True
Me.CMB_SITES.ListMultiSelect = True
Me.CMB_SITES.Location = New System.Drawing.Point(0, 0)
Me.CMB_SITES.Name = "CMB_SITES"
Me.CMB_SITES.Size = New System.Drawing.Size(286, 252)
Me.CMB_SITES.Size = New System.Drawing.Size(286, 277)
Me.CMB_SITES.TabIndex = 0
'
'SiteSelectionForm

View File

@@ -174,7 +174,6 @@ Namespace Editors
Me.TXT_USER.CaptionToolTipEnabled = True
Me.TXT_USER.CaptionToolTipText = "You must enter the user's URL in this field."
Me.TXT_USER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_USER.Lines = New String(-1) {}
Me.TXT_USER.Location = New System.Drawing.Point(4, 4)
Me.TXT_USER.Name = "TXT_USER"
Me.TXT_USER.PlaceholderEnabled = True
@@ -225,7 +224,6 @@ Namespace Editors
Me.CMB_SITE.Columns.Add(ListColumn1)
Me.CMB_SITE.Columns.Add(ListColumn2)
Me.CMB_SITE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_SITE.Lines = New String(-1) {}
Me.CMB_SITE.Location = New System.Drawing.Point(0, 3)
Me.CMB_SITE.Margin = New System.Windows.Forms.Padding(0, 3, 3, 3)
Me.CMB_SITE.Name = "CMB_SITE"
@@ -303,7 +301,6 @@ Namespace Editors
Me.TXT_DESCR.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_DESCR.GroupBoxed = True
Me.TXT_DESCR.GroupBoxText = "Description"
Me.TXT_DESCR.Lines = New String(-1) {}
Me.TXT_DESCR.Location = New System.Drawing.Point(4, 317)
Me.TXT_DESCR.Multiline = True
Me.TXT_DESCR.Name = "TXT_DESCR"
@@ -314,7 +311,6 @@ Namespace Editors
'
Me.TXT_USER_FRIENDLY.CaptionText = "Friendly name"
Me.TXT_USER_FRIENDLY.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_USER_FRIENDLY.Lines = New String(-1) {}
Me.TXT_USER_FRIENDLY.Location = New System.Drawing.Point(4, 33)
Me.TXT_USER_FRIENDLY.Name = "TXT_USER_FRIENDLY"
Me.TXT_USER_FRIENDLY.Size = New System.Drawing.Size(446, 22)
@@ -371,7 +367,6 @@ Namespace Editors
Me.TXT_LABELS.CaptionText = "Labels"
Me.TXT_LABELS.CaptionWidth = 50.0R
Me.TXT_LABELS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_LABELS.Lines = New String(-1) {}
Me.TXT_LABELS.Location = New System.Drawing.Point(4, 235)
Me.TXT_LABELS.Margin = New System.Windows.Forms.Padding(3, 2, 3, 3)
Me.TXT_LABELS.Name = "TXT_LABELS"
@@ -437,7 +432,6 @@ Namespace Editors
Me.TXT_SPEC_FOLDER.CaptionText = "Special path"
Me.TXT_SPEC_FOLDER.CaptionVisible = True
Me.TXT_SPEC_FOLDER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_SPEC_FOLDER.Lines = New String(-1) {}
Me.TXT_SPEC_FOLDER.Location = New System.Drawing.Point(4, 62)
Me.TXT_SPEC_FOLDER.Name = "TXT_SPEC_FOLDER"
Me.TXT_SPEC_FOLDER.Size = New System.Drawing.Size(446, 22)
@@ -460,7 +454,6 @@ Namespace Editors
Me.TXT_SCRIPT.CaptionToolTipText = "Execute script after downloading this user"
Me.TXT_SCRIPT.CaptionWidth = 65.0R
Me.TXT_SCRIPT.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_SCRIPT.Lines = New String(-1) {}
Me.TXT_SCRIPT.Location = New System.Drawing.Point(4, 289)
Me.TXT_SCRIPT.Margin = New System.Windows.Forms.Padding(3, 2, 3, 3)
Me.TXT_SCRIPT.Name = "TXT_SCRIPT"

View File

@@ -120,6 +120,7 @@ Namespace Editors
Private SpecialPathHandler As PathMoverHandler = Nothing
Friend ReadOnly Property UserLabels As List(Of String)
Private LabelsIncludeSpecial As Boolean = False
Private LabelsChanged As Boolean = False
#End Region
#Region "Initializers"
''' <summary>Create new user</summary>
@@ -246,7 +247,7 @@ Namespace Editors
COLOR_USER.ColorsSetUser(.BackColor, .ForeColor)
TXT_DESCR.Text = .GetUserInformation.StringFormatLines
UpdateSpecificLabels(True)
TXT_LABELS.Buttons.Insert(0, New ActionButton(ADB.Refresh) With {.ToolTipText = "Show/hide site-specific labels"})
If .SpecialLabels.ListExists Then TXT_LABELS.Buttons.Insert(0, New ActionButton(ADB.Refresh) With {.ToolTipText = "Show/hide site-specific labels"})
End With
NameFieldProvider = New CollectionNameFieldProvider
@@ -327,6 +328,8 @@ Namespace Editors
FriendlyNameChanged = False
Catch ex As Exception
MyDef.InvokeLoaderError(ex)
Finally
LabelsChanged = False
End Try
End Sub
Private Sub UserCreatorForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
@@ -367,7 +370,7 @@ Namespace Editors
End If
End If
If Not .Labels.ListEquals(UserLabels) Then _
If LabelsChanged Then _
UserDataBase.UpdateLabels(.Self, UserLabels, 1,
Not DirectCast(.Self, UserDataBase).SpecialLabels.ListExists OrElse
UserDataBase.UpdateLabelsKeepSpecial(1))
@@ -596,21 +599,21 @@ CloseForm:
Private Sub TXT_LABELS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_LABELS.ActionOnButtonClick
Select Case Sender.DefaultButton
Case ADB.Open : ChangeLabels()
Case ADB.Clear : UserLabels.Clear()
Case ADB.Clear : UserLabels.Clear() : LabelsChanged = True
Case ADB.Refresh : UpdateSpecificLabels(False)
End Select
End Sub
Private Sub UpdateSpecificLabels(ByVal IsInit As Boolean)
UserLabels.ListAddList(UserInstance.Labels, LAP.NotContainsOnly)
If DirectCast(UserInstance, UserDataBase).SpecialLabels.ListExists Then
If Not IsInit Then LabelsIncludeSpecial = Not LabelsIncludeSpecial
UserLabelName.Clone()
UserLabels.ListAddList(UserInstance.Labels, LAP.NotContainsOnly)
If Not LabelsIncludeSpecial Then UserLabels.ListWithRemove(DirectCast(UserInstance, UserDataBase).SpecialLabels)
If UserLabels.Count > 0 Then UserLabels.Sort()
TXT_LABELS.Text = UserLabels.ListToString
Else
If Not IsInit Then MsgBoxE({"Users in this collection do not have site-specific labels", "Change labels view"}, vbExclamation)
End If
TXT_LABELS.Clear()
TXT_LABELS.Text = UserLabels.ListToString
End Sub
Private Sub TXT_SCRIPT_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_SCRIPT.ActionOnButtonClick
SettingsCLS.ScriptTextBoxButtonClick(TXT_SCRIPT, Sender)
@@ -784,8 +787,10 @@ CloseForm:
Using fl As New LabelsForm(UserLabels)
fl.ShowDialog()
If fl.DialogResult = DialogResult.OK Then
LabelsChanged = True
UserLabels.ListAddList(fl.LabelsList, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
If UserLabels.ListExists Then
UserLabels.Sort()
TXT_LABELS.Text = UserLabels.ListToString
Else
TXT_LABELS.Clear()

View File

@@ -225,7 +225,7 @@ Namespace Editors
#End Region
#End Region
#Region "Initializer"
Friend Sub New()
Public Sub New()
InitializeComponent()
MyView = New FormView(Me, Settings.Design)
MyProgress = New MyProgress(Toolbar_BOTTOM, PR_MAIN, LBL_STATUS)

View File

@@ -6,4 +6,7 @@ Imports System.Diagnostics.CodeAnalysis
<Assembly: SuppressMessage("Style", "IDE0044:Add readonly modifier", Justification:="<Pending>", Scope:="member", Target:="~F:SCrawler.MainFrame.MySearch")>
<Assembly: SuppressMessage("Style", "IDE0059:Unnecessary assignment of a value", Justification:="<Pending>", Scope:="member", Target:="~M:SCrawler.DownloadObjects.DownloadFeedForm.TPRemoveControl(SCrawler.DownloadObjects.FeedMedia,System.Boolean)")>
<Assembly: SuppressMessage("Style", "IDE0060:Remove unused parameter", Justification:="<Pending>", Scope:="member", Target:="~M:SCrawler.API.UserDataBind.DownloadData(System.Threading.CancellationToken,System.Boolean)")>
<Assembly: SuppressMessage("Style", "IDE0044:Add readonly modifier", Justification:="<Pending>", Scope:="member", Target:="~F:SCrawler.MainFrame.DownloadQueue")>
<Assembly: SuppressMessage("Style", "IDE0044:Add readonly modifier", Justification:="<Pending>", Scope:="member", Target:="~F:SCrawler.MainFrame.DownloadQueue")>
<Assembly: SuppressMessage("Style", "IDE0044:Add readonly modifier", Justification:="<Pending>", Scope:="member", Target:="~F:SCrawler.MainFrame.MyMissingPosts")>
<Assembly: SuppressMessage("Style", "IDE0044:Add readonly modifier", Justification:="<Pending>", Scope:="member", Target:="~F:SCrawler.MainFrame.MyUserMetrics")>
<Assembly: SuppressMessage("Style", "IDE0060:Remove unused parameter", Justification:="<Pending>", Scope:="member", Target:="~M:SCrawler.DownloadObjects.AutoDownloaderPauseButtons.UpdatePauseButtons_Handler(SCrawler.DownloadObjects.AutoDownloader.PauseModes)")>

View File

@@ -105,12 +105,17 @@ Friend Class ListImagesLoader
Dim v As View = Settings.ViewMode.Value
With MyList
MyList.BeginUpdate()
.BeginUpdate()
If Settings.FastProfilesLoading Then
Settings.Users.ListReindex
UserDataList = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList)).ListIfNothing
If Settings.ShowingMode.Value = ShowingModes.AdvancedFilter Then
UserDataList = GetAdvancedFilteredUsers(Of UserOption)()
Else
UserDataList = (From u As IUserData In Settings.Users Where u.FitToAddParams Select New UserOption(u, MyList)).ListIfNothing
End If
If UserDataList.ListExists Then UserDataList.Sort()
If UserDataList.ListExists Then
@@ -127,7 +132,14 @@ Friend Class ListImagesLoader
End If
Else
Dim t As New List(Of Task)
For Each User As IUserData In Settings.Users
Dim advUsers As List(Of IUserData) = Nothing
Dim isAdv As Boolean = False
If Settings.ShowingMode.Value = ShowingModes.AdvancedFilter Then
isAdv = True
advUsers = GetAdvancedFilteredUsers(Of IUserData)()
If Not advUsers.ListExists Then UpdateInProgress = False : MyList.EndUpdate() : Exit Sub
End If
For Each User As IUserData In If(isAdv, advUsers, Settings.Users)
If User.FitToAddParams Then
If Settings.ViewModeIsPicture Then
t.Add(Task.Run(Sub() UpdateUser(User, True)))
@@ -139,8 +151,9 @@ Friend Class ListImagesLoader
If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear()
UpdateInProgress = False
End If
.EndUpdate()
End With
MyList.EndUpdate()
Else
UpdateInProgress = False
End If
@@ -151,6 +164,16 @@ Friend Class ListImagesLoader
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[ListImagesLoader.Update]")
End Try
End Sub
Private Function GetAdvancedFilteredUsers(Of T)() As List(Of T)
With Settings.AdvancedFilter.GetUsers
If .ListExists Then
With ListAddList(Nothing, .Select(Function(u) Settings.GetUser(u, True)), LAP.NotContainsOnly, LAP.IgnoreICopier)
If .ListExists Then Return If(GetType(T) Is GetType(UserOption), .Select(Function(u) New UserOption(u, MyList)).ToList, .Self)
End With
End If
End With
Return Nothing
End Function
Friend Sub UpdateUser(ByVal User As IUserData, ByVal Add As Boolean)
Try
Dim a As Action
@@ -200,8 +223,8 @@ Friend Class ListImagesLoader
.BackColor = Color.LightSkyBlue
.ForeColor = Color.MidnightBlue
ElseIf User.IsSubscription Then
.BackColor = If(User.BackColor, Settings.MainFrameUsersSubscriptionsColorBack.Value)
.ForeColor = If(User.ForeColor, Settings.MainFrameUsersSubscriptionsColorFore.Value)
.BackColor = GetSubscriptionColor(User, True)
.ForeColor = GetSubscriptionColor(User, False)
Else
.BackColor = If(User.BackColor, Settings.UserListBackColorF)
.ForeColor = If(User.ForeColor, Settings.UserListForeColorF)
@@ -209,6 +232,23 @@ Friend Class ListImagesLoader
End With
Return LVI
End Function
Private Shared Function GetSubscriptionColor(ByVal User As IUserData, ByVal GetBackColor As Boolean) As Color
Dim uc As Color? = If(GetBackColor, User.BackColor, User.ForeColor)
If Not uc.HasValue Then
Dim sc As Color = If(GetBackColor, Settings.MainFrameUsersSubscriptionsColorBack.Value, Settings.MainFrameUsersSubscriptionsColorFore.Value)
Dim scu As Color? = Nothing
If User.IsUser Then
If GetBackColor Then
If Settings.MainFrameUsersSubscriptionsColorBack_USERS.Exists Then scu = Settings.MainFrameUsersSubscriptionsColorBack_USERS.Value
Else
If Settings.MainFrameUsersSubscriptionsColorFore_USERS.Exists Then scu = Settings.MainFrameUsersSubscriptionsColorFore_USERS.Value
End If
End If
Return If(scu, sc)
Else
Return uc.Value
End If
End Function
Private Shared Function CheckUserCollection(ByVal User As IUserData) As Boolean
If User.IsCollection Then
With DirectCast(User, UserDataBind)

View File

@@ -70,6 +70,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_DOWN_ALL_FULL_SUBSCR = New SCrawler.ToolStripKeyMenuItem()
Me.BTT_DOWN_SITE_FULL = New SCrawler.ToolStripKeyMenuItem()
Me.BTT_DOWN_SITE_FULL_SUBSCR = New SCrawler.ToolStripKeyMenuItem()
Me.BTT_DOWN_SPEC = New SCrawler.ToolStripKeyMenuItem()
Me.BTT_DOWN_VIDEO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_ADD_NEW_GROUP = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SILENT_MODE = New System.Windows.Forms.ToolStripMenuItem()
@@ -96,6 +97,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_SHOW_EXCLUDED_LABELS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_EXCLUDED_LABELS_IGNORE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_SHOW_GROUPS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_FILTER_ADV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_LIMIT_DATES_NOT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_LIMIT_DATES_IN = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOG = New System.Windows.Forms.ToolStripButton()
@@ -406,7 +408,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'MENU_DOWN_ALL
'
Me.MENU_DOWN_ALL.AutoToolTip = False
Me.MENU_DOWN_ALL.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_DOWN_SELECTED, Me.MENU_D_DOWN_ALL, Me.MENU_D_DOWN_ALL_SITE, MENU_DOWN_ALL_SEP_1, Me.BTT_DOWN_VIDEO, MENU_DOWN_ALL_SEP_2, Me.BTT_ADD_NEW_GROUP, MENU_DOWN_ALL_SEP_3, Me.BTT_SILENT_MODE, MENU_DOWN_ALL_SEP_4, Me.BTT_DOWN_AUTOMATION, Me.BTT_DOWN_AUTOMATION_PAUSE})
Me.MENU_DOWN_ALL.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_DOWN_SELECTED, Me.MENU_D_DOWN_ALL, Me.MENU_D_DOWN_ALL_SITE, Me.BTT_DOWN_SPEC, MENU_DOWN_ALL_SEP_1, Me.BTT_DOWN_VIDEO, MENU_DOWN_ALL_SEP_2, Me.BTT_ADD_NEW_GROUP, MENU_DOWN_ALL_SEP_3, Me.BTT_SILENT_MODE, MENU_DOWN_ALL_SEP_4, Me.BTT_DOWN_AUTOMATION, Me.BTT_DOWN_AUTOMATION_PAUSE})
Me.MENU_DOWN_ALL.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.MENU_DOWN_ALL.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_DOWN_ALL.Name = "MENU_DOWN_ALL"
@@ -513,6 +515,17 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_DOWN_SITE_FULL_SUBSCR.Size = New System.Drawing.Size(274, 22)
Me.BTT_DOWN_SITE_FULL_SUBSCR.Text = "Download all site subscriptions [FULL]"
Me.BTT_DOWN_SITE_FULL_SUBSCR.ToolTipText = resources.GetString("BTT_DOWN_SITE_FULL_SUBSCR.ToolTipText")
'
'BTT_DOWN_SPEC
'
Me.BTT_DOWN_SPEC.AutoToolTip = True
Me.BTT_DOWN_SPEC.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_DOWN_SPEC.Name = "BTT_DOWN_SPEC"
Me.BTT_DOWN_SPEC.Size = New System.Drawing.Size(221, 22)
Me.BTT_DOWN_SPEC.Text = "Download (advanced)"
Me.BTT_DOWN_SPEC.ToolTipText = "Filter the users you want to download and download them." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Shift+Click to download" &
", including non-existent users." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Ctrl+Shift+Click to download, excluding from th" &
"e feed, including non-existent users."
'
'BTT_DOWN_VIDEO
'
@@ -568,7 +581,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'MENU_VIEW
'
Me.MENU_VIEW.AutoToolTip = False
Me.MENU_VIEW.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_VIEW_LARGE, Me.BTT_VIEW_SMALL, Me.BTT_VIEW_LIST, Me.BTT_VIEW_DETAILS, MENU_VIEW_SEP_1, Me.BTT_MODE_SHOW_USERS, Me.BTT_MODE_SHOW_SUBSCRIPTIONS, MENU_VIEW_SEP_2, Me.BTT_SITE_ALL, Me.BTT_SITE_SPECIFIC, MENU_VIEW_SEP_3, Me.BTT_SHOW_ALL, Me.BTT_SHOW_REGULAR, Me.BTT_SHOW_TEMP, Me.BTT_SHOW_FAV, Me.BTT_SHOW_DELETED, Me.BTT_SHOW_SUSPENDED, Me.BTT_SHOW_LABELS, Me.BTT_SHOW_NO_LABELS, Me.BTT_SHOW_EXCLUDED_LABELS, Me.BTT_SHOW_EXCLUDED_LABELS_IGNORE, Me.BTT_SHOW_SHOW_GROUPS, MENU_VIEW_SEP_4, Me.BTT_SHOW_LIMIT_DATES_NOT, Me.BTT_SHOW_LIMIT_DATES_IN})
Me.MENU_VIEW.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_VIEW_LARGE, Me.BTT_VIEW_SMALL, Me.BTT_VIEW_LIST, Me.BTT_VIEW_DETAILS, MENU_VIEW_SEP_1, Me.BTT_MODE_SHOW_USERS, Me.BTT_MODE_SHOW_SUBSCRIPTIONS, MENU_VIEW_SEP_2, Me.BTT_SITE_ALL, Me.BTT_SITE_SPECIFIC, MENU_VIEW_SEP_3, Me.BTT_SHOW_ALL, Me.BTT_SHOW_REGULAR, Me.BTT_SHOW_TEMP, Me.BTT_SHOW_FAV, Me.BTT_SHOW_DELETED, Me.BTT_SHOW_SUSPENDED, Me.BTT_SHOW_LABELS, Me.BTT_SHOW_NO_LABELS, Me.BTT_SHOW_EXCLUDED_LABELS, Me.BTT_SHOW_EXCLUDED_LABELS_IGNORE, Me.BTT_SHOW_SHOW_GROUPS, Me.BTT_SHOW_FILTER_ADV, MENU_VIEW_SEP_4, Me.BTT_SHOW_LIMIT_DATES_NOT, Me.BTT_SHOW_LIMIT_DATES_IN})
Me.MENU_VIEW.Image = CType(resources.GetObject("MENU_VIEW.Image"), System.Drawing.Image)
Me.MENU_VIEW.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_VIEW.Name = "MENU_VIEW"
@@ -695,6 +708,14 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Me.BTT_SHOW_SHOW_GROUPS.Size = New System.Drawing.Size(231, 22)
Me.BTT_SHOW_SHOW_GROUPS.Text = "Show groups instead of labels"
'
'BTT_SHOW_FILTER_ADV
'
Me.BTT_SHOW_FILTER_ADV.AutoToolTip = True
Me.BTT_SHOW_FILTER_ADV.Name = "BTT_SHOW_FILTER_ADV"
Me.BTT_SHOW_FILTER_ADV.Size = New System.Drawing.Size(231, 22)
Me.BTT_SHOW_FILTER_ADV.Text = "Advanced filter"
Me.BTT_SHOW_FILTER_ADV.ToolTipText = "Advanced filter of users you want to display"
'
'BTT_SHOW_LIMIT_DATES_NOT
'
Me.BTT_SHOW_LIMIT_DATES_NOT.AutoToolTip = True
@@ -1158,4 +1179,6 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
Private WithEvents BTT_DOWN_SITE_FULL_SUBSCR As ToolStripKeyMenuItem
Private WithEvents BTT_BUG_REPORT As ToolStripButton
Private WithEvents MENU_INFO_SHOW_QUEUE As ToolStripMenuItem
Private WithEvents BTT_DOWN_SPEC As ToolStripKeyMenuItem
Private WithEvents BTT_SHOW_FILTER_ADV As ToolStripMenuItem
End Class

View File

@@ -68,12 +68,15 @@ Public Class MainFrame
.ResetProgressOnMaximumChanges = False, .Visible = False}
Downloader = New TDownloader
InfoForm = New DownloadedInfoForm
DownloadQueue = New UserDownloadQueueForm
MyProgressForm = New ActiveDownloadingProgress
Downloader.ReconfPool()
AddHandler Downloader.JobsChange, AddressOf Downloader_UpdateJobsCount
AddHandler Downloader.Downloading, AddressOf Downloader_Downloading
AddHandler Downloader.DownloadCountChange, AddressOf InfoForm.Downloader_DownloadCountChange
AddHandler Downloader.SendNotification, AddressOf MainFrameObj.ShowNotification
AddHandler Downloader.UserDownloadStateChanged, AddressOf DownloadQueue.Downloader_UserDownloadStateChanged
AddHandler Downloader.Downloading, AddressOf DownloadQueue.Downloader_Downloading
AddHandler InfoForm.UserFind, AddressOf FocusUser
Settings.LoadUsers()
MyView = New FormView(Me)
@@ -119,7 +122,7 @@ Public Class MainFrame
.Automation = New Scheduler
AddHandler .Groups.Updated, AddressOf .Automation.GROUPS_Updated
AddHandler .Groups.Deleted, AddressOf .Automation.GROUPS_Deleted
AddHandler .Automation.PauseDisabled, AddressOf MainFrameObj.PauseButtons.UpdatePauseButtons
AddHandler .Automation.PauseChanged, AddressOf MainFrameObj.PauseButtons.UpdatePauseButtons_Handler
If .Automation.Count > 0 Then .Labels.AddRange(.Automation.GetGroupsLabels, False) : .Labels.Update()
_UFinit = False
Await .Automation.Start(True)
@@ -415,20 +418,32 @@ CloseResume:
End Sub
#End Region
#Region "Info, Feed, Channels, Saved posts"
#Region "Info"
Private Sub MENU_INFO_SHOW_INFO_Click(sender As Object, e As EventArgs) Handles MENU_INFO_SHOW_INFO.Click
InfoForm.FormShow()
InfoForm.FormShow(EDP.LogMessageValue)
End Sub
Private Sub MENU_INFO_SHOW_QUEUE_Click(sender As Object, e As EventArgs) Handles MENU_INFO_SHOW_QUEUE.Click
DownloadQueue.FormShow(EDP.LogMessageValue)
ShowDownloadQueueForm()
End Sub
Private Sub ShowDownloadQueueForm(Optional ByVal Round As Integer = 0)
Try
DownloadQueue.FormShow(EDP.LogMessageValue)
Catch ex As Exception
If Round = 0 Then
If Not DownloadQueue Is Nothing Then DownloadQueue.Dispose() : DownloadQueue = Nothing
ShowDownloadQueueForm(Round + 1)
Else
ErrorsDescriber.Execute(EDP.SendToLog, ex, "ShowDownloadQueueForm")
End If
End Try
End Sub
Private Sub MENU_INFO_SHOW_MISSING_Click(sender As Object, e As EventArgs) Handles MENU_INFO_SHOW_MISSING.Click
If MyMissingPosts Is Nothing Then MyMissingPosts = New MissingPostsForm
If MyMissingPosts.Visible Then MyMissingPosts.BringToFront() Else MyMissingPosts.Show()
MyMissingPosts.FormShow(EDP.LogMessageValue)
End Sub
Private Sub MENU_INFO_SHOW_USER_METRICS_Click(sender As Object, e As EventArgs) Handles MENU_INFO_SHOW_USER_METRICS.Click
If MyUserMetrics Is Nothing Then MyUserMetrics = New UsersInfoForm
MyUserMetrics.FormShowS
MyUserMetrics.FormShow(EDP.LogMessageValue)
End Sub
#End Region
Private Sub ShowFeed() Handles BTT_FEED.Click, BTT_TRAY_FEED_SHOW.Click
If MyFeed Is Nothing Then MyFeed = New DownloadFeedForm : AddHandler Downloader.FeedFilesChanged, AddressOf MyFeed.Downloader_FilesChanged
If MyFeed.Visible Then MyFeed.BringToFront() Else MyFeed.Show()
@@ -483,19 +498,32 @@ CloseResume:
DownloadSiteFull(False, e.IncludeInTheFeed, True, e.Shift)
End Sub
#End Region
Private Sub BTT_DOWN_SPEC_KeyClick(ByVal Sender As Object, ByVal e As MyKeyEventArgs) Handles BTT_DOWN_SPEC.KeyClick
Dim group As Groups.DownloadGroup = Nothing
Using f As New Groups.GroupEditorForm(Nothing) With {.DownloadMode = True}
f.ShowDialog()
If f.DialogResult = DialogResult.OK AndAlso Not f.MyGroup Is Nothing Then group = f.MyGroup
End Using
If Not group Is Nothing Then group.DownloadUsers(e.IncludeInTheFeed,, e.Shift) : group.Dispose()
End Sub
Private Sub DownloadSiteFull(ByVal ReadyForDownloadOnly As Boolean, ByVal IncludeInTheFeed As Boolean,
ByVal Subscription As Boolean, Optional ByVal IgnoreExists As Boolean = False)
Using f As New SiteSelectionForm(Settings.LatestDownloadedSites.ValuesList)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
If f.DialogResult = DialogResult.OK AndAlso f.SelectedSites.Count > 0 Then
Settings.LatestDownloadedSites.Clear()
Settings.LatestDownloadedSites.AddRange(f.SelectedSites)
Settings.LatestDownloadedSites.Update()
If f.SelectedSites.Count > 0 Then
Downloader.AddRange(Settings.GetUsers(Function(u) f.SelectedSites.Contains(u.Site) And (u.Exists Or IgnoreExists) And
u.IsSubscription = Subscription And
(Not ReadyForDownloadOnly Or u.ReadyForDownload)), IncludeInTheFeed)
End If
Using g As New Groups.DownloadGroup
g.Sites.AddRange(f.SelectedSites)
g.ReadyForDownload = True
g.ReadyForDownloadIgnore = Not ReadyForDownloadOnly
If Subscription Then
g.Subscriptions = True
g.SubscriptionsOnly = True
End If
g.DownloadUsers(IncludeInTheFeed, ReadyForDownloadOnly, IgnoreExists)
End Using
End If
End Using
End Sub
@@ -679,6 +707,7 @@ CloseResume:
BTT_SHOW_LABELS.Checked = m = ShowingModes.Labels
BTT_SHOW_NO_LABELS.Checked = m = ShowingModes.NoLabels
BTT_SHOW_SHOW_GROUPS.Checked = Settings.ShowGroupsInsteadLabels
BTT_SHOW_FILTER_ADV.Checked = m = ShowingModes.AdvancedFilter
SetExcludedButtonChecker()
With Settings
If Not m = ShowingModes.Labels Then .Labels.Current.Clear() : .Labels.Current.Update()
@@ -705,6 +734,19 @@ CloseResume:
End If
End Using
End Function
Private Sub BTT_SHOW_FILTER_ADV_Click(sender As Object, e As EventArgs) Handles BTT_SHOW_FILTER_ADV.Click
Try
Using g As New Groups.GroupEditorForm(Settings.AdvancedFilter) With {.FilterMode = True}
g.ShowDialog()
If g.DialogResult = DialogResult.OK Then
Settings.AdvancedFilter.UpdateFile()
SetShowButtonsCheckers(ShowingModes.AdvancedFilter, True)
End If
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Changing advanced filter options")
End Try
End Sub
#End Region
#Region "5 - view dates"
Private Sub BTT_SHOW_LIMIT_DATES_NOT_IN_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles BTT_SHOW_LIMIT_DATES_NOT.Click,

View File

@@ -53,6 +53,7 @@ Friend Module MainMod
NoLabels = 1000
Deleted = 10000
Suspended = 12000
AdvancedFilter = 100000
End Enum
Friend Enum ShowingDates As Integer
[Off] = 0
@@ -83,12 +84,20 @@ Friend Module MainMod
Friend MyProgressForm As ActiveDownloadingProgress
Friend MainFrameObj As MainFrameObjects
Friend ReadOnly DateTimeDefaultProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Friend ReadOnly SessionDateTimeProvider As New ADateTime("yyyyMMdd_HHmmss")
Friend ReadOnly FeedVideoLengthProvider As New ADateTime("hh\:mm\:ss") With {.TimeParseMode = ADateTime.TimeModes.TimeSpan}
Friend ReadOnly UserExistsPredicate As New FPredicate(Of IUserData)(Function(u) u.Exists)
Friend ReadOnly UserExistsSubscriptionsPredicate As New FPredicate(Of IUserData)(Function(u) u.Exists And u.IsSubscription)
Friend ReadOnly UserExistsNonSubscriptionsPredicate As New FPredicate(Of IUserData)(Function(u) u.Exists And Not u.IsSubscription)
Friend ReadOnly LogConnector As New LogHost
Friend DefaultUserAgent As String = String.Empty
#Region "NonExistingUsersLog"
Friend ReadOnly NonExistingUsersLog As New TextSaver($"LOGs\NonExistingUsers.txt") With {.LogMode = True, .AutoSave = True}
Friend Sub AddNonExistingUserToLog(ByVal Message As String)
MyMainLOG = Message
NonExistingUsersLog.AppendLine(Message)
End Sub
#End Region
#Region "File name operations"
Friend FileDateAppenderProvider As IFormatProvider
''' <summary>File, Date</summary>

View File

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

View File

@@ -41,6 +41,11 @@ Namespace Plugin.Hosts
FileSetManually = True
End Set
End Property
Public Overrides Sub Delete(ByVal RemoveFiles As Boolean)
MyBase.Delete(RemoveFiles)
If Not RemoveFiles And Not Settings.STDownloader_SnapshotsKeepWithFiles And Settings.STDownloader_SnapShotsCachePermamnent Then _
ThumbnailFile.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.None)
End Sub
Friend Sub New(ByVal URL As String, ByVal OutputFile As SFile)
Me.URL = URL
Me.File = OutputFile
@@ -111,6 +116,8 @@ Namespace Plugin.Hosts
End If
Instance.DownloadSingleObject(If(ExternalSource, Me), Token)
ExchangeData(ExternalSource, Me)
Dim __url$ = DirectCast(Me, IDownloadableMedia).URL_BASE.IfNullOrEmpty(URL)
If File.Exists And Not __url.IsEmptyString And MyDownloaderSettings.CreateUrlFiles Then CreateUrlFile(__url, File)
If Not ExternalSource Is Nothing Then
With ExternalSource : _HasError = .HasError : _Exists = .Exists : End With
End If

View File

@@ -13,8 +13,8 @@ Namespace Plugin.Hosts
End Sub
Friend Sub Add(ByVal ex As Exception, ByVal Message As String,
Optional ByVal ShowMainMsg As Boolean = False, Optional ByVal ShowErrorMsg As Boolean = False,
Optional ByVal SendInLog As Boolean = True) Implements ILogProvider.Add
ErrorsDescriber.Execute(New ErrorsDescriber(ShowMainMsg, ShowErrorMsg, SendInLog), ex, Message)
Optional ByVal SendToLog As Boolean = True) Implements ILogProvider.Add
ErrorsDescriber.Execute(New ErrorsDescriber(ShowMainMsg, ShowErrorMsg, SendToLog), ex, Message)
End Sub
End Class
End Namespace

View File

@@ -79,6 +79,7 @@ Namespace Plugin.Hosts
New PluginHost(New API.Twitter.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.Mastodon.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.Instagram.SiteSettings(_XML, GlobalPath), _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.ThreadsNet.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.RedGifs.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.YouTube.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.Pinterest.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
@@ -89,7 +90,8 @@ Namespace Plugin.Hosts
New PluginHost(New API.XVIDEOS.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.ThisVid.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.PathPlugin.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.OnlyFans.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids)}
New PluginHost(New API.OnlyFans.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.JustForFans.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids)}
End Function
Friend Shared Function GetPluginsHosts(ByRef _XML As XmlFile, ByVal GlobalPath As SFile,
ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean),

View File

@@ -331,6 +331,7 @@ Namespace Plugin.Hosts
End If
Return _AvailableValue
Else
If Not Silent Then MsgBoxE({$"Downloading data for the site {Name} has been disabled by you.", $"{Name} downloading disabled"}, vbExclamation)
Return False
End If
End Function

Some files were not shown because too many files have changed in this diff Show More