Compare commits

...

35 Commits

Author SHA1 Message Date
Andy
5bd79ff3c2 2023.12.14.1
API.Twitter: add additional nodes
2023-12-14 23:06:55 +03:00
Andy
3268bca0d3 2023.12.14.0
YT
YouTubeSettings: add 'CreateThumbnails_Video' and 'CreateThumbnails_Music' properties
VideoListForm: add 'BTT_SELECT_ALL' and 'BTT_SELECT_NONE'
YouTubeMediaContainerBase: update thumbnails downloading
2023-12-14 14:19:20 +03:00
Andy
1455a31879 2023.12.13.0
YT
Structures: add 'YouTubeChannelTab' enum
YouTubeFunctions: add 'StandardizeURL_Channel' function; update 'Info_GetUrlType', 'Parse' and 'Parse_Internal' functions (YouTubeChannelTab)
YouTubeSettings: add 'ChannelsDownload' property and 'YouTubeChannelTabConverter' converter for grid
Add 'ChannelTabsChooserForm'
VideoListForm: remove buttons 'BTT_ADD_NO_SHORTS' and 'BTT_ADD_SHORTS_ONLY'; update 'BTT_ADD_KeyClick' function

SCrawler
API.M3U8Base: add 'M3U8URL' structure; update 'Download' function with 'OnlyDownload' arg
API.ProfileSaved: add sorting of feed files
API.Xhamster: update M3U8 parser and 'Download' function for additional downloading ways; add 'ReencodeVideos' property (to the 'SiteSettings')
API.YouTube: update to updated 'Parse' function
2023-12-13 19:48:50 +03:00
Andy
64d6e6b28c 2023.12.10.0
YT: move updater functions into the app
SCrawler.API.Twitter: update parsing function to new GDL (1.26.4-dev)
2023-12-10 10:16:58 +03:00
Andy
da7cddc720 Update README.md 2023-12-07 14:08:32 +03:00
Andy
72be6b09ff Update README.md 2023-12-07 11:33:52 +03:00
Andy
3a0837a1b0 2023.12.7.0 2023-12-07 11:03:34 +03:00
Andy
0657f3d195 2023.12.6.1
Update updater
YT: add new version check at start
2023-12-06 18:28:36 +03:00
Andy
c92314d8e8 2023.12.6.0
Add updater
2023-12-06 10:55:50 +03:00
Andy
d99243ce46 2023.12.5.0
YT
VideoListForm: add a check of adding a URL if it has already been downloaded ('ValidateContainerURL')
YouTubeMediaContainerBase: add 'GetUrls' and 'GetFiles' functions; make 'Files' protected friend; update 'CreateUrlFile' function

SCrawler
Add downloaded saved posts to the feed
API.ProfileSaved: add token verification for multi-acc
API.SiteSettingsBase: update 'UpdateResponserFile' and 'CLONE_PROPERTIES.filterUC' functions
API.UserDataBase: add a null host check before request a new key; update 'OpenFolder' function (for saved posts)
API.YouTube: add the ability to download YouTube user community feeds
DownloadProgress: add 'KeyClickEventArgs' to download saved posts excluding from feed; add 'FeedFilesChanged' event; update 'Start' function
DownloadSavedPostsForm: add 'FeedFilesChanged' event and handler; update 'Start' function
Feed.FeedMedia: make the class compatible to work with saved posts
StandaloneDownloader.VideoDownloaderForm: add a check of adding a URL if it has already been downloaded ('ValidateContainerURL')
TDownloader: add the 'IsSavedPosts' field to the 'UserMediaD' structure; update 'UserMediaD.New(EContainer)' function (for saved posts); update 'UserMediaD.ToEContainer' function; add 'SessionSavedPosts' property
MainFrame: add 'Alt+A' hotkey to show scheduler; add 'Alt+P' hotkey to show progress form
Hosts.DownloadableMediaHost: add URL file to files list
2023-12-05 12:05:20 +03:00
Andy
3dae40b696 Update Plugins.md 2023-12-04 07:30:21 +03:00
Andy
ee0c773c37 Update README.md 2023-11-26 03:18:04 +03:00
Andy
ebe5f0ca01 2023.11.25.0
SettingsHost, SiteSettingsBase: change comparer to 'MembersDistinctComparerExtended'
API.RedGifs: fix initial UserAgent value
AutoDownloader: add 'IsManual' to 'Copy' function
2023-11-25 03:00:14 +03:00
Andy
a540aded68 2023.11.24.0
Scheduler: handle scheduler change error (collection was modified)
SchedulerEditorForm: add scheduler name to form title
DownloadProgress: fix disposing error when some objects are already null
API.Reddit: add special notification for error 429
API.Twitter: handle JSON deserialization error
Porn sites: fix incorrect parsing of search queries
YouTube: path not set when adding array to download
2023-11-24 04:54:04 +03:00
Andy
0ec617c1dc 2023.11.21.0
YouTube
Add absolute paths support
PlaylistArrayForm: fix RTB issue
Single media: the file name is not changed manually

SCrawler
Automation: add manual tasks
DownloaderUrlsArrForm: fix RTB issue
SiteSettingsBase: add use of Netscape cookies if enabled for a class; disable saving Netscape cookies on init
Add feeds update when users' location and/or basic info changes
API.TikTok: add ID, username and friendly name extraction from data; update request URL; update 'GetUserUrl' function; add new option 'Use video date as file date'
API.YouTube: set 'UseNetscapeCookies'
2023-11-21 09:25:22 +03:00
Andy
45adf735a7 2023.11.17.0 2023-11-17 02:30:23 +03:00
Andy
496c9487cd 2023.11.15.0
ADD FACEBOOK
SiteSettingsBase: update 'CLONE_PROPERTIES' function (exclude 'DoNotUse' attribute)
API.Instagram: handle 401 error
API.ThreadsNet.SiteSettings: make the class compatible for Facebook
xHanster, XVideos, PornHub, ThisVid: update download function for search queries
Hosts.PropertyValueHost: set the 'Exists' value based on the 'DoNotUse' attribute
Hosts.SettingsHost: use 'GetObjectMembers' instead of 'GetTypeInfo.DeclaredMembers' to get class members
2023-11-17 02:30:23 +03:00
Andy
96705f1c59 2023.11.13.1
PornHub: add playlists downloading
2023-11-13 23:18:21 +03:00
Andy
f08a5f9259 2023.11.13.0
API.JFF: update UserAgent start value
ActiveDownloadingProgress: fix unnecessary focus of inactive form
FeedMedia: add additional buttons to the context menu
FeedSpecialCollection: 'Favorite' feed does not appear in the feeds list if it is created manually
UserCreatorForm: disable account selection when opening an empty form
MainFrame: fix background image resizing on form state changes
SettingsHost: inherit path when cloning an instance
SettingsHostCollection: Extract user path change function to static
2023-11-13 20:53:32 +03:00
Andy
95cbb6aeb1 2023.11.12.2
API.Instagram: handle JSON primitive error (simple line)
API.OnlyFans: handle 401 error; handle file update error
API.Xhamster: handle 503 error
Scheduler: handle automation start error
2023-11-12 22:34:47 +03:00
Andy
5af0dcc46e 2023.11.12.1
YouTube: add cc and subtitles merge
2023-11-12 20:57:05 +03:00
Andy
f5789862ba 2023.11.12.0
Add special feeds
2023-11-12 20:34:53 +03:00
Andy
12c02580f6 2023.11.9.0
ADD MULTI-ACCOUNT

PluginProvider
IDownloadableMedia: added 'AccountName' property
IPluginContentProvider: added 'AccountName' property
ISiteSettings: added properties: 'AccountName', 'Temporary', 'AvailableText', 'DefaultInstance'; added functions: 'Clone', 'Update', 'Delete'; removed 'Load' function; implement 'IDisposable' interface
PropertyValue: added functions: 'BeginInit', 'EndInit', 'Clone'

YT
YouTubeSettings: make the class compatible for multi-acc
YouTubeMediaContainerBase: add 'AccountName' property

SCrawler
IUserData: add properties: 'HostStatic', 'AccountName'
ProfileSaved: add the ability to download saved posts from all accounts
SiteSettingsBase: add multi-acc support; add 'UserOptionsType' for future purposes; update initializers; update responser initializing; add 'CLONE_PROPERTIES' and 'CloneGetEmptySettingsInstance' functions; 'IDisposable' support
UserDataBase: add multi-acc support; change host retrieval method
DomainsContainer: implements 'IDisposable' interface

API.All sites: add multi-acc support; move the Icon and Image setting to the initializer; update initializer
API.Instagram: change some property types
API.Reddit: set 'AvailableText'; update 'UpdateRedGifsToken' and 'UserOptions' functions
API.Mastodon: remove 'MastodonDomains' class and 'SettingsForm' form; replace 'MastodonDomains' with 'DomainsContainer'; update functions 'IsMyUser' and 'IsMyImageVideo'; update to 'DefaultInstance' environment; update 'UserData.ResetCredentials' function
API.XVIDEOS: update to 'DefaultInstance' environment
API.Xhamster: update to 'DefaultInstance' environment

STDownloader: add multi-acc compatibility

SiteEditorForm: add option 'Download saved posts'; update providers; add additional providers; add multi-acc support

PluginsEnvironment: add 'PClonableAttribute'; add multi-acc support
2023-11-12 01:31:09 +03:00
Andy
6def34d5e9 2023.10.12.0
API.ThisVid: update parser ('SessionPosts')
2023-10-12 19:47:02 +03:00
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
196 changed files with 9749 additions and 2387 deletions

View File

@@ -39,5 +39,4 @@ I welcome requests! Follow these steps to contribute:
If I'm interested in a site you want to add, it may be added in future releases.
# Sites I will never develop
- Facebook
- Tumblr

View File

