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.8.6.0
*2023-08-06* *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: # :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 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) [![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) [![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) [![FAQ](https://img.shields.io/badge/FAQ-green)](FAQ.md)
[![GUIDE](https://img.shields.io/badge/GUIDE-green)](https://github.com/AAndyProgram/SCrawler/wiki) [![GUIDE](https://img.shields.io/badge/GUIDE-green)](https://github.com/AAndyProgram/SCrawler/wiki)
@@ -11,7 +12,7 @@
:eu: :eu:
:greece: :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)** **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: <!---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/); - Redgifs videos (https://www.redgifs.com/);
- Twitter images and videos, saved (bookmarked) posts; - Twitter images and videos, saved (bookmarked) posts;
- OnlyFans 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; - Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories, saved 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; - Pinterest boards, users, saved posts;
- Imgur images, galleries and videos; - Imgur images, galleries and videos;
- Gfycat videos; - Gfycat videos;
@@ -72,6 +75,8 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **OnlyFans** - **OnlyFans**
- **Mastodon** - **Mastodon**
- **Instagram** - **Instagram**
- **Threads**
- JustForFans
- TikTok - TikTok
- RedGifs - RedGifs
- Pinterest - 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. 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 ## How to request a new site
<!---Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about---> <!---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) - [Reddit](https://github.com/AAndyProgram/SCrawler/wiki/Settings#reddit)
- [Twitter](https://github.com/AAndyProgram/SCrawler/wiki/Settings#twitter) - [Twitter](https://github.com/AAndyProgram/SCrawler/wiki/Settings#twitter)
- [OnlyFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans) - [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) - [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) - [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok)
- [RedGifs](https://github.com/AAndyProgram/SCrawler/wiki/Settings#redgifs) - [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) - [Pinterest](https://github.com/AAndyProgram/SCrawler/wiki/Settings#Pinterest)
- [PornHub](https://github.com/AAndyProgram/SCrawler/wiki/Settings#pornhub) - [PornHub](https://github.com/AAndyProgram/SCrawler/wiki/Settings#pornhub)
- [XHamster](https://github.com/AAndyProgram/SCrawler/wiki/Settings#xhamster) - [XHamster](https://github.com/AAndyProgram/SCrawler/wiki/Settings#xhamster)
- [XVIDEOS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#xvideos) - [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) - [LPSG](https://github.com/AAndyProgram/SCrawler/wiki/Settings#lpsg)
**Full guide you can find [here](https://github.com/AAndyProgram/SCrawler/wiki)** **Full guide you can find [here](https://github.com/AAndyProgram/SCrawler/wiki)**
@@ -194,6 +193,10 @@ F5-->[*]
# Contact me # 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 [e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me
Matrix (Element): https://matrix.to/#/@andyprogram:matrix.org Matrix (Element): https://matrix.to/#/@andyprogram:matrix.org
@@ -203,3 +206,4 @@ Discord (contact the developer): andyprogram
Discord server: https://discord.gg/uFNUXvFFmg Discord server: https://discord.gg/uFNUXvFFmg
[Wire](https://account.wire.com/user-profile/?id=93985052-cf2c-4b72-ac75-bbe3231cf544): @andyprogram [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: ' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")> ' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2023.8.6.0")> <Assembly: AssemblyVersion("2023.10.1.0")>
<Assembly: AssemblyFileVersion("2023.8.6.0")> <Assembly: AssemblyFileVersion("2023.10.1.0")>
<Assembly: NeutralResourcesLanguage("en")> <Assembly: NeutralResourcesLanguage("en")>

View File

@@ -11,6 +11,6 @@ Namespace Plugin
Overloads Sub Add(ByVal Message As String) Overloads Sub Add(ByVal Message As String)
Overloads Sub Add(ByVal ex As Exception, 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 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 Interface
End Namespace End Namespace

View File

@@ -6,6 +6,10 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' 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 Namespace API.YouTube.Base
Public Structure Thumbnail : Implements IIndexable, IComparable(Of Thumbnail) Public Structure Thumbnail : Implements IIndexable, IComparable(Of Thumbnail)
Public ID As String Public ID As String
@@ -47,6 +51,14 @@ Namespace API.YouTube.Base
Channel = 2 Channel = 2
PlayList = 3 PlayList = 3
End Enum 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 Structure MediaObject : Implements IIndexable, IComparable(Of MediaObject)
Public Type As Plugin.UserMediaTypes Public Type As Plugin.UserMediaTypes
Public ID As String Public ID As String
@@ -59,6 +71,17 @@ Namespace API.YouTube.Base
Public Size As Double Public Size As Double
Public Codec As String Public Codec As String
Public Protocol 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 URL As String
Public Property Index As Integer Implements IIndexable.Index Public Property Index As Integer Implements IIndexable.Index
Private Function SetIndex(ByVal Obj As Object, ByVal Index As Integer) As Object Implements IIndexable.SetIndex 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|))" Public Const UrlTypePattern As String = "(?<=https?://[^/]*?youtube.com/)((@|[^\?/&]+))([/\?]{0,1}(list=|v=|)([^\?/&]*))(?=(\S+|\Z|))"
Private Sub New() Private Sub New()
End Sub 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 Public Shared Function IsMyUrl(ByVal URL As String) As Boolean
Return Not Info_GetUrlType(URL) = YouTubeMediaType.Undefined Return Not Info_GetUrlType(URL) = YouTubeMediaType.Undefined
End Function 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 Optional ByRef IsChannelUser As Boolean = False, Optional ByRef Id As String = Nothing) As YouTubeMediaType
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
IsMusic = URL.Contains("music.youtube.com") IsMusic = URL.Contains("music.youtube.com")
IsChannelUser = False IsChannelUser = False
IsShorts = False
Dim data As List(Of String) = RegexReplace(URL, RParams.DMS(UrlTypePattern, 0, RegexReturn.ListByMatch, EDP.ReturnValue)) Dim data As List(Of String) = RegexReplace(URL, RParams.DMS(UrlTypePattern, 0, RegexReturn.ListByMatch, EDP.ReturnValue))
If data.ListExists Then If data.ListExists Then
If data.Count >= 6 Then Id = data(5) If data.Count >= 6 Then Id = data(5)
If data.Count >= 3 And Not data(2).IsEmptyString Then If data.Count >= 3 And Not data(2).IsEmptyString Then
Select Case data(2).ToLower Select Case data(2).ToLower
Case "watch" : Return YouTubeMediaType.Single Case "watch" : Return YouTubeMediaType.Single
Case "shorts" : IsShorts = True : Return YouTubeMediaType.Single
Case "playlist" : Return YouTubeMediaType.PlayList Case "playlist" : Return YouTubeMediaType.PlayList
Case UserChannelOption, "@" : IsChannelUser = data(2).ToLower = UserChannelOption : Return YouTubeMediaType.Channel Case UserChannelOption, "@" : IsChannelUser = data(2).ToLower = UserChannelOption : Return YouTubeMediaType.Channel
End Select End Select
@@ -64,8 +89,8 @@ Namespace API.YouTube.Base
Dim urlOrig$ = URL Dim urlOrig$ = URL
URL = RegexReplace(URL, TrueUrlRegEx) URL = RegexReplace(URL, TrueUrlRegEx)
If URL.IsEmptyString Then Throw New ArgumentNullException("URL", $"Can't get true URL from [{urlOrig}]") If URL.IsEmptyString Then Throw New ArgumentNullException("URL", $"Can't get true URL from [{urlOrig}]")
Dim isMusic As Boolean = False Dim isMusic As Boolean = False, isShorts As Boolean = False
Dim objType As YouTubeMediaType = Info_GetUrlType(URL, isMusic) Dim objType As YouTubeMediaType = Info_GetUrlType(URL, isMusic, isShorts)
If Not objType = YouTubeMediaType.Undefined Then If Not objType = YouTubeMediaType.Undefined Then
Dim __GetDefault As Boolean = If(GetDefault, True) Dim __GetDefault As Boolean = If(GetDefault, True)
Dim __GetShorts As Boolean = If(GetShorts, True) Dim __GetShorts As Boolean = If(GetShorts, True)
@@ -105,7 +130,7 @@ Namespace API.YouTube.Base
If result Then If result Then
container.Parse(Nothing, _CachePathDefault, isMusic, Token, Progress) 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 End If
container.Dispose() container.Dispose()
End If End If

View File

@@ -132,13 +132,32 @@ Namespace API.YouTube.Base
End Set End Set
End Property End Property
#End Region #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" #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"), <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.")> 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) Public ReadOnly Property ReplaceModificationDate As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Use cookies"), <Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Use cookies"),
Description("By default, use cookies when downloading from YouTube.")> Description("By default, use cookies when downloading from YouTube.")>
Public ReadOnly Property DefaultUseCookies As XMLValue(Of Boolean) 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"), <Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"),
DisplayName("Auto remove"), Description("Automatically remove downloaded items from the list.")> DisplayName("Auto remove"), Description("Automatically remove downloaded items from the list.")>
Public ReadOnly Property RemoveDownloadedAutomatically As XMLValue(Of Boolean) Public ReadOnly Property RemoveDownloadedAutomatically As XMLValue(Of Boolean)

View File

@@ -433,7 +433,28 @@ Namespace API.YouTube.Controls
End Sub End Sub
#End Region #End Region
#Region "Footer" #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 Dim f As SFile
#Disable Warning BC40000 #Disable Warning BC40000
If MyContainer.HasElements Then If MyContainer.HasElements Then

View File

@@ -18,6 +18,7 @@ Namespace DownloadObjects.STDownloader
ReadOnly Property OpenFolderInOtherProgram_Command As String ReadOnly Property OpenFolderInOtherProgram_Command As String
ReadOnly Property OutputPathAskForName As Boolean ReadOnly Property OutputPathAskForName As Boolean
ReadOnly Property OutputPathAutoAddPaths As Boolean ReadOnly Property OutputPathAutoAddPaths As Boolean
ReadOnly Property CreateUrlFiles As Boolean
ReadOnly Property ENVIR_FFMPEG As SFile ReadOnly Property ENVIR_FFMPEG As SFile
ReadOnly Property ENVIR_YTDLP As SFile ReadOnly Property ENVIR_YTDLP As SFile
ReadOnly Property ENVIR_GDL 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_2 As System.Windows.Forms.ToolStripSeparator
Dim SEP_3 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_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 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.TOOLBAR_BOTTOM = New System.Windows.Forms.StatusStrip()
Me.PR_MAIN = New System.Windows.Forms.ToolStripProgressBar() Me.PR_MAIN = New System.Windows.Forms.ToolStripProgressBar()
Me.LBL_INFO = New System.Windows.Forms.ToolStripStatusLabel() 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_ADD_SHORTS_ONLY = New PersonalUtilities.Forms.Controls.KeyClick.ToolStripMenuItemKeyClick()
Me.BTT_DOWN = New System.Windows.Forms.ToolStripButton() Me.BTT_DOWN = New System.Windows.Forms.ToolStripButton()
Me.BTT_STOP = 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.SEP_LOG = New System.Windows.Forms.ToolStripSeparator()
Me.BTT_LOG = New System.Windows.Forms.ToolStripButton() Me.BTT_LOG = New System.Windows.Forms.ToolStripButton()
Me.BTT_INFO = 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_2 = New System.Windows.Forms.ToolStripSeparator()
SEP_3 = New System.Windows.Forms.ToolStripSeparator() SEP_3 = New System.Windows.Forms.ToolStripSeparator()
MENU_ADD_SEP_1 = 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_BOTTOM.SuspendLayout()
Me.TOOLBAR_TOP.SuspendLayout() Me.TOOLBAR_TOP.SuspendLayout()
Me.SuspendLayout() Me.SuspendLayout()
@@ -70,6 +75,59 @@ Namespace DownloadObjects.STDownloader
MENU_ADD_SEP_1.Name = "MENU_ADD_SEP_1" MENU_ADD_SEP_1.Name = "MENU_ADD_SEP_1"
MENU_ADD_SEP_1.Size = New System.Drawing.Size(181, 6) 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 'TOOLBAR_BOTTOM
' '
Me.TOOLBAR_BOTTOM.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.PR_MAIN, Me.LBL_INFO}) 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 'TOOLBAR_TOP
' '
Me.TOOLBAR_TOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden 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.Location = New System.Drawing.Point(0, 0)
Me.TOOLBAR_TOP.Name = "TOOLBAR_TOP" Me.TOOLBAR_TOP.Name = "TOOLBAR_TOP"
Me.TOOLBAR_TOP.Size = New System.Drawing.Size(584, 25) 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.Size = New System.Drawing.Size(51, 22)
Me.BTT_STOP.Text = "Stop" 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 'SEP_LOG
' '
Me.SEP_LOG.Name = "SEP_LOG" Me.SEP_LOG.Name = "SEP_LOG"
@@ -300,9 +331,9 @@ Namespace DownloadObjects.STDownloader
Private WithEvents LBL_INFO As ToolStripStatusLabel Private WithEvents LBL_INFO As ToolStripStatusLabel
Protected WithEvents TP_CONTROLS As TableLayoutPanel Protected WithEvents TP_CONTROLS As TableLayoutPanel
Private WithEvents TOOLBAR_TOP As ToolStrip Private WithEvents TOOLBAR_TOP As ToolStrip
Private WithEvents BTT_DELETE As ToolStripButton Private WithEvents BTT_DELETE As ToolStripMenuItem
Private WithEvents BTT_CLEAR_DONE As ToolStripButton Private WithEvents BTT_CLEAR_DONE As ToolStripMenuItem
Private WithEvents BTT_CLEAR_ALL As ToolStripButton Private WithEvents BTT_CLEAR_ALL As ToolStripMenuItem
Private WithEvents BTT_SETTINGS As ToolStripButton Private WithEvents BTT_SETTINGS As ToolStripButton
Private WithEvents SEP_1 As ToolStripSeparator Private WithEvents SEP_1 As ToolStripSeparator
Private WithEvents SEP_LOG As ToolStripSeparator Private WithEvents SEP_LOG As ToolStripSeparator
@@ -317,5 +348,6 @@ Namespace DownloadObjects.STDownloader
Protected WithEvents MENU_ADD As ToolStripDropDownButton Protected WithEvents MENU_ADD As ToolStripDropDownButton
Protected WithEvents BTT_DOWN As ToolStripButton Protected WithEvents BTT_DOWN As ToolStripButton
Private WithEvents BTT_BUG_REPORT As ToolStripButton Private WithEvents BTT_BUG_REPORT As ToolStripButton
Private WithEvents BTT_CLEAR_SELECTED As ToolStripMenuItem
End Class End Class
End Namespace 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"> <metadata name="MENU_ADD_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </metadata>
<metadata name="MENU_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"> <metadata name="TOOLBAR_BOTTOM.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value> <value>17, 17</value>
</metadata> </metadata>
<metadata name="TOOLBAR_TOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> <metadata name="TOOLBAR_TOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>177, 17</value> <value>177, 17</value>
</metadata> </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"> <data name="BTT_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN1SURBVEhLrZVZSFRRGMdvKa44TljWuGGWldMyZpYLjpqW YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAANxSURBVEhLrZVJTFNRFIYfQhgD1OBUpiCKQwkUoUA0FBAU
TlrRuGVutLiUkSk6SmUMZfYaRW/Rg0REL2H01PJgEZWaOuod00kZZ7OxwOj9xL/v3EbyQTT0fvBnBs7h KqixAlpliAODYEQJFAJiCKBujcadcUGMMW4MxpXDAoeoOEDR1woVUjph0QTD/pLfcx8lsiBg8J3kT9vc
//vOd//nXmG58rnr1eV7zwuLia95tq28uJHapGZZQ1ocHtZCJ5LMWhRbsyWIZ9vKi5vsGlGzgHcCFB8F k/+797z/vgorlf9N376AW75YSnzN27b64kYqk4rlDWuxf0QLnUgya1Fmy5cg3rbVlwT4omLBrwSEvRMQ
hPQLCB/wRo0zTz6ARlSz4E8CNvSvQfSQL+JFBVrdhfIBEgjAO48x+SJhLBiZ4xtx60eFfIBkAsSY/LB/ 8VFA1Gc/1LiK5AMkiioW/l7A+o8+iBsOQIoYhlZPiXyAZALwncebApBqCUfu6EZc/VUhH0BDgHhTINIt
TIlcSxjNfyvuztXKBzgraliiWYk8SzjKprej1haPh78a5AM0i0lM9zUClbY41NsT0OxIxeNfhv8DLJXz ChRaI2n+W3FzplY+wBkxkWnMChRZo3Bycjtq7Sm4O9soH6BZTGO679GotO9EgyMVzc49uD9r/DfAcjlf
eVX0ZfyusO3AJXsi2ma0uOHOQdfPFqx/4r+kVM8Cu6QOs+czTvnOH9eiwJKFKmsuLjmO44qrGJ3uKvqf kOFtzlyFfQcuODRom9Ki21OAvt8tWPcgaFkpH4X0STvMX8g45bt4VIuj1jxU2QpxwXkY7e4yXPNU0XcN
iKuudNx056JjVoeuuRY8mjNIoAdzDbjzoxo3Z8vR6iqiEeaj3nYSqu5ASABurvhAGe8VEDHkQ7FUSEnR OtzZ6PEUondah76ZFtybMUqgOzONuPGrGj3T5Wh1l9IIi9FgPw5lfwgkADcPe0sZHxQQPewPNcWQJ0U/
T8XgjG0nLjuScG3mIBnocHs2TwLc+JZDZlrU2uNRMhWL7IlN0JgViBz0gZJ8Tpr1/wC8c27OFzXmINqs EY/T9kRcdGbi8tReMtDh+nSRBOj+UUBmWtQ6UnBsIgH5Y5ugNochZsgfCvI5btb/BfCdc3O+qDaHUrMS
QqHHvNGZhHZXFjrcOgLk4Pq3LBhcafQs9uH0tBonJjcjYzwUu8UghA15Q9knwJ8uZeHwAkD+mBZRZB5P JV7zS65MdLrz0OvREaAAV37kwejOomeRhlOTKhwZ34yc0Q1IEkMROewHxQcBQXQpS0YWAYotWsSSeQrt
HWRbVFIMa+waNDkP4OpMJtrJ9IorAwZnGhod+1FHa5U2NY5NRiOdTiqZD3qDX0ZuvuaVAH3fAsApyyGk IN+qlGJY41CjyZWBjqlcdJJpuzsHRlcWLjnTUUdrlXYVDo3HIZtOKpkP+YFfRm7u80yA/sMiwAnrPuy2
jIVQDCNQbt2BBnqYLZSUNjLkps3OVElNNKo6GglP09HJKKR9CUXcaCBUn70QRCP26xEgvCR1E+D9AsAF RFAMo1Fu24FGepgtlJQ2MuSmza49kppoVHU0Ep6mg+OxyPq2ATu/hkD5yRehNOLAAQHCU1I/Ad4sAtSL
cS8ziCnM+KWSGcfPMeNEHTNaaun3PDOKF9n97xfI/ABqbBqUTm9D3mQk2hxVKPiY8btaTGUVYjIrJaWQ ScwoprMusZJ0lnWZ61iXpZY+z9Hv8+z2z3oyz0CNXQ3D5DYUjcegzVmFw69z5qrFDFYhapiBlE7SfCF9
kkdIA6TeZCYBeEwXi9i8+KZOsY3V2Peg1BqLI3TKJDptvb1UWltSPKbLFd9oFJtYCT2X3Ilw7KMbvcXk Jg1qmATgMV0qYgviTd1iG6txJMNgS8ABOmUmnbbBYZDWlhWP6UrFG7vEJnaMnkvhWBTS6EZvMQXhlO2o
j9PWAsnEs23l9RdQz3ImwqQXHX+bhlBSyiyeGa+2/gKq2V5zMCIoKesozvzbUDSf89UWN2kQy1nkoC+U ZOJtW33NAxpYwVik9KLjb9MISspJq3fG/1vzgGq2yxyOaErKWooz/28oXcj5/xY3aRTLWcxQABQUw+CX
FMOAtwK8XlNKTDICzlLCuLkfdb6Wx/AFAT7JCCin+PlT5wJdIOE56SkB3skIKBrVSyPR95LoAul7SG/k AnyfU0pMMgLOUMK4eSDtfA2P4RMCvJcRUE7xC6KdC3SBhMekhwR4JSOg9KteGol+kEQXSD9AeiEXgLLM
AlCWudGiWjbngvAHbcWtizmLGJwAAAAASUVORK5CYII= jZbUijkXhD9w0a0SO8Tg+AAAAABJRU5ErkJggg==
</value> </value>
</data> </data>
<data name="BTT_ADD_PLS_ARR.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_ADD_PLS_ARR.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN2SURBVEhLrZVJTFNRFIafQhgD1OBUpiiKSomUSYmVgoJC YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN0SURBVEhLrZVJTFNRFIafQhgD1KBoGYzihDXYqtCqoYKg
BTVWBpEpigyKESVQiVMa56XRuDMuiDHGjcG4cligMSqCUOAVoZaUTlgkqWF/ze+5zzayIGDwneRPm9yb UEENFUSkQFApKEaUQCVOaQR1azTujAtijHFjNK4cFmocGASKvFaokNIJiiYY99f8nvsskQUBg+8kf9rk
/zv3vP++JyxWQXcDuoLvBWA+8TXftqUXN0oxqVj+oBZ7h7TQiSSzFuW2Agni27b04iapwyoW9k5A5EcB 3vzfuef99z1hvgq7FdIRfjsEs4mvBbctvLiRyqZiuf167B3QwyCS7HocduVJkOC2hZcE+KxiUW8FxH4U
0X0CYr8EotFVLB8gXVSxqE8CVvUtw7rBYKSJkTjvKZUPkEUA3nmiKRgZo1HYNbYGN2Zq5ANoxBSWaArB EN8jIKk3FGZfoXyAdFHF4joFLOtZhFX94dCIsTgfKJEPoCEA7zzVFo6tjjjkDC3Hte+V8gG0BEi1RSDT
tlEFiiwxNP+NuOttkg9QL6azLLMCxZZYVE1uRpM9DQ9nW+UDtIs7mO5bHGrtyWhxZKDdqcHjWcO/ARbK oUCBM5Hmvxa3purkAxwX01mGXYFCZxIqxjagzq3BvZ+N8gGaxUxm+JqMKvdGNHi2otm7Ew9+Wv4NMFfO
uV91/Xm/auxbcMaRhc4pLa56CtH1swMrn4QuKOWz8C6pwwJ/xinfJWNaHLbko85WhDPOg7jgLsdNTx39 p1XRmf2r0p2GM54MtI7rcTWQj44fLVj6MHJOKR9Hd0gd5k1nnPJdNKTHIWcuql0FOOM9iAv+w7geqKb/
z8JFdy6ueYpwfVqHLm8HHnkNEuiBtxV3Zhpwbboa591lNMIStNiPQNkdDgnAzSM/UMZ7BcQNBkFNMeRJ Gbjo34W2QAHaJw3omGrB/SmLBLo71Yib32vRNmnCeX8pjbAIDe4jUD6JhgTg5rEfKONdApL7w6CmGPKk
0U8k4rg9BWed2bg0tZsMdLg1XSwBrn4vJDMtmhxpqJhIQsH4WqjNkYgfCIKCfI6Y9X8BvHNuzhfV5gja GEdTccy9CWe9Olwa300GBtyYLJQAVyfyyUyPOo8GZaPrkDe8Amp7LFL6wqAgnyN2418A75yb80W1PYY2
rESpz/ycKxuX3fm47tERoBBXvufD4M6hZ5GJY5MqHLKuR97YamwVIxAzGAjFZwGhdClLh+YASka1SCDz K1ESND/n0+GyPxftAQMB8nFlIhcWfxY9i22oGVOheGQ1socS6K7EILE/FIpuAZF0KUsGZgCKHHqsJHMN
NOqgwKKUYtjoUKPNtR0Xp3bhMplecOfB4MrBOec2NNNarV2FA9Z1yKWTSuYDgeCXkZsveyVA/3kO4Khl dZDnVEoxNHvUaPJpcXE8B5fJ9II/GxZfFs55M1FPa1VuFQ6MrMIuOqlk3hcKfhm5+aIXAozdMwBHnXuw
D3aMRlMM41Bt24JWepgdlJROMuSm7S6NpDYaVTONhKdpvzUBOV9XI3kkHMr+AETQiEN6BAgvSd0EeD8H wxFPMUyGyZWGRnqYLZSUVjLkps2+nZKaaFT1NBKepv0jK5H1JQEbB6Oh/BSCGBpxxGsBwnPSEwK8mwE4
cErMZAZxJzOO1zKj5QQzfmtmRmsT/Z5kRvE0u//jFJlvR6NdjcrJTSi2xqPTWYey3t2/GsQcViNqWCVp JaqZRdQxq72KWR0nmPVLPbMO1dHvSWYVT7M7306RuRZmtxrlY+tROJKCVm81it9n/6oVt7NKUcvKSTqS
J0kzTPpC6tUwCcBjOl/E/OKbboudrNGRikpbEvbRKbPptC2OSmltQfGYLlZ8o1FsYxX0XIrGY5FJN3qD 9jOpl9SlZRKAx3S2iE2Lb2oXW5nZsxnlrnXYR6fU0WkbPOXS2pziMZ2v+Ear2MTK6LkUDCdhG93oNbZI
KRTHbIclE9+2pdcfQAsrHI+RXnT8bRpNSamy+Gb8v/UH0MDSzVGIo6SsoDjzb0OZP+f/W9ykVaxm8QPB 1LgOSSbBbQuvP4AGlj+cKL3o+Ns0npJS4QzO+H/rD6CWbbHHIZmSsoTizL8NpdM5/9/iJo2iiaX0hUNB
UFAMw94KCHhNKTHJCKinhHHzEOp8OY/hCwJ8khFQTfELpc4FukDCc9JTAryTEVA2opdGou8l0QXS95De MYx6IyDkJaXEJiPgOCWMm0dQ54t5DJ8RoFNGgIniF0mdC3SBhKekRwR4KyOgdNAojcTYRaILZHxNeiUX
yAWgLHOjebVozgXhN40Crc2i/A+XAAAAAElFTkSuQmCC gLLMjWbVvDkXhN9lPK1NCDBSGgAAAABJRU5ErkJggg==
</value> </value>
</data> </data>
<data name="BTT_ADD_NO_SHORTS.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_ADD_NO_SHORTS.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN8SURBVEhLrZVZSJRRGIZ/U1wSdcK2caMsW6nR3Chm1LRZ YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN6SURBVEhLrZVJTFNRFIYfQhgkQA1OZTCKoqLBVgRRpEpb
UosmTS2XNpc0tEQnaUPMiugmiu6iC4mIbsLoquXCJCpbdMx/XKapcVbHAqP7E2/f+RvJC9Gw/4MXBs7h hQpqrAwiBYJIQTCiBCpxSuO41GjcGRfEGOPGYFw5LJAYFQco8opQIKUTFEkw7K/5PfelRBYEDL6T/GmT
fb7znff8I8xXwTcDu0JuBWI28TX/toUXN8owp7DcAQ20gxoYRJJFgwP2PAni37bw4ibbP6Wwxb0CIt8I e/N/55733/eEhSr0XnBb2P1gzCW+Fti2+OJGabZUpuvR4ECvBgaRZNeg2KmXIIFtiy9ukvE9lS3tFBD9
iH4vIPZjEGrc+fIB1GIKi3orYNn7AKwaCEGyGIkzviL5ANkE4J0nmkOwbTgKOaMrcPl7hXwArZjBEs2h UUDsFwHx30Jg9ubLB9glprKYTwJWfAnC2p4wqMVoXPAXygfYQwDeeZItDGn9McgZWIWbk+XyAbRiGkuy
SB9WQG+Nofmvxc2pWvkAx0Q1S7MokG+NxaHx9ah1JOPuzyb5AC0ju5jhcxwqHRvR4NyGFtcO3P9p+jfA hSOjX4E8RxzNfwPuTdXKB6gWd7F0uwL5jniUjW5CrUuNR9ON8gGaxRxmGEpAhSsFDe40NHuy8GTa8m+A
XDmfVv2I7leFYwManWlo82rQ4dOh60crlj4Im1PKR+FdUod50xmnfBeMarDfmosqux6Nrr046zmAK74q +XI+I3Of7ne5azPOutPROqbBNX8u2n61YPnTiHmlfB7ZJnWon8k45btgQINjDh0qnXk46zmCi75i3PJX
+p2Gc54sXPLp0TlpQNdUK+5NmSTQnakm3PhejUuT5TjjKaYRFqDBUQpldzj+XCKZR76mjPcJiBsIhopi 0v90XPLtxXV/Hm5MGNA21YLHUxYJ9HCqEXcna3B9woQLviIaYQEaXMehbI+EBODm0R8o410CEnpCoaIY
yJNi/JKIo47NOOXKxHnvTjIw4OpkvgTomNCRmQa1zmSUfElC3thKqCyRiO8PhoJ8Si3GvwDeOTfniypL 8qQYR5Jw0rUV5zyZuDymJQMDbk/kS4Br47lkpkGtW42SkWToB1dDZY9GYncoFORz3G78C+Cdc3O+qLJH
BG1WoshvftqdiQueXHT6DATQ4eJELkweNd1FKo6Mb8I+22pkjy7HFjECMQNBULwTEEaPsmhwBqBgWIME 0WYlCgPm572ZuOLT4YbfQIBcXB3XweLLpmexA1WjW3B0eB32DaxEqhiFuJ4QKD4LiKBLWdg7C1DQr8Ea
Mk+mDvKsSimGNU4Vmt0ZOOfNwQUyPevJhsmtxmlXOupordKxCXtsq5BFJ5XM+4PAHyM3D3gmwPhuBuCg MldTB3qHUoqh2a1Ck3cnLo3l4AqZXvTtg8WbjfOeDNTRWoVrCw4Pr8VeOqlk3h0Cfhm5edBrAcbPswAn
dRe2D0dTDONQbt+AJrrMVkpKGxly0xb3DknNNKo6GglPU6EtAeqR5dg4FA7lh0BE0IhDewQIT0ndBHg1 HPuxuz+WYpgAk3MzGulhtlBSWsmQmzZ7syQ10ajqaCQ8TYeG1yD7x0qk9EVC+TUYUTTi8A4BwitSOwHe
A1Bvy2Imu461uytZu+c46/DWsY6JWtbpPcGufT3Jbn+rJ/MM1DhUKBtfh3xbPNpcVTgsFv6qHtGzClHL zwLUD2Qxy5COWUcrmNV1ilnddczqqaXf0+ym4wx78LOezHfC7FKhdHQj8ocT0eqphMlm+F0j6lm5qGWl
ykg6kvYT6SOpT8skAI/pbBGbFt90y97GapxbUWZPwm46ZSadtsFZJq3NKR7T+YpvvP61mZXQvejHYpFK JB1J+530jdSlZRKAx3SuiM2Ib7oz1MrM7m0odSbjIJ0yk07b4C6V1uYVj+lCxTfedjSxEnoueYPx2EE3
L3qNOQxH7PslE/+2hRc3af/cwHRjMdKHjn9Noykph6z+Gf9vSYDRapZiiUIcJWUJxZn/NxRP5/x/i5s0 er0tAlXOY5JJYNvii5tYfzSw3ME46UXH36axlJQyR2DG/1sSQKxh2+0xSKCkLKM4829D0UzO/7e4SaNo
WcpZfH8IFBTDxS8FBD6nlJhlBBwTdYybh1Lni3gMnxDgrYyAcopfGHUu0AMSHpMeEqBXRkDxkFEaibGP YondYVBQDJe+ExD8hlJikxFQLeoYNw+nzpfwGL4kwCcZASaKXwR1LtAFEl6QnhGgU0ZAUZ9RGomxi0QX
RA/I2EN6IReAssyNZtW8OReE31w2r8aW2OYjAAAAAElFTkSuQmCC yNhBeisXgLLMjebUgjkXhD+4Jq73JQ87ogAAAABJRU5ErkJggg==
</value> </value>
</data> </data>
<data name="BTT_ADD_SHORTS_ONLY.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_ADD_SHORTS_ONLY.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN8SURBVEhLrZVZSJRRGIZ/U1wSdcK2caMsW6nR3Chm1LRZ YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN6SURBVEhLrZVJTFNRFIYfQhgkQA1OZTCKoqLBVgRRpEpb
UosmTS2XNpc0tEQnaUPMiugmiu6iC4mIbsLoquXCJCpbdMx/XKapcVbHAqP7E2/f+RvJC9Gw/4MXBs7h hQpqrAwiBYJIQTCiBCpxSuO41GjcGRfEGOPGYFw5LJAYFQco8opQIKUTFEkw7K/5PfelRBYEDL6T/GmT
fb7znff8I8xXwTcDu0JuBWI28TX/toUXN8owp7DcAQ20gxoYRJJFgwP2PAni37bw4ibbP6Wwxb0CIt8I e/N/55733/eEhSr0XnBb2P1gzCW+Fti2+OJGabZUpuvR4ECvBgaRZNeg2KmXIIFtiy9ukvE9lS3tFBD9
iH4vIPZjEGrc+fIB1GIKi3orYNn7AKwaCEGyGIkzviL5ANkE4J0nmkOwbTgKOaMrcPl7hXwArZjBEs2h UUDsFwHx30Jg9ubLB9glprKYTwJWfAnC2p4wqMVoXPAXygfYQwDeeZItDGn9McgZWIWbk+XyAbRiGkuy
SB9WQG+Nofmvxc2pWvkAx0Q1S7MokG+NxaHx9ah1JOPuzyb5AC0ju5jhcxwqHRvR4NyGFtcO3P9p+jfA hSOjX4E8RxzNfwPuTdXKB6gWd7F0uwL5jniUjW5CrUuNR9ON8gGaxRxmGEpAhSsFDe40NHuy8GTa8m+A
XDmfVv2I7leFYwManWlo82rQ4dOh60crlj4Im1PKR+FdUod50xmnfBeMarDfmosqux6Nrr046zmAK74q +XI+I3Of7ne5azPOutPROqbBNX8u2n61YPnTiHmlfB7ZJnWon8k45btgQINjDh0qnXk46zmCi75i3PJX
+p2Gc54sXPLp0TlpQNdUK+5NmSTQnakm3PhejUuT5TjjKaYRFqDBUQpldzj+XCKZR76mjPcJiBsIhopi 0v90XPLtxXV/Hm5MGNA21YLHUxYJ9HCqEXcna3B9woQLviIaYQEaXMehbI+EBODm0R8o410CEnpCoaIY
yJNi/JKIo47NOOXKxHnvTjIw4OpkvgTomNCRmQa1zmSUfElC3thKqCyRiO8PhoJ8Si3GvwDeOTfniypL 8qQYR5Jw0rUV5zyZuDymJQMDbk/kS4Br47lkpkGtW42SkWToB1dDZY9GYncoFORz3G78C+Cdc3O+qLJH
BG1WoshvftqdiQueXHT6DATQ4eJELkweNd1FKo6Mb8I+22pkjy7HFjECMQNBULwTEEaPsmhwBqBgWIME 0WYlCgPm572ZuOLT4YbfQIBcXB3XweLLpmexA1WjW3B0eB32DaxEqhiFuJ4QKD4LiKBLWdg7C1DQr8Ea
Mk+mDvKsSimGNU4Vmt0ZOOfNwQUyPevJhsmtxmlXOupordKxCXtsq5BFJ5XM+4PAHyM3D3gmwPhuBuCg MldTB3qHUoqh2a1Ck3cnLo3l4AqZXvTtg8WbjfOeDNTRWoVrCw4Pr8VeOqlk3h0Cfhm5edBrAcbPswAn
dRe2D0dTDONQbt+AJrrMVkpKGxly0xb3DknNNKo6GglPU6EtAeqR5dg4FA7lh0BE0IhDewQIT0ndBHg1 HPuxuz+WYpgAk3MzGulhtlBSWsmQmzZ7syQ10ajqaCQ8TYeG1yD7x0qk9EVC+TUYUTTi8A4BwitSOwHe
A1Bvy2Imu461uytZu+c46/DWsY6JWtbpPcGufT3Jbn+rJ/MM1DhUKBtfh3xbPNpcVTgsFv6qHtGzClHL zwLUD2Qxy5COWUcrmNV1ilnddczqqaXf0+ym4wx78LOezHfC7FKhdHQj8ocT0eqphMlm+F0j6lm5qGWl
ykg6kvYT6SOpT8skAI/pbBGbFt90y97GapxbUWZPwm46ZSadtsFZJq3NKR7T+YpvvP61mZXQvejHYpFK JB1J+530jdSlZRKAx3SuiM2Ib7oz1MrM7m0odSbjIJ0yk07b4C6V1uYVj+lCxTfedjSxEnoueYPx2EE3
L3qNOQxH7PslE/+2hRc3af/cwHRjMdKHjn9Noykph6z+Gf9vSYDRapZiiUIcJWUJxZn/NxRP5/x/i5s0 er0tAlXOY5JJYNvii5tYfzSw3ME46UXH36axlJQyR2DG/1sSQKxh2+0xSKCkLKM4829D0UzO/7e4SaNo
WcpZfH8IFBTDxS8FBD6nlJhlBBwTdYybh1Lni3gMnxDgrYyAcopfGHUu0AMSHpMeEqBXRkDxkFEaibGP YondYVBQDJe+ExD8hlJikxFQLeoYNw+nzpfwGL4kwCcZASaKXwR1LtAFEl6QnhGgU0ZAUZ9RGomxi0QX
RA/I2EN6IReAssyNZtW8OReE31w2r8aW2OYjAAAAAElFTkSuQmCC yNhBeisXgLLMjebUgjkXhD+4Jq73JQ87ogAAAABJRU5ErkJggg==
</value> </value>
</data> </data>
<data name="MENU_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="MENU_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN9SURBVEhLrZVZSJRRGIZ/U1wSdcK2cYmyzYyayTQrHStn YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN7SURBVEhLrZVbSJNhGMe/Ujwk6sKy5iHKsqysaVojcbnN
cdKKJi3NjRaXMrJEJ9EMyza6CqO76EIiopsoumq5qIjSSp3yn1FHbZzNxgSj+yNv3/kZyQvRsP+DFwbO cksrWmqZJ8o8pJEluqQTo6zuIoruoguJiG7C6KrDhUlUdnDTvk23jLmTzQSj+zf+Pe/HJC9Ew74H/mzw
4X2+8533/CPMVcFtge0hdwIxk/iaf9v8ixulWtQsq0cD/VcNjCLJqsFhh1aC+LfNv7jJ9m9qtvCdgMiP vvx/z/t8//f7hPkq4nZYd+SdMMwmvhbatvDiRtm2TKa3arBnUAOjSLJrUO4ulCChbQsvbpI7lMmW9AmI
AqI/C4jtCkKFJ0c+QLqoZlEdApZ8DsDKnhCoxUhc8OXJB8gkAO88wRKCZFsUdvcvw7XxEvkAOjGVJVhC eycg4aOA5M/haPAXywdQi5ks/r2A5R8XYbU1ElliHM4FS+UD5BGAd55mi8Q2Rzy0IytwbbJaPoBWzGZp
kWpTINseQ/Nfg7aJSvkAJ8R0lmJVIMcei6KR9ah0qnH/d418gDqblhkH41Dq3IBqVzLq3Dvx8Lf53wCz tihsdyhgcCXR/Nfh9lSjfIA6Uc1y7QoUu5JRObYBjZ4s3P/VKh+gXSxgxq8pqPFsRIt3G9p9eXj4y/xv
5XxKp2z6yRJnIs66UtAwqsEVnwHtv+qx+FHYrFI+CW+XOtROZZzynduvwSF7Fsoc2TjrPoBG72Fc95XR gLlyPq36Id3vak8GTntz0TmuwZVgEbp/dmDZo+g5pXwS0y11WDidccp3yYgGh1x61LoNOO07gPOBclwP
7xQ0eTPR6svG1TEj2ifq8WDCLIHuTdTg9ng5WseKccGbTyPMRbWzAMqn4ZAA3DzyA2W8U0BcTzBUFEOe 1tL/XFwI7MLVoAFdE0Z0T3XgwZRZAt2basWtyXpcnajCuUAZjbAELZ4jUPbEQAJw87i3lPF+ASnWCKgo
FNNwAo47N+KcOw0XR/eQgRE3xnIkwJUfBjLToNKlxpHhtdAOLIfKGon47mAoyKfAavoL4J1zc76oskbQ hjwppm9pOO7ZjDM+NS6O68jAiBsTxRLgyvciMtOg0ZuFw9/SUehcCZU9DqkDEVCQzxG76S+Ad87N+aLK
ZiXy/ObnPWlo9mbhqs9IAAMu/ciC2ZtBd7EVx0aScHBoFXb1L8UmMQIxPUFQfBIQRo8y7+s0QK5NgxVk HkublSgNmZ/1q3EpoEdX0EiAIlz+roc5kE/PIgfHxjbh4OgaFIwkYosYiyRrOBQfBETTpSwdnAEocWiw
rqYOtHalFMMKlwq1nm1oGt2NZjJt9O6C2ZOB8+5UVNFaqTMJ+4dWIpNOKpl3B4E/Rm4e8FKA6dM0wFG7 isyzqINCl1KKYYNXhTb/DlwY1+ISmZ4PFMDsz8dZ33Y00VqNZxP2j67GLjqpZD4QDn4ZufmiFwJMH2YA
Djts0RTDOBQ7ElFDl1lPSWkgQ25a59kpqZZGVUUj4WnaN7QCGX1LsaE3HMovgYigEYe+ESC8ID0lwPtp jrp2Y6cjgWKYgip3BlrpYXZQUjrJkJu2+/MktdGommgkPE37RlchfzgRG7/EQPkpDLE04qheAcJzUg8B
gNODGmb+rmct7lLW4jnJLnur2OXRStbqPcVuDp9hd3+eJvNtqHCqUDiyDjlD8Whwl6GsN3ey3GZgJaKO 3swANA/vZGaXjlncNcwydoJZPE3M4m2k35Osy3mK3f3RTOY70OBRoWJsPYpHU9Hpq0Wl1fC7XtSzalHL
FZL0JN03UhepU8ckAI/pTBGbEt/U9r2BVbg2o9CxFnvplGl02mpXobQ2q3hM5yq+8dZwLTtC95I9EIut Kkg6knaI9JnUr2USgMd0tohNi2+66epkDd6tqHCnYy+dUk2nbfFWSGtzisd0vuIbrzvb2GF6LgZnMnLo
9KJXW8JwzHFIMvFvm39xkxZ7NTMMxEgfOv41jaakFNn9M/7fkgB95WyLNQpxlJRFFGf+35A/lfP/LW5S Rq+1ReOY+5BkEtq28OImFkcLK3ImSS86/jZNoKRUukIz/t+SAGI9y7bHI4WSspTizL8NZdM5/9/iJq1i
Ixaz+O4QKCiGC98KCHxFKbHICDgh6hk3D6XOF/AYPidAh4yAYopfGHUu0AMSnpEeE+CdjID8XpM0ElMn FUsdiISCYrjktYCwl5QSm4yAOlHHuHkUdb6Yx/AZAd7LCKii+EVT5wJdIOEp6TEB+mQElH0xSSMx9ZPo
iR6Q6Q3ptVwAyjI3mlFz5lwQ/gBru6+QfGvWdQAAAABJRU5ErkJggg== Apl6Sa/kAlCWudGsmjfngvAH4HCuyOLK/ToAAAAASUVORK5CYII=
</value> </value>
</data> </data>
<data name="BTT_STOP.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="BTT_STOP.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8 iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVESURBVEhLjZVrTJNXGMcLQmdHO6AdarLSOcQBQgv0raV1 YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVCSURBVEhLjZVtTFNXGMcLQmdHO1461GSlc4jjvUBvLbdu
XnBcpGjBlgo6RtSMiisoXlCiGI3RxMVLsmQftg/bhy0zmXFLdFk2JoyaOYFMGKiwlIsOaym9F152SRbo Ko4XKVqwpYKOETWj4gqKLyhRjMZoovElWbIP24ftw5aZzLgluiyTCaNmKrApAltZENBhLaXvhctekkV6
2f+UVmcsG0/yy9v3nOf8n3+fc9735dDoLyqKM6ekfHxz2bKRGxLJR5vF4lcwHBOc/J8YVipVv0kkt0aX 9j+l1RnLxpP8cnvPec7/+fc5597Lo9FfXBxjSk7++PqSJSPXpNKP1kskr2A4KjD5PzGsVLK/SaU3Rhcv
Lu27lppqwFAciApO0hgwmfh3ioq+HG5uJmOXLpHepqbADZWqI08gWInp2LmsyGFhmLX2HTsesefPk+mL 7ruckqLHUAyICEzSMBuNwtvFxV8Ot7SQsfPnyY/Nzf5rLNuZLxItx3T0bFb4GGKYN21btjzkzpwh0+fO
F8lIZaX3g/T0ekl8fCKm54p0rFjx4dChQ+Th6dNk7NQpYkOy9ehR0qpS3ZIJBK8jJWKRUbX6TYhb2QsX kZGqKs8HaWkN0tjYeEzPFulctuzDe/v2kQfHj5OxY8eIFcmWgwdJG8vekIlEryMlbJFRleotiFu4s2cJ
CIu1bEsLmT55kgxptb6vxeL3kSIEMZybIpGNij9saiKPjh8nNiRNnDtH7jc3B24olT9JBYI0JD5TBG0p h7VcayuZPnqU3NNovF9LJO8jJQFE8a6LxVYq/qC5mTw8fJhYkTRx6hTpa2nxX1Mqb2aLRKlIfKYI2lJi
tldV2ahzKj4NcfbIETINY/6aGmJOShpEmgoIOO3JyZdHamvJGApYge3YMWLHAufZs2QQ7WpXqbqy+Px0 q662UudUfBri3IEDZBrGfLW1xJSYOIg0Foh4HUlJF0bq6sgYCliA9dAhYsMCx8mTZADt6mDZ7iyhMA3J
JAeLDMvlxROVlbap994jLMxMwxSLddMHD5LJvXtJq1Lp3ikSXUVqKRBy9MuXv9qqUNzq2b078BhJ42AC gSLDcnnJRFWVder0acLBzDRMcVg3vXcvmdy5k7Qpla6tYvElpJaBBJ5u6dJX2xSKGz3bt/sfIWkcTMCN
bpzYEw9a5jp8mNxEkVw+P+MXhikaNxjsU2fOBFvCwjGL9rKNjWQK4ubcXG8aj/cZhI1ABuiGc2IZkSgd A3viRsuc+/eT6yiSJxSm32WY4nG93jZ14kSgJRwcc2gv19REpiBuysvzpAoEn0HYAGSAbjgvmhGL01Ck
RbqsO3cS+759xNHQQJwHDhA3ivkgZGloCHSr1XcflJfb2BMngo5ZzLHIZevrn4hn8HiXoVcLMkPi0SAY 27J1K7Ht2kXsjY3EsWcPcaGYF0LmxkZ/j0o1cL+iwsodORJwzGGOQy7X0PBEPF0guAC9OpAZFI8EgeDn
3FyhMON7ubzzXnV1wFFXR1zAYzIRLwT8KObfv59Mwe0UFcY9i/ugONrbqVD4ZHw+FafOV4HF4OlRDQVX JSSkfyeXd92tqfHb6+uJE7iNRuKBgA/FfLt3kym4naLCuOdwHxBHe7sUCq9MKKTi1HkGWAieHtVg8JUJ
KRSuas/O7rJv20Zcu3YRD/AZjcQPh5MoOIkNnCwvJ/6NG4lfrSZe0JmX588RCK5g/R5AnfPAc+Lh4K5O CRkdOTndtk2biHPbNuIGXoOB+OBwEgUnsYGTFRXEt3Yt8alUxAO68vN9uSLRRazfAahzAXhOPBT8FfHx
TMxsl8m6BtaunfFu3048Gg3xMAxxi8XELRAQd2wscS9aRCx8fqAtJcWnSkigG1oHssCLYF7xcATbdUcm mR0yWbeZZR97Nm8mbrWauBmGuCQS4hKJiCs6mrgWLCBmodDfnpzsZePi6IbWgyzwIphTPBSBdt2Wyfon
65+AoANiTuACVDhITAzpy87+y5Ce/i3y3wVSsCDxYNhrakx2tdrq4PGeFwd0bCA1dcas1T7ISE4ux5J4 IGiHmAM4ARUOEBVF+nJy/tKnpX2L/PdANpiXeCBstbVGm0plsQsEz4sDOmZOSXls0mjupyclVWBJLJif
sDBxv9F42F1Q4HbA/Xzi4+ARsGZmkj6dbvCtNWtysPQ/XyvB8BiNLa5NmzyOuLjnxF3oPW0XFR8DI9HR uM9g2O8qLHTZ4X4u8XHwEFgyM0mfVjv49sqVuVj6n6+VQLgNhlbnunVue0zMc+JO9J62i4qPgZHISGIG
ZAB05+QE+isqfjWoVLRN8xfx7dlz3FlS4o3k3CUSkcclJX8PpqUFqPhwSLwXdIIfGWa2n/6T+YrgKLY4 N3Nz/f2Vlb/qWZa2ae4i3h07DjtKSz3hnDvFYvKotPTvgdRUPxUfDor3gi5gYpiZfvpP5iqCo9hqLyz0
Cgp8Dj4/KPxMW5YsIZbS0t/PrF/f3btly4Q1I4Pch2gPuE3FgZmyevXszwbD3QKZjL4gn77qvbW1zVTc 2oXCgPAzbVm0iAyVlf1+YvXqnt4NGyYs6enkF4jeAbfAD7QAZcWKmZ/0+oFCmYy+IJ++6j11dS1U3BFO
GUk8KYlYNmz4o55h2pHaUJKV9fZgWdkDC3ofFu8AbaCVFlEqZ7srKno/1WrpxnNBFMe7davNmZAQ2TnE PDGRDK1Z80cDw3QgtbE0K+udwfLy+0PofUi8E7SDNlpEqZzpqazs/VSjoRvPBxE8z8aNVkdcXHjnEK+X
6+TyNiSaAN1I4YH8/Df69PrRu1LpE/HvwDfgOuiXSmd69Poh5C4HXI5Dp7N4JZKIzk0M8wOS6kPi4S8V y9uRaAR0IxP2FBS80afTjQ5kZz8Rvwq+AVdAf0bG4zs63T3kLgV8nl2rHfJIpWGdGxnmeyQ1BMVDXyr+
92BhoaqvomK0XSoN/Fv8q6go0pOVNWPWaMaRVwQSOd3V1TsmNBqPB6Jh5wPFxX/uiyweDm5jfn4eNnbk 3qIitq+ycrQtO9v/b/GvIiLIHRQwqdXjyCsG8byempotE2q12w3RkHNzScmfu8KLh4LfVFCQj40duZ2T
TnY2uRYSN+flzX6h0TwuXbnyE+TMFUAsbqusPGErK/MNqVQB6rxRoejA+Hzi4eAa162T03a0YZ1ZrZ69 Qy4HxU35+TNfqNWPypYv/wQ5swUQC9urqo5Yy8u9gyzrp86bFIpOjM8lHgq+YdUqOW3HVawzqVQzl+D8
Cucv8XgXMacDcy1CRDEpKfG9ev3nD8vKXFcKC3H6ohsxzgA+nadJ8wT3elXVO/d0uvHbWq27JC2Nfgv0 JYHgHOa0YLZFiAgmOTm2V6f7/EF5ufNiURFOX2QTxhkgpPM0aY7gX6mufvdnrXb8lkbjKk1Npd8CHZAA
QAzocX2ylv5IAAqwOXRd6OP/AqBHk56cLeA1EPGBWwSoY/qxpld6v5CgJuj7/+UQtGDIGIfzD+o72WmD elyfrKU/4oACrA9e5/v4vwDo0aQnZwN4DYR94BYA6ph+rOmV3s8nqAn6/n85CC0YNMbj/QOlgNkkdPGc
vfrkAAAAAElFTkSuQmCC ugAAAABJRU5ErkJggg==
</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==
</value> </value>
</data> </data>
<data name="BTT_LOG.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <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 If e.Control Then useCookies = True
Dim useCookiesParse As Boolean? = Nothing Dim useCookiesParse As Boolean? = Nothing
If useCookies Then useCookiesParse = True 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 c As IYouTubeMediaContainer = Nothing
Dim url$ = String.Empty Dim url$ = String.Empty
@@ -264,7 +266,7 @@ Namespace DownloadObjects.STDownloader
pForm.SetInitialValues(.Count, "Parsing playlists...") pForm.SetInitialValues(.Count, "Parsing playlists...")
Dim containers As New List(Of IYouTubeMediaContainer) Dim containers As New List(Of IYouTubeMediaContainer)
For Each u$ In .Self 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.NextPlaylist()
pForm.MyProgress.Perform() pForm.MyProgress.Perform()
Next Next
@@ -295,7 +297,7 @@ Namespace DownloadObjects.STDownloader
pForm = New ParsingProgressForm pForm = New ParsingProgressForm
pForm.Show(Me) pForm.Show(Me)
pForm.SetInitialValues(1, "Parsing data...") 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() pForm.Dispose()
End If End If
If Not c Is Nothing Then 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) ControlInvoke(TOOLBAR_TOP, BTT_STOP, Sub() BTT_STOP.Enabled = False, EDP.SendToLog)
MyJob.Cancel() MyJob.Cancel()
End Sub End Sub
#Region "Delete / Clear"
Private Sub BTT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_DELETE.Click Private Sub BTT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_DELETE.Click
RemoveControls(ControlsChecked, True) RemoveControls(ControlsChecked, True)
End Sub 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 Protected Overridable Sub BTT_CLEAR_DONE_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DONE.Click
RemoveControls(ControlsDownloaded, False) RemoveControls(ControlsDownloaded, False)
End Sub End Sub
Protected Overridable Sub BTT_CLEAR_ALL_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_ALL.Click Protected Overridable Sub BTT_CLEAR_ALL_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_ALL.Click
RemoveControls(, False) RemoveControls(, False)
End Sub End Sub
#End Region
Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click
MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton) MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton)
End Sub End Sub
@@ -526,6 +533,7 @@ Namespace DownloadObjects.STDownloader
MyProgress.InformationTemporary = "Download error" MyProgress.InformationTemporary = "Download error"
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[VideoListForm.DownloadData]") ErrorsDescriber.Execute(EDP.SendToLog, ex, "[VideoListForm.DownloadData]")
Finally Finally
MyProgress.Visible(, False) = False
MyJob.Finish() MyJob.Finish()
EnableDownloadButtons(False) EnableDownloadButtons(False)
End Try End Try

View File

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

View File

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

View File

@@ -112,7 +112,7 @@ Namespace API.YouTube.Objects
End Set End Set
End Property End Property
<XMLEC(Name_IsMusic)> Public Property IsMusic As Boolean = False Implements IYouTubeMediaContainer.IsMusic <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 ID As String Implements IYouTubeMediaContainer.ID, IUserMedia.PostID
<XMLEC> Public Property Title As String Implements IDownloadableMedia.Title <XMLEC> Public Property Title As String Implements IDownloadableMedia.Title
<XMLEC> Public Property Description As String Implements IYouTubeMediaContainer.Description <XMLEC> Public Property Description As String Implements IYouTubeMediaContainer.Description
@@ -709,6 +709,19 @@ Namespace API.YouTube.Objects
End Sub End Sub
#End Region #End Region
#Region "Download" #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) Private ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue)
Public Property Progress As MyProgress Implements IYouTubeMediaContainer.Progress Public Property Progress As MyProgress Implements IYouTubeMediaContainer.Progress
Private Property IDownloadableMedia_Progress As Object Implements IDownloadableMedia.Progress Private Property IDownloadableMedia_Progress As Object Implements IDownloadableMedia.Progress
@@ -807,6 +820,13 @@ Namespace API.YouTube.Objects
Try Try
Dim url$ = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={PlsId}" Dim url$ = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={PlsId}"
Dim r$ 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 Using resp As New Responser
If UseCookies And MyYouTubeSettings.Cookies.Count > 0 Then resp.Cookies.AddRange(MyYouTubeSettings.Cookies,, EDP.SendToLog) If UseCookies And MyYouTubeSettings.Cookies.Count > 0 Then resp.Cookies.AddRange(MyYouTubeSettings.Cookies,, EDP.SendToLog)
r = resp.GetResponse(url,, EDP.ReturnValue) r = resp.GetResponse(url,, EDP.ReturnValue)
@@ -882,6 +902,21 @@ Namespace API.YouTube.Objects
End If End If
If Not File.Exists Then _File.Name = File.File If Not File.Exists Then _File.Name = File.File
If File.Exists Then 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 PlaylistCount > 0 And Not CoverDownloaded And Not PlaylistID.IsEmptyString Then DownloadPlaylistCover(PlaylistID, File, UseCookies)
If prExists Then Progress.InformationTemporary = $"Download {MediaType}: post processing" If prExists Then Progress.InformationTemporary = $"Download {MediaType}: post processing"
_ThumbnailFile = File _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) If fc.Exists(SFO.Path, False) AndAlso SFile.GetFiles(fc, "*.json",, EDP.ReturnValue).Count > 0 Then Parse(Nothing, fc, IsMusic)
XMLPopulateData(Me, x) XMLPopulateData(Me, x)
_MediaStateOnLoad = _MediaState _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 If(x(Name_CheckedElements)?.Count, 0) > 0 Then ApplyElementCheckedValue(x(Name_CheckedElements))
If ArrayMaxResolution <> -10 Then SetMaxResolution(ArrayMaxResolution) If ArrayMaxResolution <> -10 Then SetMaxResolution(ArrayMaxResolution)
End Using End Using
@@ -1309,9 +1348,29 @@ Namespace API.YouTube.Objects
Next Next
End If End If
End Sub 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 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.Audio)
If MediaObjects.Count > 0 Then DupRemover.Invoke(UMTypes.Video) If MediaObjects.Count > 0 Then DupRemover.Invoke(UMTypes.Video)
If MediaObjects.Count > 0 Then protocolCleaner.Invoke
If MediaObjects.Count > 0 Then If MediaObjects.Count > 0 Then
MediaObjects.Sort() MediaObjects.Sort()
SelectedAudioIndex = MediaObjects.FindIndex(Function(mo) mo.Type = UMTypes.Audio) 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: ' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")> ' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2023.8.6.0")> <Assembly: AssemblyVersion("2023.10.10.0")>
<Assembly: AssemblyFileVersion("2023.8.6.0")> <Assembly: AssemblyFileVersion("2023.10.10.0")>
<Assembly: NeutralResourcesLanguage("en")> <Assembly: NeutralResourcesLanguage("en")>

View File

@@ -67,7 +67,6 @@ Namespace API.Base.GDL
End Function End Function
End Module End Module
Friend Class GDLBatch : Inherits TokenBatch Friend Class GDLBatch : Inherits TokenBatch
Friend Property TempPostsList As List(Of String)
Friend Const UrlLibStart As String = "[urllib3.connectionpool][debug]" Friend Const UrlLibStart As String = "[urllib3.connectionpool][debug]"
Friend Const UrlTextStart As String = UrlLibStart & " https" Friend Const UrlTextStart As String = UrlLibStart & " https"
Friend Sub New(ByVal _Token As Threading.CancellationToken) Friend Sub New(ByVal _Token As Threading.CancellationToken)
@@ -75,20 +74,11 @@ Namespace API.Base.GDL
MainProcessName = "gallery-dl" MainProcessName = "gallery-dl"
ChangeDirectory(Settings.GalleryDLFile.File) ChangeDirectory(Settings.GalleryDLFile.File)
End Sub 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) Protected Overrides Async Sub OutputDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
If Not ProcessKilled Then If Not ProcessKilled Then
MyBase.OutputDataReceiver(Sender, e) MyBase.OutputDataReceiver(Sender, e)
Await Validate(e.Data) Await Validate(e.Data)
End If End If
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 Class
End Namespace End Namespace