@@ -1,3 +1,157 @@
# 2023.12.14.1
*2023-12-14*
- Fixed
- Twitter: some twitter profiles don't download completely
# 2023.12.14.0
*2023-12-14*
- Added
- YouTube: options `Create thumbnail files (video)` and `Create thumbnail files (music)`
- YouTube: `Select all` and `Select none` buttons
# 2023.12.13.0
*2023-12-13*
- Added
- YouTube (standalone app): additional options for downloading channels
- Updated
- gallery-dl up to version 1.26.4
- Fixed
- Feed: saved posts are added to the end of the feed
- xHamster: some videos won't download
# 2023.12.10.0
*2023-12-10*
- Updated
- gallery-dl up to version 1.26.4-dev
- Fixed
- Twitter: data is not downloading
# 2023.12.7.0
*2023-12-07*
- Added
- Saved posts: add downloaded saved posts to the feed
- **YouTube (SCrawler): the ability to download YouTube user community feeds**
- Main window: add `Alt+A` hotkey to show scheduler
- Main window: add `Alt+P` hotkey to show progress form
- YouTube: check of adding a URL if it has already been downloaded
- YouTube: ability to check for a new version at start
- **Updater**
- Fixed
- Standalone downloader: URL files are not deleted along with the file
- Minor bugs
# 2023.11.25.0
*2023-11-25*
- Fixed
- Reddit: missing refresh token button in the settings form
# 2023.11.24.0
*2023-11-24*
For those of you who use TikTok, I recommend updating [TikTok plugin](https://github.com/bashonly/yt-dlp-TTUser) to the latest version using [these instructions](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-install-yt-dlp-ttuser-plugin).
- Added
- Automation: manual task option
- Scheduler: add scheduler name to form title
- Feeds: update when users' location and/or basic information changes
- Reddit: special notification for error 429
- TikTok: ID, username and friendly name extraction from data
- TikTok: new option `Use video date as file date`
- YouTube: absolute path for a single playlist
- Updated
- yt-dlp up to version 2023.11.16
- Fixed
- Scheduler: scheduler change error
- Twitter: JSON deserialization error
- xHamster, XVideos, PornHub, ThisVid: incorrect parsing of search queries
- YouTube: the file name is not changed manually
- YouTube: path not set when adding array to download
- Minor bugs
# 2023.11.17.0
*2023-11-17*
- Added
- **Facebook**
- **Multi-account**
- **Special feeds**
- Site settings: option `Download saved posts`
- Standalone downloader: support for multiple account
- PornHub: add playlists downloading
- YouTube: ability to download subtitles **and** `CC` if they both exists
- Other improvements
- PluginProvider
- `IDownloadableMedia`: added `AccountName` property
- `IPluginContentProvider`: added `AccountName` property
- `ISiteSettings`: added properties: `AccountName`, `Temporary`, `AvailableText`, `DefaultInstance`; added functions: `Clone`, `Update`, `Delete`; removed `Load` function; implement `IDisposable` interface
- `PropertyValue`: added functions: `BeginInit`, `EndInit`, `Clone`
- `Attributes.DoNotUse` - add `Value` field
- Fixed
- Instagram: handling 401 error
- OnlyFans: handling 401 error
- xHamster: handling 503 error
- xHamster: incorrect parsing of search queries
- XVideos: incorrect parsing of search queries
- ThisVid: incorrect parsing of search queries
- PornHub: incorrect parsing of search queries
- Automation: handle automation start error (in some cases) when changing scheduler
- Minor bugs
# 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*

6
FAQ.md
View File

@@ -113,4 +113,8 @@ A: I can only [suggest](#q-you-lost-me-your-program-is-too-complicated) you find
#### Q: **Can you add a step-by-step guide or video on how to use the program?**
A: **NO! NEVER!** The guide fully covers all the functionality of SCrawler! If you don't respect my work, I don't waste my time. If you want, you can create a video tutorial and send it to me. Then I add it. All options and what each option does described on the wiki. The wiki also contains a description of all settings and how-to configure them. For complex settings, there is a steep-by-steep guide. Read the [main](README.md) information and [GUIDE](https://github.com/AAndyProgram/SCrawler/wiki/) and you won't have any problems. I have developed a program with an intuitive interface. There is a Settings button, download buttons, a context menu that drops down when a user is clicked, and other controls. Anyone can use it.
A: **NO! NEVER!** The guide fully covers all the functionality of SCrawler! If you don't respect my work, I don't waste my time. If you want, you can create a video tutorial and send it to me. Then I add it. All options and what each option does described on the wiki. The wiki also contains a description of all settings and how-to configure them. For complex settings, there is a steep-by-steep guide. Read the [main](README.md) information and [GUIDE](https://github.com/AAndyProgram/SCrawler/wiki/) and you won't have any problems. I have developed a program with an intuitive interface. There is a Settings button, download buttons, a context menu that drops down when a user is clicked, and other controls. Anyone can use it.
**The following video shows how to add credentials:**
[![How to configure](https://img.youtube.com/vi/XDn7zG4I700/0.jpg)](https://www.youtube.com/watch?v=XDn7zG4I700)

View File

@@ -1,3 +1,7 @@
You can create a plugin for any site you want. **To create a plugin, read [this guide](https://github.com/AAndyProgram/SCrawler/wiki/Plugins).**
If you've created a plugin, you can create a [new issue](https://github.com/AAndyProgram/SCrawler/issues/new?assignees=&labels=New+Plugin&projects=&template=plugin_add.md&title=%5BNEW+PLUGIN%5D) and I'll add your plugin to the list below.
List of available plugins:
Tools:

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 32 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 9.7 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 8.7 KiB

After

Width:  |  Height:  |  Size: 103 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 34 KiB

After

Width:  |  Height:  |  Size: 39 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: 19 KiB

After

Width:  |  Height:  |  Size: 20 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 17 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 6.3 KiB

After

Width:  |  Height:  |  Size: 7.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 25 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 KiB

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 22 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 20 KiB

View File

@@ -1,9 +1,10 @@
<!-- # :rainbow_flag: Happy LGBT Pride Month :tada:
-->
# :rainbow_flag: Social networks crawler :rainbow_flag:
# 🏳️‍🌈 Social networks crawler 🏳️‍🌈
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
[![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE)
[![Discord](https://img.shields.io/discord/1124032649682493462?logo=discord)](https://discord.gg/uFNUXvFFmg)
[![GitHub all releases](https://img.shields.io/github/downloads/aandyprogram/scrawler/total?label=Total%20downloads)](https://github.com/AAndyProgram/SCrawler/releases)
[![FAQ](https://img.shields.io/badge/FAQ-green)](FAQ.md)
[![GUIDE](https://img.shields.io/badge/GUIDE-green)](https://github.com/AAndyProgram/SCrawler/wiki)
@@ -11,7 +12,7 @@
:eu:
:greece:
A program to download photo and video from [any site](#supported-sites) (e.g. YouTube, YouTube Music, OnlyFans, Reddit, Twitter, Mastodon, Instagram, TikTok, RedGifs, JustForFans, 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, Facebook, TikTok, RedGifs, JustForFans, PornHub, XHamster, XVIDEOS, ThisVid, LPSG, Pinterest).
**If you like SCrawler, please like the program on [this site](https://alternativeto.net/software/scrawler/about/) and/or [this](https://www.softpedia.com/get/Internet/Download-Managers/Social-networks-crawler.shtml)**
<!---Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush:
@@ -29,7 +30,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
# What can program do:
- Download pictures and videos from users' profiles and subreddits:
- YouTube videos, shorts, users, artists, playlists, music, tracks;
- YouTube videos, shorts, community feeds, users, artists, playlists, music, tracks;
- Reddit images, galleries of images, videos, saved posts;
- Redgifs videos (https://www.redgifs.com/);
- Twitter images and videos, saved (bookmarked) posts;
@@ -37,6 +38,8 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- JustForFans images and videos, saved (bookmarked) posts;
- Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories, saved posts;
- Threads images and videos;
- Facebook images and videos, stories, saved posts;
- TikTok videos;
- Pinterest boards, users, saved posts;
- Imgur images, galleries and videos;
@@ -52,6 +55,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **Advanced user management**
- **Automation** ([downloading data automatically](https://github.com/AAndyProgram/SCrawler/wiki/Settings#automation) every ```X``` minutes)
- **Feed** ([feed](https://github.com/AAndyProgram/SCrawler/wiki#feed) of downloaded media files and subscriptions posts)
- Multiple accounts support
- Labeling users
- Create [download groups](https://github.com/AAndyProgram/SCrawler/wiki/Settings#download-groups)
- Adding users to favorites and temporary
@@ -73,6 +77,8 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **OnlyFans**
- **Mastodon**
- **Instagram**
- **Threads**
- **Facebook**
- JustForFans
- TikTok
- RedGifs
@@ -124,6 +130,8 @@ First, the program downloads the full profile. After the program downloads only
- [OnlyFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans)
- [Mastodon](https://github.com/AAndyProgram/SCrawler/wiki/Settings#mastodon)
- [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram)
- [Threads](https://github.com/AAndyProgram/SCrawler/wiki/Settings#threads)
- [Facebook](https://github.com/AAndyProgram/SCrawler/wiki/Settings#facebook)
- [JustForFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#justforfans)
- [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok)
- [RedGifs](https://github.com/AAndyProgram/SCrawler/wiki/Settings#redgifs)
@@ -137,6 +145,10 @@ First, the program downloads the full profile. After the program downloads only
**Full guide you can find [here](https://github.com/AAndyProgram/SCrawler/wiki)**
**Video on how to configure**
[![How to configure](https://img.youtube.com/vi/XDn7zG4I700/0.jpg)](https://www.youtube.com/watch?v=XDn7zG4I700)
# Installation
**Just download the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest), unzip the program archive to any folder and enjoy.** :blush:
@@ -159,6 +171,8 @@ The program has an intuitive interface.
**[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
[![How to configure](https://img.youtube.com/vi/XDn7zG4I700/0.jpg)](https://www.youtube.com/watch?v=XDn7zG4I700)
Just add a user profile and **click the ```Download``` button**.
```mermaid
@@ -191,7 +205,6 @@ F5-->[*]
Discord server: https://discord.gg/uFNUXvFFmg
[e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me
<!--
[e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me
@@ -202,4 +215,4 @@ Discord (contact the developer): andyprogram
Discord server: https://discord.gg/uFNUXvFFmg
[Wire](https://account.wire.com/user-profile/?id=93985052-cf2c-4b72-ac75-bbe3231cf544): @andyprogram
-->
-->

View File

@@ -1,3 +1,3 @@
[*.vb]
# Modifier preferences
file_header_template = Copyright (C) 2023 Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>
file_header_template = Copyright (C) Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>

View File

@@ -65,6 +65,12 @@ Namespace Plugin.Attributes
End Class
''' <summary>Attribute to disable some properties for host use</summary>
<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class DoNotUse : Inherits Attribute
Public ReadOnly Value As Boolean = True
Public Sub New()
End Sub
Public Sub New(ByVal Value As Boolean)
Me.Value = Value
End Sub
End Class
''' <summary>Special property updater</summary>
<AttributeUsage(AttributeTargets.Method, AllowMultiple:=True, Inherited:=False)> Public NotInheritable Class PropertyUpdater : Inherits Attribute

View File

@@ -14,6 +14,7 @@ Namespace Plugin
ReadOnly Property SiteIcon As Drawing.Image
ReadOnly Property Site As String
ReadOnly Property SiteKey As String
Property AccountName As String
Property ThumbnailUrl As String
Property ThumbnailFile As String
Property Title As String

View File

@@ -15,6 +15,7 @@ Namespace Plugin
Property Thrower As IThrower
Property LogProvider As ILogProvider
Property Settings As ISiteSettings
Property AccountName As String
Property Name As String
Property ID As String
Property Options As String

View File

@@ -8,7 +8,7 @@
' but WITHOUT ANY WARRANTY
Imports System.Drawing
Namespace Plugin
Public Interface ISiteSettings
Public Interface ISiteSettings : Inherits IDisposable
Enum Download As Integer
Main = 0
SavedPosts = 1
@@ -17,6 +17,9 @@ Namespace Plugin
ReadOnly Property Icon As Icon
ReadOnly Property Image As Image
ReadOnly Property Site As String
Property AccountName As String
Property Temporary As Boolean
Property DefaultInstance As ISiteSettings
ReadOnly Property SubscriptionsAllowed As Boolean
Property Logger As ILogProvider
Function GetUserUrl(ByVal User As IPluginContentProvider) As String
@@ -25,9 +28,6 @@ Namespace Plugin
Function GetInstance(ByVal What As Download) As IPluginContentProvider
Function GetSingleMediaInstance(ByVal URL As String, ByVal OutputFile As String) As IDownloadableMedia
Function GetUserPostUrl(ByVal User As IPluginContentProvider, ByVal Media As IUserMedia) As String
#Region "XML Support"
Sub Load(ByVal XMLValues As IEnumerable(Of KeyValuePair(Of String, String)))
#End Region
#Region "Initialization"
Sub BeginInit()
Sub EndInit()
@@ -37,6 +37,7 @@ Namespace Plugin
Sub EndEdit()
#End Region
#Region "Site availability"
Property AvailableText As String
Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
Function ReadyToDownload(ByVal What As Download) As Boolean
#End Region
@@ -46,7 +47,10 @@ Namespace Plugin
Sub AfterDownload(ByVal User As Object, ByVal What As Download)
Sub DownloadDone(ByVal What As Download)
#End Region
Sub Update()
Function Clone(ByVal Full As Boolean) As ISiteSettings
Sub Delete()
Overloads Sub Update()
Overloads Sub Update(ByVal Source As ISiteSettings)
Sub Reset()
Sub OpenSettingsForm()
Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)

View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("Plugin provider for SCrawler")>
<Assembly: AssemblyCompany("AndyProgram")>
<Assembly: AssemblyProduct("SCrawler.PluginProvider")>
<Assembly: AssemblyCopyright("Copyright © 2023")>
<Assembly: AssemblyCopyright("Copyright © 2024")>
<Assembly: AssemblyTrademark("AndyProgram")>
<Assembly: ComVisible(False)>
@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2023.8.6.0")>
<Assembly: AssemblyFileVersion("2023.8.6.0")>
<Assembly: AssemblyVersion("2023.11.24.0")>
<Assembly: AssemblyFileVersion("2023.11.24.0")>
<Assembly: NeutralResourcesLanguage("en")>

View File

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

View File

@@ -11,6 +11,7 @@ Namespace Plugin
Public Event ValueChanged As IPropertyValue.ValueChangedEventHandler Implements IPropertyValue.ValueChanged
Public Property [Type] As Type Implements IPropertyValue.Type
Public Property OnChangeFunction As IPropertyValue.ValueChangedEventHandler
Private _Initialization As Boolean = False
''' <inheritdoc cref="PropertyValue.New(Object, Type, ByRef IPropertyValue.ValueChangedEventHandler)"/>
''' <exception cref="ArgumentNullException"></exception>
Public Sub New(ByVal InitValue As Object)
@@ -41,10 +42,25 @@ Namespace Plugin
End Get
Set(ByVal NewValue As Object)
_Value = NewValue
If Not OnChangeFunction Is Nothing Then OnChangeFunction.Invoke(Value)
RaiseEvent ValueChanged(_Value)
If Not _Initialization Then
If Not OnChangeFunction Is Nothing Then OnChangeFunction.Invoke(Value)
RaiseEvent ValueChanged(_Value)
End If
End Set
End Property
Public Sub BeginInit()
_Initialization = True
End Sub
Public Sub EndInit()
_Initialization = False
End Sub
Public Sub Clone(ByVal Source As PropertyValue)
_Initialization = True
Type = Source.Type
OnChangeFunction = Source.OnChangeFunction
_Value = Source._Value
_Initialization = False
End Sub
End Class
Public Interface IPropertyValue
''' <summary>Event for internal exchange</summary>

View File

@@ -0,0 +1,3 @@
[*.vb]
# Modifier preferences
file_header_template = Copyright (C) Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>

View File

@@ -0,0 +1,33 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace [Shared]
Public Module Functions
Public Const NewReleaseFolderName As String = "__NewRelease"
Public Function GetCurrentMaxVer(Optional ByVal Path As SFile = Nothing) As Version
Try
If Path.IsEmptyString Then Path = Application.StartupPath.CSFileP
If Path.Exists(SFO.Path, False) Then
Dim versions As New List(Of Version)
Dim v As FileVersionInfo
With SFile.GetFiles(Path, "*.exe",, EDP.ReturnValue).ListIfNothing.Where(Function(f) f.Name = "SCrawler" Or f.Name = "YouTubeDownloader")
If .ListExists Then
For Each f As SFile In .Self
v = FileVersionInfo.GetVersionInfo(f)
versions.Add(New Version(v.ProductVersion))
Next
End If
End With
If versions.Count > 0 Then Return versions.LastOrDefault
End If
Catch
End Try
Return Nothing
End Function
End Module
End Namespace

View File

@@ -0,0 +1,13 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On

View File

@@ -0,0 +1,10 @@
<?xml version="1.0" encoding="utf-8"?>
<MyApplicationData xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<MySubMain>false</MySubMain>
<SingleInstance>false</SingleInstance>
<ShutdownMode>0</ShutdownMode>
<EnableVisualStyles>true</EnableVisualStyles>
<AuthenticationMode>0</AuthenticationMode>
<ApplicationType>1</ApplicationType>
<SaveMySettingsOnExit>true</SaveMySettingsOnExit>
</MyApplicationData>

View File

@@ -0,0 +1,37 @@
Imports System.Resources
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("SCrawler.Shared")>
<Assembly: AssemblyDescription("SCrawler shared functions")>
<Assembly: AssemblyCompany("AndyProgram")>
<Assembly: AssemblyProduct("SCrawler.Shared")>
<Assembly: AssemblyCopyright("Copyright © 2024")>
<Assembly: AssemblyTrademark("AndyProgram")>
<Assembly: ComVisible(False)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("75a22c7c-6f90-49cb-852b-078ea0b8f2b6")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2023.12.7.0")>
<Assembly: AssemblyFileVersion("2023.12.7.0")>
<Assembly: NeutralResourcesLanguage("en")>

View File

@@ -0,0 +1,63 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Imports System
Namespace My.Resources
'This class was auto-generated by the StronglyTypedResourceBuilder
'class via a tool like ResGen or Visual Studio.
'To add or remove a member, edit your .ResX file then rerun ResGen
'with the /str option, or rebuild your VS project.
'''<summary>
''' A strongly-typed resource class, for looking up localized strings, etc.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "16.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo
'''<summary>
''' Returns the cached ResourceManager instance used by this class.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If Object.ReferenceEquals(resourceMan, Nothing) Then
Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("SCrawler.Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Overrides the current thread's CurrentUICulture property for all
''' resource lookups using this strongly typed resource class.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set
resourceCulture = value
End Set
End Property
End Module
End Namespace

View File

@@ -0,0 +1,117 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>

View File

@@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "16.10.0.0"), _
Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Partial Friend NotInheritable Class MySettings
Inherits Global.System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings()),MySettings)
#Region "My.Settings Auto-Save Functionality"
#If _MyType = "WindowsForms" Then
Private Shared addedHandler As Boolean
Private Shared addedHandlerLockObject As New Object
<Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Private Shared Sub AutoSaveSettings(sender As Global.System.Object, e As Global.System.EventArgs)
If My.Application.SaveMySettingsOnExit Then
My.Settings.Save()
End If
End Sub
#End If
#End Region
Public Shared ReadOnly Property [Default]() As MySettings
Get
#If _MyType = "WindowsForms" Then
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
#End If
Return defaultInstance
End Get
End Property
End Class
End Namespace
Namespace My
<Global.Microsoft.VisualBasic.HideModuleNameAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Module MySettingsProperty
<Global.System.ComponentModel.Design.HelpKeywordAttribute("My.Settings")> _
Friend ReadOnly Property Settings() As Global.SCrawler.My.MySettings
Get
Return Global.SCrawler.My.MySettings.Default
End Get
End Property
End Module
End Namespace

View File

@@ -0,0 +1,7 @@
<?xml version='1.0' encoding='utf-8'?>
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles>
<Profile Name="(Default)" />
</Profiles>
<Settings />
</SettingsFile>

View File

@@ -0,0 +1,151 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="15.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProjectGuid>{DC634700-24C7-42DD-BF8F-87E6CC54E625}</ProjectGuid>
<OutputType>Library</OutputType>
<RootNamespace>SCrawler</RootNamespace>
<AssemblyName>SCrawler.Shared</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Windows</MyType>
<TargetFrameworkVersion>v4.6.1</TargetFrameworkVersion>
<Deterministic>true</Deterministic>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\</OutputPath>
<DocumentationFile>
</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<DebugType>pdbonly</DebugType>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<Optimize>true</Optimize>
<OutputPath>bin\Release\</OutputPath>
<DocumentationFile>
</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
</PropertyGroup>
<PropertyGroup>
<OptionExplicit>On</OptionExplicit>
</PropertyGroup>
<PropertyGroup>
<OptionCompare>Binary</OptionCompare>
</PropertyGroup>
<PropertyGroup>
<OptionStrict>Off</OptionStrict>
</PropertyGroup>
<PropertyGroup>
<OptionInfer>On</OptionInfer>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Debug|x64'">
<DebugSymbols>true</DebugSymbols>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x64\Debug\</OutputPath>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<DebugType>full</DebugType>
<PlatformTarget>x64</PlatformTarget>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Release|x64'">
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x64\Release\</OutputPath>
<Optimize>true</Optimize>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<DebugType>pdbonly</DebugType>
<PlatformTarget>x64</PlatformTarget>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Debug|x86'">
<DebugSymbols>true</DebugSymbols>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x86\Debug\</OutputPath>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<DebugType>full</DebugType>
<PlatformTarget>x86</PlatformTarget>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Release|x86'">
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x86\Release\</OutputPath>
<Optimize>true</Optimize>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<DebugType>pdbonly</DebugType>
<PlatformTarget>x86</PlatformTarget>
</PropertyGroup>
<ItemGroup>
<Reference Include="System" />
<Reference Include="System.Data" />
<Reference Include="System.Windows.Forms" />
<Reference Include="System.Xml" />
<Reference Include="System.Core" />
<Reference Include="System.Xml.Linq" />
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="System.Net.Http" />
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="PersonalUtilities.Functions" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Collections.Generic" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
<Import Include="System.Linq" />
<Import Include="System.Windows.Forms" />
<Import Include="System.Xml.Linq" />
<Import Include="System.Threading.Tasks" />
</ItemGroup>
<ItemGroup>
<Compile Include="Functions.vb" />
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
<DesignTime>True</DesignTime>
</Compile>
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>Resources.resx</DependentUpon>
</Compile>
<Compile Include="My Project\Settings.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="My Project\Resources.resx">
<Generator>VbMyResourcesResXFileCodeGenerator</Generator>
<LastGenOutput>Resources.Designer.vb</LastGenOutput>
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<SubType>Designer</SubType>
</EmbeddedResource>
</ItemGroup>
<ItemGroup>
<None Include=".editorconfig" />
<None Include="My Project\Application.myapp">
<Generator>MyApplicationCodeGenerator</Generator>
<LastGenOutput>Application.Designer.vb</LastGenOutput>
</None>
<None Include="My Project\Settings.settings">
<Generator>SettingsSingleFileGenerator</Generator>
<CustomToolNamespace>My</CustomToolNamespace>
<LastGenOutput>Settings.Designer.vb</LastGenOutput>
</None>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\..\..\MyUtilities\PersonalUtilities\PersonalUtilities.vbproj">
<Project>{8405896b-2685-4916-bc93-1fb514c323a9}</Project>
<Name>PersonalUtilities</Name>
</ProjectReference>
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>

View File

@@ -0,0 +1,3 @@
[*.vb]
# Modifier preferences
file_header_template = Copyright (C) Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>

View File

@@ -0,0 +1,6 @@
<?xml version="1.0" encoding="utf-8" ?>
<configuration>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.6.1" />
</startup>
</configuration>

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.4 KiB

229
SCrawler.Updater/MainMod.vb Normal file
View File

@@ -0,0 +1,229 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Net
Imports System.IO.Compression
Imports PersonalUtilities.Functions
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.Shared
Public Module MainMod
Private MyProcessID As Integer = -1
Private MyWorkingPath As SFile = Nothing
Private ReadOnly ProcessNames As String() = {"SCrawler", "YouTubeDownloader", "Updater"}
Private Silent As Boolean = False
Private Function GetConsoleResponse(ByVal Request As String) As String
Console.Write(Request)
Return Console.ReadLine
End Function
Private Function DownloadFile(ByVal URL As String, ByVal Destination As SFile) As Boolean
Try
Dim lastPerc% = -1
Dim currentCursor% = Console.CursorTop
Using w As New RWebClient With {.AsyncMode = True}
AddHandler w.DownloadProgressChanged,
New DownloadProgressChangedEventHandler(Sub(ByVal Sender As Object, ByVal e As DownloadProgressChangedEventArgs)
If lastPerc < e.ProgressPercentage Then
lastPerc = e.ProgressPercentage
Console.SetCursorPosition(0, currentCursor)
Console.Write("{0}% completed", e.ProgressPercentage)
End If
End Sub)
Return w.DownloadFile(URL, Destination, EDP.ReturnValue)
End Using
Catch ex As Exception
Return False
End Try
End Function
Public Sub Main()
Try
MyWorkingPath = AppDomain.CurrentDomain.BaseDirectory.CSFileP
MyProcessID = Process.GetCurrentProcess.Id
Console.Title = "SCrawler updater"
With Environment.GetCommandLineArgs
If .ListExists(2) Then Silent = .Self()(1).FromXML(Of Boolean)(False)
End With
Dim currentDir As SFile = MyWorkingPath.CutPath
Dim extractionDir As SFile = $"{currentDir.CSFilePS}{NewReleaseFolderName}\"
If extractionDir.Exists(SFO.Path, False) Then extractionDir.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.None)
Dim currVer As Version = GetCurrentMaxVer(currentDir)
If currVer Is Nothing Then
Console.WriteLine("The current version of the program cannot be determined")
Else
Console.WriteLine($"The current version is {currVer} (x{IIf(Environment.Is64BitProcess, 64, 86)})")
Dim release As GitRelease = GetGitRelease()
If Not release.URL.IsEmptyString And Not release.Version Is Nothing Then
If release.Version > currVer Then
Console.WriteLine($"The new version is {release.Version} ({release.Name})")
If Not Silent AndAlso GetConsoleResponse("Do you want to update the program? (y/n): ").IfNullOrEmpty("n") = "n" Then Exit Sub
If ActiveProcessesExist() Then
Console.WriteLine("One of the SCrawler programs is still running. Waiting for all SCrawler programs to close.")
While ActiveProcessesExist() : Threading.Thread.Sleep(100) : End While
Console.WriteLine("All SCrawler programs are closed.")
End If
If extractionDir.Exists(SFO.Path, True) Then
Dim destFile As SFile = $"{extractionDir.CSFilePS}{New SFile(release.URL).File}"
Console.WriteLine("Downloading new version...")
If DownloadFile(release.URL, destFile) Then
Console.WriteLine("")
Console.WriteLine("New version downloaded!")
Console.WriteLine("Extracting files...")
ZipFile.ExtractToDirectory(destFile, extractionDir)
Console.WriteLine("Files extracted!")
destFile.Delete(SFO.File, SFODelete.DeletePermanently, EDP.None)
If Not MoveFiles(extractionDir, currentDir) Then GetConsoleResponse("Unable to update the program. Press Enter to exit") : Exit Sub
Else
extractionDir.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.None)
Console.WriteLine("Unable to download new version")
End If
Else
Console.WriteLine("Unable to create temp directory")
End If
Else
Console.WriteLine("The program is up to date")
End If
Else
Console.WriteLine("Unable to get information about new version")
End If
End If
Catch ex As Exception
Console.WriteLine("An error occurred during update")
Console.WriteLine(ex.Message)
Finally
GetConsoleResponse("Press Enter to exit")
End Try
End Sub
Private Function MoveFiles(ByVal Source As SFile, ByVal Destination As SFile) As Boolean
Console.WriteLine("Updating files")
Try
Dim oldFiles As List(Of SFile) = SFile.GetFiles(Destination,,, EDP.ReturnValue)
Dim oldFolders As List(Of SFile) = SFile.GetDirectories(Destination,,, EDP.ReturnValue)
Dim newFiles As List(Of SFile) = SFile.GetFiles(Source,,, EDP.ReturnValue)
Dim newFolders As List(Of SFile) = SFile.GetDirectories(Source,,, EDP.ReturnValue)
Dim obj As SFile = Nothing
Dim wSegment As String = MyWorkingPath.Segments.Last
Dim filesPredicate As Predicate(Of SFile) = Function(ByVal f As SFile) As Boolean
If obj = f Or obj.Name = f.Name Then
f.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.None)
Return True
Else
Return False
End If
End Function
Dim foldersPredicate As Predicate(Of SFile) = Function(ByVal f As SFile) As Boolean
Dim ls$ = f.Segments.Last
If ls = obj.Segments.Last And Not ls = NewReleaseFolderName And Not ls = wSegment Then
f.Delete(SFO.Path, SFODelete.DeleteToRecycleBin, EDP.None)
Return True
Else
Return False
End If
End Function
Dim getDestFile As Func(Of SFile, Boolean, SFile) = Function(ByVal f As SFile, ByVal isFolder As Boolean) As SFile
Dim ff As SFile = f
If isFolder Then
ff = $"{Destination.PathWithSeparator}{f.Segments.Last}\"
Else
ff.Path = Destination.Path
End If
Console.WriteLine(ff)
Return ff
End Function
If newFiles.ListExists Then
If oldFiles.ListExists Then
For Each obj In newFiles : oldFiles.RemoveAll(filesPredicate) : Next
End If
newFiles.ForEach(Sub(ff) SFile.Move(ff, getDestFile(ff, False), SFO.File, True, SFODelete.DeleteToRecycleBin, EDP.None))
End If
If newFolders.ListExists Then
If oldFolders.ListExists Then
For Each obj In newFolders : oldFolders.RemoveAll(foldersPredicate) : Next
End If
newFolders.ForEach(Sub(ff) If Not ff.Segments.Last = wSegment Then _
SFile.Move(ff, getDestFile(ff, True), SFO.Path, True, SFODelete.DeleteToRecycleBin, EDP.None))
End If
Console.WriteLine("Files updated")
Return True
Catch
Return False
End Try
End Function
Private Function ActiveProcessesExist() As Boolean
Try
Return Process.GetProcesses.Any(Function(p) ProcessNames.Contains(p.ProcessName) And Not p.Id = MyProcessID)
Catch
Return True
End Try
End Function
Private Structure GitRelease
Friend URL As String
Friend Name As String
Friend Version As Version
End Structure
Private Function GetGitRelease() As GitRelease
Try
Dim nameEnd$ = $"_x{IIf(Environment.Is64BitProcess, 64, 86)}.zip"
Dim name$, relName$, relTag$
Using resp As New Responser With {.Accept = "application/vnd.github.v3+json"}
Dim r$ = resp.GetResponse("https://api.github.com/repos/AAndyProgram/SCrawler/releases",, EDP.ReturnValue)
If Not r.IsEmptyString Then
Dim getver As Func(Of String, Version) = Function(ByVal input As String) As Version
Try
If Not input.IsEmptyString Then
If input.ToLower.StartsWith("scrawler") Then
Return New Version(input.Split("_")(1))
Else
Return New Version(input)
End If
End If
Catch
End Try
Return Nothing
End Function
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If j.ListExists Then
With j.FirstOrDefault(Function(e) Not e.Value("draft").FromXML(Of Boolean) And Not e.Value("prerelease").FromXML(Of Boolean))
If .ListExists Then
relName = .Value("name")
relTag = .Value("tag_name")
With .Item("assets")
If .ListExists Then
For Each asset As EContainer In .Self
name = asset.Value("name")
If Not name.IsEmptyString AndAlso name.EndsWith(nameEnd) Then _
Return New GitRelease With {
.Name = name,
.URL = asset.Value("browser_download_url"),
.Version = getver(name).IfNullOrEmpty(getver(relName).IfNullOrEmpty(getver(relTag)))}
Next
End If
End With
End If
End With
End If
End Using
End If
End Using
Catch
End Try
Return Nothing
End Function
End Module

View File

@@ -0,0 +1,13 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On

View File

@@ -0,0 +1,10 @@
<?xml version="1.0" encoding="utf-8"?>
<MyApplicationData xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<MySubMain>false</MySubMain>
<SingleInstance>false</SingleInstance>
<ShutdownMode>0</ShutdownMode>
<EnableVisualStyles>true</EnableVisualStyles>
<AuthenticationMode>0</AuthenticationMode>
<ApplicationType>2</ApplicationType>
<SaveMySettingsOnExit>true</SaveMySettingsOnExit>
</MyApplicationData>

View File

@@ -0,0 +1,37 @@
Imports System.Resources
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("SCrawler updater")>
<Assembly: AssemblyDescription("SCrawler updater")>
<Assembly: AssemblyCompany("AndyProgram")>
<Assembly: AssemblyProduct("SCrawler.Updater")>
<Assembly: AssemblyCopyright("Copyright © 2024")>
<Assembly: AssemblyTrademark("AndyProgram")>
<Assembly: ComVisible(False)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("df008b29-ad5e-4271-acfe-650396d15c40")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2023.12.7.0")>
<Assembly: AssemblyFileVersion("2023.12.7.0")>
<Assembly: NeutralResourcesLanguage("en")>

View File

@@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Imports System
Namespace My.Resources
'This class was auto-generated by the StronglyTypedResourceBuilder
'class via a tool like ResGen or Visual Studio.
'To add or remove a member, edit your .ResX file then rerun ResGen
'with the /str option, or rebuild your VS project.
'''<summary>
''' A strongly-typed resource class, for looking up localized strings, etc.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "16.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo
'''<summary>
''' Returns the cached ResourceManager instance used by this class.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If Object.ReferenceEquals(resourceMan, Nothing) Then
Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("SCrawler.Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Overrides the current thread's CurrentUICulture property for all
''' resource lookups using this strongly typed resource class.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set
resourceCulture = value
End Set
End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Icon similar to (Icon).
'''</summary>
Friend ReadOnly Property RainbowIcon_48() As System.Drawing.Icon
Get
Dim obj As Object = ResourceManager.GetObject("RainbowIcon_48", resourceCulture)
Return CType(obj,System.Drawing.Icon)
End Get
End Property
End Module
End Namespace

View File

@@ -0,0 +1,124 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" />
<data name="RainbowIcon_48" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Content\Icons\RainbowIcon_48.ico;System.Drawing.Icon, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
</root>

View File

@@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "16.10.0.0"), _
Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Partial Friend NotInheritable Class MySettings
Inherits Global.System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings()),MySettings)
#Region "My.Settings Auto-Save Functionality"
#If _MyType = "WindowsForms" Then
Private Shared addedHandler As Boolean
Private Shared addedHandlerLockObject As New Object
<Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Private Shared Sub AutoSaveSettings(sender As Global.System.Object, e As Global.System.EventArgs)
If My.Application.SaveMySettingsOnExit Then
My.Settings.Save()
End If
End Sub
#End If
#End Region
Public Shared ReadOnly Property [Default]() As MySettings
Get
#If _MyType = "WindowsForms" Then
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
#End If
Return defaultInstance
End Get
End Property
End Class
End Namespace
Namespace My
<Global.Microsoft.VisualBasic.HideModuleNameAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Module MySettingsProperty
<Global.System.ComponentModel.Design.HelpKeywordAttribute("My.Settings")> _
Friend ReadOnly Property Settings() As Global.SCrawler.My.MySettings
Get
Return Global.SCrawler.My.MySettings.Default
End Get
End Property
End Module
End Namespace

View File

@@ -0,0 +1,7 @@
<?xml version='1.0' encoding='utf-8'?>
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles>
<Profile Name="(Default)" />
</Profiles>
<Settings />
</SettingsFile>

View File

@@ -0,0 +1,79 @@
<?xml version="1.0" encoding="utf-8"?>
<assembly manifestVersion="1.0" xmlns="urn:schemas-microsoft-com:asm.v1">
<assemblyIdentity version="1.0.0.0" name="MyApplication.app"/>
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
<security>
<requestedPrivileges xmlns="urn:schemas-microsoft-com:asm.v3">
<!-- UAC Manifest Options
If you want to change the Windows User Account Control level replace the
requestedExecutionLevel node with one of the following.
<requestedExecutionLevel level="asInvoker" uiAccess="false" />
<requestedExecutionLevel level="requireAdministrator" uiAccess="false" />
<requestedExecutionLevel level="highestAvailable" uiAccess="false" />
Specifying requestedExecutionLevel element will disable file and registry virtualization.
Remove this element if your application requires this virtualization for backwards
compatibility.
-->
<requestedExecutionLevel level="asInvoker" uiAccess="false" />
</requestedPrivileges>
</security>
</trustInfo>
<compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
<application>
<!-- A list of the Windows versions that this application has been tested on
and is designed to work with. Uncomment the appropriate elements
and Windows will automatically select the most compatible environment. -->
<!-- Windows Vista -->
<!--<supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}" />-->
<!-- Windows 7 -->
<!--<supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}" />-->
<!-- Windows 8 -->
<!--<supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}" />-->
<!-- Windows 8.1 -->
<!--<supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}" />-->
<!-- Windows 10 -->
<!--<supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}" />-->
</application>
</compatibility>
<!-- Indicates that the application is DPI-aware and will not be automatically scaled by Windows at higher
DPIs. Windows Presentation Foundation (WPF) applications are automatically DPI-aware and do not need
to opt in. Windows Forms applications targeting .NET Framework 4.6 that opt into this setting, should
also set the 'EnableWindowsFormsHighDpiAutoResizing' setting to 'true' in their app.config.
Makes the application long-path aware. See https://docs.microsoft.com/windows/win32/fileio/maximum-file-path-limitation -->
<!--
<application xmlns="urn:schemas-microsoft-com:asm.v3">
<windowsSettings>
<dpiAware xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">true</dpiAware>
<longPathAware xmlns="http://schemas.microsoft.com/SMI/2016/WindowsSettings">true</longPathAware>
</windowsSettings>
</application>
-->
<!-- Enable themes for Windows common controls and dialogs (Windows XP and later) -->
<!--
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="*"
publicKeyToken="6595b64144ccf1df"
language="*"
/>
</dependentAssembly>
</dependency>
-->
</assembly>

View File

@@ -0,0 +1,173 @@
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="15.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
<PropertyGroup>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ProjectGuid>{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}</ProjectGuid>
<OutputType>Exe</OutputType>
<StartupObject>Sub Main</StartupObject>
<RootNamespace>SCrawler</RootNamespace>
<AssemblyName>Updater</AssemblyName>
<FileAlignment>512</FileAlignment>
<MyType>Console</MyType>
<TargetFrameworkVersion>v4.6.1</TargetFrameworkVersion>
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
<Deterministic>true</Deterministic>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<PlatformTarget>AnyCPU</PlatformTarget>
<DebugSymbols>true</DebugSymbols>
<DebugType>full</DebugType>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\Debug\Updater\</OutputPath>
<DocumentationFile>
</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<Prefer32Bit>false</Prefer32Bit>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<PlatformTarget>AnyCPU</PlatformTarget>
<DebugType>pdbonly</DebugType>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<Optimize>true</Optimize>
<OutputPath>bin\Release\Updater\</OutputPath>
<DocumentationFile>
</DocumentationFile>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<Prefer32Bit>false</Prefer32Bit>
</PropertyGroup>
<PropertyGroup>
<OptionExplicit>On</OptionExplicit>
</PropertyGroup>
<PropertyGroup>
<OptionCompare>Binary</OptionCompare>
</PropertyGroup>
<PropertyGroup>
<OptionStrict>Off</OptionStrict>
</PropertyGroup>
<PropertyGroup>
<OptionInfer>On</OptionInfer>
</PropertyGroup>
<PropertyGroup>
<ApplicationIcon>Content\Icons\RainbowIcon_48.ico</ApplicationIcon>
</PropertyGroup>
<PropertyGroup>
<ApplicationManifest>My Project\app.manifest</ApplicationManifest>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Debug|x64'">
<DebugSymbols>true</DebugSymbols>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x64\Debug\Updater\</OutputPath>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<DebugType>full</DebugType>
<PlatformTarget>x64</PlatformTarget>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Release|x64'">
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x64\Release\Updater\</OutputPath>
<Optimize>true</Optimize>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<DebugType>pdbonly</DebugType>
<PlatformTarget>x64</PlatformTarget>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Debug|x86'">
<DebugSymbols>true</DebugSymbols>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x86\Debug\Updater\</OutputPath>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<DebugType>full</DebugType>
<PlatformTarget>x86</PlatformTarget>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Release|x86'">
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x86\Release\Updater\</OutputPath>
<Optimize>true</Optimize>
<NoWarn>42016,41999,42017,42018,42019,42032,42036,42020,42021,42022</NoWarn>
<DebugType>pdbonly</DebugType>
<PlatformTarget>x86</PlatformTarget>
</PropertyGroup>
<ItemGroup>
<Reference Include="System" />
<Reference Include="System.Data" />
<Reference Include="System.Deployment" />
<Reference Include="System.Drawing" />
<Reference Include="System.IO.Compression" />
<Reference Include="System.IO.Compression.FileSystem" />
<Reference Include="System.Xml" />
<Reference Include="System.Core" />
<Reference Include="System.Xml.Linq" />
<Reference Include="System.Data.DataSetExtensions" />
<Reference Include="System.Net.Http" />
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Collections.Generic" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
<Import Include="System.Linq" />
<Import Include="System.Xml.Linq" />
<Import Include="System.Threading.Tasks" />
</ItemGroup>
<ItemGroup>
<Compile Include="MainMod.vb" />
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
<DesignTime>True</DesignTime>
</Compile>
<Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTime>True</DesignTime>
<DependentUpon>Resources.resx</DependentUpon>
</Compile>
<Compile Include="My Project\Settings.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Settings.settings</DependentUpon>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="My Project\Resources.resx">
<Generator>VbMyResourcesResXFileCodeGenerator</Generator>
<LastGenOutput>Resources.Designer.vb</LastGenOutput>
<CustomToolNamespace>My.Resources</CustomToolNamespace>
<SubType>Designer</SubType>
</EmbeddedResource>
</ItemGroup>
<ItemGroup>
<None Include=".editorconfig" />
<None Include="My Project\app.manifest" />
<None Include="My Project\Application.myapp">
<Generator>MyApplicationCodeGenerator</Generator>
<LastGenOutput>Application.Designer.vb</LastGenOutput>
</None>
<None Include="My Project\Settings.settings">
<Generator>SettingsSingleFileGenerator</Generator>
<CustomToolNamespace>My</CustomToolNamespace>
<LastGenOutput>Settings.Designer.vb</LastGenOutput>
</None>
<None Include="App.config" />
</ItemGroup>
<ItemGroup>
<Content Include="Content\Icons\RainbowIcon_48.ico" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\..\..\MyUtilities\PersonalUtilities\PersonalUtilities.vbproj">
<Project>{8405896b-2685-4916-bc93-1fb514c323a9}</Project>
<Name>PersonalUtilities</Name>
</ProjectReference>
<ProjectReference Include="..\SCrawler.Shared\SCrawler.Shared.vbproj">
<Project>{dc634700-24c7-42dd-bf8f-87e6cc54e625}</Project>
<Name>SCrawler.Shared</Name>
</ProjectReference>
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>

View File

@@ -1,3 +1,3 @@
[*.vb]
# Modifier preferences
file_header_template = Copyright (C) 2023 Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>
file_header_template = Copyright (C) Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>

View File

@@ -28,8 +28,19 @@ Namespace API.YouTube.Base
End Structure
Public Structure Subtitles : Implements IIndexable, IComparable(Of Subtitles)
Public ID As String
Public Name As String
Private _Name As String
Public Property Name As String
Get
Dim n$ = _Name.IfNullOrEmpty(ID)
If CC Then n &= " (CC)"
Return n
End Get
Set(ByVal NewName As String)
_Name = NewName
End Set
End Property
Public Formats As String
Public CC As Boolean
Public ReadOnly Property FullID As String
Get
Return IIf(ID = "en", "en.*", ID)
@@ -51,6 +62,14 @@ Namespace API.YouTube.Base
Channel = 2
PlayList = 3
End Enum
<Editor(GetType(EnumDropDownEditor), GetType(UITypeEditor)), Flags>
Public Enum YouTubeChannelTab As Integer
<EnumValue(IsNullValue:=True)>
All = 0
Videos = 1
Shorts = 3
Playlists = 10
End Enum
<Editor(GetType(EnumDropDownEditor), GetType(UITypeEditor))>
Public Enum Protocols As Integer
<EnumValue(ExcludeFromList:=True)>

View File

@@ -20,11 +20,58 @@ Namespace API.YouTube.Base
Public Const UrlTypePattern As String = "(?<=https?://[^/]*?youtube.com/)((@|[^\?/&]+))([/\?]{0,1}(list=|v=|)([^\?/&]*))(?=(\S+|\Z|))"
Private Sub New()
End Sub
Public Shared Function StandardizeURL(ByVal URL As String) As String
Try
Dim isMusic As Boolean = False, isShorts As Boolean = False
If Info_GetUrlType(URL, isMusic, isShorts) = YouTubeMediaType.Single Then
If Not isMusic And Not isShorts Then
Dim videoOptionRegex As RParams = RParams.DMS("[\?&]v=([^\?&]+)", 1, EDP.ReturnValue)
Dim data As List(Of String) = RegexReplace(URL, RParams.DMS(UrlTypePattern, 0, RegexReturn.ListByMatch, EDP.ReturnValue))
Dim val$ = String.Empty
If data.ListExists Then
For Each d$ In data
val = RegexReplace(d, videoOptionRegex)
If Not val.IsEmptyString Then Exit For
Next
data.Clear()
End If
If Not val.IsEmptyString Then Return $"https://www.youtube.com/watch?v={val}"
End If
End If
Return URL
Catch ex As Exception
Return URL
End Try
End Function
Public Shared Function StandardizeURL_Channel(ByVal URL As String, Optional ByVal Process As Boolean = True) As String
Try
Dim ct As YouTubeChannelTab = YouTubeChannelTab.All
Dim isMusic As Boolean = False
If Process AndAlso Info_GetUrlType(URL, isMusic,,,, ct) = YouTubeMediaType.Channel AndAlso Not isMusic Then
If Not ct = YouTubeChannelTab.All Then
Dim rValue$ = String.Empty
Select Case ct
Case YouTubeChannelTab.Videos : rValue = "/videos"
Case YouTubeChannelTab.Shorts : rValue = "/shorts"
Case YouTubeChannelTab.Playlists : rValue = "/playlists"
End Select
If Not rValue.IsEmptyString Then
Dim startIndx% = InStr(URL, rValue)
If startIndx > 0 Then URL = URL.Remove(startIndx - 1)
End If
End If
End If
Return URL
Catch ex As Exception
Return URL
End Try
End Function
Public Shared Function IsMyUrl(ByVal URL As String) As Boolean
Return Not Info_GetUrlType(URL) = YouTubeMediaType.Undefined
End Function
Public Shared Function Info_GetUrlType(ByVal URL As String, Optional ByRef IsMusic As Boolean = False, 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,
Optional ByRef ChannelOptions As YouTubeChannelTab = YouTubeChannelTab.All) As YouTubeMediaType
If Not URL.IsEmptyString Then
IsMusic = URL.Contains("music.youtube.com")
IsChannelUser = False
@@ -37,7 +84,17 @@ Namespace API.YouTube.Base
Case "watch" : Return YouTubeMediaType.Single
Case "shorts" : IsShorts = True : Return YouTubeMediaType.Single
Case "playlist" : Return YouTubeMediaType.PlayList
Case UserChannelOption, "@" : IsChannelUser = data(2).ToLower = UserChannelOption : Return YouTubeMediaType.Channel
Case UserChannelOption, "@"
IsChannelUser = data(2).ToLower = UserChannelOption
If data.Count > 6 Then
Select Case data(6).StringToLower.StringTrimStart("/")
Case "videos" : ChannelOptions = YouTubeChannelTab.Videos
Case "shorts" : ChannelOptions = YouTubeChannelTab.Shorts
Case "playlists" : ChannelOptions = YouTubeChannelTab.Playlists
Case Else : ChannelOptions = YouTubeChannelTab.All
End Select
End If
Return YouTubeMediaType.Channel
End Select
End If
End If
@@ -59,27 +116,25 @@ Namespace API.YouTube.Base
''' <exception cref="InvalidOperationException"></exception>
Public Shared Function Parse(ByVal URL As String, Optional ByVal UseCookies As Boolean? = Nothing,
Optional ByVal Token As Threading.CancellationToken = Nothing, Optional ByVal Progress As IMyProgress = Nothing,
Optional ByVal GetDefault As Boolean? = Nothing, Optional ByVal GetShorts As Boolean? = Nothing,
Optional ByVal DateAfter As Date? = Nothing, Optional ByVal DateBefore As Date? = Nothing) As IYouTubeMediaContainer
Optional ByVal DateAfter As Date? = Nothing, Optional ByVal DateBefore As Date? = Nothing,
Optional ByVal ChannelOption As YouTubeChannelTab? = Nothing, Optional ByVal UrlAsIs As Boolean = False) As IYouTubeMediaContainer
If URL.IsEmptyString Then Throw New ArgumentNullException("URL", "URL cannot be null")
If Not MyYouTubeSettings.YTDLP.Value.Exists Then Throw New IO.FileNotFoundException("Path to 'yt-dlp.exe' not set or program not found at destination", MyYouTubeSettings.YTDLP.Value.ToString)
Dim urlOrig$ = URL
URL = RegexReplace(URL, TrueUrlRegEx)
If URL.IsEmptyString Then Throw New ArgumentNullException("URL", $"Can't get true URL from [{urlOrig}]")
Dim isMusic As Boolean = False, isShorts As Boolean = False
Dim objType As YouTubeMediaType = Info_GetUrlType(URL, isMusic, isShorts)
Dim channelTab As YouTubeChannelTab = YouTubeChannelTab.All
Dim objType As YouTubeMediaType = Info_GetUrlType(URL, isMusic, isShorts,,, channelTab)
If ChannelOption.HasValue Then channelTab = ChannelOption.Value
If Not objType = YouTubeMediaType.Undefined Then
Dim __GetDefault As Boolean = If(GetDefault, True)
Dim __GetShorts As Boolean = If(GetShorts, True)
If isMusic Then __GetShorts = False
Dim container As IYouTubeMediaContainer
Dim pattern$ = "%(channel_id)s_%(id)s_%(playlist_index)s"
Select Case objType
Case YouTubeMediaType.Single
__GetShorts = False
If isMusic Then container = New Track Else container = New Video
Case YouTubeMediaType.PlayList : container = New PlayList : pattern = "%(playlist_index)s_%(id)s" : __GetShorts = False
Case YouTubeMediaType.PlayList : container = New PlayList : pattern = "%(playlist_index)s_%(id)s"
Case YouTubeMediaType.Channel
container = New Channel
If isMusic Then pattern = "%(playlist_id)s/%(channel_id)s_%(id)s_%(playlist_index)s"
@@ -98,11 +153,11 @@ Namespace API.YouTube.Base
Dim useCookiesForce As Boolean = UseCookies.HasValue AndAlso UseCookies.Value AndAlso cookiesExists
If UseCookies.HasValue AndAlso UseCookies.Value Then
withCookieRequested = True
result = Parse_Internal(URL, pattern, _CachePathDefault, True, YouTubeCookieNetscapeFile, DateAfter, DateBefore, __GetDefault, __GetShorts)
result = Parse_Internal(URL, pattern, _CachePathDefault, True, YouTubeCookieNetscapeFile, DateAfter, DateBefore, objType, channelTab, isMusic, UrlAsIs)
End If
If Not result And Not withCookieRequested Then
If Not UseCookies.HasValue OrElse Not UseCookies.Value Then result = Parse_Internal(URL, pattern, _CachePathDefault, False, YouTubeCookieNetscapeFile, DateAfter, DateBefore, __GetDefault, __GetShorts)
If Not result And Not UseCookies.HasValue And cookiesExists Then result = Parse_Internal(URL, pattern, _CachePathDefault, True, YouTubeCookieNetscapeFile, DateAfter, DateBefore, __GetDefault, __GetShorts)
If Not UseCookies.HasValue OrElse Not UseCookies.Value Then result = Parse_Internal(URL, pattern, _CachePathDefault, False, YouTubeCookieNetscapeFile, DateAfter, DateBefore, objType, channelTab, isMusic, UrlAsIs)
If Not result And Not UseCookies.HasValue And cookiesExists Then result = Parse_Internal(URL, pattern, _CachePathDefault, True, YouTubeCookieNetscapeFile, DateAfter, DateBefore, objType, channelTab, isMusic, UrlAsIs)
End If
If result Then
@@ -116,21 +171,40 @@ Namespace API.YouTube.Base
Private Shared Function Parse_Internal(ByVal URL As String, ByVal OutputPattern As String, ByVal OutputPath As SFile,
ByVal UseCookies As Boolean, ByVal CookiesFile As SFile,
ByVal DateAfter As Date?, ByVal DateBefore As Date?,
ByVal GetDefault As Boolean, ByVal GetShorts As Boolean) As Boolean
ByVal ObjType As YouTubeMediaType, ByVal ChannelTab As YouTubeChannelTab,
ByVal IsMusic As Boolean, ByVal UrlAsIs As Boolean) As Boolean
Try
Dim command$ = "yt-dlp --write-info-json --skip-download"
command.StringAppend(GetCookiesCommand(UseCookies, CookiesFile), " ")
If DateAfter.HasValue Then command.StringAppend($"--dateafter {DateAfter.Value:yyyyMMdd}", " ")
If DateBefore.HasValue Then command.StringAppend($"--datebefore {DateBefore.Value:yyyyMMdd}", " ")
command.StringAppend("{0}" & $" -o ""{OutputPattern}""", " ")
'#If DEBUG Then
'Debug.WriteLine(String.Format(command, URL))
'#End If
Dim debugString As Func(Of String, String) = Function(ByVal input As String) As String
#If DEBUG Then
Debug.WriteLine(String.Format(command, URL))
Debug.WriteLine(input)
#End If
Return input
End Function
Using batch As New BatchExecutor(True)
With batch
.CommandPermanent = BatchExecutor.GetDirectoryCommand(MyYouTubeSettings.YTDLP.Value)
If GetDefault Then .Execute(String.Format(command, URL))
If GetShorts Then .Execute(String.Format(command, $"{URL.StringTrimEnd("/")}/shorts"))
If ObjType = YouTubeMediaType.Channel And Not IsMusic And Not UrlAsIs Then
Dim ct As List(Of YouTubeChannelTab) = EnumExtract(Of YouTubeChannelTab)(ChannelTab,, True).ListIfNothing
If ct.Count = 0 Then
.Execute(debugString(String.Format(command, $"{URL.StringTrimEnd("/")}/videos")))
.Execute(debugString(String.Format(command, $"{URL.StringTrimEnd("/")}/shorts")))
.Execute(debugString(String.Format(command, $"{URL.StringTrimEnd("/")}/playlists")))
Else
If ct.Contains(YouTubeChannelTab.Videos) Then .Execute(debugString(String.Format(command, $"{URL.StringTrimEnd("/")}/videos")))
If ct.Contains(YouTubeChannelTab.Shorts) Then .Execute(debugString(String.Format(command, $"{URL.StringTrimEnd("/")}/shorts")))
If ct.Contains(YouTubeChannelTab.Playlists) Then .Execute(debugString(String.Format(command, $"{URL.StringTrimEnd("/")}/playlists")))
End If
Else
.Execute(debugString(String.Format(command, URL)))
End If
End With
End Using
Return SFile.GetFiles(OutputPath,, IO.SearchOption.AllDirectories, EDP.ReturnValue).Count > 0

View File

@@ -35,6 +35,7 @@ Namespace API.YouTube.Base
<Browsable(False)> Private Property Mode As GridUpdateModes = GridUpdateModes.OnConfirm Implements IGridValuesContainer.Mode
<Browsable(False), XMLVV(-1)> Friend ReadOnly Property PlaylistFormSplitterDistance As XMLValue(Of Integer)
<Browsable(False)> Friend ReadOnly Property DownloadLocations As DownloadLocationsCollection
<Browsable(False)> Public Overridable Property AccountName As String
#Region "Environment"
#Region "Programs"
<Browsable(True), GridVisible(False), XMLVN({"Environment"}), Category("Environment programs"), DisplayName("Path to yt-dlp.exe"),
@@ -131,8 +132,32 @@ Namespace API.YouTube.Base
OpenFolderInOtherProgram.Value = command
End Set
End Property
<Browsable(True), GridVisible(False), XMLVN({"Environment"}, True), Category("Environment"), DisplayName("Check new version at start")>
Friend ReadOnly Property CheckUpdatesAtStart As XMLValue(Of Boolean)
#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)
<Browsable(True), GridVisible, XMLVN({"Info"}, True), Category("Info"), DisplayName("Create thumbnail files (video)"),
Description("Create video thumbnail files. Default: true.")>
Public ReadOnly Property CreateThumbnails_Video As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Info"}, True), Category("Info"), DisplayName("Create thumbnail files (music)"),
Description("Create music thumbnail files (covers). Default: true.")>
Public ReadOnly Property CreateThumbnails_Music As XMLValue(Of Boolean)
#End Region
#Region "Defaults"
<Browsable(True), GridVisible, XMLVN({"Defaults"}, True), Category("Defaults"), DisplayName("Standardize URLs"),
Description("Standardize URLs by eliminating unwanted strings. Default: true.")>
Public ReadOnly Property StandardizeURLs As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Replace modification date"),
Description("Set the file date to the date the video was added (website) (if available). Default: false.")>
Public ReadOnly Property ReplaceModificationDate As XMLValue(Of Boolean)
@@ -204,6 +229,38 @@ Namespace API.YouTube.Base
Description("Add some additional info to the program info if you need")>
Friend ReadOnly Property ProgramDescription As XMLValue(Of String)
#End Region
#Region "Defaults ChannelsDownload"
<Browsable(True), GridVisible, XMLVN({"Defaults", "Channels"}), Category("Defaults"), DisplayName("Default download tabs for channels"),
Description("Default download tabs for downloading channels"), TypeConverter(GetType(YouTubeChannelTabConverter))>
Public ReadOnly Property ChannelsDownload As XMLValue(Of YouTubeChannelTab)
Private Class YouTubeChannelTabConverter : Inherits TypeConverter
Public Overrides Function ConvertTo(ByVal Context As ITypeDescriptorContext, ByVal Culture As CultureInfo, ByVal Value As Object,
ByVal DestinationType As Type) As Object
If Not DestinationType Is Nothing Then
If DestinationType Is GetType(String) Then
If IsNothing(Value) Then
Return YouTubeChannelTab.All.ToString
Else
Dim v As List(Of YouTubeChannelTab) = EnumExtract(Of YouTubeChannelTab)(Value,,, EDP.ReturnValue).ListIfNothing
If v.ListExists Then
v.Sort()
Return v.ListToStringE(, New ANumbers.EnumToStringProvider(GetType(YouTubeChannelTab)))
Else
Return YouTubeChannelTab.All.ToString
End If
End If
Else
If IsNothing(Value) Then
Return YouTubeChannelTab.All
Else
Return Value
End If
End If
End If
Return MyBase.ConvertTo(Context, Culture, Value, DestinationType)
End Function
End Class
#End Region
#Region "Defaults Video"
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, "MKV"), Category("Defaults Video"), DisplayName("Default format"),
TypeConverter(GetType(FieldsTypeConverter)), GridStandardValuesProvider(NameOf(AvailableVideoFormats_Impl)),
@@ -284,9 +341,17 @@ Namespace API.YouTube.Base
#End Region
#Region "Initializer"
Public Sub New()
Me.New(String.Empty)
End Sub
Public Sub New(ByVal AccountName As String)
Me.AccountName = AccountName
DownloadLocations = New DownloadLocationsCollection
DownloadLocations.Load(False, True)
XML = New XmlFile(YouTubeSettingsFile,, False) With {.AutoUpdateFile = True}
Dim acc$ = String.Empty
If Not AccountName.IsEmptyString Then acc = $"_{AccountName}"
Dim f As SFile = YouTubeSettingsFile
f.Name &= acc
XML = New XmlFile(f,, False) With {.AutoUpdateFile = True}
XML.LoadData(EDP.None)
DesignXml = New XmlFile("Settings\DesignDownloader.xml", Protector.Modes.All, False)
DesignXml.LoadData(EDP.None)
@@ -294,7 +359,9 @@ Namespace API.YouTube.Base
AddHandler ShowNotificationsEveryDownload.TempValueChanged, AddressOf ShowNotificationsEveryDownload_TempValueChanged
Cookies = New CookieKeeper
Grid.Abstract.DesignerXmlSource.Add(New Grid.Abstract.DesignerXmlData(GetType(CookieListForm2), DesignXml, "CookiesListForm"))
If YouTubeCookieNetscapeFile.Exists Then Cookies.AddRange(CookieKeeper.ParseNetscapeText(YouTubeCookieNetscapeFile.GetText(EDP.ReturnValue), EDP.None),, EDP.None)
f = YouTubeCookieNetscapeFile
f.Name &= acc
If f.Exists Then Cookies.AddRange(CookieKeeper.ParseNetscapeText(f.GetText(EDP.ReturnValue), EDP.None),, EDP.None)
If Not YTDLP.Value.Exists Then YTDLP.Value = ProgramPath("yt-dlp.exe")
If Not FFMPEG.Value.Exists Then FFMPEG.Value = ProgramPath("ffmpeg.exe")
If Not OutputPath.Value.Exists(SFO.Path, False) Then OutputPath.Value = YouTubeDownloadPathDefault

View File

@@ -0,0 +1,179 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.YouTube.Controls
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class ChannelTabsChooserForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Me.CH_ALL = New System.Windows.Forms.CheckBox()
Me.CH_VIDEOS = New System.Windows.Forms.CheckBox()
Me.CH_SHORTS = New System.Windows.Forms.CheckBox()
Me.CH_PLS = New System.Windows.Forms.CheckBox()
Me.TXT_URL = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_URL_ASIS = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
CType(Me.TXT_URL, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(474, 159)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(474, 184)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Controls.Add(Me.CH_ALL, 0, 2)
TP_MAIN.Controls.Add(Me.CH_VIDEOS, 0, 3)
TP_MAIN.Controls.Add(Me.CH_SHORTS, 0, 4)
TP_MAIN.Controls.Add(Me.CH_PLS, 0, 5)
TP_MAIN.Controls.Add(Me.TXT_URL, 0, 0)
TP_MAIN.Controls.Add(Me.CH_URL_ASIS, 0, 1)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 7
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(474, 159)
TP_MAIN.TabIndex = 0
'
'CH_ALL
'
Me.CH_ALL.AutoSize = True
Me.CH_ALL.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_ALL.Location = New System.Drawing.Point(4, 59)
Me.CH_ALL.Name = "CH_ALL"
Me.CH_ALL.Size = New System.Drawing.Size(466, 19)
Me.CH_ALL.TabIndex = 2
Me.CH_ALL.Text = "ALL"
Me.CH_ALL.UseVisualStyleBackColor = True
'
'CH_VIDEOS
'
Me.CH_VIDEOS.AutoSize = True
Me.CH_VIDEOS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_VIDEOS.Location = New System.Drawing.Point(4, 85)
Me.CH_VIDEOS.Name = "CH_VIDEOS"
Me.CH_VIDEOS.Size = New System.Drawing.Size(466, 19)
Me.CH_VIDEOS.TabIndex = 3
Me.CH_VIDEOS.Text = "Videos"
Me.CH_VIDEOS.UseVisualStyleBackColor = True
'
'CH_SHORTS
'
Me.CH_SHORTS.AutoSize = True
Me.CH_SHORTS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_SHORTS.Location = New System.Drawing.Point(4, 111)
Me.CH_SHORTS.Name = "CH_SHORTS"
Me.CH_SHORTS.Size = New System.Drawing.Size(466, 19)
Me.CH_SHORTS.TabIndex = 4
Me.CH_SHORTS.Text = "Shorts"
Me.CH_SHORTS.UseVisualStyleBackColor = True
'
'CH_PLS
'
Me.CH_PLS.AutoSize = True
Me.CH_PLS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_PLS.Location = New System.Drawing.Point(4, 137)
Me.CH_PLS.Name = "CH_PLS"
Me.CH_PLS.Size = New System.Drawing.Size(466, 19)
Me.CH_PLS.TabIndex = 5
Me.CH_PLS.Text = "Playlists"
Me.CH_PLS.UseVisualStyleBackColor = True
'
'TXT_URL
'
Me.TXT_URL.CaptionText = "Channel URL"
Me.TXT_URL.CaptionWidth = 80.0R
Me.TXT_URL.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_URL.Location = New System.Drawing.Point(4, 4)
Me.TXT_URL.Name = "TXT_URL"
Me.TXT_URL.Size = New System.Drawing.Size(466, 22)
Me.TXT_URL.TabIndex = 0
'
'CH_URL_ASIS
'
Me.CH_URL_ASIS.AutoSize = True
Me.CH_URL_ASIS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_URL_ASIS.Location = New System.Drawing.Point(4, 33)
Me.CH_URL_ASIS.Name = "CH_URL_ASIS"
Me.CH_URL_ASIS.Size = New System.Drawing.Size(466, 19)
Me.CH_URL_ASIS.TabIndex = 1
Me.CH_URL_ASIS.Text = "Download URL as is"
Me.CH_URL_ASIS.UseVisualStyleBackColor = True
'
'ChannelTabsChooserForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(474, 184)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteYouTube.YouTubeIcon_32
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(490, 223)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(490, 223)
Me.Name = "ChannelTabsChooserForm"
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Tabs"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout()
CType(Me.TXT_URL, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Private WithEvents CH_ALL As CheckBox
Private WithEvents CH_VIDEOS As CheckBox
Private WithEvents CH_SHORTS As CheckBox
Private WithEvents CH_PLS As CheckBox
Private WithEvents TXT_URL As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_URL_ASIS As CheckBox
End Class
End Namespace

View File

@@ -0,0 +1,126 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
</root>

View File

@@ -0,0 +1,85 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports SCrawler.API.YouTube.Base
Namespace API.YouTube.Controls
Friend Class ChannelTabsChooserForm : Implements IDesignXMLContainer
Private WithEvents MyDefs As DefaultFormOptions
Friend Property DesignXML As EContainer Implements IDesignXMLContainer.DesignXML
Private Property DesignXMLNodes As String() Implements IDesignXMLContainer.DesignXMLNodes
Private Property DesignXMLNodeName As String Implements IDesignXMLContainer.DesignXMLNodeName
Private _Result As YouTubeChannelTab = YouTubeChannelTab.All
Friend ReadOnly Property Result As YouTubeChannelTab
Get
Return _Result
End Get
End Property
Friend ReadOnly Property URL As String
Get
Return TXT_URL.Text
End Get
End Property
Friend ReadOnly Property MyUrlAsIs As Boolean
Get
Return CH_URL_ASIS.Checked
End Get
End Property
Friend Sub New(ByVal InitVal As YouTubeChannelTab, ByVal _URL As String)
InitializeComponent()
MyDefs = New DefaultFormOptions(Me)
_Result = InitVal
TXT_URL.Text = _URL
End Sub
Private Sub ChannelTabsChooserForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
With MyDefs
MyDefs.MyXML = DesignXML
If Not DesignXML Is Nothing Then .MyViewInitialize(True)
.AddOkCancelToolbar()
If _Result = YouTubeChannelTab.All And Not MyYouTubeSettings Is Nothing Then _Result = MyYouTubeSettings.ChannelsDownload
Dim r() As YouTubeChannelTab = _Result.EnumExtract(Of YouTubeChannelTab)
If r.ListExists Then
For Each value As YouTubeChannelTab In r
Select Case value
Case YouTubeChannelTab.All : CH_ALL.Checked = True
Case YouTubeChannelTab.Videos : CH_VIDEOS.Checked = True
Case YouTubeChannelTab.Shorts : CH_SHORTS.Checked = True
Case YouTubeChannelTab.Playlists : CH_PLS.Checked = True
End Select
Next
Else
CH_ALL.Checked = True
End If
UpdateCheckBoxes()
.EndLoaderOperations()
.MyOkCancel.EnableOK = True
End With
Catch ex As Exception
MyDefs.InvokeLoaderError(ex)
End Try
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
_Result = YouTubeChannelTab.All
If Not CH_ALL.Checked And {CH_VIDEOS, CH_SHORTS, CH_PLS}.Any(Function(c) c.Checked) Then
If CH_VIDEOS.Checked Then _Result += YouTubeChannelTab.Videos
If CH_SHORTS.Checked Then _Result += YouTubeChannelTab.Shorts
If CH_PLS.Checked Then _Result += YouTubeChannelTab.Playlists
End If
MyDefs.CloseForm()
End Sub
Private Sub UpdateCheckBoxes() Handles CH_ALL.CheckedChanged, CH_URL_ASIS.CheckedChanged
Dim e As Boolean = Not CH_ALL.Checked And Not CH_URL_ASIS.Checked
CH_VIDEOS.Enabled = e
CH_SHORTS.Enabled = e
CH_PLS.Enabled = e
End Sub
End Class
End Namespace

View File

@@ -427,10 +427,14 @@ Namespace API.YouTube.Controls
Me.TXT_OUTPUT_PATH.Buttons.Add(ActionButton8)
Me.TXT_OUTPUT_PATH.Buttons.Add(ActionButton9)
Me.TXT_OUTPUT_PATH.Buttons.Add(ActionButton10)
Me.TXT_OUTPUT_PATH.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.Label
Me.TXT_OUTPUT_PATH.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.CheckBox
Me.TXT_OUTPUT_PATH.CaptionText = "Output path"
Me.TXT_OUTPUT_PATH.CaptionToolTipEnabled = True
Me.TXT_OUTPUT_PATH.CaptionToolTipText = "If this checkbox is selected, this path is absolute and artist folder will not be" &
" created in it"
Me.TXT_OUTPUT_PATH.CaptionVisible = True
Me.TXT_OUTPUT_PATH.CaptionWidth = 112.0R
Me.TXT_OUTPUT_PATH.ChangeControlsEnableOnCheckedChange = False
ListColumn1.Name = "COL_NAME"
ListColumn1.Text = "Name"
ListColumn1.Width = -1

View File

@@ -80,6 +80,14 @@ Namespace API.YouTube.Controls
End If
LIST_PLAYLISTS.SelectedIndex = 0
If .ObjectType = Base.YouTubeMediaType.Channel Then
With TXT_OUTPUT_PATH
.CaptionMode = ICaptionControl.Modes.Label
.CaptionToolTipText = String.Empty
.CaptionToolTipEnabled = False
End With
End If
TXT_OUTPUT_PATH.Text = MyYouTubeSettings.OutputPath.Value
If Not .UserTitle.IsEmptyString Then
@@ -266,6 +274,7 @@ Namespace API.YouTube.Controls
If Not TXT_SUBS.Checked Then .PostProcessing_OutputSubtitlesFormats.Clear()
.OutputAudioCodec = CMB_FORMATS.Text
If Not TXT_FORMATS_ADDIT.Checked Then .PostProcessing_OutputAudioFormats.Clear()
.AbsolutePath = TXT_OUTPUT_PATH.Checked
.File = TXT_OUTPUT_PATH.Text.CSFileP
If MyYouTubeSettings.OutputPathAutoChange Then MyYouTubeSettings.OutputPath.Value = .File
If MyDownloaderSettings.OutputPathAutoAddPaths Then MyYouTubeSettings.DownloadLocations.Add(.File, False)

View File

@@ -26,7 +26,7 @@ Namespace API.YouTube.Controls
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim FRM_PLS As System.Windows.Forms.GroupBox
Me.CH_PLS_ONE = New System.Windows.Forms.CheckBox()
Me.TXT_URLS = New System.Windows.Forms.RichTextBox()
Me.TXT_URLS = New System.Windows.Forms.TextBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
FRM_PLS = New System.Windows.Forms.GroupBox()
@@ -94,13 +94,14 @@ Namespace API.YouTube.Controls
'
'TXT_URLS
'
Me.TXT_URLS.DetectUrls = False
Me.TXT_URLS.AcceptsReturn = True
Me.TXT_URLS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_URLS.Location = New System.Drawing.Point(3, 16)
Me.TXT_URLS.MaxLength = 2147483647
Me.TXT_URLS.Multiline = True
Me.TXT_URLS.Name = "TXT_URLS"
Me.TXT_URLS.Size = New System.Drawing.Size(372, 261)
Me.TXT_URLS.TabIndex = 0
Me.TXT_URLS.Text = ""
'
'PlaylistArrayForm
'
@@ -119,10 +120,11 @@ Namespace API.YouTube.Controls
TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout()
FRM_PLS.ResumeLayout(False)
FRM_PLS.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents CH_PLS_ONE As CheckBox
Private WithEvents TXT_URLS As RichTextBox
Private WithEvents TXT_URLS As TextBox
End Class
End Namespace

View File

@@ -275,6 +275,7 @@ Namespace API.YouTube.Controls
ActionButton1.Name = "ArrowDown"
ActionButton1.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.ArrowDown
Me.TXT_FILE.Buttons.Add(ActionButton1)
Me.TXT_FILE.ChangeControlsEnableOnCheckedChange = False
ListColumn1.Name = "COL_NAME"
ListColumn1.Text = "Name"
ListColumn1.Width = -1

View File

@@ -76,6 +76,12 @@ Namespace API.YouTube.Controls
If Not def.ValueBetween(-1, 10000) Then def = 1080
End If
NUM_RES.Value = def
With TXT_FILE
.CaptionMode = ICaptionControl.Modes.CheckBox
.CaptionWidth = 18
.CaptionToolTipText = "If this checkbox is selected, this path is absolute and artist folder will not be created in it"
.CaptionToolTipEnabled = True
End With
Else
TP_OPTIONS.Controls.Remove(NUM_RES)
TP_OPTIONS.ColumnStyles(3).Width = 0
@@ -297,8 +303,8 @@ Namespace API.YouTube.Controls
.SelectedVideoIndex = -1
.SelectedAudioIndex = cntIndex
End If
.File = f
.FileSetManually = True
.File = f
.UpdateInfoFields()
'#If DEBUG Then
'Debug.WriteLine(.Command(False))
@@ -309,6 +315,7 @@ Namespace API.YouTube.Controls
Else
.SetMaxResolution(NUM_RES.Value)
End If
.AbsolutePath = TXT_FILE.Checked
.File = f
End If
End With
@@ -433,7 +440,28 @@ Namespace API.YouTube.Controls
End Sub
#End Region
#Region "Footer"
Private Sub BTT_BROWSE_MouseClick(sender As Object, e As MouseEventArgs) Handles BTT_BROWSE.MouseClick
Private _FilePathBeforeItemChange As SFile = Nothing
Private Sub TXT_FILE_ActionSelectedItemBeforeChanged(ByVal Sender As Object, ByVal e As EventArgs, ByVal Item As ListViewItem) Handles TXT_FILE.ActionSelectedItemBeforeChanged
If Not TXT_FILE.Text.IsEmptyString Then _FilePathBeforeItemChange = TXT_FILE.Text Else _FilePathBeforeItemChange = Nothing
End Sub
Private Sub TXT_FILE_ActionSelectedItemChanged(ByVal Sender As Object, ByVal e As EventArgs, ByVal Item As ListViewItem) Handles TXT_FILE.ActionSelectedItemChanged
Try
If Not MyContainer.HasElements Then
Dim currentPath As SFile = _FilePathBeforeItemChange
Dim newPath As SFile = TXT_FILE.Text.CSFileP
If Not currentPath.File.IsEmptyString Then
newPath.Name = currentPath.Name
newPath.Extension = currentPath.Extension
TXT_FILE.Text = newPath
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.YouTube.Controls.VideoOptionsForm.ChangeDestinationPath]")
Finally
_FilePathBeforeItemChange = Nothing
End Try
End Sub
Private Sub BTT_BROWSE_MouseDown(sender As Object, e As MouseEventArgs) Handles BTT_BROWSE.MouseDown
Dim f As SFile
#Disable Warning BC40000
If MyContainer.HasElements Then

View File

@@ -108,5 +108,16 @@ Namespace API.YouTube
Throw New NotImplementedException("'GetFormat' is not available in the 'DurationXmlConverter' context")
End Function
End Class
Friend Sub CheckVersion(ByVal Force As Boolean)
If Not MyYouTubeSettings Is Nothing Then
With MyYouTubeSettings
If .CheckUpdatesAtStart Or Force Then
ShowProgramInfo(.ProgramText.Value.IfNullOrEmpty("YouTube Downloader"),
SCrawler.Shared.GetCurrentMaxVer(Application.StartupPath.CSFileP).IfNullOrEmpty(My.Application.Info.Version),
True, Force, .Self, True,, False, .ProgramDescription)
End If
End With
End If
End Sub
End Module
End Namespace

View File

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

View File

@@ -24,8 +24,15 @@ Namespace DownloadObjects.STDownloader
Private Sub InitializeComponent()
Dim SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim SEP_3 As System.Windows.Forms.ToolStripSeparator
Dim MENU_ADD_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim MENU_DEL_CLEAR As System.Windows.Forms.ToolStripDropDownButton
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(VideoListForm))
Dim MENU_DEL_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim MENU_DEL_SEP_2 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.BTT_SELECT_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.TOOLBAR_BOTTOM = New System.Windows.Forms.StatusStrip()
Me.PR_MAIN = New System.Windows.Forms.ToolStripProgressBar()
Me.LBL_INFO = New System.Windows.Forms.ToolStripStatusLabel()
@@ -36,21 +43,19 @@ Namespace DownloadObjects.STDownloader
Me.MENU_ADD = New System.Windows.Forms.ToolStripDropDownButton()
Me.BTT_ADD = New PersonalUtilities.Forms.Controls.KeyClick.ToolStripMenuItemKeyClick()
Me.BTT_ADD_PLS_ARR = New PersonalUtilities.Forms.Controls.KeyClick.ToolStripMenuItemKeyClick()
Me.BTT_ADD_NO_SHORTS = 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_STOP = New System.Windows.Forms.ToolStripButton()
Me.BTT_DELETE = New System.Windows.Forms.ToolStripButton()
Me.BTT_CLEAR_DONE = New System.Windows.Forms.ToolStripButton()
Me.BTT_CLEAR_ALL = New System.Windows.Forms.ToolStripButton()
Me.SEP_LOG = New System.Windows.Forms.ToolStripSeparator()
Me.BTT_LOG = New System.Windows.Forms.ToolStripButton()
Me.BTT_INFO = New System.Windows.Forms.ToolStripButton()
Me.BTT_DONATE = New System.Windows.Forms.ToolStripButton()
Me.BTT_BUG_REPORT = New System.Windows.Forms.ToolStripButton()
Me.BTT_SELECT_NONE = New System.Windows.Forms.ToolStripMenuItem()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
SEP_3 = New System.Windows.Forms.ToolStripSeparator()
MENU_ADD_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
MENU_DEL_CLEAR = New System.Windows.Forms.ToolStripDropDownButton()
MENU_DEL_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
MENU_DEL_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
Me.TOOLBAR_BOTTOM.SuspendLayout()
Me.TOOLBAR_TOP.SuspendLayout()
Me.SuspendLayout()
@@ -65,10 +70,69 @@ Namespace DownloadObjects.STDownloader
SEP_3.Name = "SEP_3"
SEP_3.Size = New System.Drawing.Size(6, 25)
'
'MENU_ADD_SEP_1
'MENU_DEL_CLEAR
'
MENU_ADD_SEP_1.Name = "MENU_ADD_SEP_1"
MENU_ADD_SEP_1.Size = New System.Drawing.Size(181, 6)
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_SEP_2, Me.BTT_SELECT_ALL, Me.BTT_SELECT_NONE})
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"
'
'MENU_DEL_SEP_2
'
MENU_DEL_SEP_2.Name = "MENU_DEL_SEP_2"
MENU_DEL_SEP_2.Size = New System.Drawing.Size(182, 6)
'
'BTT_SELECT_ALL
'
Me.BTT_SELECT_ALL.Name = "BTT_SELECT_ALL"
Me.BTT_SELECT_ALL.Size = New System.Drawing.Size(185, 22)
Me.BTT_SELECT_ALL.Text = "Select all"
'
'TOOLBAR_BOTTOM
'
@@ -105,7 +169,7 @@ Namespace DownloadObjects.STDownloader
'TOOLBAR_TOP
'
Me.TOOLBAR_TOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.TOOLBAR_TOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_SETTINGS, Me.SEP_1, Me.MENU_ADD, SEP_2, Me.BTT_DOWN, Me.BTT_STOP, SEP_3, Me.BTT_DELETE, Me.BTT_CLEAR_DONE, Me.BTT_CLEAR_ALL, Me.SEP_LOG, Me.BTT_LOG, Me.BTT_INFO, Me.BTT_DONATE, Me.BTT_BUG_REPORT})
Me.TOOLBAR_TOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_SETTINGS, Me.SEP_1, Me.MENU_ADD, SEP_2, Me.BTT_DOWN, Me.BTT_STOP, SEP_3, MENU_DEL_CLEAR, Me.SEP_LOG, Me.BTT_LOG, Me.BTT_INFO, Me.BTT_DONATE, Me.BTT_BUG_REPORT})
Me.TOOLBAR_TOP.Location = New System.Drawing.Point(0, 0)
Me.TOOLBAR_TOP.Name = "TOOLBAR_TOP"
Me.TOOLBAR_TOP.Size = New System.Drawing.Size(584, 25)
@@ -128,7 +192,7 @@ Namespace DownloadObjects.STDownloader
'MENU_ADD
'
Me.MENU_ADD.AutoToolTip = False
Me.MENU_ADD.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_ADD, Me.BTT_ADD_PLS_ARR, MENU_ADD_SEP_1, Me.BTT_ADD_NO_SHORTS, Me.BTT_ADD_SHORTS_ONLY})
Me.MENU_ADD.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_ADD, Me.BTT_ADD_PLS_ARR})
Me.MENU_ADD.Image = CType(resources.GetObject("MENU_ADD.Image"), System.Drawing.Image)
Me.MENU_ADD.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_ADD.Name = "MENU_ADD"
@@ -141,7 +205,7 @@ Namespace DownloadObjects.STDownloader
Me.BTT_ADD.Image = CType(resources.GetObject("BTT_ADD.Image"), System.Drawing.Image)
Me.BTT_ADD.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_ADD.Name = "BTT_ADD"
Me.BTT_ADD.Size = New System.Drawing.Size(184, 22)
Me.BTT_ADD.Size = New System.Drawing.Size(149, 22)
Me.BTT_ADD.Tag = "a"
Me.BTT_ADD.Text = "Add (Ins)"
Me.BTT_ADD.ToolTipText = "Click to add." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Ctrl+click to use cookies for download (if supported)." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Shift to a" &
@@ -153,35 +217,11 @@ Namespace DownloadObjects.STDownloader
Me.BTT_ADD_PLS_ARR.Image = CType(resources.GetObject("BTT_ADD_PLS_ARR.Image"), System.Drawing.Image)
Me.BTT_ADD_PLS_ARR.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_ADD_PLS_ARR.Name = "BTT_ADD_PLS_ARR"
Me.BTT_ADD_PLS_ARR.Size = New System.Drawing.Size(184, 22)
Me.BTT_ADD_PLS_ARR.Size = New System.Drawing.Size(149, 22)
Me.BTT_ADD_PLS_ARR.Tag = "pls"
Me.BTT_ADD_PLS_ARR.Text = "Add playlist array"
Me.BTT_ADD_PLS_ARR.Text = "Add URL array"
Me.BTT_ADD_PLS_ARR.ToolTipText = "Click to add." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Ctrl+click to use cookies for download (if supported)." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Shift to a" &
"dd without downloading."
'
'BTT_ADD_NO_SHORTS
'
Me.BTT_ADD_NO_SHORTS.AutoToolTip = True
Me.BTT_ADD_NO_SHORTS.Image = CType(resources.GetObject("BTT_ADD_NO_SHORTS.Image"), System.Drawing.Image)
Me.BTT_ADD_NO_SHORTS.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_ADD_NO_SHORTS.Name = "BTT_ADD_NO_SHORTS"
Me.BTT_ADD_NO_SHORTS.Size = New System.Drawing.Size(184, 22)
Me.BTT_ADD_NO_SHORTS.Tag = "ans"
Me.BTT_ADD_NO_SHORTS.Text = "Add (without Shorts)"
Me.BTT_ADD_NO_SHORTS.ToolTipText = "Download all videos except 'Shorts'." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Click to add." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Ctrl+click to use cookies fo" &
"r download (if supported)." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Shift to add without downloading."
'
'BTT_ADD_SHORTS_ONLY
'
Me.BTT_ADD_SHORTS_ONLY.AutoToolTip = True
Me.BTT_ADD_SHORTS_ONLY.Image = CType(resources.GetObject("BTT_ADD_SHORTS_ONLY.Image"), System.Drawing.Image)
Me.BTT_ADD_SHORTS_ONLY.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_ADD_SHORTS_ONLY.Name = "BTT_ADD_SHORTS_ONLY"
Me.BTT_ADD_SHORTS_ONLY.Size = New System.Drawing.Size(184, 22)
Me.BTT_ADD_SHORTS_ONLY.Tag = "as"
Me.BTT_ADD_SHORTS_ONLY.Text = "Add (Shorts only)"
Me.BTT_ADD_SHORTS_ONLY.ToolTipText = "Download only 'Shorts' videos." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Click to add." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Ctrl+click to use cookies for down" &
"load (if supported)." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Shift to add without downloading."
'
'BTT_DOWN
'
@@ -202,33 +242,6 @@ Namespace DownloadObjects.STDownloader
Me.BTT_STOP.Size = New System.Drawing.Size(51, 22)
Me.BTT_STOP.Text = "Stop"
'
'BTT_DELETE
'
Me.BTT_DELETE.Image = CType(resources.GetObject("BTT_DELETE.Image"), System.Drawing.Image)
Me.BTT_DELETE.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DELETE.Name = "BTT_DELETE"
Me.BTT_DELETE.Size = New System.Drawing.Size(60, 22)
Me.BTT_DELETE.Text = "Delete"
Me.BTT_DELETE.ToolTipText = "Delete selected items"
'
'BTT_CLEAR_DONE
'
Me.BTT_CLEAR_DONE.Image = CType(resources.GetObject("BTT_CLEAR_DONE.Image"), System.Drawing.Image)
Me.BTT_CLEAR_DONE.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR_DONE.Name = "BTT_CLEAR_DONE"
Me.BTT_CLEAR_DONE.Size = New System.Drawing.Size(54, 22)
Me.BTT_CLEAR_DONE.Text = "Clear"
Me.BTT_CLEAR_DONE.ToolTipText = "Remove all downloaded items"
'
'BTT_CLEAR_ALL
'
Me.BTT_CLEAR_ALL.Image = CType(resources.GetObject("BTT_CLEAR_ALL.Image"), System.Drawing.Image)
Me.BTT_CLEAR_ALL.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_CLEAR_ALL.Name = "BTT_CLEAR_ALL"
Me.BTT_CLEAR_ALL.Size = New System.Drawing.Size(69, 22)
Me.BTT_CLEAR_ALL.Text = "Clear all"
Me.BTT_CLEAR_ALL.ToolTipText = "Remove all items (pending and downloaded)"
'
'SEP_LOG
'
Me.SEP_LOG.Name = "SEP_LOG"
@@ -273,6 +286,12 @@ Namespace DownloadObjects.STDownloader
Me.BTT_BUG_REPORT.Size = New System.Drawing.Size(23, 22)
Me.BTT_BUG_REPORT.Text = "Bug report"
'
'BTT_SELECT_NONE
'
Me.BTT_SELECT_NONE.Name = "BTT_SELECT_NONE"
Me.BTT_SELECT_NONE.Size = New System.Drawing.Size(185, 22)
Me.BTT_SELECT_NONE.Text = "Select none"
'
'VideoListForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -300,9 +319,9 @@ Namespace DownloadObjects.STDownloader
Private WithEvents LBL_INFO As ToolStripStatusLabel
Protected WithEvents TP_CONTROLS As TableLayoutPanel
Private WithEvents TOOLBAR_TOP As ToolStrip
Private WithEvents BTT_DELETE As ToolStripButton
Private WithEvents BTT_CLEAR_DONE As ToolStripButton
Private WithEvents BTT_CLEAR_ALL As ToolStripButton
Private WithEvents BTT_DELETE As ToolStripMenuItem
Private WithEvents BTT_CLEAR_DONE As ToolStripMenuItem
Private WithEvents BTT_CLEAR_ALL As ToolStripMenuItem
Private WithEvents BTT_SETTINGS As ToolStripButton
Private WithEvents SEP_1 As ToolStripSeparator
Private WithEvents SEP_LOG As ToolStripSeparator
@@ -312,10 +331,11 @@ Namespace DownloadObjects.STDownloader
Private WithEvents BTT_DONATE As ToolStripButton
Protected WithEvents BTT_ADD As PersonalUtilities.Forms.Controls.KeyClick.ToolStripMenuItemKeyClick
Protected WithEvents BTT_ADD_PLS_ARR As PersonalUtilities.Forms.Controls.KeyClick.ToolStripMenuItemKeyClick
Protected WithEvents BTT_ADD_NO_SHORTS As PersonalUtilities.Forms.Controls.KeyClick.ToolStripMenuItemKeyClick
Protected WithEvents BTT_ADD_SHORTS_ONLY As PersonalUtilities.Forms.Controls.KeyClick.ToolStripMenuItemKeyClick
Protected WithEvents MENU_ADD As ToolStripDropDownButton
Protected WithEvents BTT_DOWN As ToolStripButton
Private WithEvents BTT_BUG_REPORT As ToolStripButton
Private WithEvents BTT_CLEAR_SELECTED As ToolStripMenuItem
Private WithEvents BTT_SELECT_ALL As ToolStripMenuItem
Private WithEvents BTT_SELECT_NONE As ToolStripMenuItem
End Class
End Namespace

View File

@@ -123,235 +123,257 @@
<metadata name="SEP_3.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_ADD_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<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
FeVFihZsqaBjRM2ouILiC0oUozGaaBSTJfuwfdg+bJnJnFuiyzKZMOp8ATJl4IYLAjqspfS9cNlLskjP
/qe0OmPZeJJfbu85z/k//z7n3Ht5NPqLimLMSUkfXV20aPiKTPbhOqn0FQxHBSb/J4ZUKvY3mez6yMKF
fReTkw0YigERgUkaAyaT8FZR0ZdDzc1k9OxZ0tHU5L/Csp15ItFSTEfPZIWPQYZ507Z580Pu9Gky1dpK
hisrPe+nptbLYmPjMT1TpHPJkg/u7d1LHhw7RkaPHiVWJFsOHCBtLHtdLhK9jpSwRUbU6jUQt3BnzhAO
a7mWFjJ15Ai5p9V6v5ZK30OKGETxrkokVir+oKmJPDx0iFiRNH7yJLnW3Oy/olLdyBKJUpD4TBG0pdhW
VWWlzqn4FMS5/fvJFIz5amqIOSHhLtJYIOJ1JCaeG66tJaMoYAHWgweJDQscJ06QG2hXB8t2ZwqFqUgO
FBlSKIrHKyutk6dOEQ5mpmCKw7qpPXvIxI4dpE2lcm2RSC4gtRSIefrFi19tUyqvt2/b5n+EpDEwDjcO
7IkbLXPu20euokiuUJj2E8MUjRkMtsnjxwMt4eCYQ3u5xkYyCXFzbq4nRSD4FMJGIAd0w3nRjESSiiLd
li1biG3nTmJvaCCO3buJC8W8EOpuaPD3qNV37peXW7nDhwOOOcxxyOXq65+IpwkE56BXCzKC4pEgEPxc
sTjtO4Wi64fqar+9ro44gdtkIh4I+FDMt2sXmYTbSSqMew73AXG0t0up9MqFQipOnaeD+eDpUQ0GXyUW
p3dkZ3fbNm4kzq1biRt4jUbig8MJFJzABk6UlxPf6tXEp1YTD+jKy/PliETnsX47oM4F4DnxUPCXxcdn
dMjl3QMZGY89mzYRt0ZD3AxDXFIpcYlExBUdTVzz5pFuodDfnpTkZePi6IbWgUzwIphVPBSBdt2Sy/vH
IWiHmAM4ARUOEBVF+rKz/zKkpn6L/HdBFpiTeCBsNTUmm1ptsQsEz4sDOjaQnPzYrNXeT0tMLMeSWDA3
cZ/RuM9VUOCyw/1s4mPgIbBkZJA+ne7uW8uX52Dpf75WAuE2Gluca9e67TExz4k70XvaLio+CoYjI8kA
uJyT4++vqPjVwLK0TbMX8W7ffshRUuIJ59wpkZBHJSV/30hJ8VPxoaB4L+gCZoaZ7qf/ZLYiOIot9oIC
r10oDAg/05YFC8hgaenvx1eu7Oldv37ckpZGfoHobXATXKMFKMuWTf9oMNwpkMvpC/Lpq95TW9tMxR3h
xBMSyOCqVX/UM0wHUhtKMjPfvltWdn8QvQ+Jd4J20EaLqFTTPRUVvZ9otXTj+SCC59mwweqIiwvvHOJ1
CkU7Ek2AbqR4d37+G316/cidrKwn4pfBN+AS6E9Pf3xbr7+H3MWAz7PrdIMemSyscxPDfI+k+qB46EvF
31NYyPZVVIxcyMry/1v8q4gIchsFzBrNGPKKQDyvp7p687hG43ZDNOR8oLj4z53hxUPBb8zPz8PGDt/K
ziYXg+LmvLzpzzWaR6VLl36MnJkCiPntlZWHrWVl3h6W9VPnjUplJ8ZnEw8F37hihYK24wusM6vV0xfg
/CWBoBVzOjDTIkQEk5QU26vXf/agrMx5vrAQpy+yEeMMENJ5mjRL8C9VVb3zs043dlOrdZWkpNBvgR5I
AT2uT9bSH3FACdYFr3N9/F8A9GjSk7MevAbCPnDzAHVMP9b0Su/nEtQEff+/HIQWDBrj8f4B7zPYbtFn
HR8AAAAASUVORK5CYII=
</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
FeVFihZsqaBjRM2ouILiC0oUozGaaBSTJfuwfdg+bJnJnFuiyzKZMOp8ATJl4IYLAjqspfS9cNlLskjP
/qe0OmPZeJJfbu85z/k//z7n3Ht5NPqLimLMSUkfXV20aPiKTPbhOqn0FQxHBSb/J4ZUKvY3mez6yMKF
fReTkw0YigERgUkaAyaT8FZR0ZdDzc1k9OxZ0tHU5L/Csp15ItFSTEfPZIWPQYZ507Z580Pu9Gky1dpK
hisrPe+nptbLYmPjMT1TpHPJkg/u7d1LHhw7RkaPHiVWJFsOHCBtLHtdLhK9jpSwRUbU6jUQt3BnzhAO
a7mWFjJ15Ai5p9V6v5ZK30OKGETxrkokVir+oKmJPDx0iFiRNH7yJLnW3Oy/olLdyBKJUpD4TBG0pdhW
VWWlzqn4FMS5/fvJFIz5amqIOSHhLtJYIOJ1JCaeG66tJaMoYAHWgweJDQscJ06QG2hXB8t2ZwqFqUgO
FBlSKIrHKyutk6dOEQ5mpmCKw7qpPXvIxI4dpE2lcm2RSC4gtRSIefrFi19tUyqvt2/b5n+EpDEwDjcO
7IkbLXPu20euokiuUJj2E8MUjRkMtsnjxwMt4eCYQ3u5xkYyCXFzbq4nRSD4FMJGIAd0w3nRjESSiiLd
li1biG3nTmJvaCCO3buJC8W8EOpuaPD3qNV37peXW7nDhwOOOcxxyOXq65+IpwkE56BXCzKC4pEgEPxc
sTjtO4Wi64fqar+9ro44gdtkIh4I+FDMt2sXmYTbSSqMew73AXG0t0up9MqFQipOnaeD+eDpUQ0GXyUW
p3dkZ3fbNm4kzq1biRt4jUbig8MJFJzABk6UlxPf6tXEp1YTD+jKy/PliETnsX47oM4F4DnxUPCXxcdn
dMjl3QMZGY89mzYRt0ZD3AxDXFIpcYlExBUdTVzz5pFuodDfnpTkZePi6IbWgUzwIphVPBSBdt2Sy/vH
IWiHmAM4ARUOEBVF+rKz/zKkpn6L/HdBFpiTeCBsNTUmm1ptsQsEz4sDOjaQnPzYrNXeT0tMLMeSWDA3
cZ/RuM9VUOCyw/1s4mPgIbBkZJA+ne7uW8uX52Dpf75WAuE2Gluca9e67TExz4k70XvaLio+CoYjI8kA
uJyT4++vqPjVwLK0TbMX8W7ffshRUuIJ59wpkZBHJSV/30hJ8VPxoaB4L+gCZoaZ7qf/ZLYiOIot9oIC
r10oDAg/05YFC8hgaenvx1eu7Oldv37ckpZGfoHobXATXKMFKMuWTf9oMNwpkMvpC/Lpq95TW9tMxR3h
xBMSyOCqVX/UM0wHUhtKMjPfvltWdn8QvQ+Jd4J20EaLqFTTPRUVvZ9otXTj+SCC59mwweqIiwvvHOJ1
CkU7Ek2AbqR4d37+G316/cidrKwn4pfBN+AS6E9Pf3xbr7+H3MWAz7PrdIMemSyscxPDfI+k+qB46EvF
31NYyPZVVIxcyMry/1v8q4gIchsFzBrNGPKKQDyvp7p687hG43ZDNOR8oLj4z53hxUPBb8zPz8PGDt/K
ziYXg+LmvLzpzzWaR6VLl36MnJkCiPntlZWHrWVl3h6W9VPnjUplJ8ZnEw8F37hihYK24wusM6vV0xfg
/CWBoBVzOjDTIkQEk5QU26vXf/agrMx5vrAQpy+yEeMMENJ5mjRL8C9VVb3zs043dlOrdZWkpNBvgR5I
AT2uT9bSH3FACdYFr3N9/F8A9GjSk7MevAbCPnDzAHVMP9b0Su/nEtQEff+/HIQWDBrj8f4B7zPYbtFn
HR8AAAAASUVORK5CYII=
</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
FeVFihZsqaBjRM2ouILiC0oUozGaaBSTJfuwfdg+bJnJnFuiyzKZMOp8ATJl4IYLAjqspfS9cNlLskjP
/qe0OmPZeJJfbu85z/k//z7n3Ht5NPqLimLMSUkfXV20aPiKTPbhOqn0FQxHBSb/J4ZUKvY3mez6yMKF
fReTkw0YigERgUkaAyaT8FZR0ZdDzc1k9OxZ0tHU5L/Csp15ItFSTEfPZIWPQYZ507Z580Pu9Gky1dpK
hisrPe+nptbLYmPjMT1TpHPJkg/u7d1LHhw7RkaPHiVWJFsOHCBtLHtdLhK9jpSwRUbU6jUQt3BnzhAO
a7mWFjJ15Ai5p9V6v5ZK30OKGETxrkokVir+oKmJPDx0iFiRNH7yJLnW3Oy/olLdyBKJUpD4TBG0pdhW
VWWlzqn4FMS5/fvJFIz5amqIOSHhLtJYIOJ1JCaeG66tJaMoYAHWgweJDQscJ06QG2hXB8t2ZwqFqUgO
FBlSKIrHKyutk6dOEQ5mpmCKw7qpPXvIxI4dpE2lcm2RSC4gtRSIefrFi19tUyqvt2/b5n+EpDEwDjcO
7IkbLXPu20euokiuUJj2E8MUjRkMtsnjxwMt4eCYQ3u5xkYyCXFzbq4nRSD4FMJGIAd0w3nRjESSiiLd
li1biG3nTmJvaCCO3buJC8W8EOpuaPD3qNV37peXW7nDhwOOOcxxyOXq65+IpwkE56BXCzKC4pEgEPxc
sTjtO4Wi64fqar+9ro44gdtkIh4I+FDMt2sXmYTbSSqMew73AXG0t0up9MqFQipOnaeD+eDpUQ0GXyUW
p3dkZ3fbNm4kzq1biRt4jUbig8MJFJzABk6UlxPf6tXEp1YTD+jKy/PliETnsX47oM4F4DnxUPCXxcdn
dMjl3QMZGY89mzYRt0ZD3AxDXFIpcYlExBUdTVzz5pFuodDfnpTkZePi6IbWgUzwIphVPBSBdt2Sy/vH
IWiHmAM4ARUOEBVF+rKz/zKkpn6L/HdBFpiTeCBsNTUmm1ptsQsEz4sDOjaQnPzYrNXeT0tMLMeSWDA3
cZ/RuM9VUOCyw/1s4mPgIbBkZJA+ne7uW8uX52Dpf75WAuE2Gluca9e67TExz4k70XvaLio+CoYjI8kA
uJyT4++vqPjVwLK0TbMX8W7ffshRUuIJ59wpkZBHJSV/30hJ8VPxoaB4L+gCZoaZ7qf/ZLYiOIot9oIC
r10oDAg/05YFC8hgaenvx1eu7Oldv37ckpZGfoHobXATXKMFKMuWTf9oMNwpkMvpC/Lpq95TW9tMxR3h
xBMSyOCqVX/UM0wHUhtKMjPfvltWdn8QvQ+Jd4J20EaLqFTTPRUVvZ9otXTj+SCC59mwweqIiwvvHOJ1
CkU7Ek2AbqR4d37+G316/cidrKwn4pfBN+AS6E9Pf3xbr7+H3MWAz7PrdIMemSyscxPDfI+k+qB46EvF
31NYyPZVVIxcyMry/1v8q4gIchsFzBrNGPKKQDyvp7p687hG43ZDNOR8oLj4z53hxUPBb8zPz8PGDt/K
ziYXg+LmvLzpzzWaR6VLl36MnJkCiPntlZWHrWVl3h6W9VPnjUplJ8ZnEw8F37hihYK24wusM6vV0xfg
/CWBoBVzOjDTIkQEk5QU26vXf/agrMx5vrAQpy+yEeMMENJ5mjRL8C9VVb3zs043dlOrdZWkpNBvgR5I
AT2uT9bSH3FACdYFr3N9/F8A9GjSk7MevAbCPnDzAHVMP9b0Su/nEtQEff+/HIQWDBrj8f4B7zPYbtFn
HR8AAAAASUVORK5CYII=
</value>
</data>
<metadata name="MENU_DEL_SEP_2.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<data name="MENU_DEL_CLEAR.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVGSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcQBAgV6a1/c
NGgBKVqwpYKOETWj4gqKLyhRjMZoovElWbIP24ftw5aZzLgluiwbE0aNjpdNGejUIW9iKaX0FS5zSxbo
2f+UVmcsG0/yy+095zn/59/nnHsvh0ZPfn6MJSnpk+tLlvRfk0g+3iAWv4bhqMDk/0SfQqF6JJHcHFi8
uPtKcrIRQzEgIjBJ457ZzL+Vn/9VX0MDGb5wgfxeX++/plK1KgWC5ZiOns0KH70M87Z969bH7NmzZOr8
edJfVub5MDW1RhIbG4/p2SKty5Z99HD/fjJ04gQZPn6c2JBsPXSINKlUN6UCwZtICVtkQK1eB3Ere+4c
YbGWbWwkU8eOkYc6nfcbsfgDpAhBFOe6SGSj4kP19eTxkSPEhqSx06fJYEOD/5pC8VOmQJCCxOeKoC0F
9vJyG3VOxacgzh48SKZgzFdZSSwJCfeRpgICTkti4sX+qioyjAJWYDt8mNixYPzUKfII7WpRqToy+PxU
JAeK9MlkBWNlZbbJM2cICzNTMMVi3dS+fWRi1y7SpFC4tolEl5FaBIQcw9KlrzfJ5Tcf7NjhH0HSKBiD
m3HsiRstcx44QK6jSA6fn/Yrw+SPGo32yZMnAy1h4ZhFe9m6OjIJcUtOjieFx/scwiYgBXTDOdGMSJSK
Ih3WbduIffdu4qitJeN79xIXinkhZK2t9Xeq1XcGS0ps7NGjAccs5ljksjU1T8XTeLyL0KsC6UHxSBAI
bo5QmPaDTNY+UFHhd1RXEydwm83EAwEfivn27CGTcDtJhXHP4j4gjva2y+VeKZ9PxanzFWAheHZUg8FV
CIUrWrKyOuybNxPn9u3EDbwmE/HB4QQKTmADJ0pKiG/tWuJTq4kHtCuVvmyB4BLW7wTUOQ+8IB4K7sr4
+PQWqbRjqKBg2rNlC3FrtcTNMMQlFhOXQEBc0dHEtWABsfL5/uakJK8qLo5uaDXIAC+DOcVDEWjXLam0
ZwyCDoiNAyegwgGiokhPVtZfxtTU75D/PsgE8xIPhL2y0mxXq60OHu9FcUDHBpOTpy063WBaYmIJlsSC
+Yn7TKYDLo3G5YD7ucRHwWNgTU8n3Xr9/XdWrcrG0v98rQTCbTI1OtevdztiYl4Qd6L3tF1UfBj0R0aS
e+Budra/p7T0gVGlom2au4h3584j44WFnnDOnSIRGSks/PtRSoqfivcFxbtAO7jNMDM99J/MVQRHsdGh
0XgdfH5A+Lm2LFpEeouK/ji5Zk1n18aNY9a0NPIbFQVt4AawgJ9Xrpz5xWi8o5FK6Qvy2aveU1XVQMXH
w4knJJDevLwnNQzTgtTawoyMd+8XFw/2ovch8VbQDJpAm0Ix01la2vWZTkc3ngsiOJ5Nm2zjcXHhnUO8
WiZrRqIZ0I0U7s3NfavbYBi4k5n5VPx78C24CnqUyunbBsND5C4FXI5Dr+/1SCRhnZsZ5kck1QTFQ18q
7r68PFV3aelAe2am/9/iX0dEkNsKxbRFqx1FXj6I53RWVGwd02rdboiGnN8rKPhzd3jxUHDrcnOV2Nj+
W1lZ5EpQ3KJUznyp1Y4ULV/+KXJmCyAWNpeVHbUVF3tHVCp/r0bzpE4ub8X4XOKh4JpWr5bRdrRh3Q21
euYynL/C453HnB7MtggRwSQlxXYZDF8MFRc7L+Xl4fRF1mGcAXw6T5PmCO7V8vL37ur1o206naswJYV+
CwxADOhxfbqW/ogDcrAheJ3v4/8SoEeTnpyN4A0Q9oFbAKhj+rGmV3o/n6Am6Pv/1SC0YNAYh/MPME3a
dCWdzmEAAAAASUVORK5CYII=
</value>
</data>
<metadata name="TOOLBAR_BOTTOM.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<metadata name="TOOLBAR_TOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>177, 17</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="BTT_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN1SURBVEhLrZVZSFRRGMdvKa44TljWuGGWldMyZpYLjpqW
TlrRuGVutLiUkSk6SmUMZfYaRW/Rg0REL2H01PJgEZWaOuod00kZZ7OxwOj9xL/v3EbyQTT0fvBnBs7h
//vOd//nXmG58rnr1eV7zwuLia95tq28uJHapGZZQ1ocHtZCJ5LMWhRbsyWIZ9vKi5vsGlGzgHcCFB8F
hPQLCB/wRo0zTz6ARlSz4E8CNvSvQfSQL+JFBVrdhfIBEgjAO48x+SJhLBiZ4xtx60eFfIBkAsSY/LB/
TIlcSxjNfyvuztXKBzgraliiWYk8SzjKprej1haPh78a5AM0i0lM9zUClbY41NsT0OxIxeNfhv8DLJXz
eVX0ZfyusO3AJXsi2ma0uOHOQdfPFqx/4r+kVM8Cu6QOs+czTvnOH9eiwJKFKmsuLjmO44qrGJ3uKvqf
iKuudNx056JjVoeuuRY8mjNIoAdzDbjzoxo3Z8vR6iqiEeaj3nYSqu5ASABurvhAGe8VEDHkQ7FUSEnR
T8XgjG0nLjuScG3mIBnocHs2TwLc+JZDZlrU2uNRMhWL7IlN0JgViBz0gZJ8Tpr1/wC8c27OFzXmINqs
QqHHvNGZhHZXFjrcOgLk4Pq3LBhcafQs9uH0tBonJjcjYzwUu8UghA15Q9knwJ8uZeHwAkD+mBZRZB5P
HWRbVFIMa+waNDkP4OpMJtrJ9IorAwZnGhod+1FHa5U2NY5NRiOdTiqZD3qDX0ZuvuaVAH3fAsApyyGk
jIVQDCNQbt2BBnqYLZSUNjLkps3OVElNNKo6GglP09HJKKR9CUXcaCBUn70QRCP26xEgvCR1E+D9AsAF
cS8ziCnM+KWSGcfPMeNEHTNaaun3PDOKF9n97xfI/ABqbBqUTm9D3mQk2hxVKPiY8btaTGUVYjIrJaWQ
kkdIA6TeZCYBeEwXi9i8+KZOsY3V2Peg1BqLI3TKJDptvb1UWltSPKbLFd9oFJtYCT2X3Ilw7KMbvcXk
j9PWAsnEs23l9RdQz3ImwqQXHX+bhlBSyiyeGa+2/gKq2V5zMCIoKesozvzbUDSf89UWN2kQy1nkoC+U
FMOAtwK8XlNKTDICzlLCuLkfdb6Wx/AFAT7JCCin+PlT5wJdIOE56SkB3skIKBrVSyPR95LoAul7SG/k
AlCWudGiWjbngvAHbcWtizmLGJwAAAAASUVORK5CYII=
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAANoSURBVEhLrZVrSFNhGMePTbwkzoVlzUuUZdkizzIvFE5r
K51a0bzU8kYXp2W4El1SGdL1axh9iz5IRPQljD51gUyitIvOOjNdytxNZ4Hh9xP/nvc0yQ+iYeeBPwze
l//veZ/3/55xi1VYh6Iz/LYC84mtBbctvZiRxq4R9QM67BvUwSiQHDqUuwwSJLht6SUBPmvE5T0clO84
xH7gkPApFBZfkYwAQSPG9HJY9SEE6wbCoRWUOB8olRfAOk+2hyN9KAa7h1fj+o8q+QA8AZLtEcgcUqHA
GU/z34iO6Tr5ACcIkOFQociZgIrxzahza3FvxiofoFlIE43fElHt3oIGTzqavbvwYMb2b4CFcj6r0td5
v6rcqWj0ZKB1QocrgXx0/mzByoeRC0r9OKpT6tAwm3HKd/GwDiVOPWpcBWj0HsQFfzluBGrodwYu+nNx
NVCAa1NGdE634P60TQLdnbbi1o9aXJ2qxHl/GY2wGA3uI1B3RUECMHPlW8p4H4fEgTC6VKWUFNNYMo67
t+KsNxuXJvaQgRE3p4okwJXJfDLToc6jxeGxFBhG1oB3KJHUHwYV+RxxmP4CWOfMnC3yjmjarEZp0Pyc
Lxttfj2uBYwEyMflST1s/hy6ix04Nq7BodH1yBuOwzYhGvEDoVC95xBJj7J0cA6geEiHtWSupQ4MTrUU
Q4uHR5MvCxcndqONTC/482Dz5eCcNxP1tFbt1uDA6Drk0kkl8/5QsMfIzEOeczC9nwM46tyLnUOxFMNE
VLpSYaXLbKGktJIhM2327ZLURKOqp5GwNO0fXYucr3HY8iUK6o8KRNOII7o5cM9IXQR4MwdwmnJuE7Ri
u1BNOkmqJ9WRTpHOiHe+nybzLFjcPMzjm1A0moRWbw0KX+X9qhW2i1UCL5pJWhL/mfSJ1MeLEoDFdL6I
zYptahdaRYsnDWZXCgrplNl02gaPWVpbUCymixXb2C40iYfpXgpGErCDXvQGeySOuUokk+C2pdcfQIOY
PxIvfejY1zSWklLhDM74f+sPoFbc7ohBIiVlBcWZ/TeUzeb8f4uZWIVKMak/HCqK4fLXHBQvKCV2GQEn
KGHMPII6X8Zi+JQAvTICKil+kdQ5Rw+Ie0J6RIAeGQFlX0zSSEx9JHpApm7SS7kAlGVmNK8WzTnH/Qao
hKygM1JCJAAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_ADD_PLS_ARR.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN2SURBVEhLrZVJTFNRFIafQhgD1OBUpiiKSomUSYmVgoJC
BTVWBpEpigyKESVQiVMa56XRuDMuiDHGjcG4cligMSqCUOAVoZaUTlgkqWF/ze+5zzayIGDwneRPm9yb
/zv3vP++JyxWQXcDuoLvBWA+8TXftqUXN0oxqVj+oBZ7h7TQiSSzFuW2Agni27b04iapwyoW9k5A5EcB
0X0CYr8EotFVLB8gXVSxqE8CVvUtw7rBYKSJkTjvKZUPkEUA3nmiKRgZo1HYNbYGN2Zq5ANoxBSWaArB
tlEFiiwxNP+NuOttkg9QL6azLLMCxZZYVE1uRpM9DQ9nW+UDtIs7mO5bHGrtyWhxZKDdqcHjWcO/ARbK
uV91/Xm/auxbcMaRhc4pLa56CtH1swMrn4QuKOWz8C6pwwJ/xinfJWNaHLbko85WhDPOg7jgLsdNTx39
z8JFdy6ueYpwfVqHLm8HHnkNEuiBtxV3Zhpwbboa591lNMIStNiPQNkdDgnAzSM/UMZ7BcQNBkFNMeRJ
0U8k4rg9BWed2bg0tZsMdLg1XSwBrn4vJDMtmhxpqJhIQsH4WqjNkYgfCIKCfI6Y9X8BvHNuzhfV5gja
rESpz/ycKxuX3fm47tERoBBXvufD4M6hZ5GJY5MqHLKuR97YamwVIxAzGAjFZwGhdClLh+YASka1SCDz
NOqgwKKUYtjoUKPNtR0Xp3bhMplecOfB4MrBOec2NNNarV2FA9Z1yKWTSuYDgeCXkZsveyVA/3kO4Khl
D3aMRlMM41Bt24JWepgdlJROMuSm7S6NpDYaVTONhKdpvzUBOV9XI3kkHMr+AETQiEN6BAgvSd0EeD8H
cErMZAZxJzOO1zKj5QQzfmtmRmsT/Z5kRvE0u//jFJlvR6NdjcrJTSi2xqPTWYey3t2/GsQcViNqWCVp
J0kzTPpC6tUwCcBjOl/E/OKbboudrNGRikpbEvbRKbPptC2OSmltQfGYLlZ8o1FsYxX0XIrGY5FJN3qD
KRTHbIclE9+2pdcfQAsrHI+RXnT8bRpNSamy+Gb8v/UH0MDSzVGIo6SsoDjzb0OZP+f/W9ykVaxm8QPB
UFAMw94KCHhNKTHJCKinhHHzEOp8OY/hCwJ8khFQTfELpc4FukDCc9JTAryTEVA2opdGou8l0QXS95De
yAWgLHOjebVozgXhN40Crc2i/A+XAAAAAElFTkSuQmCC
</value>
</data>
<data name="BTT_ADD_NO_SHORTS.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN8SURBVEhLrZVZSJRRGIZ/U1wSdcK2caMsW6nR3Chm1LRZ
UosmTS2XNpc0tEQnaUPMiugmiu6iC4mIbsLoquXCJCpbdMx/XKapcVbHAqP7E2/f+RvJC9Gw/4MXBs7h
fb7znff8I8xXwTcDu0JuBWI28TX/toUXN8owp7DcAQ20gxoYRJJFgwP2PAni37bw4ibbP6Wwxb0CIt8I
iH4vIPZjEGrc+fIB1GIKi3orYNn7AKwaCEGyGIkzviL5ANkE4J0nmkOwbTgKOaMrcPl7hXwArZjBEs2h
SB9WQG+Nofmvxc2pWvkAx0Q1S7MokG+NxaHx9ah1JOPuzyb5AC0ju5jhcxwqHRvR4NyGFtcO3P9p+jfA
XDmfVv2I7leFYwManWlo82rQ4dOh60crlj4Im1PKR+FdUod50xmnfBeMarDfmosqux6Nrr046zmAK74q
+p2Gc54sXPLp0TlpQNdUK+5NmSTQnakm3PhejUuT5TjjKaYRFqDBUQpldzj+XCKZR76mjPcJiBsIhopi
yJNi/JKIo47NOOXKxHnvTjIw4OpkvgTomNCRmQa1zmSUfElC3thKqCyRiO8PhoJ8Si3GvwDeOTfniypL
BG1WoshvftqdiQueXHT6DATQ4eJELkweNd1FKo6Mb8I+22pkjy7HFjECMQNBULwTEEaPsmhwBqBgWIME
Mk+mDvKsSimGNU4Vmt0ZOOfNwQUyPevJhsmtxmlXOupordKxCXtsq5BFJ5XM+4PAHyM3D3gmwPhuBuCg
dRe2D0dTDONQbt+AJrrMVkpKGxly0xb3DknNNKo6GglPU6EtAeqR5dg4FA7lh0BE0IhDewQIT0ndBHg1
A1Bvy2Imu461uytZu+c46/DWsY6JWtbpPcGufT3Jbn+rJ/MM1DhUKBtfh3xbPNpcVTgsFv6qHtGzClHL
ykg6kvYT6SOpT8skAI/pbBGbFt90y97GapxbUWZPwm46ZSadtsFZJq3NKR7T+YpvvP61mZXQvejHYpFK
L3qNOQxH7PslE/+2hRc3af/cwHRjMdKHjn9Noykph6z+Gf9vSYDRapZiiUIcJWUJxZn/NxRP5/x/i5s0
WcpZfH8IFBTDxS8FBD6nlJhlBBwTdYybh1Lni3gMnxDgrYyAcopfGHUu0AMSHpMeEqBXRkDxkFEaibGP
RA/I2EN6IReAssyNZtW8OReE31w2r8aW2OYjAAAAAElFTkSuQmCC
</value>
</data>
<data name="BTT_ADD_SHORTS_ONLY.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN8SURBVEhLrZVZSJRRGIZ/U1wSdcK2caMsW6nR3Chm1LRZ
UosmTS2XNpc0tEQnaUPMiugmiu6iC4mIbsLoquXCJCpbdMx/XKapcVbHAqP7E2/f+RvJC9Gw/4MXBs7h
fb7znff8I8xXwTcDu0JuBWI28TX/toUXN8owp7DcAQ20gxoYRJJFgwP2PAni37bw4ibbP6Wwxb0CIt8I
iH4vIPZjEGrc+fIB1GIKi3orYNn7AKwaCEGyGIkzviL5ANkE4J0nmkOwbTgKOaMrcPl7hXwArZjBEs2h
SB9WQG+Nofmvxc2pWvkAx0Q1S7MokG+NxaHx9ah1JOPuzyb5AC0ju5jhcxwqHRvR4NyGFtcO3P9p+jfA
XDmfVv2I7leFYwManWlo82rQ4dOh60crlj4Im1PKR+FdUod50xmnfBeMarDfmosqux6Nrr046zmAK74q
+p2Gc54sXPLp0TlpQNdUK+5NmSTQnakm3PhejUuT5TjjKaYRFqDBUQpldzj+XCKZR76mjPcJiBsIhopi
yJNi/JKIo47NOOXKxHnvTjIw4OpkvgTomNCRmQa1zmSUfElC3thKqCyRiO8PhoJ8Si3GvwDeOTfniypL
BG1WoshvftqdiQueXHT6DATQ4eJELkweNd1FKo6Mb8I+22pkjy7HFjECMQNBULwTEEaPsmhwBqBgWIME
Mk+mDvKsSimGNU4Vmt0ZOOfNwQUyPevJhsmtxmlXOupordKxCXtsq5BFJ5XM+4PAHyM3D3gmwPhuBuCg
dRe2D0dTDONQbt+AJrrMVkpKGxly0xb3DknNNKo6GglPU6EtAeqR5dg4FA7lh0BE0IhDewQIT0ndBHg1
A1Bvy2Imu461uytZu+c46/DWsY6JWtbpPcGufT3Jbn+rJ/MM1DhUKBtfh3xbPNpcVTgsFv6qHtGzClHL
ykg6kvYT6SOpT8skAI/pbBGbFt90y97GapxbUWZPwm46ZSadtsFZJq3NKR7T+YpvvP61mZXQvejHYpFK
L3qNOQxH7PslE/+2hRc3af/cwHRjMdKHjn9Noykph6z+Gf9vSYDRapZiiUIcJWUJxZn/NxRP5/x/i5s0
WcpZfH8IFBTDxS8FBD6nlJhlBBwTdYybh1Lni3gMnxDgrYyAcopfGHUu0AMSHpMeEqBXRkDxkFEaibGP
RA/I2EN6IReAssyNZtW8OReE31w2r8aW2OYjAAAAAElFTkSuQmCC
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAANqSURBVEhLrZVbSJNhGMe/mjhN1IWdpjPMssOitqklidPS
cksrmufyQAcPZWSKzqEZUla3UXQXXYyI6CaMrjpcmEV5KF31zXQt5k42Cxbdf/Hveb8meSEa+j3wh8H7
8v897/P+32/cQhV+U2aV35JhLrG10LbFFzNS29RC7qgeBz7oYeRJdj1KXXkiJLRt8SUCPqqFFf0cYt5y
iBvmkPA+DHW+AgkBvFqIHeCwengZkkbl0PIxaA8USwfYTgDWebJNjtSxWOwdX4urP6qkA+gIkGyLwK4x
BQyOeJr/JtwM1ksHOEWAdLsCBY4EHJ/cgnq3Fnd/NUkHaOW1gvGLCtXubWj0pKLVm4n7v8z/B5gv5zMq
fZXzu8q9Fec96bBM6XE5kA/rzzasehA5r5SPoqxih3kzGad8F47rUeTIRY3LgPPeI+jwl+JaoIZ+p6PT
n40rAQN6po2wBttwL2gWQXeCTbjxoxZXpivR7i+hERai0V0OZW8URAAzj3lDGR/koBoNh4ZiyJJi+pqM
k+7tuODNwMWpfWRgxPXpAhFw+Vs+melR79Gi7GsK8ibWQWOPQeJIOBTkU243/QOwzpk5W9TYo2mzEsUh
82ZfBrr8uegJGAmQj0vfcmH2Z9FdpOHEpBpHnRuQM74GO/hoxI+GQTHEIZIeZfGHWYDCMT3Wk7mWOshz
KMUY1nk0aPHtRufUXnSRaYc/B2ZfFpq9u9BAa9VuNQ47k5BNJxXNR8LAHiMzX/aMg2loFuCYYz/2jMVR
DFWodG1FE11mGyXFQobMtNWXKaqFRtVAI2FpOuRcj6zPa7DtUxSU72SIphFH9HHgnpJ6CfB6FuAs5dzM
pwrdfDXpNKmBVE86Qzon3P5+lsx3o86tQcXkZhQ4E2Hx1qCwL+d3LZ8mVPE6oYKUStJ9JL0nDeoEEcBi
OlfEZsQ2dfMWoc6zExWuFBykU2bQaRs9FeLavGIxXajYxm6+RSijezFMJCCNXvRGWyROuIpEk9C2xddf
QKOQPxEvfujY1zSOknLcEZrxUusvoFbQ2WOhoqSspDiz/4aSmZwvtZhJE18pJI7IoaAYrnjJQfacUmKT
EHCKEsbMI6jz5SyGTwgwICGgkuIXSZ1z9IC4x6SHBOiXEFDyySSOxDRIogdk6iO9kApAWWZGc2rBnHPc
H0WkrMjY2947AAAAAElFTkSuQmCC
</value>
</data>
<data name="MENU_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN9SURBVEhLrZVZSJRRGIZ/U1wSdcK2cYmyzYyayTQrHStn
cdKKJi3NjRaXMrJEJ9EMyza6CqO76EIiopsoumq5qIjSSp3yn1FHbZzNxgSj+yNv3/kZyQvRsP+DFwbO
4X2+8533/CPMVcFtge0hdwIxk/iaf9v8ixulWtQsq0cD/VcNjCLJqsFhh1aC+LfNv7jJ9m9qtvCdgMiP
AqI/C4jtCkKFJ0c+QLqoZlEdApZ8DsDKnhCoxUhc8OXJB8gkAO88wRKCZFsUdvcvw7XxEvkAOjGVJVhC
kWpTINseQ/Nfg7aJSvkAJ8R0lmJVIMcei6KR9ah0qnH/d418gDqblhkH41Dq3IBqVzLq3Dvx8Lf53wCz
5XxKp2z6yRJnIs66UtAwqsEVnwHtv+qx+FHYrFI+CW+XOtROZZzynduvwSF7Fsoc2TjrPoBG72Fc95XR
7xQ0eTPR6svG1TEj2ifq8WDCLIHuTdTg9ng5WseKccGbTyPMRbWzAMqn4ZAA3DzyA2W8U0BcTzBUFEOe
FNNwAo47N+KcOw0XR/eQgRE3xnIkwJUfBjLToNKlxpHhtdAOLIfKGon47mAoyKfAavoL4J1zc76oskbQ
ZiXy/ObnPWlo9mbhqs9IAAMu/ciC2ZtBd7EVx0aScHBoFXb1L8UmMQIxPUFQfBIQRo8y7+s0QK5NgxVk
rqYOtHalFMMKlwq1nm1oGt2NZjJt9O6C2ZOB8+5UVNFaqTMJ+4dWIpNOKpl3B4E/Rm4e8FKA6dM0wFG7
Djts0RTDOBQ7ElFDl1lPSWkgQ25a59kpqZZGVUUj4WnaN7QCGX1LsaE3HMovgYigEYe+ESC8ID0lwPtp
gNODGmb+rmct7lLW4jnJLnur2OXRStbqPcVuDp9hd3+eJvNtqHCqUDiyDjlD8Whwl6GsN3ey3GZgJaKO
FZL0JN03UhepU8ckAI/pTBGbEt/U9r2BVbg2o9CxFnvplGl02mpXobQ2q3hM5yq+8dZwLTtC95I9EIut
9KJXW8JwzHFIMvFvm39xkxZ7NTMMxEgfOv41jaakFNn9M/7fkgB95WyLNQpxlJRFFGf+35A/lfP/LW5S
Ixaz+O4QKCiGC98KCHxFKbHICDgh6hk3D6XOF/AYPidAh4yAYopfGHUu0AMSnpEeE+CdjID8XpM0ElMn
iR6Q6Q3ptVwAyjI3mlFz5lwQ/gBru6+QfGvWdQAAAABJRU5ErkJggg==
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN5SURBVEhLrZVJTFNRFIafljBIgBqcymAU54oWGSRCK1oU
KqixAoIyiMqgGBAChYCaOsed0bgzLogxxo3RuHJYqDEqKFD1tUItKZ2gaIJxf8nvuc8SWRAw8E7yp03u
zf+de95/3xNmquCbis6QWwpMJb4W2Db74kaJFjXT9+mw+7MOBpFk1aHImS1BAttmX9xE80XNFrwREPle
QPRHAbE9Qaj25skHSBbVLOqDgMUf52FFXwiSxEi0+gvkA6QRgHeeYAlBsi0KO/qX4srPMvkAmWIiS7CE
Is2mRK49hua/GjfHauQDHBeTWapViTx7LI4MrUONKwl3fzfIB2gWM5jhexzKXRtQ505GsycD93+b/g8w
Xc4ndLQna7zMtR717lS0Detw0Z+Dzl8tWPQgbFqpHoV3Sh1mT2Sc8p3fr8NBux4VzlzUe/aj3VeEq/4K
+p+KDt92XPLn4vKoAZ1jLbg3ZpJAd8YacONnFS6NlqLVV0gjzEedqxiqx+GQANw88h1lvEtAXF8wNBRD
nhTjYAKOuTbijCcdZ4d3koEB10bzJMDFkRwy06HGnYRDg2uQPbAMGmsk4nuDoSSfYqvxH4B3zs35osYa
QZtVKAiYN3rTcc6nx2W/gQA5OD+ih8mnpWeRgsohNQ44ViKrfwk2iRGI6QuCsltAGF3Kgs+TAPk2HZaT
eRJ1kG1XSTGsdmvQ5N2KjuEdOEem7b4smLxaNHrSUEtr5S419jlWYDudVDLvDQK/jNx83nMBxu5JgMP2
Xdhmi6YYxqHUuR4N9DBbKCltZMhNm70ZkppoVLU0Ep6mvY7l0H5bgg1fw6H6pEAEjTj0lQDhGekxAd5O
ApwSU5nJqmVmezkzfz/BzI5aZh6sod+TzCyeZrd/nCLzrah2aVAytBZ5jni0eSpQ1K0frxJ1rEzMZCUk
LSnzC6mH1JXJJACP6VQRmxDfdN3axqrdm1HiXIM9dMp0Om2du0Ram1Y8pjMV33hBbGKH6LnkDsQihW70
KksYKp0HJZPAttkXNzGLdSxnIEZ60fG3aTQl5Yg9MOO51l9AFdtijUIcJWUhxZl/Gwoncj7X4iYNYimL
7w2BkmK44LUAxQtKiUVGwHFRy7h5KHU+n8fwKQE+yAgopfiFUecCXSDhCekhAd7ICCj8apRGYuwi0QUy
viK9lAtAWeZGU2rGnAvCHy5drfKWDYjrAAAAAElFTkSuQmCC
</value>
</data>
<data name="BTT_STOP.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVESURBVEhLjZVrTJNXGMcLQmdHO6AdarLSOcQBQgv0raV1
XnBcpGjBlgo6RtSMiisoXlCiGI3RxMVLsmQftg/bhy0zmXFLdFk2JoyaOYFMGKiwlIsOaym9F152SRbo
2f+UVmcsG0/yy9v3nOf8n3+fc9735dDoLyqKM6ekfHxz2bKRGxLJR5vF4lcwHBOc/J8YVipVv0kkt0aX
Lu27lppqwFAciApO0hgwmfh3ioq+HG5uJmOXLpHepqbADZWqI08gWInp2LmsyGFhmLX2HTsesefPk+mL
F8lIZaX3g/T0ekl8fCKm54p0rFjx4dChQ+Th6dNk7NQpYkOy9ehR0qpS3ZIJBK8jJWKRUbX6TYhb2QsX
CIu1bEsLmT55kgxptb6vxeL3kSIEMZybIpGNij9saiKPjh8nNiRNnDtH7jc3B24olT9JBYI0JD5TBG0p
tldV2ahzKj4NcfbIETINY/6aGmJOShpEmgoIOO3JyZdHamvJGApYge3YMWLHAufZs2QQ7WpXqbqy+Px0
JAeLDMvlxROVlbap994jLMxMwxSLddMHD5LJvXtJq1Lp3ikSXUVqKRBy9MuXv9qqUNzq2b078BhJ42AC
bpzYEw9a5jp8mNxEkVw+P+MXhikaNxjsU2fOBFvCwjGL9rKNjWQK4ubcXG8aj/cZhI1ABuiGc2IZkSgd
RbqsO3cS+759xNHQQJwHDhA3ivkgZGloCHSr1XcflJfb2BMngo5ZzLHIZevrn4hn8HiXoVcLMkPi0SAY
3FyhMON7ubzzXnV1wFFXR1zAYzIRLwT8KObfv59Mwe0UFcY9i/ugONrbqVD4ZHw+FafOV4HF4OlRDQVX
KRSuas/O7rJv20Zcu3YRD/AZjcQPh5MoOIkNnCwvJ/6NG4lfrSZe0JmX588RCK5g/R5AnfPAc+Lh4K5O
TMxsl8m6BtaunfFu3048Gg3xMAxxi8XELRAQd2wscS9aRCx8fqAtJcWnSkigG1oHssCLYF7xcATbdUcm
65+AoANiTuACVDhITAzpy87+y5Ce/i3y3wVSsCDxYNhrakx2tdrq4PGeFwd0bCA1dcas1T7ISE4ux5J4
sDBxv9F42F1Q4HbA/Xzi4+ARsGZmkj6dbvCtNWtysPQ/XyvB8BiNLa5NmzyOuLjnxF3oPW0XFR8DI9HR
ZAB05+QE+isqfjWoVLRN8xfx7dlz3FlS4o3k3CUSkcclJX8PpqUFqPhwSLwXdIIfGWa2n/6T+YrgKLY4
Cgp8Dj4/KPxMW5YsIZbS0t/PrF/f3btly4Q1I4Pch2gPuE3FgZmyevXszwbD3QKZjL4gn77qvbW1zVTc
GUk8KYlYNmz4o55h2pHaUJKV9fZgWdkDC3ofFu8AbaCVFlEqZ7srKno/1WrpxnNBFMe7davNmZAQ2TnE
6+TyNiSaAN1I4YH8/Df69PrRu1LpE/HvwDfgOuiXSmd69Poh5C4HXI5Dp7N4JZKIzk0M8wOS6kPi4S8V
92BhoaqvomK0XSoN/Fv8q6go0pOVNWPWaMaRVwQSOd3V1TsmNBqPB6Jh5wPFxX/uiyweDm5jfn4eNnbk
TnY2uRYSN+flzX6h0TwuXbnyE+TMFUAsbqusPGErK/MNqVQB6rxRoejA+Hzi4eAa162T03a0YZ1ZrZ69
Cucv8XgXMacDcy1CRDEpKfG9ev3nD8vKXFcKC3H6ohsxzgA+nadJ8wT3elXVO/d0uvHbWq27JC2Nfgv0
QAzocX2ylv5IAAqwOXRd6OP/AqBHk56cLeA1EPGBWwSoY/qxpld6v5CgJuj7/+UQtGDIGIfzD+o72WmD
vfrkAAAAAElFTkSuQmCC
</value>
</data>
<data name="BTT_DELETE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVCSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3ltZN
xfEiRQu2VNAxomZUXEHxBSWK0RhNNIrJkn3YPmwftsxkxi3RzWxMGCVTgYiMsuGCgA5rKX0vXPaSLNKz
/ymtzlg2nuSX23vOc/7Pv885914ODXNRUYwpKenjrmXLRq9LJB9tFItfwXBUYPJ/YkShUP4mkdwYW7p0
4Epysh5DMSAiMEljyGjk9xUVfTnS3EzGL1wgt5qa/NeVys48gWAlpqPnssLHMMO8adu27SF77hyZaW0l
o5WVng9SU+slsbHxmJ4r0rlixYf3DhwgD06eJOMnThArki2HD5M2pfKGVCB4HSlhi4ypVG9B3MKeP09Y
rGVbWsjM8ePknkbj/Vosfh8pQhDF6RKJrFT8QVMTeXj0KLEiafLMGdLX3Oy/rlDczBIIUpD4TBG0pdhW
VWWlzqn4DMTZQ4fIDIz5amqIKSHhLtKUQMDpSEy8OFpbS8ZRwAKsR44QGxY4Tp8m/WhXh1LZk8nnpyI5
UGREJiuerKy0Tp89S1iYmYEpFutm9u8nU7t3kzaFwrVdJLqM1FIg5OiWL3+1TS6/cXPnTv8jJE2ASbhx
YE/caJnz4EHShSK5fH7aTwxTNKHX26ZPnQq0hIVjFu1lGxvJNMRNubmeFB7vMwgbgBTQDedEMyJRKor0
WLZvJ7Y9e4i9oYE49u0jLhTzQsjc0ODvVakG75eXW9ljxwKOWcyxyGXr65+Ip/F4F6FXCzKC4pEgENxc
oTDte5ms+3Z1td9eV0ecwG00Eg8EfCjm27uXTMPtNBXGPYv7gDja2y2Xe6V8PhWnztPBYvD0qAaDqxAK
0zuys3tsW7YQ544dxA28BgPxweEUCk5hA6fKy4lv/XriU6mIB3Tn5flyBIJLWL8LUOc88Jx4KLir4uMz
OqTSniG5/LFn61biVquJm2GISywmLoGAuKKjiWvRImLm8/3tSUleZVwc3dA6kAleBPOKhyLQrj6p1DwJ
QTvEHMAJqHCAqCgykJ39lz419VvkvweywILEA2GrqTHaVCqLncd7XhzQsaHk5McmjeZ+WmJiOZbEgoWJ
+wyGg66CApcd7ucTnwAPgSUjgwxotXffXr06B0v/87USCLfB0OLcsMFtj4l5TtyJ3tN2UfFxMBoZSYZA
V06O31xR8ateqaRtmr+Id9euo46SEk84506RiDwqKfm7PyXFT8VHguL9oBuYGGbWTP/JfEVwFFvsBQVe
O58fEH6mLUuWkOHS0t9PrV3b279p06QlLY38AtE74Bb4kRagrFo1e1uvHyyQSukL8umr3lNb20zFHeHE
ExLI8Lp1f9QzTAdSG0oyM9+5W1Z2fxi9D4l3gnbQRosoFLO9FRX9n2o0dOO5IILj2bzZ6oiLC+8c4nUy
WTsSjYBupHBffv4bAzrd2GBW1hPx78A1cBWY09Mf39Hp7iF3OeBy7FrtsEciCevcyDA/IKk+KB76UnH3
FxYqByoqxq5lZfn/Lf5VRAS5gwImtXoCeUUgntNbXb1tUq12uyEacj5UXPznnvDioeA25ufnYWNH+7Kz
yZWguCkvb/YLtfpR6cqVnyBnrgBicXtl5TFrWZl3UKn0U+eNcnknxucTDwXXsGaNjLbjG6wzqVSzl+H8
JR6vFXNaMNciRASTlBTbr9N9/qCszHmpsBCnL7IR4wzg03maNE9wr1ZVvfuzVjtxS6NxlaSk0G+BDogB
Pa5P1tIfcUAONgavC338XwD0aNKTswm8BsI+cIsAdUw/1vRK7xcS1AR9/78chBYMGuNw/gGBHdjskDgc
+QAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_CLEAR_DONE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVCSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3ltZN
xfEiRQu2VNAxomZUXEHxBSWK0RhNNIrJkn3YPmwftsxkxi3RzWxMGCVTgYiMsuGCgA5rKX0vXPaSLNKz
/ymtzlg2nuSX23vOc/7Pv885914ODXNRUYwpKenjrmXLRq9LJB9tFItfwXBUYPJ/YkShUP4mkdwYW7p0
4Epysh5DMSAiMEljyGjk9xUVfTnS3EzGL1wgt5qa/NeVys48gWAlpqPnssLHMMO8adu27SF77hyZaW0l
o5WVng9SU+slsbHxmJ4r0rlixYf3DhwgD06eJOMnThArki2HD5M2pfKGVCB4HSlhi4ypVG9B3MKeP09Y
rGVbWsjM8ePknkbj/Vosfh8pQhDF6RKJrFT8QVMTeXj0KLEiafLMGdLX3Oy/rlDczBIIUpD4TBG0pdhW
VWWlzqn4DMTZQ4fIDIz5amqIKSHhLtKUQMDpSEy8OFpbS8ZRwAKsR44QGxY4Tp8m/WhXh1LZk8nnpyI5
UGREJiuerKy0Tp89S1iYmYEpFutm9u8nU7t3kzaFwrVdJLqM1FIg5OiWL3+1TS6/cXPnTv8jJE2ASbhx
YE/caJnz4EHShSK5fH7aTwxTNKHX26ZPnQq0hIVjFu1lGxvJNMRNubmeFB7vMwgbgBTQDedEMyJRKor0
WLZvJ7Y9e4i9oYE49u0jLhTzQsjc0ODvVakG75eXW9ljxwKOWcyxyGXr65+Ip/F4F6FXCzKC4pEgENxc
oTDte5ms+3Z1td9eV0ecwG00Eg8EfCjm27uXTMPtNBXGPYv7gDja2y2Xe6V8PhWnztPBYvD0qAaDqxAK
0zuys3tsW7YQ544dxA28BgPxweEUCk5hA6fKy4lv/XriU6mIB3Tn5flyBIJLWL8LUOc88Jx4KLir4uMz
OqTSniG5/LFn61biVquJm2GISywmLoGAuKKjiWvRImLm8/3tSUleZVwc3dA6kAleBPOKhyLQrj6p1DwJ
QTvEHMAJqHCAqCgykJ39lz419VvkvweywILEA2GrqTHaVCqLncd7XhzQsaHk5McmjeZ+WmJiOZbEgoWJ
+wyGg66CApcd7ucTnwAPgSUjgwxotXffXr06B0v/87USCLfB0OLcsMFtj4l5TtyJ3tN2UfFxMBoZSYZA
V06O31xR8ateqaRtmr+Id9euo46SEk84506RiDwqKfm7PyXFT8VHguL9oBuYGGbWTP/JfEVwFFvsBQVe
O58fEH6mLUuWkOHS0t9PrV3b279p06QlLY38AtE74Bb4kRagrFo1e1uvHyyQSukL8umr3lNb20zFHeHE
ExLI8Lp1f9QzTAdSG0oyM9+5W1Z2fxi9D4l3gnbQRosoFLO9FRX9n2o0dOO5IILj2bzZ6oiLC+8c4nUy
WTsSjYBupHBffv4bAzrd2GBW1hPx78A1cBWY09Mf39Hp7iF3OeBy7FrtsEciCevcyDA/IKk+KB76UnH3
FxYqByoqxq5lZfn/Lf5VRAS5gwImtXoCeUUgntNbXb1tUq12uyEacj5UXPznnvDioeA25ufnYWNH+7Kz
yZWguCkvb/YLtfpR6cqVnyBnrgBicXtl5TFrWZl3UKn0U+eNcnknxucTDwXXsGaNjLbjG6wzqVSzl+H8
JR6vFXNaMNciRASTlBTbr9N9/qCszHmpsBCnL7IR4wzg03maNE9wr1ZVvfuzVjtxS6NxlaSk0G+BDogB
Pa5P1tIfcUAONgavC338XwD0aNKTswm8BsI+cIsAdUw/1vRK7xcS1AR9/78chBYMGuNw/gGBHdjskDgc
+QAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_CLEAR_ALL.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVCSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3ltZN
xfEiRQu2VNAxomZUXEHxBSWK0RhNNIrJkn3YPmwftsxkxi3RzWxMGCVTgYiMsuGCgA5rKX0vXPaSLNKz
/ymtzlg2nuSX23vOc/7Pv885914ODXNRUYwpKenjrmXLRq9LJB9tFItfwXBUYPJ/YkShUP4mkdwYW7p0
4Epysh5DMSAiMEljyGjk9xUVfTnS3EzGL1wgt5qa/NeVys48gWAlpqPnssLHMMO8adu27SF77hyZaW0l
o5WVng9SU+slsbHxmJ4r0rlixYf3DhwgD06eJOMnThArki2HD5M2pfKGVCB4HSlhi4ypVG9B3MKeP09Y
rGVbWsjM8ePknkbj/Vosfh8pQhDF6RKJrFT8QVMTeXj0KLEiafLMGdLX3Oy/rlDczBIIUpD4TBG0pdhW
VWWlzqn4DMTZQ4fIDIz5amqIKSHhLtKUQMDpSEy8OFpbS8ZRwAKsR44QGxY4Tp8m/WhXh1LZk8nnpyI5
UGREJiuerKy0Tp89S1iYmYEpFutm9u8nU7t3kzaFwrVdJLqM1FIg5OiWL3+1TS6/cXPnTv8jJE2ASbhx
YE/caJnz4EHShSK5fH7aTwxTNKHX26ZPnQq0hIVjFu1lGxvJNMRNubmeFB7vMwgbgBTQDedEMyJRKor0
WLZvJ7Y9e4i9oYE49u0jLhTzQsjc0ODvVakG75eXW9ljxwKOWcyxyGXr65+Ip/F4F6FXCzKC4pEgENxc
oTDte5ms+3Z1td9eV0ecwG00Eg8EfCjm27uXTMPtNBXGPYv7gDja2y2Xe6V8PhWnztPBYvD0qAaDqxAK
0zuys3tsW7YQ544dxA28BgPxweEUCk5hA6fKy4lv/XriU6mIB3Tn5flyBIJLWL8LUOc88Jx4KLir4uMz
OqTSniG5/LFn61biVquJm2GISywmLoGAuKKjiWvRImLm8/3tSUleZVwc3dA6kAleBPOKhyLQrj6p1DwJ
QTvEHMAJqHCAqCgykJ39lz419VvkvweywILEA2GrqTHaVCqLncd7XhzQsaHk5McmjeZ+WmJiOZbEgoWJ
+wyGg66CApcd7ucTnwAPgSUjgwxotXffXr06B0v/87USCLfB0OLcsMFtj4l5TtyJ3tN2UfFxMBoZSYZA
V06O31xR8ateqaRtmr+Id9euo46SEk84506RiDwqKfm7PyXFT8VHguL9oBuYGGbWTP/JfEVwFFvsBQVe
O58fEH6mLUuWkOHS0t9PrV3b279p06QlLY38AtE74Bb4kRagrFo1e1uvHyyQSukL8umr3lNb20zFHeHE
ExLI8Lp1f9QzTAdSG0oyM9+5W1Z2fxi9D4l3gnbQRosoFLO9FRX9n2o0dOO5IILj2bzZ6oiLC+8c4nUy
WTsSjYBupHBffv4bAzrd2GBW1hPx78A1cBWY09Mf39Hp7iF3OeBy7FrtsEciCevcyDA/IKk+KB76UnH3
FxYqByoqxq5lZfn/Lf5VRAS5gwImtXoCeUUgntNbXb1tUq12uyEacj5UXPznnvDioeA25ufnYWNH+7Kz
yZWguCkvb/YLtfpR6cqVnyBnrgBicXtl5TFrWZl3UKn0U+eNcnknxucTDwXXsGaNjLbjG6wzqVSzl+H8
JR6vFXNaMNciRASTlBTbr9N9/qCszHmpsBCnL7IR4wzg03maNE9wr1ZVvfuzVjtxS6NxlaSk0G+BDogB
Pa5P1tIfcUAONgavC338XwD0aNKTswm8BsI+cIsAdUw/1vRK7xcS1AR9/78chBYMGuNw/gGBHdjskDgc
+QAAAABJRU5ErkJggg==
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVCSURBVEhLjZVtTFNXGMcLQmdHO6AdarLCHOJ4L9Bby62b
iuNFihZsqaBjRM2ouILiC0oUozGauPiSLNmH7cP2YctMZtwSdcvGhFEzFJjCihsuCOiwltL3wmUvySI9
+5/S6oxl40l+ub3nPOf//Pucc+/l0RgoLo4xJSd/dG3JkpGrSUkfrpdKX8JwVGDyf2JYqWR/S0rqGl28
2HwpJUWPoRgQEZikMWg0Cm8VF38x3NJCxs6dI9ebm/1XWbYzXyRajuno2azwMcQwr9u2bHnAnT5Nps+e
JSNVVZ7309IakmJj4zE9W6Rz2bIP7u7bR+4fP07Gjh0jViRbDh4kbSzbJROJXkVK2CKjKtUbELdwZ84Q
Dmu51lYyffQouavReK9Ipe8hRQyieNckEisVv9/cTB4cPkysSJo4dYrcbGnxX1Uqr2eLRKlIfKoI2lJi
q662UudUfBri3IEDZBrGfLW1xJSQcAdpLBDxOhITz4/U1ZExFLAA66FDxIYFjpMnSR/a1cGyPVlCYRqS
A0WG5fKSiaoq69S77xIOZqZhisO66b17yeTOnaRNqXRtlUguIrUMiHm6pUtfblMourq2b/c/RNI4mIAb
B/bEjZY59+8n11AkTyhM/4lhisf1etvUiROBlnBwzKG9XFMTmYK4KS/PkyoQfAphA5ABuuG8aEYiSUOR
HsvWrcS2axexNzYSx549xIViXgiZGxv9vSrV7XsVFVbuyJGAYw5zHHK5hobH4ukCwXno1YHMoHgkCAQ/
TyxO/04u7/6xpsZvr68nTuA2GokHAj4U8+3eTabgdooK457DfUAc7e1WKLwyoZCKU+cZYCF4clSDwVeK
xRkdOTk9tk2biHPbNuIGXoOB+OBwEgUnsYGTFRXEt3Yt8alUxAO68/N9uSLRBazfAahzAXhGPBT8FfHx
mR0yWc8gwzzybN5M3Go1cTMMcUmlxCUSEVd0NHEtWEDMQqG/PTnZy8bF0Q2tB1ngeTCneCgC7bolkw1M
QNAOMQdwAiocICqKmHNy/tKnpX2D/HdANpiXeCBstbVGm0plsQsEz4oDOjaYkvLIpNHcS09MrMCSWDA/
cZ/BsN9VWOiyw/1c4uPgAbBkZhKzVnvnzZUrc7H0P18rgXAbDK3Odevc9piYZ8Sd6D1tFxUfAyORkWQQ
mHJz/QOVlb/qWZa2ae4i3h07DjtKSz3hnDslEvKwtPTvvtRUPxUfDor3g25ahGFmBug/masIjmKrvbDQ
axcKA8JPtWXRIjJUVvb7idWre/s3bJiwpKeTXyDaB26AH2gByooVMzf1+tuFMhl9QT551Xvq6lqouCOc
eEICGVqz5o8GhulAamNpVtZbd8rL7w2h9yHxTtAO2mgRpXKmt7Ky/xONhm48H0TwPBs3Wh1xceGdQ7xe
Lm9HohHQjRTvKSh4zazTjd7Ozn4s/i34GlwGAxkZj/p0urvIXQr4PLtWO+RJSgrr3Mgw3yOpISge+lLx
9xYVsebKytGvsrP9/xb/MiKC9KGASa0eR14xiOf11tRsmVCr3W6IhpwPlpT8uSu8eCj4TQUF+djYkVs5
OeRSUNyUnz/zuVr9sGz58o+RM1sAsbC9quqItbzcO8Cyfuq8SaHoxPhc4qHgG1atktN2XME6k0o1cxHO
XxAIzmJOC2ZbhIhgkpNj+3W6z+6XlzsvFBXh9EU2YZwBQjpPk+YI/uXq6rd/1mrHb2g0rtLUVPot0AEp
oMf18Vr6Iw4owPrgdb6P/3OAHk16cjaAV0DYB24BoI7px5pe6f18gpqg7/8Xg9CCQWM83j84CNjeVkuE
bAAAAABJRU5ErkJggg==
</value>
</data>
<data name="BTT_LOG.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">

View File

@@ -237,8 +237,7 @@ Namespace DownloadObjects.STDownloader
Protected Overridable Sub BTT_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS.Click
MyYouTubeSettings.ShowForm(AppMode)
End Sub
Protected Overridable Sub BTT_ADD_KeyClick(ByVal Sender As ToolStripMenuItemKeyClick, ByVal e As KeyClickEventArgs) Handles BTT_ADD.KeyClick, BTT_ADD_PLS_ARR.KeyClick,
BTT_ADD_NO_SHORTS.KeyClick, BTT_ADD_SHORTS_ONLY.KeyClick
Protected Overridable Sub BTT_ADD_KeyClick(ByVal Sender As ToolStripMenuItemKeyClick, ByVal e As KeyClickEventArgs) Handles BTT_ADD.KeyClick, BTT_ADD_PLS_ARR.KeyClick
Dim pForm As ParsingProgressForm = Nothing
Try
Dim useCookies As Boolean = MyYouTubeSettings.DefaultUseCookies
@@ -247,11 +246,11 @@ Namespace DownloadObjects.STDownloader
If e.Control Then useCookies = True
Dim useCookiesParse As Boolean? = Nothing
If useCookies Then useCookiesParse = True
Dim standardizeUrls As Boolean = MyYouTubeSettings.StandardizeURLs
Dim standardize As Func(Of String, String) = Function(input) If(standardizeUrls, YouTubeFunctions.StandardizeURL(input), input)
Dim c As IYouTubeMediaContainer = Nothing
Dim url$ = String.Empty
Dim GetDefault As Boolean = True
Dim GetShorts As Boolean = True
If sTag = "pls" Then
Using pf As New PlaylistArrayForm With {.DesignXML = DesignXML}
@@ -264,7 +263,7 @@ Namespace DownloadObjects.STDownloader
pForm.SetInitialValues(.Count, "Parsing playlists...")
Dim containers As New List(Of IYouTubeMediaContainer)
For Each u$ In .Self
containers.Add(YouTubeFunctions.Parse(u, useCookiesParse, pForm.Token, pForm.MyProgress, True, False))
containers.Add(YouTubeFunctions.Parse(standardize(u), useCookiesParse, pForm.Token, pForm.MyProgress))
pForm.NextPlaylist()
pForm.MyProgress.Perform()
Next
@@ -276,26 +275,53 @@ Namespace DownloadObjects.STDownloader
.IsMusic = containers.Any(Function(cc) cc.IsMusic)
}
c.Elements.AddRange(containers)
Dim path$ = c.Elements(0).File.PathWithSeparator
For Each list As List(Of String) In {
c.Elements.Select(Function(cc) cc.UserTitle).ListWithRemove(Function(cc) cc.IsEmptyString).ListIfNothing,
c.Elements.Select(Function(cc) cc.PlaylistTitle).ListWithRemove(Function(cc) cc.IsEmptyString).ListIfNothing
}
If list.Count > 0 AndAlso
(list.Count = 1 OrElse
ListAddList(Nothing, list, LAP.NotContainsOnly, EDP.ReturnValue).ListIfNothing.Count = 1) Then _
path &= $"{list(0)}\"
Next
c.File = path
End If
End If
End With
End If
End Using
Else
Select Case sTag
Case "ans" : GetShorts = False
Case "as" : GetDefault = False : GetShorts = True
End Select
url = BufferText
If url.IsEmptyString OrElse Not YouTubeFunctions.IsMyUrl(url) Then url = InputBoxE("Enter a valid URL to the YouTube video:", "YouTube link")
End If
If Not c Is Nothing OrElse YouTubeFunctions.IsMyUrl(url) Then
If c Is Nothing Then
Dim downAsIs As Boolean = False
Dim channelTab As YouTubeChannelTab? = Nothing
Dim __channelTab As YouTubeChannelTab = YouTubeChannelTab.All
Dim oType As YouTubeMediaType = YouTubeFunctions.Info_GetUrlType(url,,,,, __channelTab)
If oType = YouTubeMediaType.Channel Then
channelTab = __channelTab
Using channelTabForm As New ChannelTabsChooserForm(__channelTab, url) With {.DesignXML = DesignXML}
With channelTabForm
.ShowDialog()
If .DialogResult = DialogResult.OK Then
channelTab = .Result
downAsIs = .MyUrlAsIs
url = YouTubeFunctions.StandardizeURL_Channel(.URL, Not downAsIs)
Else
Exit Sub
End If
End With
End Using
End If
pForm = New ParsingProgressForm
pForm.Show(Me)
pForm.SetInitialValues(1, "Parsing data...")
c = YouTubeFunctions.Parse(url, useCookiesParse, pForm.Token, pForm.MyProgress, GetDefault, GetShorts)
c = YouTubeFunctions.Parse(standardize(url), useCookiesParse, pForm.Token, pForm.MyProgress,,, channelTab,
oType <> YouTubeMediaType.Channel Or downAsIs)
pForm.Dispose()
End If
If Not c Is Nothing Then
@@ -313,7 +339,7 @@ Namespace DownloadObjects.STDownloader
If Not f Is Nothing Then
If TypeOf f Is IDesignXMLContainer Then DirectCast(f, IDesignXMLContainer).DesignXML = DesignXML
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then ControlCreateAndAdd(c, disableDown)
If f.DialogResult = DialogResult.OK AndAlso ValidateContainerURL(c) Then ControlCreateAndAdd(c, disableDown)
f.Dispose()
End If
End If
@@ -327,6 +353,61 @@ Namespace DownloadObjects.STDownloader
If Not pForm Is Nothing Then pForm.Dispose()
End Try
End Sub
Protected Function ValidateContainerURL(ByVal c As IYouTubeMediaContainer) As Boolean
Try
If Not c Is Nothing AndAlso Not c.IsMusic Then
Dim urls As List(Of String) = Nothing
Dim files As List(Of SFile) = Nothing
Dim msg As New MMessage("The media file to be added is already downloaded. Do you want to download it again?", "Download media file", {"Process", "Cancel"}, vbExclamation)
If TP_CONTROLS.Controls.Count > 0 Then
With TP_CONTROLS.Controls.Cast(Of MediaItem)
urls.ListAddList(.SelectMany(Function(ByVal m As MediaItem) As IEnumerable(Of String)
If Not m.MyContainer Is Nothing Then
Return DirectCast(m.MyContainer, YouTubeMediaContainerBase).GetUrls()
Else
Return New String() {}
End If
End Function), LAP.NotContainsOnly, EDP.ReturnValue)
files.ListAddList(.SelectMany(Function(ByVal m As MediaItem) As IEnumerable(Of SFile)
If Not m.MyContainer Is Nothing Then
Return DirectCast(m.MyContainer, YouTubeMediaContainerBase).GetFiles()
Else
Return New SFile() {}
End If
End Function), LAP.NotContainsOnly, EDP.ReturnValue)
End With
End If
If urls.ListExists Then
Dim cUrls As New List(Of String)
cUrls.ListAddList({c.URL, c.URL_BASE}, LAP.NotContainsOnly)
If urls.ListContains(cUrls) Then Return msg.Show = 0
End If
If files.ListExists And Not c.File.IsEmptyString Then Return Not files.Contains(c.File) OrElse msg.Show = 0
If c.ObjectType = YouTubeMediaType.Single AndAlso c.File.Exists Then
Dim callBack As MsgBoxButtonCallBack = Sub(r, m, b)
Dim __sfo As SFO = IIf(r.Button.CallBackObject = 0, SFO.File, SFO.Path)
If __sfo = SFO.File Then
c.File.Open(__sfo)
Else
GlobalOpenPath(c.File)
End If
End Sub
Return MsgBoxE(New MMessage("The following file already exists at the destination." & vbCr &
"Do you want to download it again?" & vbCr & vbCr &
$"File: {c.File}", "Download media file",
{"Process",
New MsgBoxButton("Open file") With {.IsDialogResultButton = False, .CallBackObject = 0, .CallBack = callBack},
New MsgBoxButton("Open folder") With {.IsDialogResultButton = False, .CallBackObject = 1, .CallBack = callBack},
"Cancel"}, vbExclamation) With {.ButtonsPerRow = 4}) = 0
End If
urls.ListClearDispose
files.ListClearDispose
End If
Return True
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[VideoListForm.ValidateContainerURL]", True)
End Try
End Function
Private Sub BTT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_DOWN.Click
With TP_CONTROLS
If .Controls.Count > 0 Then
@@ -341,15 +422,33 @@ Namespace DownloadObjects.STDownloader
ControlInvoke(TOOLBAR_TOP, BTT_STOP, Sub() BTT_STOP.Enabled = False, EDP.SendToLog)
MyJob.Cancel()
End Sub
#Region "Delete / Clear"
Private Sub BTT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_DELETE.Click
RemoveControls(ControlsChecked, True)
End Sub
Private Sub BTT_CLEAR_SELECTED_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_SELECTED.Click
RemoveControls(ControlsChecked, False)
End Sub
Protected Overridable Sub BTT_CLEAR_DONE_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DONE.Click
RemoveControls(ControlsDownloaded, False)
End Sub
Protected Overridable Sub BTT_CLEAR_ALL_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_ALL.Click
RemoveControls(, False)
End Sub
Private Sub BTT_SELECT_ALL_Click(sender As Object, e As EventArgs) Handles BTT_SELECT_ALL.Click, BTT_SELECT_NONE.Click
Try
Dim checked As Boolean = sender Is BTT_SELECT_ALL
ControlInvokeFast(TP_CONTROLS, Sub()
With TP_CONTROLS.Controls
If .Count > 0 Then
For Each cnt As MediaItem In .Self : cnt.Checked = checked : Next
End If
End With
End Sub, EDP.None)
Catch
End Try
End Sub
#End Region
Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click
MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton)
End Sub
@@ -369,8 +468,10 @@ Namespace DownloadObjects.STDownloader
Try : Process.Start("https://github.com/AAndyProgram/SCrawler/blob/main/HowToSupport.md") : Catch : End Try
End Sub
Private Sub BTT_INFO_Click(sender As Object, e As EventArgs) Handles BTT_INFO.Click
ShowProgramInfo(MyYouTubeSettings.ProgramText.Value.IfNullOrEmpty("YouTube Downloader"),
My.Application.Info.Version, False, True, MyYouTubeSettings, True,, False, MyYouTubeSettings.ProgramDescription)
CheckVersionImpl(True)
End Sub
Protected Sub CheckVersionImpl(ByVal Force As Boolean)
CheckVersion(Force)
End Sub
Protected Overloads Sub RemoveControls(Optional ByVal Predicate As Predicate(Of MediaItem) = Nothing, Optional ByVal RemoveFiles As Boolean = False)
ControlInvokeFast(TP_CONTROLS, Sub()
@@ -423,16 +524,23 @@ Namespace DownloadObjects.STDownloader
RemoveControls(Sender, False)
End Sub
Private Sub MediaControl_DownloadAgain(ByVal Sender As MediaItem, ByVal Container As IYouTubeMediaContainer)
If Not Container.URL.IsEmptyString Then BufferText = Container.URL : BTT_ADD.PerformClick()
Try
If Not Container.URL.IsEmptyString Then BufferText = Container.URL : BTT_ADD.PerformClick()
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[VideoListForm.DownloadAgain]")
End Try
End Sub
Private Sub MediaControl_DownloadRequested(ByVal Sender As MediaItem, ByVal Container As IYouTubeMediaContainer)
AddToDownload(Sender, True)
End Sub
Private Sub MediaControl_CheckedChanged(ByVal Sender As MediaItem, ByVal Container As IYouTubeMediaContainer)
With TP_CONTROLS.Controls
ControlInvokeFast(TOOLBAR_TOP, BTT_DELETE,
Sub() BTT_DELETE.Enabled = .Count > 0 AndAlso .Cast(Of MediaItem).ListExists(Function(cnt) cnt.Checked), EDP.None)
End With
Try
With TP_CONTROLS.Controls
ControlInvokeFast(TOOLBAR_TOP, BTT_DELETE,
Sub() BTT_DELETE.Enabled = .Count > 0 AndAlso .Cast(Of MediaItem).ListExists(Function(cnt) cnt.Checked), EDP.None)
End With
Catch
End Try
End Sub
#End Region
#End Region
@@ -443,12 +551,16 @@ Namespace DownloadObjects.STDownloader
UpdateLogButton()
End Sub
Protected Sub AddToDownload(ByRef Item As MediaItem, ByVal RunThread As Boolean)
Dim hc% = Item.MyContainer.GetHashCode
If MyJob.Count = 0 OrElse Not MyJob.Items.Exists(Function(i) i.MyContainer.GetHashCode = hc) Then
MyJob.Add(Item)
Item.AddToQueue()
If RunThread Then StartDownloading()
End If
Try
Dim hc% = Item.MyContainer.GetHashCode
If MyJob.Count = 0 OrElse Not MyJob.Items.Exists(Function(i) i.MyContainer.GetHashCode = hc) Then
MyJob.Add(Item)
Item.AddToQueue()
If RunThread Then StartDownloading()
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[VideoListForm.AddToDownload]")
End Try
End Sub
Private Sub StartDownloading()
If Not MyJob.Working And MyJob.Count > 0 Then

View File

@@ -6,6 +6,7 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web
Imports PersonalUtilities.Functions.Messaging
@@ -38,19 +39,54 @@ Public Module MainModShared
End If
End Try
End Sub
Public Sub CheckNewReleaseFolder()
Try
Const updaterFolderName$ = "Updater\"
Dim f As SFile = SCrawler.Shared.NewReleaseFolderName.CSFileP
If f.Exists(SFO.Path, False) Then
Dim updater As SFile = updaterFolderName
Dim updaterNR As SFile = f.PathWithSeparator & updaterFolderName
If updaterNR.Exists(SFO.Path, False) Then
If updater.Exists(SFO.Path, False) Then updater.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.ReturnValue)
SFile.Move(updaterNR, updater, SFO.Path, True, SFODelete.DeletePermanently, EDP.ReturnValue)
End If
f.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.None)
End If
Catch ex As Exception
End Try
End Sub
Public Sub ShowProgramInfo(ByVal ProgramText As String, ByVal CurrentVersion As Version, ByVal CheckForUpdate As Boolean, ByVal Force As Boolean,
ByVal EnvirData As IDownloaderSettings, ByVal IsYouTube As Boolean,
Optional ByRef NewVersionDestination As String = Nothing, Optional ByVal ShowNewVersionNotification As Boolean = True,
Optional ByRef NewVersionDestination As String = Nothing, Optional ByRef ShowNewVersionNotification As Boolean = True,
Optional ByVal AdditText As String = Nothing)
Try
Dim GoToSite As New MsgBoxButton("Go to site") With {.CallBack = Sub(r, n, b) Process.Start("https://github.com/AAndyProgram/SCrawler/releases/latest")}
If CheckForUpdate AndAlso GitHub.NewVersionExists(CurrentVersion, "AAndyProgram", "SCrawler", NewVersionDestination) Then
If ShowNewVersionNotification Or Force Then
If MsgBoxE(New MMessage($"{ProgramText}: new version detected" & vbCr &
$"Current version: {CurrentVersion}" & vbCr &
$"New version: {NewVersionDestination}",
"New version",
{"OK", GoToSite, "Disable notifications"})) = 2 Then ShowNewVersionNotification = False
Dim b As New List(Of MsgBoxButton)
Dim updaterFile As SFile = Nothing
Dim updateBtt As New MsgBoxButton("Update", "Update the program using the updater") With {
.CallBack = Sub(r, n, btt)
Dim th As New Thread(Sub() Process.Start(New ProcessStartInfo(updaterFile, 1))) With {.IsBackground = True}
th.SetApartmentState(ApartmentState.MTA)
th.Start()
End Sub}
With SFile.GetFiles("Updater\", "*.exe",, EDP.ReturnValue).ListIfNothing
If .ListExists Then
With .FirstOrDefault(Function(f) f.Name = "Updater")
If Not .IsEmptyString Then updaterFile = .Self
End With
End If
End With
b.AddRange({"OK", GoToSite})
If Not updaterFile.IsEmptyString Then b.Add(updateBtt)
b.Add(New MsgBoxButton("Disable notifications") With {.CallBackObject = 10})
If AConvert(Of Integer)(
MsgBoxE(New MMessage($"{ProgramText}: new version detected" & vbCr &
$"Current version: {CurrentVersion}" & vbCr &
$"New version: {NewVersionDestination}",
"New version", b) With {.ButtonsPerRow = 4}).Button.CallBackObject, -1) = 10 Then _
ShowNewVersionNotification = False
End If
Else
If Force Then

View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("YouTube plugin environment")>
<Assembly: AssemblyCompany("AndyProgram")>
<Assembly: AssemblyProduct("SCrawler.YouTube")>
<Assembly: AssemblyCopyright("Copyright © 2023")>
<Assembly: AssemblyCopyright("Copyright © 2024")>
<Assembly: AssemblyTrademark("AndyProgram")>
<Assembly: ComVisible(False)>
@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2023.9.20.0")>
<Assembly: AssemblyFileVersion("2023.9.20.0")>
<Assembly: AssemblyVersion("2023.12.14.0")>
<Assembly: AssemblyFileVersion("2023.12.14.0")>
<Assembly: NeutralResourcesLanguage("en")>

View File

@@ -111,6 +111,7 @@ Namespace API.YouTube.Objects
_SiteKey = Key
End Set
End Property
<XMLEC> Public Property AccountName As String = String.Empty Implements IDownloadableMedia.AccountName
<XMLEC(Name_IsMusic)> Public Property IsMusic As Boolean = False Implements IYouTubeMediaContainer.IsMusic
<XMLEC> Public Property IsShorts As Boolean = False Implements IYouTubeMediaContainer.IsShorts
<XMLEC> Public Property ID As String Implements IYouTubeMediaContainer.ID, IUserMedia.PostID
@@ -495,6 +496,12 @@ Namespace API.YouTube.Objects
_IUserMedia_URL_BASE = u
End Set
End Property
Friend Function GetUrls() As IEnumerable(Of String)
Dim urls As New List(Of String)
urls.ListAddList({URL, IUserMedia_URL_BASE}, LAP.NotContainsOnly)
If HasElements And Not IsMusic Then urls.ListAddList(Elements.SelectMany(Function(elem As YouTubeMediaContainerBase) elem.GetUrls()), LAP.NotContainsOnly)
Return urls
End Function
Protected Overridable Sub GenerateFileName()
End Sub
Protected Function GetPlayListTitle() As String
@@ -530,7 +537,7 @@ Namespace API.YouTube.Objects
If ObjectType = YouTubeMediaType.Single AndAlso Not GetPlayListTitle.IsEmptyString Then _SpecialPath.StringAppend(GetPlayListTitle(), "\")
If Elements.Count > 0 Then Elements.ForEach(Sub(e) e.SpecialFolder = Path)
End Sub
<XMLEC> Friend ReadOnly Property Files As List(Of SFile) Implements IYouTubeMediaContainer.Files
<XMLEC> Protected Friend ReadOnly Property Files As List(Of SFile) Implements IYouTubeMediaContainer.Files
<XMLEC> Protected _File As SFile
<XMLEC> Protected Friend Property FileSetManually As Boolean = False
Public Property FileIgnorePlaylist As Boolean = False
@@ -542,6 +549,16 @@ Namespace API.YouTube.Objects
Return _FileIsPlaylistObject
End Get
End Property
Private _AbsolutePath As Boolean = False
Public Property AbsolutePath As Boolean
Get
Return _AbsolutePath
End Get
Set(ByVal ap As Boolean)
_AbsolutePath = ap
If Elements.Count > 0 Then Elements.ForEach(Sub(e As YouTubeMediaContainerBase) e.AbsolutePath = ap)
End Set
End Property
Public Overridable Property File As SFile Implements IYouTubeMediaContainer.File
Get
Return _File
@@ -549,11 +566,16 @@ Namespace API.YouTube.Objects
Set(ByVal f As SFile)
Select Case ObjectType
Case YouTubeMediaType.Channel : _File = f.Path
Case YouTubeMediaType.PlayList : _File.Path = $"{f.PathWithSeparator}{GetPlayListTitle()}"
Case YouTubeMediaType.PlayList
If AbsolutePath Then
_File.Path = f.Path
Else
_File.Path = $"{f.PathWithSeparator}{GetPlayListTitle()}"
End If
Case YouTubeMediaType.Single
If PlaylistCount > 0 And Not FileIgnorePlaylist Then
_File.Path = f.Path
Dim pls$ = GetPlayListTitle()
Dim pls$ = If(AbsolutePath, String.Empty, GetPlayListTitle())
If Not _File.Path.Contains(pls) Then _File.Path = $"{_File.PathWithSeparator(Not pls.IsEmptyString)}{pls}"
ElseIf Not f.Name.IsEmptyString Then
_File = f
@@ -575,6 +597,11 @@ Namespace API.YouTube.Objects
File = f
End Set
End Property
Friend Function GetFiles() As IEnumerable(Of SFile)
Dim urls As New List(Of String)({File})
If HasElements And Not IsMusic Then urls.ListAddList(Elements.SelectMany(Function(elem As YouTubeMediaContainerBase) elem.GetFiles()), LAP.NotContainsOnly)
Return urls
End Function
#End Region
#Region "Command"
<XMLEC> Public Property UseCookies As Boolean = MyYouTubeSettings.DefaultUseCookies Implements IYouTubeMediaContainer.UseCookies
@@ -709,6 +736,21 @@ Namespace API.YouTube.Objects
End Sub
#End Region
#Region "Download"
Protected Shared Function CreateUrlFile(ByVal URL As String, ByVal File As SFile) 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
Return File
Catch ex As Exception
Return Nothing
End Try
End Function
Private ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue)
Public Property Progress As MyProgress Implements IYouTubeMediaContainer.Progress
Private Property IDownloadableMedia_Progress As Object Implements IDownloadableMedia.Progress
@@ -807,33 +849,42 @@ Namespace API.YouTube.Objects
Try
Dim url$ = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={PlsId}"
Dim r$
Using resp As New Responser
If UseCookies And MyYouTubeSettings.Cookies.Count > 0 Then resp.Cookies.AddRange(MyYouTubeSettings.Cookies,, EDP.SendToLog)
r = resp.GetResponse(url,, EDP.ReturnValue)
If Not r.IsEmptyString Then
Dim p As RParams = RParams.DM("(?<=https:[\\/]{2,4})[^\.]*[\.]?googleusercontent.com[^\,]+?w(\d+).h(\d+)[^\,]+?(?=\\x22)", 0, RegexReturn.List, EDP.ReturnValue)
Dim l As List(Of String) = RegexReplace(r, p)
If l.ListExists Then l.RemoveAll(Function(uu) uu.IsEmptyString)
If l.ListExists Then
Dim u$ = l.Last
u = u.Replace("\/", "/").TrimStart("/")
Dim position%
Dim ch$
Do
position = InStr(u, "\")
If position > 0 Then
ch = $"%{Mid(u, position + 2, 2)}"
ch = SymbolsConverter.ASCII.Decode(ch, New ErrorsDescriber(False, False, False, String.Empty))
u = u.Replace(Mid(u, position, 4), ch)
End If
Loop While position > 0
url = LinkFormatterSecure(u)
f.Name = "cover"
f.Extension = "jpg"
If resp.DownloadFile(url, f, EDP.ReturnValue) And f.Exists Then CoverDownloaded = True
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
If MyYouTubeSettings.CreateThumbnails_Music Then
Using resp As New Responser
If UseCookies And MyYouTubeSettings.Cookies.Count > 0 Then resp.Cookies.AddRange(MyYouTubeSettings.Cookies,, EDP.SendToLog)
r = resp.GetResponse(url,, EDP.ReturnValue)
If Not r.IsEmptyString Then
Dim p As RParams = RParams.DM("(?<=https:[\\/]{2,4})[^\.]*[\.]?googleusercontent.com[^\,]+?w(\d+).h(\d+)[^\,]+?(?=\\x22)", 0, RegexReturn.List, EDP.ReturnValue)
Dim l As List(Of String) = RegexReplace(r, p)
If l.ListExists Then l.RemoveAll(Function(uu) uu.IsEmptyString)
If l.ListExists Then
Dim u$ = l.Last
u = u.Replace("\/", "/").TrimStart("/")
Dim position%
Dim ch$
Do
position = InStr(u, "\")
If position > 0 Then
ch = $"%{Mid(u, position + 2, 2)}"
ch = SymbolsConverter.ASCII.Decode(ch, New ErrorsDescriber(False, False, False, String.Empty))
u = u.Replace(Mid(u, position, 4), ch)
End If
Loop While position > 0
url = LinkFormatterSecure(u)
f.Name = "cover"
f.Extension = "jpg"
If resp.DownloadFile(url, f, EDP.ReturnValue) And f.Exists Then CoverDownloaded = True
End If
End If
End If
End Using
End Using
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"DownloadPlaylistCover({PlsId}, {f})")
End Try
@@ -882,12 +933,29 @@ Namespace API.YouTube.Objects
End If
If Not File.Exists Then _File.Name = File.File
If File.Exists Then
If DownloadObjects.STDownloader.MyDownloaderSettings.CreateUrlFiles Then
Dim fileUrl As SFile = File
fileUrl.Extension = "url"
CreateUrlFile(URL, fileUrl)
If fileUrl.Exists Then Files.Add(fileUrl)
End If
If MyYouTubeSettings.CreateDescriptionFiles And Not Description.IsEmptyString Then
Dim fileDesr As SFile = File
fileDesr.Extension = "txt"
TextSaver.SaveTextToFile(Description, fileDesr,,, EDP.None)
If fileDesr.Exists Then Files.Add(fileDesr)
End If
If PlaylistCount > 0 And Not CoverDownloaded And Not PlaylistID.IsEmptyString Then DownloadPlaylistCover(PlaylistID, File, UseCookies)
If prExists Then Progress.InformationTemporary = $"Download {MediaType}: post processing"
_ThumbnailFile = File
_ThumbnailFile.Name &= "_thumb"
_ThumbnailFile.Extension = "jpg"
If Not ThumbnailUrl.IsEmptyString Then GetWebFile(ThumbnailUrl, _ThumbnailFile, EDP.None)
If Not ThumbnailUrl.IsEmptyString And
If(IsMusic, MyYouTubeSettings.CreateThumbnails_Music, MyYouTubeSettings.CreateThumbnails_Video).Value Then _
GetWebFile(ThumbnailUrl, _ThumbnailFile, EDP.None)
ThrowAny(Token)
If MyYouTubeSettings.FFMPEG.Value.Exists Then
@@ -1025,7 +1093,11 @@ Namespace API.YouTube.Objects
If fc.Exists(SFO.Path, False) AndAlso SFile.GetFiles(fc, "*.json",, EDP.ReturnValue).Count > 0 Then Parse(Nothing, fc, IsMusic)
XMLPopulateData(Me, x)
_MediaStateOnLoad = _MediaState
_Exists = True
If Me.MediaState = UMStates.Downloaded Then
_Exists = File.Exists(IIf(ObjectType = YouTubeMediaType.Single, SFO.File, SFO.Path), False)
Else
_Exists = True
End If
If If(x(Name_CheckedElements)?.Count, 0) > 0 Then ApplyElementCheckedValue(x(Name_CheckedElements))
If ArrayMaxResolution <> -10 Then SetMaxResolution(ArrayMaxResolution)
End Using
@@ -1382,28 +1454,36 @@ Namespace API.YouTube.Objects
Protected Sub ParseSubtitles(ByVal e As EContainer)
Dim subt As Subtitles
Dim ee As EContainer
Dim se As EContainer = e({"subtitles"})
If If(se?.Count, 0) = 0 OrElse (se.Count = 1 And se(0).Name = "live_chat") Then se = e({"automatic_captions"})
If If(se?.Count, 0) > 0 Then
If se.Count > 1 OrElse Not se(0).Name = "live_chat" Then
Dim eSUB As EContainer = e({"subtitles"})
Dim eCC As EContainer = e({"automatic_captions"})
If If(eSUB?.Count, 0) = 0 OrElse (eSUB.Count = 1 And eSUB(0).Name = "live_chat") Then eSUB = Nothing
If If(eCC?.Count, 0) = 0 OrElse (eCC.Count = 1 And eCC(0).Name = "live_chat") Then eCC = Nothing
If If(eSUB?.Count, 0) > 0 Or If(eCC?.Count, 0) > 0 Then
Dim sl As New List(Of EContainer)
Dim ccExists As Boolean = False
Dim ccIndx% = -1, rIndx% = -1
If If(eSUB?.Count, 0) > 0 Then sl.Add(eSUB) : ccIndx += 1
If If(eCC?.Count, 0) > 0 Then sl.Add(eCC) : ccIndx += 1 : ccExists = True
For Each se As EContainer In sl
rIndx += 1
For Each ee In se
subt = New Subtitles With {.ID = ee.Name}
subt = New Subtitles With {.ID = ee.Name, .CC = rIndx = ccIndx And ccExists}
If ee.Count > 0 Then
subt.Name = ee(0).Value("name")
subt.Formats = ee.Select(Function(f) f.Value("ext")).ListToString(",")
End If
If Not subt.ID.IsEmptyString Then _Subtitles.Add(subt)
Next
With MyYouTubeSettings
If Not .DefaultSubtitlesFormat.IsEmptyString Then OutputSubtitlesFormat = .DefaultSubtitlesFormat
If _Subtitles.Count > 0 And .DefaultSubtitles.Count > 0 Then
_Subtitles.Sort()
_Subtitles.ListReindex
SubtitlesSelectedIndexesReset()
PostProcessing_OutputSubtitlesFormats_Reset()
End If
End With
End If
Next
With MyYouTubeSettings
If Not .DefaultSubtitlesFormat.IsEmptyString Then OutputSubtitlesFormat = .DefaultSubtitlesFormat
If _Subtitles.Count > 0 And .DefaultSubtitles.Count > 0 Then
_Subtitles.Sort()
_Subtitles.ListReindex
SubtitlesSelectedIndexesReset()
PostProcessing_OutputSubtitlesFormats_Reset()
End If
End With
End If
End Sub
#End Region

View File

@@ -115,6 +115,12 @@
<ItemGroup>
<Compile Include="Attributes\GridVisibleAttribute.vb" />
<Compile Include="Base\TableControlsProcessor.vb" />
<Compile Include="Controls\ChannelTabsChooserForm.Designer.vb">
<DependentUpon>ChannelTabsChooserForm.vb</DependentUpon>
</Compile>
<Compile Include="Controls\ChannelTabsChooserForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Controls\PlayListParserForm.Designer.vb">
<DependentUpon>PlayListParserForm.vb</DependentUpon>
</Compile>
@@ -208,6 +214,9 @@
<Compile Include="Base\YouTubeSettings.vb" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="Controls\ChannelTabsChooserForm.resx">
<DependentUpon>ChannelTabsChooserForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Controls\PlayListParserForm.resx">
<DependentUpon>PlayListParserForm.vb</DependentUpon>
</EmbeddedResource>
@@ -273,6 +282,10 @@
<Project>{d4650f6b-5a54-44b6-999b-6c675b7116b1}</Project>
<Name>SCrawler.PluginProvider</Name>
</ProjectReference>
<ProjectReference Include="..\SCrawler.Shared\SCrawler.Shared.vbproj">
<Project>{dc634700-24c7-42dd-bf8f-87e6cc54e625}</Project>
<Name>SCrawler.Shared</Name>
</ProjectReference>
</ItemGroup>
<ItemGroup>
<None Include="Content\Pictures\YouTubeMusicPic_96.png" />

View File

@@ -1,3 +1,3 @@
[*.vb]
# Modifier preferences
file_header_template = Copyright (C) 2023 Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>
file_header_template = Copyright (C) Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>

View File

@@ -20,6 +20,8 @@ Public Class MainFrame
Protected Overrides Sub VideoListForm_Load(sender As Object, e As EventArgs)
MyBase.VideoListForm_Load(sender, e)
TRAY_ICON.Visible = MyYouTubeSettings.CloseToTray
CheckNewReleaseFolder()
CheckVersionImpl(False)
End Sub
Private _CloseInvoked As Boolean = False
Private _IgnoreTrayOptions As Boolean = False

View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("SCrawler YouTube downloader")>
<Assembly: AssemblyCompany("AndyProgram")>
<Assembly: AssemblyProduct("SCrawler.YouTubeDownloader")>
<Assembly: AssemblyCopyright("Copyright © 2023")>
<Assembly: AssemblyCopyright("Copyright © 2024")>
<Assembly: AssemblyTrademark("AndyProgram")>
<Assembly: ComVisible(False)>
@@ -32,6 +32,6 @@ Imports System.Runtime.InteropServices
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2023.9.20.0")>
<Assembly: AssemblyFileVersion("2023.9.20.0")>
<Assembly: AssemblyVersion("2023.12.14.0")>
<Assembly: AssemblyFileVersion("2023.12.14.0")>
<Assembly: NeutralResourcesLanguage("en")>

View File

@@ -4,6 +4,9 @@ Microsoft Visual Studio Solution File, Format Version 12.00
VisualStudioVersion = 16.0.31515.178
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler", "SCrawler\SCrawler.vbproj", "{4A016FAD-9F07-4957-8BB2-AE86C88BA342}"
ProjectSection(ProjectDependencies) = postProject
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA} = {71263EEE-E25F-44DD-B0A9-F09047C0BEEA}
EndProjectSection
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "PersonalUtilities", "..\..\MyUtilities\PersonalUtilities\PersonalUtilities.vbproj", "{8405896B-2685-4916-BC93-1FB514C323A9}"
EndProject
@@ -22,6 +25,10 @@ Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.YouTube", "SCrawle
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.YouTubeDownloader", "SCrawler.YouTubeDownloader\SCrawler.YouTubeDownloader.vbproj", "{3F2F2C29-4ADB-48B5-A66E-EE0F51D0DCEF}"
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.Updater", "SCrawler.Updater\SCrawler.Updater.vbproj", "{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}"
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.Shared", "SCrawler.Shared\SCrawler.Shared.vbproj", "{DC634700-24C7-42DD-BF8F-87E6CC54E625}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
@@ -104,6 +111,30 @@ Global
{3F2F2C29-4ADB-48B5-A66E-EE0F51D0DCEF}.Release|x64.Build.0 = Release|x64
{3F2F2C29-4ADB-48B5-A66E-EE0F51D0DCEF}.Release|x86.ActiveCfg = Release|x86
{3F2F2C29-4ADB-48B5-A66E-EE0F51D0DCEF}.Release|x86.Build.0 = Release|x86
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Debug|Any CPU.Build.0 = Debug|Any CPU
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Debug|x64.ActiveCfg = Debug|x64
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Debug|x64.Build.0 = Debug|x64
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Debug|x86.ActiveCfg = Debug|x86
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Debug|x86.Build.0 = Debug|x86
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Release|Any CPU.ActiveCfg = Release|Any CPU
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Release|Any CPU.Build.0 = Release|Any CPU
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Release|x64.ActiveCfg = Release|x64
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Release|x64.Build.0 = Release|x64
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Release|x86.ActiveCfg = Release|x86
{71263EEE-E25F-44DD-B0A9-F09047C0BEEA}.Release|x86.Build.0 = Release|x86
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Debug|Any CPU.Build.0 = Debug|Any CPU
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Debug|x64.ActiveCfg = Debug|x64
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Debug|x64.Build.0 = Debug|x64
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Debug|x86.ActiveCfg = Debug|x86
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Debug|x86.Build.0 = Debug|x86
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Release|Any CPU.ActiveCfg = Release|Any CPU
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Release|Any CPU.Build.0 = Release|Any CPU
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Release|x64.ActiveCfg = Release|x64
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Release|x64.Build.0 = Release|x64
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Release|x86.ActiveCfg = Release|x86
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Release|x86.Build.0 = Release|x86
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE

View File

@@ -123,4 +123,4 @@ insert_final_newline=false
[*.vb]
# Modifier preferences
visual_basic_preferred_modifier_order = Partial,Default,Private,Protected,Public,Friend,NotOverridable,Overridable,MustOverride,Overloads,Overrides,MustInherit,NotInheritable,Static,Shared,Shadows,ReadOnly,WriteOnly,Dim,Const,WithEvents,Widening,Narrowing,Custom,Async:suggestion
file_header_template = Copyright (C) 2023 Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>
file_header_template = Copyright (C) Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>

View File

@@ -11,6 +11,8 @@ Namespace API.Base
Friend Const Header_Authorization As String = "authorization"
Friend Const Header_CSRFToken As String = "x-csrf-token"
Friend Const Header_FB_FRIENDLY_NAME As String = "x-fb-friendly-name"
Friend Const ConcurrentDownloadsCaption As String = "Concurrent downloads"
Friend Const ConcurrentDownloadsToolTip As String = "The number of concurrent downloads."
Friend Const SavedPostsUserNameCaption As String = "Saved posts user"

View File

@@ -50,6 +50,8 @@ Namespace API.Base
Property Suspended As Boolean
Property ReadyForDownload As Boolean
Property HOST As SettingsHost
Property HostStatic As Boolean
Property AccountName As String
Property [File] As SFile
Property FileExists As Boolean
Property DownloadedPictures(ByVal Total As Boolean) As Integer

View File

@@ -18,8 +18,30 @@ Namespace API.Base
Friend ReadOnly TsFilesRegEx As RParams = RParams.DM(".+?\.ts[^\r\n]*", 0, RegexReturn.List)
End Module
End Namespace
Friend Structure M3U8URL
Friend URL As String
Friend Extension As String
Friend Sub New(ByVal _URL As String, Optional ByVal _Extension As String = Nothing)
URL = _URL
Extension = _Extension
End Sub
Public Shared Widening Operator CType(ByVal URL As String) As M3U8URL
Return New M3U8URL(URL)
End Operator
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not IsNothing(Obj) Then
If TypeOf Obj Is M3U8URL Then
Return CType(Obj, M3U8URL).URL = URL
Else
Return CStr(Obj) = URL
End If
End If
Return False
End Function
End Structure
Friend NotInheritable Class M3U8Base
Friend Const TempCacheFolderName As String = "tmpCache"
Friend Const TempFilePrefix As String = "ConPart_"
Private Sub New()
End Sub
Friend Shared Function CreateUrl(ByVal Appender As String, ByVal File As String) As String
@@ -32,9 +54,17 @@ Namespace API.Base
Return $"{Appender.StringTrimEnd("/")}/{File}"
End If
End Function
Friend Shared Function Download(ByVal URLs As List(Of String), ByVal DestinationFile As SFile, Optional ByVal Responser As Responser = Nothing,
Optional ByVal Token As CancellationToken = Nothing, Optional ByVal Progress As MyProgress = Nothing,
Optional ByVal UsePreProgress As Boolean = True, Optional ByVal ExistingCache As CacheKeeper = Nothing) As SFile
Friend Overloads Shared Function Download(ByVal URLs As List(Of String), ByVal DestinationFile As SFile, Optional ByVal Responser As Responser = Nothing,
Optional ByVal Token As CancellationToken = Nothing, Optional ByVal Progress As MyProgress = Nothing,
Optional ByVal UsePreProgress As Boolean = True, Optional ByVal ExistingCache As CacheKeeper = Nothing,
Optional ByVal OnlyDownload As Boolean = False) As SFile
Return Download(URLs.ListCast(Of M3U8URL), DestinationFile, Responser, Token, Progress, UsePreProgress, ExistingCache, OnlyDownload)
End Function
Friend Overloads Shared Function Download(ByVal URLs As List(Of M3U8URL), ByVal DestinationFile As SFile, Optional ByVal Responser As Responser = Nothing,
Optional ByVal Token As CancellationToken = Nothing, Optional ByVal Progress As MyProgress = Nothing,
Optional ByVal UsePreProgress As Boolean = True, Optional ByVal ExistingCache As CacheKeeper = Nothing,
Optional ByVal OnlyDownload As Boolean = False) As SFile
Const defaultExtension$ = "ts"
Dim Cache As CacheKeeper = Nothing
Using tmpPr As New PreProgress(Progress)
Try
@@ -59,10 +89,13 @@ Namespace API.Base
End If
End If
Dim p As SFileNumbers = SFileNumbers.Default(ConcatFile.Name)
Dim pNum As ANumbers = SFileNumbers.NumberProviderDefault
p.NumberProvider = pNum
DirectCast(p.NumberProvider, ANumbers).GroupSize = {URLs.Count.ToString.Length, 3}.Max
ConcatFile = SFile.IndexReindex(ConcatFile,,, p, EDP.ReturnValue)
Dim i%
Dim dFile As SFile = cache2.RootDirectory
dFile.Extension = "ts"
dFile.Extension = defaultExtension
Using w As New DownloadObjects.WebClient2(Responser)
For i = 0 To URLs.Count - 1
If progressExists Then
@@ -73,12 +106,14 @@ Namespace API.Base
End If
End If
Token.ThrowIfCancellationRequested()
dFile.Name = $"ConPart_{i}"
w.DownloadFile(URLs(i), dFile)
dFile.Name = $"{TempFilePrefix}{i.NumToString(pNum)}"
dFile.Extension = URLs(i).Extension.IfNullOrEmpty(defaultExtension)
w.DownloadFile(URLs(i).URL, dFile)
cache2.AddFile(dFile, True)
Next
End Using
DestinationFile = FFMPEG.ConcatenateFiles(cache2, Settings.FfmpegFile.File, ConcatFile, Settings.CMDEncoding, p, EDP.ThrowException)
If Not OnlyDownload Then _
DestinationFile = FFMPEG.ConcatenateFiles(cache2, Settings.FfmpegFile.File, ConcatFile, Settings.CMDEncoding, p, EDP.ThrowException)
Return DestinationFile
End If
End If

View File

@@ -10,45 +10,94 @@ Imports System.Threading
Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Forms.Toolbars
Imports PDownload = SCrawler.Plugin.ISiteSettings.Download
Imports UserMediaD = SCrawler.DownloadObjects.TDownloader.UserMediaD
Namespace API.Base
Friend NotInheritable Class ProfileSaved
Private ReadOnly Property HOST As SettingsHost
Private ReadOnly Property HOST As SettingsHostCollection
Private ReadOnly Property Progress As MyProgress
Friend Sub New(ByRef h As SettingsHost, ByRef Bar As MyProgress)
Private _Unavailable As Integer, _NotReady As Integer, _ErrorCount As Integer
Private _TotalImages As Integer, _TotalVideos As Integer
Friend Property Session As Integer
Friend Property IncludeInTheFeed As Boolean = False
Private _FeedDataExists As Boolean = False
Friend ReadOnly Property FeedDataExists As Boolean
Get
Return _FeedDataExists
End Get
End Property
Friend Sub New(ByRef h As SettingsHostCollection, ByRef Bar As MyProgress)
HOST = h
Progress = Bar
End Sub
Friend Sub Download(ByVal Token As CancellationToken, ByVal Multiple As Boolean)
Friend Overloads Sub Download(ByVal Token As CancellationToken, ByVal Multiple As Boolean)
Dim n% = 0
Dim c% = HOST.Sum(Function(h) IIf(h.DownloadSavedPosts, 1, 0))
_FeedDataExists = False
_Unavailable = 0
_NotReady = 0
_ErrorCount = 0
_TotalImages = 0
_TotalVideos = 0
If c > 0 Then
For i% = 0 To HOST.Count - 1
If Not Token.IsCancellationRequested And HOST(i).DownloadSavedPosts Then n += 1 : Download(HOST(i), n, c, Token, Multiple)
Next
If c > 1 Then
Dim s% = {_Unavailable, _NotReady, _ErrorCount}.Sum
Progress.InformationTemporary = $"{HOST.Name} ({c - s}/{c}) Images: {_TotalImages}; Videos: {_TotalVideos}"
End If
End If
If _FeedDataExists Then Downloader.Files.Sort()
End Sub
Private Overloads Sub Download(ByVal Host As SettingsHost, ByVal Number As Integer, ByVal Count As Integer,
ByVal Token As CancellationToken, ByVal Multiple As Boolean)
Dim aStr$ = String.Empty
If Count > 1 Then aStr = $" ({Number}/{Count})"
Try
If HOST.Source.ReadyToDownload(PDownload.SavedPosts) Then
If HOST.Available(PDownload.SavedPosts, Multiple) Then
HOST.DownloadStarted(PDownload.SavedPosts)
Dim u As New UserInfo With {.Plugin = HOST.Key, .Site = HOST.Name, .SpecialPath = HOST.SavedPostsPath}
Using user As IUserData = HOST.GetInstance(PDownload.SavedPosts, Nothing, False, False)
If Host.Source.ReadyToDownload(PDownload.SavedPosts) Then
If Host.Available(PDownload.SavedPosts, Multiple Or Count > 1) Then
Host.DownloadStarted(PDownload.SavedPosts)
If Count > 1 Then Progress.Information = $"{Host.Name} - {Host.AccountName.IfNullOrEmpty(SettingsHost.NameAccountNameDefault)}"
Using user As IUserData = Host.GetInstance(PDownload.SavedPosts, Nothing, False, False)
If Not user Is Nothing Then
With DirectCast(user, UserDataBase)
.HostStatic = True
.IsSavedPosts = True
.LoadUserInformation()
.Progress = Progress
If Not .FileExists Then .UpdateUserInformation()
.IncludeInTheFeed = IncludeInTheFeed
Host.BeforeStartDownload(.Self, PDownload.SavedPosts)
.DownloadData(Token)
_TotalImages += .DownloadedPictures(False)
_TotalVideos += .DownloadedVideos(False)
If IncludeInTheFeed And .LatestData.Count > 0 Then
_FeedDataExists = True
Downloader.Files.AddRange(.LatestData.Select(Function(m) New UserMediaD(m, .Self, Session) With {.IsSavedPosts = True}))
End If
Progress.InformationTemporary = $"{Host.Name}{aStr} Images: { .DownloadedPictures(False)}; Videos: { .DownloadedVideos(False)}"
Host.AfterDownload(.Self, PDownload.SavedPosts)
End With
HOST.BeforeStartDownload(user, PDownload.SavedPosts)
user.DownloadData(Token)
Progress.InformationTemporary = $"{HOST.Name} Images: {user.DownloadedPictures(False)}; Videos: {user.DownloadedVideos(False)}"
HOST.AfterDownload(user, PDownload.SavedPosts)
End If
End Using
Else
Progress.InformationTemporary = $"Host [{HOST.Name}] is unavailable"
_Unavailable += 1
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is unavailable"
End If
Else
Progress.InformationTemporary = $"Host [{HOST.Name}] is not ready"
_NotReady += 1
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is not ready"
End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested
_ErrorCount += 1
Progress.InformationTemporary = $"{Host.Name}{aStr} downloading canceled"
Catch ex As Exception
Progress.InformationTemporary = $"{HOST.Name} downloading error"
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"[API.Base.ProfileSaved.Download({HOST.Key})]")
_ErrorCount += 1
Progress.InformationTemporary = $"{Host.Name}{aStr} downloading error"
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"[API.Base.ProfileSaved.Download({Host.Key}{aStr})]")
Finally
HOST.DownloadDone(PDownload.SavedPosts)
Host.DownloadDone(PDownload.SavedPosts)
MainFrameObj.UpdateLogButton()
End Try
End Sub

View File

@@ -6,15 +6,33 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Reflection
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Functions.RegularExpressions
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Base
Friend MustInherit Class SiteSettingsBase : Implements ISiteSettings, IResponserContainer
#Region "Declarations"
Friend ReadOnly Property Site As String Implements ISiteSettings.Site
Protected _Icon As Icon = Nothing
Friend Overridable ReadOnly Property Icon As Icon Implements ISiteSettings.Icon
Get
Return _Icon
End Get
End Property
Protected _Image As Image = Nothing
Friend Overridable ReadOnly Property Image As Image Implements ISiteSettings.Image
Get
Return _Image
End Get
End Property
Friend Property AccountName As String Implements ISiteSettings.AccountName
Friend Property Temporary As Boolean = False Implements ISiteSettings.Temporary
Friend Property DefaultInstance As ISiteSettings = Nothing Implements ISiteSettings.DefaultInstance
Protected _AllowUserAgentUpdate As Boolean = True
Protected _SubscriptionsAllowed As Boolean = False
Friend ReadOnly Property SubscriptionsAllowed As Boolean Implements ISiteSettings.SubscriptionsAllowed
@@ -24,7 +42,25 @@ Namespace API.Base
End Property
Private Property Logger As ILogProvider = LogConnector Implements ISiteSettings.Logger
Friend Overridable ReadOnly Property Responser As Responser
Private _UserOptionsExists As Boolean = False
Private _UserOptionsType As Type = Nothing
Protected Property UserOptionsType As Type
Get
Return _UserOptionsType
End Get
Set(ByVal t As Type)
_UserOptionsType = t
_UserOptionsExists = Not t Is Nothing
End Set
End Property
#End Region
#Region "Responser and cookies support"
Private _CookiesNetscapeFile As SFile = Nothing
Friend ReadOnly Property CookiesNetscapeFile As SFile
Get
Return _CookiesNetscapeFile
End Get
End Property
Protected CheckNetscapeCookiesOnEndInit As Boolean = False
Private _UseNetscapeCookies As Boolean = False
Protected Property UseNetscapeCookies As Boolean
@@ -38,7 +74,7 @@ Namespace API.Base
Responser.Cookies.ChangedAllowInternalDrop = Not _UseNetscapeCookies
Responser.Cookies.Changed = False
End If
If b And _UseNetscapeCookies Then Update_SaveCookiesNetscape()
If b AndAlso _UseNetscapeCookies AndAlso Not CookiesNetscapeFile.Exists Then Update_SaveCookiesNetscape()
End Set
End Property
Private Property IResponserContainer_Responser As Responser Implements IResponserContainer.Responser
@@ -47,22 +83,46 @@ Namespace API.Base
End Get
Set : End Set
End Property
Protected Sub UpdateResponserFile()
Dim acc$ = If(AccountName.IsEmptyString OrElse AccountName = Hosts.SettingsHost.NameAccountNameDefault, String.Empty, $"_{AccountName}")
Responser.File = $"{SettingsFolderName}\Responser_{Site}{acc}.xml"
_CookiesNetscapeFile = Responser.File
_CookiesNetscapeFile.Name &= "_Cookies_Netscape"
_CookiesNetscapeFile.Extension = "txt"
End Sub
#End Region
#Region "GetInstance"
Friend MustOverride Function GetInstance(ByVal What As Download) As IPluginContentProvider Implements ISiteSettings.GetInstance
Friend Sub New(ByVal SiteName As String)
#End Region
#Region "Initializers"
Friend Sub New(ByVal SiteName As String, Optional ByVal __Icon As Icon = Nothing, Optional ByVal __Image As Image = Nothing)
Site = SiteName
CookiesNetscapeFile = $"{SettingsFolderName}\Responser_{Site}_Cookies_Netscape.txt"
_Icon = __Icon
_Image = __Image
Responser = New Responser With {.DeclaredError = EDP.ThrowException}
UpdateResponserFile()
End Sub
Friend Sub New(ByVal SiteName As String, ByVal CookiesDomain As String)
Me.New(SiteName)
Responser = New Responser($"{SettingsFolderName}\Responser_{Site}.xml") With {.DeclaredError = EDP.ThrowException}
With Responser
.CookiesDomain = CookiesDomain
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey
If .File.Exists Then .LoadSettings() Else .SaveSettings()
End With
End Sub
#Region "XML"
Friend Overridable Sub Load(ByVal XMLValues As IEnumerable(Of KeyValuePair(Of String, String))) Implements ISiteSettings.Load
Friend Sub New(ByVal SiteName As String, ByVal CookiesDomain As String, ByVal AccName As String, ByVal Temp As Boolean,
Optional ByVal __Icon As Icon = Nothing, Optional ByVal __Image As Image = Nothing)
Me.New(SiteName, __Icon, __Image)
Temporary = Temp
AccountName = AccName
If Temporary Then
With Responser
.File = Nothing
.Cookies.File = Nothing
.CookiesDomain = CookiesDomain
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey
End With
_CookiesNetscapeFile = Nothing
Else
UpdateResponserFile()
With Responser
.CookiesDomain = CookiesDomain
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey
If .File.Exists Then .LoadSettings() Else .SaveSettings()
End With
End If
End Sub
#End Region
#Region "Initialize"
@@ -81,12 +141,18 @@ Namespace API.Base
Protected _SiteEditorFormOpened As Boolean = False
Friend Overridable Sub BeginEdit() Implements ISiteSettings.BeginEdit
_SiteEditorFormOpened = True
If UseNetscapeCookies And CookiesNetscapeFile.Exists Then
With Responser.Cookies
.Clear()
.AddRange(CookieKeeper.ParseNetscapeText(CookiesNetscapeFile.GetText, EDP.SendToLog + EDP.ReturnValue),, EDP.None)
End With
End If
End Sub
Friend Overridable Sub EndEdit() Implements ISiteSettings.EndEdit
If _SiteEditorFormOpened Then DomainsReset()
_SiteEditorFormOpened = False
End Sub
Friend Overridable Sub Update() Implements ISiteSettings.Update
Friend Overridable Overloads Sub Update() Implements ISiteSettings.Update
If _SiteEditorFormOpened Then
If UseNetscapeCookies Then Update_SaveCookiesNetscape()
If Not Responser Is Nothing Then
@@ -98,6 +164,17 @@ Namespace API.Base
End If
If Not Responser Is Nothing Then Responser.SaveSettings()
End Sub
Friend Overridable Overloads Sub Update(ByVal Source As ISiteSettings) Implements ISiteSettings.Update
AccountName = Source.AccountName
If Not Responser Is Nothing Then Responser.Copy(DirectCast(Source, SiteSettingsBase).Responser) : UpdateResponserFile() : Responser.SaveSettings()
Update_CloneProperties(Source)
UpdateImpl(Source)
End Sub
Protected Overridable Sub Update_CloneProperties(ByVal Source As ISiteSettings)
CLONE_PROPERTIES(Source, Me, True)
End Sub
Protected Overridable Sub UpdateImpl(ByVal Source As ISiteSettings)
End Sub
Protected Sub Update_SaveCookiesNetscape(Optional ByVal Force As Boolean = False, Optional ByVal IsInit As Boolean = False)
If Not Responser Is Nothing Then
With Responser
@@ -142,6 +219,7 @@ Namespace API.Base
End Sub
''' <inheritdoc cref="DownloadStarted(Download)"/>
Friend Overridable Sub DownloadDone(ByVal What As Download) Implements ISiteSettings.DownloadDone
AvailableText = String.Empty
End Sub
#End Region
#Region "User info"
@@ -184,6 +262,7 @@ Namespace API.Base
End Function
#End Region
#Region "Ready, Available"
Friend Property AvailableText As String Implements ISiteSettings.AvailableText
''' <returns>True</returns>
Friend Overridable Function BaseAuthExists() As Boolean
Return True
@@ -199,12 +278,119 @@ Namespace API.Base
Return True
End Function
#End Region
Protected Sub CLONE_PROPERTIES(ByVal Source As ISiteSettings, ByVal Destination As ISiteSettings, ByVal IsUpdate As Boolean,
Optional ByVal Full As Boolean = True)
Dim comparer As New MembersDistinctComparerExtended
'0 = update
'1 = clone
'2 = any
Dim filterUC As Func(Of MemberInfo, Byte, Boolean) = Function(ByVal m As MemberInfo, ByVal __mode As Byte) As Boolean
If If(m.GetCustomAttribute(Of DoNotUse)?.Value, False) Then
Return False
Else
With m.GetCustomAttribute(Of PClonableAttribute)
Return Not .Self Is Nothing AndAlso (__mode = 2 OrElse If(__mode = 0, .Update, .Clone))
End With
End If
End Function
Dim filterAll As Func(Of MemberInfo, Boolean) = Function(m) filterUC.Invoke(m, 2)
Dim filterC As Func(Of MemberInfo, Boolean) = Function(m) If(Full, filterAll.Invoke(m), filterUC.Invoke(m, 1))
Dim filterU As Func(Of MemberInfo, Boolean) = Function(m) filterUC.Invoke(m, 0)
Dim membersSource As IEnumerable(Of MemberInfo) = GetObjectMembers(Source, filterAll,, True, comparer)
If membersSource.ListExists Then
Dim membersDest As IEnumerable(Of MemberInfo) = GetObjectMembers(Destination, If(IsUpdate, filterU, filterC),, True, comparer)
If membersDest.ListExists Then
Dim mSource As MemberInfo = Nothing, mDest As MemberInfo = Nothing
Dim destIndx%
Dim isPropertyValue As Boolean
Dim sourceValue As Object
For Each mSource In membersSource
destIndx = membersDest.ListIndexOf(mSource, comparer, EDP.ReturnValue)
If destIndx.ValueBetween(0, membersDest.Count - 1) Then mDest = membersDest(destIndx) Else mDest = Nothing
If Not mDest Is Nothing Then
sourceValue = mSource.GetMemberValue(Source)
If mDest.MemberType = MemberTypes.Property Then
isPropertyValue = DirectCast(mDest, PropertyInfo).PropertyType Is GetType(PropertyValue)
Else
isPropertyValue = DirectCast(mDest, FieldInfo).FieldType Is GetType(PropertyValue)
End If
If isPropertyValue Then
DirectCast(mDest.GetMemberValue(Destination), PropertyValue).Clone(sourceValue)
Else
mDest.SetMemberValue(Destination, sourceValue)
End If
End If
Next
End If
End If
End Sub
Protected Overridable Function CloneGetEmptySettingsInstance() As ISiteSettings
Dim _max% = -1
Dim c As ConstructorInfo = Nothing
With Me.GetType.GetTypeInfo.DeclaredConstructors
If .ListExists Then
With .Where(Function(m) If(m.GetParameters?.Count, 0).ValueBetween(0, 2))
If .ListExists Then
_max = .Max(Function(m) If(m.GetParameters?.Count, 0))
c = .First(Function(m) If(m.GetParameters?.Count, 0) = _max)
End If
End With
End If
Select Case _max
Case 2 : Return c.Invoke({String.Empty, True})
Case 1 : Return c.Invoke({String.Empty})
Case 0 : Return c.Invoke(Nothing)
Case Else : Return Activator.CreateInstance(Me.GetType)
End Select
End With
End Function
Friend Overridable Function Clone(ByVal Full As Boolean) As ISiteSettings Implements ISiteSettings.Clone
Dim obj As ISiteSettings = CloneGetEmptySettingsInstance()
CLONE_PROPERTIES(Me, obj, False, Full)
Return obj
End Function
Friend Sub Delete() Implements ISiteSettings.Delete
If Not Responser Is Nothing Then
With Responser
If .File.Exists Then .File.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.None)
If .Cookies.File.Exists Then .Cookies.File.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.None)
End With
If _CookiesNetscapeFile.Exists Then _CookiesNetscapeFile.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.None)
End If
End Sub
Friend Overridable Sub Reset() Implements ISiteSettings.Reset
End Sub
Friend Overridable Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Implements ISiteSettings.UserOptions
Options = Nothing
If _UserOptionsExists Then
If Options Is Nothing OrElse Not Options.GetType Is _UserOptionsType Then
Options = AConvert(Me, AModes.Var, _UserOptionsType,, True, Nothing)
If Options Is Nothing Then Options = Activator.CreateInstance(_UserOptionsType)
End If
If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
Else
Options = Nothing
End If
End Sub
Friend Overridable Sub OpenSettingsForm() Implements ISiteSettings.OpenSettingsForm
End Sub
#Region "IDisposable Support"
Protected disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then Responser.DisposeIfReady
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

@@ -18,6 +18,7 @@ Namespace API.Base
Tags = 2
Categories = 3
Pornstars = 4
Playlists = 5
End Enum
Friend Structure UserMedia : Implements IUserMedia, IEquatable(Of UserMedia), IEContainerProvider
#Region "XML Names"

View File

@@ -12,6 +12,7 @@ Namespace API.Base
Friend Class TokenBatch : Inherits BatchExecutor
Friend Property TempPostsList As List(Of String)
Protected ReadOnly Token As CancellationToken
Friend Property DebugMode As Boolean = False
Friend Sub New(ByVal _Token As CancellationToken)
MyBase.New(True)
Token = _Token
@@ -22,11 +23,21 @@ Namespace API.Base
End Sub
Protected Overrides Async Sub OutputDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
MyBase.OutputDataReceiver(Sender, e)
Await Task.Run(Sub() If Token.IsCancellationRequested Then Kill())
Await Task.Run(Sub()
#If DEBUG Then
If DebugMode Then Debug.WriteLineIf(Not e.Data.IsEmptyString, $"Out: {e.Data}")
#End If
If Token.IsCancellationRequested Then Kill()
End Sub)
End Sub
Protected Overrides Async Sub ErrorDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
MyBase.ErrorDataReceiver(Sender, e)
Await Task.Run(Sub() If Token.IsCancellationRequested Then Kill())
Await Task.Run(Sub()
#If DEBUG Then
If DebugMode Then Debug.WriteLineIf(Not e.Data.IsEmptyString, $"Err: {e.Data}")
#End If
If Token.IsCancellationRequested Then Kill()
End Sub)
End Sub
Protected Overridable Async Function Validate(ByVal Value As String) As Task
If Not ProcessKilled AndAlso Await Task.Run(Of Boolean)(Function() Token.IsCancellationRequested OrElse

View File

@@ -126,6 +126,7 @@ Namespace API.Base
#Region "XML Declarations"
Private Const Name_Site As String = UserInfo.Name_Site
Private Const Name_Plugin As String = UserInfo.Name_Plugin
Private Const Name_AccountName As String = UserInfo.Name_AccountName
Protected Const Name_IsChannel As String = "IsChannel"
Friend Const Name_UserName As String = "UserName"
Private Const Name_Model_User As String = UserInfo.Name_Model_User
@@ -168,10 +169,56 @@ Namespace API.Base
Protected Const Name_UseMD5Comparison As String = "UseMD5Comparison"
Protected Const Name_RemoveExistingDuplicates As String = "RemoveExistingDuplicates"
Protected Const Name_StartMD5Checked As String = "StartMD5Checked"
#Region "Additional names"
Protected Const Name_SiteMode As String = "SiteMode"
Protected Const Name_TrueName As String = "TrueName"
Protected Const Name_Arguments As String = "Arguments"
#End Region
#End Region
#Region "Declarations"
#Region "Host, Site, Progress"
Friend Property HostCollection As SettingsHostCollection
Private Function HostObtainCollection() As Boolean
If HostCollection Is Nothing Then
Dim k$ = If(_HOST?.Key, _HostKey)
If Not k.IsEmptyString Then HostCollection = Settings(k)
End If
Return Not HostCollection Is Nothing
End Function
Private _HOST As SettingsHost
Private _HostKey As String = String.Empty
Private _HostObtained As Boolean = False
Friend Property HOST As SettingsHost Implements IUserData.HOST
Get
If _HostObtained Or HostStatic Then
Return _HOST
ElseIf HostObtainCollection() Then
_HOST = HostCollection(AccountName)
_HostObtained = Not _HOST Is Nothing
Return _HOST
Else
Return Nothing
End If
End Get
Set(ByVal h As SettingsHost)
_HOST = h
If Not h Is Nothing Then _HostKey = h.Key
End Set
End Property
Private Sub ResetHost()
_HostObtained = False
End Sub
Friend Property HostStatic As Boolean = False Implements IUserData.HostStatic
Private _AccountName As String = String.Empty
Friend Overridable Property AccountName As String Implements IUserData.AccountName, IPluginContentProvider.AccountName
Get
Return _AccountName.IfNullOrEmpty(User.AccountName)
End Get
Set(ByVal name As String)
If Not _AccountName = name Then ResetHost()
_AccountName = name
End Set
End Property
Friend ReadOnly Property Site As String Implements IUserData.Site
Get
Return HOST.Name
@@ -845,6 +892,7 @@ BlockNullPicture:
Friend Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean,
Optional ByVal AttachUserInfo As Boolean = True) Implements IUserData.SetEnvironment
HOST = h
HostObtainCollection()
If AttachUserInfo Then
User = u
If _LoadUserInformation Then LoadUserInformation()
@@ -853,7 +901,7 @@ BlockNullPicture:
''' <exception cref="ArgumentOutOfRangeException"></exception>
Friend Shared Function GetInstance(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True) As IUserData
If Not u.Plugin.IsEmptyString Then
Return Settings(u.Plugin).GetInstance(ISiteSettings.Download.Main, u, _LoadUserInformation)
Return Settings(u.Plugin).Default.GetInstance(ISiteSettings.Download.Main, u, _LoadUserInformation)
Else
Throw New ArgumentOutOfRangeException("Plugin", $"Plugin [{u.Plugin}] information does not recognized by loader")
End If
@@ -865,7 +913,7 @@ BlockNullPicture:
With DirectCast(u, UserDataBase)
If Not .User.Plugin.IsEmptyString Then
uName = .User.Name
Return Settings(.User.Plugin).GetUserPostUrl(.Self, PostData)
Return Settings(.User.Plugin).Default.GetUserPostUrl(.Self, PostData)
End If
End With
End If
@@ -937,6 +985,7 @@ BlockNullPicture:
Using x As New XmlFile With {.Name = "User"}
x.Add(Name_Site, Site)
x.Add(Name_Plugin, HOST.Key)
x.Add(Name_AccountName, AccountName)
x.Add(Name_UserName, User.Name)
x.Add(Name_Model_User, CInt(UserModel))
x.Add(Name_Model_Collection, CInt(CollectionModel))
@@ -1030,6 +1079,7 @@ BlockNullPicture:
End Try
End Sub
Friend Overridable Sub OpenFolder() Implements IUserData.OpenFolder
If MyFile.IsEmptyString And IsSavedPosts Then UpdateDataFiles()
GlobalOpenPath(MyFile.CutPath)
End Sub
#End Region
@@ -1130,11 +1180,13 @@ BlockNullPicture:
End If
End Sub
Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IUserData.DownloadData
ResetHost()
__DOWNLOAD_IN_PROGRESS = True
OnUserDownloadStateChanged(True)
Dim Canceled As Boolean = False
TokenQueue = Token
Try
If HOST Is Nothing Then Throw New ExitException($"Host '{AccountName}' not found")
EnvirDownloadSet()
If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Responser
@@ -1226,7 +1278,7 @@ BlockNullPicture:
End If
ThrowIfDisposed()
If Not _PictureExists Or _EnvirInvokeUserUpdated Then OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested
Catch oex As OperationCanceledException When Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested Or TokenQueue.IsCancellationRequested
MyMainLOG = $"{ToStringForLog()}: downloading canceled"
Canceled = True
Catch exit_ex As ExitException
@@ -1291,7 +1343,12 @@ BlockNullPicture:
#Region "DownloadSingleObject"
Protected IsSingleObjectDownload As Boolean = False
Friend Overridable Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken) Implements IUserData.DownloadSingleObject
Dim URL$ = String.Empty
Try
ResetHost()
URL = Data.URL
AccountName = Data.AccountName
If HOST Is Nothing Then Throw New ExitException($"Host '{AccountName}' not found")
Data.DownloadState = UserMediaStates.Tried
Progress = Data.Progress
If Not Progress Is Nothing Then Progress.ResetProgressOnMaximumChanges = False
@@ -1305,9 +1362,21 @@ BlockNullPicture:
DownloadSingleObject_CreateMedia(Data, Token)
DownloadSingleObject_Download(Data, Token)
DownloadSingleObject_PostProcessing(Data)
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Data.DownloadState = UserMediaStates.Missing
ErrorsDescriber.Execute(EDP.SendToLog, oex, $"{Site} download canceled: {URL}")
Catch dex As ObjectDisposedException When Disposed
Catch exit_ex As ExitException
If Not exit_ex.Silent Then
If exit_ex.SimpleLogLine Then
MyMainLOG = $"{URL}: downloading canceled (exit) ({exit_ex.Message})"
Else
ErrorsDescriber.Execute(EDP.SendToLog, exit_ex, $"{URL}: downloading canceled (exit)")
End If
End If
Catch ex As Exception
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: {URL}")
End Try
End Sub
Protected Overridable Sub DownloadSingleObject_CreateMedia(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken)
@@ -1661,8 +1730,6 @@ BlockNullPicture:
DownloadContentDefault_PostProcessing(v, f, Token)
dCount += 1
Catch woex As OperationCanceledException When Token.IsCancellationRequested
'TODELETE: UserDataBase.DownloadContentDefault: remove file when 'OperationCanceledException'
'If f.Exists Then f.Delete(,, EDP.SendToLog)
__deleteFile.Invoke(f, v.URL_BASE)
v.State = UStates.Missing
v.Attempts += 1
@@ -1829,6 +1896,7 @@ BlockNullPicture:
If m.Contains(IUserData.EraseMode.History) Then
If MyFilePosts.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
If MyFileData.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
EraseData_AdditionalDataFiles()
End If
If m.Contains(IUserData.EraseMode.Data) Then
Dim files As List(Of SFile) = SFile.GetFiles(DownloadContentDefault_GetRootDir.CSFileP,, SearchOption.AllDirectories, e)
@@ -1850,6 +1918,8 @@ BlockNullPicture:
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"EraseData({CInt(Mode)}): {ToStringForLog()}", False)
End Try
End Function
Protected Overridable Sub EraseData_AdditionalDataFiles()
End Sub
Friend Overridable Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer Implements IUserData.Delete
Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then
@@ -1871,6 +1941,7 @@ BlockNullPicture:
Try
Dim f As SFile
Dim v As Boolean = IsVirtual
Settings.Feeds.Load()
If IncludedInCollection And __CollectionName.IsEmptyString And __SpecialCollectionPath.IsEmptyString Then
Settings.Users.Add(Me)
@@ -1913,6 +1984,7 @@ BlockNullPicture:
Settings.UsersList.Remove(UserBefore)
Settings.UpdateUsersList(User)
Settings.Feeds.UpdateUsers(UserBefore, User)
UpdateUserInformation()
Return True
Catch ex As Exception
@@ -1966,6 +2038,7 @@ BlockNullPicture:
End If
If Not ScriptData.IsEmptyString AndAlso ScriptData.Contains(UserBefore.File.PathNoSeparator) Then _
ScriptData = ScriptData.Replace(UserBefore.File.PathNoSeparator, MyFile.PathNoSeparator)
Settings.Feeds.UpdateUsers(UserBefore, User)
UpdateUserInformation()
End If
Catch ioex As InvalidOperationException When ioex.HelpLink = 1
@@ -2026,8 +2099,8 @@ BlockNullPicture:
End Function
#End Region
#Region "Errors functions"
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String)
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"{ToStringForLog()}: {Message}")
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String, Optional ByVal e As ErrorsDescriber = Nothing)
ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}")
End Sub
Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String)
If Not f.Exists Then MyMainLOG = $"Error downloading from [{URL}] to [{f}]"
@@ -2040,9 +2113,13 @@ BlockNullPicture:
Private Overloads Sub ThrowAny() Implements IThrower.ThrowAny
ThrowAny(TokenQueue)
End Sub
''' <summary><c>ThrowAnyImpl(Token)</c></summary>
''' <exception cref="OperationCanceledException"></exception>
''' <exception cref="ObjectDisposedException"></exception>
Friend Overridable Overloads Sub ThrowAny(ByVal Token As CancellationToken)
ThrowAnyImpl(Token)
End Sub
Protected Sub ThrowAnyImpl(ByVal Token As CancellationToken)
Token.ThrowIfCancellationRequested()
TokenQueue.ThrowIfCancellationRequested()
TokenPersonal.ThrowIfCancellationRequested()
@@ -2105,7 +2182,11 @@ BlockNullPicture:
#End Region
#Region "IComparable Support"
Friend Overridable Function CompareTo(ByVal Other As UserDataBase) As Integer Implements IComparable(Of UserDataBase).CompareTo
Return Name.CompareTo(Other.Name)
If IsCollection Then
Return Name.CompareTo(Other.Name)
Else
Return FriendlyName.IfNullOrEmpty(Name).StringTrim.CompareTo(Other.FriendlyName.IfNullOrEmpty(Other.Name).StringTrim)
End If
End Function
Friend Overridable Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserDataBase Then

View File

@@ -11,7 +11,7 @@ Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Namespace API.Base
Friend Class DomainsContainer : Implements IEnumerable(Of String), IMyEnumerator(Of String)
Friend Class DomainsContainer : Implements IEnumerable(Of String), IMyEnumerator(Of String), IDisposable
Friend Event DomainsUpdated(ByVal Sender As DomainsContainer)
Friend ReadOnly Property Domains As List(Of String)
Friend ReadOnly Property DomainsTemp As List(Of String)
@@ -98,11 +98,33 @@ Namespace API.Base
End If
End Using
End Sub
#Region "IEnumerable Support"
Private Function GetEnumerator() As IEnumerator(Of String) Implements IEnumerable(Of String).GetEnumerator
Return New MyEnumerator(Of String)(Me)
End Function
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return GetEnumerator()
End Function
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
Domains.Clear()
DomainsTemp.Clear()
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

@@ -20,7 +20,7 @@ Namespace API.Base
Private ReadOnly Property MyMembers As List(Of MemberOption)
''' <summary>Default: 200</summary>
Friend Property MinimumWidth As Integer = 200
Private Class MemberOption : Inherits Hosts.PropertyValueHost : Implements IDisposable
Private Class MemberOption : Inherits Hosts.PropertyValueHost
Friend ToolTip As String
Friend Caption As String
Friend ThreeState As Boolean = False
@@ -102,24 +102,6 @@ Namespace API.Base
CreateControl(TT)
If Not Provider Is Nothing Then f.AddControl(Control, Caption, Type, AllowNull, Activator.CreateInstance(Provider))
End Sub
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then Control.Dispose()
Control = Nothing
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
Friend Sub New(ByVal Obj As Object, ByVal s As ISiteSettings, ByVal _IsSettingsForm As Boolean)
InitializeComponent()

View File

@@ -0,0 +1,37 @@
' 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.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Facebook
Friend Module Declarations
Friend ReadOnly Regex_UserToken_dtsg As RParams = RParams.DMS("DTSGInitialData.:.?{\s*.token.:\s*""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_UserToken_lsd As RParams = RParams.DMS("LSD.:.?{\s*.token.:\s*""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_UserID As RParams = RParams.DMS("userid.:.(\d+)", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly Regex_Photos_by As RParams = RParams.DMS("photos_by"",""id"":""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_FileName As RParams = RParams.DM("([^/\?]+\..{3,4})(?=(\?|\Z))", 0, EDP.ReturnValue)
Friend ReadOnly Regex_ProfileUrlID As RParams = RParams.DMS("profile.php\?id=(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_VideoPageID As RParams = RParams.DMS("pageid.:.(\d+)", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly Regex_StoryBucket As RParams = RParams.DMS("story_bucket[^\>]*?(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_VideoIDFromURL As RParams = RParams.DMS("facebook.com/([^/]+/videos/|watch/\D*[\?&]{1}v=)(\d+)", 2, EDP.ReturnValue)
Friend ReadOnly Regex_PostHtmlFullPicture As RParams = RParams.DM("^((?!_[ps]{1}\d+x\d+).)*$", 0, EDP.ReturnValue)
Friend ReadOnly SpecialNode() As NodeParams = {New NodeParams("attachment", True, True, True, True, 30),
New NodeParams("media", True, True, True, True, 0),
New NodeParams("photo_image", True, True, True, True, 0),
New NodeParams("uri", True, True, True, True, 0)}
Friend ReadOnly SpecialNode2() As NodeParams = {New NodeParams("result", True, True, True, True, 30),
New NodeParams("data", True, True, True, True, 0),
New NodeParams("currmedia", True, True, True, True, 0),
New NodeParams("image", True, True, True, True, 0),
New NodeParams("uri", True, True, True, True, 0)}
End Module
End Namespace

View File

@@ -0,0 +1,110 @@
' 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.Functions.RegularExpressions
Namespace API.Facebook
<Manifest("AndyProgram_Facebook"), SavedPosts, SeparatedTasks(1), SpecialForm(False)>
Friend Class SiteSettings : Inherits ThreadsNet.SiteSettings
#Region "Declarations"
#Region "Auth"
<PropertyOption(AllowNull:=False, ControlText:="Accept", ControlToolTip:="Header 'Accept'", IsAuth:=True), ControlNumber(21), PXML, PClonable>
Friend ReadOnly Property Header_Accept As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", AllowNull:=True, IsAuth:=True)>
Friend Overrides ReadOnly Property HH_IG_APP_ID As PropertyValue
Get
Return __HH_IG_APP_ID
End Get
End Property
<DoNotUse> Friend Overrides ReadOnly Property HH_CSRF_TOKEN As PropertyValue
Get
Return __HH_CSRF_TOKEN
End Get
End Property
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", IsAuth:=True, LeftOffset:=120), ControlNumber(51), PXML, PClonable>
Friend ReadOnly Property HH_PLATFORM_VER As PropertyValue
#End Region
#Region "Defaults"
<PropertyOption(ControlText:="Download photos", IsAuth:=False), PXML, PClonable>
Friend ReadOnly Property ParsePhotoBlock As PropertyValue
<PropertyOption(ControlText:="Download videos", IsAuth:=False), PXML, PClonable>
Friend ReadOnly Property ParseVideoBlock As PropertyValue
<PropertyOption(ControlText:="Download stories", IsAuth:=False), PXML, PClonable>
Friend ReadOnly Property ParseStoriesBlock As PropertyValue
#End Region
#End Region
#Region "Initializer"
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("Facebook", "facebook.com", AccName, Temp, My.Resources.SiteResources.FacebookIcon_32, My.Resources.SiteResources.FacebookPic_37)
With Responser.Headers
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.facebook.com"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Origin, "https://www.facebook.com"))
.Remove(DeclaredNames.Header_FB_FRIENDLY_NAME)
End With
Header_Accept = New PropertyValue(String.Empty, GetType(String))
HH_PLATFORM_VER = New PropertyValue(String.Empty, GetType(String))
ParsePhotoBlock = New PropertyValue(True)
ParseVideoBlock = New PropertyValue(True)
ParseStoriesBlock = New PropertyValue(True)
UrlPatternUser = "https://www.facebook.com/{0}"
UserRegex = RParams.DMS("facebook.com/(profile.php\?id=\d+|[^\?&/]+)", 1)
ImageVideoContains = "facebook.com"
UserOptionsType = GetType(UserExchangeOptions)
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 "UpdateResponserData"
Friend Overrides Sub UpdateResponserData(ByVal Resp As Responser)
With Responser.Cookies
.Update(Resp.Cookies)
If .Changed Then Responser.SaveCookies() : .Changed = False
End With
End Sub
#End Region
#Region "BaseAuthExists, GetUserUrl, GetUserPostUrl, IsMyUser, IsMyImageVideo"
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists And ACheck(HH_IG_APP_ID.Value)
End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return DirectCast(User, UserData).GetProfileUrl
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return Media.URL_BASE
End Function
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim e As ExchangeOptions = MyBase.IsMyUser(UserURL)
If e.Exists Then
e.Options = e.UserName
Dim v$ = RegexReplace(e.UserName, Regex_ProfileUrlID)
If Not v.IsEmptyString Then
e.UserName = v
Else
e.UserName = e.UserName.StringRemoveWinForbiddenSymbols
End If
End If
Return e
End Function
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
If Not URL.IsEmptyString AndAlso Not CStr(AConvert(Of String)(URL, Regex_VideoIDFromURL, String.Empty)).IsEmptyString Then
Return New ExchangeOptions(Site, String.Empty) With {.Exists = True}
Else
Return Nothing
End If
End Function
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,713 @@
' 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 System.Text.RegularExpressions
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 IG = SCrawler.API.Instagram.SiteSettings
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Facebook
Friend Class UserData : Inherits Instagram.UserData
#Region "XML names"
Private Const Name_IsNoNameProfile As String = "IsNoNameProfile"
Private Const Name_OptionsParsed As String = "OptionsParsed"
Private Const Name_VideoPageID As String = "VideoPageID"
Private Const Name_StoryBucket As String = "StoryBucket"
Private Const Name_ParsePhotoBlock As String = "ParsePhotoBlock"
Private Const Name_ParseVideoBlock As String = "ParseVideoBlock"
Private Const Name_ParseStoriesBlock As String = "ParseStoriesBlock"
#End Region
#Region "Declarations"
Friend ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
End Get
End Property
Private IsNoNameProfile As Boolean = False
Private OptionsParsed As Boolean = False
Private Property VideoPageID As String = String.Empty
Private Property StoryBucket As String = String.Empty
Friend Property ParsePhotoBlock As Boolean = True
Friend Property ParseVideoBlock As Boolean = True
Friend Property ParseStoriesBlock As Boolean = True
Private Enum PageBlock As Integer
Timeline = Sections.Timeline
Stories = Sections.Stories
Photos = 100
Videos = 101
Undefined = -1
End Enum
#End Region
#Region "GetProfileUrl"
Friend Function GetProfileUrl() As String
If IsNoNameProfile Then
Return $"https://www.facebook.com/profile.php?id={ID}"
Else
Return $"https://www.facebook.com/{NameTrue}"
End If
End Function
#End Region
#Region "Exchange"
Friend Overrides Function ExchangeOptionsGet() As Object
Return New UserExchangeOptions(Me)
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions)
ParsePhotoBlock = .ParsePhotoBlock
ParseVideoBlock = .ParseVideoBlock
ParseStoriesBlock = .ParseStoriesBlock
End With
End If
End Sub
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
Dim updateNames As Action = Sub()
If Not OptionsParsed AndAlso Not Options.IsEmptyString Then
OptionsParsed = True
Dim v$ = RegexReplace(Options, Regex_ProfileUrlID)
If Not v.IsEmptyString Then ID = v : IsNoNameProfile = True
End If
End Sub
With Container
If Loading Then
If .Contains(Name_IsNoNameProfile) Then
IsNoNameProfile = .Value(Name_IsNoNameProfile).FromXML(Of Boolean)(False)
Else
updateNames.Invoke
End If
OptionsParsed = .Value(Name_OptionsParsed).FromXML(Of Boolean)(False)
VideoPageID = .Value(Name_VideoPageID)
StoryBucket = .Value(Name_StoryBucket)
ParsePhotoBlock = .Value(Name_ParsePhotoBlock).FromXML(Of Boolean)(True)
ParseVideoBlock = .Value(Name_ParseVideoBlock).FromXML(Of Boolean)(True)
ParseStoriesBlock = .Value(Name_ParseStoriesBlock).FromXML(Of Boolean)(True)
Else
updateNames.Invoke
.Add(Name_IsNoNameProfile, IsNoNameProfile.BoolToInteger)
.Add(Name_OptionsParsed, OptionsParsed.BoolToInteger)
.Add(Name_VideoPageID, VideoPageID)
.Add(Name_StoryBucket, StoryBucket)
.Add(Name_ParsePhotoBlock, ParsePhotoBlock.BoolToInteger)
.Add(Name_ParseVideoBlock, ParseVideoBlock.BoolToInteger)
.Add(Name_ParseStoriesBlock, ParseStoriesBlock.BoolToInteger)
End If
End With
End Sub
#End Region
#Region "Download functions"
Private Token_dtsg As String = String.Empty
Private Token_lsd As String = String.Empty
Private Token_Photosby As String = String.Empty
Private Limit As Integer = -1
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
GetUserTokens(Token)
LoadSavePostsKV(True)
Limit = If(DownloadTopCount, -1)
If IsSavedPosts Then
DownloadData_SavedPosts(String.Empty, Token)
Else
If DownloadImages And ParsePhotoBlock Then DownloadData_Photo(String.Empty, Token)
If DownloadVideos And ParseVideoBlock Then DownloadData_Video(String.Empty, Token)
If (DownloadImages Or DownloadVideos) And ParseStoriesBlock Then DownloadData_Stories(Token)
End If
LoadSavePostsKV(False)
Finally
MySettings.UpdateResponserData(Responser)
End Try
End Sub
Private Const Header_fb_fr_name_Photo As String = "ProfileCometAppCollectionPhotosRendererPaginationQuery"
Private Const Header_fb_fr_name_Video As String = "PagesCometChannelTabAllVideosCardImplPaginationQuery"
Private Const Header_fb_fr_name_Stories As String = "StoriesSuspenseContentPaneRootWithEntryPointQuery"
Private Const Header_fb_fr_name_SavedPosts As String = "CometSaveDashboardAllItemsPaginationQuery"
Private Const DocID_Photo As String = "6684543058255697"
Private Const DocID_Video As String = "24545934291687581"
Private Const DocID_Stories As String = "6771064226315961"
Private Const DocID_SavedPosts As String = "7112228098805003"
Private Const Graphql_UrlPattern As String = "https://www.facebook.com/api/graphql?lsd={0}&doc_id={1}&server_timestamps=true&fb_dtsg={3}&fb_api_req_friendly_name={2}&variables={4}"
Private Const VideoHtmlUrlPattern As String = "https://www.facebook.com/watch/?v={0}"
Private Sub DownloadData_Photo(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Const VarPattern$ = """count"":8,""cursor"":""{0}"",""scale"":1,""id"":""{1}"""
Try
Dim nextCursor$ = String.Empty
Dim newPostsDetected As Boolean = False
Dim pUrl$, pUrlBase$
Dim pid As PostKV
ValidateBaseTokens()
If Token_Photosby.IsEmptyString Then Throw New ArgumentNullException("Token_Photosby", "Unable to obtain token")
URL = String.Format(Graphql_UrlPattern, Token_lsd, DocID_Photo, Header_fb_fr_name_Photo,
SymbolsConverter.ASCII.EncodeSymbolsOnly(Token_dtsg),
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(VarPattern, Cursor, Token_Photosby) & "}"))
ResponserApplyDefs(Header_fb_fr_name_Photo)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
With j({"data", "node", "pageItems", "edges"})
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each jNode As EContainer In .Self
ProgressPre.Perform()
With jNode
If Not .Value("cursor").IsEmptyString Then nextCursor = .Value("cursor")
With .Item({"node"})
If .ListExists Then
pUrl = .Value({"node", "viewer_image"}, "uri")
pUrlBase = .Value("url")
If Not pUrl.IsEmptyString Then
pid = New PostKV(.Value("id"), .Value({"node"}, "id"), PageBlock.Photos)
If Not PostKvExists(pid) Then
newPostsDetected = True
PostsKVIDs.ListAddValue(pid, LNC)
_TempPostsList.Add(pid.ID)
_TempMediaList.ListAddValue(New UserMedia(pUrl, UTypes.Picture) With {
.URL_BASE = pUrlBase,
.File = CreateFileFromUrl(pUrl),
.Post = pid.ID.IfNullOrEmpty(pid.Code)}, LNC)
If Limit > 0 And _TempMediaList.Count >= Limit Then Exit Sub
Else
Exit Sub
End If
End If
End If
End With
End With
Next
End If
End With
End If
End Using
End If
If newPostsDetected And Not nextCursor.IsEmptyString Then DownloadData_Photo(nextCursor, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data (photo) downloading error [{URL}]",, Responser)
End Try
End Sub
Private Sub DownloadData_Video(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Const VarPattern$ = """alwaysIncludeAudioRooms"":true,""count"":6,""cursor"":{0},""pageID"":""{1}"",""scale"":4,""showReactions"":true,""useDefaultActor"":false,""id"":""{1}"""
Try
Dim nextCursor$ = String.Empty
Dim newPostsDetected As Boolean = False
Dim pid As PostKV
If VideoPageID.IsEmptyString Then GetVideoPageID(Token)
If VideoPageID.IsEmptyString Then Throw New ArgumentNullException("VideoPageID", "Unable to obtain VideoPageID")
ValidateBaseTokens()
URL = String.Format(Graphql_UrlPattern, Token_lsd, DocID_Video, Header_fb_fr_name_Video,
SymbolsConverter.ASCII.EncodeSymbolsOnly(Token_dtsg),
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(VarPattern, If(Cursor.IsEmptyString, "null", $"""{Cursor}"""), VideoPageID) & "}"))
ResponserApplyDefs(Header_fb_fr_name_Video)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
With j({"data", "node", "all_videos", "edges"})
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each jNode As EContainer In .Self
ProgressPre.Perform()
pid = New PostKV(String.Empty, jNode.Value({"node"}, "id"), PageBlock.Videos)
pid.Code = $"Stories:{pid.ID}"
nextCursor = jNode.Value("cursor")
If Not PostKvExists(pid) Then
newPostsDetected = True
PostsKVIDs.ListAddValue(pid, LNC)
_TempPostsList.Add(pid.Code)
_TempMediaList.ListAddValue(New UserMedia(String.Format(VideoHtmlUrlPattern, pid.ID),
UTypes.VideoPre) With {.Post = pid.ID}, LNC)
If Limit > 0 And _TempMediaList.Count >= Limit Then Exit Sub
Else
Exit Sub
End If
Next
End If
End With
End If
End Using
End If
If newPostsDetected And Not nextCursor.IsEmptyString Then DownloadData_Video(nextCursor, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data (video) downloading error [{URL}]",, Responser)
End Try
End Sub
Private Sub DownloadData_Stories(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Const VarPattern$ = """UFI2CommentsProvider_commentsKey"":""StoriesSuspenseContentPaneRootWithEntryPointQuery"",""blur"":10,""bucketID"":""{0}"",""displayCommentsContextEnableComment"":true,""displayCommentsContextIsAdPreview"":false,""displayCommentsContextIsAggregatedShare"":false,""displayCommentsContextIsStorySet"":false,""displayCommentsFeedbackContext"":null,""feedbackSource"":65,""feedLocation"":""COMET_MEDIA_VIEWER"",""focusCommentID"":null,""initialBucketID"":""{0}"",""initialLoad"":true,""isInitialLoadFromCommentsNotification"":false,""isStoriesArchive"":false,""isStoryCommentingEnabled"":false,""scale"":1,""shouldDeferLoad"":false,""shouldEnableArmadilloStoryReply"":false,""shouldEnableLiveInStories"":true,""__relay_internal__pv__StoriesIsCommentEnabledrelayprovider"":false,""__relay_internal__pv__StoriesIsContextualReplyDisabledrelayprovider"":false,""__relay_internal__pv__StoriesIsShareToStoryEnabledrelayprovider"":false,""__relay_internal__pv__StoriesRingrelayprovider"":false,""__relay_internal__pv__StoriesLWRVariantrelayprovider"":""www_new_reactions"""
Try
Dim pUrl$, pUrlBase$
Dim pid As PostKV
Dim t As UTypes
Dim postDate As Date?
ValidateBaseTokens()
If StoryBucket.IsEmptyString Then Throw New ArgumentNullException("StoryBucket", "Unable to obtain StoryBucket")
URL = String.Format(Graphql_UrlPattern, Token_lsd, DocID_Stories, Header_fb_fr_name_Stories,
SymbolsConverter.ASCII.EncodeSymbolsOnly(Token_dtsg),
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(VarPattern, StoryBucket) & "}"))
ResponserApplyDefs(Header_fb_fr_name_Stories)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then r = RegexReplace(r, RParams.DM("[^\r\n]+", 0, EDP.ReturnValue))
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
With j({"data", "bucket", "unified_stories", "edges"})
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each jNode As EContainer In .Self
ProgressPre.Perform()
With jNode({"node"})
If .ListExists Then
pid = New PostKV(.Value("id"), "", Sections.Stories)
With .ItemF({"attachments", 0, "media"})
If .ListExists Then
pid.ID = .Value("id")
pUrl = String.Empty
postDate = AConvert(Of Date)(.Value("creation_time"), UnixDate32Provider, Nothing)
Select Case .Value("__typename")
Case "Photo"
t = UTypes.Picture
pUrl = .Value({"image"}, "uri")
Case "Video"
t = UTypes.Video
pUrl = .Value("browser_native_hd_url").IfNullOrEmpty(.Value("browser_native_sd_url"))
End Select
If Not pUrl.IsEmptyString AndAlso Not PostKvExists(pid) Then
pUrlBase = $"https://www.facebook.com/stories/{StoryBucket}"
PostsKVIDs.Add(pid)
_TempMediaList.ListAddValue(New UserMedia(pUrl, t) With {
.URL_BASE = pUrlBase,
.File = CreateFileFromUrl(pUrl),
.SpecialFolder = $"{StoriesFolder} (user)",
.Post = New UserPost(pid.ID, postDate)}, LNC)
End If
End If
End With
End If
End With
Next
End If
End With
End If
End Using
End If
Catch ex As Exception
ProcessException(ex, Token, $"data (stories) downloading error [{URL}]",, Responser)
End Try
End Sub
Private Sub DownloadData_SavedPosts(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Const VarPattern$ = """content_filter"":[],""count"":10,""cursor"":{0},""scale"":1,""use_case"":""SAVE_DEFAULT"""
Try
Dim nextCursor$ = String.Empty
Dim newPostsDetected As Boolean = False
Dim pUrl$, videoId$, imgUri$
Dim imgFile As SFile
Dim pid As PostKV
ValidateBaseTokens()
URL = String.Format(Graphql_UrlPattern, Token_lsd, DocID_SavedPosts, Header_fb_fr_name_SavedPosts,
SymbolsConverter.ASCII.EncodeSymbolsOnly(Token_dtsg),
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(VarPattern, If(Cursor.IsEmptyString, "null", $"""{Cursor}""")) & "}"))
ResponserApplyDefs(Header_fb_fr_name_SavedPosts)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
With j({"data", "viewer", "saver_info", "all_saves", "edges"})
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each jNode As EContainer In .Self
ProgressPre.Perform()
nextCursor = jNode.Value("cursor")
pid = New PostKV("", jNode.Value({"node"}, "id"), Sections.SavedPosts)
If Not PostKvExists(pid) Then
PostsKVIDs.Add(pid)
newPostsDetected = True
With jNode({"node", "savable"})
If .ListExists Then
pUrl = .Value("savable_permalink")
If Not pUrl.IsEmptyString Then
Select Case .Value("savable_default_category").StringToLower
Case "post_with_photo"
imgUri = .Value({"savable_image"}, "uri")
If Not imgUri.IsEmptyString Then
imgFile = CreateFileFromUrl(imgUri)
If Not imgFile.Name.IsEmptyString Then
ThrowAny(Token)
_TempMediaList.ListAddList(DownloadData_SavedPosts_ParseImagePost(pUrl, imgFile.Name, Token))
End If
End If
Case "video"
videoId = RegexReplace(pUrl, Regex_VideoIDFromURL)
If Not videoId.IsEmptyString Then _
_TempMediaList.ListAddValue(New UserMedia(pUrl, UTypes.VideoPre) With {.Post = videoId}, LNC)
Case Else : Continue For
End Select
End If
End If
End With
End If
Next
End If
End With
End If
End Using
End If
If newPostsDetected And Not nextCursor.IsEmptyString Then DownloadData_SavedPosts(nextCursor, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data (saved posts) downloading error [{URL}]",, Responser)
End Try
End Sub
Private Function DownloadData_SavedPosts_ParseImagePost(ByVal PostUrl As String, ByVal ImageName As String, ByVal Token As CancellationToken,
Optional ByVal Round As Integer = 0) As IEnumerable(Of UserMedia)
Dim resp As Responser = HtmlResponserCreate()
Try
If Round > 0 Then ThrowAny(Token)
Dim script$, newUrl$
Dim jNode As EContainer, jNode2 As EContainer
Dim r$ = resp.GetResponse(PostUrl)
If Not r.IsEmptyString Then
script = RegexReplace(r, RParams.DMS($"<script type=""application/json""[^\>]*data-sjs>([^<]+?{ImageName}[^<]+)<", 1, EDP.ReturnValue))
If Not script.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(script)
If j.ListExists Then
jNode = j.Find(Function(jj) Not jj.Name.IsEmptyString AndAlso jj.Name.ToLower = "prefetch_uris_v2", True)
If jNode.ListExists Then
For Each vNode As EContainer In jNode
newUrl = RegexReplace(vNode.Value("uri"), Regex_PostHtmlFullPicture)
If Not newUrl.IsEmptyString Then _
Return {New UserMedia(newUrl, UTypes.Picture) With {.URL_BASE = PostUrl, .File = CreateFileFromUrl(newUrl)}}
Next
End If
If Round = 0 Then
j.SetSourceReferences()
jNode = j.GetNode(SpecialNode)
If Not jNode Is Nothing AndAlso Not jNode.Value.IsEmptyString AndAlso Not jNode.Source Is Nothing Then
With DirectCast(jNode.Source, EContainer)
If Not .Source Is Nothing Then
newUrl = DirectCast(.Source, EContainer).Value("url")
If Not newUrl.IsEmptyString Then
Dim __data As IEnumerable(Of UserMedia) =
DownloadData_SavedPosts_ParseImagePost(newUrl, CreateFileFromUrl(jNode.Value).Name, Token, Round + 1)
If __data.ListExists Then Return __data
End If
End If
End With
End If
End If
jNode = j.Find(Function(jj) Not jj.Name.IsEmptyString AndAlso jj.Name = "viewer_image", True)
If Not jNode Is Nothing AndAlso Not jNode.Source Is Nothing Then
Dim doRound% = 0
Do : doRound += 1 : jNode = jNode.Source : Loop While doRound <= 30 AndAlso Not jNode Is Nothing AndAlso Not jNode.Name = "nodes"
If Not jNode Is Nothing AndAlso jNode.Name = "nodes" AndAlso jNode.Count > 0 Then
Dim mList As New List(Of UserMedia)
For Each jNode2 In jNode
With jNode2
newUrl = .Value({"media", "viewer_image"}, "uri")
If Not newUrl.IsEmptyString Then _
mList.Add(New UserMedia(newUrl, UTypes.Picture) With {.URL_BASE = PostUrl, .File = CreateFileFromUrl(newUrl)})
End With
Next
Return mList
End If
End If
newUrl = j.GetNode(SpecialNode2).XmlIfNothingValue
If Not newUrl.IsEmptyString Then _
Return {New UserMedia(newUrl, UTypes.Picture) With {.URL_BASE = PostUrl, .File = CreateFileFromUrl(newUrl)}}
End If
End Using
End If
End If
Return Nothing
Catch ex As Exception
ProcessException(ex, Token, $"data (saved posts) downloading error [{PostUrl}]",, resp, False)
Return Nothing
Finally
HtmlResponserDispose(resp)
End Try
End Function
#End Region
#Region "ValidateBaseTokens, GetVideoPageID, GetUserTokens"
''' <exception cref="ArgumentNullException"></exception>
Private Sub ValidateBaseTokens()
If Token_dtsg.IsEmptyString Then Throw New ArgumentNullException("Token_dtsg", "Unable to obtain token")
If Token_lsd.IsEmptyString Then Throw New ArgumentNullException("Token_lsd", "Unable to obtain token")
End Sub
Private Sub GetVideoPageID(ByVal Token As CancellationToken)
Dim URL$ = $"{GetProfileUrl()}\videos"
Dim resp As Responser = HtmlResponserCreate()
Try
Dim r$ = resp.GetResponse(URL)
If Not r.IsEmptyString Then VideoPageID = RegexReplace(r, Regex_VideoPageID)
Catch ex As Exception
ProcessException(ex, Token, "get video page ID",, resp)
Finally
HtmlResponserDispose(resp)
End Try
End Sub
Private Sub GetUserTokens(ByVal Token As CancellationToken)
Dim URL$ = If(IsSavedPosts, "https://www.facebook.com/saved", GetProfileUrl())
Dim resp As Responser = HtmlResponserCreate()
Try
Token_dtsg = String.Empty
Token_lsd = String.Empty
Token_Photosby = String.Empty
Dim r$ = resp.GetResponse(URL)
If Not r.IsEmptyString Then
If Responser.CookiesExists Then Responser.Cookies.Update(resp.Cookies)
Token_dtsg = RegexReplace(r, Regex_UserToken_dtsg)
Token_lsd = RegexReplace(r, Regex_UserToken_lsd)
Token_Photosby = RegexReplace(r, Regex_Photos_by)
If StoryBucket.IsEmptyString Then StoryBucket = RegexReplace(r, Regex_StoryBucket)
If ID.IsEmptyString Then
ID = RegexReplace(r, Regex_UserID)
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
End If
Catch ex As Exception
ProcessException(ex, Token, "get user token",, resp)
Finally
HtmlResponserDispose(resp)
End Try
End Sub
#End Region
#Region "Responser options"
Private Sub ResponserApplyDefs(ByVal __fb_friendly_name As String)
With Responser
.Headers.Add(ThreadsNet.UserData.Header_FB_LSD, Token_lsd)
.Headers.Add(DeclaredNames.Header_FB_FRIENDLY_NAME, __fb_friendly_name)
.Method = "POST"
.Accept = "*/*"
.Referer = GetProfileUrl()
End With
End Sub
Private Function HtmlResponserCreate() As Responser
Dim r As Responser = Responser.Copy
With r
.Accept = CStr(AConvert(Of String)(MySettings.Header_Accept.Value, String.Empty))
.Referer = Nothing
.Method = "GET"
With .Headers
.Clear()
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.facebook.com"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest, "document"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "navigate"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchSite, "none"))
.Add("Sec-Fetch-User", "?1")
.Add("Upgrade-Insecure-Requests", 1)
Dim h$ = Responser.Headers.Value(IG.Header_Browser)
If Not h.IsEmptyString Then .Add(IG.Header_Browser, h)
h = Responser.Headers.Value(IG.Header_BrowserExt)
If Not h.IsEmptyString Then .Add(IG.Header_BrowserExt, h)
h = .Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform))
If Not h.IsEmptyString Then .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform, h))
If ACheck(MySettings.HH_PLATFORM_VER.Value) Then _
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatformVersion, MySettings.HH_PLATFORM_VER.Value))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile, "?0"))
.Add("Sec-Ch-Ua-Model", "")
End With
End With
Return r
End Function
Private Sub HtmlResponserDispose(ByVal r As Responser)
If Not r Is Nothing Then
Responser.Cookies.Update(r.Cookies)
r.Dispose()
End If
End Sub
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Dim resp As Responser = HtmlResponserCreate()
Try
If ContentMissingExists Then
Dim m As UserMedia
Dim result As Boolean
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
m = _ContentList(i)
If (m.State = UStates.Missing And (m.Type = UTypes.Video Or m.Type = UTypes.VideoPre)) AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
result = False
m = ReparseSingleVideo(m, resp, result)
If result Then
rList.Add(i)
m.State = UStates.Missing
_TempMediaList.ListAddValue(m, LNC)
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
HtmlResponserDispose(resp)
End Try
End Sub
#End Region
#Region "ReparseVideo"
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Dim resp As Responser = HtmlResponserCreate()
Try
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.Type = UTypes.VideoPre) Then
ProgressPre.ChangeMax(_TempMediaList.Count)
Dim m As UserMedia
Dim result As Boolean
For i% = 0 To _TempMediaList.Count - 1
m = _TempMediaList(i)
If m.Type = UTypes.VideoPre Then
ThrowAny(Token)
result = False
m = ReparseSingleVideo(m, resp, result)
If Not result Then m.State = UStates.Missing
_TempMediaList(i) = m
End If
ProgressPre.Perform()
Next
End If
Catch ex As Exception
ProcessException(ex, Token, $"video reparsing error [{URL}]",, resp)
Finally
HtmlResponserDispose(resp)
End Try
End Sub
Protected Function ReparseSingleVideo(ByVal m As UserMedia, ByVal resp As Responser, ByRef result As Boolean) As UserMedia
Const nameSD$ = "browser_native_sd_url"
Const nameHD$ = "browser_native_hd_url"
Const pattern$ = "<script type=""application/json""[^\>]*data-sjs>([^<]+?{0}[^<]+)<"
Dim URL$ = String.Empty
Dim j As EContainer = Nothing
Try
Dim r$, script$, __url$
Dim jNode As EContainer
Dim jf As Predicate(Of EContainer) = Function(ee) Not ee.Name.IsEmptyString AndAlso (ee.Name.ToLower = nameSD Or ee.Name.ToLower = nameHD)
Dim re As RParams = RParams.DMS("", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
If m.Post.ID.IsEmptyString Then
URL = m.URL_BASE
Else
URL = String.Format(VideoHtmlUrlPattern, m.Post.ID)
End If
r = resp.GetResponse(URL)
If Not r.IsEmptyString Then
re.Pattern = String.Format(pattern, nameHD)
script = RegexReplace(r, re)
If script.IsEmptyString Then
re.Pattern = String.Format(pattern, nameSD)
script = RegexReplace(r, re)
End If
If Not script.IsEmptyString Then
j = JsonDocument.Parse(script)
If j.ListExists Then
j.SetSourceReferences()
jNode = j.Find(jf, True)
If Not jNode Is Nothing Then
With DirectCast(jNode.Source, EContainer)
__url = .Value(nameHD).IfNullOrEmpty(.Value(nameSD))
If Not __url.IsEmptyString Then
m.URL = __url
m.URL_BASE = URL
m.Type = UTypes.Video
m.File = CreateFileFromUrl(__url)
m.Post.Date = AConvert(Of Date)(.Value("publish_time"), UnixDate32Provider, Nothing)
result = True
Return m
End If
End With
End If
End If
End If
End If
Catch ex As Exception
End Try
j.DisposeIfReady
result = False
Return m
End Function
#End Region
#Region "CreateFileFromUrl"
Protected Overrides Function CreateFileFromUrl(ByVal URL As String) As SFile
If Not URL.IsEmptyString Then
Dim f$ = RegexReplace(URL, Regex_FileName)
If Not f.IsEmptyString Then
Return f
Else
Dim ff As New SFile(URL)
If Not ff.Extension.IsEmptyString Then
If ff.Length > 4 Then ff.Extension = ff.Extension.Split("?").FirstOrDefault
ff.Extension = ff.Extension.StringRemoveWinForbiddenSymbols
End If
ff.Name = ff.Name.StringRemoveWinForbiddenSymbols
Return ff
End If
End If
Return String.Empty
End Function
#End Region
#Region "DownloadContent"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
#End Region
#Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
_ContentList.Add(New UserMedia(Data.URL, UTypes.VideoPre) With {.Post = CStr(AConvert(Of String)(Data.URL, Regex_VideoIDFromURL, String.Empty))})
ReparseMissing(Token)
End Sub
#End Region
#Region "ThrowAny"
Friend Overrides Sub ThrowAny(ByVal Token As CancellationToken)
ThrowAnyImpl(Token)
End Sub
#End Region
#Region "Exception"
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

@@ -0,0 +1,32 @@
' 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.Plugin.Attributes
Namespace API.Facebook
Friend Class UserExchangeOptions
<PSetting(NameOf(SiteSettings.ParsePhotoBlock), NameOf(MySettings))>
Friend Property ParsePhotoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseVideoBlock), NameOf(MySettings))>
Friend Property ParseVideoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseStoriesBlock), NameOf(MySettings))>
Friend Property ParseStoriesBlock As Boolean = True
Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
MySettings = u.HostCollection.Default.Source
ParsePhotoBlock = u.ParsePhotoBlock
ParseVideoBlock = u.ParseVideoBlock
ParseStoriesBlock = u.ParseStoriesBlock
End Sub
Friend Sub New(ByVal s As SiteSettings)
MySettings = s
ParsePhotoBlock = s.ParsePhotoBlock.Value
ParseVideoBlock = s.ParseVideoBlock.Value
ParseStoriesBlock = s.ParseStoriesBlock.Value
End Sub
End Class
End Namespace

View File

@@ -39,8 +39,8 @@ Namespace API.Gfycat
If Not urlVideo.IsEmptyString Then
If urlVideo.Contains("redgifs.com") Then
_IsRedGifs = True
DirectCast(Settings(RedGifs.RedGifsSiteKey).Source, RedGifs.SiteSettings).UpdateTokenIfRequired()
Dim newData As IYouTubeMediaContainer = Settings(RedGifs.RedGifsSiteKey).GetSingleMediaInstance(urlVideo, Data.File)
DirectCast(Settings(RedGifs.RedGifsSiteKey).Default.Source, RedGifs.SiteSettings).UpdateTokenIfRequired()
Dim newData As IYouTubeMediaContainer = Settings(RedGifs.RedGifsSiteKey).Default.GetSingleMediaInstance(urlVideo, Data.File)
If Not newData Is Nothing Then
newData.Progress = Data.Progress
newData.Download(Data.UseCookies, Token)
@@ -49,7 +49,7 @@ Namespace API.Gfycat
With DirectCast(Data, YouTubeMediaContainerBase)
.Site = RedGifs.RedGifsSite
.SiteKey = RedGifs.RedGifsSiteKey
.SiteIcon = Settings(RedGifs.RedGifsSiteKey).Source.Image
.SiteIcon = Settings(RedGifs.RedGifsSiteKey).Default.Source.Image
End With
Else
Throw New Exception($"Unable to get RedGifs instance{vbCr}{Data.URL}{vbCr}{urlVideo}")

View File

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

View File

@@ -10,9 +10,6 @@ Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Objects
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
@@ -21,18 +18,6 @@ Namespace API.Instagram
<Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
#Region "Images"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.InstagramIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.InstagramPic_76
End Get
End Property
#End Region
#Region "Providers"
Private Class TimersChecker : Inherits FieldsCheckerProviderBase
Private ReadOnly LVProvider As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
@@ -70,30 +55,31 @@ Namespace API.Instagram
End Class
#End Region
#Region "Authorization properties"
Private Const Header_IG_APP_ID As String = "x-ig-app-id"
Friend Const Header_IG_APP_ID As String = "x-ig-app-id"
Friend Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Friend Const Header_CSRF_TOKEN As String = "x-csrftoken"
Private Const Header_ASBD_ID As String = "X-Asbd-Id"
Private Const Header_Browser As String = "Sec-Ch-Ua"
Private Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
Private Const Header_Platform As String = "Sec-Ch-Ua-Platform-Version"
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash for tagged posts", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)>
Friend Const Header_CSRF_TOKEN_COOKIE As String = "csrftoken"
Friend Const Header_ASBD_ID As String = "X-Asbd-Id"
Friend Const Header_Browser As String = "Sec-Ch-Ua"
Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
Friend Const Header_Platform As String = "Sec-Ch-Ua-Platform-Version"
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash for tagged posts", IsAuth:=True), PXML("InstaHash"), ControlNumber(0), PClonable(Clone:=False)>
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), PClonable(Clone:=False)>
Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3)>
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3), PClonable(Clone:=False)>
Friend Property HH_IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-asbd-id", IsAuth:=True, AllowNull:=True), ControlNumber(4)>
<PropertyOption(ControlText:="x-asbd-id", IsAuth:=True, AllowNull:=True), ControlNumber(4), PClonable(Clone:=False)>
Friend Property HH_ASBD_ID As PropertyValue
<PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=True), ControlNumber(5)>
<PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=True), ControlNumber(5), PClonable(Clone:=False)>
Friend Property HH_IG_WWW_CLAIM As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua", IsAuth:=True, AllowNull:=True), ControlNumber(6)>
<PropertyOption(ControlText:="sec-ch-ua", IsAuth:=True, AllowNull:=True), ControlNumber(6), PClonable>
Private Property HH_BROWSER As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", IsAuth:=True, AllowNull:=True), ControlNumber(7)>
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", IsAuth:=True, AllowNull:=True), ControlNumber(7), PClonable>
Private Property HH_BROWSER_EXT As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", IsAuth:=True, AllowNull:=True), ControlNumber(8)>
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", IsAuth:=True, AllowNull:=True), ControlNumber(8), PClonable>
Private Property HH_PLATFORM As PropertyValue
<PropertyOption(ControlText:="UserAgent", IsAuth:=True, AllowNull:=True), ControlNumber(9)>
<PropertyOption(ControlText:="UserAgent", IsAuth:=True, AllowNull:=True), ControlNumber(9), PClonable>
Private Property HH_USER_AGENT As PropertyValue
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists And ACheck(HH_IG_APP_ID.Value) And ACheck(HH_CSRF_TOKEN.Value)
@@ -123,68 +109,69 @@ Namespace API.Instagram
End Sub
#End Region
#Region "Download properties"
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(20)>
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(20), PClonable>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider
<PropertyOption(ControlText:="Request timer counter", AllowNull:=False, LeftOffset:=120), PXML("RequestsWaitTimerTaskCount"), ControlNumber(21)>
<PropertyOption(ControlText:="Request timer counter", AllowNull:=False, LeftOffset:=120), PXML("RequestsWaitTimerTaskCount"), ControlNumber(21), PClonable>
Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue
<Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider
<PropertyOption(ControlText:="Posts limit timer", AllowNull:=False), PXML("SleepTimerOnPostsLimit"), ControlNumber(22)>
<PropertyOption(ControlText:="Posts limit timer", AllowNull:=False), PXML("SleepTimerOnPostsLimit"), ControlNumber(22), PClonable>
Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue
<Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider
<PropertyOption(ControlText:="Get timeline", ControlToolTip:="Default value for new users"), PXML, ControlNumber(23)>
<PropertyOption(ControlText:="Get timeline", ControlToolTip:="Default value for new users"), PXML, ControlNumber(23), PClonable>
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), PClonable>
Friend ReadOnly Property GetStories As PropertyValue
<PropertyOption(ControlText:="Get stories: user", ControlToolTip:="Default value for new users"), PXML, ControlNumber(25)>
<PropertyOption(ControlText:="Get stories: user", ControlToolTip:="Default value for new users"), PXML, ControlNumber(25), PClonable>
Friend ReadOnly Property GetStoriesUser As PropertyValue
<PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), PXML, ControlNumber(26)>
<PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), PXML, ControlNumber(26), PClonable>
Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr &
"-1 to disable"), PXML, ControlNumber(27)>
"-1 to disable"), PXML, ControlNumber(27), PClonable>
Friend ReadOnly Property TaggedNotifyLimit As PropertyValue
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region
#Region "Download ready"
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline"), PXML, ControlNumber(10)>
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline"), PXML, ControlNumber(10), PClonable>
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), PClonable>
Friend ReadOnly Property DownloadStories As PropertyValue
<PropertyOption(ControlText:="Download stories: user", ControlToolTip:="Download stories (user)"), PXML, ControlNumber(12)>
<PropertyOption(ControlText:="Download stories: user", ControlToolTip:="Download stories (user)"), PXML, ControlNumber(12), PClonable>
Friend ReadOnly Property DownloadStoriesUser As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(13)>
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(13), PClonable>
Friend ReadOnly Property DownloadTagged As PropertyValue
#End Region
#Region "429 bypass"
Private ReadOnly Property DownloadingErrorDate As XMLValue(Of Date)
<PXML("InstagramDownloadingErrorDate")>
Private ReadOnly Property DownloadingErrorDate As PropertyValue
Friend Property LastApplyingValue As Integer? = Nothing
Friend ReadOnly Property ReadyForDownload As Boolean
Get
If SkipUntilNextSession Then Return False
With DownloadingErrorDate
If .ValueF.Exists Then
Return .ValueF.Value.AddMinutes(If(LastApplyingValue, 10)) < Now
If ACheck(Of Date)(.Value) Then
Return CDate(.Value).AddMinutes(If(LastApplyingValue, 10)) < Now
Else
Return True
End If
End With
End Get
End Property
Private ReadOnly Property LastDownloadDate As XMLValue(Of Date)
Private ReadOnly Property LastRequestsCount As XMLValue(Of Integer)
<PXML> Private ReadOnly Property LastDownloadDate As PropertyValue
<PXML> Private ReadOnly Property LastRequestsCount As PropertyValue
<PropertyOption(IsInformationLabel:=True), ControlNumber(100)>
Private Property LastRequestsCountLabel As PropertyValue
Private ReadOnly LastRequestsCountLabelStr As Func(Of Integer, String) = Function(r) $"Number of spent requests: {r.NumToGroupIntegral}"
Private TooManyRequestsReadyForCatch As Boolean = True
Friend Function GetWaitDate() As Date
With DownloadingErrorDate
If .ValueF.Exists Then
Return .ValueF.Value.AddMinutes(If(LastApplyingValue, 10))
If ACheck(Of Date)(.Value) Then
Return CDate(.Value).AddMinutes(If(LastApplyingValue, 10))
Else
Return Now
End If
@@ -193,7 +180,7 @@ Namespace API.Instagram
Friend Sub TooManyRequests(ByVal Catched As Boolean)
With DownloadingErrorDate
If Catched Then
If Not .ValueF.Exists Then
If Not ACheck(Of Date)(.Value) Then
.Value = Now
If TooManyRequestsReadyForCatch Then
LastApplyingValue = If(LastApplyingValue, 0) + 10
@@ -202,7 +189,7 @@ Namespace API.Instagram
End If
End If
Else
.ValueF = Nothing
.Value = Nothing
LastApplyingValue = Nothing
TooManyRequestsReadyForCatch = True
End If
@@ -211,8 +198,8 @@ Namespace API.Instagram
#End Region
#End Region
#Region "Initializer"
Friend Sub New(ByRef _XML As XmlFile, ByVal GlobalPath As SFile)
MyBase.New(InstagramSite, "instagram.com")
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New(InstagramSite, "instagram.com", AccName, Temp, My.Resources.SiteResources.InstagramIcon_32, My.Resources.SiteResources.InstagramPic_76)
Dim app_id$ = String.Empty
Dim www_claim$ = String.Empty
@@ -225,7 +212,7 @@ Namespace API.Instagram
With Responser
.Accept = "*/*"
useragent = .UserAgent
If .UserAgentExists Then useragent = .UserAgent Else .UserAgent = String.Empty
With .Headers
If .Count > 0 Then
token = .Value(Header_CSRF_TOKEN)
@@ -249,8 +236,6 @@ Namespace API.Instagram
.CookiesExtractedAutoSave = False
End With
Dim n() As String = {SettingsCLS.Name_Node_Sites, Site.ToString}
HashTagged = New PropertyValue(String.Empty, GetType(String))
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))
@@ -280,12 +265,11 @@ Namespace API.Instagram
TaggedNotifyLimit = New PropertyValue(200)
TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
DownloadingErrorDate = New XMLValue(Of Date) With {.Provider = New XMLValueConversionProvider(Function(ss, nn, vv, dd) AConvert(Of String)(vv, AModes.Var, Nothing))}
DownloadingErrorDate.SetExtended("InstagramDownloadingErrorDate", Now.AddYears(-10), _XML, n)
LastDownloadDate = New XMLValue(Of Date)("LastDownloadDate", Now.AddDays(-1), _XML, n)
LastRequestsCount = New XMLValue(Of Integer)("LastRequestsCount", 0, _XML, n)
DownloadingErrorDate = New PropertyValue(Nothing, GetType(Date))
LastDownloadDate = New PropertyValue(Now.AddDays(-1))
LastRequestsCount = New PropertyValue(0)
LastRequestsCountLabel = New PropertyValue(LastRequestsCountLabelStr.Invoke(LastRequestsCount.Value))
AddHandler LastRequestsCount.ValueChanged, Sub(sender, e) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(DirectCast(sender, XMLValue(Of Integer)).ValueF.Value)
LastRequestsCount.OnChangeFunction = Sub(vv) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(vv)
_AllowUserAgentUpdate = False
UrlPatternUser = "https://www.instagram.com/{0}/"
@@ -328,7 +312,7 @@ Namespace API.Instagram
Private _NextTagged As Boolean = True
Friend Overrides Sub DownloadStarted(ByVal What As Download)
ActiveJobs += 1
If LastDownloadDate.Value.AddMinutes(120) < Now Or Not ACheck(HH_IG_WWW_CLAIM.Value) Then HH_IG_WWW_CLAIM.Value = "0"
If CDate(LastDownloadDate.Value).AddMinutes(120) < Now Or Not ACheck(HH_IG_WWW_CLAIM.Value) Then HH_IG_WWW_CLAIM.Value = "0"
End Sub
Friend Overrides Sub BeforeStartDownload(ByVal User As Object, ByVal What As Download)
With DirectCast(User, UserData)
@@ -336,8 +320,8 @@ Namespace API.Instagram
.WaitNotificationMode = _NextWNM
.TaggedCheckSession = _NextTagged
End If
If LastDownloadDate.Value.AddMinutes(60) > Now Then
.RequestsCount = LastRequestsCount
If CDate(LastDownloadDate.Value).AddMinutes(60) > Now Then
.RequestsCount = LastRequestsCount.Value
Else
LastRequestsCount.Value = 0
.RequestsCount = 0
@@ -365,13 +349,16 @@ Namespace API.Instagram
SkipUntilNextSession = False
End Sub
#End Region
#Region "UserOptions, GetUserPostUrl"
#Region "UserOptions, GetUserUrl, GetUserPostUrl"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is EditorExchangeOptions Then Options = New EditorExchangeOptions(Me)
If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
End Sub
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return String.Format(UrlPatternUser, DirectCast(User, UserData).NameTrue)
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Try
Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID)

View File

@@ -17,6 +17,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Instagram
Friend Class UserData : Inherits UserDataBase
#Region "XML Names"
@@ -30,7 +31,7 @@ Namespace API.Instagram
Private Const Name_NameTrue As String = "NameTrue"
#End Region
#Region "Declarations"
Private Structure PostKV : Implements IEContainerProvider
Protected Structure PostKV : Implements IEContainerProvider
Private Const Name_Code As String = "Code"
Private Const Name_Section As String = "Section"
Friend Code As String
@@ -70,7 +71,7 @@ Namespace API.Instagram
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
Private ReadOnly PostsKVIDs As List(Of PostKV)
Protected ReadOnly PostsKVIDs As List(Of PostKV)
Private ReadOnly PostsToReparse As List(Of PostKV)
Private LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = False
@@ -78,8 +79,8 @@ Namespace API.Instagram
Friend Property GetStories As Boolean
Friend Property GetStoriesUser As Boolean
Friend Property GetTaggedData As Boolean
Private _NameTrue As String = String.Empty
Private ReadOnly Property NameTrue As String
Protected _NameTrue As String = String.Empty
Friend ReadOnly Property NameTrue As String
Get
Return _NameTrue.IfNullOrEmpty(Name)
End Get
@@ -143,12 +144,22 @@ Namespace API.Instagram
Throw New ExitException
End Sub
End Class
Private Sub LoadSavePostsKV(ByVal Load As Boolean)
Private ReadOnly Property MyFilePostsKV As SFile
Get
Dim f As SFile = MyFilePosts
If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
Return f
Else
Return Nothing
End If
End Get
End Property
Protected Sub LoadSavePostsKV(ByVal Load As Boolean)
Dim x As XmlFile
Dim f As SFile = MyFilePosts
Dim f As SFile = MyFilePostsKV
If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
If Load Then
PostsKVIDs.Clear()
x = New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
@@ -164,7 +175,7 @@ Namespace API.Instagram
End If
End If
End Sub
Private Overloads Function PostKvExists(ByVal pkv As PostKV) As Boolean
Protected Overloads Function PostKvExists(ByVal pkv As PostKV) As Boolean
Return PostKvExists(pkv.ID, False, pkv.Section) OrElse PostKvExists(pkv.Code, True, pkv.Section)
End Function
Private Overloads Function PostKvExists(ByVal PostCodeId As String, ByVal IsCode As Boolean, ByVal Section As Sections) As Boolean
@@ -182,10 +193,8 @@ Namespace API.Instagram
Friend Function GetPostCodeById(ByVal PostID As String) As String
Try
If Not PostID.IsEmptyString Then
Dim f As SFile = MyFilePosts
Dim f As SFile = MyFilePostsKV
If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
Dim l As List(Of PostKV) = Nothing
Using x As New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
@@ -213,11 +222,15 @@ Namespace API.Instagram
End If
End Function
Private _DownloadingInProgress As Boolean = False
Private _Limit As Integer = -1
Private _TotalPostsParsed As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
UserNameRequested = False
Dim s As Sections = Sections.Timeline
Dim errorFound As Boolean = False
Try
_Limit = If(DownloadTopCount, -1)
_TotalPostsParsed = 0
LoadSavePostsKV(True)
_DownloadingInProgress = True
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
@@ -270,7 +283,7 @@ Namespace API.Instagram
Catch ex As Exception
End Try
End Sub
Private Sub UpdateResponser()
Protected Overridable Sub UpdateResponser()
Try
If _DownloadingInProgress AndAlso Not Responser Is Nothing AndAlso Not Responser.Disposed Then
_DownloadingInProgress = False
@@ -280,11 +293,11 @@ Namespace API.Instagram
Catch
End Try
End Sub
Private Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
Protected Overridable Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
Declarations.UpdateResponser(e, Responser)
End Sub
Private Enum Sections : Timeline : Tagged : Stories : UserStories : SavedPosts : End Enum
Private Const StoriesFolder As String = "Stories"
Protected Enum Sections : Timeline : Tagged : Stories : UserStories : SavedPosts : End Enum
Protected Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass"
Private Const MaxPostsCount As Integer = 200
@@ -572,6 +585,7 @@ Namespace API.Instagram
Dim URL$ = String.Empty
Dim dValue% = 1
Dim _Index% = 0
Dim before%
If PostsToReparse.Count > 0 Then ProgressPre.ChangeMax(PostsToReparse.Count)
Try
Do While dValue = 1
@@ -600,7 +614,12 @@ Namespace API.Instagram
If Not j Is Nothing Then
If If(j("items")?.Count, 0) > 0 Then
With j("items")
For Each jj In .Self : ObtainMedia(jj, PostsToReparse(i).ID) : Next
For Each jj In .Self
before = _TempMediaList.Count
ObtainMedia(jj, PostsToReparse(i).ID)
If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
If _Limit > 0 And _TotalPostsParsed >= _Limit Then Throw New ExitException
Next
End With
End If
j.Dispose()
@@ -643,13 +662,18 @@ Namespace API.Instagram
End Using
End If
End Sub
Private Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
Optional ByVal SpecFolder As String = Nothing) As Boolean
Protected DefaultParser_ElemNode() As Object = Nothing
Protected DefaultParser_IgnorePass As Boolean = False
Protected DefaultParser_PostUrlCreator As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/"
Protected Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
Optional ByVal SpecFolder As String = Nothing, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0) As Boolean
ThrowAny(Token)
If Items.Count > 0 Then
Dim PostIDKV As PostKV
Dim Pinned As Boolean
Dim PostDate$
Dim PostDate$, PostOriginUrl$
Dim before%
If SpecFolder.IsEmptyString Then
Select Case Section
Case Sections.Tagged : SpecFolder = TaggedFolder
@@ -660,22 +684,26 @@ Namespace API.Instagram
ProgressPre.ChangeMax(Items.Count)
For Each nn In Items
ProgressPre.Perform()
With nn
With If(Not DefaultParser_ElemNode Is Nothing, nn.ItemF(DefaultParser_ElemNode), nn)
PostIDKV = New PostKV(.Value("code"), .Value("id"), Section)
PostOriginUrl = DefaultParser_PostUrlCreator(PostIDKV)
Pinned = .Contains("timeline_pinned_user_ids")
If PostKvExists(PostIDKV) Then
If Not DefaultParser_IgnorePass AndAlso PostKvExists(PostIDKV) Then
If Not Pinned Then Return False
Else
_TempPostsList.Add(PostIDKV.ID)
PostsKVIDs.ListAddValue(PostIDKV, LNC)
PostDate = .Value("taken_at")
If Not IsSavedPosts Then
If Not DefaultParser_IgnorePass And Not IsSavedPosts Then
Select Case CheckDatesLimit(PostDate, UnixDate32Provider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : If Not Pinned Then Return False
End Select
End If
ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate)
before = _TempMediaList.Count
ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate,, PostOriginUrl, State, Attempts)
If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
If _Limit > 0 And _TotalPostsParsed >= _Limit Then Return False
End If
End With
Next
@@ -686,7 +714,7 @@ Namespace API.Instagram
End Function
#End Region
#Region "Code ID converters"
Private Function CodeToID(ByVal Code As String) As String
Protected Function CodeToID(ByVal Code As String) As String
Const CodeSymbols$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
Try
If Not Code.IsEmptyString Then
@@ -706,12 +734,20 @@ Namespace API.Instagram
End Function
#End Region
#Region "Obtain Media"
Private Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj As String = Nothing)
Protected ObtainMedia_SizeFuncVid As Func(Of EContainer, Sizes) = Nothing
Protected ObtainMedia_SizeFuncPic As Func(Of EContainer, Sizes) = Nothing
Protected ObtainMedia_AllowAbstract As Boolean = False
Protected Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj As String = Nothing, Optional ByVal InitialType As Integer = -1,
Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0)
Try
Dim wrongData As Predicate(Of Sizes) = Function(_ss) _ss.HasError Or _ss.Data.IsEmptyString
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0
Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url"))
Dim ssVid As Func(Of EContainer, Sizes) = ss
Dim ssPic As Func(Of EContainer, Sizes) = ss
Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String
If Not DateObj.IsEmptyString Then Return DateObj
If elem.Contains("taken_at") Then
@@ -731,28 +767,41 @@ Namespace API.Instagram
End If
End If
End Function
If Not ObtainMedia_SizeFuncVid Is Nothing Then ssVid = ObtainMedia_SizeFuncVid
If Not ObtainMedia_SizeFuncPic Is Nothing Then ssPic = ObtainMedia_SizeFuncPic
If n.Count > 0 Then
Dim l As New List(Of Sizes)
Dim d As EContainer
Dim t%
Dim abstractDecision As Boolean = False
'8 - gallery
'2 - one video
'1 - one picture
t = n.Value("media_type").FromXML(Of Integer)(-1)
If t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then
If n.Contains(vid) Then
t = 2
abstractDecision = True
ElseIf n.Contains(img) Then
t = 1
abstractDecision = True
End If
End If
If t >= 0 Then
Select Case t
Case 1
If n.Contains(img) Then
t = n.Value("media_type").FromXML(Of Integer)(-1)
If Not abstractDecision Then t = n.Value("media_type").FromXML(Of Integer)(-1)
DateObj = mDate(n)
If t >= 0 Then
With n.ItemF({img, "candidates"}).XmlIfNothing
If .Count > 0 Then
l.Clear()
l.ListAddList(.Select(ss), LNC)
l.ListAddList(.Select(ssPic), LNC)
If l.Count > 0 Then l.RemoveAll(wrongData)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl, State, Attempts), LNC)
l.Clear()
End If
End If
@@ -765,10 +814,11 @@ Namespace API.Instagram
With n.ItemF({vid}).XmlIfNothing
If .Count > 0 Then
l.Clear()
l.ListAddList(.Select(ss), LNC)
l.ListAddList(.Select(ssVid), LNC)
If l.Count > 0 Then l.RemoveAll(wrongData)
If l.Count > 0 Then
l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl, State, Attempts), LNC)
l.Clear()
End If
End If
@@ -778,7 +828,7 @@ Namespace API.Instagram
DateObj = mDate(n)
With n("carousel_media").XmlIfNothing
If .Count > 0 Then
For Each d In .Self : ObtainMedia(d, PostID, SpecialFolder, DateObj) : Next
For Each d In .Self : ObtainMedia(d, PostID, SpecialFolder, DateObj, 8, PostOriginUrl) : Next
End If
End With
End Select
@@ -923,7 +973,8 @@ Namespace API.Instagram
Try
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/highlights/{ID}/highlights_tray/",, EDP.ThrowException)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing()("tray").XmlIfNothing
Dim ee As New ErrorsDescriber(EDP.ReturnValue) With {.DeclaredMessage = New MMessage($"{ToStringForLog()}:")}
Using j As EContainer = JsonDocument.Parse(r, ee).XmlIfNothing()("tray").XmlIfNothing
If j.Count > 0 Then Return j.Select(Function(jj) jj.Value("id").Replace("highlight:", String.Empty)).ListIfNothing
End Using
End If
@@ -939,6 +990,12 @@ Namespace API.Instagram
DownloadContentDefault(Token)
End Sub
#End Region
#Region "Erase"
Protected Overrides Sub EraseData_AdditionalDataFiles()
Dim f As SFile = MyFilePostsKV
If f.Exists Then f.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.ReturnValue)
End Sub
#End Region
#Region "Exceptions"
''' <exception cref="ExitException"></exception>
''' <inheritdoc cref="UserDataBase.ThrowAny(CancellationToken)"/>
@@ -954,7 +1011,7 @@ Namespace API.Instagram
Optional ByVal s As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then '404
If Not UserNameRequested AndAlso GetUserNameById() Then Return 1 Else UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then '400
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Or Responser.StatusCode = HttpStatusCode.Unauthorized Then '400, 401
HasError = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
DisableSection(s)
@@ -996,12 +1053,14 @@ Namespace API.Instagram
#End Region
#Region "Create media"
Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal SpecialFolder As String = Nothing) As UserMedia
Optional ByVal SpecialFolder As String = Nothing, Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}}
Dim m As New UserMedia(_URL, t) With {.URL_BASE = PostOriginUrl.IfNullOrEmpty(_URL), .Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, UnixDate32Provider, Nothing) Else m.Post.Date = Nothing
m.SpecialFolder = SpecialFolder
If State = UStates.Missing Then m.State = UStates.Missing : m.Attempts = Attempts
Return m
End Function
#End Region

View File

@@ -24,6 +24,7 @@ Namespace API.JustForFans
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)
@@ -37,20 +38,24 @@ Namespace API.JustForFans
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 _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 = 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)
@@ -101,49 +106,15 @@ Namespace API.JustForFans
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)))).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)
For i = 0 To .Count - 1
tmpFile.Name = $"ConPart_{i}"
Thrower.ThrowAny()
Responser.DownloadFile(.Item(i), tmpFile)
ProgressPerform()
tmpCache.AddFile(tmpFile, True)
bat.AppendLine($"type {tmpFile.File} >> {cFile.File}")
Next
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
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
@@ -156,7 +127,7 @@ Namespace API.JustForFans
End Try
End Sub
Private Async Sub Batch_OutputDataReceived(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
Await Task.Run(Sub() ProgressPerform())
Await Task.Run(Sub() If Not e.Data.IsEmptyString AndAlso e.Data.Contains("] Opening") Then ProgressPerform())
End Sub
Private Sub MergeFiles()
Try
@@ -194,8 +165,8 @@ Namespace API.JustForFans
#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) As SFile
Using m As New M3U8(Media, DestinationFile, Resp, Thrower, Progress, UsePreProgress)
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
@@ -210,6 +181,7 @@ Namespace API.JustForFans
DataAudio.Clear()
ProgressPre.DisposeIfReady
Cache.Dispose()
If ResponserInternal Then Responser.DisposeIfReady
End If
disposedValue = True
End If

View File

@@ -15,32 +15,22 @@ 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>
<PropertyOption(ControlText:="User ID", AllowNull:=False), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property UserID As PropertyValue
<PropertyOption, PXML>
<PropertyOption, PXML, PClonable(Clone:=False)>
Friend ReadOnly Property UserHash4 As PropertyValue
<PropertyOption(ControlText:="Accept", ControlToolTip:="Header 'Accept'")>
<PropertyOption(ControlText:="Accept", ControlToolTip:="Header 'Accept'"), PClonable>
Friend ReadOnly Property HeaderAccept As PropertyValue
<PropertyOption> Friend ReadOnly Property UserAgent As PropertyValue
<PropertyOption, PClonable> 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")
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("JustForFans", "justfor.fans", AccName, Temp, My.Resources.SiteResources.JFFIcon_64, My.Resources.SiteResources.JFFPic_76)
With Responser
.CookiesExtractMode = Responser.CookiesExtractModes.Any
@@ -53,7 +43,7 @@ Namespace API.JustForFans
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))
UserAgent = New PropertyValue(If(Responser.UserAgentExists, Responser.UserAgent, String.Empty), GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v))
_AllowUserAgentUpdate = False
UserRegex = RParams.DMS("https://justfor.fans/([^/\?]+)", 1, EDP.ReturnValue)
@@ -82,7 +72,7 @@ Namespace API.JustForFans
End If
End Sub
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return Responser.CookiesExists And ACheck(UserID.Value) And ACheck(UserHash4.Value)
Return Settings.FfmpegFile.Exists And Responser.CookiesExists And ACheck(UserID.Value) And ACheck(UserHash4.Value)
End Function
End Class
End Namespace

View File

@@ -168,7 +168,6 @@ Namespace API.JustForFans
#Region "Initializer"
Friend Sub New()
UseInternalM3U8Function = True
UseResponserClient = True
End Sub
#End Region
#Region "Download functions"
@@ -176,10 +175,13 @@ Namespace API.JustForFans
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
FileSerialInstance = New FileSerial(DownloadContentDefault_GetRootDir())
InitializeFileSerial()
Responser.Cookies.Changed = False
If Not ResponserNoHandlers Is Nothing Then ResponserNoHandlers.Dispose() : ResponserNoHandlers = Nothing
ResponserNoHandlers = Responser.Copy
@@ -233,11 +235,13 @@ Namespace API.JustForFans
Select Case CheckDatesLimit(post.PostDate, Nothing)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
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
@@ -250,11 +254,12 @@ Namespace API.JustForFans
End Sub
Private Sub GetUserID()
Try
Dim r$, hash$, new_id$
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
@@ -262,8 +267,14 @@ Namespace API.JustForFans
If j.ListExists Then
new_id = j.Value("UserID")
If Not new_id.IsEmptyString Then
new_id = RegexReplace(new_id, RParams.DM("\D", 0, RegexReturn.Replace, CType(Function(input$) String.Empty, Func(Of String, String))))
If Not new_id.IsEmptyString Then ID = new_id : _ForceSaveUserInfo = True
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
@@ -281,8 +292,14 @@ Namespace API.JustForFans
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, ByVal 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
@@ -295,7 +312,7 @@ Namespace API.JustForFans
If .ListExists Then
rList.Add(i)
For Each p In .Self
If p.Valid Then _TempMediaList.ListAddList(p.GetUserMedia(FileSerialInstance), LNC)
If p.Valid Then _TempMediaList.ListAddList(p.GetUserMedia(FileSerialInstance).ListForEachCopy(stateRefill, True), LNC)
Next
End If
End With
@@ -318,7 +335,7 @@ Namespace API.JustForFans
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)
Return M3U8.Download(Media, DestinationFile, ResponserNoHandlers, Me, Progress, Not IsSingleObjectDownload, Token)
End Function
#End Region
#Region "DownloadSingleObject"

View File

@@ -12,18 +12,8 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.LPSG
<Manifest("AndyProgram_LPSG")>
Friend Class SiteSettings : Inherits Base.SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.LPSGIcon_48
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.LPSGPic_32
End Get
End Property
Friend Sub New()
MyBase.New("LPSG", "www.lpsg.com")
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("LPSG", "www.lpsg.com", AccName, Temp, My.Resources.SiteResources.LPSGIcon_48, My.Resources.SiteResources.LPSGPic_32)
UrlPatternUser = "https://www.lpsg.com/threads/{0}/"
UserRegex = RParams.DMS(".+?lpsg.com/threads/[^/]+?\.(\d+)", 1, EDP.ReturnValue)
End Sub

View File

@@ -1,65 +0,0 @@
' 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.Plugin
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Namespace API.Mastodon
Friend Class MastodonDomains : Inherits DomainsContainer
Friend ReadOnly Property Credentials As List(Of Credentials)
Friend ReadOnly Property CredentialsTemp As List(Of Credentials)
Private ReadOnly CredentialsFile As SFile = $"{SettingsFolderName}\Responser_Mastodon_DomainsCredentials.xml"
Friend Sub New(ByVal _Instance As ISiteSettings, ByVal DefaultValue As String)
MyBase.New(_Instance, DefaultValue)
Credentials = New List(Of Credentials)
CredentialsTemp = New List(Of Credentials)
If CredentialsFile.Exists Then
Using x As New XmlFile(CredentialsFile,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then Credentials.ListAddList(x, LAP.IgnoreICopier)
End Using
End If
End Sub
Friend Overrides Function Apply() As Boolean
If Changed Then
Credentials.Clear()
If CredentialsTemp.Count > 0 Then Credentials.AddRange(CredentialsTemp)
CredentialsTemp.Clear()
End If
Return MyBase.Apply()
End Function
Friend Overrides Sub Save()
If Credentials.Count > 0 Then
Using x As New XmlFile With {.AllowSameNames = True}
x.AddRange(Credentials)
x.Name = "DomainsCredentials"
x.Save(CredentialsFile)
End Using
Else
CredentialsFile.Delete(,, EDP.None)
End If
MyBase.Save()
End Sub
Friend Overrides Sub Reset()
CredentialsTemp.Clear()
MyBase.Reset()
End Sub
Friend Overrides Sub OpenSettingsForm()
Using f As New SettingsForm(Instance)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
Changed = True
CredentialsTemp.Clear()
If f.MyCredentials.Count > 0 Then CredentialsTemp.AddRange(f.MyCredentials)
DomainsTemp.Clear()
If f.MyDomains.Count > 0 Then DomainsTemp.ListAddList(f.MyDomains, LAP.NotContainsOnly)
End If
End Using
End Sub
End Class
End Namespace

View File

@@ -1,165 +0,0 @@
' 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.Mastodon
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class SettingsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(SettingsForm))
Dim ActionButton2 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 ActionButton5 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton6 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.CMB_DOMAINS = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.TXT_AUTH = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_TOKEN = New PersonalUtilities.Forms.Controls.TextBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
CType(Me.CMB_DOMAINS, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_AUTH, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_TOKEN, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(384, 361)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(384, 361)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_MAIN.Controls.Add(Me.CMB_DOMAINS, 0, 0)
TP_MAIN.Controls.Add(Me.TXT_AUTH, 0, 1)
TP_MAIN.Controls.Add(Me.TXT_TOKEN, 0, 2)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 3
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.Size = New System.Drawing.Size(384, 361)
TP_MAIN.TabIndex = 0
'
'CMB_DOMAINS
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Add"
ActionButton1.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Add
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Delete"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Delete
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Clear"
ActionButton3.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "ArrowDown"
ActionButton4.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.ArrowDown
ActionButton4.Visible = False
Me.CMB_DOMAINS.Buttons.Add(ActionButton1)
Me.CMB_DOMAINS.Buttons.Add(ActionButton2)
Me.CMB_DOMAINS.Buttons.Add(ActionButton3)
Me.CMB_DOMAINS.Buttons.Add(ActionButton4)
Me.CMB_DOMAINS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_DOMAINS.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple
Me.CMB_DOMAINS.Location = New System.Drawing.Point(4, 4)
Me.CMB_DOMAINS.Name = "CMB_DOMAINS"
Me.CMB_DOMAINS.Size = New System.Drawing.Size(378, 296)
Me.CMB_DOMAINS.TabIndex = 0
'
'TXT_AUTH
'
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Name = "Clear"
ActionButton5.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_AUTH.Buttons.Add(ActionButton5)
Me.TXT_AUTH.CaptionText = "Auth"
Me.TXT_AUTH.CaptionToolTipEnabled = True
Me.TXT_AUTH.CaptionToolTipText = "Bearer token"
Me.TXT_AUTH.CaptionWidth = 50.0R
Me.TXT_AUTH.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_AUTH.Location = New System.Drawing.Point(4, 306)
Me.TXT_AUTH.Name = "TXT_AUTH"
Me.TXT_AUTH.Size = New System.Drawing.Size(376, 22)
Me.TXT_AUTH.TabIndex = 1
'
'TXT_TOKEN
'
ActionButton6.BackgroundImage = CType(resources.GetObject("ActionButton6.BackgroundImage"), System.Drawing.Image)
ActionButton6.Name = "Clear"
ActionButton6.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_TOKEN.Buttons.Add(ActionButton6)
Me.TXT_TOKEN.CaptionText = "Token"
Me.TXT_TOKEN.CaptionToolTipEnabled = True
Me.TXT_TOKEN.CaptionToolTipText = "csrf token"
Me.TXT_TOKEN.CaptionWidth = 50.0R
Me.TXT_TOKEN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TOKEN.Location = New System.Drawing.Point(4, 335)
Me.TXT_TOKEN.Name = "TXT_TOKEN"
Me.TXT_TOKEN.Size = New System.Drawing.Size(376, 22)
Me.TXT_TOKEN.TabIndex = 2
'
'SettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(384, 361)
Me.Controls.Add(CONTAINER_MAIN)
Me.Icon = Global.SCrawler.My.Resources.SiteResources.MastodonIcon_48
Me.MinimumSize = New System.Drawing.Size(400, 400)
Me.Name = "SettingsForm"
Me.ShowInTaskbar = False
Me.Text = "Mastodon domains"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
CType(Me.CMB_DOMAINS, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_AUTH, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_TOKEN, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Private WithEvents CMB_DOMAINS As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents TXT_AUTH As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_TOKEN As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class
End Namespace

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