View File

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

View File

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

View File

@@ -10,18 +10,39 @@ Imports System.Threading
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Namespace API.Base Namespace API.Base
Friend Class TokenBatch : Inherits BatchExecutor Friend Class TokenBatch : Inherits BatchExecutor
Friend Property TempPostsList As List(Of String)
Protected ReadOnly Token As CancellationToken Protected ReadOnly Token As CancellationToken
Friend Property DebugMode As Boolean = False
Friend Sub New(ByVal _Token As CancellationToken) Friend Sub New(ByVal _Token As CancellationToken)
MyBase.New(True) MyBase.New(True)
Token = _Token Token = _Token
End Sub 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) Protected Overrides Async Sub OutputDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
MyBase.OutputDataReceiver(Sender, e) 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 End Sub
Protected Overrides Async Sub ErrorDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs) Protected Overrides Async Sub ErrorDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
MyBase.ErrorDataReceiver(Sender, e) 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 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 Class
End Namespace End Namespace

View File

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

View File

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

View File

@@ -70,13 +70,14 @@ Namespace API.Instagram
End Class End Class
#End Region #End Region
#Region "Authorization properties" #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_IG_WWW_CLAIM As String = "x-ig-www-claim"
Friend Const Header_CSRF_TOKEN As String = "x-csrftoken" Friend Const Header_CSRF_TOKEN As String = "x-csrftoken"
Private Const Header_ASBD_ID As String = "X-Asbd-Id" Friend Const Header_CSRF_TOKEN_COOKIE As String = "csrftoken"
Private Const Header_Browser As String = "Sec-Ch-Ua" Friend Const Header_ASBD_ID As String = "X-Asbd-Id"
Private Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List" Friend Const Header_Browser As String = "Sec-Ch-Ua"
Private Const Header_Platform As String = "Sec-Ch-Ua-Platform-Version" 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)> <PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash for tagged posts", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)>
Friend ReadOnly Property HashTagged As PropertyValue Friend ReadOnly Property HashTagged As PropertyValue
<PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(2)> <PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(2)>
@@ -139,11 +140,13 @@ Namespace API.Instagram
Friend ReadOnly Property GetTimeline As PropertyValue Friend ReadOnly Property GetTimeline As PropertyValue
<PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users"), PXML, ControlNumber(24)> <PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users"), PXML, ControlNumber(24)>
Friend ReadOnly Property GetStories As PropertyValue 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 Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit", <PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr & 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 Friend ReadOnly Property TaggedNotifyLimit As PropertyValue
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)> <Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
@@ -153,7 +156,9 @@ Namespace API.Instagram
Friend ReadOnly Property DownloadTimeline As PropertyValue Friend ReadOnly Property DownloadTimeline As PropertyValue
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories"), PXML, ControlNumber(11)> <PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories"), PXML, ControlNumber(11)>
Friend ReadOnly Property DownloadStories As PropertyValue 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 Friend ReadOnly Property DownloadTagged As PropertyValue
#End Region #End Region
#Region "429 bypass" #Region "429 bypass"
@@ -259,6 +264,7 @@ Namespace API.Instagram
DownloadTimeline = New PropertyValue(True) DownloadTimeline = New PropertyValue(True)
DownloadStories = New PropertyValue(True) DownloadStories = New PropertyValue(True)
DownloadStoriesUser = New PropertyValue(True)
DownloadTagged = New PropertyValue(False) DownloadTagged = New PropertyValue(False)
RequestsWaitTimer = New PropertyValue(1000) RequestsWaitTimer = New PropertyValue(1000)
@@ -270,6 +276,7 @@ Namespace API.Instagram
GetTimeline = New PropertyValue(True) GetTimeline = New PropertyValue(True)
GetStories = New PropertyValue(False) GetStories = New PropertyValue(False)
GetStoriesUser = New PropertyValue(False)
GetTagged = New PropertyValue(False) GetTagged = New PropertyValue(False)
TaggedNotifyLimit = New PropertyValue(200) TaggedNotifyLimit = New PropertyValue(200)
TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
@@ -359,13 +366,16 @@ Namespace API.Instagram
SkipUntilNextSession = False SkipUntilNextSession = False
End Sub End Sub
#End Region #End Region
#Region "UserOptions, GetUserPostUrl" #Region "UserOptions, GetUserUrl, GetUserPostUrl"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) 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 Options Is Nothing OrElse Not TypeOf Options Is EditorExchangeOptions Then Options = New EditorExchangeOptions(Me)
If OpenForm Then If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If End If
End Sub 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 Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Try Try
Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID) 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.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Instagram Namespace API.Instagram
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
#Region "XML Names" #Region "XML Names"
@@ -24,12 +25,13 @@ Namespace API.Instagram
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone" Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
Private Const Name_GetTimeline As String = "GetTimeline" Private Const Name_GetTimeline As String = "GetTimeline"
Private Const Name_GetStories As String = "GetStories" Private Const Name_GetStories As String = "GetStories"
Private Const Name_GetStoriesUser As String = "GetStoriesUser"
Private Const Name_GetTagged As String = "GetTaggedData" Private Const Name_GetTagged As String = "GetTaggedData"
Private Const Name_TaggedChecked As String = "TaggedChecked" Private Const Name_TaggedChecked As String = "TaggedChecked"
Private Const Name_NameTrue As String = "NameTrue" Private Const Name_NameTrue As String = "NameTrue"
#End Region #End Region
#Region "Declarations" #Region "Declarations"
Private Structure PostKV : Implements IEContainerProvider Protected Structure PostKV : Implements IEContainerProvider
Private Const Name_Code As String = "Code" Private Const Name_Code As String = "Code"
Private Const Name_Section As String = "Section" Private Const Name_Section As String = "Section"
Friend Code As String Friend Code As String
@@ -75,15 +77,41 @@ Namespace API.Instagram
Private FirstLoadingDone As Boolean = False Private FirstLoadingDone As Boolean = False
Friend Property GetTimeline As Boolean = True Friend Property GetTimeline As Boolean = True
Friend Property GetStories As Boolean Friend Property GetStories As Boolean
Friend Property GetStoriesUser As Boolean
Friend Property GetTaggedData As Boolean Friend Property GetTaggedData As Boolean
Private _NameTrue As String = String.Empty Protected _NameTrue As String = String.Empty
Private ReadOnly Property NameTrue As String Friend ReadOnly Property NameTrue As String
Get Get
Return _NameTrue.IfNullOrEmpty(Name) Return _NameTrue.IfNullOrEmpty(Name)
End Get End Get
End Property End Property
Private UserNameRequested As Boolean = False Private UserNameRequested As Boolean = False
#End Region #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" #Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptions(Me) Return New EditorExchangeOptions(Me)
@@ -93,37 +121,17 @@ Namespace API.Instagram
With DirectCast(Obj, EditorExchangeOptions) With DirectCast(Obj, EditorExchangeOptions)
GetTimeline = .GetTimeline GetTimeline = .GetTimeline
GetStories = .GetStories GetStories = .GetStories
GetStoriesUser = .GetStoriesUser
GetTaggedData = .GetTagged GetTaggedData = .GetTagged
End With End With
End If End If
End Sub End Sub
#End Region #End Region
#Region "Initializer, loader" #Region "Initializer"
Friend Sub New() Friend Sub New()
PostsKVIDs = New List(Of PostKV) PostsKVIDs = New List(Of PostKV)
PostsToReparse = New List(Of PostKV) PostsToReparse = New List(Of PostKV)
End Sub 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 #End Region
#Region "Download data" #Region "Download data"
Private E560Thrown As Boolean = False Private E560Thrown As Boolean = False
@@ -136,12 +144,22 @@ Namespace API.Instagram
Throw New ExitException Throw New ExitException
End Sub End Sub
End Class 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 x As XmlFile
Dim f As SFile = MyFilePosts Dim f As SFile = MyFilePostsKV
If Not f.IsEmptyString Then If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
If Load Then If Load Then
PostsKVIDs.Clear() PostsKVIDs.Clear()
x = New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True} 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 Friend Function GetPostCodeById(ByVal PostID As String) As String
Try Try
If Not PostID.IsEmptyString Then If Not PostID.IsEmptyString Then
Dim f As SFile = MyFilePosts Dim f As SFile = MyFilePostsKV
If Not f.IsEmptyString Then If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
Dim l As List(Of PostKV) = Nothing Dim l As List(Of PostKV) = Nothing
Using x As New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True} Using x As New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData() x.LoadData()
@@ -206,11 +222,15 @@ Namespace API.Instagram
End If End If
End Function End Function
Private _DownloadingInProgress As Boolean = False Private _DownloadingInProgress As Boolean = False
Private _Limit As Integer = -1
Private _TotalPostsParsed As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
UserNameRequested = False UserNameRequested = False
Dim s As Sections = Sections.Timeline Dim s As Sections = Sections.Timeline
Dim errorFound As Boolean = False Dim errorFound As Boolean = False
Try Try
_Limit = If(DownloadTopCount, -1)
_TotalPostsParsed = 0
LoadSavePostsKV(True) LoadSavePostsKV(True)
_DownloadingInProgress = True _DownloadingInProgress = True
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
@@ -234,6 +254,7 @@ Namespace API.Instagram
If FirstLoadingDone Then LastCursor = String.Empty If FirstLoadingDone Then LastCursor = String.Empty
If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then
If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token) : ProgressPre.Done() If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
If CBool(MySiteSettings.DownloadStoriesUser.Value) And GetStoriesUser Then s = Sections.UserStories : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token) : ProgressPre.Done() If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token) : ProgressPre.Done()
End If End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
@@ -262,7 +283,7 @@ Namespace API.Instagram
Catch ex As Exception Catch ex As Exception
End Try End Try
End Sub End Sub
Private Sub UpdateResponser() Protected Overridable Sub UpdateResponser()
Try Try
If _DownloadingInProgress AndAlso Not Responser Is Nothing AndAlso Not Responser.Disposed Then If _DownloadingInProgress AndAlso Not Responser Is Nothing AndAlso Not Responser.Disposed Then
_DownloadingInProgress = False _DownloadingInProgress = False
@@ -272,10 +293,10 @@ Namespace API.Instagram
Catch Catch
End Try End Try
End Sub 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) Declarations.UpdateResponser(e, Responser)
End Sub 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 StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged" Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass" #Region "429 bypass"
@@ -455,7 +476,7 @@ Namespace API.Instagram
ThrowAny(Token) ThrowAny(Token)
End If End If
If StoriesList.ListExists Then If StoriesList.ListExists Then
GetStoriesData(StoriesList, Token) GetStoriesData(StoriesList, False, Token)
MySiteSettings.TooManyRequests(False) MySiteSettings.TooManyRequests(False)
RequestsCount += 1 RequestsCount += 1
End If End If
@@ -464,6 +485,11 @@ Namespace API.Instagram
Else Else
Throw New ExitException Throw New ExitException
End If End If
Case Sections.UserStories
GetStoriesData(Nothing, True, Token)
MySiteSettings.TooManyRequests(False)
RequestsCount += 1
Throw New ExitException
End Select End Select
'Get response 'Get response
@@ -559,6 +585,7 @@ Namespace API.Instagram
Dim URL$ = String.Empty Dim URL$ = String.Empty
Dim dValue% = 1 Dim dValue% = 1
Dim _Index% = 0 Dim _Index% = 0
Dim before%
If PostsToReparse.Count > 0 Then ProgressPre.ChangeMax(PostsToReparse.Count) If PostsToReparse.Count > 0 Then ProgressPre.ChangeMax(PostsToReparse.Count)
Try Try
Do While dValue = 1 Do While dValue = 1
@@ -587,7 +614,12 @@ Namespace API.Instagram
If Not j Is Nothing Then If Not j Is Nothing Then
If If(j("items")?.Count, 0) > 0 Then If If(j("items")?.Count, 0) > 0 Then
With j("items") 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 With
End If End If
j.Dispose() j.Dispose()
@@ -624,21 +656,24 @@ Namespace API.Instagram
NextCursor = .Value("next_max_id") NextCursor = .Value("next_max_id")
If .Contains("items") Then nodes = (From ee As EContainer In .Item("items") Where ee.Count > 0 Select ee(0)) If .Contains("items") Then nodes = (From ee As EContainer In .Item("items") Where ee.Count > 0 Select ee(0))
End With End With
If nodes.ListExists Then If nodes.ListExists AndAlso DefaultParser(nodes, Sections.SavedPosts, Token) AndAlso
DefaultParser(nodes, Sections.SavedPosts, Token) HasNextPage AndAlso Not NextCursor.IsEmptyString Then SavedPostsDownload(NextCursor, Token)
If HasNextPage And Not NextCursor.IsEmptyString Then SavedPostsDownload(NextCursor, Token)
End If
End If End If
End Using End Using
End If End If
End Sub End Sub
Private Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken, Protected DefaultParser_ElemNode() As Object = Nothing
Optional ByVal SpecFolder As String = Nothing) As Boolean 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) ThrowAny(Token)
If Items.Count > 0 Then If Items.Count > 0 Then
Dim PostIDKV As PostKV Dim PostIDKV As PostKV
Dim Pinned As Boolean Dim Pinned As Boolean
Dim PostDate$ Dim PostDate$, PostOriginUrl$
Dim before%
If SpecFolder.IsEmptyString Then If SpecFolder.IsEmptyString Then
Select Case Section Select Case Section
Case Sections.Tagged : SpecFolder = TaggedFolder Case Sections.Tagged : SpecFolder = TaggedFolder
@@ -649,22 +684,26 @@ Namespace API.Instagram
ProgressPre.ChangeMax(Items.Count) ProgressPre.ChangeMax(Items.Count)
For Each nn In Items For Each nn In Items
ProgressPre.Perform() ProgressPre.Perform()
With nn With If(Not DefaultParser_ElemNode Is Nothing, nn.ItemF(DefaultParser_ElemNode), nn)
PostIDKV = New PostKV(.Value("code"), .Value("id"), Section) PostIDKV = New PostKV(.Value("code"), .Value("id"), Section)
PostOriginUrl = DefaultParser_PostUrlCreator(PostIDKV)
Pinned = .Contains("timeline_pinned_user_ids") Pinned = .Contains("timeline_pinned_user_ids")
If PostKvExists(PostIDKV) Then If Not DefaultParser_IgnorePass AndAlso PostKvExists(PostIDKV) Then
If Not Pinned Then Return False If Not Pinned Then Return False
Else Else
_TempPostsList.Add(PostIDKV.ID) _TempPostsList.Add(PostIDKV.ID)
PostsKVIDs.ListAddValue(PostIDKV, LNC) PostsKVIDs.ListAddValue(PostIDKV, LNC)
PostDate = .Value("taken_at") PostDate = .Value("taken_at")
If Not IsSavedPosts Then If Not DefaultParser_IgnorePass And Not IsSavedPosts Then
Select Case CheckDatesLimit(PostDate, UnixDate32Provider) Select Case CheckDatesLimit(PostDate, UnixDate32Provider)
Case DateResult.Skip : Continue For Case DateResult.Skip : Continue For
Case DateResult.Exit : If Not Pinned Then Return False Case DateResult.Exit : If Not Pinned Then Return False
End Select End Select
End If 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 If
End With End With
Next Next
@@ -675,7 +714,7 @@ Namespace API.Instagram
End Function End Function
#End Region #End Region
#Region "Code ID converters" #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-_" Const CodeSymbols$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
Try Try
If Not Code.IsEmptyString Then If Not Code.IsEmptyString Then
@@ -695,12 +734,20 @@ Namespace API.Instagram
End Function End Function
#End Region #End Region
#Region "Obtain Media" #Region "Obtain Media"
Private Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing, Protected ObtainMedia_SizeFuncVid As Func(Of EContainer, Sizes) = Nothing
Optional ByVal DateObj As String = 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 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 img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0 Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0
Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url")) Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_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 Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String
If Not DateObj.IsEmptyString Then Return DateObj If Not DateObj.IsEmptyString Then Return DateObj
If elem.Contains("taken_at") Then If elem.Contains("taken_at") Then
@@ -720,28 +767,41 @@ Namespace API.Instagram
End If End If
End If End If
End Function 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 If n.Count > 0 Then
Dim l As New List(Of Sizes) Dim l As New List(Of Sizes)
Dim d As EContainer Dim d As EContainer
Dim t% Dim t%
Dim abstractDecision As Boolean = False
'8 - gallery '8 - gallery
'2 - one video '2 - one video
'1 - one picture '1 - one picture
t = n.Value("media_type").FromXML(Of Integer)(-1) 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 If t >= 0 Then
Select Case t Select Case t
Case 1 Case 1
If n.Contains(img) Then 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) DateObj = mDate(n)
If t >= 0 Then If t >= 0 Then
With n.ItemF({img, "candidates"}).XmlIfNothing With n.ItemF({img, "candidates"}).XmlIfNothing
If .Count > 0 Then If .Count > 0 Then
l.Clear() 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 If l.Count > 0 Then
l.Sort() 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() l.Clear()
End If End If
End If End If
@@ -754,10 +814,11 @@ Namespace API.Instagram
With n.ItemF({vid}).XmlIfNothing With n.ItemF({vid}).XmlIfNothing
If .Count > 0 Then If .Count > 0 Then
l.Clear() 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 If l.Count > 0 Then
l.Sort() 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() l.Clear()
End If End If
End If End If
@@ -767,7 +828,7 @@ Namespace API.Instagram
DateObj = mDate(n) DateObj = mDate(n)
With n("carousel_media").XmlIfNothing With n("carousel_media").XmlIfNothing
If .Count > 0 Then 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 If
End With End With
End Select End Select
@@ -854,17 +915,21 @@ Namespace API.Instagram
End Function End Function
#End Region #End Region
#Region "Pinned stories" #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}" 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 qStr$, r$, sFolder$, storyID$, pid$
Dim i% = -1 Dim i% = -1
Dim jj As EContainer, s As EContainer Dim jj As EContainer, s As EContainer
ThrowAny(Token) ThrowAny(Token)
If StoriesList.ListExists Then If StoriesList.ListExists Or GetUserStory Then
tmpList = StoriesList.Take(5) If Not GetUserStory Then tmpList = StoriesList.Take(5)
If tmpList.ListExists Then If tmpList.ListExists Or GetUserStory Then
qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids=highlight:{q}").ListToString("&")) 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) r = Responser.GetResponse(qStr,, EDP.ThrowException)
ThrowAny(Token) ThrowAny(Token)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -876,9 +941,13 @@ Namespace API.Instagram
i += 1 i += 1
sFolder = jj.Value("title").StringRemoveWinForbiddenSymbols sFolder = jj.Value("title").StringRemoveWinForbiddenSymbols
storyID = jj.Value("id").Replace("highlight:", String.Empty) storyID = jj.Value("id").Replace("highlight:", String.Empty)
If sFolder.IsEmptyString Then sFolder = $"Story_{storyID}" If GetUserStory Then
If sFolder.IsEmptyString Then sFolder = $"Story_{i}" sFolder = $"{StoriesFolder} (user)"
sFolder = $"{StoriesFolder}\{sFolder}" 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 &= ":" If Not storyID.IsEmptyString Then storyID &= ":"
With jj("items").XmlIfNothing With jj("items").XmlIfNothing
If .Count > 0 Then If .Count > 0 Then
@@ -896,7 +965,7 @@ Namespace API.Instagram
End If End If
End Using End Using
End If End If
StoriesList.RemoveRange(0, tmpList.Count) If Not GetUserStory Then StoriesList.RemoveRange(0, tmpList.Count)
End If End If
End If End If
End Sub End Sub
@@ -920,6 +989,12 @@ Namespace API.Instagram
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
#End Region #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" #Region "Exceptions"
''' <exception cref="ExitException"></exception> ''' <exception cref="ExitException"></exception>
''' <inheritdoc cref="UserDataBase.ThrowAny(CancellationToken)"/> ''' <inheritdoc cref="UserDataBase.ThrowAny(CancellationToken)"/>
@@ -933,15 +1008,15 @@ Namespace API.Instagram
''' </summary> ''' </summary>
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, 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 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 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 HasError = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]" MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
DisableSection(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 Return 3
ElseIf Responser.StatusCode = 429 Then ElseIf Responser.StatusCode = 429 Then '429
With MySiteSettings With MySiteSettings
Dim WaiterExists As Boolean = .LastApplyingValue.HasValue Dim WaiterExists As Boolean = .LastApplyingValue.HasValue
.TooManyRequests(True) .TooManyRequests(True)
@@ -950,10 +1025,10 @@ Namespace API.Instagram
Caught429 = True Caught429 = True
MyMainLOG = $"Number of requests before error 429: {RequestsCount}" MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1 Return 1
ElseIf Responser.StatusCode = 560 Then ElseIf Responser.StatusCode = 560 Or Responser.StatusCode = HttpStatusCode.InternalServerError Then '560, 500
MySiteSettings.SkipUntilNextSession = True MySiteSettings.SkipUntilNextSession = True
Else 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) DisableSection(s)
If Not FromPE Then LogError(ex, Message) : HasError = True If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0 Return 0
@@ -965,6 +1040,10 @@ Namespace API.Instagram
Dim s As Sections = DirectCast(Section, Sections) Dim s As Sections = DirectCast(Section, Sections)
Select Case s Select Case s
Case Sections.Timeline : MySiteSettings.DownloadTimeline.Value = False 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 Case Else : MySiteSettings.DownloadTagged.Value = False
End Select End Select
MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper
@@ -973,12 +1052,14 @@ Namespace API.Instagram
#End Region #End Region
#Region "Create media" #Region "Create media"
Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String, 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)) _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 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 If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, UnixDate32Provider, Nothing) Else m.Post.Date = Nothing
m.SpecialFolder = SpecialFolder m.SpecialFolder = SpecialFolder
If State = UStates.Missing Then m.State = UStates.Missing : m.Attempts = Attempts
Return m Return m
End Function End Function
#End Region #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" #Region "UpdateServersList"
Private Sub UpdateServersList() Private Sub UpdateServersList()
Try Try
Dim r$ = GetWebString("https://api.joinmastodon.org/servers?language=&category=&region=&ownership=&registrations=",, EDP.ThrowException) Using resp As New Responser With {
If Not r.IsEmptyString Then .ProcessExceptionDecision = Function(rr, obj, e) If(rr.StatusCode = Net.HttpStatusCode.ServiceUnavailable,
Dim j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue) EDP.ReturnValue, EDP.ThrowException)}
If If(j?.Count, 0) > 0 Then Dim r$ = resp.GetResponse("https://api.joinmastodon.org/servers?language=&category=&region=&ownership=&registrations=")
Domains.Domains.ListAddList(j.Select(Function(e) e.Value("domain")), LAP.NotContainsOnly, EDP.ReturnValue) If Not r.IsEmptyString Then
Domains.Domains.Sort() Dim j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
Domains.Save() If If(j?.Count, 0) > 0 Then
j.Dispose() 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
End If End Using
DomainsLastUpdateDate.Value = Now
Catch ex As Exception Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.Mastodon.SiteSettings.UpdateServersList]") ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.Mastodon.SiteSettings.UpdateServersList]")
End Try End Try

View File

@@ -190,7 +190,8 @@ Namespace API.Mastodon
ProcessException(ex, Token, $"data downloading error{IIf(IsSavedPosts, " (Saved Posts)", String.Empty)} [{URL}]") ProcessException(ex, Token, $"data downloading error{IIf(IsSavedPosts, " (Saved Posts)", String.Empty)} [{URL}]")
End Try End Try
End Sub 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 Dim t As UTypes = UTypes.Undefined
Select Case e.Value("type") Select Case e.Value("type")
Case "video" : t = UTypes.Video Case "video" : t = UTypes.Video
@@ -207,7 +208,13 @@ Namespace API.Mastodon
If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = GifsSpecialFolder If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = GifsSpecialFolder
If Not GifsPrefix.IsEmptyString Then m.File.Name = $"{GifsPrefix}{m.File.Name}" If Not GifsPrefix.IsEmptyString Then m.File.Name = $"{GifsPrefix}{m.File.Name}"
End If 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 If End If
End Sub End Sub
@@ -261,7 +268,7 @@ Namespace API.Mastodon
If Not j Is Nothing Then If Not j Is Nothing Then
PostDate = String.Empty PostDate = String.Empty
If j.Contains("created_at") Then PostDate = j("created_at").Value Else 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) rList.Add(i)
j.Dispose() j.Dispose()
End If End If

View File

@@ -380,6 +380,11 @@ Namespace API.OnlyFans
Try Try
If ContentMissingExists Then If ContentMissingExists Then
Dim m As UserMedia 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 mList As List(Of UserMedia)
Dim mediaResult As Boolean Dim mediaResult As Boolean
Dim r$, path$, postDate$ Dim r$, path$, postDate$
@@ -402,7 +407,7 @@ Namespace API.OnlyFans
mediaResult = False mediaResult = False
mList = TryCreateMedia(j, m.Post.ID, postDate, mediaResult) mList = TryCreateMedia(j, m.Post.ID, postDate, mediaResult)
If mediaResult Then If mediaResult Then
_TempMediaList.ListAddList(mList, LNC) _TempMediaList.ListAddList(mList.ListForEachCopy(stateRefill, True), LNC)
rList.Add(i) rList.Add(i)
mList.Clear() mList.Clear()
End If End If

View File

@@ -37,7 +37,7 @@ Namespace API.Pinterest
End Property End Property
Friend Property TrueUserName As String Friend Property TrueUserName As String
Friend Property TrueBoardName As String Friend Property TrueBoardName As String
Friend Property IsUser As Boolean Friend Property IsUser_NB As Boolean
Private Const BoardLabelName As String = "Board" Private Const BoardLabelName As String = "Board"
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String) Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get Get
@@ -51,10 +51,10 @@ Namespace API.Pinterest
Dim n$() = Name.Split("@") Dim n$() = Name.Split("@")
If n.ListExists Then If n.ListExists Then
TrueUserName = n(0) TrueUserName = n(0)
IsUser = True IsUser_NB = True
If n.Length > 1 Then TrueBoardName = n(1) : IsUser = False If n.Length > 1 Then TrueBoardName = n(1) : IsUser_NB = False
If Not IsSavedPosts And Not IsSingleObjectDownload Then If Not IsSavedPosts And Not IsSingleObjectDownload Then
Dim l$ = IIf(IsUser, UserLabelName, BoardLabelName) Dim l$ = IIf(IsUser_NB, UserLabelName, BoardLabelName)
Settings.Labels.Add(l) Settings.Labels.Add(l)
Labels.ListAddValue(l, LNC) Labels.ListAddValue(l, LNC)
Labels.Sort() Labels.Sort()
@@ -69,13 +69,13 @@ Namespace API.Pinterest
If Loading Then If Loading Then
TrueUserName = .Value(Name_TrueUserName) TrueUserName = .Value(Name_TrueUserName)
TrueBoardName = .Value(Name_TrueBoardName) TrueBoardName = .Value(Name_TrueBoardName)
IsUser = .Value(Name_IsUser).FromXML(Of Boolean)(False) IsUser_NB = .Value(Name_IsUser).FromXML(Of Boolean)(False)
ReconfUserName() ReconfUserName()
Else Else
If ReconfUserName() Then .Value(Name_LabelsName) = LabelsString If ReconfUserName() Then .Value(Name_LabelsName) = LabelsString
.Add(Name_TrueUserName, TrueUserName) .Add(Name_TrueUserName, TrueUserName)
.Add(Name_TrueBoardName, TrueBoardName) .Add(Name_TrueBoardName, TrueBoardName)
.Add(Name_IsUser, IsUser.BoolToInteger) .Add(Name_IsUser, IsUser_NB.BoolToInteger)
End If End If
End With End With
End Sub End Sub
@@ -85,7 +85,7 @@ Namespace API.Pinterest
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
If IsSavedPosts Then If IsSavedPosts Then
IsUser = True IsUser_NB = True
TrueUserName = MySettings.SavedPostsUserName.Value TrueUserName = MySettings.SavedPostsUserName.Value
If TrueUserName.IsEmptyString Then Throw New ArgumentNullException("SavedPostsUserName", "Saved posts user not set") If TrueUserName.IsEmptyString Then Throw New ArgumentNullException("SavedPostsUserName", "Saved posts user not set")
End If End If
@@ -94,7 +94,7 @@ Namespace API.Pinterest
Dim b$ = TrueBoardName Dim b$ = TrueBoardName
If Not b.IsEmptyString Then b &= "/" If Not b.IsEmptyString Then b &= "/"
URL = $"https://www.pinterest.com/{TrueUserName}/{b}" URL = $"https://www.pinterest.com/{TrueUserName}/{b}"
If IsUser Then If IsUser_NB Then
boards = GetBoards(Token) boards = GetBoards(Token)
Else Else
boards = New List(Of BoardInfo) From {New BoardInfo With {.URL = URL, .ID = ID, .Title = UserSiteName}} 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 boards(i) = board
Next Next
With boards.First With boards.First
If IsUser Then If IsUser_NB Then
If ID.IsEmptyString Then ID = .UserID If ID.IsEmptyString Then ID = .UserID
UserSiteNameUpdate(.UserTitle) UserSiteNameUpdate(.UserTitle)
Else Else
@@ -175,7 +175,7 @@ Namespace API.Pinterest
Dim r$ Dim r$
Dim j As EContainer, jj As EContainer Dim j As EContainer, jj As EContainer
Dim u As UserMedia 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 titleExists As Boolean = Not Board.Title.IsEmptyString
Dim i% = -1 Dim i% = -1
Dim jErr As New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue) Dim jErr As New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue)
@@ -216,7 +216,7 @@ Namespace API.Pinterest
End If End If
Board.UserID = .Value({"board", "owner"}, "id") Board.UserID = .Value({"board", "owner"}, "id")
Board.UserTitle = TitleHtmlConverter(.Value({"board", "owner"}, "full_name")) 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 If Not Board.Title.IsEmptyString Then
folder = Board.Title folder = Board.Title
ElseIf Not Board.ID.IsEmptyString Then ElseIf Not Board.ID.IsEmptyString Then
@@ -322,7 +322,7 @@ Namespace API.Pinterest
If Not TrueBoardName.IsEmptyString Then Data.Title &= $"/{TrueBoardName}" If Not TrueBoardName.IsEmptyString Then Data.Title &= $"/{TrueBoardName}"
End If End If
Dim additPath$ = TitleHtmlConverter(UserSiteName) 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 If Not additPath.IsEmptyString Then
Dim f As SFile = User.File Dim f As SFile = User.File
f.Path = f.PathWithSeparator & additPath 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) Private ReadOnly UnicodeHexConverter As Func(Of String, String) = Function(Input) SymbolsConverter.UnicodeHex.Decode(Input, EDP.ReturnValue)
#End Region #End Region
#Region "Declarations video" #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+?)", 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) 0, RegexReturn.List, EDP.ReturnValue)
Friend ReadOnly RegexVideo_FlashVars_Vars As RParams = RParams.DM("var ([\w\d]{10,})=("".+?)(?=(;|\Z))", 0, RegexReturn.List) 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 DownloadFavorite As Boolean = False
Friend Property DownloadGifs As Boolean Friend Property DownloadGifs As Boolean
Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True 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 Friend Property QueryString As String
Get Get
If IsUser Then If IsUser Then
@@ -207,7 +212,7 @@ Namespace API.PornHub
If IsUser And Force Then If IsUser And Force Then
Return False Return False
Else Else
IsUser = False _IsUser = False
Options = If(Force, eObj.Options, Options) Options = If(Force, eObj.Options, Options)
NameTrue = Options NameTrue = Options
If Not Force Then If Not Force Then
@@ -218,7 +223,7 @@ Namespace API.PornHub
End If End If
End If End If
Else Else
IsUser = True _IsUser = True
Dim n$() = Name.Split("_") Dim n$() = Name.Split("_")
If n.ListExists(2) Then If n.ListExists(2) Then
NameTrue = Name.Replace($"{n(0)}_", String.Empty) NameTrue = Name.Replace($"{n(0)}_", String.Empty)
@@ -242,7 +247,7 @@ Namespace API.PornHub
DownloadFavorite = .Value(Name_DownloadFavorite).FromXML(Of Boolean)(False) DownloadFavorite = .Value(Name_DownloadFavorite).FromXML(Of Boolean)(False)
DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False) DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False)
DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True) 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() UpdateUserOptions()
Else Else
If UpdateUserOptions() Then .Value(Name_LabelsName) = LabelsString If UpdateUserOptions() Then .Value(Name_LabelsName) = LabelsString
@@ -813,6 +818,15 @@ Namespace API.PornHub
#End Region #End Region
#Region "CreateVideoURL" #Region "CreateVideoURL"
Private Function CreateVideoURL(ByVal r As String) As String 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 Try
Dim OutStr$ = String.Empty Dim OutStr$ = String.Empty
Dim OutList As New List(Of String) 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}" MyMainLOG = $"{ToStringForLog()}: something is wrong when parsing flashvars.{vbCr}{regex_ex.Message}"
Return String.Empty Return String.Empty
Catch ex As Exception 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 Try
End Function End Function
#End Region #End Region

View File

@@ -270,13 +270,14 @@ Namespace API.Reddit
End With End With
Dim b% = Posts.Count Dim b% = Posts.Count
Posts.ListAddList(d.GetNewChannelPosts(), LNC) 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() Posts.Sort()
LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate) LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate)
UpdateUsersStats() UpdateUsersStats()
End Using End Using
Catch oex As OperationCanceledException When Token.IsCancellationRequested Catch oex As OperationCanceledException When Token.IsCancellationRequested
Finally Finally
SaveUnsaved()
_Downloading = False _Downloading = False
End Try End Try
End Sub End Sub
@@ -344,14 +345,13 @@ Namespace API.Reddit
Using x As New XmlFile(f, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True} Using x As New XmlFile(f, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
x.LoadData() x.LoadData()
If x.Count > 0 Then If x.Count > 0 Then
Dim XMLDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Dim lc As New ListAddParams(LAP.ClearBeforeAdd) Dim lc As New ListAddParams(LAP.ClearBeforeAdd)
Name = x.Value(Name_Name) Name = x.Value(Name_Name)
ID = x.Value(Name_ID) ID = x.Value(Name_ID)
ViewMode = x.Value(Name_ViewMode).FromXML(Of Integer)(CInt(View.[New])) ViewMode = x.Value(Name_ViewMode).FromXML(Of Integer)(CInt(View.[New]))
ViewPeriod = x.Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(Period.All)) ViewPeriod = x.Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(Period.All))
If FilePosts.Exists Then PostsNames.ListAddList(FilePosts.GetText.StringToList(Of String)("|"), LNC) 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) CountOfAddedUsers.ListAddList(x.Value(Name_UsersAdded).StringToList(Of Integer)("|"), lc)
CountOfLoadedPostsPerSession.ListAddList(x.Value(Name_PostsDownloaded).StringToList(Of Integer)("|"), lc) CountOfLoadedPostsPerSession.ListAddList(x.Value(Name_PostsDownloaded).StringToList(Of Integer)("|"), lc)
ChannelExistentUserNames.ListAddList(x.Value(Name_UsersExistent).StringToList(Of String)("|"), LNC) ChannelExistentUserNames.ListAddList(x.Value(Name_UsersExistent).StringToList(Of String)("|"), LNC)
@@ -359,7 +359,7 @@ Namespace API.Reddit
With x(Name_PostsNode).XmlIfNothing With x(Name_PostsNode).XmlIfNothing
If .Count > 0 Then .ForEach(Sub(ee) PostsLatest.Add(New UserPost With { If .Count > 0 Then .ForEach(Sub(ee) PostsLatest.Add(New UserPost With {
.ID = ee.Attribute(Name_ID), .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 With
End If End If
End If End If
@@ -367,45 +367,53 @@ Namespace API.Reddit
End If End If
Return True Return True
End Function 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 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) Try
UpdateUsersStats() UpdateUsersStats()
If Not ViewMode = View.New Then If Not ViewMode = View.New Then
Dim l As New List(Of String) 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) 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) l.ListAddList(PostsNames, LNC)
If l.Count > 0 Then TextSaver.SaveTextToFile(l.ListToString("|"), FilePosts, True,, EDP.SendToLog) 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()
End If End If
x.Save(File) Using x As New XmlFile With {.AllowSameNames = True, .Name = "Channel"}
End Using x.Add(Name_Name, Name)
Return True 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 Function
#End Region #End Region
#Region "IDisposable Support" #Region "IDisposable Support"

View File

@@ -90,7 +90,7 @@ Namespace API.Reddit
End If End If
End Sub End Sub
Friend Sub Update() 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 End Sub
Friend ReadOnly Property Count As Integer Implements ICollection(Of Channel).Count, IMyEnumerator(Of Channel).MyEnumeratorCount Friend ReadOnly Property Count As Integer Implements ICollection(Of Channel).Count, IMyEnumerator(Of Channel).MyEnumeratorCount
Get Get

View File

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

View File

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

View File

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

View File

@@ -67,7 +67,7 @@ Namespace API.ThisVid
UpdateUserOptions(True, q) UpdateUserOptions(True, q)
End Set End Set
End Property End Property
Friend ReadOnly Property IsUser As Boolean Friend Overrides ReadOnly Property IsUser As Boolean
Get Get
Return SiteMode = SiteModes.User Return SiteMode = SiteModes.User
End Get End Get
@@ -180,6 +180,7 @@ Namespace API.ThisVid
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
UseClientTokens = True UseClientTokens = True
PagePosts = New List(Of String)
End Sub End Sub
#End Region #End Region
#Region "Validation" #Region "Validation"
@@ -223,8 +224,10 @@ Namespace API.ThisVid
End Function End Function
#End Region #End Region
#Region "Download functions" #Region "Download functions"
Private ReadOnly PagePosts As List(Of String)
Private AddedCount As Integer = 0 Private AddedCount As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
PagePosts.Clear()
AddedCount = 0 AddedCount = 0
Responser.Cookies.ChangedAllowInternalDrop = False Responser.Cookies.ChangedAllowInternalDrop = False
Responser.Cookies.Changed = False Responser.Cookies.Changed = False
@@ -299,11 +302,16 @@ Namespace API.ThisVid
_TempMediaList.Add(New UserMedia(u) With {.Type = UserMedia.Types.VideoPre, .SpecialFolder = __SpecialFolder}) _TempMediaList.Add(New UserMedia(u) With {.Type = UserMedia.Types.VideoPre, .SpecialFolder = __SpecialFolder})
AddedCount += 1 AddedCount += 1
If limit > 0 And AddedCount >= limit Then Exit Sub If limit > 0 And AddedCount >= limit Then Exit Sub
ElseIf PagePosts.Count > 0 AndAlso PagePosts.Contains(u) Then
Continue For
Else Else
Exit Sub Exit Sub
End If End If
End If End If
Next Next
PagePosts.Clear()
PagePosts.AddRange(l)
l.Clear()
End If End If
End If End If
If Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000) Then DownloadData(Page + 1, Model, Token) 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 Return 0
End If End If
End Function 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 Region
End Class End Class
End Namespace 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) TitleUseNative = .Value(Name_TitleUseNative).FromXML(Of Boolean)(True)
TitleAddVideoID = .Value(Name_TitleAddVideoID).FromXML(Of Boolean)(True) TitleAddVideoID = .Value(Name_TitleAddVideoID).FromXML(Of Boolean)(True)
LastDownloadDate = AConvert(Of Date)(.Value(Name_LastDownloadDate), ADateTime.Formats.BaseDateTime, Nothing) LastDownloadDate = AConvert(Of Date)(.Value(Name_LastDownloadDate), ADateTime.Formats.BaseDateTime, Nothing)
If Not LastDownloadDate.HasValue Then LastDownloadDate = LastUpdated
Else Else
.Add(Name_RemoveTagsFromTitle, RemoveTagsFromTitle.BoolToInteger) .Add(Name_RemoveTagsFromTitle, RemoveTagsFromTitle.BoolToInteger)
.Add(Name_TitleUseNative, TitleUseNative.BoolToInteger) .Add(Name_TitleUseNative, TitleUseNative.BoolToInteger)
@@ -109,12 +110,20 @@ Namespace API.TikTok
End With End With
If LastDownloadDate.HasValue Then 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) If (LastDownloadDate.Value - dateAfter.Value).TotalDays > 1 Then dateAfter = dateAfter.Value.AddDays(1)
End If End If
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.ChangeDirectory(cache)
b.Encoding = BatchExecutor.UnicodeEncoding b.Encoding = BatchExecutor.UnicodeEncoding
b.Execute(CreateYTCommand(cache.RootDirectory, URL, False, dateBefore, dateAfter)) b.Execute(CreateYTCommand(cache.RootDirectory, URL, False, dateBefore, dateAfter))
@@ -163,6 +172,7 @@ Namespace API.TikTok
End If End If
Next Next
End If End If
If _TempMediaList.Count > 0 Then LastDownloadDate = Now
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]") ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try End Try
@@ -210,6 +220,9 @@ Namespace API.TikTok
command &= "-o %(id)s" command &= "-o %(id)s"
End If End If
End If End If
'#If DEBUG Then
'Debug.WriteLine(command)
'#End If
Return command Return command
End Function End Function
#End Region #End Region

View File

@@ -87,6 +87,7 @@ Namespace API.Twitter
MyBase.New(TwitterSite, "twitter.com") MyBase.New(TwitterSite, "twitter.com")
_Image = My.Resources.SiteResources.TwitterIcon_32.ToBitmap _Image = My.Resources.SiteResources.TwitterIcon_32.ToBitmap
LimitSkippedUsers = New List(Of UserDataBase)
With Responser With Responser
.Cookies.ChangedAllowInternalDrop = False .Cookies.ChangedAllowInternalDrop = False
@@ -126,7 +127,19 @@ Namespace API.Twitter
Return Settings.GalleryDLFile.Exists And BaseAuthExists() Return Settings.GalleryDLFile.Exists And BaseAuthExists()
End Function End Function
Friend Property LIMIT_ABORT As Boolean = False Friend Property LIMIT_ABORT As Boolean = False
Friend ReadOnly Property LimitSkippedUsers As List(Of UserDataBase)
Friend Overrides Sub DownloadDone(ByVal What As ISiteSettings.Download) 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 LIMIT_ABORT = False
MyBase.DownloadDone(What) MyBase.DownloadDone(What)
End Sub End Sub

View File

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

View File

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

View File

@@ -51,6 +51,11 @@ Namespace API.XVIDEOS
Private Property TrueName As String = String.Empty Private Property TrueName As String = String.Empty
Private Property Arguments As String = String.Empty Private Property Arguments As String = String.Empty
Private Property PersonType 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) Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get Get
Return {SearchRequestLabelName} Return {SearchRequestLabelName}

View File

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

View File

@@ -82,7 +82,7 @@ Namespace API.YouTube
Dim isMusic As Boolean = False Dim isMusic As Boolean = False
Dim id$ = String.Empty Dim id$ = String.Empty
Dim isChannelUser As Boolean = False 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 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)}") Return New ExchangeOptions(Site, $"{id}@{CInt(t) + IIf(isMusic, UserMedia.Types.Audio, 0) + IIf(isChannelUser, ChannelUserInt, 0)}")
End If 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 Imports PersonalUtilities.Tools.Notifications
Namespace DownloadObjects Namespace DownloadObjects
Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider
Friend Event PauseDisabled() Friend Event PauseChanged(ByVal Value As PauseModes)
Friend Enum Modes As Integer Friend Enum Modes As Integer
None = 0 None = 0
[Default] = 1 [Default] = 1
@@ -297,9 +297,11 @@ Namespace DownloadObjects
Groups = New List(Of String) Groups = New List(Of String)
UserKeys = New List(Of NotifiedUser) UserKeys = New List(Of NotifiedUser)
_IsNewPlan = IsNewPlan _IsNewPlan = IsNewPlan
Initialization = False
End Sub End Sub
Friend Sub New(ByVal x As EContainer) Friend Sub New(ByVal x As EContainer)
Me.New Me.New
Initialization = True
Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None) Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
Import(x) Import(x)
If Name.IsEmptyString Then Name = "Default" If Name.IsEmptyString Then Name = "Default"
@@ -322,6 +324,24 @@ Namespace DownloadObjects
Initialization = False Initialization = False
End Sub End Sub
#End Region #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" #Region "Groups Support"
Friend Sub GROUPS_Updated(ByVal Sender As DownloadGroup) Friend Sub GROUPS_Updated(ByVal Sender As DownloadGroup)
If Groups.Count > 0 Then If Groups.Count > 0 Then
@@ -392,6 +412,7 @@ Namespace DownloadObjects
Case PauseModes.Until : _PauseValue = DateLimit Case PauseModes.Until : _PauseValue = DateLimit
Case Else : _PauseValue = Nothing Case Else : _PauseValue = Nothing
End Select End Select
RaiseEvent PauseChanged(p)
End Set End Set
End Property End Property
Private ReadOnly Property IsPaused As Boolean Private ReadOnly Property IsPaused As Boolean
@@ -403,7 +424,7 @@ Namespace DownloadObjects
Else Else
_Pause = PauseModes.Disabled _Pause = PauseModes.Disabled
_PauseValue = Nothing _PauseValue = Nothing
RaiseEvent PauseDisabled() RaiseEvent PauseChanged(_Pause)
Return False Return False
End If End If
Else Else
@@ -541,9 +562,9 @@ Namespace DownloadObjects
Using g As New GroupParameters Using g As New GroupParameters
g.LabelsExcluded.ListAddList(LabelsExcluded) g.LabelsExcluded.ListAddList(LabelsExcluded)
g.SitesExcluded.ListAddList(SitesExcluded) g.SitesExcluded.ListAddList(SitesExcluded)
users.ListAddList(DownloadGroup.GetUsers(g, True)) users.ListAddList(DownloadGroup.GetUsers(g))
End Using End Using
Case Modes.Specified : users.ListAddList(DownloadGroup.GetUsers(Me, True)) Case Modes.Specified : users.ListAddList(DownloadGroup.GetUsers(Me))
Case Modes.Groups Case Modes.Groups
If Groups.Count > 0 And Settings.Groups.Count > 0 Then If Groups.Count > 0 And Settings.Groups.Count > 0 Then
For Each GName In Groups For Each GName In Groups

View File

@@ -24,28 +24,28 @@ Namespace DownloadObjects
Private Sub InitializeComponent() Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container() Me.components = New System.ComponentModel.Container()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer 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 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 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 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 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 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 Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.DEF_GROUP = New SCrawler.DownloadObjects.Groups.GroupDefaults() 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_ALL = New System.Windows.Forms.RadioButton()
Me.OPT_DEFAULT = New System.Windows.Forms.RadioButton() Me.OPT_DEFAULT = New System.Windows.Forms.RadioButton()
Me.OPT_SPEC = New System.Windows.Forms.RadioButton() Me.OPT_SPEC = New System.Windows.Forms.RadioButton()
Me.OPT_DISABLED = New System.Windows.Forms.RadioButton() Me.OPT_DISABLED = New System.Windows.Forms.RadioButton()
Me.OPT_GROUP = New System.Windows.Forms.RadioButton() Me.OPT_GROUP = New System.Windows.Forms.RadioButton()
Me.TXT_TIMER = New PersonalUtilities.Forms.Controls.TextBoxExtended() Me.TXT_GROUPS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.LBL_LAST_TIME_UP = New System.Windows.Forms.Label()
Me.NUM_DELAY = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_NOTIFY = New System.Windows.Forms.CheckBox() Me.CH_NOTIFY = New System.Windows.Forms.CheckBox()
Me.CH_SHOW_PIC = 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_SHOW_PIC_USER = New System.Windows.Forms.CheckBox()
Me.CH_NOTIFY_SIMPLE = 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() CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MODE = New System.Windows.Forms.TableLayoutPanel() TP_MODE = New System.Windows.Forms.TableLayoutPanel()
TP_NOTIFY = New System.Windows.Forms.TableLayoutPanel() TP_NOTIFY = New System.Windows.Forms.TableLayoutPanel()
@@ -53,11 +53,11 @@ Namespace DownloadObjects
CONTAINER_MAIN.ContentPanel.SuspendLayout() CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout() CONTAINER_MAIN.SuspendLayout()
Me.DEF_GROUP.SuspendLayout() Me.DEF_GROUP.SuspendLayout()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).BeginInit()
TP_MODE.SuspendLayout() TP_MODE.SuspendLayout()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).BeginInit()
TP_NOTIFY.SuspendLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).BeginInit()
TP_NOTIFY.SuspendLayout()
Me.SuspendLayout() Me.SuspendLayout()
' '
'CONTAINER_MAIN 'CONTAINER_MAIN
@@ -66,7 +66,7 @@ Namespace DownloadObjects
'CONTAINER_MAIN.ContentPanel 'CONTAINER_MAIN.ContentPanel
' '
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DEF_GROUP) 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.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0) 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.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.Percent, 100.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.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 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
' '
TP_MODE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single] TP_MODE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
@@ -214,52 +197,23 @@ Namespace DownloadObjects
TT_MAIN.SetToolTip(Me.OPT_GROUP, "Download groups") TT_MAIN.SetToolTip(Me.OPT_GROUP, "Download groups")
Me.OPT_GROUP.UseVisualStyleBackColor = True Me.OPT_GROUP.UseVisualStyleBackColor = True
' '
'TXT_TIMER 'TXT_GROUPS
' '
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image) ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Refresh" ActionButton1.Name = "Edit"
Me.TXT_TIMER.Buttons.Add(ActionButton3) ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
Me.TXT_TIMER.CaptionText = "Timer" ActionButton2.Name = "Clear"
Me.TXT_TIMER.CaptionToolTipEnabled = True Me.TXT_GROUPS.Buttons.Add(ActionButton1)
Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)" Me.TXT_GROUPS.Buttons.Add(ActionButton2)
Me.TXT_TIMER.CaptionWidth = 50.0R Me.TXT_GROUPS.CaptionText = "Groups"
Me.TXT_TIMER.Dock = System.Windows.Forms.DockStyle.Fill Me.TXT_GROUPS.CaptionWidth = 50.0R
Me.TXT_TIMER.Location = New System.Drawing.Point(4, 282) Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TIMER.Name = "TXT_TIMER" Me.TXT_GROUPS.Lines = New String(-1) {}
Me.TXT_TIMER.Size = New System.Drawing.Size(468, 22) Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 224)
Me.TXT_TIMER.TabIndex = 3 Me.TXT_GROUPS.Name = "TXT_GROUPS"
' Me.TXT_GROUPS.Size = New System.Drawing.Size(468, 22)
'LBL_LAST_TIME_UP Me.TXT_GROUPS.TabIndex = 1
' Me.TXT_GROUPS.TextBoxReadOnly = True
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"
' '
'TP_NOTIFY 'TP_NOTIFY
' '
@@ -329,6 +283,55 @@ Namespace DownloadObjects
TT_MAIN.SetToolTip(Me.CH_NOTIFY_SIMPLE, resources.GetString("CH_NOTIFY_SIMPLE.ToolTip")) TT_MAIN.SetToolTip(Me.CH_NOTIFY_SIMPLE, resources.GetString("CH_NOTIFY_SIMPLE.ToolTip"))
Me.CH_NOTIFY_SIMPLE.UseVisualStyleBackColor = True 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 'AutoDownloaderEditorForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -343,6 +346,7 @@ Namespace DownloadObjects
Me.MinimizeBox = False Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(492, 427) Me.MinimumSize = New System.Drawing.Size(492, 427)
Me.Name = "AutoDownloaderEditorForm" Me.Name = "AutoDownloaderEditorForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "AutoDownloader settings" Me.Text = "AutoDownloader settings"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False) CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
@@ -350,13 +354,13 @@ Namespace DownloadObjects
CONTAINER_MAIN.PerformLayout() CONTAINER_MAIN.PerformLayout()
Me.DEF_GROUP.ResumeLayout(False) Me.DEF_GROUP.ResumeLayout(False)
Me.DEF_GROUP.PerformLayout() Me.DEF_GROUP.PerformLayout()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).EndInit()
TP_MODE.ResumeLayout(False) TP_MODE.ResumeLayout(False)
TP_MODE.PerformLayout() TP_MODE.PerformLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).EndInit() CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).EndInit()
TP_NOTIFY.ResumeLayout(False) TP_NOTIFY.ResumeLayout(False)
TP_NOTIFY.PerformLayout() TP_NOTIFY.PerformLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False) Me.ResumeLayout(False)
End Sub 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"> <metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </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" /> <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="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
@@ -187,15 +196,14 @@
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value> </value>
</data> </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> <value>False</value>
</metadata> </metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> <data name="CH_NOTIFY_SIMPLE.ToolTip" xml:space="preserve">
<value>False</value> <value>Show a simple notification instead of a user notification.
</metadata> 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.
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> The 'Image' and 'User icon' parameters will be ignored.</value>
<value>17, 17</value> </data>
</metadata>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6 iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
@@ -228,12 +236,4 @@
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg== VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value> </value>
</data> </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> </root>

View File

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

View File

@@ -14,12 +14,14 @@ Imports PauseModes = SCrawler.DownloadObjects.AutoDownloader.PauseModes
Namespace DownloadObjects Namespace DownloadObjects
Friend Class Scheduler : Implements IEnumerable(Of AutoDownloader), IMyEnumerator(Of AutoDownloader), IDisposable Friend Class Scheduler : Implements IEnumerable(Of AutoDownloader), IMyEnumerator(Of AutoDownloader), IDisposable
Friend Const Name_Plan As String = "Plan" Friend Const Name_Plan As String = "Plan"
Friend Event PauseDisabled As AutoDownloader.PauseDisabledEventHandler Friend Event PauseChanged As AutoDownloader.PauseChangedEventHandler
Private Sub OnPauseDisabled() Private Sub OnPauseChanged(ByVal Value As PauseModes)
RaiseEvent PauseDisabled() RaiseEvent PauseChanged(Pause)
End Sub End Sub
Private ReadOnly Plans As List(Of AutoDownloader) 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 PlanWorking As Predicate(Of AutoDownloader) = Function(Plan) Plan.Working
Private ReadOnly PlanDownloading As Predicate(Of AutoDownloader) = Function(Plan) Plan.Downloading 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)) Private ReadOnly PlansWaiter As Action(Of Predicate(Of AutoDownloader)) = Sub(ByVal Predicate As Predicate(Of AutoDownloader))
@@ -27,20 +29,9 @@ Namespace DownloadObjects
End Sub End Sub
Friend Sub New() Friend Sub New()
Plans = New List(Of AutoDownloader) Plans = New List(Of AutoDownloader)
If File.Exists Then File = Settings.AutomationFile.Value.IfNullOrEmpty(FileDefault)
Using x As New XmlFile(File,, False) With {.AllowSameNames = True} If Not File.Exists Then File = FileDefault
x.LoadData() Reset(File, True)
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
End Sub End Sub
Default Friend ReadOnly Property Item(ByVal Index As Integer) As AutoDownloader Implements IMyEnumerator(Of AutoDownloader).MyEnumeratorObject Default Friend ReadOnly Property Item(ByVal Index As Integer) As AutoDownloader Implements IMyEnumerator(Of AutoDownloader).MyEnumeratorObject
Get Get
@@ -62,7 +53,7 @@ Namespace DownloadObjects
End Function End Function
Friend Sub Add(ByVal Plan As AutoDownloader) Friend Sub Add(ByVal Plan As AutoDownloader)
Plan.Source = Me Plan.Source = Me
AddHandler Plan.PauseDisabled, AddressOf OnPauseDisabled AddHandler Plan.PauseChanged, AddressOf OnPauseChanged
Plans.Add(Plan) Plans.Add(Plan)
Plans.ListReindex Plans.ListReindex
Update() Update()
@@ -96,6 +87,39 @@ Namespace DownloadObjects
Catch Catch
End Try End Try
End Sub 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" #Region "Groups Support"
Friend Sub GROUPS_Updated(ByVal Sender As DownloadGroup) Friend Sub GROUPS_Updated(ByVal Sender As DownloadGroup)
If Count > 0 Then Plans.ForEach(Sub(p) p.GROUPS_Updated(Sender)) If Count > 0 Then Plans.ForEach(Sub(p) p.GROUPS_Updated(Sender))

View File

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

View File

@@ -8,10 +8,15 @@
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools
Imports ECI = PersonalUtilities.Forms.Toolbars.EditToolbar.ControlItem
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Namespace DownloadObjects Namespace DownloadObjects
Friend Class SchedulerEditorForm Friend Class SchedulerEditorForm
#Region "Declarations" #Region "Declarations"
Private WithEvents MyDefs As DefaultFormOptions Private WithEvents MyDefs As DefaultFormOptions
Private WithEvents BTT_SETTINGS As ToolStripButton
Private WithEvents BTT_CLONE As ToolStripButton
Private ReadOnly MENU_SKIP As ToolStripDropDownButton Private ReadOnly MENU_SKIP As ToolStripDropDownButton
Private WithEvents BTT_SKIP As ToolStripMenuItem Private WithEvents BTT_SKIP As ToolStripMenuItem
Private WithEvents BTT_SKIP_MIN As ToolStripMenuItem Private WithEvents BTT_SKIP_MIN As ToolStripMenuItem
@@ -26,6 +31,20 @@ Namespace DownloadObjects
Friend Sub New() Friend Sub New()
InitializeComponent() InitializeComponent()
MyDefs = New DefaultFormOptions(Me, Settings.Design) 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 { MENU_SKIP = New ToolStripDropDownButton With {
.Text = "Skip", .Text = "Skip",
.ToolTipText = String.Empty, .ToolTipText = String.Empty,
@@ -80,13 +99,15 @@ Namespace DownloadObjects
} }
PauseArr = New AutoDownloaderPauseButtons(AutoDownloaderPauseButtons.ButtonsPlace.Scheduler) With { PauseArr = New AutoDownloaderPauseButtons(AutoDownloaderPauseButtons.ButtonsPlace.Scheduler) With {
.MainFrameButtonsInstance = MainFrameObj.PauseButtons} .MainFrameButtonsInstance = MainFrameObj.PauseButtons}
Icon = ImageRenderer.GetIcon(My.Resources.ScriptPic_32, EDP.ReturnValue)
End Sub End Sub
#End Region #End Region
#Region "Form handlers" #Region "Form handlers"
Private Sub SchedulerEditorForm_Load(sender As Object, e As EventArgs) Handles Me.Load Private Sub SchedulerEditorForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs With MyDefs
.MyViewInitialize() .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) PauseArr.AddButtons(BTT_PAUSE, .MyEditToolbar.ToolStrip)
Refill() Refill()
.EndLoaderOperations(False) .EndLoaderOperations(False)
@@ -118,17 +139,24 @@ Namespace DownloadObjects
End Try End Try
End Sub End Sub
#Region "Add, Edit, Delete" #Region "Add, Edit, Delete"
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EventArgs) Handles MyDefs.ButtonAddClick, BTT_CLONE.Click
Dim a As New AutoDownloader(True) Dim a As AutoDownloader = Nothing
Using f As New AutoDownloaderEditorForm(a) If Sender Is BTT_CLONE Then
f.ShowDialog() If _LatestSelected.ValueBetween(0, Settings.Automation.Count - 1) Then a = Settings.Automation(_LatestSelected).Copy
If f.DialogResult = DialogResult.OK Then Else
Settings.Automation.Add(a) a = New AutoDownloader(True)
Refill() End If
Else If Not a Is Nothing Then
a.Dispose() Using f As New AutoDownloaderEditorForm(a)
End If f.ShowDialog()
End Using If f.DialogResult = DialogResult.OK Then
Settings.Automation.Add(a)
Refill()
Else
a.Dispose()
End If
End Using
End If
End Sub End Sub
Private Sub Edit() Handles MyDefs.ButtonEditClick Private Sub Edit() Handles MyDefs.ButtonEditClick
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
@@ -170,7 +198,80 @@ Namespace DownloadObjects
Edit() Edit()
End Sub End Sub
#End Region #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 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 If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
With Settings.Automation(_LatestSelected) : .Start(.IsNewPlan) : End With With Settings.Automation(_LatestSelected) : .Start(.IsNewPlan) : End With

View File

@@ -123,7 +123,7 @@ Namespace DownloadObjects
With Downloader.Downloaded With Downloader.Downloaded
If .Count > 0 Then If .Count > 0 Then
With .Select(Function(u) Settings.GetUser(u, False)).Reverse 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 If _UsersListSession.Count > 0 Then
_UsersListSession.InsertRange(0, .Self) _UsersListSession.InsertRange(0, .Self)
Else Else
@@ -165,33 +165,45 @@ Namespace DownloadObjects
#End Region #End Region
#Region "Toolbar controls" #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 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 Try
Dim clicked As ToolStripMenuItem = Sender Dim __refill As Boolean = False
Dim other As ToolStripMenuItem = If(Sender Is MENU_VIEW_SESSION, MENU_VIEW_ALL, MENU_VIEW_SESSION) Dim clicked As ToolStripMenuItem = Sender
If other.Checked Then Dim other As ToolStripMenuItem = If(Sender Is MENU_VIEW_SESSION, MENU_VIEW_ALL, MENU_VIEW_SESSION)
clicked.Checked = True ControlInvokeFast(ToolbarTOP, clicked, Sub()
other.Checked = False If other.Checked Then
__refill = True clicked.Checked = True
Else other.Checked = False
clicked.Checked = False __refill = True
End If Else
ViewMode = IIf(MENU_VIEW_SESSION.Checked, ViewModes.Session, ViewModes.All) clicked.Checked = False
ControlInvokeFast(ToolbarTOP, BTT_CLEAR, Sub() BTT_CLEAR.Visible = ViewMode = ViewModes.Session) End If
If __refill Then RefillList() 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 End Sub
Private Sub OPT_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_DEFAULT.Click, OPT_SUBSCRIPTIONS.Click Private Sub OPT_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_DEFAULT.Click, OPT_SUBSCRIPTIONS.Click
Dim __refill As Boolean = False Try
Dim clicked As ToolStripMenuItem = Sender Dim __refill As Boolean = False
Dim other As ToolStripMenuItem = If(Sender Is OPT_DEFAULT, OPT_SUBSCRIPTIONS, OPT_DEFAULT) Dim clicked As ToolStripMenuItem = Sender
If other.Checked Then Dim other As ToolStripMenuItem = If(Sender Is OPT_DEFAULT, OPT_SUBSCRIPTIONS, OPT_DEFAULT)
clicked.Checked = True ControlInvokeFast(ToolbarTOP, clicked, Sub()
other.Checked = False If other.Checked Then
__refill = True clicked.Checked = True
Else other.Checked = False
clicked.Checked = False __refill = True
End If Else
Settings.InfoViewDefault.Value = OPT_DEFAULT.Checked clicked.Checked = False
If __refill Then RefillList() 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 End Sub
Private Sub BTT_FIND_Click(sender As Object, e As EventArgs) Handles BTT_FIND.Click 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 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_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.BTT_CLEAR = New System.Windows.Forms.ToolStripButton() Me.BTT_CLEAR = New System.Windows.Forms.ToolStripButton()
Me.TP_DATA = New System.Windows.Forms.TableLayoutPanel() 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_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator() SEP_2 = New System.Windows.Forms.ToolStripSeparator()
MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton() MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton()
@@ -89,7 +90,7 @@ Namespace DownloadObjects
'MENU_LOAD_SESSION 'MENU_LOAD_SESSION
' '
Me.MENU_LOAD_SESSION.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image Me.MENU_LOAD_SESSION.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_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.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.MENU_LOAD_SESSION.ImageTransparentColor = System.Drawing.Color.Magenta Me.MENU_LOAD_SESSION.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_LOAD_SESSION.Name = "MENU_LOAD_SESSION" Me.MENU_LOAD_SESSION.Name = "MENU_LOAD_SESSION"
@@ -130,7 +131,7 @@ Namespace DownloadObjects
' '
Me.BTT_DOWN_ALL.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16 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.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.Tag = "a"
Me.BTT_DOWN_ALL.Text = "Download ALL" 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.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_DOWN_SELECTED.Name = "BTT_DOWN_SELECTED" 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.Tag = "s"
Me.BTT_DOWN_SELECTED.Text = "Download selected" 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.Size = New System.Drawing.Size(484, 436)
Me.TP_DATA.TabIndex = 1 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 'DownloadFeedForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -218,5 +226,6 @@ Namespace DownloadObjects
Private WithEvents MENU_DOWN As ToolStripDropDownButton Private WithEvents MENU_DOWN As ToolStripDropDownButton
Private WithEvents BTT_DOWN_ALL As ToolStripMenuItem Private WithEvents BTT_DOWN_ALL As ToolStripMenuItem
Private WithEvents BTT_DOWN_SELECTED As ToolStripMenuItem Private WithEvents BTT_DOWN_SELECTED As ToolStripMenuItem
Private WithEvents BTT_LOAD_SESSION_CURRENT As ToolStripMenuItem
End Class End Class
End Namespace End Namespace

View File

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

View File

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

View File

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

View File

@@ -83,7 +83,7 @@ Namespace DownloadObjects.Groups
End Using End Using
End Sub End Sub
Friend Function DownloadGroupIfExists(ByVal Index As Integer) As Boolean 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 End Function
Friend Function IndexOf(ByVal Name As String) As Integer Friend Function IndexOf(ByVal Name As String) As Integer
If Count > 0 Then If Count > 0 Then

View File

@@ -156,6 +156,10 @@ Namespace DownloadObjects.Groups
Controls.Add(TXT_LABELS, 0, 6) Controls.Add(TXT_LABELS, 0, 6)
Controls.Add(TXT_SITES, 0, 7) Controls.Add(TXT_SITES, 0, 7)
End Sub 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 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 If Sender.DefaultButton = ADB.Clear Then NUM_USERS_COUNT.Value = 0
End Sub End Sub

View File

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

View File

@@ -22,7 +22,7 @@ Namespace DownloadObjects.Groups
Property SubscriptionsOnly As Boolean Property SubscriptionsOnly As Boolean
Property UsersCount As Integer Property UsersCount As Integer
End Interface 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_Name As String = "Name"
Protected Const Name_Temporary As String = "Temporary" Protected Const Name_Temporary As String = "Temporary"
Protected Const Name_Favorite As String = "Favorite" Protected Const Name_Favorite As String = "Favorite"
@@ -53,6 +53,28 @@ Namespace DownloadObjects.Groups
Sites = New List(Of String) Sites = New List(Of String)
SitesExcluded = New List(Of String) SitesExcluded = New List(Of String)
End Sub 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) Protected Sub Import(ByVal e As EContainer)
Name = e.Value(Name_Name) Name = e.Value(Name_Name)
Temporary = e.Value(Name_Temporary).FromXML(Of Integer)(CInt(CheckState.Indeterminate)) 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 Private WithEvents BTT_INFO As ToolStripButton
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Public Sub New()
InitializeComponent() InitializeComponent()
MUsers = New List(Of IUserData) MUsers = New List(Of IUserData)
MyDefs = New DefaultFormOptions(Me, Settings.Design) MyDefs = New DefaultFormOptions(Me, Settings.Design)

View File

@@ -121,7 +121,6 @@ Namespace DownloadObjects.STDownloader
If isArr Then If isArr Then
Dim urls As List(Of String) = Nothing Dim urls As List(Of String) = Nothing
Dim cntAdded As Boolean = False
If isExternal Then urls = New List(Of String)(ExternalUrlsTemp) If isExternal Then urls = New List(Of String)(ExternalUrlsTemp)
Using fa As New DownloaderUrlsArrForm(urls) Using fa As New DownloaderUrlsArrForm(urls)
fa.ShowDialog() fa.ShowDialog()
@@ -143,10 +142,9 @@ Namespace DownloadObjects.STDownloader
For Each url In urls For Each url In urls
If Not TryYouTube.Invoke Then If Not TryYouTube.Invoke Then
media = FindSource(url, output) 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 End If
Next Next
If cntAdded And Settings.STDownloader_DownloadAutomatically Then BTT_DOWN.PerformClick()
urls.Clear() urls.Clear()
Else Else
MsgBoxE({"There are no valid URLs in the list", "Add URLs array"}, vbCritical) 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 ReadOnly Property Files As List(Of UserMediaD)
Friend Property FilesChanged As Boolean = False Friend Property FilesChanged As Boolean = False
Private ReadOnly FilesLP As New ListAddParams(LAP.NotContainsOnly) Private ReadOnly FilesLP As New ListAddParams(LAP.NotContainsOnly)
Private FilesLastSessionBackedup As Boolean = False
Friend Const SessionsPath As String = "Settings\Sessions\" Friend Const SessionsPath As String = "Settings\Sessions\"
Friend ReadOnly FilesSessionActual As SFile = $"{SessionsPath}Latest.xml" Private _FilesSessionCleared As Boolean = False
Private ReadOnly FilesSessionBackup As SFile = $"{SessionsPath}Latest_Backup.xml" 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() Private Sub FilesSave()
Try Try
If Settings.FeedStoreSessionsData And Files.Count > 0 Then If Settings.FeedStoreSessionsData And Files.Count > 0 Then
FilesBackupLastSession() ClearSessions()
Using x As New XmlFile With {.Name = "Session", .AllowSameNames = True} Using x As New XmlFile With {.Name = "Session", .AllowSameNames = True}
x.AddRange(Files) x.AddRange(Files)
x.Save(FilesSessionActual) x.Save(FilesSessionActual)
@@ -105,28 +111,43 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.TDownloader.FilesSave]") ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.TDownloader.FilesSave]")
End Try End Try
End Sub End Sub
Private Sub FilesBackupLastSession() Friend Sub ClearSessions()
Try Try
If Not FilesLastSessionBackedup Then If Not _FilesSessionCleared Then
If FilesSessionActual.Exists Then _FilesSessionCleared = True
If FilesSessionBackup.Exists Then Dim files As List(Of SFile) = SFile.GetFiles(SessionsPath.CSFileP, "*.xml",, EDP.ReturnValue)
Dim f As SFile = SFile.IndexReindex(FilesSessionBackup) If RenameOldFileNames(files) Then files = SFile.GetFiles(SessionsPath.CSFileP, "*.xml",, EDP.ReturnValue)
SFile.Rename(FilesSessionBackup, f) Dim filesCount% = Settings.FeedStoredSessionsNumber
RemoveLogFiles(FilesSessionBackup, 10) If files.ListExists And filesCount > 0 Then
FilesSessionBackup.Delete() Dim fe As New ErrorsDescriber(EDP.None)
End If Do While files.Count > filesCount : files(0).Delete(,, fe) : files.RemoveAt(0) : Loop
SFile.Rename(FilesSessionActual, FilesSessionBackup)
End If End If
End If End If
Catch ex As Exception Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.TDownloader.FilesBackupLastSession]") ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.TDownloader.ClearSessions]")
Finally
FilesLastSessionBackedup = True
End Try End Try
End Sub 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 #End Region
Friend ReadOnly Property ActiveDownloading As List(Of IUserData)
Friend Property QueueFormOpening As Boolean = False
Friend ReadOnly Property Downloaded As List(Of IUserData) Friend ReadOnly Property Downloaded As List(Of IUserData)
Private ReadOnly NProv As IFormatProvider Private ReadOnly NProv As IFormatProvider
#End Region #End Region
@@ -249,6 +270,7 @@ Namespace DownloadObjects
End Sub End Sub
Public Overrides Sub Finish() Public Overrides Sub Finish()
_Working = False _Working = False
TokenSource.DisposeIfReady
TokenSource = Nothing TokenSource = Nothing
Try Try
If Not Thread Is Nothing Then If Not Thread Is Nothing Then
@@ -275,39 +297,46 @@ Namespace DownloadObjects
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
Files = New List(Of UserMediaD) Files = New List(Of UserMediaD)
ActiveDownloading = New List(Of IUserData)
Downloaded = New List(Of IUserData) Downloaded = New List(Of IUserData)
NProv = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral} NProv = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
Pool = New List(Of Job) Pool = New List(Of Job)
End Sub End Sub
#End Region #End Region
#Region "Pool" #Region "Pool"
Friend Sub ReconfPool() Friend Sub ReconfPool(Optional ByVal Round As Integer = 0)
If Pool.Count = 0 OrElse Not Pool.Exists(Function(j) j.Working Or j.Count > 0) Then Try
Dim i% If Pool.Count = 0 OrElse Not Pool.Exists(Function(j) j.Working Or j.Count > 0) Then
Pool.ListClearDispose Dim i%
If Settings.Plugins.Count > 0 Then Pool.ListClearDispose
Pool.Add(New Job(Download.Main)) If Settings.Plugins.Count > 0 Then
For Each p As PluginHost In Settings.Plugins Pool.Add(New Job(Download.Main))
If p.Settings.IsSeparatedTasks Then For Each p As PluginHost In Settings.Plugins
Pool.Add(New Job(Download.Main)) If p.Settings.IsSeparatedTasks Then
Pool.Last.AddHost(p.Settings) Pool.Add(New Job(Download.Main))
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) 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 End If
Else Next
Pool(0).AddHost(p.Settings) End If
End If RaiseEvent Reconfigured()
Next
End If End If
RaiseEvent Reconfigured() Catch ex As Exception
End If If Round = 0 Then
ReconfPool(Round + 1)
Else
Throw ex
End If
End Try
End Sub End Sub
#End Region #End Region
#Region "Thread" #Region "Thread"
@@ -410,9 +439,6 @@ Namespace DownloadObjects
Dim Keys As New List(Of String) Dim Keys As New List(Of String)
Dim h As Boolean = False Dim h As Boolean = False
Dim host As SettingsHost = Nothing 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 For Each _Item As IUserData In _Job.Items
If Not _Item.Disposed Then If Not _Item.Disposed Then
Keys.Add(_Item.Key) Keys.Add(_Item.Key)
@@ -420,10 +446,8 @@ Namespace DownloadObjects
If host.Source.ReadyToDownload(Download.Main) Then If host.Source.ReadyToDownload(Download.Main) Then
host.BeforeStartDownload(_Item, Download.Main) host.BeforeStartDownload(_Item, Download.Main)
_Job.ThrowIfCancellationRequested() _Job.ThrowIfCancellationRequested()
waitQueueForm.Invoke
DirectCast(_Item, UserDataBase).Progress = _Job.Progress DirectCast(_Item, UserDataBase).Progress = _Job.Progress
t.Add(Task.Run(Sub() _Item.DownloadData(Token))) t.Add(Task.Run(Sub() _Item.DownloadData(Token)))
ActiveDownloading.Add(_Item)
RaiseEvent UserDownloadStateChanged(_Item, True) RaiseEvent UserDownloadStateChanged(_Item, True)
i += 1 i += 1
If i >= limit Then Exit For If i >= limit Then Exit For
@@ -441,12 +465,10 @@ Namespace DownloadObjects
Dim dcc As Boolean = False Dim dcc As Boolean = False
If Keys.Count > 0 Then If Keys.Count > 0 Then
For Each k$ In Keys For Each k$ In Keys
waitQueueForm.Invoke
i = _Job.Items.FindIndex(Function(ii) ii.Key = k) i = _Job.Items.FindIndex(Function(ii) ii.Key = k)
If i >= 0 Then If i >= 0 Then
With _Job.Items(i) With _Job.Items(i)
If DirectCast(.Self, UserDataBase).ContentMissingExists Then MissingPostsDetected = True If DirectCast(.Self, UserDataBase).ContentMissingExists Then MissingPostsDetected = True
If ActiveDownloading.Count > 0 AndAlso ActiveDownloading.Contains(.Self) Then ActiveDownloading.Remove(.Self)
RaiseEvent UserDownloadStateChanged(.Self, False) RaiseEvent UserDownloadStateChanged(.Self, False)
host.AfterDownload(.Self, Download.Main) host.AfterDownload(.Self, Download.Main)
If Not .Disposed AndAlso Not .IsCollection AndAlso .DownloadedTotal(False) > 0 Then If Not .Disposed AndAlso Not .IsCollection AndAlso .DownloadedTotal(False) > 0 Then
@@ -531,7 +553,6 @@ Namespace DownloadObjects
[Stop]() [Stop]()
Pool.ListClearDispose Pool.ListClearDispose
Files.Clear() Files.Clear()
ActiveDownloading.Clear()
Downloaded.Clear() Downloaded.Clear()
End If End If
disposedValue = True disposedValue = True

View File

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

View File

@@ -12,9 +12,13 @@ Imports PersonalUtilities.Functions.XML.Objects
Namespace Editors Namespace Editors
Public Class ColorPicker : Implements IChangeDetectorCompatible Public Class ColorPicker : Implements IChangeDetectorCompatible
Private Event DataChanged As EventHandler Implements IChangeDetectorCompatible.DataChanged Private Event DataChanged As EventHandler Implements IChangeDetectorCompatible.DataChanged
Private TT As ToolTip
Public Sub New() Public Sub New()
InitializeComponent() InitializeComponent()
End Sub End Sub
Private Sub ColorPicker_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
TT.DisposeIfReady
End Sub
#Region "Appearance" #Region "Appearance"
<Category("Appearance2"), DefaultValue(105)> <Category("Appearance2"), DefaultValue(105)>
Public Property CaptionWidth As Integer Public Property CaptionWidth As Integer
@@ -52,6 +56,20 @@ Namespace Editors
LBL_CAPTION.Text = t LBL_CAPTION.Text = t
End Set End Set
End Property 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 #End Region
#Region "Colors" #Region "Colors"
Private BackColorDefault As Color = DefaultBackColor Private BackColorDefault As Color = DefaultBackColor

View File

@@ -203,6 +203,7 @@ Namespace Editors
Me.KeyPreview = True Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(600, 290) Me.MinimumSize = New System.Drawing.Size(600, 290)
Me.Name = "GlobalLocationsChooserForm" Me.Name = "GlobalLocationsChooserForm"
Me.ShowInTaskbar = False
Me.Text = "Choose a new location" Me.Text = "Choose a new location"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False) CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.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> <value>False</value>
</metadata> </metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" /> <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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -132,7 +132,7 @@
cMaRN0UdBBkAAAAASUVORK5CYII= cMaRN0UdBBkAAAAASUVORK5CYII=
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go 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"> <metadata name="TP_IMAGES.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -151,7 +151,7 @@
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6 iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
@@ -167,7 +167,7 @@
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg== VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6 iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
@@ -183,7 +183,7 @@
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg== VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go 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"> <metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value> <value>17, 17</value>
</metadata> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6 iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
@@ -213,42 +213,7 @@
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg== VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value> </value>
</data> </data>
<data name="ActionButton8.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
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">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go 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"> <metadata name="LBL_DATE_POS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </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"> <data name="CH_SEPARATE_VIDEO_FOLDER.ToolTip" xml:space="preserve">
<value>This is a global setting for newly added users only. <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. 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"> <metadata name="TP_BEHAVIOR.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -312,7 +286,7 @@ You can find more detailed information about the missing posts in the form that
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go 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"> <metadata name="TP_DOWNLOADING.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -343,7 +317,7 @@ You can find more detailed information about the missing posts in the form that
cMaRN0UdBBkAAAAASUVORK5CYII= cMaRN0UdBBkAAAAASUVORK5CYII=
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go 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"> <metadata name="TP_ENVIR.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -383,7 +357,7 @@ You can find more detailed information about the missing posts in the form that
cMaRN0UdBBkAAAAASUVORK5CYII= cMaRN0UdBBkAAAAASUVORK5CYII=
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -391,7 +365,7 @@ You can find more detailed information about the missing posts in the form that
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -402,7 +376,7 @@ You can find more detailed information about the missing posts in the form that
cMaRN0UdBBkAAAAASUVORK5CYII= cMaRN0UdBBkAAAAASUVORK5CYII=
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -410,7 +384,7 @@ You can find more detailed information about the missing posts in the form that
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -421,7 +395,7 @@ You can find more detailed information about the missing posts in the form that
cMaRN0UdBBkAAAAASUVORK5CYII= cMaRN0UdBBkAAAAASUVORK5CYII=
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -429,7 +403,7 @@ You can find more detailed information about the missing posts in the form that
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -440,7 +414,7 @@ You can find more detailed information about the missing posts in the form that
cMaRN0UdBBkAAAAASUVORK5CYII= cMaRN0UdBBkAAAAASUVORK5CYII=
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -448,7 +422,7 @@ You can find more detailed information about the missing posts in the form that
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6 iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
@@ -464,7 +438,7 @@ You can find more detailed information about the missing posts in the form that
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg== VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value> </value>
</data> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go 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"> <metadata name="TP_STD.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </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> <value>
iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE65JREFUeF7t iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE65JREFUeF7t
3X2sJWddB/DdLi2lQG2hdOHuvfM887J7Cxca4ELTQMDWKigIFpBAEAgi9g+CJpJo9Q8NJhgBiYZIYspL 3X2sJWddB/DdLi2lQG2hdOHuvfM887J7Cxca4ELTQMDWKigIFpBAEAgi9g+CJpJo9Q8NJhgBiYZIYspL
@@ -566,6 +540,47 @@ You can find more detailed information about the missing posts in the form that
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA6LEtW/4flgYiLD1qeX0A AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA6LEtW/4flgYiLD1qeX0A
AAAASUVORK5CYII= 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> </value>
</data> </data>
</root> </root>

View File

@@ -33,16 +33,19 @@ Namespace Editors
TXT_MAX_JOBS_USERS.Value = .MaxUsersJobsCount.Value TXT_MAX_JOBS_USERS.Value = .MaxUsersJobsCount.Value
TXT_MAX_JOBS_CHANNELS.Value = .ChannelsMaxJobsCount.Value TXT_MAX_JOBS_CHANNELS.Value = .ChannelsMaxJobsCount.Value
CH_CHECK_VER_START.Checked = .CheckUpdatesAtStart CH_CHECK_VER_START.Checked = .CheckUpdatesAtStart
TXT_PRG_TITLE.Text = .ProgramText
TXT_PRG_DESCR.Text = .ProgramDescription
TXT_USER_AGENT.Text = .UserAgent TXT_USER_AGENT.Text = .UserAgent
TXT_IMGUR_CLIENT_ID.Text = .ImgurClientID 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 TXT_USER_LIST_IMAGE.Text = .UserListImage.Value
COLORS_USERLIST.ColorsSet(.UserListBackColor, .UserListForeColor, SystemColors.Window, SystemColors.WindowText) COLORS_USERLIST.ColorsSet(.UserListBackColor, .UserListForeColor, SystemColors.Window, SystemColors.WindowText)
COLORS_SUBSCRIPTIONS.ColorsSet(.MainFrameUsersSubscriptionsColorBack, .MainFrameUsersSubscriptionsColorFore, COLORS_SUBSCRIPTIONS.ColorsSet(.MainFrameUsersSubscriptionsColorBack, .MainFrameUsersSubscriptionsColorFore,
SystemColors.Window, SystemColors.WindowText) SystemColors.Window, SystemColors.WindowText)
CH_SHOW_GROUPS.Checked = .ShowGroups COLORS_SUBSCRIPTIONS_USERS.ColorsSet(.MainFrameUsersSubscriptionsColorBack_USERS, .MainFrameUsersSubscriptionsColorFore_USERS,
CH_USERS_GROUPING.Checked = .UseGrouping SystemColors.Window, SystemColors.WindowText)
'Environment 'Environment
TXT_FFMPEG.Text = .FfmpegFile.File TXT_FFMPEG.Text = .FfmpegFile.File
TXT_CURL.Text = .CurlFile.File TXT_CURL.Text = .CurlFile.File
@@ -94,6 +97,7 @@ Namespace Editors
CH_STD_YT_REMOVE.Checked = .STDownloader_RemoveYTVideosOnClear CH_STD_YT_REMOVE.Checked = .STDownloader_RemoveYTVideosOnClear
CH_STD_YT_OUTPUT_ASK_NAME.Checked = .STDownloader_OutputPathAskForName CH_STD_YT_OUTPUT_ASK_NAME.Checked = .STDownloader_OutputPathAskForName
CH_STD_YT_OUTPUT_AUTO_ADD.Checked = .STDownloader_OutputPathAutoAddPaths CH_STD_YT_OUTPUT_AUTO_ADD.Checked = .STDownloader_OutputPathAutoAddPaths
CH_STD_YT_CREATE_URL.Checked = .STDownloader_CreateUrlFiles
'Downloading 'Downloading
CH_UDESCR_UP.Checked = .UpdateUserDescriptionEveryTime CH_UDESCR_UP.Checked = .UpdateUserDescriptionEveryTime
CH_UNAME_UP.Checked = .UserSiteNameUpdateEveryTime CH_UNAME_UP.Checked = .UserSiteNameUpdateEveryTime
@@ -132,7 +136,8 @@ Namespace Editors
CH_FEED_ENDLESS.Checked = .FeedEndless CH_FEED_ENDLESS.Checked = .FeedEndless
CH_FEED_ADD_SESSION.Checked = .FeedAddSessionToCaption CH_FEED_ADD_SESSION.Checked = .FeedAddSessionToCaption
CH_FEED_ADD_DATE.Checked = .FeedAddDateToCaption 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_OPEN_LAST_MODE.Checked = .FeedOpenLastMode
CH_FEED_SHOW_FRIENDLY.Checked = .FeedShowFriendlyNames CH_FEED_SHOW_FRIENDLY.Checked = .FeedShowFriendlyNames
End With End With
@@ -201,16 +206,18 @@ Namespace Editors
.MaxUsersJobsCount.Value = CInt(TXT_MAX_JOBS_USERS.Value) .MaxUsersJobsCount.Value = CInt(TXT_MAX_JOBS_USERS.Value)
.ChannelsMaxJobsCount.Value = TXT_MAX_JOBS_CHANNELS.Value .ChannelsMaxJobsCount.Value = TXT_MAX_JOBS_CHANNELS.Value
.CheckUpdatesAtStart.Value = CH_CHECK_VER_START.Checked .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 .UserAgent.Value = TXT_USER_AGENT.Text
DefaultUserAgent = TXT_USER_AGENT.Text DefaultUserAgent = TXT_USER_AGENT.Text
.ImgurClientID.Value = TXT_IMGUR_CLIENT_ID.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 .UserListImage.Value = TXT_USER_LIST_IMAGE.Text
COLORS_USERLIST.ColorsGet(.UserListBackColor, .UserListForeColor) COLORS_USERLIST.ColorsGet(.UserListBackColor, .UserListForeColor)
COLORS_SUBSCRIPTIONS.ColorsGet(.MainFrameUsersSubscriptionsColorBack, .MainFrameUsersSubscriptionsColorFore) COLORS_SUBSCRIPTIONS.ColorsGet(.MainFrameUsersSubscriptionsColorBack, .MainFrameUsersSubscriptionsColorFore)
.ShowGroups.Value = CH_SHOW_GROUPS.Checked COLORS_SUBSCRIPTIONS_USERS.ColorsGet(.MainFrameUsersSubscriptionsColorBack_USERS, .MainFrameUsersSubscriptionsColorFore_USERS)
.UseGrouping.Value = CH_USERS_GROUPING.Checked
'Environment 'Environment
.FfmpegFile.File = TXT_FFMPEG.Text .FfmpegFile.File = TXT_FFMPEG.Text
.CurlFile.File = TXT_CURL.Text .CurlFile.File = TXT_CURL.Text
@@ -259,6 +266,7 @@ Namespace Editors
.STDownloader_RemoveYTVideosOnClear.Value = CH_STD_YT_REMOVE.Checked .STDownloader_RemoveYTVideosOnClear.Value = CH_STD_YT_REMOVE.Checked
.STDownloader_OutputPathAskForName.Value = CH_STD_YT_OUTPUT_ASK_NAME.Checked .STDownloader_OutputPathAskForName.Value = CH_STD_YT_OUTPUT_ASK_NAME.Checked
.STDownloader_OutputPathAutoAddPaths.Value = CH_STD_YT_OUTPUT_AUTO_ADD.Checked .STDownloader_OutputPathAutoAddPaths.Value = CH_STD_YT_OUTPUT_AUTO_ADD.Checked
.STDownloader_CreateUrlFiles.Value = CH_STD_YT_CREATE_URL.Checked
'Downloading 'Downloading
.UpdateUserDescriptionEveryTime.Value = CH_UDESCR_UP.Checked .UpdateUserDescriptionEveryTime.Value = CH_UDESCR_UP.Checked
.UserSiteNameUpdateEveryTime.Value = CH_UNAME_UP.Checked .UserSiteNameUpdateEveryTime.Value = CH_UNAME_UP.Checked
@@ -298,7 +306,8 @@ Namespace Editors
.FeedEndless.Value = CH_FEED_ENDLESS.Checked .FeedEndless.Value = CH_FEED_ENDLESS.Checked
.FeedAddSessionToCaption.Value = CH_FEED_ADD_SESSION.Checked .FeedAddSessionToCaption.Value = CH_FEED_ADD_SESSION.Checked
.FeedAddDateToCaption.Value = CH_FEED_ADD_DATE.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 .FeedOpenLastMode.Value = CH_FEED_OPEN_LAST_MODE.Checked
.FeedShowFriendlyNames.Value = CH_FEED_SHOW_FRIENDLY.Checked .FeedShowFriendlyNames.Value = CH_FEED_SHOW_FRIENDLY.Checked
FeedParametersChanged = .FeedDataRows.ChangesDetected Or .FeedDataColumns.ChangesDetected Or 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(ActionButton2)
Me.CMB_LABELS.Buttons.Add(ActionButton3) Me.CMB_LABELS.Buttons.Add(ActionButton3)
Me.CMB_LABELS.Dock = System.Windows.Forms.DockStyle.Fill Me.CMB_LABELS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_LABELS.Lines = New String(-1) {}
Me.CMB_LABELS.ListCheckBoxes = True Me.CMB_LABELS.ListCheckBoxes = True
Me.CMB_LABELS.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple Me.CMB_LABELS.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple
Me.CMB_LABELS.ListGridVisible = True Me.CMB_LABELS.ListGridVisible = True

View File

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

View File

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

View File

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

View File

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

View File

@@ -7,3 +7,6 @@ Imports System.Diagnostics.CodeAnalysis
<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", "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", "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 Dim v As View = Settings.ViewMode.Value
With MyList With MyList
MyList.BeginUpdate() .BeginUpdate()
If Settings.FastProfilesLoading Then If Settings.FastProfilesLoading Then
Settings.Users.ListReindex 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 UserDataList.Sort()
If UserDataList.ListExists Then If UserDataList.ListExists Then
@@ -127,7 +132,14 @@ Friend Class ListImagesLoader
End If End If
Else Else
Dim t As New List(Of Task) 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 User.FitToAddParams Then
If Settings.ViewModeIsPicture Then If Settings.ViewModeIsPicture Then
t.Add(Task.Run(Sub() UpdateUser(User, True))) 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() If t.Count > 0 Then Task.WhenAll(t.ToArray) : t.Clear()
UpdateInProgress = False UpdateInProgress = False
End If End If
.EndUpdate()
End With End With
MyList.EndUpdate()
Else Else
UpdateInProgress = False UpdateInProgress = False
End If End If
@@ -151,6 +164,16 @@ Friend Class ListImagesLoader
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[ListImagesLoader.Update]") ErrorsDescriber.Execute(EDP.SendToLog, ex, "[ListImagesLoader.Update]")
End Try End Try
End Sub 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) Friend Sub UpdateUser(ByVal User As IUserData, ByVal Add As Boolean)
Try Try
Dim a As Action Dim a As Action
@@ -200,8 +223,8 @@ Friend Class ListImagesLoader
.BackColor = Color.LightSkyBlue .BackColor = Color.LightSkyBlue
.ForeColor = Color.MidnightBlue .ForeColor = Color.MidnightBlue
ElseIf User.IsSubscription Then ElseIf User.IsSubscription Then
.BackColor = If(User.BackColor, Settings.MainFrameUsersSubscriptionsColorBack.Value) .BackColor = GetSubscriptionColor(User, True)
.ForeColor = If(User.ForeColor, Settings.MainFrameUsersSubscriptionsColorFore.Value) .ForeColor = GetSubscriptionColor(User, False)
Else Else
.BackColor = If(User.BackColor, Settings.UserListBackColorF) .BackColor = If(User.BackColor, Settings.UserListBackColorF)
.ForeColor = If(User.ForeColor, Settings.UserListForeColorF) .ForeColor = If(User.ForeColor, Settings.UserListForeColorF)
@@ -209,6 +232,23 @@ Friend Class ListImagesLoader
End With End With
Return LVI Return LVI
End Function 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 Private Shared Function CheckUserCollection(ByVal User As IUserData) As Boolean
If User.IsCollection Then If User.IsCollection Then
With DirectCast(User, UserDataBind) 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_ALL_FULL_SUBSCR = New SCrawler.ToolStripKeyMenuItem()
Me.BTT_DOWN_SITE_FULL = New SCrawler.ToolStripKeyMenuItem() Me.BTT_DOWN_SITE_FULL = New SCrawler.ToolStripKeyMenuItem()
Me.BTT_DOWN_SITE_FULL_SUBSCR = 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_DOWN_VIDEO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_ADD_NEW_GROUP = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_ADD_NEW_GROUP = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SILENT_MODE = 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 = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_EXCLUDED_LABELS_IGNORE = 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_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_NOT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_SHOW_LIMIT_DATES_IN = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_SHOW_LIMIT_DATES_IN = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOG = New System.Windows.Forms.ToolStripButton() Me.BTT_LOG = New System.Windows.Forms.ToolStripButton()
@@ -406,7 +408,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'MENU_DOWN_ALL 'MENU_DOWN_ALL
' '
Me.MENU_DOWN_ALL.AutoToolTip = False 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.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.MENU_DOWN_ALL.ImageTransparentColor = System.Drawing.Color.Magenta Me.MENU_DOWN_ALL.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_DOWN_ALL.Name = "MENU_DOWN_ALL" 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.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.Text = "Download all site subscriptions [FULL]"
Me.BTT_DOWN_SITE_FULL_SUBSCR.ToolTipText = resources.GetString("BTT_DOWN_SITE_FULL_SUBSCR.ToolTipText") 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 'BTT_DOWN_VIDEO
' '
@@ -568,7 +581,7 @@ Partial Public Class MainFrame : Inherits System.Windows.Forms.Form
'MENU_VIEW 'MENU_VIEW
' '
Me.MENU_VIEW.AutoToolTip = False 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.Image = CType(resources.GetObject("MENU_VIEW.Image"), System.Drawing.Image)
Me.MENU_VIEW.ImageTransparentColor = System.Drawing.Color.Magenta Me.MENU_VIEW.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_VIEW.Name = "MENU_VIEW" 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.Size = New System.Drawing.Size(231, 22)
Me.BTT_SHOW_SHOW_GROUPS.Text = "Show groups instead of labels" 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 'BTT_SHOW_LIMIT_DATES_NOT
' '
Me.BTT_SHOW_LIMIT_DATES_NOT.AutoToolTip = True 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_DOWN_SITE_FULL_SUBSCR As ToolStripKeyMenuItem
Private WithEvents BTT_BUG_REPORT As ToolStripButton Private WithEvents BTT_BUG_REPORT As ToolStripButton
Private WithEvents MENU_INFO_SHOW_QUEUE As ToolStripMenuItem Private WithEvents MENU_INFO_SHOW_QUEUE As ToolStripMenuItem
Private WithEvents BTT_DOWN_SPEC As ToolStripKeyMenuItem
Private WithEvents BTT_SHOW_FILTER_ADV As ToolStripMenuItem
End Class End Class

View File

@@ -68,12 +68,15 @@ Public Class MainFrame
.ResetProgressOnMaximumChanges = False, .Visible = False} .ResetProgressOnMaximumChanges = False, .Visible = False}
Downloader = New TDownloader Downloader = New TDownloader
InfoForm = New DownloadedInfoForm InfoForm = New DownloadedInfoForm
DownloadQueue = New UserDownloadQueueForm
MyProgressForm = New ActiveDownloadingProgress MyProgressForm = New ActiveDownloadingProgress
Downloader.ReconfPool() Downloader.ReconfPool()
AddHandler Downloader.JobsChange, AddressOf Downloader_UpdateJobsCount AddHandler Downloader.JobsChange, AddressOf Downloader_UpdateJobsCount
AddHandler Downloader.Downloading, AddressOf Downloader_Downloading AddHandler Downloader.Downloading, AddressOf Downloader_Downloading
AddHandler Downloader.DownloadCountChange, AddressOf InfoForm.Downloader_DownloadCountChange AddHandler Downloader.DownloadCountChange, AddressOf InfoForm.Downloader_DownloadCountChange
AddHandler Downloader.SendNotification, AddressOf MainFrameObj.ShowNotification 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 AddHandler InfoForm.UserFind, AddressOf FocusUser
Settings.LoadUsers() Settings.LoadUsers()
MyView = New FormView(Me) MyView = New FormView(Me)
@@ -119,7 +122,7 @@ Public Class MainFrame
.Automation = New Scheduler .Automation = New Scheduler
AddHandler .Groups.Updated, AddressOf .Automation.GROUPS_Updated AddHandler .Groups.Updated, AddressOf .Automation.GROUPS_Updated
AddHandler .Groups.Deleted, AddressOf .Automation.GROUPS_Deleted 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() If .Automation.Count > 0 Then .Labels.AddRange(.Automation.GetGroupsLabels, False) : .Labels.Update()
_UFinit = False _UFinit = False
Await .Automation.Start(True) Await .Automation.Start(True)
@@ -415,20 +418,32 @@ CloseResume:
End Sub End Sub
#End Region #End Region
#Region "Info, Feed, Channels, Saved posts" #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 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 End Sub
Private Sub MENU_INFO_SHOW_QUEUE_Click(sender As Object, e As EventArgs) Handles MENU_INFO_SHOW_QUEUE.Click 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 End Sub
Private Sub MENU_INFO_SHOW_MISSING_Click(sender As Object, e As EventArgs) Handles MENU_INFO_SHOW_MISSING.Click 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 MyMissingPosts.FormShow(EDP.LogMessageValue)
If MyMissingPosts.Visible Then MyMissingPosts.BringToFront() Else MyMissingPosts.Show()
End Sub End Sub
Private Sub MENU_INFO_SHOW_USER_METRICS_Click(sender As Object, e As EventArgs) Handles MENU_INFO_SHOW_USER_METRICS.Click 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.FormShow(EDP.LogMessageValue)
MyUserMetrics.FormShowS
End Sub End Sub
#End Region
Private Sub ShowFeed() Handles BTT_FEED.Click, BTT_TRAY_FEED_SHOW.Click Private Sub ShowFeed() Handles BTT_FEED.Click, BTT_TRAY_FEED_SHOW.Click
If MyFeed Is Nothing Then MyFeed = New DownloadFeedForm : AddHandler Downloader.FeedFilesChanged, AddressOf MyFeed.Downloader_FilesChanged If MyFeed Is Nothing Then MyFeed = New DownloadFeedForm : AddHandler Downloader.FeedFilesChanged, AddressOf MyFeed.Downloader_FilesChanged
If MyFeed.Visible Then MyFeed.BringToFront() Else MyFeed.Show() If MyFeed.Visible Then MyFeed.BringToFront() Else MyFeed.Show()
@@ -483,19 +498,32 @@ CloseResume:
DownloadSiteFull(False, e.IncludeInTheFeed, True, e.Shift) DownloadSiteFull(False, e.IncludeInTheFeed, True, e.Shift)
End Sub End Sub
#End Region #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, Private Sub DownloadSiteFull(ByVal ReadyForDownloadOnly As Boolean, ByVal IncludeInTheFeed As Boolean,
ByVal Subscription As Boolean, Optional ByVal IgnoreExists As Boolean = False) ByVal Subscription As Boolean, Optional ByVal IgnoreExists As Boolean = False)
Using f As New SiteSelectionForm(Settings.LatestDownloadedSites.ValuesList) Using f As New SiteSelectionForm(Settings.LatestDownloadedSites.ValuesList)
f.ShowDialog() f.ShowDialog()
If f.DialogResult = DialogResult.OK Then If f.DialogResult = DialogResult.OK AndAlso f.SelectedSites.Count > 0 Then
Settings.LatestDownloadedSites.Clear() Settings.LatestDownloadedSites.Clear()
Settings.LatestDownloadedSites.AddRange(f.SelectedSites) Settings.LatestDownloadedSites.AddRange(f.SelectedSites)
Settings.LatestDownloadedSites.Update() Settings.LatestDownloadedSites.Update()
If f.SelectedSites.Count > 0 Then Using g As New Groups.DownloadGroup
Downloader.AddRange(Settings.GetUsers(Function(u) f.SelectedSites.Contains(u.Site) And (u.Exists Or IgnoreExists) And g.Sites.AddRange(f.SelectedSites)
u.IsSubscription = Subscription And g.ReadyForDownload = True
(Not ReadyForDownloadOnly Or u.ReadyForDownload)), IncludeInTheFeed) g.ReadyForDownloadIgnore = Not ReadyForDownloadOnly
End If If Subscription Then
g.Subscriptions = True
g.SubscriptionsOnly = True
End If
g.DownloadUsers(IncludeInTheFeed, ReadyForDownloadOnly, IgnoreExists)
End Using
End If End If
End Using End Using
End Sub End Sub
@@ -679,6 +707,7 @@ CloseResume:
BTT_SHOW_LABELS.Checked = m = ShowingModes.Labels BTT_SHOW_LABELS.Checked = m = ShowingModes.Labels
BTT_SHOW_NO_LABELS.Checked = m = ShowingModes.NoLabels BTT_SHOW_NO_LABELS.Checked = m = ShowingModes.NoLabels
BTT_SHOW_SHOW_GROUPS.Checked = Settings.ShowGroupsInsteadLabels BTT_SHOW_SHOW_GROUPS.Checked = Settings.ShowGroupsInsteadLabels
BTT_SHOW_FILTER_ADV.Checked = m = ShowingModes.AdvancedFilter
SetExcludedButtonChecker() SetExcludedButtonChecker()
With Settings With Settings
If Not m = ShowingModes.Labels Then .Labels.Current.Clear() : .Labels.Current.Update() If Not m = ShowingModes.Labels Then .Labels.Current.Clear() : .Labels.Current.Update()
@@ -705,6 +734,19 @@ CloseResume:
End If End If
End Using End Using
End Function 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 #End Region
#Region "5 - view dates" #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, 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 NoLabels = 1000
Deleted = 10000 Deleted = 10000
Suspended = 12000 Suspended = 12000
AdvancedFilter = 100000
End Enum End Enum
Friend Enum ShowingDates As Integer Friend Enum ShowingDates As Integer
[Off] = 0 [Off] = 0
@@ -83,12 +84,20 @@ Friend Module MainMod
Friend MyProgressForm As ActiveDownloadingProgress Friend MyProgressForm As ActiveDownloadingProgress
Friend MainFrameObj As MainFrameObjects Friend MainFrameObj As MainFrameObjects
Friend ReadOnly DateTimeDefaultProvider As New ADateTime(ADateTime.Formats.BaseDateTime) 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 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 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 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 UserExistsNonSubscriptionsPredicate As New FPredicate(Of IUserData)(Function(u) u.Exists And Not u.IsSubscription)
Friend ReadOnly LogConnector As New LogHost Friend ReadOnly LogConnector As New LogHost
Friend DefaultUserAgent As String = String.Empty 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" #Region "File name operations"
Friend FileDateAppenderProvider As IFormatProvider Friend FileDateAppenderProvider As IFormatProvider
''' <summary>File, Date</summary> ''' <summary>File, Date</summary>

View File

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

View File

@@ -41,6 +41,11 @@ Namespace Plugin.Hosts
FileSetManually = True FileSetManually = True
End Set End Set
End Property 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) Friend Sub New(ByVal URL As String, ByVal OutputFile As SFile)
Me.URL = URL Me.URL = URL
Me.File = OutputFile Me.File = OutputFile
@@ -111,6 +116,8 @@ Namespace Plugin.Hosts
End If End If
Instance.DownloadSingleObject(If(ExternalSource, Me), Token) Instance.DownloadSingleObject(If(ExternalSource, Me), Token)
ExchangeData(ExternalSource, Me) 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 If Not ExternalSource Is Nothing Then
With ExternalSource : _HasError = .HasError : _Exists = .Exists : End With With ExternalSource : _HasError = .HasError : _Exists = .Exists : End With
End If End If

View File

@@ -13,8 +13,8 @@ Namespace Plugin.Hosts
End Sub End Sub
Friend Sub Add(ByVal ex As Exception, ByVal Message As String, 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 ShowMainMsg As Boolean = False, Optional ByVal ShowErrorMsg As Boolean = False,
Optional ByVal SendInLog As Boolean = True) Implements ILogProvider.Add Optional ByVal SendToLog As Boolean = True) Implements ILogProvider.Add
ErrorsDescriber.Execute(New ErrorsDescriber(ShowMainMsg, ShowErrorMsg, SendInLog), ex, Message) ErrorsDescriber.Execute(New ErrorsDescriber(ShowMainMsg, ShowErrorMsg, SendToLog), ex, Message)
End Sub End Sub
End Class End Class
End Namespace 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.Twitter.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.Mastodon.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.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.RedGifs.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.YouTube.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), 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.XVIDEOS.SiteSettings, _XML, GlobalPath, _Temp, _Imgs, _Vids),
New PluginHost(New API.ThisVid.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.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 End Function
Friend Shared Function GetPluginsHosts(ByRef _XML As XmlFile, ByVal GlobalPath As SFile, Friend Shared Function GetPluginsHosts(ByRef _XML As XmlFile, ByVal GlobalPath As SFile,
ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean), ByRef _Temp As XMLValue(Of Boolean), ByRef _Imgs As XMLValue(Of Boolean),

View File

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

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