2023.8.6.0

Plugins.Attributes: add 'DependentFields' attribute
Plugins.IPluginContentProvider: add 'Options' and 'IsSubscription' properties
Plugins.ISiteSettings: add 'SubscriptionsAllowed' property
Plugins.ExchangeOptions: add 'Options' field
Plugins.Attributes.PropertyUpdater: replace 'Dependencies' with 'Arguments'

YT: add 'OutputPathAskForName' and 'OutputPathAutoAddPaths' properties; add the ability to store download locations; add 'DownloadLocation' and 'DownloadLocationsCollection' objects
YT.IDownloaderSettings: add 'OutputPathAskForName' and 'OutputPathAutoAddPaths' properties
YT.Downloader: fixed bug with re-saving elements when loading a video list; fixed bug when files were not deleted when clicking on the delete button; fixed a bug that caused the video to redownload; download job removes elements at wrong indexes; added skipping of downloaded elements in the job; fixed a bug, pending option did not change after download complete
YT.YouTubeMediaContainerBase: add '_MediaStateOnLoad' field and 'NeedToSave' function; update the 'Save' function to prevent saving a file when a download is complete and the file has already been saved; update code for new yt-dlp version

Fixed cache deletion errors
Add user queue
Add global locations
API.Base.SiteSettingsBase: implement 'SubscriptionsAllowed' property; remove request headers with null values on save; add '_AllowUserAgentUpdate' parameter
API.Base.Structures: add 'SiteModes' enum
API.Base.UserDataBase: add 'Erase' button; implement 'Options' and 'IsSubscription' properties; add 'SpecialLabels' property; update 'LVIKey'; update 'FitToAddParams' function; add 'EraseData' function; user colors; Not UserExists notification, UserQueue support
API.Base: add 'DeclaredNames'
API.Instagram: remove default values for headers; disable updating UserAgent from global; check for a new username for non-existent users
API.Mastodon: bypass new inherited twitter options; update names and headers
API.OnlyFans: make 'HH_BROWSER' property nullable; remove 'HH_BROWSER' from required; fix username bug (dots); handling of 504 and 429 errors; add 'DownloadHighlights' and 'DownloadChatMedia' options; add 'UserExchangeOptions'; fixed incorrect error handler
API.PathPlugin: fixed incorrect detection of path existence
API.Pinterest: add 'SpecialLabels'
API.PornHub: add new video regex; remove old regex; added 'DownloadUploaded', 'DownloadTagged', 'DownloadPrivate' and 'DownloadFavorite' properties to 'SiteSettings', 'UserData' and 'UserExchangeOptions'; update regex to define user; added downloading search queries; update 'GetUserUrl' function; hide unnecessary 'RegexFieldsTextBecameNullException' errors; add subscriptions
API.Reddit: add 'SpecialLabels'; add bearer token and its refresh interval; add OAuth; add additional options
API.RedGifs: add 'DependentFields' for 'Token'
API.ThisVid: add 'DownloadFavourite' option; add downloading search queries, tags, categories; add 'SpecialLabels'; add subscriptions; updating cookies issue
API.TikTok: rewrite algorithms
API.Twitter: add 'UseAppropriateModel', 'UseNewEndPointSearch', 'UseNewEndPointProfiles', 'AbortOnLimit', 'DownloadAlreadyParsed', 'MediaModelAllowNonUserTweets' properties; remove old commented code; remove 'TwitterPic_400' and replace with 'TwitterIcon_32.ToBitmap'; add 'DownloadModelForceApply' user option; update environment to GDL 1.25.8; fixed gifs downloading; fix typo in 'ReparseMissing'; update names
API.UserDataBind: prevent adding site-specific labels when adding to a collection
API.Xhamster: add downloading search queries, tags, categories; add 'SpecialLabels'; add additional nodes for channels; add subscriptions
API.XVIDEOS: add downloading search queries, tags, categories; add 'SpecialLabels'; add subscriptions; changed users creation method; add subscriptions
API.YouTube: add subscriptions
AutoDownloader: add new group subscription options; update predicates; fixed excluded labels and sites in default mode; update notifications; add an additional skip options, add 'Force start' option
DownloadedInfoForm: add subscriptions; fixed size/location bug; hide unnecessary error (refill)
Feed: add subscriptions; update filters; add 'Ctrl+G' shortcut
FeedMedia: add subscriptions; fixed 'webm' bug; add title for subscription media; add site icon to post; user colors; always using 'FriendlyName' instead of 'UserName' if it exists
DownloadGroup, GroupDefaults, GroupParameters: add subscription and 'UsersCount' options
MissingPostsForm: add 'BTT_DELETE_ALL'
VideoDownloaderForm, DownloaderUrlForm, DownloaderUrlsArrForm: add download locations support
VideoDownloaderForm: add subscriptions support
GlobalSettingsForm: add new properties
UserCreatorForm: add subscriptions; add 'Options' support (of 'ExchangeOptions'); user colors
ListImagesLoader: add subscription colors; user colors
MainFrame: add subscriptions; add filters by subscription and user; update predicates
NuGet: update 'LibVLCSharp', 'LibVLCSharp.WinForms', 'VideoLAN.LibVLC.Windows'
DownloadableMediaHost: update 'Save' function
PropertyValueHost: fix 'CaptionWidth' bug; add 'Dependents'
SettingsHost: add 'Dependents'
UserDataHost: add 'Options' and 'IsSubscription' properties
SettingsCLS: implement new 'IDownloaderSettings' properties; add 'CacheSnapshots'; add 'DownloadLocations'; add new properties
UserInfo, UserFinder: add subscriptions
UserSearchForm: fixed search by name bug
This commit is contained in:
Andy
2023-08-06 18:16:07 +03:00
parent bade8666d5
commit df06a86651
179 changed files with 9145 additions and 2041 deletions

View File

@@ -30,7 +30,9 @@ A clear and concise description of what you expected to happen.
**Screenshots**
If applicable, add screenshots to help explain your problem.
**Release information (please complete the following information):**
**Release information:**
**Please complete the following information or replace the following text with data copied from SCrawler (click the top right info button in the main window, then the `Environment` button, then the `Copy` button, and paste the copied text here).**
- OS: [e.g. Windows 10, Windows 11]
- Architecture: [e.g. x86, x64]
- Version: [e.g. 2023.3.5.0]
@@ -38,6 +40,7 @@ If applicable, add screenshots to help explain your problem.
- ffmpeg version (command `ffmpeg -version`):
- yt-dlp version (command `yt-dlp --version`):
- gallery-dl version (command `gallery-dl --version`):
- cURL version (command `curl --version`):
**Additional context**
Add any other context about the problem here.

3
.gitignore vendored
View File

@@ -10,8 +10,7 @@
*.userosscache
*.sln.docstates
.obsidian/
ToDo.txt
ToDo.md
BugReporterFormDiscordWebHook.vb
# User-specific files (MonoDevelop/Xamarin Studio)
*.userprefs

View File

@@ -1,3 +1,91 @@
# 2023.8.6.0
*2023-08-06*
- Added
- The ability to remove user data and/or download history for redownload
- **Subscription** mode
- Settings to change the program title and information in the program information
- Settings for saving video thumbnail along with the file or in the cache (temporary cache or permanent cache)
- A bug report form to create a bug report or say something nice to the developer :blush:
- Prevent adding site-specific labels when adding to a collection
- Ability to select custom user highlighting in the main window and feed.
- Add a notification to the log if the user is not found on the site
- Added visualization of users download queue
- Ability to set more than one global paths
- Improve user paths changing: now you can also simply move the user/collection to another global location
- Ability to move multiple user/collection to another location
- Download groups: added `Subscription` options
- Download groups: the ability to set the number of users to download
- Auto downloader: new group options
- Auto downloader: additional skip options
- Auto downloader: added force start
- Feed: press `Ctrl+G` to go to a specific page
- Feed: added site icon to post
- Feed: always using `Friendly name` instead of `UserName` if it exists
- Missing posts: the ability to delete all missing posts
- Standalone downloader: add the ability to store download locations and quickly select after
- Standalone downloader: add `Ctrl+O` hotkey to select destination path
- Standalone downloader: add `Alt+O` hotkey to select destination path and save it to download locations
- User editor: ability to hide/show site-specific labels in collection editing mode
- Main window: filters by subscription and user
- Instagram: if the user is not found on the site, SCrawler will check for a new user name
- OnlyFans: handling of `504` and `429` errors
- OnlyFans: the `sec-ch-ua` header is now optional
- OnlyFans: ability to download 'Highlights" and media from chats
- PathPlugin: incorrect detection of path existence
- PornHub: completely rewritten videos parser
- PornHub: now you choose which videos you want to download (uploaded, tagged, private, favorites)
- PornHub: subscription mode
- PornHub: ability to download search queries and search categories
- Reddit: ability to set the number of concurrent downloads
- Reddit: added bearer token (optional)
- Reddit: added OAuth authorization (optional)
- Reddit: options to use the bearer token for the timeline and/or saved posts
- Reddit: option to disable the use of cookies for the timeline
- ThisVid: now you can also download user's favorite videos
- ThisVid: ability to download search queries, search categories and search tags
- ThisVid: subscription mode
- Twitter: new options: `Use the appropriate model`, `New endpoint: search`, `New endpoint: profiles`, `Abort on limit`, `Download already parsed` and `Media Model: allow non-user tweets`
- Twitter: new user option `Force apply`
- xHamster: ability to download search queries, search categories and search tags
- xHamster: subscription mode
- xHamster: pornstars download
- XVideos: ability to download search queries, search categories and search tags
- XVideos: subscription mode
- YouTube: added `Output path: ask for a name` and `Output path: auto add` settings
- YouTube: added the ability to store download locations and quickly select after
- YouTube: subscription mode
- Plugins.Attributes: added `DependentFields` attribute
- Plugins.Attributes: replace `Dependencies` with `Arguments` (`PropertyUpdater` attribute)
- Plugins.IPluginContentProvider: added `Options` and `IsSubscription` properties
- Plugins.ISiteSettings: added `SubscriptionsAllowed` property
- Plugins.ExchangeOptions: added `Options` field
- Plugins: added `ExitException`
- Other improvements
- Updated
- gallery-dl up to version 1.25.8
- yt-dlp up to version 2023.07.06
- LibVLCSharp up to 3.7.0
- VideoLAN up to 3.0.18
- Fixed
- **TikTok** supported again!
- Auto downloader: excluded labels and sites in default mode are not respected
- Download info: does not remember the last size and location
- Download info: hide unnecessary error
- Feed: `webm` photos not showing
- Search users: incorrect search by name
- OnlyFans: incorrect parsing of username containing dots
- OnlyFans: incorrect error handler
- Reddit: Handling error 502 (Reddit data not downloading)
- RedGifs: incorrect behavior when updating token
- Twitter: gifs are not downloading
- xHamster: some channels cannot be downloaded or are not fully downloaded
- YouTube: re-saving elements when loading a video list
- YouTube: files were not deleted when the delete button was clicked
- YouTube: a bug that caused the video to redownload
- Minor bugs
# 2023.6.19.0
*2023-06-19*

Binary file not shown.

Before

Width:  |  Height:  |  Size: 32 KiB

After

Width:  |  Height:  |  Size: 33 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 483 KiB

After

Width:  |  Height:  |  Size: 491 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 9.2 KiB

After

Width:  |  Height:  |  Size: 11 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 11 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 KiB

After

Width:  |  Height:  |  Size: 15 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 363 KiB

After

Width:  |  Height:  |  Size: 359 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 8.5 KiB

After

Width:  |  Height:  |  Size: 9.4 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 20 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 23 KiB

After

Width:  |  Height:  |  Size: 27 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 15 KiB

After

Width:  |  Height:  |  Size: 19 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 17 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 37 KiB

After

Width:  |  Height:  |  Size: 34 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 20 KiB

After

Width:  |  Height:  |  Size: 22 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 19 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 15 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 KiB

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 17 KiB

After

Width:  |  Height:  |  Size: 22 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 9.9 KiB

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 4.3 KiB

After

Width:  |  Height:  |  Size: 5.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.8 KiB

View File

@@ -40,20 +40,21 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- Pinterest boards, users, saved posts;
- Imgur images, galleries and videos;
- Gfycat videos;
- PornHub images, videos, save (liked) posts;
- XHamster images, videos, saved posts;
- XVIDEOS videos, saved posts;
- ThisVid images, videos, saved posts;
- PornHub images, videos, save (liked) posts, search queries, search categories;
- XHamster images, videos, saved posts, search queries, search categories, search tags;
- XVIDEOS videos, saved posts, search queries, search categories;
- ThisVid images, videos, saved posts, search queries, search categories, search tags;
- [Other](#supported-sites) supported sites
- Parse [channel and view data](https://github.com/AAndyProgram/SCrawler/wiki/Channels)
- Download [saved Reddit, Twitter and Instagram posts](https://github.com/AAndyProgram/SCrawler/wiki/Home#saved-posts)
- Parse [Reddit channel and view data](https://github.com/AAndyProgram/SCrawler/wiki/Channels)
- Download [saved posts](https://github.com/AAndyProgram/SCrawler/wiki/Home#saved-posts)
- Add users from parsed channel
- **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)
- **Feed** ([feed](https://github.com/AAndyProgram/SCrawler/wiki#feed) of downloaded media files and subscriptions posts)
- Labeling users
- Create [download groups](https://github.com/AAndyProgram/SCrawler/wiki/Settings#download-groups)
- Adding users to favorites and temporary
- Adding users and search queries in the **Subscription** mode (download post preview, but do not download the media file)
- [Filter exists users](https://github.com/AAndyProgram/SCrawler/wiki#view) by label or group
- Selection of media types you want to download (images only, videos only, both)
- [Download a special video](https://github.com/AAndyProgram/SCrawler/wiki#download-separate-video), image or gallery
@@ -71,7 +72,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **OnlyFans**
- **Mastodon**
- **Instagram**
- TikTok (*currently broken*; [limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits))
- TikTok
- RedGifs
- Pinterest
- Imgur
@@ -193,6 +194,8 @@ F5-->[*]
# Contact me
[e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me
Matrix (Element): https://matrix.to/#/@andyprogram:matrix.org
Discord (contact the developer): andyprogram

View File

@@ -44,6 +44,16 @@ Namespace Plugin.Attributes
Name = PropertyName
End Sub
End Class
''' <summary>Set the dependent fields that need to be updated when this property is changed internally.</summary>
<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class DependentFields : Inherits Attribute
Public ReadOnly Fields As String()
Public Sub New(ByVal Field As String)
Fields = {Field}
End Sub
Public Sub New(ByVal Fields As String())
Me.Fields = Fields
End Sub
End Class
''' <summary>Store property value in settings XML file</summary>
<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class PXML : Inherits Attribute
Public ReadOnly ElementName As String
@@ -59,16 +69,16 @@ Namespace Plugin.Attributes
''' <summary>Special property updater</summary>
<AttributeUsage(AttributeTargets.Method, AllowMultiple:=True, Inherited:=False)> Public NotInheritable Class PropertyUpdater : Inherits Attribute
Public ReadOnly Name As String
Public ReadOnly Dependencies As String()
Public ReadOnly Arguments As String()
''' <inheritdoc cref="PropertyUpdater.New(String, String())"/>
Public Sub New(ByVal UpdatingPropertyName As String)
Name = UpdatingPropertyName
End Sub
''' <summary>Initialize a new PropertyUpdater attribute</summary>
''' <param name="UpdatingPropertyName">The name of the property to be updated</param>
Public Sub New(ByVal UpdatingPropertyName As String, ByVal Dependent As String())
Public Sub New(ByVal UpdatingPropertyName As String, ByVal Arguments As String())
Name = UpdatingPropertyName
Dependencies = Dependent
Me.Arguments = Arguments
End Sub
End Class
''' <summary>Plugin key</summary>

View File

@@ -17,6 +17,7 @@ Namespace Plugin
Property Settings As ISiteSettings
Property Name As String
Property ID As String
Property Options As String
Property ParseUserMediaOnly As Boolean
Property UserDescription As String
Property ExistingContentList As List(Of IUserMedia)
@@ -25,6 +26,7 @@ Namespace Plugin
Property UserExists As Boolean
Property UserSuspended As Boolean
Property IsSavedPosts As Boolean
Property IsSubscription As Boolean
Property SeparateVideoFolder As Boolean
Property DataPath As String
Property PostsNumberLimit As Integer?

View File

@@ -17,6 +17,7 @@ Namespace Plugin
ReadOnly Property Icon As Icon
ReadOnly Property Image As Image
ReadOnly Property Site As String
ReadOnly Property SubscriptionsAllowed As Boolean
Property Logger As ILogProvider
Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Function IsMyUser(ByVal UserURL As String) As ExchangeOptions

View File

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

View File

@@ -11,6 +11,7 @@ Namespace Plugin
Public UserName As String
Public SiteName As String
Public HostKey As String
Public Options As String
Public Exists As Boolean
Public Sub New(ByVal Site As String, ByVal Name As String)
UserName = Name

View File

@@ -0,0 +1,36 @@
' 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 Plugin
''' <summary>Represents errors that occur during downloading to be thrown to the root downloading function.</summary>
Public Class ExitException : Inherits Exception
''' <summary>Add only the message to the log, without adding a <see cref="StackTrace"/>. Default: <see langword="True"/>.</summary>
''' <returns><see langword="True"/> if only the message should be added to the log; otherwise the stack trace will also be added.</returns>
Public Property SimpleLogLine As Boolean = True
''' <summary>Don't add a message to the log. Default: <see langword="False"/>.</summary>
''' <returns><see langword="True"/> if the error is exit-only and there is no need to add a message to the log; otherwise add a message to the log.</returns>
Public Property Silent As Boolean = False
''' <summary>Initializes a new instance of the <see cref="ExitException"/> class.</summary>
Public Sub New()
End Sub
''' <summary>Initializes a new instance of the <see cref="ExitException"/> class with a specified error message.</summary>
''' <param name="Message">The message that describes the error.</param>
Public Sub New(ByVal Message As String)
MyBase.New(Message)
End Sub
''' <summary>
''' Initializes a new instance of the <see cref="ExitException"/> class with a specified error message
''' and a reference to the inner exception that is the cause of this exception.
''' </summary>
''' <param name="Message">The error message that explains the reason for the exception.</param>
''' <param name="InnerException">The exception that is the cause of the current exception, or a null reference (Nothing in Visual Basic) if no inner exception is specified.</param>
Public Sub New(ByVal Message As String, ByVal InnerException As Exception)
MyBase.New(Message, InnerException)
End Sub
End Class
End Namespace

View File

@@ -107,6 +107,7 @@
<Compile Include="Objects\ExchangeOptions.vb" />
<Compile Include="ObjectInterfaces\ILogProvider.vb" />
<Compile Include="Interfaces\IPluginContentProvider.vb" />
<Compile Include="Objects\ExitException.vb" />
<Compile Include="Objects\PluginUserMedia.vb" />
<Compile Include="Interfaces\ISiteSettings.vb" />
<Compile Include="ObjectInterfaces\IThrower.vb" />

View File

@@ -58,7 +58,7 @@ Namespace API.YouTube.Base
''' <summary>Kb</summary>
Public Size As Double
Public Codec As String
Public Info As String
Public Protocol As String
Public URL As String
Public Property Index As Integer Implements IIndexable.Index
Private Function SetIndex(ByVal Obj As Object, ByVal Index As Integer) As Object Implements IIndexable.SetIndex

View File

@@ -34,13 +34,36 @@ Namespace API.YouTube.Base
<Browsable(False)> Friend ReadOnly Property DesignXml As XmlFile
<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
#Region "Environment"
<Browsable(True), GridVisible(False), XMLVN({"Environment"}), Category("Environment"), DisplayName("Path to yt-dlp.exe"),
#Region "Programs"
<Browsable(True), GridVisible(False), XMLVN({"Environment"}), Category("Environment programs"), DisplayName("Path to yt-dlp.exe"),
Description("Path to yt-dlp.exe file")>
Public ReadOnly Property YTDLP As XMLValue(Of SFile)
<Browsable(True), GridVisible(False), XMLVN({"Environment"}), Category("Environment"), DisplayName("Path to ffmpeg.exe"),
<Browsable(True), GridVisible(False), XMLVN({"Environment"}), Category("Environment programs"), DisplayName("Path to ffmpeg.exe"),
Description("Path to ffmpeg.exe file")>
Public ReadOnly Property FFMPEG As XMLValue(Of SFile)
<Browsable(False)> Private ReadOnly Property ENVIR_FFMPEG As SFile Implements IDownloaderSettings.ENVIR_FFMPEG
Get
Return FFMPEG
End Get
End Property
<Browsable(False)> Private ReadOnly Property ENVIR_YTDLP As SFile Implements IDownloaderSettings.ENVIR_YTDLP
Get
Return YTDLP
End Get
End Property
<Browsable(False)> Private ReadOnly Property ENVIR_GDL As SFile Implements IDownloaderSettings.ENVIR_GDL
Get
Return Nothing
End Get
End Property
<Browsable(False)> Private ReadOnly Property ENVIR_CURL As SFile Implements IDownloaderSettings.ENVIR_CURL
Get
Return Nothing
End Get
End Property
#End Region
<Browsable(True), GridVisible(False), Category("Environment"), Description("YouTube cookies"), GridCollectionForm(GetType(CookieListForm2)),
EditorBrowsable(EditorBrowsableState.Never), DesignerSerializationVisibility(DesignerSerializationVisibility.Content)>
Public ReadOnly Property Cookies As CookieKeeper
@@ -62,6 +85,22 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible(False), XMLVN({"Environment"}), Category("Environment"), DisplayName("Output path auto change"),
Description("Automatically change the output path when a new destination is selected in the opening forms.")>
Public ReadOnly Property OutputPathAutoChange As XMLValue(Of Boolean)
<Browsable(True), GridVisible(False), XMLVN({"Environment"}, True), Category("Environment"), DisplayName("Output path: ask for a name"),
Description("Ask for a name when adding a new output path to the list.")>
Public ReadOnly Property OutputPathAskForName As XMLValue(Of Boolean)
Private ReadOnly Property IDownloaderSettings_OutputPathAskForName As Boolean Implements IDownloaderSettings.OutputPathAskForName
Get
Return OutputPathAskForName
End Get
End Property
<Browsable(True), GridVisible(False), XMLVN({"Environment"}, True), Category("Environment"), DisplayName("Output path: auto add"),
Description("Add new paths to the list automatically.")>
Public ReadOnly Property OutputPathAutoAddPaths As XMLValue(Of Boolean)
Private ReadOnly Property IDownloaderSettings_OutputPathAutoAddPaths As Boolean Implements IDownloaderSettings.OutputPathAutoAddPaths
Get
Return OutputPathAutoAddPaths
End Get
End Property
<Browsable(True), GridVisible(False), XMLVN({"Environment"}, DoubleClickBehavior.Folder), Category("Environment"), DisplayName("On item double click"),
Description("What should program open when you double-click on an item...")>
Public ReadOnly Property OnItemDoubleClick As XMLValue(Of DoubleClickBehavior)
@@ -155,6 +194,12 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Download on click in tray: show form"),
Description("Show main window when download by clicking (Ctrl+Click) the tray icon. Default: false")>
Public ReadOnly Property ShowFormDownTrayClick As XMLValue(Of Boolean)
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Program title"),
Description("Change the title of the main window if you need to")>
Friend ReadOnly Property ProgramText As XMLValue(Of String)
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Program description"),
Description("Add some additional info to the program info if you need")>
Friend ReadOnly Property ProgramDescription As XMLValue(Of String)
#End Region
#Region "Defaults Video"
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, "MKV"), Category("Defaults Video"), DisplayName("Default format"),
@@ -167,6 +212,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, 1080), Category("Defaults Video"), DisplayName("Default definition"),
Description("The default maximum video resolution. -1 for max definition")>
Public ReadOnly Property DefaultVideoDefinition As XMLValue(Of Integer)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}), Category("Defaults Video"), DisplayName("Include zero size formats"),
Description("Include formats with zero size (or undefined size).")>
Public ReadOnly Property DefaultVideoIncludeNullSize As XMLValue(Of Boolean)
#End Region
#Region "Defaults Audio"
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, "AAC"), Category("Defaults Audio"), DisplayName("Default codec"),
@@ -233,6 +281,8 @@ Namespace API.YouTube.Base
#End Region
#Region "Initializer"
Public Sub New()
DownloadLocations = New DownloadLocationsCollection
DownloadLocations.Load(False, True)
XML = New XmlFile(YouTubeSettingsFile,, False) With {.AutoUpdateFile = True}
XML.LoadData(EDP.None)
DesignXml = New XmlFile("Settings\DesignDownloader.xml", Protector.Modes.All, False)

Binary file not shown.

After

Width:  |  Height:  |  Size: 209 B

View File

@@ -41,6 +41,10 @@ Namespace API.YouTube.Controls
Dim ActionButton6 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton7 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton8 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton9 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton10 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ListColumn1 As PersonalUtilities.Forms.Controls.Base.ListColumn = New PersonalUtilities.Forms.Controls.Base.ListColumn()
Dim ListColumn2 As PersonalUtilities.Forms.Controls.Base.ListColumn = New PersonalUtilities.Forms.Controls.Base.ListColumn()
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.BTT_DOWN = New System.Windows.Forms.Button()
Me.BTT_CANCEL = New System.Windows.Forms.Button()
@@ -53,7 +57,7 @@ Namespace API.YouTube.Controls
Me.CMB_FORMATS = New System.Windows.Forms.ComboBox()
Me.TXT_SUBS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_DOWN_LYRICS = New System.Windows.Forms.CheckBox()
Me.TXT_OUTPUT_PATH = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_OUTPUT_PATH = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_BUTTONS = New System.Windows.Forms.TableLayoutPanel()
TP_PLS = New System.Windows.Forms.TableLayoutPanel()
@@ -408,18 +412,41 @@ Namespace API.YouTube.Controls
ActionButton7.BackgroundImage = CType(resources.GetObject("ActionButton7.BackgroundImage"), System.Drawing.Image)
ActionButton7.Name = "Open"
ActionButton7.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Open
ActionButton7.ToolTipText = "Choose a new location (Ctrl+O)"
ActionButton8.BackgroundImage = CType(resources.GetObject("ActionButton8.BackgroundImage"), System.Drawing.Image)
ActionButton8.Name = "Clear"
ActionButton8.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton8.Name = "Add"
ActionButton8.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Add
ActionButton8.ToolTipText = "Choose a new location and add it to the list (Alt+O)"
ActionButton9.BackgroundImage = CType(resources.GetObject("ActionButton9.BackgroundImage"), System.Drawing.Image)
ActionButton9.Name = "Clear"
ActionButton9.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton10.BackgroundImage = CType(resources.GetObject("ActionButton10.BackgroundImage"), System.Drawing.Image)
ActionButton10.Name = "ArrowDown"
ActionButton10.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.ArrowDown
Me.TXT_OUTPUT_PATH.Buttons.Add(ActionButton7)
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.CaptionText = "Output path"
Me.TXT_OUTPUT_PATH.CaptionVisible = True
Me.TXT_OUTPUT_PATH.CaptionWidth = 112.0R
ListColumn1.Name = "COL_NAME"
ListColumn1.Text = "Name"
ListColumn1.Width = -1
ListColumn2.DisplayMember = True
ListColumn2.Name = "COL_VALUE"
ListColumn2.Text = "Value"
ListColumn2.ValueMember = True
ListColumn2.Visible = False
Me.TXT_OUTPUT_PATH.Columns.Add(ListColumn1)
Me.TXT_OUTPUT_PATH.Columns.Add(ListColumn2)
Me.TXT_OUTPUT_PATH.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_OUTPUT_PATH.Location = New System.Drawing.Point(3, 59)
Me.TXT_OUTPUT_PATH.Name = "TXT_OUTPUT_PATH"
Me.TXT_OUTPUT_PATH.Size = New System.Drawing.Size(428, 22)
Me.TXT_OUTPUT_PATH.TabIndex = 2
Me.TXT_OUTPUT_PATH.TextBoxBorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
'
'MusicPlaylistsForm
'
@@ -464,6 +491,6 @@ Namespace API.YouTube.Controls
Private WithEvents CMB_FORMATS As ComboBox
Private WithEvents SPLITTER_MAIN As SplitContainer
Private WithEvents CH_DOWN_LYRICS As CheckBox
Private WithEvents TXT_OUTPUT_PATH As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_OUTPUT_PATH As PersonalUtilities.Forms.Controls.ComboBoxExtended
End Class
End Namespace

View File

@@ -233,11 +233,123 @@
</value>
</data>
<data name="ActionButton8.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAADmUlE
QVRIS62WWWxMURjHL220JW1HausmlFrDFKUhnUGH6bRFzJ2idImlC0Vp2mlji1A8iNhCPIjIRES8EU+W
h2oEtbSDTk3HNNM7S01VKsXjkb/vXBo3k1Ee7sMvmZzzzf//ne/+z50RAAxL1MUIG4G/YAv3HSVhF5Vw
IYNdz3LadVj9RgdTB+HQYYPHIJuE1ocSdlEJFzG+1bPRLQLinglIeCkg+XUkKvz56hnkOfQs/rmA8S9H
YEp7FDI64tAQtKhnsMapZ7zzNHsUFnbGY4VzIk70l6hnIH4wsDR7NBZ3apDrSqL5T8eFgUr1DLZ78lim
Q4N8VzK29MxEpZSBa4M16hnU+c3M9CEFpdJsVHsXos63DDcHrf9nQEXD5VymwW/5USLNwl5vJhp7dTgW
NML2pR7jbsUMS+KdMTa5Q8NQxinfBU4dRFcOyjy52OtbhwOBDTgZLKPPmTgY0ON4MBdNfSbYBupxY8Aq
G10dqMG5/nIc7ytGQ6CQRliAamkTN/g1Ai4e95Qy3iogpX0UtBRDnhRzdxq2SXOxz5eFQ70rScCEU335
ssGxj0YS06HSm4GN3ekwdE2C1hGH1LZR0JDOJof5jwHvnIvzTa0jlooTYfktvt+fhcOBHDQFTWRgxJGP
ObAGsulZLMLWnjlY756K5c4JmNcRi6T2SGheCIihS2l5ozAo6NRhMolnUAcGV6IcwwqvFrX+JTjYuwKH
SfRAYDms/mzs9y1GFe2VSnOw1j0FejqpLN4WCX4ZufiIBwLMLxQGm12rsLQzgWKYgmLPLNTQw6ynpDSS
IBet8y+TqaVRVdFIeJrWuCcj+/0EzH43BomvIhBLI45uFiDcJ+6QwROFwa6+Amb9bGFNg6Xs9Ncd7Oy3
Knb2eyU7/20nu9y/m136tIvEl6BC0qKoZwby3alo9JVhj7T5R7m/kJVIIityi8zyXmTiW+I10SqyIQNb
uIgNwYuuf25kFd75KPKkI49OmUWnrfYWyXv/wBb2cijhhVf6a9lGei65XclYRDd6mj0GWz2iLBJaH0rY
RSVc5Eywmhm7kuQXHX+bJlBStrh+zTi0PpSwi0q4yNFAOVvgiEcKJWUsxZn/NhT+znlofShhF5VwkRpv
MUtti4KGYjj6sYCIh5QSu4oG27stjItHU+cjeQzvkcFzFQ2KnSKLoc4FukDCXeI2GbSoaFD4ziyPxNxK
0AUyNxOP1DOwcaG/8I+/LRB+At7psBnyDBG0AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton9.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton10.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE65JREFUeF7t
3X2sJWddB/DdLi2lQG2hdOHuvfM887J7Cxca4ELTQMDWKigIFpBAEAgi9g+CJpJo9Q8NJhgBiYZIYspL
GlAKCkhEC4KgQlsLQkqhKi/lrYWWlxaw3dLddrerz/Q89+7dc2fbfTn3npf5fJJv2rS758z85nnOzJz5
nZktAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMK3O3r79wVUIz65jfGNVxI/VIX69CvGO9M//a9P+e8o3B/8v
vKn9s+3fyX8dAJgmaWd+fl3E96Wd/E9XdvZHkfbvXNa+Rn45AGCS3bvjj/E/h3box5OrmxjPyy8PAEyS
XXO7zqhCeH/HDnwUOdCE+J6zdux4eH47YIrEGE8uy/Ls9Bnx/LooL0oH9b9Th/I1TVG+rCqKC+q6Xsh/
FJgmO8vy6WknfdPQTnsjckMdwlPy2wITLO3wF6si/lGas1ekuXvX0Fzuyg9S3psOCl6qDwimQB3ji9Ok
3btmEm907kpnEa/Mbw9Mlq1pB/6cdHZ/ZcfcPZrcXoXyrVVVFfl1gUmSdsS/libqPUMTd5NSvjktwrbB
kgDjVi1UT26K+Nnu+XrMuaud60uPWHpIfhtg3JqyfEaanHcPTdZNTRPCPy4uLj40LxIwBudt2fKAtOP/
0zQnN+5koIg3tpca81sC49J+LZcm5a3rJulYEq6LSV40YBOFEB6V5uFV6+flRiTsSwf9r81vDYzBCSO4
vjfq/KAuiqfm5QM2QRPjuWnubUbz71DCn6W33zpYCmDT1EX5m92Tcuy5q47xFXkxgQ3UduqnOXfn0Bzc
xJSvz4sCbIb2pzlp8v1w/WScnKSzkjekRT1hsMTAKC0vL5/Ydud3zb1NT1FelBcL2GiDm3d0TMTJy0ea
pjk1LzYwAu3NvtLc+uTQXBtn7tYYCJtja/vQno5JOJFpQrzWb4hhNJoQnpjm1Q3D82wCcnNRFKfnxQQ2
Qttk1zH5JjzhFmcIcHzyzb6O5aFem5J0sP/OvKjARmg7b7sm3xRkT3vDorwawJHb1t6Ep2NOTVoOtDch
yssMjFr6IPh8x8SbnsT4lrQamgPhCMzPzz+sifHjnXNpMnN5XnRglJaWlk5KE2z/0ISbxnzQQ0bgvlXz
1ePSXPnG0NyZ+DRF8Zi8CsCo7Azh0V0TbkrzRc2B0G3wIJ9429CcmZLce4MgYJTyff87JtzU5uayLM/J
qwcM7vD5+jQ3DgzNlWnKDXldgFFJZwW/2jHZpj1727uZ5VWE3mofqJXmw4eG5sdUpqqqXXm1gFGoQnhJ
12SbgRxoYvzjtIruK04vxRjPSvPgK0PzYmqTPqtemVcNGIU6xgu7JtusJH1ovH9ubu6UvLrQC2ncPyuN
/58Mz4fpTvnmvHrAKJQL5dO6J9ssJXxucWFhLq8yzLKtaUf5h2ncb9zz+8eUKsYP53UERmHX/PyOrsk2
g7nJDUWYZUuPWHpIE8oPdIz92UiMn86rCoxIOmOYta8KD5uftk2Peb1hZtTzdVOHcF3HmJ+ZVCF+Ia8u
MCppcl0+PNlmOG1zYPtYYc2BzIQ0np+ZxvWPh8b5LObqvMrAqEzRo4BHmctijCfnEsBUqkP5u2ksz8Kd
PI8g5SfyagOj0jbIpQk2c01DR5Brmh3NfC4DTI324LWO8V0dY3pm48mAsEGm7OEgo0sRb9wZ4+NzGWDi
lWUZ0ti9Zt1YnvUU8fdyCYBRmsFbAh9xqhDvqEN4Xi4FTKz8s93vD4/hPiSdpJyXywCMWPtrgKuGJ12P
ck/6gPmDXAuYOHVR/lY6UN3XMXb7kDv17MAGqhaqJ6WJ1sdegDUJ726a5oG5JDB2917vL+Kl3eO1N/lQ
LgewUdIO8E0dk69vubosy+25JDA2bYNuFeJnOsZovxLjhbkkwEZZXl4+0QfOvfl2Ogg4O5cFNl1dFE9N
4/B7Q+Oyj7mh/VzKZQE2UtM0j6iL+LWOidizhN3OPBiHuigvSmPwrvVjsn9pQnh1LguwGQa3Fo3fHp6M
Pcw97c1WcllgQy0tLZ2UDr7/qmMc9jJNiF/WkwNjMHhQ0GzfX/yIU8RLfRCxkdq+kzTfrugcf/3MgZ1l
+fRcHmCztU8Yq2P8h47J2cdcpTmQjdCE8IQ0vnzjdkjKP8nlAcZoWxXin3dP0n4l1eGb9UL92FwXOG51
Ub48ja09w2Otz2nvTJpKs21QIWDs0lnKb6TJqTEphN3NQvncXBY4VtvSju4N3WOs17l6cXHxoblGwKRo
r8mlHeAtHZO2b9mfDohem8sCR2XX3K4z0hj65NCYklSTGONpuUzApNlVFFWaqP81NHF7mvD2tnM7lwbu
V/vwqTR2vrV+LPU7VSjf4ff+MAU0B65NeWVd12fm0sBhpTnzosHDp7rGUV8T9lVFvDiXCJgSrmEezDea
onhMrgsM25rmyuvSODkwNG56nvZyYvi5XCNg2mgOXM3tVVH9ci4L3KtpmlN9W7Y+VYhfiEkuEzCt8n3L
fzA8yXuY/b7OZEVZlovt3ew6xknf8965ublTcpmAaac5cG3C2zQ09Vv7bVAaC/+7fmz0Og6QYVZpDlyT
GD/dPlgpl4b+2Nru5NIYuGfdmOhxmhB/VBblL+QaATNKc+DBfH1nCI/OdWHGtTewSdv874fGgIT4xfYb
wlwmYNZpDlzNbVUIz85lYUblJ2i6BDacGP/u7O3bH5zLBPSF5sDV7K+L+Nu5LMyYtJP7xbSNfzy0zfue
A+03gak8WwdVAnpHc+CaxHiJ5sCZsnK9f/+6bd3v3JZ2/r+SawT0mebAg0kfjB93v/Pp136t3X693bWN
e56v6nsBhmkOXE24Ph0EnJXrwpSp63qhDuXnu7dtn1P+U1VVP5PLBHAozYGDtD+LchvU6TN4Iqa+lqGs
XO8/YVAlgMPQHLiSsC+dNb0ml4UJVxflRWm73b1+O/Y5YXcVwvNziQDun+bANYnxkvO2bHlALg0TJsZ4
cl3ESzu3Xa8Trm+KYimXCeDIaQ48mKqIH9McOHl2zc/vaIr42a5t1vN8tCiK03OZAI6J5sCVFPFr7QNk
cl0Ys3yp6nvrtlO/s3K9f9ugSgDHSXPgILk58PxcFsYkX+93J8s1qUK8oynKF+YSAYyO5sCVhH3pgOjV
uSxsoqZpHpjq//bu7dLjFPHGND+Xc5kARk9z4JrE+JZUEl+1bpLFhYW5VPf/WLcd5N/ruj4zlwlg42gO
PCQfdXOVjdeE8MRU6xuGai9uXw2MgebA1YTrFkMoc10YsaYoX5rqfOf6uvc6e9LO/xW5RACbT3Pgam5N
B0Q/m8vCCLT3XnCQ2ZXwnWqhenIuE8D4aA5czV3OykZj19yuM1I9PzlUXwnhirIst+cyAYyf5sA1GTQH
uu/6MdoZ4+NTHb+1rq59j+v9wKTSHHhIPtI0zam5NByhNH5enGr306Fa9j1720ttuUQAE0tz4Epi/FJM
cl24b8ZNd25KdTk31whg8mkOXEm4pX1EbS4LHebn5x+WdnIf765fr3NVCOFRuUwA00Nz4Gr21kX58lwW
1qjmq8el+nxjqF4S4yVLS0sn5TIBTB/NgWuiOfAQTVE+J9XltnV16nXCvqqIF+cSAUw3zYGH5INnb9/+
4Fyavtra7uRSLe4Zqk3f88MmxvNyjQBmhiavg/liVVVFrkuvLC4uPjSt/4eG6iEhXlOWZchlApg9mgNX
c3P6wD8nl6UXqvlqZ1rv/xmqQ+/ThPJv5ufnH5TLBDC7NAeuZm97n/tclplWhfCstL4/GVr/nsf1fqCH
NAeu5kB7aSSVZFabA13v786tVVFckGsE0C+aAw8mnSG/f25u7pRcmpnQbt8mlB/oWt8+pwnxWk+PBNAc
uJoqxC/MSnNgs7BQ1yFc17WePc97Z+1AD+C4aA5czU3T/qjXdED3zLQePx5ar75nf77ev3VQJQBWaQ5c
zZ4qhJfkskyVuigvapvbOtapt2lC/FFTls/IJQKgi+bA1aw0B07FGWOM8eQ6xnd1rEe/E+OX2jGdywTA
fdEcuCYx/u2kXzNudjTz6az/c53L3+NUMX7YI6EBjp7mwIO5pt3J5rpMlHKhfFpavu8PLW/fM+s/7QTY
eJoDV/PduiiWc1kmwuB6f7x7aDn7ntvrGC/MJQLgeGgOHKQK8Y46hOflsoxN0zQPbEJ8Z9cy9jxf3RnC
o3OZABgFzYGrab9efl0qyViaAxcXFubSgchnOpar77k8xnhaLhMAo6Q5cE2K+L7NfoBMHcJT0nvfvG5Z
+h3X+wE2iebAg7m6LMvtuS4bKl/v14txSMLuKoQX5BIBsBk0B64kfCfV4om5LCN33pYtD3DA1ZVwfb1Q
PzaXCYDNpDlwJWH3RnSe75rbdUZ6/X9b/369z0eLojg9lwmAcdAcuJqV5sCRaEJ4QnrNbw+9R9+zcr1/
26BKAIyV5sBDcll7W95cmmPSPocgvc6dQ6/b9+xpivJluUQATBDNgQdz1TE2B6phV4p446TdhAmAIens
9ZXpQ1tz4KA58Am5LPfrrB07Hp7+zr90v1Z/UxXxU3Vdn5nLBMAk0xy4krC7WSifm8tyWGVZnl2F+M3u
1+hxYrxkeXn5xFwmAKaB5sDV7E9nsRfnsqyTdnIvGtxiuPPv9jV7Ul1ekUsEwLTRHHgwVSjfsbS0dFIu
TWtr+6uB9P8ODP/Znue7ZVmek2sEwBTT2Laa8sr2enb7jHoHRl0JV8QYH5nHDQCzwJ0DV/P1tKO7vuO/
9zpVKN/qej/AjNIcKB3Z24TyVXmIADCrNAfKmtzUxHhuHhoAzDrNgZJyVQjhUXlIANAjmgN7m/Du471d
MgBTzp0D+5Sw777uiQBAz2gO7EPCLSnn500OAAOaA2c615RlGfKmBoBDaQ6cvTQhvmd+fv5BeRMDwGFp
DpyJuN4PwDHQHDjVubUqigvypgSAo6M5cPrShHjtYghl3oQAcGw0B05Rivi+ubm5U/KmA4Djozlw4rM/
X+/fOthiADA6mgMnME2IP2rK8hl5GwHAxtAcOFH5SozxrLxpAGBjaQ4cf6oYP9w0zal5kwDA5tAcOLYc
aC/FpE1wwmBLAMAm0xy46bk91fvCXH4AGCvNgZuRIn6tKYrH5JoDwGTQHLihuTzGeFouNQBMFs2BI4/r
/QBMB82Bo0rYXYXwglxWAJh8mgOPN+H6eqF+bC4nAEwVzYHHkiL+c1EUp+caAsB00hx4FInxLalk2waV
A4AppznwfrOnLsqX53IBwOzQHHiYFPHGaqF6Ui4TAMwezYGHpirip+q6PjOXBwBmmubANjFesry8fGKu
CQD0Q4+bA/dWMf56LgMA9E8PmwO/W5blOXn1AaC/+tMcWF4ZY3xkXm0AYOabA2O8ZGlp6aS8ugDAGrPY
HLi3CeWr8voBAIczQ82BN6UDmnPzagEA92f6mwPLz1dVVeTVAQCO1LQ2B1Yh/PX8/PyD8moAAEdrupoD
w76qiBfnRQcAjtMUNAeGW1LOz8sLAIzKBDcHXlOWZciLCQCM2gQ2B142Nzd3Sl48AGCjTEhz4H7X+wFg
k425OfDWqqh+Pi8KALDJtqWDgDemHfKBoR30hqUJ8dqY5PcHAMalKcrnpJ3z94Z31qNO+/t+1/sBYIKk
k/LT6hD+Mu2oR/4rgXTW/+X02r+U3woAmDTtz/GaIv5F2nH/ZHhHfpS5J+Vf01n/S9LLbhu8OgAw0dpb
8TYL5XPTmfvb0o78v/MOvWtHvybtzXzKT1Qx/n5d1wv5pQCAaXXvAUFRLLXd+3WMFzZF+cKUl7X/rIri
gsWFhbn8RwEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA6LEtW/4flgYiLD1qeX0A
AAAASUVORK5CYII=
</value>
</data>
</root>

View File

@@ -8,6 +8,7 @@
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports SCrawler.API.YouTube.Objects
Imports SCrawler.DownloadObjects.STDownloader
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls
Imports PersonalUtilities.Forms.Controls.Base
@@ -50,6 +51,8 @@ Namespace API.YouTube.Controls
MyView.SetFormSize()
End If
MyYouTubeSettings.DownloadLocations.PopulateComboBox(TXT_OUTPUT_PATH)
CMB_FORMATS.Items.AddRange(AvailableAudioFormats)
If MyYouTubeSettings.PlaylistFormSplitterDistance > 0 Then SPLITTER_MAIN.SplitterDistancePercentageSet(MyYouTubeSettings.PlaylistFormSplitterDistance)
@@ -102,6 +105,17 @@ Namespace API.YouTube.Controls
MyYouTubeSettings.PlaylistFormSplitterDistance.Value = SPLITTER_MAIN.SplitterDistancePercentageGet
MyView.DisposeIfReady()
End Sub
Private Sub MusicPlaylistsForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
Dim b As Boolean = True
If e.KeyCode = Keys.O And e.Control Then
MyYouTubeSettings.DownloadLocations.ChooseNewLocation(TXT_OUTPUT_PATH, False, MyDownloaderSettings.OutputPathAskForName)
ElseIf e.KeyCode = Keys.O And e.Alt Then
MyYouTubeSettings.DownloadLocations.ChooseNewLocation(TXT_OUTPUT_PATH, True, MyDownloaderSettings.OutputPathAskForName)
Else
b = False
End If
If b Then e.Handled = True
End Sub
#End Region
#Region "Form text"
Private _InitialFormText As String = String.Empty
@@ -159,10 +173,8 @@ Namespace API.YouTube.Controls
End With
End Sub
Private Sub TXT_OUTPUT_PATH_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_OUTPUT_PATH.ActionOnButtonClick
If Sender.DefaultButton = ADB.Open Then
Dim f As SFile = SFile.SelectPath(TXT_OUTPUT_PATH.Text, "Select files destination", EDP.ReturnValue)
If Not f.IsEmptyString Then TXT_OUTPUT_PATH.Text = f
End If
If Sender.DefaultButton = ADB.Open Or Sender.DefaultButton = ADB.Add Then _
MyYouTubeSettings.DownloadLocations.ChooseNewLocation(TXT_OUTPUT_PATH, Sender.DefaultButton = ADB.Add, MyDownloaderSettings.OutputPathAskForName)
End Sub
#End Region
#Region "Lists' handlers"
@@ -256,6 +268,7 @@ Namespace API.YouTube.Controls
If Not TXT_FORMATS_ADDIT.Checked Then .PostProcessing_OutputAudioFormats.Clear()
.File = TXT_OUTPUT_PATH.Text.CSFileP
If MyYouTubeSettings.OutputPathAutoChange Then MyYouTubeSettings.OutputPath.Value = .File
If MyDownloaderSettings.OutputPathAutoAddPaths Then MyYouTubeSettings.DownloadLocations.Add(.File, False)
End With
DialogResult = DialogResult.OK
Close()

View File

@@ -52,6 +52,7 @@ Namespace API.YouTube.Controls
End If
LBL_DEFINITION.Text = $"{m.Height}p"
LBL_CODECS.Text = $"{m.Extension.StringToUpper}{d}{m.Codec.StringToUpper}{d}{m.FPS}fps{d}{m.Bitrate}k"
If Not m.Protocol.IsEmptyString Then LBL_CODECS.Text &= $" ({m.Protocol})"
If Not SelectedAudio.ID.IsEmptyString Then LBL_CODECS.Text &= $" / {SelectedAudio.Extension}{d}{SelectedAudio.Codec}{d}{SelectedAudio.Bitrate}k"
End If

View File

@@ -29,6 +29,10 @@ Namespace API.YouTube.Controls
Dim ICON_LINK As System.Windows.Forms.PictureBox
Dim TP_FOOTER As System.Windows.Forms.TableLayoutPanel
Dim TP_DESTINATION 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(VideoOptionsForm))
Dim ListColumn1 As PersonalUtilities.Forms.Controls.Base.ListColumn = New PersonalUtilities.Forms.Controls.Base.ListColumn()
Dim ListColumn2 As PersonalUtilities.Forms.Controls.Base.ListColumn = New PersonalUtilities.Forms.Controls.Base.ListColumn()
Dim TP_OK_CANCEL As System.Windows.Forms.TableLayoutPanel
Dim LB_SEP_1 As System.Windows.Forms.Label
Dim LB_SEP_2 As System.Windows.Forms.Label
@@ -37,8 +41,6 @@ Namespace API.YouTube.Controls
Dim LBL_FORMAT As System.Windows.Forms.Label
Dim LBL_SUBS_FORMAT As System.Windows.Forms.Label
Dim TT_MAIN As System.Windows.Forms.ToolTip
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(VideoOptionsForm))
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()
@@ -47,12 +49,13 @@ Namespace API.YouTube.Controls
Dim ActionButton7 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton8 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton9 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton10 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.ICON_VIDEO = New System.Windows.Forms.PictureBox()
Me.LBL_TITLE = New System.Windows.Forms.Label()
Me.TP_HEADER_INFO_2 = New System.Windows.Forms.TableLayoutPanel()
Me.LBL_TIME = New System.Windows.Forms.Label()
Me.LBL_URL = New System.Windows.Forms.LinkLabel()
Me.TXT_FILE = New System.Windows.Forms.TextBox()
Me.TXT_FILE = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.BTT_BROWSE = New System.Windows.Forms.Button()
Me.BTT_DOWN = New System.Windows.Forms.Button()
Me.BTT_CANCEL = New System.Windows.Forms.Button()
@@ -93,6 +96,7 @@ Namespace API.YouTube.Controls
CType(ICON_LINK, System.ComponentModel.ISupportInitialize).BeginInit()
TP_FOOTER.SuspendLayout()
TP_DESTINATION.SuspendLayout()
CType(Me.TXT_FILE, System.ComponentModel.ISupportInitialize).BeginInit()
TP_OK_CANCEL.SuspendLayout()
TP_WHAT.SuspendLayout()
Me.TP_HEADER_BASE.SuspendLayout()
@@ -267,12 +271,27 @@ Namespace API.YouTube.Controls
'
'TXT_FILE
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "ArrowDown"
ActionButton1.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.ArrowDown
Me.TXT_FILE.Buttons.Add(ActionButton1)
ListColumn1.Name = "COL_NAME"
ListColumn1.Text = "Name"
ListColumn1.Width = -1
ListColumn2.DisplayMember = True
ListColumn2.Name = "COL_VALUE"
ListColumn2.Text = "Value"
ListColumn2.ValueMember = True
ListColumn2.Visible = False
Me.TXT_FILE.Columns.Add(ListColumn1)
Me.TXT_FILE.Columns.Add(ListColumn2)
Me.TXT_FILE.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_FILE.Location = New System.Drawing.Point(3, 3)
Me.TXT_FILE.Location = New System.Drawing.Point(1, 1)
Me.TXT_FILE.Margin = New System.Windows.Forms.Padding(1)
Me.TXT_FILE.Name = "TXT_FILE"
Me.TXT_FILE.Size = New System.Drawing.Size(503, 20)
Me.TXT_FILE.Size = New System.Drawing.Size(507, 22)
Me.TXT_FILE.TabIndex = 0
Me.TXT_FILE.WordWrap = False
Me.TXT_FILE.TextBoxBorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
'
'BTT_BROWSE
'
@@ -283,7 +302,7 @@ Namespace API.YouTube.Controls
Me.BTT_BROWSE.Size = New System.Drawing.Size(74, 22)
Me.BTT_BROWSE.TabIndex = 1
Me.BTT_BROWSE.Text = "Browse"
TT_MAIN.SetToolTip(Me.BTT_BROWSE, "Choose an output file")
TT_MAIN.SetToolTip(Me.BTT_BROWSE, "Choose an output file (Right click for add a new location to the list)")
Me.BTT_BROWSE.UseVisualStyleBackColor = True
'
'TP_OK_CANCEL
@@ -473,21 +492,21 @@ Namespace API.YouTube.Controls
'
'TXT_SUBS
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Open"
ActionButton1.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Open
ActionButton1.ToolTipText = "Choose subtitles"
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Refresh"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Refresh
ActionButton2.ToolTipText = "Reset subtitles to initial selected"
ActionButton2.Name = "Open"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Open
ActionButton2.ToolTipText = "Choose subtitles"
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Clear"
ActionButton3.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton3.ToolTipText = "Clear subtitles selection (don't download subtitles)"
Me.TXT_SUBS.Buttons.Add(ActionButton1)
ActionButton3.Name = "Refresh"
ActionButton3.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Refresh
ActionButton3.ToolTipText = "Reset subtitles to initial selected"
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Clear"
ActionButton4.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton4.ToolTipText = "Clear subtitles selection (don't download subtitles)"
Me.TXT_SUBS.Buttons.Add(ActionButton2)
Me.TXT_SUBS.Buttons.Add(ActionButton3)
Me.TXT_SUBS.Buttons.Add(ActionButton4)
Me.TXT_SUBS.CaptionText = "Subtitles"
Me.TXT_SUBS.CaptionToolTipEnabled = True
Me.TXT_SUBS.CaptionToolTipText = "The selected subtitles will also be downloaded"
@@ -611,24 +630,24 @@ Namespace API.YouTube.Controls
'
'TXT_SUBS_ADDIT
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Enabled = False
ActionButton4.Name = "Open"
ActionButton4.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Open
ActionButton4.ToolTipText = "Choose additional formats"
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Enabled = False
ActionButton5.Name = "Refresh"
ActionButton5.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Refresh
ActionButton5.ToolTipText = "Fill in additional formats from the defaults"
ActionButton5.Name = "Open"
ActionButton5.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Open
ActionButton5.ToolTipText = "Choose additional formats"
ActionButton6.BackgroundImage = CType(resources.GetObject("ActionButton6.BackgroundImage"), System.Drawing.Image)
ActionButton6.Enabled = False
ActionButton6.Name = "Clear"
ActionButton6.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton6.ToolTipText = "Remove all additional formats"
Me.TXT_SUBS_ADDIT.Buttons.Add(ActionButton4)
ActionButton6.Name = "Refresh"
ActionButton6.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Refresh
ActionButton6.ToolTipText = "Fill in additional formats from the defaults"
ActionButton7.BackgroundImage = CType(resources.GetObject("ActionButton7.BackgroundImage"), System.Drawing.Image)
ActionButton7.Enabled = False
ActionButton7.Name = "Clear"
ActionButton7.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton7.ToolTipText = "Remove all additional formats"
Me.TXT_SUBS_ADDIT.Buttons.Add(ActionButton5)
Me.TXT_SUBS_ADDIT.Buttons.Add(ActionButton6)
Me.TXT_SUBS_ADDIT.Buttons.Add(ActionButton7)
Me.TXT_SUBS_ADDIT.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.CheckBox
Me.TXT_SUBS_ADDIT.CaptionText = "Additional subtitle formats"
Me.TXT_SUBS_ADDIT.CaptionToolTipEnabled = True
@@ -646,24 +665,24 @@ Namespace API.YouTube.Controls
'
'TXT_EXTRA_AUDIO_FORMATS
'
ActionButton7.BackgroundImage = CType(resources.GetObject("ActionButton7.BackgroundImage"), System.Drawing.Image)
ActionButton7.Enabled = False
ActionButton7.Name = "Open"
ActionButton7.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Open
ActionButton7.ToolTipText = "Choose additional formats"
ActionButton8.BackgroundImage = CType(resources.GetObject("ActionButton8.BackgroundImage"), System.Drawing.Image)
ActionButton8.Enabled = False
ActionButton8.Name = "Refresh"
ActionButton8.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Refresh
ActionButton8.ToolTipText = "Fill in additional formats from the defaults"
ActionButton8.Name = "Open"
ActionButton8.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Open
ActionButton8.ToolTipText = "Choose additional formats"
ActionButton9.BackgroundImage = CType(resources.GetObject("ActionButton9.BackgroundImage"), System.Drawing.Image)
ActionButton9.Enabled = False
ActionButton9.Name = "Clear"
ActionButton9.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton9.ToolTipText = "Choose additional formats"
Me.TXT_EXTRA_AUDIO_FORMATS.Buttons.Add(ActionButton7)
ActionButton9.Name = "Refresh"
ActionButton9.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Refresh
ActionButton9.ToolTipText = "Fill in additional formats from the defaults"
ActionButton10.BackgroundImage = CType(resources.GetObject("ActionButton10.BackgroundImage"), System.Drawing.Image)
ActionButton10.Enabled = False
ActionButton10.Name = "Clear"
ActionButton10.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton10.ToolTipText = "Choose additional formats"
Me.TXT_EXTRA_AUDIO_FORMATS.Buttons.Add(ActionButton8)
Me.TXT_EXTRA_AUDIO_FORMATS.Buttons.Add(ActionButton9)
Me.TXT_EXTRA_AUDIO_FORMATS.Buttons.Add(ActionButton10)
Me.TXT_EXTRA_AUDIO_FORMATS.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.CheckBox
Me.TXT_EXTRA_AUDIO_FORMATS.CaptionText = "Additional audio formats"
Me.TXT_EXTRA_AUDIO_FORMATS.CaptionToolTipEnabled = True
@@ -704,7 +723,7 @@ Namespace API.YouTube.Controls
CType(ICON_LINK, System.ComponentModel.ISupportInitialize).EndInit()
TP_FOOTER.ResumeLayout(False)
TP_DESTINATION.ResumeLayout(False)
TP_DESTINATION.PerformLayout()
CType(Me.TXT_FILE, System.ComponentModel.ISupportInitialize).EndInit()
TP_OK_CANCEL.ResumeLayout(False)
TP_WHAT.ResumeLayout(False)
TP_WHAT.PerformLayout()
@@ -740,7 +759,7 @@ Namespace API.YouTube.Controls
Private WithEvents CMB_SUBS_FORMAT As ComboBox
Private WithEvents TXT_SUBS_ADDIT As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_EXTRA_AUDIO_FORMATS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_FILE As TextBox
Private WithEvents TXT_FILE As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents BTT_BROWSE As Button
Private WithEvents BTT_DOWN As Button
Private WithEvents BTT_CANCEL As Button

View File

@@ -135,6 +135,97 @@
<metadata name="TP_DESTINATION.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="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE65JREFUeF7t
3X2sJWddB/DdLi2lQG2hdOHuvfM887J7Cxca4ELTQMDWKigIFpBAEAgi9g+CJpJo9Q8NJhgBiYZIYspL
GlAKCkhEC4KgQlsLQkqhKi/lrYWWlxaw3dLddrerz/Q89+7dc2fbfTn3npf5fJJv2rS758z85nnOzJz5
nZktAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMK3O3r79wVUIz65jfGNVxI/VIX69CvGO9M//a9P+e8o3B/8v
vKn9s+3fyX8dAJgmaWd+fl3E96Wd/E9XdvZHkfbvXNa+Rn45AGCS3bvjj/E/h3box5OrmxjPyy8PAEyS
XXO7zqhCeH/HDnwUOdCE+J6zdux4eH47YIrEGE8uy/Ls9Bnx/LooL0oH9b9Th/I1TVG+rCqKC+q6Xsh/
FJgmO8vy6WknfdPQTnsjckMdwlPy2wITLO3wF6si/lGas1ekuXvX0Fzuyg9S3psOCl6qDwimQB3ji9Ok
3btmEm907kpnEa/Mbw9Mlq1pB/6cdHZ/ZcfcPZrcXoXyrVVVFfl1gUmSdsS/libqPUMTd5NSvjktwrbB
kgDjVi1UT26K+Nnu+XrMuaud60uPWHpIfhtg3JqyfEaanHcPTdZNTRPCPy4uLj40LxIwBudt2fKAtOP/
0zQnN+5koIg3tpca81sC49J+LZcm5a3rJulYEq6LSV40YBOFEB6V5uFV6+flRiTsSwf9r81vDYzBCSO4
vjfq/KAuiqfm5QM2QRPjuWnubUbz71DCn6W33zpYCmDT1EX5m92Tcuy5q47xFXkxgQ3UduqnOXfn0Bzc
xJSvz4sCbIb2pzlp8v1w/WScnKSzkjekRT1hsMTAKC0vL5/Ydud3zb1NT1FelBcL2GiDm3d0TMTJy0ea
pjk1LzYwAu3NvtLc+uTQXBtn7tYYCJtja/vQno5JOJFpQrzWb4hhNJoQnpjm1Q3D82wCcnNRFKfnxQQ2
Qttk1zH5JjzhFmcIcHzyzb6O5aFem5J0sP/OvKjARmg7b7sm3xRkT3vDorwawJHb1t6Ep2NOTVoOtDch
yssMjFr6IPh8x8SbnsT4lrQamgPhCMzPzz+sifHjnXNpMnN5XnRglJaWlk5KE2z/0ISbxnzQQ0bgvlXz
1ePSXPnG0NyZ+DRF8Zi8CsCo7Azh0V0TbkrzRc2B0G3wIJ9429CcmZLce4MgYJTyff87JtzU5uayLM/J
qwcM7vD5+jQ3DgzNlWnKDXldgFFJZwW/2jHZpj1727uZ5VWE3mofqJXmw4eG5sdUpqqqXXm1gFGoQnhJ
12SbgRxoYvzjtIruK04vxRjPSvPgK0PzYmqTPqtemVcNGIU6xgu7JtusJH1ovH9ubu6UvLrQC2ncPyuN
/58Mz4fpTvnmvHrAKJQL5dO6J9ssJXxucWFhLq8yzLKtaUf5h2ncb9zz+8eUKsYP53UERmHX/PyOrsk2
g7nJDUWYZUuPWHpIE8oPdIz92UiMn86rCoxIOmOYta8KD5uftk2Peb1hZtTzdVOHcF3HmJ+ZVCF+Ia8u
MCppcl0+PNlmOG1zYPtYYc2BzIQ0np+ZxvWPh8b5LObqvMrAqEzRo4BHmctijCfnEsBUqkP5u2ksz8Kd
PI8g5SfyagOj0jbIpQk2c01DR5Brmh3NfC4DTI324LWO8V0dY3pm48mAsEGm7OEgo0sRb9wZ4+NzGWDi
lWUZ0ti9Zt1YnvUU8fdyCYBRmsFbAh9xqhDvqEN4Xi4FTKz8s93vD4/hPiSdpJyXywCMWPtrgKuGJ12P
ck/6gPmDXAuYOHVR/lY6UN3XMXb7kDv17MAGqhaqJ6WJ1sdegDUJ726a5oG5JDB2917vL+Kl3eO1N/lQ
LgewUdIO8E0dk69vubosy+25JDA2bYNuFeJnOsZovxLjhbkkwEZZXl4+0QfOvfl2Ogg4O5cFNl1dFE9N
4/B7Q+Oyj7mh/VzKZQE2UtM0j6iL+LWOidizhN3OPBiHuigvSmPwrvVjsn9pQnh1LguwGQa3Fo3fHp6M
Pcw97c1WcllgQy0tLZ2UDr7/qmMc9jJNiF/WkwNjMHhQ0GzfX/yIU8RLfRCxkdq+kzTfrugcf/3MgZ1l
+fRcHmCztU8Yq2P8h47J2cdcpTmQjdCE8IQ0vnzjdkjKP8nlAcZoWxXin3dP0n4l1eGb9UL92FwXOG51
Ub48ja09w2Otz2nvTJpKs21QIWDs0lnKb6TJqTEphN3NQvncXBY4VtvSju4N3WOs17l6cXHxoblGwKRo
r8mlHeAtHZO2b9mfDohem8sCR2XX3K4z0hj65NCYklSTGONpuUzApNlVFFWaqP81NHF7mvD2tnM7lwbu
V/vwqTR2vrV+LPU7VSjf4ff+MAU0B65NeWVd12fm0sBhpTnzosHDp7rGUV8T9lVFvDiXCJgSrmEezDea
onhMrgsM25rmyuvSODkwNG56nvZyYvi5XCNg2mgOXM3tVVH9ci4L3KtpmlN9W7Y+VYhfiEkuEzCt8n3L
fzA8yXuY/b7OZEVZlovt3ew6xknf8965ublTcpmAaac5cG3C2zQ09Vv7bVAaC/+7fmz0Og6QYVZpDlyT
GD/dPlgpl4b+2Nru5NIYuGfdmOhxmhB/VBblL+QaATNKc+DBfH1nCI/OdWHGtTewSdv874fGgIT4xfYb
wlwmYNZpDlzNbVUIz85lYUblJ2i6BDacGP/u7O3bH5zLBPSF5sDV7K+L+Nu5LMyYtJP7xbSNfzy0zfue
A+03gak8WwdVAnpHc+CaxHiJ5sCZsnK9f/+6bd3v3JZ2/r+SawT0mebAg0kfjB93v/Pp136t3X693bWN
e56v6nsBhmkOXE24Ph0EnJXrwpSp63qhDuXnu7dtn1P+U1VVP5PLBHAozYGDtD+LchvU6TN4Iqa+lqGs
XO8/YVAlgMPQHLiSsC+dNb0ml4UJVxflRWm73b1+O/Y5YXcVwvNziQDun+bANYnxkvO2bHlALg0TJsZ4
cl3ESzu3Xa8Trm+KYimXCeDIaQ48mKqIH9McOHl2zc/vaIr42a5t1vN8tCiK03OZAI6J5sCVFPFr7QNk
cl0Ys3yp6nvrtlO/s3K9f9ugSgDHSXPgILk58PxcFsYkX+93J8s1qUK8oynKF+YSAYyO5sCVhH3pgOjV
uSxsoqZpHpjq//bu7dLjFPHGND+Xc5kARk9z4JrE+JZUEl+1bpLFhYW5VPf/WLcd5N/ruj4zlwlg42gO
PCQfdXOVjdeE8MRU6xuGai9uXw2MgebA1YTrFkMoc10YsaYoX5rqfOf6uvc6e9LO/xW5RACbT3Pgam5N
B0Q/m8vCCLT3XnCQ2ZXwnWqhenIuE8D4aA5czV3OykZj19yuM1I9PzlUXwnhirIst+cyAYyf5sA1GTQH
uu/6MdoZ4+NTHb+1rq59j+v9wKTSHHhIPtI0zam5NByhNH5enGr306Fa9j1720ttuUQAE0tz4Epi/FJM
cl24b8ZNd25KdTk31whg8mkOXEm4pX1EbS4LHebn5x+WdnIf765fr3NVCOFRuUwA00Nz4Gr21kX58lwW
1qjmq8el+nxjqF4S4yVLS0sn5TIBTB/NgWuiOfAQTVE+J9XltnV16nXCvqqIF+cSAUw3zYGH5INnb9/+
4Fyavtra7uRSLe4Zqk3f88MmxvNyjQBmhiavg/liVVVFrkuvLC4uPjSt/4eG6iEhXlOWZchlApg9mgNX
c3P6wD8nl6UXqvlqZ1rv/xmqQ+/ThPJv5ufnH5TLBDC7NAeuZm97n/tclplWhfCstL4/GVr/nsf1fqCH
NAeu5kB7aSSVZFabA13v786tVVFckGsE0C+aAw8mnSG/f25u7pRcmpnQbt8mlB/oWt8+pwnxWk+PBNAc
uJoqxC/MSnNgs7BQ1yFc17WePc97Z+1AD+C4aA5czU3T/qjXdED3zLQePx5ar75nf77ev3VQJQBWaQ5c
zZ4qhJfkskyVuigvapvbOtapt2lC/FFTls/IJQKgi+bA1aw0B07FGWOM8eQ6xnd1rEe/E+OX2jGdywTA
fdEcuCYx/u2kXzNudjTz6az/c53L3+NUMX7YI6EBjp7mwIO5pt3J5rpMlHKhfFpavu8PLW/fM+s/7QTY
eJoDV/PduiiWc1kmwuB6f7x7aDn7ntvrGC/MJQLgeGgOHKQK8Y46hOflsoxN0zQPbEJ8Z9cy9jxf3RnC
o3OZABgFzYGrab9efl0qyViaAxcXFubSgchnOpar77k8xnhaLhMAo6Q5cE2K+L7NfoBMHcJT0nvfvG5Z
+h3X+wE2iebAg7m6LMvtuS4bKl/v14txSMLuKoQX5BIBsBk0B64kfCfV4om5LCN33pYtD3DA1ZVwfb1Q
PzaXCYDNpDlwJWH3RnSe75rbdUZ6/X9b/369z0eLojg9lwmAcdAcuJqV5sCRaEJ4QnrNbw+9R9+zcr1/
26BKAIyV5sBDcll7W95cmmPSPocgvc6dQ6/b9+xpivJluUQATBDNgQdz1TE2B6phV4p446TdhAmAIens
9ZXpQ1tz4KA58Am5LPfrrB07Hp7+zr90v1Z/UxXxU3Vdn5nLBMAk0xy4krC7WSifm8tyWGVZnl2F+M3u
1+hxYrxkeXn5xFwmAKaB5sDV7E9nsRfnsqyTdnIvGtxiuPPv9jV7Ul1ekUsEwLTRHHgwVSjfsbS0dFIu
TWtr+6uB9P8ODP/Znue7ZVmek2sEwBTT2Laa8sr2enb7jHoHRl0JV8QYH5nHDQCzwJ0DV/P1tKO7vuO/
9zpVKN/qej/AjNIcKB3Z24TyVXmIADCrNAfKmtzUxHhuHhoAzDrNgZJyVQjhUXlIANAjmgN7m/Du471d
MgBTzp0D+5Sw777uiQBAz2gO7EPCLSnn500OAAOaA2c615RlGfKmBoBDaQ6cvTQhvmd+fv5BeRMDwGFp
DpyJuN4PwDHQHDjVubUqigvypgSAo6M5cPrShHjtYghl3oQAcGw0B05Rivi+ubm5U/KmA4Djozlw4rM/
X+/fOthiADA6mgMnME2IP2rK8hl5GwHAxtAcOFH5SozxrLxpAGBjaQ4cf6oYP9w0zal5kwDA5tAcOLYc
aC/FpE1wwmBLAMAm0xy46bk91fvCXH4AGCvNgZuRIn6tKYrH5JoDwGTQHLihuTzGeFouNQBMFs2BI4/r
/QBMB82Bo0rYXYXwglxWAJh8mgOPN+H6eqF+bC4nAEwVzYHHkiL+c1EUp+caAsB00hx4FInxLalk2waV
A4AppznwfrOnLsqX53IBwOzQHHiYFPHGaqF6Ui4TAMwezYGHpirip+q6PjOXBwBmmubANjFesry8fGKu
CQD0Q4+bA/dWMf56LgMA9E8PmwO/W5blOXn1AaC/+tMcWF4ZY3xkXm0AYOabA2O8ZGlp6aS8ugDAGrPY
HLi3CeWr8voBAIczQ82BN6UDmnPzagEA92f6mwPLz1dVVeTVAQCO1LQ2B1Yh/PX8/PyD8moAAEdrupoD
w76qiBfnRQcAjtMUNAeGW1LOz8sLAIzKBDcHXlOWZciLCQCM2gQ2B142Nzd3Sl48AGCjTEhz4H7X+wFg
k425OfDWqqh+Pi8KALDJtqWDgDemHfKBoR30hqUJ8dqY5PcHAMalKcrnpJ3z94Z31qNO+/t+1/sBYIKk
k/LT6hD+Mu2oR/4rgXTW/+X02r+U3woAmDTtz/GaIv5F2nH/ZHhHfpS5J+Vf01n/S9LLbhu8OgAw0dpb
8TYL5XPTmfvb0o78v/MOvWtHvybtzXzKT1Qx/n5d1wv5pQCAaXXvAUFRLLXd+3WMFzZF+cKUl7X/rIri
gsWFhbn8RwEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA6LEtW/4flgYiLD1qeX0A
AAAASUVORK5CYII=
</value>
</data>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
@@ -162,8 +253,7 @@
<metadata name="LBL_SUBS_FORMAT.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="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -174,7 +264,7 @@
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
@@ -188,17 +278,17 @@
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -209,7 +299,7 @@
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton6.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
@@ -225,7 +315,7 @@
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton6.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton7.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -233,7 +323,7 @@
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton7.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton8.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
@@ -244,7 +334,7 @@
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton8.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton9.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
@@ -260,7 +350,7 @@
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton9.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<data name="ActionButton10.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go

View File

@@ -47,6 +47,8 @@ Namespace API.YouTube.Controls
MyView.SetFormSize()
End If
MyYouTubeSettings.DownloadLocations.PopulateComboBox(TXT_FILE)
If Not MyContainer Is Nothing Then
With MyContainer
Dim i%
@@ -312,6 +314,7 @@ Namespace API.YouTube.Controls
End With
If MyYouTubeSettings.OutputPathAutoChange Then MyYouTubeSettings.OutputPath.Value = f
If MyDownloaderSettings.OutputPathAutoAddPaths Then MyYouTubeSettings.DownloadLocations.Add(f, False)
DialogResult = DialogResult.OK
Close()
@@ -430,7 +433,7 @@ Namespace API.YouTube.Controls
End Sub
#End Region
#Region "Footer"
Private Sub BTT_BROWSE_Click(sender As Object, e As EventArgs) Handles BTT_BROWSE.Click
Private Sub BTT_BROWSE_MouseClick(sender As Object, e As MouseEventArgs) Handles BTT_BROWSE.MouseClick
Dim f As SFile
#Disable Warning BC40000
If MyContainer.HasElements Then
@@ -444,7 +447,13 @@ Namespace API.YouTube.Controls
f = SFile.SaveAs(f, "Select the destination of the video file",,, sPattern, EDP.ReturnValue)
End If
#Enable Warning
If Not f.IsEmptyString Then TXT_FILE.Text = f
If Not f.IsEmptyString Then
If e.Button = MouseButtons.Right Then
MyYouTubeSettings.DownloadLocations.Add(f, MyDownloaderSettings.OutputPathAskForName)
MyYouTubeSettings.DownloadLocations.PopulateComboBox(TXT_FILE, f)
End If
TXT_FILE.Text = f
End If
End Sub
#End Region
#End Region

View File

@@ -0,0 +1,204 @@
' 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 PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.XML.Attributes
Imports PersonalUtilities.Forms.Controls
Imports PersonalUtilities.Forms.Controls.Base
Imports PersonalUtilities.Tools
Namespace DownloadObjects.STDownloader
Public Structure DownloadLocation : Implements IComparable(Of DownloadLocation), IEquatable(Of DownloadLocation), IEContainerProvider
<XMLECA(NameOf(Path))> Public Name As String
<XMLEC> Public Path As String
<XMLECA(NameOf(Path), NullValue:=-1, NullValueExists:=True)>
Public Model As Integer
''' <param name="Path">with separator</param>
Public Sub New(ByVal Path As String)
Me.New(Path, -1)
End Sub
''' <inheritdoc cref="DownloadLocation.New(String)"/>
Public Sub New(ByVal Path As String, ByVal Model As Integer)
Me.Path = Path
Me.Model = Model
End Sub
Public Shared Widening Operator CType(ByVal Path As String) As DownloadLocation
Return New DownloadLocation(Path)
End Operator
Public Shared Narrowing Operator CType(ByVal Path As SFile) As DownloadLocation
Return New DownloadLocation(Path.PathWithSeparator)
End Operator
Public Shared Widening Operator CType(ByVal Location As DownloadLocation) As String
Return Location.Path
End Operator
Public Overrides Function ToString() As String
Return Path
End Function
Public Overloads Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not IsNothing(Obj) Then
If TypeOf Obj Is DownloadLocation Then
Return Equals(DirectCast(Obj, DownloadLocation))
Else
Return Obj.ToString = Path
End If
Else
Return False
End If
End Function
Public Overloads Function Equals(ByVal Other As DownloadLocation) As Boolean Implements IEquatable(Of DownloadLocation).Equals
Return Path = Other.Path And Model = Other.Model
End Function
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return XMLGenerateContainers(Me).FirstOrDefault
End Function
Private Function CompareTo(ByVal Other As DownloadLocation) As Integer Implements IComparable(Of DownloadLocation).CompareTo
Return Name.CompareTo(Other.Name)
End Function
End Structure
Public Class DownloadLocationsCollection : Implements ICollection(Of DownloadLocation), IMyEnumerator(Of DownloadLocation)
Private ReadOnly Property Locations As List(Of DownloadLocation)
Private WorkingFile As SFile
Public Sub New()
Locations = New List(Of DownloadLocation)
End Sub
Public Sub Load(ByVal IsGlobal As Boolean, Optional ByVal IsYT As Boolean = False, Optional ByVal File As SFile = Nothing)
If Not IsGlobal Then
WorkingFile = $"Settings\DownloadLocations{IIf(IsYT, "YouTube", String.Empty)}.xml"
ElseIf Not File.IsEmptyString Then
WorkingFile = File
Else
Throw New ArgumentNullException("File", "File cannot be null in global locations instance")
End If
If WorkingFile.Exists Then
Using x As New XmlFile(WorkingFile, Protector.Modes.All, False) With {.AllowSameNames = True}
x.LoadData()
Locations.ListAddList(x.XMLGenerateInstances(Of DownloadLocation), LAP.NotContainsOnly)
End Using
End If
End Sub
Private ReadOnly Property IsReadOnly As Boolean = False Implements ICollection(Of DownloadLocation).IsReadOnly
Public ReadOnly Property Count As Integer Implements ICollection(Of DownloadLocation).Count, IMyEnumerator(Of DownloadLocation).MyEnumeratorCount
Get
Return Locations.Count
End Get
End Property
Default Public ReadOnly Property Item(ByVal Index As Integer) As DownloadLocation Implements IMyEnumerator(Of DownloadLocation).MyEnumeratorObject
Get
Return Locations(Index)
End Get
End Property
Public Shared Sub AddCmbColumns(ByRef CMB As ComboBoxExtended, Optional ByVal UseUpdate As Boolean = True)
With CMB
If UseUpdate Then .BeginUpdate()
With .Columns
.Clear()
.Add(New ListColumn("COL_NAME", "Name") With {.DisplayMember = False, .ValueMember = False, .AutoWidth = True, .Width = -1})
.Add(New ListColumn("COL_VALUE", "Value") With {.DisplayMember = True, .ValueMember = True, .Visible = False})
End With
If UseUpdate Then .EndUpdate(True)
End With
End Sub
Public Sub PopulateComboBox(ByRef CMB As ComboBoxExtended, Optional ByVal Current As SFile = Nothing)
Locations.Sort()
With CMB
.BeginUpdate()
If .Columns.Count = 0 Then AddCmbColumns(CMB, False)
.Items.Clear()
If Count > 0 Then
.Items.AddRange(Locations.Select(Function(l) New ListItem({l.Name, l.Path})))
.LeaveDefaultButtons = True
Else
.LeaveDefaultButtons = False
End If
.ListAutoCompleteMode = ComboBoxExtended.AutoCompleteModes.Disabled
.EndUpdate()
If Not Current.IsEmptyString And Locations.Count > 0 Then
Dim i% = IndexOf(Current.PathWithSeparator)
If i.ValueBetween(0, .Items.Count - 1) Then .SelectedIndex = i
If Current.File.IsEmptyString Then CMB.Text = Current.PathWithSeparator Else CMB.Text = Current
End If
End With
End Sub
Public Function ChooseNewLocation(ByRef CMB As ComboBoxExtended, ByVal AddToList As Boolean, ByVal AskForName As Boolean) As SFile
Dim f As SFile = SFile.SelectPath(CMB.Text.CSFileP, "Select output directory", EDP.ReturnValue)
If Not f.IsEmptyString Then
CMB.Text = f.PathWithSeparator
If AddToList Then
Add(New DownloadLocation(f.PathWithSeparator), AskForName)
PopulateComboBox(CMB, f)
End If
End If
Return f
End Function
Private Sub Update()
If Locations.Count > 0 Then
Using x As New XmlFile With {.AllowSameNames = True}
x.AddRange(Locations)
x.Name = "Locations"
x.Save(WorkingFile, EDP.SendToLog)
End Using
Else
WorkingFile.Delete(,, EDP.None)
End If
End Sub
Public Sub Clear() Implements ICollection(Of DownloadLocation).Clear
If Locations.Count > 0 Then Locations.Clear() : Update()
End Sub
Public Overloads Sub Add(ByVal Item As DownloadLocation) Implements ICollection(Of DownloadLocation).Add
Add(Item, True)
End Sub
Public Overloads Sub Add(ByVal Item As DownloadLocation, ByVal AskForName As Boolean)
If Not Item.Path.IsEmptyString Then
Dim i% = IndexOf(Item)
Dim processUpdate As Boolean = True
If i >= 0 Then
If Locations(i).Model = Item.Model Then
processUpdate = False
Else
Locations(i) = Item
End If
Else
If Item.Name.IsEmptyString And AskForName Then Item.Name = InputBoxE("Enter a new name for the new location", "Location name", Item.Path)
If Item.Name.IsEmptyString Then Item.Name = Item.Path
Locations.Add(Item)
Locations.Sort()
End If
If processUpdate Then Update()
End If
End Sub
Private Sub CopyTo(ByVal Array() As DownloadLocation, ByVal ArrayIndex As Integer) Implements ICollection(Of DownloadLocation).CopyTo
Locations.CopyTo(Array, ArrayIndex)
End Sub
Public Function Contains(ByVal Item As DownloadLocation) As Boolean Implements ICollection(Of DownloadLocation).Contains
Return Not Item.Path.IsEmptyString AndAlso Locations.Contains(Item)
End Function
Public Function IndexOf(ByVal Item As DownloadLocation, Optional ByVal IgnoreModel As Boolean = False) As Integer
Return Locations.FindIndex(Function(d) d.Path = Item.Path And (d.Model = Item.Model Or IgnoreModel))
End Function
Public Function Remove(ByVal Item As DownloadLocation) As Boolean Implements ICollection(Of DownloadLocation).Remove
If Locations.Remove(Item) Then
Update()
Return True
Else
Return False
End If
End Function
Private Function GetEnumerator() As IEnumerator(Of DownloadLocation) Implements IEnumerable(Of DownloadLocation).GetEnumerator
Return New MyEnumerator(Of DownloadLocation)(Me)
End Function
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return GetEnumerator()
End Function
End Class
End Namespace

View File

@@ -16,5 +16,11 @@ Namespace DownloadObjects.STDownloader
ReadOnly Property OnItemDoubleClick As DoubleClickBehavior
ReadOnly Property OpenFolderInOtherProgram As Boolean
ReadOnly Property OpenFolderInOtherProgram_Command As String
ReadOnly Property OutputPathAskForName As Boolean
ReadOnly Property OutputPathAutoAddPaths As Boolean
ReadOnly Property ENVIR_FFMPEG As SFile
ReadOnly Property ENVIR_YTDLP As SFile
ReadOnly Property ENVIR_GDL As SFile
ReadOnly Property ENVIR_CURL As SFile
End Interface
End Namespace

View File

@@ -47,6 +47,7 @@ Namespace DownloadObjects.STDownloader
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()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
SEP_3 = New System.Windows.Forms.ToolStripSeparator()
MENU_ADD_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
@@ -104,7 +105,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.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.Location = New System.Drawing.Point(0, 0)
Me.TOOLBAR_TOP.Name = "TOOLBAR_TOP"
Me.TOOLBAR_TOP.Size = New System.Drawing.Size(584, 25)
@@ -262,6 +263,16 @@ Namespace DownloadObjects.STDownloader
Me.BTT_DONATE.Size = New System.Drawing.Size(23, 22)
Me.BTT_DONATE.ToolTipText = "Support"
'
'BTT_BUG_REPORT
'
Me.BTT_BUG_REPORT.Alignment = System.Windows.Forms.ToolStripItemAlignment.Right
Me.BTT_BUG_REPORT.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.BTT_BUG_REPORT.Image = Global.SCrawler.My.Resources.Resources.MailPic_16
Me.BTT_BUG_REPORT.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_BUG_REPORT.Name = "BTT_BUG_REPORT"
Me.BTT_BUG_REPORT.Size = New System.Drawing.Size(23, 22)
Me.BTT_BUG_REPORT.Text = "Bug report"
'
'VideoListForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -305,5 +316,6 @@ Namespace DownloadObjects.STDownloader
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
End Class
End Namespace

View File

@@ -136,88 +136,46 @@
<data name="BTT_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN1SURBVEhLrZVJTFNRFIafQhgD1OBUpiiKYg22AopFKggK
FdRYQUEZgsqgGBAChaiYRlG2RuPOuCDGGDcG48phgcQog0KFV4QKKZ2wSIJxf83vuc8SWRAw8E7yp23u
yf/de95/X4Wlyu+eT4f/fR8sJL7mbVt+cSOVWcUyB3U4/EUHvUiy6HDKliVBvG3LL26SMKRiQd0CQj8K
CO8XEPnZF5WuXPkAGlHFwnoErOtfhU2D/vQ7FM2efPkASQTgO481+yNxJAwZoxtwe6ZEPoCWALHmAOwZ
USDHGkHz34p7s1XyAc6LGpZsUSDXGomzk9tRZdfg0a86+QCN4j6m/xaFUvsO1DgS0ehMxZNfxv8DLJbz
OZX2p/8uscej1pGMlikdbnqy0fGzCWufBi4q5fPgDmmHWXMZp3znjepw0pqJMlsOap3HcdV9Cnc8ZfQ9
GdfcB3DLk4O2aT06ZpvweNYogR7O1uHuTAVuTRej2V1AI8xDjb0Qys5gSABuHvqBMt4rIGrQD2qKIU+K
YSIW5+w7ccWZgutTB8lAj/bpXAlw83s2melQ5dDg9EQcssY2Qm0JRfSAHxTkU2gx/APwnXNzvqi2hFCz
Evle83pXClrdmWjz6AmQjRvfM2F0p9GzSEL5pAonxjcjfXQ9EsQQRAz6QtEnIJAuZf6XeYC8ER1iyFxD
O8iyKqUYVjrUaHDtxbWpDLSS6VV3OoyuNNQ796Ca1krtKhwb34QDdFLJfMAX/DJy81WvBRj65gHOWA9B
OxJOMYxCsS0edfQwmygpLWTITRtdqZIaaFTVNBKepqPjMUj7uh47hoOh/OSDEBpxQJcA4RWpkwDv5wEu
iYnMKKYy02gpM41dYCZrNTN9q6LPi8wkXmYPflwi872otKtRNLkNuePRaHGWIb8n43eFuJ+ViFpWREol
aYdIn0m9WiYBeEwXiticeFO72MIqHbtQZIvDETplCp22xlEkrS0qHtOlijeaxAZ2mp5LzlgkkuhGbzEH
otx2UjLxti2//gJqWPZYhPSi42/TcErKWat3xiutv4AKttsShihKyhqKM/9vKJjL+UqLm9SJxSx6wB8K
imHQOwE+byglZhkB5ylh3DyAdr6ax/AlAXpkBBRT/AJp5wJdIOEF6RkBumUEFAwbpJEYekl0gQxdpLdy
ASjL3GhBLZlzQfgD9Y2tq0N6ki0AAAAASUVORK5CYII=
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=
</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
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
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
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN9SURBVEhLrZVZSFRRGMdvKa6oE5Y1bpTtRY1N5pB407Tu
TFrRpJXlgpVLTWiJTlIZli0QPUTLW/QgEdFLFD21PFREZYtONTON08jsOiYYvp/4953LSD6Iht0P/jBw
Dv/fd77zP3eE6SrqekR39I0ITCa+Ft428+JGOouWFfWJ2PpFhMFKsonY4y6WIeFtMy9ukvdVy+JeC0h8
JyD5o4C0z5GoD5QoBxCtWpb0XsC8j7OwsC8a2dZEnAyVKQcoJADvPMsSDa09CYWO+bg4UqUcQLLqWJYl
BhvsKuidqTT/Jbg+2qAc4JBVZDk2FUqcaTjgWY4GbzbujDUrB2h1bGWGH+mo9q6EyadFqz8P98bM/waY
KufjMjn0v6u8K9Dky0H7oIjzIQndv9ow937slFI/jO+WOywezzjlu9QhYrezCDVuPZr8O3EquAeXQjX0
Oweng5vQFdLjwrAB3aNtuDtqlkG3R5txbaQOXcOVOBkspxGWwuTdB/WjeMgAbp74ljLeIyC9LwoaiiFP
inEgCwe9q3Hcr8OZwc1kYMDl4RIZcH5IIjMRDb5s7B1YiuL+BdDYEpHRGwUV+eyzGf8CeOfcnC9qbAm0
WY2ysPmJgA4dwSJcCBkIIOHsUBHMwXy6i/Wo9azCLtciFDhSsMaagNS+SKg+CIilR1n2ZQKg1C4ik8yz
qYNip1qOYb1Pg5ZALk4PFqKDTE8FC2AO5OOEfwMaaa3auwo7XAuxiU4qm/dGgj9Gbj7rmQDjhwmA/c4t
2GhPphimo9K9As10mW2UlHYy5KatgTxZLTSqRhoJT9N2Vybyv6dg5bd4qD9FIIFGHPNSgPCU9IgAbyYA
jg4UMLNHzzqD1axz8DDrGmpkXaEGdnHoCLviPsZu/TxK5rmo92pQ4VmGElcG2v01qLXt+F3nMLAqm8Qq
rBLTk6SvpM+kHonJAB7TySI2Lr7ppqed1fvWosK9FNvolDo6rclXIa9NKR7T6YpvvOpuYXvpXvT9aVhP
L3qxJRa17t2ySXjbzIubnHOZmNSfKn/o+Nc0mZJywBme8f8WN+nsr2PrbElIp6TMoTjz/4by8Zz/b3GT
Znsly+iNhopiGPdKQMRzSolFQcAhq55x8xjqfDaP4RMCvFcQUEnxi6XOBXpAwmPSAwK8VhBQ/s0oj8TY
Q6IHZHxJeqEUgLLMjSbVtDkXhD9St6/+w21JdAAAAABJRU5ErkJggg==
</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
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN9SURBVEhLrZVZSFRRGMdvKa6oE5Y1bpTtRY1N5pB407Tu
TFrRpJXlgpVLTWiJTlIZli0QPUTLW/QgEdFLFD21PFREZYtONTON08jsOiYYvp/4953LSD6Iht0P/jBw
Dv/fd77zP3eE6SrqekR39I0ITCa+Ft428+JGOouWFfWJ2PpFhMFKsonY4y6WIeFtMy9ukvdVy+JeC0h8
JyD5o4C0z5GoD5QoBxCtWpb0XsC8j7OwsC8a2dZEnAyVKQcoJADvPMsSDa09CYWO+bg4UqUcQLLqWJYl
BhvsKuidqTT/Jbg+2qAc4JBVZDk2FUqcaTjgWY4GbzbujDUrB2h1bGWGH+mo9q6EyadFqz8P98bM/waY
KufjMjn0v6u8K9Dky0H7oIjzIQndv9ow937slFI/jO+WOywezzjlu9QhYrezCDVuPZr8O3EquAeXQjX0
Oweng5vQFdLjwrAB3aNtuDtqlkG3R5txbaQOXcOVOBkspxGWwuTdB/WjeMgAbp74ljLeIyC9LwoaiiFP
inEgCwe9q3Hcr8OZwc1kYMDl4RIZcH5IIjMRDb5s7B1YiuL+BdDYEpHRGwUV+eyzGf8CeOfcnC9qbAm0
WY2ysPmJgA4dwSJcCBkIIOHsUBHMwXy6i/Wo9azCLtciFDhSsMaagNS+SKg+CIilR1n2ZQKg1C4ik8yz
qYNip1qOYb1Pg5ZALk4PFqKDTE8FC2AO5OOEfwMaaa3auwo7XAuxiU4qm/dGgj9Gbj7rmQDjhwmA/c4t
2GhPphimo9K9As10mW2UlHYy5KatgTxZLTSqRhoJT9N2Vybyv6dg5bd4qD9FIIFGHPNSgPCU9IgAbyYA
jg4UMLNHzzqD1axz8DDrGmpkXaEGdnHoCLviPsZu/TxK5rmo92pQ4VmGElcG2v01qLXt+F3nMLAqm8Qq
rBLTk6SvpM+kHonJAB7TySI2Lr7ppqed1fvWosK9FNvolDo6rclXIa9NKR7T6YpvvOpuYXvpXvT9aVhP
L3qxJRa17t2ySXjbzIubnHOZmNSfKn/o+Nc0mZJywBme8f8WN+nsr2PrbElIp6TMoTjz/4by8Zz/b3GT
Znsly+iNhopiGPdKQMRzSolFQcAhq55x8xjqfDaP4RMCvFcQUEnxi6XOBXpAwmPSAwK8VhBQ/s0oj8TY
Q6IHZHxJeqEUgLLMjSbVtDkXhD9St6/+w21JdAAAAABJRU5ErkJggg==
</value>
</data>
<data name="MENU_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN8SURBVEhLrZVZSJRRGIZ/U1wSdcK2caMsW6nR3Chm1LRZ
@@ -236,122 +194,164 @@
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
</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==
</value>
</data>
<data name="BTT_STOP.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVFSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcQBQgv01tK6
oSgvUrRgSwUdI2pGxRUUX1CiGI3RRONLsmQftg/bhy0zmXFLdFk2JkjJmMCmCE4wvOmwllL6Cpe9JAv0
7H9KqzOWjSf55fae85z/8+9zzr2XQ6M3Pz/KnJDwSduyZcM3JJKPN4nFr2E4wj/5PzGkVKp+k0jaR5Yu
7bmWmGjAUBQI80/S6DOZ+Lfz878aamggo5cukbv19b4bKlVrlkCwEtORc1mhY4Bh3rZt3/6YPX+eTF+8
SIbLytwfJifXSKKjYzE9V6R1xYqPBg8eJI9OnSKjJ08SK5ItR46QJpWqXSYQvImUkEVG1OoNELewFy4Q
FmvZxkYyfeIEGdRqPd+IxR8gRQgiOG0ikZWKP6qvJ4+PHSNWJI2fPUv6Ghp8N5TKn6QCQRISnyuCthTY
ysut1DkVn4Y4e/gwmYYxb2UlMcfF9SNNBQSclvj4y8NVVWQUBSzAevQosWHBxJkz5AHa1aJSdabx+clI
9hcZkssLxsvKrFPnzhEWZqZhisW66QMHyOSePaRJqXTuEImuIrUICDn65ctfb1Io2rt37fI9QdIYGIeb
CeyJCy1zHDpE2lAkk89Pucsw+WMGg23q9Gl/S1g4ZtFetq6OTEHcnJnpTuLxPoewEcgA3XBOJCMSJaNI
p2XHDmLbu5fYa2vJxP79xIliHggN1tb6utTqew9LSqzs8eN+xyzmWOSyNTVPxVN4vMvQqwKpAfFw4A9u
plCY8oNc3nG/osJnr64mDuAymYgbAl4U8+7bR6bgdooK457FvV8c7e1QKDwyPp+KU+erwGLw7KgGgqsU
Cle1pKd32rZuJY6dO4kLeIxG4oXDSRScxAZOlpQQ7/r1xKtWEzfoyMryZggEV7B+N6DOeeAF8WBwV8fG
prbIZJ392dkz7m3biEujIS6GIU6xmDgFAuKMjCTORYvIIJ/va05I8KhiYuiGVoM08DKYVzwY/nbdlsl6
xyFoh9gEcAAq7CcigvSkp/9lSE7+DvnvAylYkLg/bJWVJptabbHzeC+KAzrWl5g4Y9ZqH6bEx5dgSTRY
mLjXaDzkzM112uF+PvEx8BhYUlNJj07X/86aNRlY+p+vFX+4jMZGx8aNLntU1AviDvSetouKj4Lh8HDS
B37OyPD1lpY+MKhUtE3zF/Hs3n1sorDQHcq5QyQiTwoL/36QlOSj4kMB8W7QAdoZZraX/pP5iuAoNtpz
cz12Pt8v/FxbliwhA0VFv59eu7are/PmcUtKCrkP0TvgFvgRmEHb6tWzvxgM93JlMvqCfPaqd1dVNVDx
iVDicXFkYN26P2oYpgWptYVpae/2Fxc/HEDvg+KtoBk0AbNSOdtVWtr9mVZLN54LwjjuLVusEzExoZ1D
vFoub0aiCdCNFO7PyXmrR68fuSeVPhX/HnwLroNemWzmjl4/iNzlgMux63QDbokkpHMTw9xEUk1APPil
4h7Iy1P1lJaO3JRKff8W/zosjNyRSmfMGs0Y8vJBLKeromL7uEbjckE06LyvoODPvaHFg8Gty8nJwsYO
305PJ9cC4uasrNkvNZonRStXfoqcuQKIxc1lZcetxcWeIZXKR53XKRStGJ9PPBhcY3a2nLYD3wyfWa2e
vQrnr/B4FzGnA3MtQoQxCQnR3Xr9F4+Kix1X8vJw+sLrMM4APp2nSfME93p5+Xu/6nRjt7RaZ2FSEv0W
6IEY0OP6dC39EQMUYFPgutDH/yVAjyY9OZvBGyDkA7cIUMf0Y02v9H4hQU3Q9/+rAWjBgDEO5x9IKtl+
4dDtOAAAAABJRU5ErkJggg==
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
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVDSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3lFs3
FceLFC3YgqBjRM2ouILiC0oUozGauPiSLNmH7cP2YctMZtwSXdzGhFE3J5ABAg4XBHRYS+l74bKXZJGe
/U9pdcay8SS/3N5znvN//n3OuffyaAwUFkaZEhI+ur5s2eg1mezDDVLpSxiO8E/+T4yoVOxvMtmNsaVL
+y8nJlZgKAqE+SdpDBmNwp7Cwi9GmpvJ+PnzpLOpyXeNZTtyRaKVmI6cywodwwzzunXr1gfcmTNk5tw5
MlpZ6X4/ObleFh0di+m5Ih0rVnxwd/9+cv/ECTJ+/DixINl86BBpZdkbcpHoVaSELDKmVr8BcTN39izh
sJZraSEzx46Ru1qt5yup9D2kiEEE77pEYqHi95uayIMjR4gFSZOnT5Pe5mbfNZXqpwyRKAmJTxVBW4qs
VVUW6pyKz0CcO3iQzMCYt6aGmOLi7iCNBSJee3z8hdHaWjKOAmZgOXyYWLHAfuoUuYV2tbNsV7pQmIxk
f5ERhaJosrLSMv3uu4SDmRmY4rBuZt8+MrVrF2lVqZzbJJJLSC0BYp5++fKXW5XKGzd37PA9RNIEmIQb
O/bEhZY5Dhwg11EkWyhMucUwhRMVFdbpkyf9LeHgmEN7ucZGMg1xU3a2O0kg+BTCBiAHdMN5kYxEkowi
XeZt24h1925ia2gg9r17iRPFPBAabGjwdavVg/fKyizc0aN+xxzmOORy9fWPxVMEggvQqwVpAfFw4A9+
tlic8p1C0dlTXe2z1dURB3AZjcQNAS+KeffsIdNwO02Fcc/h3i+O9nYqlR65UEjFqfNUsBg8OaqB4KvE
4tT2zMwu6+bNxLF9O3EBj8FAvHA4hYJT2MCpsjLiXbeOeNVq4gadubneLJHoItbvBNS5ADwjHgx+Tmxs
Wrtc3jWUk/PIvWULcWk0xMUwxCmVEqdIRJyRkcS5aBEZFAp9bQkJHjYmhm5oHUgHz4N5xYPhb1ePXD4w
CUEbxOzAAaiwn4gI0p+Z+VdFcvI3yH8HZIAFifvDWlNjtKrVZptA8Kw4oGNDiYmPTFrtvZT4+DIsiQYL
E/caDAec+flOG9zPJz4BHgBzWhrp1+nuvLlqVRaW/udrxR8ug6HFsX69yxYV9Yy4A72n7aLi42A0PJwM
gR+ysnwD5eW/VrAsbdP8RTw7dx6xFxe7Qzl3SCTkYXHx37eSknxUfCQg3gc6gYlhZgfoP5mvCI5iiy0/
32MTCv3CT7VlyRIyXFLy+8k1a7r7Nm6cNKekkF8g2gtugh9pAUpOzuzPFRWD+XI5fUE+edW7a2ubqbg9
lHhcHBleu/aPeoZpR2pDcXr6W3dKS+8No/dB8Q7QBlppEZVqtru8vO8TrZZuPB+E8dybNlnsMTGhnUO8
TqFoQ6IR0I0U783Le61frx8bzMh4LP4tuAqugIHU1Ee9ev1d5C4HfJ5Npxt2y2QhnRsZ5nsk1QfEg18q
/r6CAra/vHzs64wM37/FvwwLI70oYNJoJpBXCGJ53dXVWyc1GpcLokHnQ0VFf+4OLR4MfmNeXi42drQn
M5NcDoibcnNnP9doHpasXPkxcuYKIBa3VVYetZSWem6zrI86b1QqOzA+n3gw+IbVqxW0HVexzqRWz16C
8xcEgnOY04G5FiHCmISE6D69/rP7paWOiwUFOH3hjRhngJDO06R5gn+lqurt2zrdxE2t1lmclES/BXog
BfS4Pl5Lf8QAJdgQuC708X8O0KNJT85G8AoI+cAtAtQx/VjTK71fSFAT9P3/YgBaMGCMx/sHyjLY+hqD
P/QAAAAASUVORK5CYII=
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
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVDSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3lFs3
FceLFC3YgqBjRM2ouILiC0oUozGauPiSLNmH7cP2YctMZtwSXdzGhFE3J5ABAg4XBHRYS+l74bKXZJGe
/U9pdcay8SS/3N5znvN//n3OuffyaAwUFkaZEhI+ur5s2eg1mezDDVLpSxiO8E/+T4yoVOxvMtmNsaVL
+y8nJlZgKAqE+SdpDBmNwp7Cwi9GmpvJ+PnzpLOpyXeNZTtyRaKVmI6cywodwwzzunXr1gfcmTNk5tw5
MlpZ6X4/ObleFh0di+m5Ih0rVnxwd/9+cv/ECTJ+/DixINl86BBpZdkbcpHoVaSELDKmVr8BcTN39izh
sJZraSEzx46Ru1qt5yup9D2kiEEE77pEYqHi95uayIMjR4gFSZOnT5Pe5mbfNZXqpwyRKAmJTxVBW4qs
VVUW6pyKz0CcO3iQzMCYt6aGmOLi7iCNBSJee3z8hdHaWjKOAmZgOXyYWLHAfuoUuYV2tbNsV7pQmIxk
f5ERhaJosrLSMv3uu4SDmRmY4rBuZt8+MrVrF2lVqZzbJJJLSC0BYp5++fKXW5XKGzd37PA9RNIEmIQb
O/bEhZY5Dhwg11EkWyhMucUwhRMVFdbpkyf9LeHgmEN7ucZGMg1xU3a2O0kg+BTCBiAHdMN5kYxEkowi
XeZt24h1925ia2gg9r17iRPFPBAabGjwdavVg/fKyizc0aN+xxzmOORy9fWPxVMEggvQqwVpAfFw4A9+
tlic8p1C0dlTXe2z1dURB3AZjcQNAS+KeffsIdNwO02Fcc/h3i+O9nYqlR65UEjFqfNUsBg8OaqB4KvE
4tT2zMwu6+bNxLF9O3EBj8FAvHA4hYJT2MCpsjLiXbeOeNVq4gadubneLJHoItbvBNS5ADwjHgx+Tmxs
Wrtc3jWUk/PIvWULcWk0xMUwxCmVEqdIRJyRkcS5aBEZFAp9bQkJHjYmhm5oHUgHz4N5xYPhb1ePXD4w
CUEbxOzAAaiwn4gI0p+Z+VdFcvI3yH8HZIAFifvDWlNjtKrVZptA8Kw4oGNDiYmPTFrtvZT4+DIsiQYL
E/caDAec+flOG9zPJz4BHgBzWhrp1+nuvLlqVRaW/udrxR8ug6HFsX69yxYV9Yy4A72n7aLi42A0PJwM
gR+ysnwD5eW/VrAsbdP8RTw7dx6xFxe7Qzl3SCTkYXHx37eSknxUfCQg3gc6gYlhZgfoP5mvCI5iiy0/
32MTCv3CT7VlyRIyXFLy+8k1a7r7Nm6cNKekkF8g2gtugh9pAUpOzuzPFRWD+XI5fUE+edW7a2ubqbg9
lHhcHBleu/aPeoZpR2pDcXr6W3dKS+8No/dB8Q7QBlppEZVqtru8vO8TrZZuPB+E8dybNlnsMTGhnUO8
TqFoQ6IR0I0U783Le61frx8bzMh4LP4tuAqugIHU1Ee9ev1d5C4HfJ5Npxt2y2QhnRsZ5nsk1QfEg18q
/r6CAra/vHzs64wM37/FvwwLI70oYNJoJpBXCGJ53dXVWyc1GpcLokHnQ0VFf+4OLR4MfmNeXi42drQn
M5NcDoibcnNnP9doHpasXPkxcuYKIBa3VVYetZSWem6zrI86b1QqOzA+n3gw+IbVqxW0HVexzqRWz16C
8xcEgnOY04G5FiHCmISE6D69/rP7paWOiwUFOH3hjRhngJDO06R5gn+lqurt2zrdxE2t1lmclES/BXog
BfS4Pl5Lf8QAJdgQuC708X8O0KNJT85G8AoI+cAtAtQx/VjTK71fSFAT9P3/YgBaMGCMx/sHyjLY+hqD
P/QAAAAASUVORK5CYII=
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
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVDSURBVEhLjZVtTFNXGMcLQmdHO6AdarLSOcTxXqC3lFs3
FceLFC3YgqBjRM2ouILiC0oUozGauPiSLNmH7cP2YctMZtwSXdzGhFE3J5ABAg4XBHRYS+l74bKXZJGe
/U9pdcay8SS/3N5znvN//n3OuffyaAwUFkaZEhI+ur5s2eg1mezDDVLpSxiO8E/+T4yoVOxvMtmNsaVL
+y8nJlZgKAqE+SdpDBmNwp7Cwi9GmpvJ+PnzpLOpyXeNZTtyRaKVmI6cywodwwzzunXr1gfcmTNk5tw5
MlpZ6X4/ObleFh0di+m5Ih0rVnxwd/9+cv/ECTJ+/DixINl86BBpZdkbcpHoVaSELDKmVr8BcTN39izh
sJZraSEzx46Ru1qt5yup9D2kiEEE77pEYqHi95uayIMjR4gFSZOnT5Pe5mbfNZXqpwyRKAmJTxVBW4qs
VVUW6pyKz0CcO3iQzMCYt6aGmOLi7iCNBSJee3z8hdHaWjKOAmZgOXyYWLHAfuoUuYV2tbNsV7pQmIxk
f5ERhaJosrLSMv3uu4SDmRmY4rBuZt8+MrVrF2lVqZzbJJJLSC0BYp5++fKXW5XKGzd37PA9RNIEmIQb
O/bEhZY5Dhwg11EkWyhMucUwhRMVFdbpkyf9LeHgmEN7ucZGMg1xU3a2O0kg+BTCBiAHdMN5kYxEkowi
XeZt24h1925ia2gg9r17iRPFPBAabGjwdavVg/fKyizc0aN+xxzmOORy9fWPxVMEggvQqwVpAfFw4A9+
tlic8p1C0dlTXe2z1dURB3AZjcQNAS+KeffsIdNwO02Fcc/h3i+O9nYqlR65UEjFqfNUsBg8OaqB4KvE
4tT2zMwu6+bNxLF9O3EBj8FAvHA4hYJT2MCpsjLiXbeOeNVq4gadubneLJHoItbvBNS5ADwjHgx+Tmxs
Wrtc3jWUk/PIvWULcWk0xMUwxCmVEqdIRJyRkcS5aBEZFAp9bQkJHjYmhm5oHUgHz4N5xYPhb1ePXD4w
CUEbxOzAAaiwn4gI0p+Z+VdFcvI3yH8HZIAFifvDWlNjtKrVZptA8Kw4oGNDiYmPTFrtvZT4+DIsiQYL
E/caDAec+flOG9zPJz4BHgBzWhrp1+nuvLlqVRaW/udrxR8ug6HFsX69yxYV9Yy4A72n7aLi42A0PJwM
gR+ysnwD5eW/VrAsbdP8RTw7dx6xFxe7Qzl3SCTkYXHx37eSknxUfCQg3gc6gYlhZgfoP5mvCI5iiy0/
32MTCv3CT7VlyRIyXFLy+8k1a7r7Nm6cNKekkF8g2gtugh9pAUpOzuzPFRWD+XI5fUE+edW7a2ubqbg9
lHhcHBleu/aPeoZpR2pDcXr6W3dKS+8No/dB8Q7QBlppEZVqtru8vO8TrZZuPB+E8dybNlnsMTGhnUO8
TqFoQ6IR0I0U783Le61frx8bzMh4LP4tuAqugIHU1Ee9ev1d5C4HfJ5Npxt2y2QhnRsZ5nsk1QfEg18q
/r6CAra/vHzs64wM37/FvwwLI70oYNJoJpBXCGJ53dXVWyc1GpcLokHnQ0VFf+4OLR4MfmNeXi42drQn
M5NcDoibcnNnP9doHpasXPkxcuYKIBa3VVYetZSWem6zrI86b1QqOzA+n3gw+IbVqxW0HVexzqRWz16C
8xcEgnOY04G5FiHCmISE6D69/rP7paWOiwUFOH3hjRhngJDO06R5gn+lqurt2zrdxE2t1lmclES/BXog
BfS4Pl5Lf8QAJdgQuC708X8O0KNJT85G8AoI+cAtAtQx/VjTK71fSFAT9P3/YgBaMGCMx/sHyjLY+hqD
P/QAAAAASUVORK5CYII=
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_LOG.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">

View File

@@ -50,7 +50,11 @@ Namespace DownloadObjects.STDownloader
End If
If AppMode Then
If Now.Month.ValueBetween(6, 8) Then Text = "SCrawler: Happy LGBT Pride Month! :-)"
If Now.Month.ValueBetween(6, 8) Then
Text = "SCrawler: Happy LGBT Pride Month! :-)"
ElseIf Not MyYouTubeSettings Is Nothing AndAlso Not MyYouTubeSettings.ProgramText.IsEmptyString Then
Text = MyYouTubeSettings.ProgramText
End If
MyNotificator = New YTNotificator(Me)
MyDownloaderSettings = MyYouTubeSettings
End If
@@ -64,6 +68,7 @@ Namespace DownloadObjects.STDownloader
BTT_LOG.Visible = False
BTT_INFO.Visible = False
BTT_DONATE.Visible = False
BTT_BUG_REPORT.Visible = False
End If
MyProgress.Visible = False
LoadData()
@@ -96,7 +101,7 @@ Namespace DownloadObjects.STDownloader
If c.ListExists Then
c.Sort(New ContainerDateComparer)
SuspendLayout()
For i% = c.Count - 1 To 0 Step -1 : ControlCreateAndAdd(c(i), True, i = 0) : Next
For i% = c.Count - 1 To 0 Step -1 : ControlCreateAndAdd(c(i), True, i = 0, True) : Next
ResumeLayout(False)
PerformLayout()
End If
@@ -121,11 +126,11 @@ Namespace DownloadObjects.STDownloader
#End Region
#Region "Controls"
Protected Sub ControlCreateAndAdd(ByVal Container As IYouTubeMediaContainer, Optional ByVal DisableDownload As Boolean = False,
Optional ByVal PerformClick As Boolean = True)
Optional ByVal PerformClick As Boolean = True, Optional ByVal IsLoading As Boolean = False)
ControlInvokeFast(TP_CONTROLS, Sub()
With TP_CONTROLS
.SuspendLayout()
If DisableDownload Or Not MyDownloaderSettings.DownloadAutomatically Then Container.Save()
If Not IsLoading And (DisableDownload Or Not MyDownloaderSettings.DownloadAutomatically) Then Container.Save()
'.AutoScroll = True
'.HorizontalScroll.Visible = False
.RowStyles.Insert(0, New RowStyle(SizeType.Absolute, 60))
@@ -337,13 +342,13 @@ Namespace DownloadObjects.STDownloader
MyJob.Cancel()
End Sub
Private Sub BTT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_DELETE.Click
RemoveControls(ControlsChecked)
RemoveControls(ControlsChecked, True)
End Sub
Protected Overridable Sub BTT_CLEAR_DONE_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DONE.Click
RemoveControls(ControlsDownloaded)
RemoveControls(ControlsDownloaded, False)
End Sub
Protected Overridable Sub BTT_CLEAR_ALL_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_ALL.Click
RemoveControls()
RemoveControls(, False)
End Sub
Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click
MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton)
@@ -351,20 +356,23 @@ Namespace DownloadObjects.STDownloader
Friend Sub UpdateLogButton()
If AppMode Then MyMainLOG_UpdateLogButton(BTT_LOG, TOOLBAR_TOP)
End Sub
Private Sub BTT_BUG_REPORT_Click(sender As Object, e As EventArgs) Handles BTT_BUG_REPORT.Click
Try
With MyYouTubeSettings
Using f As New Editors.BugReporterForm(MyCache, .DesignXml, .ProgramText, My.Application.Info.Version,
True, .Self, .ProgramDescription) : f.ShowDialog() : End Using
End With
Catch
End Try
End Sub
Private Sub BTT_DONATE_Click(sender As Object, e As EventArgs) Handles BTT_DONATE.Click
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
Try
MsgBoxE({$"YouTube Downloader v{My.Application.Info.Version}" & vbCr &
$"Address: https://github.com/AAndyProgram/SCrawler" & vbCr &
"Created by Greek LGBT person Andy (Gay)",
"Program information"},,,,
{"OK", New MsgBoxButton("Go to site") With {.CallBack = Sub(r, n, b) Process.Start("https://github.com/AAndyProgram/SCrawler/releases")}})
Catch
End Try
ShowProgramInfo(MyYouTubeSettings.ProgramText.Value.IfNullOrEmpty("YouTube Downloader"),
My.Application.Info.Version, False, True, MyYouTubeSettings, True,, False, MyYouTubeSettings.ProgramDescription)
End Sub
Protected Overloads Sub RemoveControls(Optional ByVal Predicate As Predicate(Of MediaItem) = Nothing)
Protected Overloads Sub RemoveControls(Optional ByVal Predicate As Predicate(Of MediaItem) = Nothing, Optional ByVal RemoveFiles As Boolean = False)
ControlInvokeFast(TP_CONTROLS, Sub()
With TP_CONTROLS
If .Controls.Count > 0 Then
@@ -379,7 +387,7 @@ Namespace DownloadObjects.STDownloader
For i = rCnt.Count - 1 To 0 Step -1
cnt = .Controls(rCnt(i))
.Controls.RemoveAt(rCnt(i))
If Not cnt.MyContainer Is Nothing Then cnt.MyContainer.Delete(False)
If Not cnt.MyContainer Is Nothing Then cnt.MyContainer.Delete(RemoveFiles) : cnt.MyContainer.Dispose()
cnt.Dispose()
Next
End If
@@ -395,19 +403,24 @@ Namespace DownloadObjects.STDownloader
UpdateScrolls(Nothing, Nothing)
End Sub, EDP.None)
End Sub
Private Overloads Sub RemoveControls(ByVal CNT As MediaItem)
Private Overloads Sub RemoveControls(ByVal CNT As MediaItem, Optional ByVal RemoveFiles As Boolean = False)
ControlInvokeFast(TP_CONTROLS, Sub()
If Not CNT Is Nothing Then TP_CONTROLS.Controls.Remove(CNT) : OffsetControls()
If Not CNT Is Nothing Then
If Not CNT.MyContainer Is Nothing Then CNT.MyContainer.Delete(RemoveFiles) : CNT.MyContainer.Dispose()
TP_CONTROLS.Controls.Remove(CNT)
OffsetControls()
CNT.Dispose()
End If
End Sub, EDP.None)
End Sub
#End Region
#Region "Media controls' handlers"
Private Sub MediaControl_FileDownloaded(ByVal Sender As MediaItem, ByVal Container As IYouTubeMediaContainer)
If MyDownloaderSettings.ShowNotifications Then MyNotificator.ShowNotification(Container.ToString(), Container.ThumbnailFile)
If MyDownloaderSettings.RemoveDownloadedAutomatically Then RemoveControls(Sender)
If MyDownloaderSettings.RemoveDownloadedAutomatically Then RemoveControls(Sender, False)
End Sub
Private Sub MediaControl_Removal(ByVal Sender As MediaItem, ByVal Container As IYouTubeMediaContainer)
RemoveControls(Sender)
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()
@@ -432,8 +445,6 @@ Namespace DownloadObjects.STDownloader
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
'TODELETE: YT video downloader 'Item.Pending'
'Item.Pending = True
MyJob.Add(Item)
Item.AddToQueue()
If RunThread Then StartDownloading()
@@ -457,25 +468,39 @@ Namespace DownloadObjects.STDownloader
MyJob.Start()
Const nf As ANumbers.Formats = ANumbers.Formats.Number
Dim t As New List(Of Task)
Dim i%
Dim i%, iAbs%
Dim __item As MediaItem
Dim Indexes As New List(Of Integer)
Dim IndexesToRemove As New List(Of Integer)
Dim maxJobCount% = MyDownloaderSettings.MaxJobsCount
If maxJobCount <= 0 Then maxJobCount = 1
MyProgress.Visible = True
MyProgress.Maximum = MyJob.Count
Do While MyJob.Count > 0 And Not MyJob.IsCancellationRequested
i = -1
iAbs = -1
Indexes.Clear()
IndexesToRemove.Clear()
For Each __item In MyJob.Items
iAbs += 1
If Not __item.IsDisposed And Not If(__item.MyContainer?.DownloadState, Plugin.UserMediaStates.Unknown) = Plugin.UserMediaStates.Downloaded Then
i += 1
If i <= maxJobCount - 1 Then
Indexes.Add(i)
Indexes.Add(iAbs)
t.Add(Task.Run(Sub() __item.Download(MyJob.Token)))
Else
Exit For
End If
Else
IndexesToRemove.Add(iAbs)
End If
Next
If IndexesToRemove.Count > 0 Then
For i = IndexesToRemove.Count - 1 To 0 Step -1
If Not MyJob.Items(IndexesToRemove(i)).IsDisposed Then MyJob.Items(IndexesToRemove(i)).Pending = False
MyJob.Items.RemoveAt(IndexesToRemove(i))
Next
End If
If t.Count > 0 Then
MyProgress.Information = $"Downloading {t.Count.NumToString(nf, PNumProv)}/{MyJob.Count.NumToString(nf, PNumProv)}"
MyProgress.InformationTemporary = MyProgress.Information
@@ -491,6 +516,7 @@ Namespace DownloadObjects.STDownloader
End If
Loop
Indexes.Clear()
IndexesToRemove.Clear()
MyProgress.Done()
MyProgress.InformationTemporary = "Download completed"
Catch aoex As ArgumentOutOfRangeException

View File

@@ -0,0 +1,361 @@
' 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 Editors
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Public Class BugReporterForm : 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()
Me.components = New System.ComponentModel.Container()
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim TP_BUTTONS 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(BugReporterForm))
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()
Dim ActionButton7 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton8 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton9 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.BTT_EMAIL = New System.Windows.Forms.Button()
Me.BTT_GITHUB = New System.Windows.Forms.Button()
Me.BTT_COPY = New System.Windows.Forms.Button()
Me.BTT_CANCEL = New System.Windows.Forms.Button()
Me.BTT_ANON = New System.Windows.Forms.Button()
Me.TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
Me.TXT_DESCR = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_URL_PROFILE = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_URL_POST = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_REPRODUCE = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_EXPECT = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_LOG = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_FILES = New PersonalUtilities.Forms.Controls.TextBoxExtended()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_BUTTONS = New System.Windows.Forms.TableLayoutPanel()
TP_MAIN.SuspendLayout()
TP_BUTTONS.SuspendLayout()
CType(Me.TXT_DESCR, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_URL_PROFILE, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_URL_POST, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_REPRODUCE, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_EXPECT, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_LOG, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_FILES, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'TP_MAIN
'
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.TXT_DESCR, 0, 0)
TP_MAIN.Controls.Add(Me.TXT_URL_PROFILE, 0, 1)
TP_MAIN.Controls.Add(Me.TXT_URL_POST, 0, 2)
TP_MAIN.Controls.Add(Me.TXT_REPRODUCE, 0, 3)
TP_MAIN.Controls.Add(Me.TXT_EXPECT, 0, 4)
TP_MAIN.Controls.Add(Me.TXT_LOG, 0, 5)
TP_MAIN.Controls.Add(TP_BUTTONS, 0, 7)
TP_MAIN.Controls.Add(Me.TXT_FILES, 0, 6)
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 = 8
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 20.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.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 20.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 20.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 20.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 20.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_MAIN.Size = New System.Drawing.Size(584, 461)
TP_MAIN.TabIndex = 0
'
'TP_BUTTONS
'
TP_BUTTONS.ColumnCount = 6
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 100.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 100.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 100.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 100.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 100.0!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_BUTTONS.Controls.Add(Me.BTT_EMAIL, 2, 0)
TP_BUTTONS.Controls.Add(Me.BTT_GITHUB, 3, 0)
TP_BUTTONS.Controls.Add(Me.BTT_COPY, 4, 0)
TP_BUTTONS.Controls.Add(Me.BTT_CANCEL, 5, 0)
TP_BUTTONS.Controls.Add(Me.BTT_ANON, 1, 0)
TP_BUTTONS.Dock = System.Windows.Forms.DockStyle.Fill
TP_BUTTONS.Location = New System.Drawing.Point(0, 431)
TP_BUTTONS.Margin = New System.Windows.Forms.Padding(0)
TP_BUTTONS.Name = "TP_BUTTONS"
TP_BUTTONS.RowCount = 1
TP_BUTTONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_BUTTONS.Size = New System.Drawing.Size(584, 30)
TP_BUTTONS.TabIndex = 7
'
'BTT_EMAIL
'
Me.BTT_EMAIL.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_EMAIL.Location = New System.Drawing.Point(187, 3)
Me.BTT_EMAIL.Name = "BTT_EMAIL"
Me.BTT_EMAIL.Size = New System.Drawing.Size(94, 24)
Me.BTT_EMAIL.TabIndex = 1
Me.BTT_EMAIL.Text = "email"
Me.TT_MAIN.SetToolTip(Me.BTT_EMAIL, "Create a message to send via email.")
Me.BTT_EMAIL.UseVisualStyleBackColor = True
'
'BTT_GITHUB
'
Me.BTT_GITHUB.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_GITHUB.Location = New System.Drawing.Point(287, 3)
Me.BTT_GITHUB.Name = "BTT_GITHUB"
Me.BTT_GITHUB.Size = New System.Drawing.Size(94, 24)
Me.BTT_GITHUB.TabIndex = 2
Me.BTT_GITHUB.Text = "GitHub"
Me.TT_MAIN.SetToolTip(Me.BTT_GITHUB, "Create a MarkDown message to post to GitHub.")
Me.BTT_GITHUB.UseVisualStyleBackColor = True
'
'BTT_COPY
'
Me.BTT_COPY.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_COPY.Location = New System.Drawing.Point(387, 3)
Me.BTT_COPY.Name = "BTT_COPY"
Me.BTT_COPY.Size = New System.Drawing.Size(94, 24)
Me.BTT_COPY.TabIndex = 3
Me.BTT_COPY.Text = "Copy"
Me.TT_MAIN.SetToolTip(Me.BTT_COPY, "Create a message and copy to your clipboard.")
Me.BTT_COPY.UseVisualStyleBackColor = True
'
'BTT_CANCEL
'
Me.BTT_CANCEL.DialogResult = System.Windows.Forms.DialogResult.Cancel
Me.BTT_CANCEL.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_CANCEL.Location = New System.Drawing.Point(487, 3)
Me.BTT_CANCEL.Name = "BTT_CANCEL"
Me.BTT_CANCEL.Size = New System.Drawing.Size(94, 24)
Me.BTT_CANCEL.TabIndex = 4
Me.BTT_CANCEL.Text = "Cancel"
Me.BTT_CANCEL.UseVisualStyleBackColor = True
'
'BTT_ANON
'
Me.BTT_ANON.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_ANON.Location = New System.Drawing.Point(87, 3)
Me.BTT_ANON.Name = "BTT_ANON"
Me.BTT_ANON.Size = New System.Drawing.Size(94, 24)
Me.BTT_ANON.TabIndex = 0
Me.BTT_ANON.Text = "Anon message"
Me.TT_MAIN.SetToolTip(Me.BTT_ANON, resources.GetString("BTT_ANON.ToolTip"))
Me.BTT_ANON.UseVisualStyleBackColor = True
'
'TXT_DESCR
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Dock = System.Windows.Forms.DockStyle.Top
ActionButton1.Name = "Clear"
ActionButton1.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_DESCR.Buttons.Add(ActionButton1)
Me.TXT_DESCR.CaptionDock = System.Windows.Forms.DockStyle.Top
Me.TXT_DESCR.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.None
Me.TXT_DESCR.CaptionVisible = False
Me.TXT_DESCR.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_DESCR.GroupBoxed = True
Me.TXT_DESCR.GroupBoxText = "Describe the bug or write your message"
Me.TXT_DESCR.Lines = New String(-1) {}
Me.TXT_DESCR.Location = New System.Drawing.Point(3, 3)
Me.TXT_DESCR.Multiline = True
Me.TXT_DESCR.Name = "TXT_DESCR"
Me.TXT_DESCR.Size = New System.Drawing.Size(578, 69)
Me.TXT_DESCR.TabIndex = 0
Me.TXT_DESCR.TextToolTip = "A clear and concise description of what the bug is"
Me.TXT_DESCR.TextToolTipEnabled = True
'
'TXT_URL_PROFILE
'
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Clear"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_URL_PROFILE.Buttons.Add(ActionButton2)
Me.TXT_URL_PROFILE.CaptionText = "Profile URL"
Me.TXT_URL_PROFILE.CaptionWidth = 75.0R
Me.TXT_URL_PROFILE.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_URL_PROFILE.Lines = New String(-1) {}
Me.TXT_URL_PROFILE.Location = New System.Drawing.Point(3, 78)
Me.TXT_URL_PROFILE.Name = "TXT_URL_PROFILE"
Me.TXT_URL_PROFILE.Size = New System.Drawing.Size(578, 22)
Me.TXT_URL_PROFILE.TabIndex = 1
'
'TXT_URL_POST
'
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Clear"
ActionButton3.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_URL_POST.Buttons.Add(ActionButton3)
Me.TXT_URL_POST.CaptionText = "Post URL"
Me.TXT_URL_POST.CaptionWidth = 75.0R
Me.TXT_URL_POST.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_URL_POST.Lines = New String(-1) {}
Me.TXT_URL_POST.Location = New System.Drawing.Point(3, 106)
Me.TXT_URL_POST.Name = "TXT_URL_POST"
Me.TXT_URL_POST.Size = New System.Drawing.Size(578, 22)
Me.TXT_URL_POST.TabIndex = 2
'
'TXT_REPRODUCE
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Dock = System.Windows.Forms.DockStyle.Top
ActionButton4.Name = "Clear"
ActionButton4.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_REPRODUCE.Buttons.Add(ActionButton4)
Me.TXT_REPRODUCE.CaptionDock = System.Windows.Forms.DockStyle.Top
Me.TXT_REPRODUCE.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.None
Me.TXT_REPRODUCE.CaptionVisible = False
Me.TXT_REPRODUCE.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_REPRODUCE.GroupBoxed = True
Me.TXT_REPRODUCE.GroupBoxText = "To Reproduce"
Me.TXT_REPRODUCE.Lines = New String(-1) {}
Me.TXT_REPRODUCE.Location = New System.Drawing.Point(3, 134)
Me.TXT_REPRODUCE.Multiline = True
Me.TXT_REPRODUCE.Name = "TXT_REPRODUCE"
Me.TXT_REPRODUCE.Size = New System.Drawing.Size(578, 69)
Me.TXT_REPRODUCE.TabIndex = 3
Me.TXT_REPRODUCE.TextToolTip = "Steps to reproduce the behavior:" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "1. Do something" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "2. See error"
Me.TXT_REPRODUCE.TextToolTipEnabled = True
'
'TXT_EXPECT
'
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Dock = System.Windows.Forms.DockStyle.Top
ActionButton5.Name = "Clear"
ActionButton5.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_EXPECT.Buttons.Add(ActionButton5)
Me.TXT_EXPECT.CaptionDock = System.Windows.Forms.DockStyle.Top
Me.TXT_EXPECT.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.None
Me.TXT_EXPECT.CaptionVisible = False
Me.TXT_EXPECT.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_EXPECT.GroupBoxed = True
Me.TXT_EXPECT.GroupBoxText = "Expected behavior"
Me.TXT_EXPECT.Lines = New String(-1) {}
Me.TXT_EXPECT.Location = New System.Drawing.Point(3, 209)
Me.TXT_EXPECT.Multiline = True
Me.TXT_EXPECT.Name = "TXT_EXPECT"
Me.TXT_EXPECT.Size = New System.Drawing.Size(578, 69)
Me.TXT_EXPECT.TabIndex = 4
Me.TXT_EXPECT.TextToolTip = "A clear and concise description of what you expected to happen."
Me.TXT_EXPECT.TextToolTipEnabled = True
'
'TXT_LOG
'
ActionButton6.BackgroundImage = CType(resources.GetObject("ActionButton6.BackgroundImage"), System.Drawing.Image)
ActionButton6.Dock = System.Windows.Forms.DockStyle.Top
ActionButton6.Name = "Open"
ActionButton6.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Open
ActionButton6.ToolTipText = "Select log files to add their text to the message"
ActionButton7.BackgroundImage = CType(resources.GetObject("ActionButton7.BackgroundImage"), System.Drawing.Image)
ActionButton7.Dock = System.Windows.Forms.DockStyle.Top
ActionButton7.Name = "Clear"
ActionButton7.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton7.ToolTipText = "Empty"
Me.TXT_LOG.Buttons.Add(ActionButton6)
Me.TXT_LOG.Buttons.Add(ActionButton7)
Me.TXT_LOG.CaptionDock = System.Windows.Forms.DockStyle.Top
Me.TXT_LOG.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.None
Me.TXT_LOG.CaptionVisible = False
Me.TXT_LOG.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_LOG.GroupBoxed = True
Me.TXT_LOG.GroupBoxText = "Log data"
Me.TXT_LOG.Lines = New String(-1) {}
Me.TXT_LOG.Location = New System.Drawing.Point(3, 284)
Me.TXT_LOG.Multiline = True
Me.TXT_LOG.Name = "TXT_LOG"
Me.TXT_LOG.Size = New System.Drawing.Size(578, 69)
Me.TXT_LOG.TabIndex = 5
'
'TXT_FILES
'
ActionButton8.BackgroundImage = CType(resources.GetObject("ActionButton8.BackgroundImage"), System.Drawing.Image)
ActionButton8.Dock = System.Windows.Forms.DockStyle.Top
ActionButton8.Name = "Add"
ActionButton8.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Add
ActionButton8.ToolTipText = "Add files"
ActionButton9.BackgroundImage = CType(resources.GetObject("ActionButton9.BackgroundImage"), System.Drawing.Image)
ActionButton9.Dock = System.Windows.Forms.DockStyle.Top
ActionButton9.Name = "Clear"
ActionButton9.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton9.ToolTipText = "Clear files"
Me.TXT_FILES.Buttons.Add(ActionButton8)
Me.TXT_FILES.Buttons.Add(ActionButton9)
Me.TXT_FILES.CaptionDock = System.Windows.Forms.DockStyle.Top
Me.TXT_FILES.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.None
Me.TXT_FILES.CaptionVisible = False
Me.TXT_FILES.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_FILES.GroupBoxed = True
Me.TXT_FILES.GroupBoxText = "Files"
Me.TXT_FILES.Lines = New String(-1) {}
Me.TXT_FILES.Location = New System.Drawing.Point(3, 359)
Me.TXT_FILES.Multiline = True
Me.TXT_FILES.Name = "TXT_FILES"
Me.TXT_FILES.Size = New System.Drawing.Size(578, 69)
Me.TXT_FILES.TabIndex = 6
Me.TXT_FILES.TextBoxReadOnly = True
Me.TXT_FILES.TextToolTip = "Attach files to your message (only works with anonymous message)"
Me.TXT_FILES.TextToolTipEnabled = True
'
'BugReporterForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.CancelButton = Me.BTT_CANCEL
Me.ClientSize = New System.Drawing.Size(584, 461)
Me.Controls.Add(TP_MAIN)
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(600, 500)
Me.Name = "BugReporterForm"
Me.Text = "New message"
TP_MAIN.ResumeLayout(False)
TP_BUTTONS.ResumeLayout(False)
CType(Me.TXT_DESCR, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_URL_PROFILE, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_URL_POST, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_REPRODUCE, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_EXPECT, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_LOG, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_FILES, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Private WithEvents TXT_DESCR As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_URL_PROFILE As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_URL_POST As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_REPRODUCE As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_EXPECT As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_LOG As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TT_MAIN As ToolTip
Private WithEvents BTT_EMAIL As Button
Private WithEvents BTT_GITHUB As Button
Private WithEvents BTT_COPY As Button
Private WithEvents BTT_CANCEL As Button
Private WithEvents BTT_ANON As Button
Private WithEvents TXT_FILES As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class
End Namespace

View File

@@ -0,0 +1,225 @@
<?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="TP_MAIN.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="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton6.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton7.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="TP_BUTTONS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<data name="BTT_ANON.ToolTip" xml:space="preserve">
<value>Send an anonymous message.
The developer will not be able you contact you back.
You can attach files (images, photos) to your message.
If you would like a response from the developer, response, please add your contact details (email, Discord, etc.).</value>
</data>
<data name="ActionButton8.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAADmUlE
QVRIS62WWWxMURjHL220JW1HausmlFrDFKUhnUGH6bRFzJ2idImlC0Vp2mlji1A8iNhCPIjIRES8EU+W
h2oEtbSDTk3HNNM7S01VKsXjkb/vXBo3k1Ee7sMvmZzzzf//ne/+z50RAAxL1MUIG4G/YAv3HSVhF5Vw
IYNdz3LadVj9RgdTB+HQYYPHIJuE1ocSdlEJFzG+1bPRLQLinglIeCkg+XUkKvz56hnkOfQs/rmA8S9H
YEp7FDI64tAQtKhnsMapZ7zzNHsUFnbGY4VzIk70l6hnIH4wsDR7NBZ3apDrSqL5T8eFgUr1DLZ78lim
Q4N8VzK29MxEpZSBa4M16hnU+c3M9CEFpdJsVHsXos63DDcHrf9nQEXD5VymwW/5USLNwl5vJhp7dTgW
NML2pR7jbsUMS+KdMTa5Q8NQxinfBU4dRFcOyjy52OtbhwOBDTgZLKPPmTgY0ON4MBdNfSbYBupxY8Aq
G10dqMG5/nIc7ytGQ6CQRliAamkTN/g1Ai4e95Qy3iogpX0UtBRDnhRzdxq2SXOxz5eFQ70rScCEU335
ssGxj0YS06HSm4GN3ekwdE2C1hGH1LZR0JDOJof5jwHvnIvzTa0jlooTYfktvt+fhcOBHDQFTWRgxJGP
ObAGsulZLMLWnjlY756K5c4JmNcRi6T2SGheCIihS2l5ozAo6NRhMolnUAcGV6IcwwqvFrX+JTjYuwKH
SfRAYDms/mzs9y1GFe2VSnOw1j0FejqpLN4WCX4ZufiIBwLMLxQGm12rsLQzgWKYgmLPLNTQw6ynpDSS
IBet8y+TqaVRVdFIeJrWuCcj+/0EzH43BomvIhBLI45uFiDcJ+6QwROFwa6+Amb9bGFNg6Xs9Ncd7Oy3
Knb2eyU7/20nu9y/m136tIvEl6BC0qKoZwby3alo9JVhj7T5R7m/kJVIIityi8zyXmTiW+I10SqyIQNb
uIgNwYuuf25kFd75KPKkI49OmUWnrfYWyXv/wBb2cijhhVf6a9lGei65XclYRDd6mj0GWz2iLBJaH0rY
RSVc5Eywmhm7kuQXHX+bJlBStrh+zTi0PpSwi0q4yNFAOVvgiEcKJWUsxZn/NhT+znlofShhF5VwkRpv
MUtti4KGYjj6sYCIh5QSu4oG27stjItHU+cjeQzvkcFzFQ2KnSKLoc4FukDCXeI2GbSoaFD4ziyPxNxK
0AUyNxOP1DOwcaG/8I+/LRB+At7psBnyDBG0AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton9.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
</root>

View File

@@ -0,0 +1,238 @@
' 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.ComponentModel
Imports PersonalUtilities.Bots
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.Messaging
Imports BStyle = PersonalUtilities.Bots.IBot.Styles
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Namespace Editors
Public Class BugReporterForm
#Region "Declarations"
Private Const MsgTitle As String = "Bug report"
Private ReadOnly MyView As FormView
Private ReadOnly MyFieldsChecker As FieldsChecker
Private MyProgramInfo As String
Private MyProgramInfoPopulated As Boolean = False
Private ReadOnly MyProgramText As String
Private ReadOnly MyCurrentVersion As Version
Private ReadOnly MyIsYouTube As Boolean
Private ReadOnly MyEnvirData As DownloadObjects.STDownloader.IDownloaderSettings
Private ReadOnly MyAdditText As String
Private ReadOnly MyCache As CacheKeeper
#End Region
#Region "Initializer"
Public Sub New(ByVal Cache As CacheKeeper, ByVal DesignXML As EContainer, ByVal ProgramText As String, ByVal CurrentVersion As Version, ByVal IsYouTube As Boolean,
ByVal EnvirData As DownloadObjects.STDownloader.IDownloaderSettings, Optional ByVal AdditText As String = Nothing)
InitializeComponent()
MyView = New FormView(Me, DesignXML)
MyFieldsChecker = New FieldsChecker
MyCache = Cache
MyProgramText = ProgramText
MyCurrentVersion = CurrentVersion
MyIsYouTube = IsYouTube
MyEnvirData = EnvirData
MyAdditText = AdditText
Icon = ImageRenderer.GetIcon(My.Resources.MailPic_16, EDP.ReturnValue)
End Sub
#End Region
#Region "Form handlers"
Private Async Sub BugReporterForm_Load(sender As Object, e As EventArgs) Handles Me.Load
MyView.Import()
MyView.SetFormSize()
With MyFieldsChecker
.AddControl(Of String)(TXT_DESCR, TXT_DESCR.GroupBoxText)
.EndLoaderOperations()
End With
TXT_LOG.Text = MyMainLOG
Await Task.Run(Sub()
MyProgramInfo = ProgramInfo.GetProgramText(MyProgramText.IfNullOrEmpty(IIf(MyIsYouTube, "YouTube downloader", "SCrawler")),
MyCurrentVersion, MyIsYouTube, MyEnvirData, MyAdditText)
MyProgramInfoPopulated = True
End Sub)
End Sub
Private Sub BugReporterForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
MyView.Dispose()
MyFieldsChecker.Dispose()
End Sub
#End Region
#Region "Message"
Private Sub WaitLoadingDone()
While Not MyProgramInfoPopulated : Threading.Thread.Sleep(100) : End While
End Sub
Private Function CreateMessage(ByVal ForGitHub As Boolean, Optional ByVal ForDiscord As Boolean = False) As Object
Try
Dim nl$ = vbNewLine.StringDup(2)
Dim data As New List(Of BotMessage)
Dim t$ = String.Empty
Dim discordAppendNl As Action = Sub() data.Add(New BotMessage(vbNewLine))
Dim appendNewLine As Action = Sub() If ForDiscord Then data.Add(New BotMessage(nl)) Else t &= nl
Dim ghBold As Func(Of String, Object) = Function(ByVal input As String) As Object
If ForDiscord Then
Return New BotMessage(input, BStyle.Bold)
Else
Return String.Format("{1}{0}{1}", input, IIf(ForGitHub, "**", ""))
End If
End Function
Dim appendData As Action(Of Object) = Sub(ByVal input As Object)
If ForDiscord Then
discordAppendNl.Invoke
data.Add(If(TypeOf input Is BotMessage, input, New BotMessage(input.ToString)))
Else
t.StringAppendLine(input)
End If
End Sub
appendData(ghBold("Describe the bug"))
appendData(TXT_DESCR.Text)
If Not TXT_URL_PROFILE.IsEmptyString Then appendData($"Profile URL: {TXT_URL_PROFILE.Text}")
If Not TXT_URL_POST.IsEmptyString Then appendData($"Post URL: {TXT_URL_POST.Text}")
If Not TXT_REPRODUCE.IsEmptyString Then
appendNewLine.Invoke
appendData(ghBold("To Reproduce"))
appendData(TXT_REPRODUCE.Text)
End If
If Not TXT_EXPECT.IsEmptyString Then
appendNewLine.Invoke
appendData(ghBold("Expected behavior"))
appendData(TXT_EXPECT.Text)
End If
If Not TXT_LOG.IsEmptyString Then
appendNewLine.Invoke
If ForDiscord Then
data.Add(New BotMessage(TXT_LOG.Text, BStyle.Code))
ElseIf ForGitHub Then
appendData($"<details><summary>Log data</summary><pre>{TXT_LOG.Text}</pre></details>")
Else
appendData(ghBold("LOG"))
appendData(TXT_LOG.Text)
End If
End If
WaitLoadingDone()
appendNewLine.Invoke
appendData(ghBold("Release information:"))
appendData(MyProgramInfo)
Return If(ForDiscord, data, t)
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[BugReporterForm.CreateMessage]")
End Try
End Function
Private Function ValidateFields(Optional ByVal SimpleMode As Boolean = False) As Boolean
If MyFieldsChecker.AllParamsOK Then
Dim opts$ = String.Empty
If TXT_URL_PROFILE.IsEmptyString Then opts.StringAppend("profile URL")
If TXT_URL_POST.IsEmptyString Then opts.StringAppend("post URL")
If TXT_LOG.Text.IsEmptyString Then opts.StringAppend("LOG")
Return opts.IsEmptyString OrElse SimpleMode OrElse
MsgBoxE({$"You haven't completed the following fields: {opts}.{vbCr}Are you sure you want to skip them?",
MsgTitle}, vbExclamation,,, {"Process", "Cancel"}) = 0
End If
Return False
End Function
#End Region
#Region "Buttons"
Private Sub BTT_ANON_Click(sender As Object, e As EventArgs) Handles BTT_ANON.Click
Try
If ValidateFields(True) Then
Dim files As List(Of SFile) = Nothing
If TXT_FILES.Lines.ListExists Then files.ListAddList(TXT_FILES.Lines, LAP.NotContainsOnly)
Dim msgs As New List(Of BotMessage)
Dim isSimple As Boolean = False
Dim aMsg$ = String.Empty
Select Case MsgBoxE(New MMessage("Do you want to send a simple message or report a bug?", MsgTitle,
{New MsgBoxButton("Nice", "Say something nice to the developer." & vbCr &
"You can also attach cat picture :-)" & vbCr &
$"The message will be sent from the '{TXT_DESCR.GroupBoxText}' field."),
New MsgBoxButton("Simple", $"The developer will only receive the message from the '{TXT_DESCR.GroupBoxText}' field."),
New MsgBoxButton("Bug report", "The developer will receive a full bug report."),
"Cancel"}, vbQuestion) With {.ButtonsPerRow = 4, .DefaultButton = 2, .CancelButton = 3}).Index
Case 0 : msgs.Add(TXT_DESCR.Text) : aMsg = $"{vbCr}Thank you very much. I'm very grateful for your messages. You are awesome!"
Case 1 : isSimple = True : msgs.Add(TXT_DESCR.Text)
Case 2 : msgs = CreateMessage(False, True)
Case Else : Exit Sub
End Select
If msgs.ListExists Then
Dim nErr As New ErrorsDescriber(EDP.None)
Using d As New DiscordBot With {.Credential = DiscordWebHook, .User = "Anonymous user"}
d.SendMessage(New BotMessage(msgs.ToArray), EDP.ThrowException)
If isSimple Then WaitLoadingDone() : d.SendMessage(MyProgramInfo, nErr)
If files.ListExists Then files.ForEach(Sub(ff) d.SendFile(BotMessage.FromFile(ff),, nErr))
End Using
msgs.Clear()
MsgBoxE({$"Your message has been sent to the developer.{aMsg}", MsgTitle})
End If
End If
Catch ex As Exception
MsgBoxE({"Something is wrong. Your message has not been sent to the developer.", MsgTitle}, vbCritical)
End Try
End Sub
Private Sub BTT_EMAIL_Click(sender As Object, e As EventArgs) Handles BTT_EMAIL.Click
If ValidateFields() Then
Dim msg$ = CreateMessage(False)
Dim cmd$ = "START mailto:""andyprogram@proton.me?to=andyprogram@proton.me&subject=Application%%20bug%%20report"""
BufferText = msg
MsgBoxE({"The message has been copied to your clipboard. Click OK and paste this message into the window that opens.", MsgTitle})
Using b As New BatchExecutor
b.FileExchanger = MyCache.NewInstance(Of BatchFileExchanger)
b.Execute(cmd)
End Using
End If
End Sub
Private Sub BTT_GITHUB_Click(sender As Object, e As EventArgs) Handles BTT_GITHUB.Click
If ValidateFields() Then
Dim msg$ = CreateMessage(True)
BufferText = msg
MsgBoxE({"The message has been copied to your clipboard. Create a new issue on GitHub and paste this message.", MsgTitle})
Try : Process.Start("https://github.com/AAndyProgram/SCrawler/issues/new?assignees=&labels=&projects=&template=custom.md&title=") : Catch : End Try
End If
End Sub
Private Sub BTT_COPY_Click(sender As Object, e As EventArgs) Handles BTT_COPY.Click
If ValidateFields() Then
Dim msg$ = CreateMessage(MsgBoxE({"Will you post this message on GitHub?", MsgTitle}, vbQuestion + vbYesNo) = vbYes)
BufferText = msg
MsgBoxE({"The message has been copied to your clipboard.", MsgTitle})
End If
End Sub
Private Sub BTT_CANCEL_Click(sender As Object, e As EventArgs) Handles BTT_CANCEL.Click
DialogResult = DialogResult.Cancel
Close()
End Sub
#End Region
#Region "Logs"
Private Sub TXT_LOG_ActionOnButtonClick(ByVal Sender As Object, ByVal e As ActionButtonEventArgs) Handles TXT_LOG.ActionOnButtonClick
If e.DefaultButton = ADB.Open Then
Dim files As List(Of SFile) = SFile.SelectFiles("LOGs\",, "Select log files", "Log files|*.txt|All files|*.*", EDP.ReturnValue)
If files.ListExists Then
Dim t$
For Each file As SFile In files
t = file.GetText
If Not t.IsEmptyString Then _
TXT_LOG.Text = $"{TXT_LOG.Text}{If(TXT_LOG.Text.IsEmptyString, String.Empty, vbNewLine.StringDup(2))}{file.Name}{vbNewLine}{t}"
Next
End If
End If
End Sub
Private Sub TXT_FILES_ActionOnButtonClick(ByVal Sender As Object, ByVal e As ActionButtonEventArgs) Handles TXT_FILES.ActionOnButtonClick
Try
If e.DefaultButton = ADB.Add Then
Dim f As List(Of SFile) = SFile.SelectFiles(,, "Select files to be sent", "Images|*.jpg;*.jpeg;*.png;*.webp;*.webm;*.gif|All files|*.*", EDP.ReturnValue)
If f.ListExists Then TXT_FILES.Lines = ListAddList(Nothing, TXT_FILES.Lines.Concat(f.Select(Function(ff) ff.ToString)),
LAP.NotContainsOnly, EDP.ReturnValue).ToArray
End If
Catch ex As Exception
End Try
End Sub
#End Region
End Class
End Namespace

View File

@@ -7,6 +7,8 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web
Imports PersonalUtilities.Functions.Messaging
Imports SCrawler.DownloadObjects.STDownloader
Public Module MainModShared
Public Property BATCH As BatchExecutor
@@ -36,4 +38,98 @@ Public Module MainModShared
End If
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 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
End If
Else
If Force Then
Dim pVer$ = $"{ProgramText} v{CurrentVersion} ({IIf(Environment.Is64BitProcess, "x64", "x86")})"
Dim eText$ = Editors.ProgramInfo.GetProgramBaseText(ProgramText, CurrentVersion, AdditText)
Dim m As New MMessage($"{pVer}" & vbCr &
"Address: https://github.com/AAndyProgram/SCrawler" & vbCr &
"Created by Greek LGBT person Andy (Gay)",
"Program information",
{"OK",
GoToSite,
New MsgBoxButton("Environment", "Show program environment") With {
.IsDialogResultButton = False,
.CallBack = Sub(r, n, b) ShowProgramEnvir(EnvirData, IsYouTube, eText)}
}) With {.DefaultButton = 0, .CancelButton = 0}
If Not AdditText.IsEmptyString Then m.Text &= $"{vbCr}{AdditText}"
m.Show()
End If
ShowNewVersionNotification = True
End If
Catch ex As Exception
End Try
End Sub
Private Sub ShowProgramEnvir(ByVal EnvirData As IDownloaderSettings, ByVal IsYouTube As Boolean, ByVal AdditCopyText As String)
Dim m As New MMessage(Editors.ProgramInfo.GetProgramEnvirText(EnvirData, IsYouTube), "Program environment", {"OK", "Copy"}) With {.Editable = True, .DefaultButton = 0, .CancelButton = 0}
If m.Text = Editors.ProgramInfo.EnvironmentNotFound Then m.Style = vbCritical
m.Text = $"{AdditCopyText}{vbCr}{m.Text}"
If m.Show() = 1 Then BufferText = m.Text
End Sub
End Module
Namespace Editors
Public NotInheritable Class ProgramInfo
Public Const EnvironmentNotFound As String = "Environment not found"
Private Sub New()
End Sub
Public Shared Function GetProgramText(ByVal ProgramText As String, ByVal CurrentVersion As Version, ByVal IsYouTube As Boolean,
ByVal EnvirData As IDownloaderSettings, Optional ByVal AdditText As String = Nothing) As String
Return GetProgramBaseText(ProgramText, CurrentVersion, AdditText) & vbNewLine & GetProgramEnvirText(EnvirData, IsYouTube)
End Function
Public Shared Function GetProgramBaseText(ByVal ProgramText As String, ByVal CurrentVersion As Version, Optional ByVal AdditText As String = Nothing) As String
Dim pVer$ = $"{ProgramText} v{CurrentVersion} ({IIf(Environment.Is64BitProcess, "x64", "x86")})"
Dim WinVer$ = String.Empty
Try : WinVer = $"OS: {My.Computer.Info.OSFullName} ({IIf(Environment.Is64BitOperatingSystem, "x64", "x86")})" : Catch : End Try
Return pVer.StringDup(1).StringAppendLine(WinVer).StringAppendLine(AdditText)
End Function
Public Shared Function GetProgramEnvirText(ByVal EnvirData As IDownloaderSettings, ByVal IsYouTube As Boolean) As String
Try
Dim output$ = String.Empty
Using b As New BatchExecutor(True)
Dim f As SFile
Dim cmd$, ff$, vText$
For i% = 0 To IIf(IsYouTube, 1, 3)
cmd = "--version"
Select Case i
Case 0 : f = EnvirData.ENVIR_FFMPEG : ff = "ffmpeg" : cmd = "-version"
Case 1 : f = EnvirData.ENVIR_YTDLP : ff = "yt-dlp"
Case 2 : f = EnvirData.ENVIR_GDL : ff = "gallery-dl"
Case 3 : f = EnvirData.ENVIR_CURL : ff = "cURL"
Case Else : f = Nothing : ff = Nothing : cmd = Nothing
End Select
If Not ff.IsEmptyString Then
If f.IsEmptyString Then
output.StringAppendLine($"[{ff}] NOT FOUND")
Else
b.Reset()
b.Execute($"""{f}"" {cmd}", EDP.None)
If b.OutputData.Count > 3 Then vText = b.OutputData(3) Else vText = "undefined"
output.StringAppendLine($"{ff} version: {vText}")
End If
End If
Next
If output.IsEmptyString Then output = EnvironmentNotFound
End Using
Return output
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[ProgramInfo.GetProgramEnvirText]", String.Empty)
End Try
End Function
End Class
End Namespace

View File

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

View File

@@ -130,6 +130,16 @@ Namespace My.Resources
End Get
End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Bitmap.
'''</summary>
Public ReadOnly Property MailPic_16() As System.Drawing.Bitmap
Get
Dim obj As Object = ResourceManager.GetObject("MailPic_16", resourceCulture)
Return CType(obj,System.Drawing.Bitmap)
End Get
End Property
'''<summary>
''' Looks up a localized resource of type System.Drawing.Bitmap.
'''</summary>

View File

@@ -139,6 +139,9 @@
<data name="LinkPic_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Content\Pictures\LinkPic_32.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="MailPic_16" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Content\Pictures\MailPic_16.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>
<data name="RulerPic_32" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>..\Content\Pictures\RulerPic_32.png;System.Drawing.Bitmap, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a</value>
</data>

View File

@@ -65,6 +65,7 @@ Namespace API.YouTube.Objects
End Set
End Property
Protected _MediaState As UMStates = UMStates.Unknown
Protected _MediaStateOnLoad As UMStates = UMStates.Unknown
<XMLEC> Public Property MediaState As UMStates Implements IYouTubeMediaContainer.MediaState, IUserMedia.DownloadState
Get
If _MediaState = UMStates.Unknown And HasElements Then
@@ -591,7 +592,9 @@ Namespace API.YouTube.Objects
Bitrate = 0
_MediaType = UMTypes.Undefined
If SelectedVideoIndex >= 0 Then
cmd.StringAppend($"bv*[format_id={SelectedVideo.ID}]")
'URGENT: 2023.3.4 -> 2023.7.6
'cmd.StringAppend($"bv*[format_id={SelectedVideo.ID}]")
cmd.StringAppend(SelectedVideo.ID)
_Size = SelectedVideo.Size
_MediaType = UMTypes.Video
Height = SelectedVideo.Height
@@ -602,7 +605,9 @@ Namespace API.YouTube.Objects
End If
If SelectedAudioIndex >= 0 Then
Dim atCodec$
cmd.StringAppend($"ba*[format_id={SelectedAudio.ID}]", "+")
'URGENT: 2023.3.4 -> 2023.7.6
'cmd.StringAppend($"ba*[format_id={SelectedAudio.ID}]", "+")
cmd.StringAppend(SelectedAudio.ID, "+")
If OutputAudioCodec.StringToLower = ac3 Then
PostProcessing_AudioAC3 = True
formats.StringAppend($"--audio-format {aac}", " ")
@@ -633,7 +638,9 @@ Namespace API.YouTube.Objects
subs = $"--write-subs --write-auto-subs --sub-format {OutputSubtitlesFormat.StringToLower} --sub-langs ""{subs}"" --convert-subs {OutputSubtitlesFormat.StringToLower}"
End If
If Not cmd.IsEmptyString Then
cmd = $"yt-dlp -f ""{cmd}"""
'URGENT: 2023.3.4 -> 2023.7.6
'cmd = $"yt-dlp -f ""{cmd}"""
cmd = $"yt-dlp -f {cmd}"
If Not MyYouTubeSettings.ReplaceModificationDate Then cmd &= " --no-mtime"
cmd.StringAppend(formats, " ")
cmd.StringAppend(subs, " ")
@@ -1017,6 +1024,7 @@ Namespace API.YouTube.Objects
Dim fc As SFile = x.Value(Name_CachePath).CSFileP
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 If(x(Name_CheckedElements)?.Count, 0) > 0 Then ApplyElementCheckedValue(x(Name_CheckedElements))
If ArrayMaxResolution <> -10 Then SetMaxResolution(ArrayMaxResolution)
@@ -1031,6 +1039,9 @@ Namespace API.YouTube.Objects
End Sub
#End Region
#Region "Save"
Protected Function NeedToSave() As Boolean
Return Not _MediaStateOnLoad = _MediaState And Not FileSettings.Exists
End Function
Private Function GetThumbnails() As IEnumerable(Of SFile)
If HasElements Then
Return ListAddList(Of SFile)(New List(Of SFile)({ThumbnailFile}),
@@ -1041,6 +1052,7 @@ Namespace API.YouTube.Objects
End Function
Public Overridable Sub Save() Implements IDownloadableMedia.Save
Try
If NeedToSave() Then
Dim fSettings As SFile = FileSettings
If fSettings.IsEmptyString Then fSettings = MyCacheSettings.NewFile
Dim f As SFile = fSettings
@@ -1077,10 +1089,13 @@ Namespace API.YouTube.Objects
Using x As New XmlFile With {.AllowSameNames = True}
fSettings.Extension = "xml"
FileSettings = fSettings
If NeedToSave() Then
x.AddRange(ToEContainer.Elements)
x.Name = "MediaContainer"
x.Save(fSettings)
End If
End Using
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"YouTubeMediaContainerBase.Save({FileSettings})")
End Try
@@ -1244,25 +1259,27 @@ Namespace API.YouTube.Objects
obj.Height = AConvert(Of Integer)(ee.Value("height"), NumberProvider, -1)
obj.FPS = AConvert(Of Double)(ee.Value("fps"), NumberProvider, -1)
obj.Bitrate = AConvert(Of Double)(ee.Value("tbr"), NumberProvider, -1)
obj.Protocol = ee.Value("protocol")
If Not obj.Protocol.IsEmptyString Then obj.Protocol = obj.Protocol.Split("_").FirstOrDefault
nValue = AConvert(Of Double)(ee.Value("filesize"), NumberProvider, -1)
If nValue > 0 Then obj.Size = (nValue / 1024).RoundVal(2)
sValue = ee.Value("vcodec")
If validCodecValue(sValue) Then
obj.Type = UMTypes.Video
obj.Codec = sValue.Split(".").First
If validCodecValue(ee.Value("acodec")) Then
obj.Type = av
If obj.Size <= 0 Then
nValue = AConvert(Of Double)(ee.Value("filesize_approx"), NumberProvider, -1)
If nValue > 0 Then obj.Size = (nValue / 1024).RoundVal(2)
End If
End If
If obj.Size <= 0 And obj.Bitrate > 0 And Duration.TotalSeconds > 0 Then _
obj.Size = (obj.Bitrate / 8 * Duration.TotalSeconds).RoundVal(2)
sValue = ee.Value("vcodec")
If validCodecValue(sValue) Then
obj.Type = UMTypes.Video
obj.Codec = sValue.Split(".").First
If validCodecValue(ee.Value("acodec")) Then obj.Type = av
Else
sValue = ee.Value("acodec")
If validCodecValue(sValue) Then
obj.Type = UMTypes.Audio
obj.Codec = sValue.Split(".").First
obj.Bitrate = AConvert(Of Double)(ee.Value("tbr"), NumberProvider, -1)
Else
Continue For
End If
@@ -1292,6 +1309,7 @@ Namespace API.YouTube.Objects
Next
End If
End Sub
If MediaObjects.Count > 0 And Not MyYouTubeSettings.DefaultVideoIncludeNullSize Then MediaObjects.RemoveAll(Function(mo) mo.Size <= 0)
If MediaObjects.Count > 0 Then DupRemover.Invoke(UMTypes.Audio)
If MediaObjects.Count > 0 Then DupRemover.Invoke(UMTypes.Video)
If MediaObjects.Count > 0 Then

View File

@@ -121,6 +121,7 @@
<Compile Include="Controls\PlayListParserForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Downloader\DownloadLocationsCollection.vb" />
<Compile Include="Downloader\IDownloaderSettings.vb" />
<Compile Include="Downloader\Notificator.vb" />
<Compile Include="Downloader\MediaItem.Designer.vb">
@@ -155,6 +156,13 @@
</Compile>
<Compile Include="Declarations.vb" />
<Compile Include="Downloader\STDownloaderDeclarations.vb" />
<Compile Include="Editors\BugReporterForm.Designer.vb">
<DependentUpon>BugReporterForm.vb</DependentUpon>
</Compile>
<Compile Include="Editors\BugReporterForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Editors\BugReporterFormDiscordWebHook.vb" />
<Compile Include="MainModShared.vb" />
<Compile Include="Objects\Channel.vb" />
<Compile Include="Objects\IYouTubeMediaContainer.vb" />
@@ -218,6 +226,9 @@
<EmbeddedResource Include="Controls\VideoOption.resx">
<DependentUpon>VideoOption.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Editors\BugReporterForm.resx">
<DependentUpon>BugReporterForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="My Project\Resources.resx">
<Generator>PublicVbMyResourcesResXFileCodeGenerator</Generator>
<LastGenOutput>Resources.Designer.vb</LastGenOutput>
@@ -317,5 +328,8 @@
<ItemGroup>
<None Include="Content\Pictures\StartPic_Green_16.png" />
</ItemGroup>
<ItemGroup>
<None Include="Content\Pictures\MailPic_16.png" />
</ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project>

View File

@@ -67,7 +67,6 @@ Partial Public Class MainFrame : Inherits SCrawler.DownloadObjects.STDownloader.
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.ClientSize = New System.Drawing.Size(1008, 729)
Me.Name = "MainFrame"
Me.Text = "SCrawler: Happy LGBT Pride Month! :-)"
Me.TRAY_CONTEXT.ResumeLayout(False)
Me.ResumeLayout(False)
Me.PerformLayout()

View File

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

View File

@@ -6,9 +6,12 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Base
Friend Module Declarations
Friend Const UserLabelName As String = "User"
Friend Const SearchRequestLabelName As String = "Search request"
Friend ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly)
Friend ReadOnly UnixDate32Provider As New ADateTime(ADateTime.Formats.Unix32)
Friend ReadOnly UnixDate64Provider As New ADateTime(ADateTime.Formats.Unix64)
@@ -16,5 +19,58 @@ Namespace API.Base
Friend ReadOnly TitleHtmlConverter As Func(Of String, String) =
Function(Input) SymbolsConverter.HTML.Decode(SymbolsConverter.Convert(Input, EDP.ReturnValue), EDP.ReturnValue).
StringRemoveWinForbiddenSymbols().StringTrim()
Friend ReadOnly Regex_VideosThumb_OG_IMAGE As RParams = RParams.DMS("meta.property=.og.image..content=""([^""]+)""", 1, EDP.ReturnValue)
Friend Class ConcurrentDownloadsProvider : Inherits FieldsCheckerProviderBase
Public Overrides Sub Reset()
ErrorMessage = String.Empty
MyBase.Reset()
End Sub
Public Overrides Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object
Dim v% = AConvert(Of Integer)(Value, -1)
Dim defV% = Settings.MaxUsersJobsCount
If v.ValueBetween(1, defV) Then
Return Value
Else
HasError = True
If ACheck(Of Integer)(Value) Then
ErrorMessage = $"The number of concurrent downloads must be greater than 0 and equal to or less than {defV} (global limit)."
Else
TypeError = True
End If
Return Nothing
End If
End Function
End Class
Friend Class TokenRefreshIntervalProvider : Inherits FieldsCheckerProviderBase
Public Overrides Sub Reset()
ErrorMessage = String.Empty
MyBase.Reset()
End Sub
Public Overrides Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object
Dim v% = AConvert(Of Integer)(Value, -1)
If v > 0 Then
Return Value
ElseIf Not ACheck(Of Integer)(Value) Then
TypeError = True
Else
ErrorMessage = $"The value of [{Name}] field must be greater than or equal to 1"
End If
HasError = True
Return Nothing
End Function
End Class
Friend ReadOnly Property CacheDeletionError(ByVal RootPath As SFile) As ErrorsDescriber
Get
Return New ErrorsDescriber(EDP.None) With {.Action = Sub(ee, eex, msg, obj) Settings.Cache.AddPath(RootPath)}
End Get
End Property
Friend Function ValidateChangeSearchOptions(ByVal User As String, ByVal NewQuery As String, ByVal CurrentQuery As String) As Boolean
Return MsgBoxE({$"Are you sure you want to change the query for user '{User}'?{vbCr}" &
"It is highly recommended to add a new user with this query instead of changing current one." & vbCr &
$"Current query: [{CurrentQuery}]{vbCr}New query: [{NewQuery}]",
"Changing a query"}, vbExclamation,,, {"Process", "Cancel"}) = 0
End Function
End Module
End Namespace

View File

@@ -0,0 +1,31 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Base
Friend NotInheritable Class DeclaredNames
Friend Const Header_Authorization As String = "authorization"
Friend Const Header_CSRFToken As String = "x-csrf-token"
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"
Friend Const SavedPostsUserNameToolTip As String = "Personal profile username"
Friend Const GifsSpecialFolderCaption As String = "GIFs special folder"
Friend Const GifsSpecialFolderToolTip As String = "Put the GIFs in a special folder" & vbCr &
"This is a folder name, not an absolute path." & vbCr &
"This folder(s) will be created relative to the user's root folder." & vbCr &
"Examples:" & vbCr & "SomeFolderName" & vbCr & "SomeFolderName\SomeFolderName2"
Friend Const GifsPrefixCaption As String = "GIF prefix"
Friend Const GifsPrefixToolTip As String = "This prefix will be added to the beginning of the filename"
Friend Const GifsDownloadCaption As String = "Download GIFs"
Friend Const UseMD5ComparisonCaption As String = "Use MD5 comparison"
Friend Const UseMD5ComparisonToolTip As String = "Each image will be checked for existence using MD5"
Private Sub New()
End Sub
End Class
End Namespace

View File

@@ -66,12 +66,12 @@ Namespace API.Base.GDL
Return urls
End Function
End Module
Friend Class GDLBatch : Inherits BatchExecutor
Friend Class GDLBatch : Inherits TokenBatch
Friend Property TempPostsList As List(Of String)
Friend Const UrlLibStart As String = "[urllib3.connectionpool][debug]"
Friend Const UrlTextStart As String = UrlLibStart & " https"
Friend Sub New()
MyBase.New(True)
Friend Sub New(ByVal _Token As Threading.CancellationToken)
MyBase.New(_Token)
MainProcessName = "gallery-dl"
ChangeDirectory(Settings.GalleryDLFile.File)
End Sub
@@ -86,8 +86,9 @@ Namespace API.Base.GDL
End If
End Sub
Protected Overridable Async Function Validate(ByVal Value As String) As Task
If Not ProcessKilled AndAlso Await Task.Run(Of Boolean)(Function() Not Value.IsEmptyString AndAlso
TempPostsList.Exists(Function(v) Value.Contains(v))) Then Kill()
If Not ProcessKilled AndAlso Await Task.Run(Of Boolean)(Function() Token.IsCancellationRequested OrElse
(Not Value.IsEmptyString AndAlso
TempPostsList.Exists(Function(v) Value.Contains(v)))) Then Kill()
End Function
End Class
End Namespace

View File

@@ -0,0 +1,88 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.Plugin.Hosts
Namespace API.Base
Friend Interface IUserData : Inherits IComparable(Of UserDataBase), IComparable, IEquatable(Of UserDataBase), IIndexable, IDisposable
Event UserUpdated(ByVal User As IUserData)
Enum EraseMode As Integer
None = 0
Data = 1
History = 2
End Enum
ReadOnly Property Site As String
ReadOnly Property Name As String
Property ID As String
Property Options As String
Property FriendlyName As String
Property Description As String
Property Favorite As Boolean
Property Temporary As Boolean
Property BackColor As Color?
Property ForeColor As Color?
Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing)
Sub DownloadData(ByVal Token As CancellationToken)
Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken)
Property ParseUserMediaOnly As Boolean
ReadOnly Property IsSubscription As Boolean
#Region "Images"
Function GetPicture() As Image
Sub SetPicture(ByVal f As SFile)
#End Region
#Region "Collection support"
ReadOnly Property IsCollection As Boolean
ReadOnly Property CollectionName As String
ReadOnly Property CollectionPath As SFile
ReadOnly Property IncludedInCollection As Boolean
ReadOnly Property UserModel As UsageModel
ReadOnly Property CollectionModel As UsageModel
ReadOnly Property IsVirtual As Boolean
ReadOnly Property Labels As List(Of String)
#End Region
Property Exists As Boolean
Property Suspended As Boolean
Property ReadyForDownload As Boolean
Property HOST As SettingsHost
Property [File] As SFile
Property FileExists As Boolean
Property DownloadedPictures(ByVal Total As Boolean) As Integer
Property DownloadedVideos(ByVal Total As Boolean) As Integer
ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer
ReadOnly Property DownloadedInformation As String
Property HasError As Boolean
ReadOnly Property FitToAddParams As Boolean
ReadOnly Property Key As String
Property DownloadImages As Boolean
Property DownloadVideos As Boolean
Property DownloadMissingOnly As Boolean
Property ScriptUse As Boolean
Property ScriptData As String
Function GetLVI(ByVal Destination As ListView) As ListViewItem
Function GetLVIGroup(ByVal Destination As ListView) As ListViewGroup
Sub LoadUserInformation()
Sub UpdateUserInformation()
''' <summary>
''' 0 - Nothing removed<br/>
''' 1 - User removed<br/>
''' 2 - Collection removed<br/>
''' 3 - Collection split
''' </summary>
Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer
Function EraseData(ByVal Mode As EraseMode) As Boolean
Function MoveFiles(ByVal CollectionName As String, ByVal SpecialCollectionPath As SFile) As Boolean
Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Sub OpenFolder()
Property DownloadTopCount As Integer?
Property DownloadDateFrom As Date?
Property DownloadDateTo As Date?
Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean,
Optional ByVal AttachUserInfo As Boolean = True)
ReadOnly Property Disposed As Boolean
End Interface
End Namespace

View File

@@ -43,6 +43,7 @@ Namespace API.Base
If ConcatFile.Name.IsEmptyString Then ConcatFile.Name = "PlayListFile"
ConcatFile.Extension = "mp4"
Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{TempCacheFolderName}\")
Cache.CacheDeleteError = CacheDeletionError(Cache)
Dim cache2 As CacheKeeper = Cache.NewInstance
If cache2.RootDirectory.Exists(SFO.Path) Then
Dim progressExists As Boolean = Not Progress Is Nothing

View File

@@ -15,6 +15,13 @@ Namespace API.Base
Friend ReadOnly Property Site As String Implements ISiteSettings.Site
Friend Overridable ReadOnly Property Icon As Icon Implements ISiteSettings.Icon
Friend Overridable ReadOnly Property Image As Image Implements ISiteSettings.Image
Protected _AllowUserAgentUpdate As Boolean = True
Protected _SubscriptionsAllowed As Boolean = False
Friend ReadOnly Property SubscriptionsAllowed As Boolean Implements ISiteSettings.SubscriptionsAllowed
Get
Return _SubscriptionsAllowed
End Get
End Property
Private Property Logger As ILogProvider = LogConnector Implements ISiteSettings.Logger
Friend Overridable ReadOnly Property Responser As Responser
Friend ReadOnly Property CookiesNetscapeFile As SFile
@@ -62,7 +69,7 @@ Namespace API.Base
Friend Overridable Sub BeginInit() Implements ISiteSettings.BeginInit
End Sub
Friend Overridable Sub EndInit() Implements ISiteSettings.EndInit
If Not DefaultUserAgent.IsEmptyString And Not Responser Is Nothing Then Responser.UserAgent = DefaultUserAgent
If _AllowUserAgentUpdate And Not DefaultUserAgent.IsEmptyString And Not Responser Is Nothing Then Responser.UserAgent = DefaultUserAgent
If CheckNetscapeCookiesOnEndInit Then Update_SaveCookiesNetscape(, True)
End Sub
#End Region
@@ -82,6 +89,11 @@ Namespace API.Base
Friend Overridable Sub Update() Implements ISiteSettings.Update
If _SiteEditorFormOpened Then
If UseNetscapeCookies Then Update_SaveCookiesNetscape()
If Not Responser Is Nothing Then
With Responser.Headers
If .Count > 0 Then .ListDisposeRemove(Function(h) h.Value.IsEmptyString)
End With
End If
DomainsApply()
End If
If Not Responser Is Nothing Then Responser.SaveSettings()
@@ -105,12 +117,30 @@ Namespace API.Base
#End Region
#End Region
#Region "Before and After Download"
''' <summary>
''' PRE<br/>
''' DownloadStarted<br/>
''' <br/>
''' BEFORE<br/>
''' Available<br/>
''' <br/>
''' IN<br/>
''' ReadyToDownload<br/>
''' BeforeStartDownload<br/>
''' AfterDownload<br/>
''' <br/>
''' AFTER<br/>
''' DownloadDone
''' </summary>
Friend Overridable Sub DownloadStarted(ByVal What As Download) Implements ISiteSettings.DownloadStarted
End Sub
''' <inheritdoc cref="DownloadStarted(Download)"/>
Friend Overridable Sub BeforeStartDownload(ByVal User As Object, ByVal What As Download) Implements ISiteSettings.BeforeStartDownload
End Sub
''' <inheritdoc cref="DownloadStarted(Download)"/>
Friend Overridable Sub AfterDownload(ByVal User As Object, ByVal What As Download) Implements ISiteSettings.AfterDownload
End Sub
''' <inheritdoc cref="DownloadStarted(Download)"/>
Friend Overridable Sub DownloadDone(ByVal What As Download) Implements ISiteSettings.DownloadDone
End Sub
#End Region
@@ -158,13 +188,13 @@ Namespace API.Base
Friend Overridable Function BaseAuthExists() As Boolean
Return True
End Function
''' <summary>JOB: leave or remove</summary>
''' <returns>Return BaseAuthExists()</returns>
''' <inheritdoc cref="DownloadStarted(Download)"/>
Friend Overridable Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean Implements ISiteSettings.Available
Return BaseAuthExists()
End Function
''' <summary>'DownloadData': before processing</summary>
''' <returns>True</returns>
''' <inheritdoc cref="DownloadStarted(Download)"/>
Friend Overridable Function ReadyToDownload(ByVal What As Download) As Boolean Implements ISiteSettings.ReadyToDownload
Return True
End Function

View File

@@ -12,6 +12,13 @@ Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Base
Friend Module Structures
Friend Enum SiteModes As Integer
User = 0
Search = 1
Tags = 2
Categories = 3
Pornstars = 4
End Enum
Friend Structure UserMedia : Implements IUserMedia, IEquatable(Of UserMedia), IEContainerProvider
#Region "XML Names"
Friend Const Name_MediaNode As String = "MediaData"
@@ -182,6 +189,7 @@ Namespace API.Base
End With
End If
'TODO: UserMedia.SpecialFolder
SpecialFolder = e.Attribute(Name_SpecialFolder).Value
If Not SpecialFolder.IsEmptyString Then upath &= $"{SpecialFolder}\"
If vp.HasValue AndAlso vp.Value Then upath &= $"Video\"

View File

@@ -0,0 +1,27 @@
' 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 PersonalUtilities.Tools
Namespace API.Base
Friend Class TokenBatch : Inherits BatchExecutor
Protected ReadOnly Token As CancellationToken
Friend Sub New(ByVal _Token As CancellationToken)
MyBase.New(True)
Token = _Token
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())
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())
End Sub
End Class
End Namespace

View File

@@ -13,6 +13,7 @@ Imports System.ComponentModel
Imports System.Runtime.CompilerServices
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Objects
Imports PersonalUtilities.Functions.RegularExpressions
@@ -51,6 +52,28 @@ Namespace API.Base
Friend Sub RemoveUpdateHandlers()
UserUpdatedEventHandlers.Clear()
End Sub
Private ReadOnly UserDownloadStateChangedEventHandlers As List(Of UserDownloadStateChangedEventHandler)
Friend Custom Event UserDownloadStateChanged As UserDownloadStateChangedEventHandler
AddHandler(ByVal h As UserDownloadStateChangedEventHandler)
If Not UserDownloadStateChangedEventHandlers.Contains(h) Then UserDownloadStateChangedEventHandlers.Add(h)
End AddHandler
RemoveHandler(ByVal h As UserDownloadStateChangedEventHandler)
UserDownloadStateChangedEventHandlers.Remove(h)
End RemoveHandler
RaiseEvent(ByVal User As IUserData, ByVal IsDownloading As Boolean)
Try
If UserDownloadStateChangedEventHandlers.Count > 0 Then
For i% = 0 To UserDownloadStateChangedEventHandlers.Count - 1
Try : UserDownloadStateChangedEventHandlers(i).Invoke(User, IsDownloading) : Catch : End Try
Next
End If
Catch
End Try
End RaiseEvent
End Event
Private Sub OnUserDownloadStateChanged(ByVal IsDownloading As Boolean)
RaiseEvent UserDownloadStateChanged(Me, IsDownloading)
End Sub
#End Region
#Region "Collection buttons"
Private _CollectionButtonsExists As Boolean = False
@@ -58,6 +81,7 @@ Namespace API.Base
Friend WithEvents BTT_CONTEXT_DOWN As ToolStripKeyMenuItem
Friend WithEvents BTT_CONTEXT_EDIT As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_DELETE As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_ERASE As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_OPEN_PATH As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_OPEN_SITE As ToolStripMenuItem
Friend Sub CreateButtons()
@@ -75,6 +99,7 @@ Namespace API.Base
BTT_CONTEXT_DOWN = New ToolStripKeyMenuItem(tn, i) With {.Name = tnn("DOWN"), .Tag = Me}
BTT_CONTEXT_EDIT = New ToolStripMenuItem(tn, i) With {.Name = tnn("EDIT"), .Tag = Me}
BTT_CONTEXT_DELETE = New ToolStripMenuItem(tn, i) With {.Name = tnn("DELETE"), .Tag = Me}
BTT_CONTEXT_ERASE = New ToolStripMenuItem(tn, i) With {.Name = tnn("ERASE"), .Tag = Me}
BTT_CONTEXT_OPEN_PATH = New ToolStripMenuItem(tn, i) With {.Name = tnn("PATH"), .Tag = Me}
BTT_CONTEXT_OPEN_SITE = New ToolStripMenuItem(tn, i) With {.Name = tnn("SITE"), .Tag = Me}
UpdateButtonsColor()
@@ -91,7 +116,8 @@ Namespace API.Base
cb = MyColor.EditBack
cf = MyColor.EditFore
End If
For Each b As ToolStripMenuItem In {BTT_CONTEXT_DOWN, BTT_CONTEXT_EDIT, BTT_CONTEXT_DELETE, BTT_CONTEXT_OPEN_PATH, BTT_CONTEXT_OPEN_SITE}
For Each b As ToolStripMenuItem In {BTT_CONTEXT_DOWN, BTT_CONTEXT_EDIT, BTT_CONTEXT_DELETE, BTT_CONTEXT_ERASE,
BTT_CONTEXT_OPEN_PATH, BTT_CONTEXT_OPEN_SITE}
If Not b Is Nothing Then b.BackColor = cb : b.ForeColor = cf
Next
If _UserInformationLoaded Then _CollectionButtonsColorsSet = True
@@ -111,12 +137,16 @@ Namespace API.Base
Private Const Name_UserExists As String = "UserExists"
Private Const Name_UserSuspended As String = "UserSuspended"
Protected Const Name_FriendlyName As String = "FriendlyName"
Private Const Name_UserSiteName As String = "UserSiteName"
Protected Const Name_UserSiteName As String = "UserSiteName"
Protected Const Name_UserID As String = "UserID"
Private Const Name_Description As String = "Description"
Protected Const Name_Options As String = "Options"
Protected Const Name_Description As String = "Description"
Private Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly"
Private Const Name_IsSubscription As String = UserInfo.Name_IsSubscription
Private Const Name_Temporary As String = "Temporary"
Private Const Name_Favorite As String = "Favorite"
Private Const Name_BackColor As String = "BackColor"
Private Const Name_ForeColor As String = "ForeColor"
Private Const Name_CreatedByChannel As String = "CreatedByChannel"
Private Const Name_SeparateVideoFolder As String = "SeparateVideoFolder"
@@ -142,7 +172,7 @@ Namespace API.Base
#Region "Declarations"
#Region "Host, Site, Progress"
Friend Property HOST As SettingsHost Implements IUserData.HOST
Friend ReadOnly Property Site As String Implements IContentProvider.Site
Friend ReadOnly Property Site As String Implements IUserData.Site
Get
Return HOST.Name
End Get
@@ -160,7 +190,7 @@ Namespace API.Base
End Property
Protected Property ProgressPre As PreProgress = Nothing
#End Region
#Region "User name, ID, exist, suspend"
#Region "User name, ID, exist, suspend, options"
Friend User As UserInfo
Friend Property IsSavedPosts As Boolean Implements IPluginContentProvider.IsSavedPosts
Private _UserExists As Boolean = True
@@ -190,14 +220,14 @@ Namespace API.Base
Set(ByVal NewName As String)
End Set
End Property
Friend Overridable ReadOnly Property Name As String Implements IContentProvider.Name
Friend Overridable ReadOnly Property Name As String Implements IUserData.Name
Get
Return User.Name
End Get
End Property
Friend Overridable Property ID As String = String.Empty Implements IContentProvider.ID, IPluginContentProvider.ID
Friend Overridable Property ID As String = String.Empty Implements IUserData.ID, IPluginContentProvider.ID
Protected _FriendlyName As String = String.Empty
Friend Overridable Property FriendlyName As String Implements IContentProvider.FriendlyName
Friend Overridable Property FriendlyName As String Implements IUserData.FriendlyName
Get
If Settings.UserSiteNameAsFriendly Then
Return _FriendlyName.IfNullOrEmpty(UserSiteName)
@@ -251,9 +281,15 @@ Namespace API.Base
Return UserModel = UsageModel.Virtual
End Get
End Property
Friend Property Options As String = String.Empty Implements IUserData.Options, IPluginContentProvider.Options
Friend Overridable ReadOnly Property FeedIsUser As Boolean
Get
Return True
End Get
End Property
#End Region
#Region "Description"
Friend Property UserDescription As String = String.Empty Implements IContentProvider.Description, IPluginContentProvider.UserDescription
Friend Property UserDescription As String = String.Empty Implements IUserData.Description, IPluginContentProvider.UserDescription
Protected _DescriptionEveryTime As Boolean = False
Protected _DescriptionChecked As Boolean = False
Protected Function UserDescriptionNeedToUpdate() As Boolean
@@ -270,9 +306,9 @@ Namespace API.Base
End If
End Sub
#End Region
#Region "Favorite, Temporary"
#Region "Favorite, Temporary, Colors"
Protected _Favorite As Boolean = False
Friend Overridable Property Favorite As Boolean Implements IContentProvider.Favorite
Friend Overridable Property Favorite As Boolean Implements IUserData.Favorite
Get
Return _Favorite
End Get
@@ -282,7 +318,7 @@ Namespace API.Base
End Set
End Property
Protected _Temporary As Boolean = False
Friend Overridable Property Temporary As Boolean Implements IContentProvider.Temporary
Friend Overridable Property Temporary As Boolean Implements IUserData.Temporary
Get
Return _Temporary
End Get
@@ -291,6 +327,24 @@ Namespace API.Base
If _Temporary Then _Favorite = False
End Set
End Property
Private _BackColor As Color? = Nothing
Friend Overridable Property BackColor As Color? Implements IUserData.BackColor
Get
Return _BackColor
End Get
Set(ByVal b As Color?)
_BackColor = b
End Set
End Property
Private _ForeColor As Color? = Nothing
Friend Overridable Property ForeColor As Color? Implements IUserData.ForeColor
Get
Return _ForeColor
End Get
Set(ByVal f As Color?)
_ForeColor = f
End Set
End Property
#End Region
#Region "Channel"
Friend Property CreatedByChannel As Boolean = False
@@ -405,32 +459,106 @@ BlockNullPicture:
Return _IsCollection
End Get
End Property
Friend Overridable Property CollectionName As String Implements IUserData.CollectionName
Friend Overridable ReadOnly Property CollectionName As String Implements IUserData.CollectionName
Get
Return User.CollectionName
End Get
Set(ByVal NewCollection As String)
ChangeCollectionName(NewCollection, True)
End Set
End Property
Friend Overridable ReadOnly Property CollectionPath As SFile Implements IUserData.CollectionPath
Get
Return User.GetCollectionRootPath
End Get
End Property
Friend ReadOnly Property IncludedInCollection As Boolean Implements IUserData.IncludedInCollection
Get
Return User.IncludedInCollection
End Get
End Property
Friend Overridable Sub ChangeCollectionName(ByVal NewName As String, ByVal UpdateSettings As Boolean)
Dim u As UserInfo = User
u.CollectionName = NewName
u.UpdateUserFile()
User = u
If UpdateSettings Then Settings.UpdateUsersList(User)
End Sub
Friend Overridable ReadOnly Property Labels As List(Of String) Implements IUserData.Labels
Protected ReadOnly Property LabelsString As String
Get
Return Labels.ListToString("|", EDP.ReturnValue)
End Get
End Property
Friend Overridable ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return New String() {}
End Get
End Property
''' <summary>
''' 0 add<br/>
''' 1 replace<br/>
''' 2 remove
''' </summary>
''' <returns>true = w/special</returns>
Friend Shared Function UpdateLabelsKeepSpecial(ByVal Mode As Byte) As Boolean
Dim m As New MMessage("", "Update labels",, vbQuestion + vbYesNo) With {.DefaultButton = 0, .CancelButton = 0}
Select Case Mode
Case 0 : m.Text = "Do you want to exclude site-specific labels from adding?"
Case 1, 2 : m.Text = "Do you want to keep site-specific labels?"
Case Else : Return False
End Select
Return m.Show = vbYes
End Function
''' <inheritdoc cref="UpdateLabelsKeepSpecial(Byte)"/>
Friend Shared Sub UpdateLabels(ByVal User As UserDataBase, ByVal NewLabels As IEnumerable(Of String), ByVal Mode As Byte, ByVal KeepSpecial As Boolean)
Try
If User.IsCollection Then
With DirectCast(User, UserDataBind)
If .Count > 0 Then .Collections.ForEach(Sub(u) UpdateLabels(u, NewLabels, Mode, KeepSpecial))
End With
Else
Dim nl As List(Of String)
If NewLabels.ListExists Then nl = NewLabels.ToList Else nl = New List(Of String)
Dim lex As List(Of String) = User.SpecialLabels.ToList
If lex.ListExists Then
If User.Labels.Count = 0 Or Not KeepSpecial Then
lex.Clear()
Else
lex.ListDisposeRemove(Function(l) Not User.Labels.Contains(l))
End If
End If
Select Case Mode
Case 0 'add
If KeepSpecial Then nl.ListAddList(lex, LNC)
User.Labels.ListAddList(nl, LNC)
Case 1 'replace
If KeepSpecial Then
nl.ListAddList(lex, LNC)
Else
nl.ListWithRemove(lex)
End If
User.Labels.Clear()
User.Labels.ListAddList(nl, LNC)
Case 2 'remove
If KeepSpecial Then nl.ListWithRemove(lex)
User.Labels.ListWithRemove(nl)
End Select
If User.Labels.Count > 0 Then User.Labels.Sort()
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[UserDataBase.UpdateLabels]")
End Try
End Sub
#End Region
#Region "Downloading"
Protected _DataLoaded As Boolean = False
Protected _DataParsed As Boolean = False
Friend Property ParseUserMediaOnly As Boolean = False Implements IUserData.ParseUserMediaOnly, IPluginContentProvider.ParseUserMediaOnly
Friend Overridable ReadOnly Property IsSubscription As Boolean Implements IUserData.IsSubscription
Get
Return User.IsSubscription
End Get
End Property
Private Property IPluginContentProvider_IsSubscription As Boolean Implements IPluginContentProvider.IsSubscription
Get
Return IsSubscription
End Get
Set : End Set
End Property
Friend Overridable Property ReadyForDownload As Boolean = True Implements IUserData.ReadyForDownload
Friend Property DownloadImages As Boolean = True Implements IUserData.DownloadImages
Friend Property DownloadVideos As Boolean = True Implements IUserData.DownloadVideos
@@ -636,7 +764,7 @@ BlockNullPicture:
Friend ReadOnly Property LVIKey As String Implements IUserData.Key
Get
If Not _IsCollection Then
Return $"{Site.ToString.ToUpper}_{Name}"
Return $"{IIf(IsSubscription, "SSSS", String.Empty)}{Site.ToString.ToUpper}_{Name}"
Else
Return $"CCCC_{CollectionName}"
End If
@@ -652,6 +780,8 @@ BlockNullPicture:
Friend Overridable ReadOnly Property FitToAddParams As Boolean Implements IUserData.FitToAddParams
Get
With Settings
If IsSubscription And Not .MainFrameUsersShowSubscriptions Then Return False
If Not IsSubscription And Not .MainFrameUsersShowDefaults Then Return False
If LastUpdated.HasValue And Not .ViewDateMode.Value = ShowingDates.Off Then
Dim f As Date = If(.ViewDateFrom.HasValue, .ViewDateFrom.Value.Date, Date.MinValue.Date)
Dim t As Date = If(.ViewDateTo.HasValue, .ViewDateTo.Value.Date, Date.MaxValue.Date)
@@ -705,6 +835,7 @@ BlockNullPicture:
_TempPostsList = New List(Of String)
Labels = New List(Of String)
UserUpdatedEventHandlers = New List(Of IUserData.UserUpdatedEventHandler)
UserDownloadStateChangedEventHandlers = New List(Of UserDownloadStateChangedEventHandler)
If InvokeImageHandler Then MainFrameObj.ImageHandler(Me)
End Sub
Friend Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean,
@@ -753,12 +884,25 @@ BlockNullPicture:
UserExists = x.Value(Name_UserExists).FromXML(Of Boolean)(True)
UserSuspended = x.Value(Name_UserSuspended).FromXML(Of Boolean)(False)
ID = x.Value(Name_UserID)
Options = x.Value(Name_Options)
_FriendlyName = x.Value(Name_FriendlyName)
UserSiteName = x.Value(Name_UserSiteName)
UserDescription = x.Value(Name_Description)
ParseUserMediaOnly = x.Value(Name_ParseUserMediaOnly).FromXML(Of Boolean)(False)
Temporary = x.Value(Name_Temporary).FromXML(Of Boolean)(False)
Favorite = x.Value(Name_Favorite).FromXML(Of Boolean)(False)
If Not x.Value(Name_BackColor).IsEmptyString Then
BackColor = AConvert(Of Color)(x.Value(Name_BackColor), Nothing, EDP.ReturnValue)
Else
BackColor = Nothing
End If
If Not x.Value(Name_ForeColor).IsEmptyString Then
ForeColor = AConvert(Of Color)(x.Value(Name_ForeColor), Nothing, EDP.ReturnValue)
Else
ForeColor = Nothing
End If
CreatedByChannel = x.Value(Name_CreatedByChannel).FromXML(Of Boolean)(False)
SeparateVideoFolder = AConvert(Of Boolean)(x.Value(Name_SeparateVideoFolder), AModes.Var, Nothing)
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
@@ -771,7 +915,6 @@ BlockNullPicture:
ScriptUse = x.Value(Name_ScriptUse).FromXML(Of Boolean)(False)
ScriptData = x.Value(Name_ScriptData)
DataMerging = x.Value(Name_Merged).FromXML(Of Boolean)(False)
ChangeCollectionName(x.Value(Name_CollectionName), False)
Labels.ListAddList(x.Value(Name_LabelsName).StringToList(Of String, List(Of String))("|", EDP.ReturnValue), LAP.NotContainsOnly, LAP.ClearBeforeAdd)
LoadUserInformation_OptionalFields(x, True)
End Using
@@ -798,12 +941,18 @@ BlockNullPicture:
x.Add(Name_UserExists, UserExists.BoolToInteger)
x.Add(Name_UserSuspended, UserSuspended.BoolToInteger)
x.Add(Name_UserID, ID)
x.Add(Name_Options, Options)
x.Add(Name_FriendlyName, _FriendlyName)
x.Add(Name_UserSiteName, UserSiteName)
x.Add(Name_Description, UserDescription)
x.Add(Name_ParseUserMediaOnly, ParseUserMediaOnly.BoolToInteger)
x.Add(Name_IsSubscription, IsSubscription.BoolToInteger)
x.Add(Name_Temporary, Temporary.BoolToInteger)
x.Add(Name_Favorite, Favorite.BoolToInteger)
x.Add(Name_BackColor, CStr(AConvert(Of String)(BackColor, String.Empty, EDP.ReturnValue)))
x.Add(Name_ForeColor, CStr(AConvert(Of String)(ForeColor, String.Empty, EDP.ReturnValue)))
x.Add(Name_CreatedByChannel, CreatedByChannel.BoolToInteger)
If SeparateVideoFolder.HasValue Then
x.Add(Name_SeparateVideoFolder, SeparateVideoFolder.Value.BoolToInteger)
@@ -820,7 +969,7 @@ BlockNullPicture:
x.Add(Name_ScriptUse, ScriptUse.BoolToInteger)
x.Add(Name_ScriptData, ScriptData)
x.Add(Name_CollectionName, CollectionName)
x.Add(Name_LabelsName, Labels.ListToString("|", EDP.ReturnValue))
x.Add(Name_LabelsName, LabelsString)
x.Add(Name_Merged, DataMerging.BoolToInteger)
LoadUserInformation_OptionalFields(x, False)
@@ -867,7 +1016,7 @@ BlockNullPicture:
#End Region
#End Region
#Region "Open site, folder"
Friend Overridable Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing) Implements IContentProvider.OpenSite
Friend Overridable Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing) Implements IUserData.OpenSite
Try
Dim URL$ = HOST.Source.GetUserUrl(Me)
If Not URL.IsEmptyString Then Process.Start(URL)
@@ -927,6 +1076,13 @@ BlockNullPicture:
End Function
#End Region
#Region "Download functions and options"
Private __DOWNLOAD_IN_PROGRESS As Boolean = False
Friend ReadOnly Property DownloadInProgress As Boolean
Get
Return __DOWNLOAD_IN_PROGRESS
End Get
End Property
Friend PersonalToken As CancellationToken
Protected Responser As Responser
Protected UseResponserClient As Boolean = False
Protected UseClientTokens As Boolean = False
@@ -935,10 +1091,12 @@ BlockNullPicture:
Private _DownloadInProgress As Boolean = False
Private _EnvirUserExists As Boolean
Private _EnvirUserSuspended As Boolean
Private _EnvirCreatedByChannel As Boolean
Private _EnvirChanged As Boolean = False
Private _PictureExists As Boolean
Private _EnvirInvokeUserUpdated As Boolean = False
Protected Sub EnvirDownloadSet()
PersonalToken = Nothing
ProgressPre.Reset()
UpdateDataFiles()
_DownloadInProgress = True
@@ -948,6 +1106,7 @@ BlockNullPicture:
_ForceSaveUserInfo = False
_EnvirUserExists = UserExists
_EnvirUserSuspended = UserSuspended
_EnvirCreatedByChannel = CreatedByChannel
_EnvirChanged = False
_EnvirInvokeUserUpdated = False
UserExists = True
@@ -965,7 +1124,9 @@ BlockNullPicture:
End Select
End If
End Sub
Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData
Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IUserData.DownloadData
__DOWNLOAD_IN_PROGRESS = True
OnUserDownloadStateChanged(True)
Dim Canceled As Boolean = False
_ExternalCompatibilityToken = Token
Try
@@ -981,14 +1142,14 @@ BlockNullPicture:
_TempMediaList.Clear()
_TempPostsList.Clear()
LatestData.Clear()
Dim __SaveData As Boolean = Not CreatedByChannel Or Not Settings.FromChannelDownloadTopUse
Dim __isChannelsSupport As Boolean = CreatedByChannel And Settings.FromChannelDownloadTopUse
LoadContentInformation()
If MyFilePosts.Exists Then _TempPostsList.ListAddList(File.ReadAllLines(MyFilePosts))
If _ContentList.Count > 0 Then _TempPostsList.ListAddList(_ContentList.Select(Function(u) u.Post.ID), LNC)
If Not DownloadMissingOnly Then
If Not DownloadMissingOnly Or IsSubscription Then
ThrowAny(Token)
DownloadDataF(Token)
ProgressPre.Done()
@@ -1010,22 +1171,37 @@ BlockNullPicture:
ProgressPre.Done()
ThrowAny(Token)
If UseMD5Comparison Then ValidateMD5(Token) : ProgressPre.Done() : ThrowAny(Token)
If UseMD5Comparison And Not IsSubscription Then ValidateMD5(Token) : ProgressPre.Done() : ThrowAny(Token)
If _TempPostsList.Count > 0 And Not DownloadMissingOnly And __SaveData Then
If _TempPostsList.Count > 0 And Not DownloadMissingOnly And Not __isChannelsSupport Then
If _TempPostsList.Count > 1000 Then _TempPostsList.ListAddList(_TempPostsList.ListTake(-2, 1000, EDP.ReturnValue).ListReverse, LAP.ClearBeforeAdd)
TextSaver.SaveTextToFile(_TempPostsList.ListToString(Environment.NewLine), MyFilePosts, True,, EDP.None)
End If
_ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd)
If IsSubscription Then
_ContentNew.ListAddList(_ContentNew.ListForEachCopy(Function(ByVal tmpC As UserMedia, ByVal ii As Integer) As UserMedia
tmpC.State = UStates.Downloaded
If tmpC.Type = UTypes.Picture Or tmpC.Type = UTypes.GIF Then
DownloadedPictures(False) += 1
Else
DownloadedVideos(False) += 1
End If
Return tmpC
End Function))
Else
DownloadContent(Token)
ThrowIfDisposed()
End If
If IncludeInTheFeed Then LatestData.ListAddList(_ContentNew.Where(_downContent), LNC)
CreatedByChannel = False
If IncludeInTheFeed Or IsSubscription Then LatestData.ListAddList(_ContentNew.Where(_downContent), LNC)
Dim mcb& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
_ContentList.ListAddList(_ContentNew.Where(Function(c) _downContent(c) Or MissingFinder(c)), LNC)
Dim mca& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
If DownloadedTotal(False) > 0 Or _EnvirChanged Or Not mcb = mca Or _ForceSaveUserData Then
If __SaveData Then
If Not __isChannelsSupport Then
LastUpdated = Now
RunScript()
DownloadedPictures(True) = SFile.GetFiles(MyFile.CutPath, "*.jpg|*.jpeg|*.png|*.gif|*.webm",, EDP.ReturnValue).Count
@@ -1040,20 +1216,30 @@ BlockNullPicture:
End If
UpdateUserInformation()
If _CollectionButtonsExists AndAlso _EnvirChanged Then UpdateButtonsColor()
ElseIf _ForceSaveUserInfo Then
ElseIf _ForceSaveUserInfo Or __isChannelsSupport Or Not _EnvirCreatedByChannel = CreatedByChannel Then
UpdateUserInformation()
End If
ThrowIfDisposed()
If Not _PictureExists Or _EnvirInvokeUserUpdated Then OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch oex As OperationCanceledException When Token.IsCancellationRequested Or PersonalToken.IsCancellationRequested
MyMainLOG = $"{ToStringForLog()}: downloading canceled"
Canceled = True
Catch exit_ex As ExitException
If Not exit_ex.Silent Then
If exit_ex.SimpleLogLine Then
MyMainLOG = $"{ToStringForLog()}: downloading canceled (exit) ({exit_ex.Message})"
Else
ErrorsDescriber.Execute(EDP.SendToLog, exit_ex, $"{ToStringForLog()}: downloading canceled (exit)")
End If
End If
Canceled = True
Catch dex As ObjectDisposedException When Disposed
Canceled = True
Catch ex As Exception
LogError(ex, "downloading data error")
HasError = True
Finally
If Not UserExists Then MyMainLOG = $"User '{ToStringForLog()}' not found on the site"
If Not Responser Is Nothing Then Responser.Dispose() : Responser = Nothing
If Not Canceled Then _DataParsed = True
_ContentNew.Clear()
@@ -1065,6 +1251,8 @@ BlockNullPicture:
_ForceSaveUserData = False
_ForceSaveUserInfo = False
ProgressPre.Done()
__DOWNLOAD_IN_PROGRESS = False
OnUserDownloadStateChanged(False)
End Try
End Sub
Protected Sub UpdateDataFiles()
@@ -1087,6 +1275,13 @@ BlockNullPicture:
End If
End Sub
Protected MustOverride Sub DownloadDataF(ByVal Token As CancellationToken)
Protected Function CreateCache() As CacheKeeper
Dim Cache As New CacheKeeper($"{DownloadContentDefault_GetRootDir()}\_tCache\")
Cache.CacheDeleteError = CacheDeletionError(Cache)
If Cache.RootDirectory.Exists(SFO.Path, False) Then Cache.RootDirectory.Delete(SFO.Path, SFODelete.DeletePermanently, EDP.ReturnValue)
Cache.Validate()
Return Cache
End Function
#Region "DownloadSingleObject"
Protected IsSingleObjectDownload As Boolean = False
Friend Overridable Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken) Implements IUserData.DownloadSingleObject
@@ -1124,7 +1319,12 @@ BlockNullPicture:
DirectCast(Data, IDownloadableMedia).ThumbnailFile = _ContentNew(0).File
ElseIf Settings.STDownloader_TakeSnapshot And Settings.FfmpegFile.Exists And Not Settings.STDownloader_RemoveDownloadedAutomatically Then
Dim f As SFile = _ContentNew(0).File
Dim ff As SFile = f
Dim ff As SFile
If Settings.STDownloader_SnapshotsKeepWithFiles Then
ff = f
Else
ff = Settings.CacheSnapshots(Settings.STDownloader_SnapShotsCachePermamnent).NewFile
End If
ff.Name &= "_thumb"
ff.Extension = "jpg"
f = Web.FFMPEG.TakeSnapshot(f, ff, Settings.FfmpegFile, TimeSpan.FromSeconds(1),,, EDP.LogMessageValue)
@@ -1423,6 +1623,7 @@ BlockNullPicture:
If __isVideo Then fileNumProvider.FileName = f.Name : f = SFile.IndexReindex(f,,, fileNumProvider)
__interrupt = False
If IsSingleObjectDownload Then f.Exists(SFO.Path, True)
If v.Type = UTypes.m3u8 And UseInternalM3U8Function Then
f = DownloadM3U8(v.URL, v, f, Token)
If f.IsEmptyString Then Throw New Exception("M3U8 download failed")
@@ -1519,7 +1720,9 @@ BlockNullPicture:
Protected Function ProcessException(ByVal ex As Exception, ByVal Token As CancellationToken, ByVal Message As String,
Optional ByVal RDE As Boolean = True, Optional ByVal EObj As Object = Nothing,
Optional ByVal ThrowEx As Boolean = True) As Integer
If Not ((TypeOf ex Is OperationCanceledException And Token.IsCancellationRequested) Or
If TypeOf ex Is ExitException Then
Throw ex
ElseIf Not ((TypeOf ex Is OperationCanceledException And (Token.IsCancellationRequested Or PersonalToken.IsCancellationRequested)) Or
(TypeOf ex Is ObjectDisposedException And Disposed)) Then
If RDE Then
Dim v% = DownloadingException(ex, Message, True, EObj)
@@ -1579,7 +1782,67 @@ BlockNullPicture:
End Sub
#End Region
#End Region
#Region "Delete, Move, Merge, Copy"
#Region "Erase, Delete, Move, Merge, Copy"
Friend Shared Function GetEraseMode(ByVal Users As IEnumerable(Of IUserData)) As IUserData.EraseMode
Dim mode As IUserData.EraseMode = IUserData.EraseMode.None
If Users.ListExists Then
Dim m As New MMessage("The data of the following users will be erased:" & vbCr & vbCr, "Erase data",
{New MsgBoxButton("History and Data", "All files (images and videos) will be deleted; download history will be deleted."),
New MsgBoxButton("Data", "All files (images and videos) will be deleted; download history will not be affected."),
New MsgBoxButton("History", "All files (images and videos) will not be affected; download history will be deleted."),
New MsgBoxButton("Cancel")
}, MsgBoxStyle.Exclamation) With {.ButtonsPerRow = 4}
Dim collectionsCount% = Users.Count(Function(u) u.IsCollection)
m.Text &= Users.ListToStringE(vbNewLine, MainFrameObj.GetUserListProvider(collectionsCount > 0))
m.Text &= vbCr.StringDup(2)
If collectionsCount > 0 Then
If collectionsCount = 1 And Users.Count = 1 Then
m.Text &= $"THIS USER IS A COLLECTION OF {DirectCast(Users(0), UserDataBind).Count} USERS. THE DATA WILL BE ERASED FOR ALL OF THEM."
Else
m.Text &= "ONE OR MORE USERS IN THE LIST IS A COLLECTION. THE DATA WILL BE ERASED FOR EACH USER OF EACH COLLECTION."
End If
m.Text &= vbCr.StringDup(2)
End If
m.Text &= "Are you sure you want to erase the data?"
Select Case m.Show
Case 0 : mode = IUserData.EraseMode.Data + IUserData.EraseMode.History
Case 1 : mode = IUserData.EraseMode.Data
Case 2 : mode = IUserData.EraseMode.History
End Select
End If
Return mode
End Function
Friend Overridable Function EraseData(ByVal Mode As IUserData.EraseMode) As Boolean Implements IUserData.EraseData
Try
Dim result As Boolean = False
If Not Mode = IUserData.EraseMode.None And Not DataMerging Then
Dim m() As IUserData.EraseMode = Mode.EnumExtract(Of IUserData.EraseMode)
If m.ListExists Then
Dim e As New ErrorsDescriber(EDP.ReturnValue)
If m.Contains(IUserData.EraseMode.History) Then
If MyFilePosts.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
If MyFileData.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
If result Then
_TempPostsList.Clear()
_TempMediaList.Clear()
_ContentNew.Clear()
_ContentList.Clear()
End If
End If
If m.Contains(IUserData.EraseMode.Data) Then
Dim files As List(Of SFile) = SFile.GetFiles(DownloadContentDefault_GetRootDir.CSFileP,, SearchOption.AllDirectories, e)
If files.ListExists Then files.RemoveAll(Function(f) Not f.Extension.IsEmptyString AndAlso (f.Extension = "txt" Or f.Extension = "xml"))
If files.ListExists Then files.ForEach(Sub(f) f.Delete(SFO.File, Settings.DeleteMode, e))
LatestData.Clear()
result = True
End If
End If
End If
Return result
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"EraseData({CInt(Mode)}): {ToStringForLog()}", False)
End Try
End Function
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
@@ -1601,7 +1864,8 @@ BlockNullPicture:
Try
Dim f As SFile
Dim v As Boolean = IsVirtual
If IncludedInCollection Then
If IncludedInCollection And __CollectionName.IsEmptyString And __SpecialCollectionPath.IsEmptyString Then
Settings.Users.Add(Me)
Removed = False
User.CollectionName = String.Empty
@@ -1634,7 +1898,8 @@ BlockNullPicture:
f.Delete(SFO.Path, Settings.DeleteMode, EDP.ThrowException)
End If
f.CutPath.Exists(SFO.Path)
Directory.Move(UserBefore.File.CutPath(, EDP.ThrowException).Path, f.Path)
SFile.Move(UserBefore.File.CutPath(, EDP.ThrowException), f, SFO.Path,,
SFODelete.EmptyOnly + SFODelete.DeleteToRecycleBin + SFODelete.OnCancelThrowException, EDP.ThrowException)
If Not ScriptData.IsEmptyString AndAlso ScriptData.Contains(UserBefore.File.PathNoSeparator) Then _
ScriptData = ScriptData.Replace(UserBefore.File.PathNoSeparator, MyFile.PathNoSeparator)
End If
@@ -1772,10 +2037,11 @@ BlockNullPicture:
''' <exception cref="ObjectDisposedException"></exception>
Friend Overridable Overloads Sub ThrowAny(ByVal Token As CancellationToken)
Token.ThrowIfCancellationRequested()
PersonalToken.ThrowIfCancellationRequested()
ThrowIfDisposed()
End Sub
#End Region
Protected Function ToStringForLog() As String
Friend Function ToStringForLog() As String
Return $"{IIf(IncludedInCollection, $"[{CollectionName}] - ", String.Empty)}[{Site}] - {Name}"
End Function
Public Overrides Function ToString() As String
@@ -1807,6 +2073,21 @@ BlockNullPicture:
End Sub
Private Sub BTT_CONTEXT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DELETE.Click
End Sub
Private Sub BTT_CONTEXT_ERASE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_ERASE.Click
Const msgTitle$ = "Erase data"
Try
Dim m As IUserData.EraseMode = GetEraseMode({Me})
If Not m = IUserData.EraseMode.None Then
If EraseData(m) Then
MsgBoxE({"User data has been erased.", msgTitle})
Else
MsgBoxE({"User data has not been erased.", msgTitle}, vbExclamation)
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, msgTitle)
End Try
End Sub
Private Sub BTT_CONTEXT_OPEN_PATH_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_PATH.Click
OpenFolder()
End Sub
@@ -1858,6 +2139,7 @@ BlockNullPicture:
If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose()
If Not BTT_CONTEXT_EDIT Is Nothing Then BTT_CONTEXT_EDIT.Dispose()
If Not BTT_CONTEXT_DELETE Is Nothing Then BTT_CONTEXT_DELETE.Dispose()
If Not BTT_CONTEXT_ERASE Is Nothing Then BTT_CONTEXT_ERASE.Dispose()
If Not BTT_CONTEXT_OPEN_PATH Is Nothing Then BTT_CONTEXT_OPEN_PATH.Dispose()
If Not BTT_CONTEXT_OPEN_SITE Is Nothing Then BTT_CONTEXT_OPEN_SITE.Dispose()
UserUpdatedEventHandlers.Clear()
@@ -1875,85 +2157,4 @@ BlockNullPicture:
End Sub
#End Region
End Class
#Region "Base interfaces"
Friend Interface IContentProvider
ReadOnly Property Site As String
ReadOnly Property Name As String
Property ID As String
Property FriendlyName As String
Property Description As String
Property Favorite As Boolean
Property Temporary As Boolean
Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing)
Sub DownloadData(ByVal Token As CancellationToken)
Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken)
End Interface
Friend Interface IUserData : Inherits IContentProvider, IComparable(Of UserDataBase), IComparable, IEquatable(Of UserDataBase), IIndexable, IDisposable
Event UserUpdated(ByVal User As IUserData)
Property ParseUserMediaOnly As Boolean
#Region "Images"
Function GetPicture() As Image
Sub SetPicture(ByVal f As SFile)
#End Region
#Region "Collection support"
ReadOnly Property IsCollection As Boolean
Property CollectionName As String
ReadOnly Property IncludedInCollection As Boolean
ReadOnly Property UserModel As UsageModel
ReadOnly Property CollectionModel As UsageModel
ReadOnly Property IsVirtual As Boolean
ReadOnly Property Labels As List(Of String)
#End Region
Property Exists As Boolean
Property Suspended As Boolean
Property ReadyForDownload As Boolean
Property HOST As SettingsHost
Property [File] As SFile
Property FileExists As Boolean
Property DownloadedPictures(ByVal Total As Boolean) As Integer
Property DownloadedVideos(ByVal Total As Boolean) As Integer
ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer
ReadOnly Property DownloadedInformation As String
Property HasError As Boolean
ReadOnly Property FitToAddParams As Boolean
ReadOnly Property Key As String
Property DownloadImages As Boolean
Property DownloadVideos As Boolean
Property DownloadMissingOnly As Boolean
Property ScriptUse As Boolean
Property ScriptData As String
Function GetLVI(ByVal Destination As ListView) As ListViewItem
Function GetLVIGroup(ByVal Destination As ListView) As ListViewGroup
Sub LoadUserInformation()
Sub UpdateUserInformation()
''' <summary>
''' 0 - Nothing removed<br/>
''' 1 - User removed<br/>
''' 2 - Collection removed<br/>
''' 3 - Collection split
''' </summary>
Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer
Function MoveFiles(ByVal CollectionName As String, ByVal SpecialCollectionPath As SFile) As Boolean
Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Sub OpenFolder()
Property DownloadTopCount As Integer?
Property DownloadDateFrom As Date?
Property DownloadDateTo As Date?
Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean,
Optional ByVal AttachUserInfo As Boolean = True)
ReadOnly Property Disposed As Boolean
End Interface
Friend Interface IChannelLimits
Property AutoGetLimits As Boolean
Property DownloadLimitCount As Integer?
Property DownloadLimitPost As String
Property DownloadLimitDate As Date?
Overloads Sub SetLimit(Optional ByVal Post As String = "", Optional ByVal Count As Integer? = Nothing, Optional ByVal [Date] As Date? = Nothing)
Overloads Sub SetLimit(ByVal Source As IChannelLimits)
End Interface
Friend Interface IChannelData : Inherits IContentProvider, IChannelLimits
Property SkipExistsUsers As Boolean
Property SaveToCache As Boolean
End Interface
#End Region
End Namespace

View File

@@ -74,9 +74,9 @@ Namespace API.Instagram
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 ReadOnly Header_Browser As New HttpHeader("Sec-Ch-Ua", """Google Chrome"";v=""113"", ""Chromium"";v=""113"", ""Not-A.Brand"";v=""24""")
Private ReadOnly Header_BrowserExt As New HttpHeader("Sec-Ch-Ua-Full-Version-List", """Google Chrome"";v=""113.0.5672.127"", ""Chromium"";v=""113.0.5672.127"", ""Not-A.Brand"";v=""24.0.0.0""")
Private ReadOnly Header_Platform As New HttpHeader("Sec-Ch-Ua-Platform-Version", """10.0.0""")
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 ReadOnly Property HashTagged As PropertyValue
<PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(2)>
@@ -108,9 +108,9 @@ Namespace API.Instagram
Case NameOf(HH_ASBD_ID) : f = Header_ASBD_ID
Case NameOf(HH_IG_WWW_CLAIM) : f = Header_IG_WWW_CLAIM
Case NameOf(HH_CSRF_TOKEN) : f = Header_CSRF_TOKEN
Case NameOf(HH_BROWSER) : f = Header_Browser.Name
Case NameOf(HH_BROWSER_EXT) : f = Header_BrowserExt.Name
Case NameOf(HH_PLATFORM) : f = Header_Platform.Name
Case NameOf(HH_BROWSER) : f = Header_Browser
Case NameOf(HH_BROWSER_EXT) : f = Header_BrowserExt
Case NameOf(HH_PLATFORM) : f = Header_Platform
Case NameOf(HH_USER_AGENT) : isUserAgent = True
End Select
If Not f.IsEmptyString Then
@@ -219,20 +219,6 @@ Namespace API.Instagram
Dim platform$ = String.Empty
Dim useragent$ = String.Empty
Dim __UpdateHeader As Action(Of HttpHeader, Boolean) = Sub(ByVal h As HttpHeader, ByVal UpdateValueIfEmpty As Boolean)
With Responser.Headers
Dim i% = .IndexOf(h)
Dim hh As HttpHeader
If i >= 0 Then
hh = .Item(i)
If hh.Value.IsEmptyString And UpdateValueIfEmpty Then hh.Value = h.Value
Else
hh = h
End If
.Add(hh)
End With
End Sub
With Responser
.Accept = "*/*"
useragent = .UserAgent
@@ -242,19 +228,13 @@ Namespace API.Instagram
app_id = .Value(Header_IG_APP_ID)
www_claim = .Value(Header_IG_WWW_CLAIM)
asbd = .Value(Header_ASBD_ID)
browser = .Value(Header_Browser.Name)
browserExt = .Value(Header_BrowserExt.Name)
platform = .Value(Header_Platform.Name)
browser = .Value(Header_Browser)
browserExt = .Value(Header_BrowserExt)
platform = .Value(Header_Platform)
End If
.Add("Dnt", 1)
__UpdateHeader(Header_Browser, browser.IsEmptyString)
browser = .Value(Header_Browser.Name)
__UpdateHeader(Header_BrowserExt, browserExt.IsEmptyString)
browserExt = .Value(Header_BrowserExt.Name)
.Add("Sec-Ch-Ua-Mobile", "?0")
.Add("Sec-Ch-Ua-Platform", """Windows""")
__UpdateHeader(Header_Platform, platform.IsEmptyString)
platform = .Value(Header_Platform.Name)
.Add("Sec-Fetch-Dest", "empty")
.Add("Sec-Fetch-Mode", "cors")
.Add("Sec-Fetch-Site", "same-origin")
@@ -301,6 +281,7 @@ Namespace API.Instagram
LastRequestsCountLabel = New PropertyValue(LastRequestsCountLabelStr.Invoke(LastRequestsCount.Value))
AddHandler LastRequestsCount.ValueChanged, Sub(sender, e) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(DirectCast(sender, XMLValue(Of Integer)).ValueF.Value)
_AllowUserAgentUpdate = False
UrlPatternUser = "https://www.instagram.com/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?instagram.com/([^/]+)", 1)
ImageVideoContains = "instagram.com"

View File

@@ -26,6 +26,7 @@ Namespace API.Instagram
Private Const Name_GetStories As String = "GetStories"
Private Const Name_GetTagged As String = "GetTaggedData"
Private Const Name_TaggedChecked As String = "TaggedChecked"
Private Const Name_NameTrue As String = "NameTrue"
#End Region
#Region "Declarations"
Private Structure PostKV : Implements IEContainerProvider
@@ -75,6 +76,13 @@ Namespace API.Instagram
Friend Property GetTimeline As Boolean = True
Friend Property GetStories As Boolean
Friend Property GetTaggedData As Boolean
Private _NameTrue As String = String.Empty
Private ReadOnly Property NameTrue As String
Get
Return _NameTrue.IfNullOrEmpty(Name)
End Get
End Property
Private UserNameRequested As Boolean = False
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object
@@ -96,21 +104,25 @@ Namespace API.Instagram
PostsToReparse = New List(Of PostKV)
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
LastCursor = Container.Value(Name_LastCursor)
FirstLoadingDone = Container.Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
GetTimeline = Container.Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value))
GetStories = Container.Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
GetTaggedData = Container.Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
TaggedChecked = Container.Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
LastCursor = .Value(Name_LastCursor)
FirstLoadingDone = .Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
GetTimeline = .Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value))
GetStories = .Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
GetTaggedData = .Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
TaggedChecked = .Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
_NameTrue = .Value(Name_NameTrue)
Else
Container.Add(Name_LastCursor, LastCursor)
Container.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
Container.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
Container.Add(Name_GetStories, GetStories.BoolToInteger)
Container.Add(Name_GetTagged, GetTaggedData.BoolToInteger)
Container.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
.Add(Name_LastCursor, LastCursor)
.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
.Add(Name_GetStories, GetStories.BoolToInteger)
.Add(Name_GetTagged, GetTaggedData.BoolToInteger)
.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
.Add(Name_NameTrue, _NameTrue)
End If
End With
End Sub
#End Region
#Region "Download data"
@@ -195,6 +207,7 @@ Namespace API.Instagram
End Function
Private _DownloadingInProgress As Boolean = False
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
UserNameRequested = False
Dim s As Sections = Sections.Timeline
Dim errorFound As Boolean = False
Try
@@ -413,13 +426,13 @@ Namespace API.Instagram
'Check environment
If Not IsSavedPosts Then
If ID.IsEmptyString Then GetUserId()
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
If ID.IsEmptyString Then Throw New Plugin.ExitException("can't get user ID")
End If
'Create query
Select Case Section
Case Sections.Timeline
URL = $"https://www.instagram.com/api/v1/feed/user/{Name}/username/?count=50" &
URL = $"https://www.instagram.com/api/v1/feed/user/{NameTrue}/username/?count=50" &
If(Cursor.IsEmptyString, String.Empty, $"&max_id={Cursor}")
ENode = Nothing
Case Sections.SavedPosts
@@ -766,16 +779,18 @@ Namespace API.Instagram
End Try
End Sub
#End Region
#Region "GetUserId"
#Region "GetUserId, GetUserName"
Private Sub GetUserId()
Dim __idFound As Boolean = False
Try
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/users/web_profile_info/?username={Name}",, EDP.ThrowException)
RequestsCount += 1
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/users/web_profile_info/?username={NameTrue}",, EDP.ThrowException)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing AndAlso j.Contains({"data", "user"}) Then
With j({"data", "user"})
ID = .Value("id")
_ForceSaveUserData = True
__idFound = True
UserSiteNameUpdate(.Value("full_name"))
Dim descr$ = .Value("biography")
@@ -800,11 +815,43 @@ Namespace API.Instagram
If Responser.StatusCode = HttpStatusCode.NotFound Or Responser.StatusCode = HttpStatusCode.BadRequest Then
Throw ex
Else
LogError(ex, "get Instagram user id")
LogError(ex, "get Instagram user ID")
End If
End If
End Try
End Sub
Private Function GetUserNameById() As Boolean
UserNameRequested = True
Try
If Not ID.IsEmptyString Then
RequestsCount += 1
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/users/{ID}/info/",, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If j.ListExists Then
Dim newName$ = j.Value({"user"}, "username")
If Not newName.IsEmptyString Then
Dim oldName$ = NameTrue
If Not newName = oldName Then
MyMainLOG = $"{ToStringForLog()}: username changed from '{oldName}' to '{newName}'"
_NameTrue = newName
Dim descr$ = $"Username changed from '{oldName}' to '{newName}' ({Now.ToStringDate(ADateTime.Formats.BaseDateTime)})!"
descr.StringAppendLine(UserDescription)
UserDescription = descr
_ForceSaveUserData = True
End If
Return True
End If
End If
End Using
End If
End If
Return False
Catch ex As Exception
LogError(ex, "get Instagram user name by ID")
Return False
End Try
End Function
#End Region
#Region "Pinned stories"
Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken)
@@ -887,7 +934,7 @@ Namespace API.Instagram
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal s As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False
If Not UserNameRequested AndAlso GetUserNameById() Then Return 1 Else UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
HasError = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
@@ -906,7 +953,7 @@ Namespace API.Instagram
ElseIf Responser.StatusCode = 560 Then
MySiteSettings.SkipUntilNextSession = True
Else
MyMainLOG = $"Instagram hash requested [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
MyMainLOG = $"Something is wrong. Your credentials may have expired [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
DisableSection(s)
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0

View File

@@ -9,9 +9,11 @@
Imports SCrawler.Plugin.Attributes
Namespace API.Mastodon
Friend Class EditorExchangeOptions : Inherits Twitter.EditorExchangeOptions
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property MediaModelAllowNonUserTweets As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelMedia As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelProfile As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelSearch As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelForceApply As Boolean
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
End Sub

View File

@@ -13,7 +13,7 @@ Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports TS = SCrawler.API.Twitter.SiteSettings
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Mastodon
<Manifest(MastodonSiteKey), SavedPosts, SpecialForm(True), SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
@@ -46,8 +46,8 @@ Namespace API.Mastodon
If Not PropName.IsEmptyString Then
Dim f$ = String.Empty
Select Case PropName
Case NameOf(Auth) : f = TS.Header_Authorization
Case NameOf(Token) : f = TS.Header_Token
Case NameOf(Auth) : f = DN.Header_Authorization
Case NameOf(Token) : f = DN.Header_CSRFToken
End Select
If Not f.IsEmptyString Then
Responser.Headers.Remove(f)
@@ -58,15 +58,15 @@ Namespace API.Mastodon
End Sub
#End Region
#Region "Other properties"
<PropertyOption(IsAuth:=False, ControlText:=TS.GifsDownload_Text), PXML>
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsDownloadCaption), PXML>
Friend ReadOnly Property GifsDownload As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:=TS.GifsSpecialFolder_Text, ControlToolTip:=TS.GifsSpecialFolder_ToolTip), PXML>
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip), PXML>
Friend ReadOnly Property GifsSpecialFolder As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:=TS.GifsPrefix_Text, ControlToolTip:=TS.GifsPrefix_ToolTip), PXML>
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip), PXML>
Friend ReadOnly Property GifsPrefix As PropertyValue
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
Private ReadOnly Property GifStringChecker As IFormatProvider
<PropertyOption(IsAuth:=False, ControlText:=TS.UseMD5Comparison_Text, ControlToolTip:=TS.UseMD5Comparison_ToolTip), PXML>
<PropertyOption(IsAuth:=False, ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip), PXML>
Friend ReadOnly Property UseMD5Comparison As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:="User related to my domain",
ControlToolTip:="Open user profiles and user posts through my domain."), PXML>
@@ -82,13 +82,13 @@ Namespace API.Mastodon
Domains.DestinationProp = SiteDomains
DomainsLastUpdateDate = New PropertyValue(Now.AddYears(-1))
Auth = New PropertyValue(Responser.Headers.Value(TS.Header_Authorization), GetType(String), Sub(v) ChangeResponserFields(NameOf(Auth), v))
Token = New PropertyValue(Responser.Headers.Value(TS.Header_Token), GetType(String), Sub(v) ChangeResponserFields(NameOf(Token), v))
Auth = New PropertyValue(Responser.Headers.Value(DN.Header_Authorization), GetType(String), Sub(v) ChangeResponserFields(NameOf(Auth), v))
Token = New PropertyValue(Responser.Headers.Value(DN.Header_CSRFToken), GetType(String), Sub(v) ChangeResponserFields(NameOf(Token), v))
GifsDownload = New PropertyValue(True)
GifsSpecialFolder = New PropertyValue(String.Empty, GetType(String))
GifsPrefix = New PropertyValue("GIF_")
GifStringChecker = New TS.GifStringProvider
GifStringChecker = New API.Twitter.SiteSettings.GifStringProvider
UseMD5Comparison = New PropertyValue(False)
MyDomain = New PropertyValue(String.Empty, GetType(String))
UserRelatedToMyDomain = New PropertyValue(False)

View File

@@ -55,8 +55,8 @@ Namespace API.Mastodon
If setDef Then MyCredentials = New Credentials With {.Domain = UserDomain, .Bearer = MySettings.Auth.Value, .Csrf = MySettings.Token.Value}
End With
With MyCredentials
Responser.Headers.Add(Twitter.SiteSettings.Header_Authorization, .Bearer)
Responser.Headers.Add(Twitter.SiteSettings.Header_Token, .Csrf)
Responser.Headers.Add(DeclaredNames.Header_Authorization, .Bearer)
Responser.Headers.Add(DeclaredNames.Header_CSRFToken, .Csrf)
End With
End Sub
#End Region
@@ -274,7 +274,7 @@ Namespace API.Mastodon
ProcessException(ex, Token, $"ReparseMissing error [{URL}]")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(i) : Next
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try

View File

@@ -14,7 +14,7 @@ Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.OnlyFans
<Manifest("AndyProgram_OnlyFans"), SavedPosts, SeparatedTasks(1)>
<Manifest("AndyProgram_OnlyFans"), SavedPosts, SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Icon"
Friend Overrides ReadOnly Property Icon As Icon
@@ -29,6 +29,13 @@ Namespace API.OnlyFans
End Property
#End Region
#Region "Declarations"
#Region "Options"
<PropertyOption(ControlText:="Download highlights", ControlToolTip:="Download profile highlights if they exists"), PXML>
Friend Property DownloadHighlights As PropertyValue
<PropertyOption(ControlText:="Download chat", ControlToolTip:="Download unlocked chat media"), PXML>
Friend Property DownloadChatMedia As PropertyValue
#End Region
#Region "Headers"
Private Const HeaderBrowser As String = "sec-ch-ua"
Private Const HeaderUserID As String = "User-Id"
Private Const HeaderXBC As String = "X-Bc"
@@ -39,7 +46,7 @@ Namespace API.OnlyFans
Private ReadOnly Property HH_X_BC As PropertyValue
<PropertyOption(ControlText:=HeaderAppToken, AllowNull:=False)>
Private ReadOnly Property HH_APP_TOKEN As PropertyValue
<PropertyOption(ControlText:=HeaderBrowser, AllowNull:=False)>
<PropertyOption(ControlText:=HeaderBrowser, ControlToolTip:="Can be null", AllowNull:=True)>
Private ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(AllowNull:=False)>
Private ReadOnly Property UserAgent As PropertyValue
@@ -59,6 +66,8 @@ Namespace API.OnlyFans
Responser.UserAgent = Value
End If
End Sub
#End Region
#Region "Rules"
<PXML("LastDateUpdated")> Private ReadOnly Property LastDateUpdated_XML As PropertyValue
Friend Property LastDateUpdated As Date
Get
@@ -81,6 +90,7 @@ Namespace API.OnlyFans
"Change this value only if you know what you are doing."), PXML>
Friend ReadOnly Property DynamicRules As PropertyValue
#End Region
#End Region
#Region "Initializer"
Friend Sub New()
MyBase.New("OnlyFans", ".onlyfans.com")
@@ -110,13 +120,16 @@ Namespace API.OnlyFans
UserAgent = New PropertyValue(IIf(.UserAgentExists, .UserAgent, String.Empty), GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v))
End With
DownloadHighlights = New PropertyValue(True)
DownloadChatMedia = New PropertyValue(True)
LastDateUpdated_XML = New PropertyValue(Now.AddYears(-1), GetType(Date))
UseOldAuthRules = New PropertyValue(False)
DynamicRulesUpdateInterval = New PropertyValue(60 * 24)
DynamicRulesUpdateIntervalProvider = New FieldsCheckerProviderSimple(Function(v) IIf(AConvert(Of Integer)(v, 0) > 0, v, Nothing),
"The value of [{0}] field must be greater than 0")
DynamicRules = New PropertyValue(String.Empty, GetType(String))
UserRegex = RParams.DMS("onlyfans.com/(\w+)", 1, EDP.ReturnValue)
UserRegex = RParams.DMS("onlyfans.com/([\w\._]+)", 1, EDP.ReturnValue)
UrlPatternUser = "https://onlyfans.com/{0}"
ImageVideoContains = "onlyfans.com"
End Sub
@@ -134,7 +147,7 @@ Namespace API.OnlyFans
#End Region
#Region "Download"
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists And {HH_USER_ID, HH_X_BC, HH_APP_TOKEN, HH_BROWSER, UserAgent}.All(Function(v) ACheck(v.Value))
Return Responser.CookiesExists And {HH_USER_ID, HH_X_BC, HH_APP_TOKEN, UserAgent}.All(Function(v) ACheck(v.Value))
End Function
Friend Overrides Function ReadyToDownload(ByVal What As ISiteSettings.Download) As Boolean
Return BaseAuthExists() And Not SessionAborted
@@ -149,17 +162,36 @@ Namespace API.OnlyFans
If Responser.Cookies.Changed Then Responser.SaveCookies() : Responser.Cookies.Changed = False
End Sub
#End Region
#Region "GetUserUrl, GetUserPostUrl"
#Region "GetUserUrl, GetUserPostUrl, UserOptions"
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return String.Format(UrlPatternUser, If(User.ID.IsEmptyString, User.Name, $"u{User.ID}"))
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
If Not Media.Post.ID.IsEmptyString Then
Return String.Format("https://onlyfans.com/{0}/{1}", Media.Post.ID, If(User.ID.IsEmptyString, User.Name, $"u{User.ID}"))
Dim post$() = Media.Post.ID.Split("_")
Dim p$ = String.Empty
If post.ListExists Then
If post(0) = UserData.A_MESSAGE Then
If Not User.ID.IsEmptyString Then Return $"https://onlyfans.com/my/chats/chat/{User.ID}/"
ElseIf Not post(0) = UserData.A_HIGHLIGHT Then
p = post(0)
End If
End If
If p.IsEmptyString Then
Return GetUserUrl(User)
Else
Return String.Format("https://onlyfans.com/{0}/{1}", p, If(User.ID.IsEmptyString, User.Name, $"u{User.ID}"))
End If
Else
Return String.Empty
End If
End Function
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions(Me)
If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
End Sub
#End Region
End Class
End Namespace

View File

@@ -19,26 +19,68 @@ Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.OnlyFans
Friend Class UserData : Inherits UserDataBase
#Region "XML names"
Private Const Name_MediaDownloadHighlights As String = "DownloadHighlights"
Private Const Name_MediaDownloadChatMedia As String = "DownloadChatMedia"
#End Region
#Region "Declarations"
Friend Property CCookie As CookieKeeper = Nothing
Private Const HeaderSign As String = "Sign"
Private Const HeaderTime As String = "Time"
Private ReadOnly HighlightsList As List(Of String)
Friend Property MediaDownloadHighlights As Boolean = True
Friend Property MediaDownloadChatMedia As Boolean = True
Private ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
End Get
End Property
#End Region
#Region "Load"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
MediaDownloadHighlights = .Value(Name_MediaDownloadHighlights).FromXML(Of Boolean)(True)
MediaDownloadChatMedia = .Value(Name_MediaDownloadChatMedia).FromXML(Of Boolean)(True)
Else
.Add(Name_MediaDownloadHighlights, MediaDownloadHighlights.BoolToInteger)
.Add(Name_MediaDownloadChatMedia, MediaDownloadChatMedia.BoolToInteger)
End If
End With
End Sub
#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)
MediaDownloadHighlights = .DownloadHighlights
MediaDownloadChatMedia = .DownloadChatMedia
End With
End If
End Sub
#End Region
#Region "Initializer"
Friend Sub New()
HighlightsList = New List(Of String)
End Sub
#End Region
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not MySettings.SessionAborted Then
If Not CCookie Is Nothing Then CCookie.Dispose()
CCookie = Responser.Cookies.Copy
Responser.Cookies.Clear()
AddHandler Responser.ResponseReceived, AddressOf OnResponseReceived
UpdateCookieHeader()
DownloadData(IIf(IsSavedPosts, 0, String.Empty), Token)
DownloadTimeline(IIf(IsSavedPosts, 0, String.Empty), Token)
If Not IsSavedPosts Then
If MediaDownloadHighlights Then DownloadHighlights(Token)
If MediaDownloadChatMedia Then DownloadChatMedia(0, Token)
End If
End If
End Sub
Private Sub OnResponseReceived(ByVal Sender As Object, ByVal e As WebDataResponse)
If e.CookiesExists Then
@@ -49,9 +91,11 @@ Namespace API.OnlyFans
Private Sub UpdateCookieHeader()
Responser.Headers.Add("Cookie", CCookie.ToString(False))
End Sub
Friend Const A_HIGHLIGHT As String = "HL"
Friend Const A_MESSAGE As String = "MSG"
Private Const BaseUrlPattern As String = "https://onlyfans.com{0}"
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
#Region "Download timeline"
Private Overloads Sub DownloadTimeline(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim url$ = String.Empty
Dim _complete As Boolean = True
Do
@@ -122,15 +166,148 @@ Namespace API.OnlyFans
If hasMore Then
If IsSavedPosts Then tmpCursor = CInt(Cursor.IfNullOrEmpty(0)) + 10
DownloadData(tmpCursor, Token)
DownloadTimeline(tmpCursor, Token)
End If
Catch ex As Exception
If ProcessException(ex, Token, $"data downloading error [{url}]") = 2 Then _complete = False
_complete = Not ProcessException(ex, Token, $"data downloading error [{url}]") = 2
End Try
Loop While Not _complete
End Sub
#End Region
#Region "Download highlights"
Private Overloads Sub DownloadHighlights(ByVal Token As CancellationToken)
HighlightsList.Clear()
DownloadHighlights(0, Token)
If HighlightsList.Count > 0 Then HighlightsList.ForEach(Sub(hl) DownloadHighlightMedia(hl, Token))
End Sub
Private Overloads Sub DownloadHighlights(ByVal Cursor As Integer, ByVal Token As CancellationToken)
Dim url$ = String.Empty
Dim _complete As Boolean = True
Do
Try
Dim hasMore As Boolean = False
Dim path$ = $"/api2/v2/users/{ID}/stories/highlights?limit=5&offset={Cursor}"
If UpdateSignature(path) Then
url = String.Format(BaseUrlPattern, path)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(url)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
hasMore = j.Value("hasMore").FromXML(Of Boolean)(False)
With j("list")
If .ListExists Then
HighlightsList.AddRange(.Select(Function(e) e.Value("id")))
Else
hasMore = False
End If
End With
End If
End Using
End If
End If
If hasMore Then DownloadHighlights(Cursor + 5, Token)
Catch ex As Exception
_complete = Not ProcessException(ex, Token, $"highlights downloading error [{url}]") = 2
End Try
Loop While Not _complete
End Sub
Private Sub DownloadHighlightMedia(ByVal HLID As String, ByVal Token As CancellationToken)
Dim url$ = String.Empty
Dim _complete As Boolean = True
Do
Try
Dim specFolder$, postID$, postDate$
Dim media As List(Of UserMedia)
Dim result As Boolean
Dim path$ = $"/api2/v2/stories/highlights/{HLID}"
If UpdateSignature(path) Then
url = String.Format(BaseUrlPattern, path)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(url)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
specFolder = j.Value("title").StringRemoveWinForbiddenSymbols.IfNullOrEmpty(HLID)
specFolder &= "*"
With j("stories")
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For Each m As EContainer In .Self
ProgressPre.Perform()
postID = $"{A_HIGHLIGHT}_{HLID}_{m.Value("id")}"
postDate = m.Value("createdAt")
If Not _TempPostsList.Contains(postID) Then
_TempPostsList.Add(postID)
Else
Exit Sub
End If
result = False
media = TryCreateMedia(m, postID, postDate, result, True, specFolder)
If result Then _TempMediaList.ListAddList(media, LNC)
Next
End If
End With
End If
End Using
End If
End If
Catch ex As Exception
_complete = Not ProcessException(ex, Token, $"highlights downloading error [{url}]") = 2
End Try
Loop While Not _complete
End Sub
#End Region
#Region "Download chat media"
Private Sub DownloadChatMedia(ByVal Cursor As Integer, ByVal Token As CancellationToken)
Dim url$ = String.Empty
Dim _complete As Boolean = True
Do
Try
Dim hasMore As Boolean = False
Dim postID$, postDate$
Dim media As List(Of UserMedia)
Dim result As Boolean
Dim path$ = $"/api2/v2/chats/{ID}/media/?opened=1&limit=20&skip_users=all"
If Cursor > 0 Then path &= $"&offset={Cursor}"
If UpdateSignature(path) Then
url = String.Format(BaseUrlPattern, path)
ThrowAny(Token)
Dim r$ = Responser.GetResponse(url)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
hasMore = j.Value("hasMore").FromXML(Of Boolean)(False)
With j("list")
If .ListExists Then
For Each m As EContainer In .Self
postID = $"{A_MESSAGE}_{m.Value("id")}"
postDate = m.Value("createdAt")
If Not _TempPostsList.Contains(postID) Then
_TempPostsList.Add(postID)
Else
Exit Sub
End If
result = False
media = TryCreateMedia(m, postID, postDate, result,, "Chats*")
If result Then _TempMediaList.ListAddList(media, LNC)
Next
End If
End With
End If
End Using
End If
End If
If hasMore Then DownloadChatMedia(Cursor + 20, Token)
Catch ex As Exception
_complete = Not ProcessException(ex, Token, $"chats downloading error [{url}]") = 2
End Try
Loop While Not _complete
End Sub
#End Region
Private Function TryCreateMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal PostDate As String = Nothing,
Optional ByRef Result As Boolean = False) As List(Of UserMedia)
Optional ByRef Result As Boolean = False, Optional ByVal IsHL As Boolean = False,
Optional ByVal SpecFolder As String = Nothing) As List(Of UserMedia)
Dim postUrl$, ext$
Dim t As UTypes
Dim mList As New List(Of UserMedia)
@@ -138,7 +315,11 @@ Namespace API.OnlyFans
With n("media")
If .ListExists Then
For Each m In .Self
If IsHL Then
postUrl = m.Value({"files", "source"}, "url")
Else
postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
End If
Select Case m.Value("type")
Case "photo" : t = UTypes.Picture : ext = "jpg"
Case "video" : t = UTypes.Video : ext = "mp4"
@@ -146,7 +327,9 @@ Namespace API.OnlyFans
End Select
If Not t = UTypes.Undefined And Not postUrl.IsEmptyString Then
Dim media As New UserMedia(postUrl, t) With {
.Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing))}
.Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing)),
.SpecialFolder = SpecFolder
}
media.File.Extension = ext
Result = True
mList.Add(media)
@@ -157,6 +340,7 @@ Namespace API.OnlyFans
Return mList
End Function
Private Sub GetUserID()
Const brTag$ = "<br />"
Dim path$ = $"/api2/v2/users/{Name}"
Dim url$ = String.Format(BaseUrlPattern, path)
Try
@@ -168,7 +352,9 @@ Namespace API.OnlyFans
ID = j.Value("id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
UserSiteNameUpdate(j.Value("name"))
UserDescriptionUpdate(j.Value("about"))
Dim descr$ = j.Value("about")
If Not descr.IsEmptyString Then descr = descr.Replace(brTag, String.Empty)
UserDescriptionUpdate(descr)
Dim a As Action(Of String) = Sub(ByVal address As String)
If Not address.IsEmptyString Then
Dim f As SFile = address
@@ -232,7 +418,7 @@ Namespace API.OnlyFans
ProcessException(ex, Token, $"ReparseMissing error [{URL}]")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(i) : Next
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try
@@ -347,6 +533,10 @@ Namespace API.OnlyFans
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then
UserExists = False
Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.GatewayTimeout Or Responser.StatusCode = 429 Then
If Responser.StatusCode = 429 Then MyMainLOG = $"[429] OnlyFans too many requests ({ToStringForLog()})"
MySettings.SessionAborted = True
Return 1
Else
Return 0
End If
@@ -354,7 +544,7 @@ Namespace API.OnlyFans
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then CCookie.DisposeIfReady(False) : CCookie = Nothing
If Not disposedValue And disposing Then CCookie.DisposeIfReady(False) : CCookie = Nothing : HighlightsList.Clear()
MyBase.Dispose(disposing)
End Sub
#End Region

View File

@@ -0,0 +1,28 @@
' 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.OnlyFans
Friend Class UserExchangeOptions
<PSetting(NameOf(SiteSettings.DownloadHighlights), NameOf(MySettings))>
Friend Property DownloadHighlights As Boolean
<PSetting(NameOf(SiteSettings.DownloadChatMedia), NameOf(MySettings))>
Friend Property DownloadChatMedia As Boolean
Private ReadOnly MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
DownloadHighlights = u.MediaDownloadHighlights
DownloadChatMedia = u.MediaDownloadChatMedia
MySettings = u.HOST.Source
End Sub
Friend Sub New(ByVal s As SiteSettings)
DownloadHighlights = s.DownloadHighlights.Value
DownloadChatMedia = s.DownloadChatMedia.Value
MySettings = s
End Sub
End Class
End Namespace

View File

@@ -12,7 +12,7 @@ Namespace API.PathPlugin
Private Const DOWNLOAD_ERROR As String = "The path plugin only provides user paths."
Friend Overrides Property UserExists As Boolean
Get
Return FileExists
Return DownloadContentDefault_GetRootDir.CSFileP.Exists(SFO.Path, False)
End Get
Set(ByVal e As Boolean)
MyBase.UserExists = e

View File

@@ -25,25 +25,12 @@ Namespace API.Pinterest
Return My.Resources.SiteResources.PinterestPic_48
End Get
End Property
Private Class ConcurrentDownloadsValidator : Inherits FieldsCheckerProviderBase
Public Overrides Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object
Dim v% = AConvert(Of Integer)(Value, -1)
Dim defV% = Settings.MaxUsersJobsCount
If v.ValueBetween(1, defV) Then
Return Value
Else
ErrorMessage = $"The number of concurrent downloads must be greater than 0 and equal to or less than {defV} (global limit)."
HasError = True
Return Nothing
End If
End Function
End Class
<Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)>
Private ReadOnly Property ConcurrentDownloadsProvider As IFormatProvider
<PXML, PropertyOption(ControlText:="Concurrent downloads", ControlToolTip:="The number of concurrent downloads.", LeftOffset:=120), TaskCounter>
<PropertyOption(ControlText:=DeclaredNames.ConcurrentDownloadsCaption,
ControlToolTip:=DeclaredNames.ConcurrentDownloadsToolTip, AllowNull:=False, LeftOffset:=120), PXML, TaskCounter>
Friend ReadOnly Property ConcurrentDownloads As PropertyValue
<PXML, PropertyOption(ControlText:="Saved posts user", ControlToolTip:="Personal profile username")>
<Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)>
Private ReadOnly Property MyConcurrentDownloadsProvider As IFormatProvider
<PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip), PXML>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
#End Region
#Region "Initializer"
@@ -51,7 +38,7 @@ Namespace API.Pinterest
MyBase.New("Pinterest", "pinterest.com")
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
ConcurrentDownloads = New PropertyValue(1)
ConcurrentDownloadsProvider = New ConcurrentDownloadsValidator
MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider
CheckNetscapeCookiesOnEndInit = True
UseNetscapeCookies = True
UserRegex = RParams.DMS("https?://w{0,3}.?[^/]*?.?pinterest.com/([^/]+)/?(?(_)|([^/]*))", 0, RegexReturn.ListByMatch, EDP.ReturnValue)

View File

@@ -38,6 +38,12 @@ Namespace API.Pinterest
Friend Property TrueUserName As String
Friend Property TrueBoardName As String
Friend Property IsUser As Boolean
Private Const BoardLabelName As String = "Board"
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {UserLabelName, BoardLabelName}
End Get
End Property
#End Region
#Region "Load"
Private Function ReconfUserName() As Boolean
@@ -48,14 +54,14 @@ Namespace API.Pinterest
IsUser = True
If n.Length > 1 Then TrueBoardName = n(1) : IsUser = False
If Not IsSavedPosts And Not IsSingleObjectDownload Then
Dim l$ = IIf(IsUser, UserLabelName, "Board")
Dim l$ = IIf(IsUser, UserLabelName, BoardLabelName)
Settings.Labels.Add(l)
Labels.ListAddValue(l, LNC)
Labels.Sort()
End If
Return True
End If
End If
End If
Return False
End Function
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
@@ -66,7 +72,7 @@ Namespace API.Pinterest
IsUser = .Value(Name_IsUser).FromXML(Of Boolean)(False)
ReconfUserName()
Else
If ReconfUserName() Then .Value(Name_LabelsName) = Labels.ListToString("|", EDP.ReturnValue)
If ReconfUserName() Then .Value(Name_LabelsName) = LabelsString
.Add(Name_TrueUserName, TrueUserName)
.Add(Name_TrueBoardName, TrueBoardName)
.Add(Name_IsUser, IsUser.BoolToInteger)
@@ -128,7 +134,7 @@ Namespace API.Pinterest
Dim j As EContainer, jj As EContainer
Dim rootNode$() = {"resource_response", "data"}
Dim jErr As New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue)
Dim urls As List(Of String) = GetDataFromGalleryDL(URL, True)
Dim urls As List(Of String) = GetDataFromGalleryDL(URL, True, Token)
If urls.ListExists Then urls.RemoveAll(Function(__url) Not __url.Contains("BoardsResource/get/"))
If urls.ListExists Then
ProgressPre.ChangeMax(urls.Count)
@@ -177,7 +183,7 @@ Namespace API.Pinterest
Dim images As List(Of Sizes)
Dim imgSelector As Func(Of EContainer, Sizes) = Function(img) New Sizes(img.Value("width"), img.Value("url"))
Dim fullData As Predicate(Of EContainer) = Function(e) e.Count > 5
Dim l As List(Of String) = GetDataFromGalleryDL(Board.URL, False)
Dim l As List(Of String) = GetDataFromGalleryDL(Board.URL, False, Token)
If l.ListExists Then l.RemoveAll(Function(ll) Not ll.Contains("BoardFeedResource/get/"))
If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
@@ -253,8 +259,8 @@ Namespace API.Pinterest
Private Class GDLBatch : Inherits GDL.GDLBatch
Private ReadOnly Property Source As UserData
Private ReadOnly IsBoardsRequested As Boolean
Friend Sub New(ByRef s As UserData, ByVal IsBoardsRequested As Boolean)
MyBase.New
Friend Sub New(ByRef s As UserData, ByVal IsBoardsRequested As Boolean, ByVal _Token As CancellationToken)
MyBase.New(_Token)
Source = s
Me.IsBoardsRequested = IsBoardsRequested
End Sub
@@ -269,22 +275,24 @@ Namespace API.Pinterest
Protected Overrides Async Function Validate(ByVal Value As String) As Task
If IsBoardsRequested Then
If ErrorOutputData.Count > 0 Then
If Await Task.Run(Of Boolean)(Function() ErrorOutputData.Exists(Function(ee) Not ee.IsEmptyString AndAlso
If Await Task.Run(Of Boolean)(Function() Token.IsCancellationRequested OrElse
ErrorOutputData.Exists(Function(ee) Not ee.IsEmptyString AndAlso
ee.StartsWith(UrlTextStart))) Then Kill()
End If
Else
If Await Task.Run(Of Boolean)(Function() Not Value.IsEmptyString AndAlso
Source._TempPostsList.Exists(Function(v) Value.Contains(v))) Then Kill()
If Await Task.Run(Of Boolean)(Function() Token.IsCancellationRequested OrElse
(Not Value.IsEmptyString AndAlso
Source._TempPostsList.Exists(Function(v) Value.Contains(v)))) Then Kill()
End If
End Function
End Class
Private Function GetDataFromGalleryDL(ByVal URL As String, ByVal IsBoardsRequested As Boolean) As List(Of String)
Private Function GetDataFromGalleryDL(ByVal URL As String, ByVal IsBoardsRequested As Boolean, ByVal Token As CancellationToken) As List(Of String)
Dim command$ = $"gallery-dl --verbose --simulate "
Try
If Not URL.IsEmptyString Then
If MySettings.CookiesNetscapeFile.Exists Then command &= $"--cookies ""{MySettings.CookiesNetscapeFile}"" "
command &= URL
Using batch As New GDLBatch(Me, IsBoardsRequested)
Using batch As New GDLBatch(Me, IsBoardsRequested, Token)
Return GetUrlsFromGalleryDl(batch, command)
End Using
End If

View File

@@ -6,6 +6,7 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Text.RegularExpressions
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.PornHub
Friend Module Declarations
@@ -15,17 +16,11 @@ Namespace API.PornHub
#Region "Declarations video"
Friend ReadOnly RegexVideo_FlashVarsBlocks As RParams = RParams.DM("(?<=(flashvars_\['[nN]ext[vV]ideo'\]|flashvars_\d+[^ ]+? = media_\d+?);[\r\n]*?)(.+?)(?=;flashvars_\d+?)",
0, RegexReturn.List, EDP.ReturnValue)
'TODELETE: PornHub old 'RegexVideo_FlashVarsBlock' declaration
'Friend ReadOnly RegexVideo_FlashVarsBlock As RParams = RParams.DM("(?<=flashvars_\['[nN]ext[vV]ideo'\];[\r\n]*?)(.+?)(?=;flashvars_\d+?)", 0, EDP.ReturnValue)
Friend ReadOnly RegexVideo_FlashVars_Vars As RParams = RParams.DM("var ([\w\d]{10,})=("".+?)(?=(;|\Z))", 0, RegexReturn.List)
Friend ReadOnly RegexVideo_FlashVars_Compiler As RParams = RParams.DM("(?<=\*/)([\w\d\S]{10,})", 0, RegexReturn.List)
Friend ReadOnly RegexVideo_FlashVars_UrlResolution As RParams = RParams.DMS("/(\d+)[^/]+\.mp4", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideo_Video_All As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""",
0, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter)
Friend ReadOnly RegexVideo_Video_Wrong As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""[\w\W\s\r\n]+?(?=\<div class=""videoUploaderBlock)",
0, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter)
Private ReadOnly RegexVideo_Video_Wrong_Option As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""[\w\W\s\r\n]+?", 0, RegexReturn.ListByMatch)
Friend ReadOnly RegexVideo_Video_Wrong_Fields As RField() = {New RField(New RFieldOption(1, RegexVideo_Video_Wrong_Option)), New RField(New RFieldOption(2, RegexVideo_Video_Wrong_Option))}
Friend ReadOnly RegexUserVideos As RParams = RParams.DM("(\<li class=""pcVideoListItem)((?:(?!/li\>).)*?)(\<div.class=.private-vid-title((?:(?!/li\>).)*?)|)(\<a.href=.([^""]+?)"".title=.([^""]*?)"")(((?:(?!/li\>).)+?)(\<div class=.videoUploaderBlock)|)((?:(?!/li\>).)*?)(\</li\>)",
0, RegexOptions.Singleline, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter)
Friend ReadOnly RegexVideo_Video_VideoKey As RParams = RParams.DMS("viewkey=([\w\d]+)", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideoPageTitle As RParams = RParams.DMS("meta (property|name)=""[^:]+?:title"" content=""([^""]+)""", 2, EDP.ReturnValue)
#End Region

View File

@@ -27,6 +27,14 @@ Namespace API.PornHub
End Property
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML>
Friend Property DownloadUHD As PropertyValue
<PropertyOption(ControlText:="Download uploaded", ControlToolTip:="Download uploaded videos"), PXML>
Friend Property DownloadUploaded As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged videos"), PXML>
Friend Property DownloadTagged As PropertyValue
<PropertyOption(ControlText:="Download private", ControlToolTip:="Download private videos"), PXML>
Friend Property DownloadPrivate As PropertyValue
<PropertyOption(ControlText:="Download favorite", ControlToolTip:="Download favorite videos"), PXML>
Friend Property DownloadFavorite As PropertyValue
<PropertyOption(ControlText:="Download GIF", ControlToolTip:="Default for new users", ThreeStates:=True), PXML>
Friend ReadOnly Property DownloadGifs As PropertyValue
<PropertyOption(ControlText:="Download GIFs as mp4", ControlToolTip:="Download gifs in 'mp4' format instead of native 'webm'"), PXML>
@@ -35,7 +43,7 @@ Namespace API.PornHub
ControlToolTip:="Download photo only from ModelHub. Prornstar photos hosted on PornHub itself will not be downloaded." & vbCr &
"Attention! Downloading photos hosted on PornHub is a very heavy job."), PXML>
Friend ReadOnly Property DownloadPhotoOnlyFromModelHub As PropertyValue
<PropertyOption(ControlText:="Saved posts user", ControlToolTip:="Personal profile username"), PXML>
<PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip), PXML>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
#End Region
#Region "Initializer"
@@ -44,14 +52,19 @@ Namespace API.PornHub
With Responser : .CurlSslNoRevoke = True : .CurlInsecure = True : End With
DownloadUHD = New PropertyValue(False)
DownloadUploaded = New PropertyValue(True)
DownloadTagged = New PropertyValue(False)
DownloadPrivate = New PropertyValue(False)
DownloadFavorite = New PropertyValue(False)
DownloadGifsAsMp4 = New PropertyValue(True)
DownloadGifs = New PropertyValue(CInt(CheckState.Indeterminate), GetType(Integer))
DownloadPhotoOnlyFromModelHub = New PropertyValue(True)
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
_SubscriptionsAllowed = True
UrlPatternUser = "https://www.pornhub.com/{0}/{1}"
UserRegex = RParams.DMS("pornhub.com/([^/]+)/([^/]+).*?", 0, RegexReturn.ListByMatch)
ImageVideoContains = "pornhub"
UserRegex = RParams.DMS("pornhub.com/(model|user[s]?|pornstar|channel[s]?)/([^/]+).*?", 0, RegexReturn.ListByMatch)
ImageVideoContains = "pornhub.com"
End Sub
#End Region
#Region "GetInstance"
@@ -67,11 +80,17 @@ Namespace API.PornHub
End Function
#End Region
#Region "IsMyUser"
Private ReadOnly NonUserRegex As RParams = RParams.DM("(?<=pornhub.com/)((.+?)(?=[\?&]{1}page=\d+)|(.+))", 0, EDP.ReturnValue)
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Try
If Not UserURL.IsEmptyString Then
If Not UserURL.IsEmptyString AndAlso UserURL.ToLower.Contains("pornhub.com") Then
Dim alist As List(Of String) = RegexReplace(UserURL.ToLower, UserRegex)
If alist.ListExists(3) Then Return New ExchangeOptions(Site, $"{alist(1)}_{alist(2)}")
If alist.ListExists(3) Then
Return New ExchangeOptions(Site, $"{alist(1)}_{alist(2)}")
Else
Dim opt$ = RegexReplace(UserURL, NonUserRegex)
If Not opt.IsEmptyString Then Return New ExchangeOptions(Site, opt.StringRemoveWinForbiddenSymbols) With {.Options = opt}
End If
End If
Return Nothing
Catch ex As Exception
@@ -81,7 +100,13 @@ Namespace API.PornHub
#End Region
#Region "GetUserUrl"
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
With DirectCast(User, UserData) : Return String.Format(UrlPatternUser, .PersonType, .NameTrue) : End With
With DirectCast(User, UserData)
If .IsUser Then
Return String.Format(UrlPatternUser, .PersonType, .NameTrue)
Else
Return .GetNonUserUrl(0)
End If
End With
End Function
#End Region
#Region "User options"

View File

@@ -21,11 +21,15 @@ Namespace API.PornHub
#Region "XML names"
Private Const Name_PersonType As String = "PersonType"
Private Const Name_NameTrue As String = "NameTrue"
Private Const Name_VideoPageModel As String = "VideoPageModel"
Private Const Name_PhotoPageModel As String = "PhotoPageModel"
Private Const Name_DownloadUHD As String = "DownloadUHD"
Private Const Name_DownloadUploaded As String = "DownloadUploaded"
Private Const Name_DownloadTagged As String = "DownloadTagged"
Private Const Name_DownloadPrivate As String = "DownloadPrivate"
Private Const Name_DownloadFavorite As String = "DownloadFavorite"
Private Const Name_DownloadGifs As String = "DownloadGifs"
Private Const Name_DownloadPhotoOnlyFromModelHub As String = "DownloadPhotoOnlyFromModelHub"
Private Const Name_IsUser As String = "IsUser"
#End Region
#Region "Structures"
Private Structure FlashVar : Implements IRegExCreator
@@ -50,18 +54,31 @@ Namespace API.PornHub
Friend URL As String
Friend ID As String
Friend Title As String
Friend Function ToUserMedia() As UserMedia
Friend Type As VideoTypes
Friend Function ToUserMedia(Optional ByVal SpecialFolder As String = Nothing) As UserMedia
Return New UserMedia(URL, UTypes.VideoPre) With {
.File = If(Title.IsEmptyString, .File, New SFile($"{Title}.mp4")),
.Post = ID
.Post = ID,
.SpecialFolder = SpecialFolder
}
End Function
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists Then
If ParamsArray.ListExists(4) Then
URL = ParamsArray(0)
ID = RegexReplace(URL, RegexVideo_Video_VideoKey)
If ID.IsEmptyString Then
URL = String.Empty
Else
URL = String.Format(UrlPattern, URL.TrimStart("/"))
Title = TitleHtmlConverter(ParamsArray(1))
If Not ParamsArray(2).IsEmptyString Then
Type = VideoTypes.Private
ElseIf Not ParamsArray(3).IsEmptyString Then
Type = VideoTypes.Tagged
Else
Type = VideoTypes.Uploaded
End If
End If
End If
Return Me
End Function
@@ -82,21 +99,24 @@ Namespace API.PornHub
End Structure
#End Region
#Region "Enums"
Friend Enum VideoPageModels As Integer
[Default] = 0
ConcatPage = 1
Favorite = 2
Undefined = -1
End Enum
Private Enum PhotoPageModels As Integer
Undefined = 0
PornHubPage = 1
ModelHubPage = 2
End Enum
Private Enum VideoTypes
Undefined
Uploaded
[Private]
Tagged
Favorite
End Enum
#End Region
#Region "Constants"
Private Const PersonTypeModel As String = "model"
Friend Const PersonTypeUser As String = "users"
Private Const PersonTypeUser As String = "users"
Private Const PersonTypePornstar As String = "pornstar"
Private Const PersonTypeCannel As String = "channels"
#End Region
#Region "Person"
Friend Property PersonType As String
@@ -111,11 +131,37 @@ Namespace API.PornHub
End Property
#End Region
#Region "Advanced fields"
Friend Property VideoPageModel As VideoPageModels = VideoPageModels.Undefined
Friend Overrides ReadOnly Property FeedIsUser As Boolean
Get
Return IsUser
End Get
End Property
Private Property PhotoPageModel As PhotoPageModels = PhotoPageModels.Undefined
Friend Property DownloadUHD As Boolean = False
Friend Property DownloadUploaded As Boolean = True
Friend Property DownloadTagged As Boolean = False
Friend Property DownloadPrivate As Boolean = False
Friend Property DownloadFavorite As Boolean = False
Friend Property DownloadGifs As Boolean
Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True
Friend Property IsUser As Boolean = True
Friend Property QueryString As String
Get
If IsUser Then
Return String.Empty
Else
Return GetNonUserUrl(0)
End If
End Get
Set(ByVal q As String)
UpdateUserOptions(True, q)
End Set
End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {SearchRequestLabelName}
End Get
End Property
#End Region
#Region "ExchangeOptions"
Friend Overrides Function ExchangeOptionsGet() As Object
@@ -125,8 +171,13 @@ Namespace API.PornHub
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions)
DownloadUHD = .DownloadUHD
DownloadUploaded = .DownloadUploaded
DownloadTagged = .DownloadTagged
DownloadPrivate = .DownloadPrivate
DownloadFavorite = .DownloadFavorite
DownloadGifs = .DownloadGifs
DownloadPhotoOnlyFromModelHub = .DownloadPhotoOnlyFromModelHub
QueryString = .QueryString
End With
End If
End Sub
@@ -136,96 +187,131 @@ Namespace API.PornHub
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
Private ReadOnly LastPageIDs As List(Of String)
#End Region
#Region "Initializer, loader"
#Region "Initializer"
Friend Sub New()
LastPageIDs = New List(Of String)
UseInternalM3U8Function = True
UseClientTokens = True
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
Dim SetNames As Action = Sub()
If Not Name.IsEmptyString And NameTrue.IsEmptyString Then
#End Region
#Region "Loader"
Private Function UpdateUserOptions(Optional ByVal Force As Boolean = False, Optional ByVal NewUrl As String = Nothing) As Boolean
If Not Force OrElse (Not IsUser AndAlso Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then
Dim eObj As Plugin.ExchangeOptions = Nothing
If Force Then eObj = MySettings.IsMyUser(NewUrl)
If (Force And Not eObj.UserName.IsEmptyString) Or (Not Force And Not Name.IsEmptyString And NameTrue.IsEmptyString) Then
If Not If(Force, eObj.Options, Options).IsEmptyString Then
If IsUser And Force Then
Return False
Else
IsUser = False
Options = If(Force, eObj.Options, Options)
NameTrue = Options
If Not Force Then
Settings.Labels.Add(SearchRequestLabelName)
Labels.ListAddValue(SearchRequestLabelName, LNC)
Labels.Sort()
Return True
End If
End If
Else
IsUser = True
Dim n$() = Name.Split("_")
If n.ListExists(2) Then
NameTrue = Name.Replace($"{n(0)}_", String.Empty)
PersonType = n(0)
If (PersonType = PersonTypeModel Or PersonType = PersonTypeUser) And
VideoPageModel = VideoPageModels.Undefined Then VideoPageModel = VideoPageModels.Default
End If
End If
End Sub
End If
End If
Return False
End Function
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
PersonType = .Value(Name_PersonType)
NameTrue = .Value(Name_NameTrue)
VideoPageModel = .Value(Name_VideoPageModel).FromXML(Of Integer)(VideoPageModels.Undefined)
PhotoPageModel = .Value(Name_PhotoPageModel).FromXML(Of Integer)(PhotoPageModels.Undefined)
DownloadUHD = .Value(Name_DownloadUHD).FromXML(Of Boolean)(False)
DownloadUploaded = .Value(Name_DownloadUploaded).FromXML(Of Boolean)(True)
DownloadTagged = .Value(Name_DownloadTagged).FromXML(Of Boolean)(False)
DownloadPrivate = .Value(Name_DownloadPrivate).FromXML(Of Boolean)(False)
DownloadFavorite = .Value(Name_DownloadFavorite).FromXML(Of Boolean)(False)
DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False)
DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True)
SetNames.Invoke()
IsUser = .Value(Name_IsUser).FromXML(Of Boolean)(True)
UpdateUserOptions()
Else
SetNames.Invoke()
If UpdateUserOptions() Then .Value(Name_LabelsName) = LabelsString
.Add(Name_PersonType, PersonType)
.Add(Name_NameTrue, NameTrue)
.Add(Name_VideoPageModel, CInt(VideoPageModel))
.Add(Name_PhotoPageModel, CInt(PhotoPageModel))
.Add(Name_DownloadUHD, DownloadUHD.BoolToInteger)
.Add(Name_DownloadUploaded, DownloadUploaded.BoolToInteger)
.Add(Name_DownloadTagged, DownloadTagged.BoolToInteger)
.Add(Name_DownloadPrivate, DownloadPrivate.BoolToInteger)
.Add(Name_DownloadFavorite, DownloadFavorite.BoolToInteger)
.Add(Name_DownloadGifs, DownloadGifs.BoolToInteger)
.Add(Name_DownloadPhotoOnlyFromModelHub, DownloadPhotoOnlyFromModelHub.BoolToInteger)
.Add(Name_IsUser, IsUser.BoolToInteger)
'Debug.WriteLine(GetNonUserUrl(0))
'Debug.WriteLine(GetNonUserUrl(2))
End If
End With
End Sub
#End Region
#Region "Downloading"
#Region "Download override"
Private Const DataDownloaded As Integer = -10
Private Const DataDownloaded_NotFound As Integer = -20
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
Responser.ResetStatus()
If PersonType = PersonTypeUser Then Responser.Mode = Responser.Modes.Curl
If IsSavedPosts Then
VideoPageModel = VideoPageModels.Favorite
PersonType = PersonTypeUser
NameTrue = MySettings.SavedPostsUserName.Value
End If
Dim page% = 1
Dim __continue As Boolean = True
Dim __videoDone As Boolean = False
Dim d%
Dim limit% = If(DownloadTopCount, -1)
If DownloadVideos Then
If PersonType = PersonTypeUser Then Responser.Mode = Responser.Modes.Curl : Responser.Method = "POST"
If VideoPageModel = VideoPageModels.Undefined Then
__continue = False
d = DownloadUserVideos(page, Token)
Select Case d
Case DataDownloaded : __continue = True : page += 1
Case 1 : VideoPageModel = VideoPageModels.ConcatPage
Case EXCEPTION_OPERATION_CANCELED : ThrowAny(Token)
Case DataDownloaded_NotFound : __videoDone = True
End Select
If Not __continue And Not __videoDone Then
d = DownloadUserVideos(page, Token)
Select Case d
Case DataDownloaded : __continue = True : page += 1
Case 1 : VideoPageModel = VideoPageModels.Undefined
Case EXCEPTION_OPERATION_CANCELED : ThrowAny(Token)
Case DataDownloaded_NotFound : __videoDone = True
End Select
If IsSavedPosts Or Not IsUser Or PersonType = PersonTypeUser Then
DownloadUserVideos(1, VideoTypes.Favorite, False, Token)
Else
If DownloadUploaded Then
LastPageIDs.Clear()
DownloadUserVideos(1, VideoTypes.Uploaded, False, Token)
End If
If DownloadTagged Then
LastPageIDs.Clear()
Dim lBefore% = _TempMediaList.Count
DownloadUserVideos(1, VideoTypes.Tagged, False, Token)
If PersonType = PersonTypePornstar And lBefore = _TempMediaList.Count Then
LastPageIDs.Clear()
DownloadUserVideos(1, VideoTypes.Tagged, True, Token)
End If
End If
If __continue And Not __videoDone Then
Do While DownloadUserVideos(page, Token) = DataDownloaded And page < 100 : page += 1 : Loop
If DownloadPrivate Then
LastPageIDs.Clear()
DownloadUserVideos(1, VideoTypes.Private, False, Token)
End If
If DownloadFavorite Then
LastPageIDs.Clear()
DownloadUserVideos(1, VideoTypes.Favorite, False, Token)
End If
If _TempMediaList.Count > 0 Then _TempMediaList.RemoveAll(Function(m) Not m.Type = UTypes.m3u8 And Not m.Type = UTypes.VideoPre)
End If
Responser.Method = "GET"
If DownloadGifs And Not IsSavedPosts Then DownloadUserGifs(Token)
If DownloadImages Then DownloadUserPhotos(Token)
If _TempMediaList.Count > 0 Then
_TempMediaList.RemoveAll(Function(m) Not m.Type = UTypes.m3u8 And Not m.Type = UTypes.VideoPre)
If limit > 0 And _TempMediaList.Count > limit Then _TempMediaList.ListAddList(_TempMediaList.ListTake(-1, limit), LAP.ClearBeforeAdd)
End If
End If
If DownloadGifs And Not IsSavedPosts And Not IsSubscription And IsUser Then DownloadUserGifs(Token)
If DownloadImages And Not IsSubscription And IsUser Then DownloadUserPhotos(Token)
Finally
Responser.Mode = Responser.Modes.Default
Responser.Method = "GET"
@@ -234,72 +320,100 @@ Namespace API.PornHub
End Sub
#End Region
#Region "Download video"
Private ReadOnly Property VideoPageType As String
Get
Select Case VideoPageModel
Case VideoPageModels.Default : Return "/videos/upload"
Case VideoPageModels.Favorite : Return "/videos/favorites/"
Case Else : Return String.Empty
End Select
End Get
End Property
Private ReadOnly Property VideoPageAppender As String
Get
Return If(PersonType = PersonTypeUser, "ajax?o=newest&page=", String.Empty)
End Get
End Property
Private Overloads Function DownloadUserVideos(ByVal Page As Integer, ByVal Token As CancellationToken) As Integer
Const VideoUrlPattern$ = "https://www.pornhub.com/{0}/{1}{2}{3}"
Const HtmlPageNotFoundVideo$ = "<span>Error Page Not Found</span>"
Friend Function GetNonUserUrl(ByVal Page As Integer) As String
If IsUser Then
Return String.Empty
Else
Dim url$ = $"https://www.pornhub.com/{Options}"
If Page > 1 Then
If url.Contains("?") Then
url &= $"&page={Page}"
Else
url = url.TrimEnd("/")
url &= $"?page={Page}"
End If
End If
Return url
End If
End Function
Private Sub DownloadUserVideos(ByVal Page As Integer, ByVal Type As VideoTypes, ByVal SecondMode As Boolean, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
ProgressPre.ChangeMax(1)
Try
Dim p$
If PersonType = PersonTypeUser Then
p = Page
Dim specFolder$ = String.Empty
Dim tryNextPage As Boolean = False
Dim limit% = If(DownloadTopCount, -1)
If IsUser Then
URL = $"https://www.pornhub.com/{PersonType}/{NameTrue}"
If Type = VideoTypes.Uploaded Then
URL &= "/videos/upload"
ElseIf Type = VideoTypes.Tagged Then
If Not SecondMode Then URL &= "/videos"
specFolder = "Tagged"
ElseIf Type = VideoTypes.Private Then
URL &= "/videos/private"
specFolder = "Private"
ElseIf Type = VideoTypes.Favorite Then
URL &= "/videos/favorites"
If Not PersonType = PersonTypeUser Then specFolder = "Favorite"
Else
p = IIf(Page = 1, String.Empty, $"?page={Page}")
Throw New ArgumentException($"Type '{Type}' is not implemented in the video download function", "Type")
End If
If Page > 1 Then URL &= $"?page={Page}"
Else
URL = GetNonUserUrl(Page)
End If
URL = $"{String.Format(VideoUrlPattern, PersonType, NameTrue, VideoPageType, VideoPageAppender)}{p}"
ThrowAny(Token)
'Debug.WriteLine(URL)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
If PersonType = PersonTypeUser And r.Contains(HtmlPageNotFoundVideo) Then Return DataDownloaded_NotFound
Dim l As List(Of UserVideo) = RegexFields(Of UserVideo)(r, {RegexVideo_Video_All}, {1, 2})
Dim lw As List(Of UserVideo) = Nothing
If Not PersonType = PersonTypeUser Then lw = RegexFields(Of UserVideo)(r, {RegexVideo_Video_Wrong}, RegexVideo_Video_Wrong_Fields)
Dim l As List(Of UserVideo) = RegexFields(Of UserVideo)(r, {RegexUserVideos}, {6, 7, 3, 10})
If l.ListExists Then l = l.ListTake(3, l.Count).ToList
If l.ListExists Then
If lw.ListExists Then l.ListWithRemove(lw)
If IsUser Then
If Type = VideoTypes.Favorite Then
l.RemoveAll(Function(uv) uv.Type = VideoTypes.Private)
ElseIf Not PersonType = PersonTypeCannel Then
l.RemoveAll(Function(uv) Not uv.Type = Type)
End If
End If
If l.Count > 0 Then l.RemoveAll(Function(uv) uv.ID.IsEmptyString Or uv.URL.IsEmptyString)
If l.Count > 0 Then
Dim lBefore% = l.Count
Dim nonLastPageDetected As Boolean = False
Dim newLastPageIDs As New List(Of String)
l.RemoveAll(Function(ByVal uv As UserVideo) As Boolean
If Not _TempPostsList.Contains(uv.ID) Then
_TempPostsList.Add(uv.ID)
newLastPageIDs.Add(uv.ID)
Return False
Else
If Not LastPageIDs.Contains(uv.ID) Then nonLastPageDetected = True
'Debug.WriteLine($"[REMOVED]: {uv.Title}")
Return True
End If
End Function)
If l.Count > 0 Then _TempMediaList.ListAddList(l.Select(Function(uv) uv.ToUserMedia))
If l.Count = lBefore And l.Count > 0 Then Return DataDownloaded
'Debug.WriteLineIf(l.Count > 0, l.Select(Function(ll) ll.Title).ListToString(vbNewLine))
If l.Count > 0 Then _TempMediaList.ListAddList(l.Select(Function(uv) uv.ToUserMedia(specFolder)))
LastPageIDs.Clear()
If newLastPageIDs.Count > 0 Then LastPageIDs.AddRange(newLastPageIDs) : newLastPageIDs.Clear()
If l.Count > 0 AndAlso (l.Count = lBefore Or Not nonLastPageDetected) AndAlso
Not (limit > 0 And _TempMediaList.Count >= limit) Then tryNextPage = True
End If
End If
End If
Return DataDownloaded_NotFound
If tryNextPage Then DownloadUserVideos(Page + 1, Type, SecondMode, Token)
Catch regex_ex As RegexFieldsTextBecameNullException
If PersonType = PersonTypeUser Or IsSavedPosts Then
Return DataDownloaded_NotFound
Else
Return ProcessException(regex_ex, Token, $"videos downloading error [{URL}]")
End If
If Not IsSavedPosts Then MyMainLOG = $"{ToStringForLog()}: videos not found. You may need to update your credentials."
Catch ex As Exception
Return ProcessException(ex, Token, $"videos downloading error [{URL}]")
ProcessException(ex, Token, $"videos downloading error [{URL}]")
Finally
ProgressPre.Perform()
End Try
End Function
End Sub
#End Region
#Region "Download GIF"
Private Sub DownloadUserGifs(ByVal Token As CancellationToken)
@@ -393,7 +507,7 @@ Namespace API.PornHub
URL = String.Format(PhotoUrlPattern_ModelHub, NameTrue)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_ModelHub_PhotoBlocks}, {1, 2})
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_ModelHub_PhotoBlocks}, {1, 2}, EDP.ReturnValue)
If l.ListExists Then l.RemoveAll(Function(ll) ll.Data.IsEmptyString)
If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
@@ -431,7 +545,7 @@ Namespace API.PornHub
Dim page%
Dim r$ = Responser.GetResponse(String.Format(PhotoUrlPattern_PornHub, PersonType, NameTrue))
If Not r.IsEmptyString Then
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_PornHub_PhotoBlocks}, {2, 1})
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_PornHub_PhotoBlocks}, {2, 1}, EDP.ReturnValue)
If l.ListExists Then l.RemoveAll(Function(ll) ll.AlbumID.IsEmptyString)
If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
@@ -539,16 +653,20 @@ Namespace API.PornHub
End If
Return False
Catch ex As Exception
Return ProcessException(ex, Token, $"photos downloading error [{URL}]")
Return ProcessException(ex, Token, $"photos downloading error [{URL}]") = 1
End Try
End Function
#End Region
#End Region
#Region "ReparseVideo"
Protected Overloads Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
If IsSubscription Then
ReparseVideoSubscriptions(Token)
Else
ReparseVideo(Token, False)
End If
End Sub
Protected Overloads Sub ReparseVideo(ByVal Token As CancellationToken, ByVal CreateFileName As Boolean,
Private Overloads Sub ReparseVideo(ByVal Token As CancellationToken, ByVal CreateFileName As Boolean,
Optional ByRef Data As IYouTubeMediaContainer = Nothing)
Const ERR_NEW_URL$ = "ERR_NEW_URL"
Dim URL$ = String.Empty
@@ -600,6 +718,54 @@ Namespace API.PornHub
ProcessException(ex, Token, "video reparsing error", False)
End Try
End Sub
Private Sub ReparseVideoSubscriptions(ByVal Token As CancellationToken)
Try
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
Dim m As UserMedia
Dim r$, URL$, tmpName$, thumb$
Dim c% = 0
Dim rErr As New ErrorsDescriber(EDP.ReturnValue)
Progress.Maximum += _TempMediaList.Count
For i% = _TempMediaList.Count - 1 To 0 Step -1
Progress.Perform()
If _TempMediaList(i).Type = UTypes.VideoPre Then
If Not DownloadTopCount.HasValue OrElse c <= DownloadTopCount.Value Then
m = _TempMediaList(i)
ThrowAny(Token)
Try
URL = m.URL_BASE
r = Responser.GetResponse(URL,, rErr)
If Not r.IsEmptyString Then
m.Type = UTypes.m3u8
thumb = RegexReplace(r, Regex_VideosThumb_OG_IMAGE)
If Not thumb.IsEmptyString Then m.URL = thumb
tmpName = RegexReplace(r, RegexVideoPageTitle)
If Not tmpName.IsEmptyString Then
m.File.Name = TitleHtmlConverter(tmpName)
m.File.Extension = "mp4"
m.PictureOption = tmpName
End If
_TempMediaList(i) = m
c += 1
Else
_TempMediaList.RemoveAt(i)
End If
Catch mid_ex As Exception
_TempMediaList.RemoveAt(i)
End Try
Else
_TempMediaList.RemoveAt(i)
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "subscriptions video reparsing error", False)
End Try
End Sub
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
@@ -646,33 +812,6 @@ Namespace API.PornHub
End Function
#End Region
#Region "CreateVideoURL"
'TODELETE: PornHub old 'CreateVideoURL' function
'Private Function CreateVideoURL(ByVal r As String) As String
' Try
' Dim OutStr$ = String.Empty
' If Not r.IsEmptyString Then
' Dim _VarBlock$ = RegexReplace(r, RegexVideo_FlashVarsBlock)
' If Not _VarBlock.IsEmptyString Then
' Dim vars As List(Of FlashVar) = RegexFields(Of FlashVar)(_VarBlock, {RegexVideo_FlashVars_Vars}, {1, 2})
' Dim compiler As List(Of String) = RegexReplace(_VarBlock, RegexVideo_FlashVars_Compiler)
' If vars.ListExists And compiler.ListExists Then
' Dim v$
' Dim i%
' For Each var$ In compiler
' i = vars.IndexOf(var)
' If i >= 0 Then
' v = vars(i).Value
' If Not v.IsEmptyString Then OutStr &= v
' End If
' Next
' End If
' End If
' End If
' Return OutStr
' Catch ex As Exception
' Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)
' End Try
'End Function
Private Function CreateVideoURL(ByVal r As String) As String
Try
Dim OutStr$ = String.Empty
@@ -705,8 +844,8 @@ Namespace API.PornHub
End If
End If
If outList.Count > 0 Then outList.RemoveAll(Function(u) u.IsEmptyString)
If outList.Count > 0 Then
If OutList.Count > 0 Then OutList.RemoveAll(Function(u) u.IsEmptyString)
If OutList.Count > 0 Then
i = OutList.FindIndex(Function(u) u.Contains("urlset"))
If i >= 0 Then
OutStr = OutList(i)
@@ -728,6 +867,9 @@ Namespace API.PornHub
End If
OutList.Clear()
Return OutStr
Catch regex_ex As RegexFieldsTextBecameNullException
MyMainLOG = $"{ToStringForLog()}: something is wrong when parsing flashvars.{vbCr}{regex_ex.Message}"
Return String.Empty
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)
End Try
@@ -753,6 +895,12 @@ Namespace API.PornHub
Return 0
End If
End Function
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then LastPageIDs.Clear()
MyBase.Dispose(disposing)
End Sub
#End Region
End Class
End Namespace

View File

@@ -8,9 +8,17 @@
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes
Namespace API.PornHub
Friend Class UserExchangeOptions
Friend Class UserExchangeOptions : Inherits Xhamster.UserExchangeOptions
<PSetting(NameOf(SiteSettings.DownloadUHD), NameOf(MySettings))>
Friend Property DownloadUHD As Boolean
<PSetting(NameOf(SiteSettings.DownloadUploaded), NameOf(MySettings))>
Friend Property DownloadUploaded As Boolean
<PSetting(NameOf(SiteSettings.DownloadTagged), NameOf(MySettings))>
Friend Property DownloadTagged As Boolean
<PSetting(NameOf(SiteSettings.DownloadPrivate), NameOf(MySettings))>
Friend Property DownloadPrivate As Boolean
<PSetting(NameOf(SiteSettings.DownloadFavorite), NameOf(MySettings))>
Friend Property DownloadFavorite As Boolean
<PSetting(Caption:="Download gifs")>
Friend Property DownloadGifs As Boolean
<PSetting(NameOf(SiteSettings.DownloadPhotoOnlyFromModelHub), NameOf(MySettings), Caption:="Download photo only from ModelHub")>
@@ -18,13 +26,22 @@ Namespace API.PornHub
Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
DownloadUHD = u.DownloadUHD
DownloadUploaded = u.DownloadUploaded
DownloadTagged = u.DownloadTagged
DownloadPrivate = u.DownloadPrivate
DownloadFavorite = u.DownloadFavorite
DownloadGifs = u.DownloadGifs
DownloadPhotoOnlyFromModelHub = u.DownloadPhotoOnlyFromModelHub
QueryString = u.QueryString
MySettings = u.HOST.Source
End Sub
Friend Sub New(ByVal s As SiteSettings)
Dim v As CheckState = CInt(s.DownloadGifs.Value)
DownloadUHD = s.DownloadUHD.Value
DownloadUploaded = s.DownloadUploaded.Value
DownloadTagged = s.DownloadTagged.Value
DownloadPrivate = s.DownloadPrivate.Value
DownloadFavorite = s.DownloadFavorite.Value
DownloadGifs = Not v = CheckState.Unchecked
DownloadPhotoOnlyFromModelHub = s.DownloadPhotoOnlyFromModelHub.Value
MySettings = s

View File

@@ -0,0 +1,18 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Reddit
Friend Interface IChannelLimits
Property AutoGetLimits As Boolean
Property DownloadLimitCount As Integer?
Property DownloadLimitPost As String
Property DownloadLimitDate As Date?
Overloads Sub SetLimit(Optional ByVal Post As String = "", Optional ByVal Count As Integer? = Nothing, Optional ByVal [Date] As Date? = Nothing)
Overloads Sub SetLimit(ByVal Source As IChannelLimits)
End Interface
End Namespace

View File

@@ -75,6 +75,7 @@ Namespace API.Reddit
ProgressPre = New PreProgress(Progress)
Me.UsePreProgress = UsePreProgress
Cache = New CacheKeeper($"{OutFile.PathWithSeparator}_{Base.M3U8Base.TempCacheFolderName}\")
Cache.CacheDeleteError = Base.CacheDeletionError(Cache)
CacheFiles = Cache.NewInstance
End Sub
#Region "Internal functions"

View File

@@ -9,12 +9,16 @@
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports DownDetector = SCrawler.API.Base.DownDetector
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Reddit
<Manifest(RedditSiteKey), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Icons"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.RedditIcon_128
@@ -25,36 +29,85 @@ Namespace API.Reddit
Return My.Resources.SiteResources.RedditPic_512
End Get
End Property
<PropertyOption(ControlText:="Saved posts user", ControlToolTip:="Personal profile username"), PXML>
#End Region
#Region "Declarations"
#Region "Authorization"
<PropertyOption(ControlText:="Login", ControlToolTip:="Your authorization username", IsAuth:=True), PXML>
Friend ReadOnly Property AuthUserName As PropertyValue
<PropertyOption(ControlText:="Password", ControlToolTip:="Your authorization password", IsAuth:=True), PXML>
Friend ReadOnly Property AuthPassword As PropertyValue
<PropertyOption(ControlText:="Client ID", ControlToolTip:="Your registered app client ID", IsAuth:=True), PXML>
Friend ReadOnly Property ApiClientID As PropertyValue
<PropertyOption(ControlText:="Client Secret", ControlToolTip:="Your registered app client secret", IsAuth:=True), PXML>
Friend ReadOnly Property ApiClientSecret As PropertyValue
<PropertyOption(ControlText:="Bearer token",
ControlToolTip:="Bearer token (can be null)." & vbCr &
"If you are using cookies to download the timeline, it is highly recommended that you add a token." & vbCr &
"You can find different tokens in the responses. Make sure that bearer token belongs to Reddit and not RedGifs." & vbCr &
"There is not need to add a token if you are not using cookies to download the timeline.", IsAuth:=True)>
Friend ReadOnly Property BearerToken As PropertyValue
#Region "TokenUpdateInterval"
<PropertyOption(ControlText:="Token refresh interval", ControlToolTip:="Interval (in minutes) to refresh the token",
AllowNull:=False, LeftOffset:=120, IsAuth:=True), PXML>
Friend ReadOnly Property TokenUpdateInterval As PropertyValue
<Provider(NameOf(TokenUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider
#End Region
<PXML> Private ReadOnly Property BearerTokenDateUpdate As PropertyValue
<PropertyOption(ControlText:="Use the token to download the timeline", IsAuth:=True), PXML>
Friend ReadOnly Property UseTokenForTimelines As PropertyValue
<PropertyOption(ControlText:="Use the token to download saved posts", IsAuth:=True), PXML>
Friend ReadOnly Property UseTokenForSavedPosts As PropertyValue
<PropertyOption(ControlText:="Use cookies to download the timeline", IsAuth:=True), PXML>
Friend ReadOnly Property UseCookiesForTimelines As PropertyValue
<PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip, IsAuth:=True), PXML>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos"), PXML>
#End Region
#Region "Other"
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML>
Friend ReadOnly Property UseM3U8 As PropertyValue
#End Region
#End Region
#Region "Initializer"
Friend Sub New()
MyBase.New(RedditSite, "reddit.com")
Dim token$
With Responser
Dim d% = .Decoders.Count
.Decoders.ListAddList({SymbolsConverter.Converters.Unicode, SymbolsConverter.Converters.HTML}, LAP.NotContainsOnly)
If d <> .Decoders.Count Then .SaveSettings()
token = .Headers.Value(DeclaredNames.Header_Authorization)
End With
AuthUserName = New PropertyValue(String.Empty, GetType(String))
AuthPassword = New PropertyValue(String.Empty, GetType(String))
ApiClientID = New PropertyValue(String.Empty, GetType(String))
ApiClientSecret = New PropertyValue(String.Empty, GetType(String))
BearerToken = New PropertyValue(token, GetType(String), Sub(v) Responser.Headers.Add(DeclaredNames.Header_Authorization, v))
TokenUpdateInterval = New PropertyValue(60 * 12)
TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider
BearerTokenDateUpdate = New PropertyValue(Now.AddYears(-1))
UseTokenForTimelines = New PropertyValue(False)
UseTokenForSavedPosts = New PropertyValue(False)
UseCookiesForTimelines = New PropertyValue(False)
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
UseM3U8 = New PropertyValue(True)
UrlPatternUser = "https://www.reddit.com/{0}/{1}/"
ImageVideoContains = "reddit.com"
UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
End Sub
#End Region
#Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
Return New UserData
End Function
Friend Const ChannelOption As String = "r"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim l As List(Of String) = RegexReplace(UserURL, UserRegex)
If l.ListExists(3) Then
Dim n$ = l(2)
If Not l(1).IsEmptyString AndAlso l(1) = ChannelOption Then n &= $"@{ChannelOption}"
Return New ExchangeOptions(Site, n)
Else
Return Nothing
End If
#End Region
#Region "Available, UpdateRedGifsToken"
Friend Property SessionInterrupted As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If What = Download.Main Then Return Not SessionInterrupted Else Return True
End Function
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
Try
@@ -72,29 +125,40 @@ Namespace API.Reddit
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
dl.ListToString(vbCr) & vbCr & vbCr &
"Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes Then
UpdateRedGifsToken()
Return trueValue
If trueValue Then UpdateRedGifsToken()
Return trueValue AndAlso UpdateTokenIfRequired()
Else
Return False
End If
End If
End If
End If
UpdateRedGifsToken()
Return trueValue
If trueValue Then UpdateRedGifsToken()
Return trueValue AndAlso UpdateTokenIfRequired()
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True)
End Try
End Function
Friend Overrides Sub DownloadDone(ByVal What As Download)
SessionInterrupted = False
MyBase.DownloadDone(What)
End Sub
Private Sub UpdateRedGifsToken()
DirectCast(Settings(RedGifs.RedGifsSiteKey).Source, RedGifs.SiteSettings).UpdateTokenIfRequired()
End Sub
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange
If OpenForm Then
Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using
#End Region
#Region "IsMyUser, GetUserUrl, GetUserPostUrl"
Friend Const ChannelOption As String = "r"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim l As List(Of String) = RegexReplace(UserURL, UserRegex)
If l.ListExists(3) Then
Dim n$ = l(2)
If Not l(1).IsEmptyString AndAlso l(1) = ChannelOption Then n &= $"@{ChannelOption}"
Return New ExchangeOptions(Site, n)
Else
Return Nothing
End If
End Sub
End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
With DirectCast(User, UserData) : Return String.Format(UrlPatternUser, IIf(.IsChannel, ChannelOption, "user"), .TrueName) : End With
End Function
@@ -105,5 +169,90 @@ Namespace API.Reddit
Return String.Empty
End If
End Function
#End Region
#Region "UserOptions"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange
If OpenForm Then
Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
#End Region
#Region "BeginEdit, Update"
Private _OldTokenValue As String = String.Empty
Friend Overrides Sub BeginEdit()
_OldTokenValue = BearerToken.Value
MyBase.BeginEdit()
End Sub
Friend Overrides Sub Update()
If _SiteEditorFormOpened Then
Dim newTokenValue$ = BearerToken.Value
If Not newTokenValue.IsEmptyString AndAlso Not newTokenValue = _OldTokenValue Then BearerTokenDateUpdate.Value = Now
End If
MyBase.Update()
End Sub
#End Region
#Region "Token"
<PropertiesDataChecker({NameOf(AuthUserName), NameOf(AuthPassword), NameOf(ApiClientID), NameOf(ApiClientSecret)})>
Private Function TokenPropertiesChecker(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists Then
Dim wrong As New List(Of String)
For i% = 0 To p.Count - 1
If CStr(p(i).Value).IsEmptyString Then wrong.Add(p(i).Name)
Next
If wrong.Count > 0 Then
MsgBoxE({$"You have not completed the following fields: {wrong.ListToString}." & vbCr &
"To use OAuth authorization, all authorization fields must be filled in.", "Validate token fields"}, vbCritical)
Return False
Else
Return True
End If
End If
Return False
End Function
Private Function UpdateTokenIfRequired() As Boolean
If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso
{AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString) Then
If CDate(BearerTokenDateUpdate.Value).AddMinutes(TokenUpdateInterval.Value) <= Now Then Return UpdateToken()
End If
Return True
End Function
Private Overloads Function UpdateToken() As Boolean
Return UpdateToken(AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value)
End Function
<PropertyUpdater(NameOf(BearerToken), {NameOf(AuthUserName), NameOf(AuthPassword), NameOf(ApiClientID), NameOf(ApiClientSecret)})>
Private Overloads Function UpdateToken(ByVal UserName As String, ByVal Password As String, ByVal ClientID As String, ByVal ClientSecret As String) As Boolean
Try
Dim result As Boolean = True
If {UserName, Password, ClientID, ClientSecret}.All(Function(v) Not v.IsEmptyString) Then
result = False
Dim r$ = String.Empty
Using resp As New Responser With {
.Mode = Responser.Modes.Curl,
.Method = "POST",
.CurlArgumentsLeft = $"-d ""grant_type=password&username={UserName}&password={Password}"" --user ""{ClientID}:{ClientSecret}"""
}
r = resp.GetResponse("https://www.reddit.com/api/v1/access_token")
End Using
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
Dim newToken$ = j.Value("access_token")
If Not newToken.IsEmptyString Then
BearerToken.Value = $"Bearer {newToken}"
BearerTokenDateUpdate.Value = Now
Responser.SaveSettings()
result = True
End If
End If
End Using
End If
End If
Return result
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[Reddit.SiteSettings.UpdateToken]", False)
End Try
End Function
#End Region
End Class
End Namespace

View File

@@ -22,7 +22,7 @@ Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports CView = SCrawler.API.Reddit.IRedditView.View
Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit
Friend Class UserData : Inherits UserDataBase : Implements IChannelData, IRedditView
Friend Class UserData : Inherits UserDataBase : Implements IChannelLimits, IRedditView
#Region "XML names"
Private Const Name_TrueName As String = "TrueName"
#End Region
@@ -46,6 +46,11 @@ Namespace API.Reddit
End Property
Friend Property IsChannel As Boolean = False
Friend Property TrueName As String = String.Empty
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {CannelsLabelName, CannelsLabelName_ChannelsForm, UserLabelName}
End Get
End Property
#End Region
#Region "Channels Support"
#Region "IChannelLimits Support"
@@ -70,9 +75,9 @@ Namespace API.Reddit
#End Region
Friend Property ChannelInfo As Channel
Private ReadOnly ChannelPostsNames As List(Of String)
Friend Property SkipExistsUsers As Boolean = False Implements IChannelData.SkipExistsUsers
Friend Property SkipExistsUsers As Boolean = False
Private ReadOnly _ExistsUsersNames As List(Of String)
Friend Property SaveToCache As Boolean = False Implements IChannelData.SaveToCache
Friend Property SaveToCache As Boolean = False
Friend Function GetNewChannelPosts() As IEnumerable(Of UserPost)
If _ContentNew.Count > 0 Then Return (From c As UserMedia In _ContentNew
Where Not c.Post.CachedFile.IsEmptyString And c.State = UStates.Downloaded
@@ -127,7 +132,7 @@ Namespace API.Reddit
End Sub
#End Region
#Region "Load and Update user info"
Private Sub UpdateNames()
Private Function UpdateNames() As Boolean
If TrueName.IsEmptyString Then
Dim n$() = Name.Split("@")
If n.ListExists Then
@@ -145,9 +150,11 @@ Namespace API.Reddit
Settings.Labels.Add(l)
Labels.ListAddValue(l, LNC)
Labels.Sort()
Return True
End If
End If
End Sub
Return False
End Function
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
@@ -157,7 +164,7 @@ Namespace API.Reddit
TrueName = .Value(Name_TrueName)
UpdateNames()
Else
UpdateNames()
If UpdateNames() Then .Value(Name_LabelsName) = LabelsString
.Add(Name_ViewMode, CInt(ViewMode))
.Add(Name_ViewPeriod, CInt(ViewPeriod))
.Add(Name_IsChannel, IsChannel.BoolToInteger)
@@ -198,6 +205,15 @@ Namespace API.Reddit
End If
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
With MySiteSettings
If IsSavedPosts Then
If Not CBool(.UseTokenForSavedPosts.Value) Then Responser.Headers.Remove(DeclaredNames.Header_Authorization)
Else
If Not CBool(.UseCookiesForTimelines.Value) Then Responser.Cookies.Clear()
If Not CBool(.UseTokenForTimelines.Value) Then Responser.Headers.Remove(DeclaredNames.Header_Authorization)
End If
End With
_TotalPostsDownloaded = 0
If IsSavedPosts Then
Responser.DecodersError = EDP.ReturnValue
@@ -302,7 +318,7 @@ Namespace API.Reddit
End If
End Using
If POST.IsEmptyString And ExistsDetected Then Exit Sub
If Not PostID.IsEmptyString And NewPostDetected Then DownloadDataUser(PostID, Token)
If Not _PostID().IsEmptyString And NewPostDetected Then DownloadDataUser(_PostID(), Token)
End If
_completed = True
Catch ex As Exception
@@ -979,8 +995,13 @@ Namespace API.Reddit
UserSuspended = True
ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})"
Throw New Plugin.ExitException With {.Silent = True}
ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then
Return 1
ElseIf .StatusCode = HttpStatusCode.Unauthorized Then
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit credentials expired ({ToString()})"
MySiteSettings.SessionInterrupted = True
Throw New Plugin.ExitException With {.Silent = True}
ElseIf .StatusCode = HttpStatusCode.InternalServerError Then
If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1
Return HttpStatusCode.InternalServerError

View File

@@ -28,7 +28,7 @@ Namespace API.RedGifs
Return My.Resources.SiteResources.RedGifsPic_32
End Get
End Property
<PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), ControlNumber(1)>
<PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), DependentFields(NameOf(UserAgent)), ControlNumber(1)>
Friend ReadOnly Property Token As PropertyValue
<PropertyOption, ControlNumber(2)>
Private ReadOnly Property UserAgent As PropertyValue
@@ -38,22 +38,6 @@ Namespace API.RedGifs
<PropertyOption(ControlText:="Token refresh interval", ControlToolTip:="Interval (in minutes) to refresh the token", AllowNull:=False, LeftOffset:=120),
PXML, ControlNumber(0)>
Friend ReadOnly Property TokenUpdateInterval As PropertyValue
Private Class TokenIntervalProvider : Inherits FieldsCheckerProviderBase
Public Overrides Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object
TypeError = False
ErrorMessage = String.Empty
If Not ACheck(Of Integer)(Value) Then
TypeError = True
ElseIf CInt(Value) > 0 Then
Return Value
Else
ErrorMessage = $"The value of [{Name}] field must be greater than or equal to 1"
HasError = True
End If
Return Nothing
End Function
End Class
<Provider(NameOf(TokenUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider
#End Region
@@ -64,7 +48,6 @@ Namespace API.RedGifs
Dim t$ = String.Empty
With Responser
.Mode = Responser.Modes.WebClient
If Not .UserAgentExists Then .UserAgent = ParserUserAgent
.ClientWebUseCookies = False
.ClientWebUseHeaders = True
t = .Headers.Value(TokenName)
@@ -73,7 +56,8 @@ Namespace API.RedGifs
UserAgent = New PropertyValue(Responser.UserAgent, GetType(String), Sub(v) UpdateResponse(NameOf(UserAgent), v))
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date))
TokenUpdateInterval = New PropertyValue(60 * 12, GetType(Integer))
TokenUpdateIntervalProvider = New TokenIntervalProvider
TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider
_AllowUserAgentUpdate = False
UrlPatternUser = "https://www.redgifs.com/users/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1)
ImageVideoContains = "redgifs"

View File

@@ -18,5 +18,9 @@ Namespace API.ThisVid
Friend ReadOnly RegExAlbumID As RParams = RParams.DMS("albumId:.'(\d+)'", 1)
Friend ReadOnly RegExAlbumImagesList As RParams = RParams.DMS("""([^""]+?image\d+/?)""", 1, RegexReturn.List, EDP.ReturnValue)
Friend ReadOnly RegExAlbumImageUrl As RParams = RParams.DMS("\<img src=""(https?://media.thisvid.com/contents/albums/[^""]+?)""", 1, EDP.ReturnValue)
Friend ReadOnly RegExVideosThumb1 As RParams = RParams.DMS("preview_url:\s*'([^""']+)'", 1, EDP.ReturnValue)
Friend ReadOnly RegExVideosThumb2 As RParams = RParams.DMS("preview_url1:\s*'([^""']+)'", 1, EDP.ReturnValue)
Friend ReadOnly RegExVideoTitle As RParams = RParams.DMS("meta property=.og:title..content=""([^""]*)""", 1, EDP.ReturnValue)
End Module
End Namespace

View File

@@ -9,6 +9,8 @@
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.ThisVid
<Manifest(ThisVidSiteKey), SeparatedTasks(1), SpecialForm(False), SavedPosts>
@@ -28,6 +30,8 @@ Namespace API.ThisVid
Friend ReadOnly Property DownloadPublic As PropertyValue
<PXML, PropertyOption(ControlText:="Private videos", ControlToolTip:="Download private videos")>
Friend ReadOnly Property DownloadPrivate As PropertyValue
<PXML, PropertyOption(ControlText:="Favourite videos", ControlToolTip:="Download favourite videos")>
Friend ReadOnly Property DownloadFavourite As PropertyValue
<PXML, PropertyOption(ControlText:="Different folders",
ControlToolTip:="Use different folders to store video files." & vbCr &
"If true, then public videos will be stored in the 'Public' folder, private - in the 'Private' folder." & vbCr &
@@ -37,9 +41,16 @@ Namespace API.ThisVid
#Region "Initializer"
Friend Sub New()
MyBase.New("ThisVid", "thisvid.com")
With Responser
.CookiesExtractMode = Responser.CookiesExtractModes.Any
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
.CookiesExtractedAutoSave = False
End With
DownloadPublic = New PropertyValue(True)
DownloadPrivate = New PropertyValue(True)
DownloadFavourite = New PropertyValue(False)
DifferentFolders = New PropertyValue(True)
_SubscriptionsAllowed = True
CheckNetscapeCookiesOnEndInit = True
UseNetscapeCookies = True
UserRegex = RParams.DMS("thisvid.com/members/(\d+)", 1)
@@ -47,17 +58,100 @@ Namespace API.ThisVid
ImageVideoContains = "https://thisvid.com/videos/"
End Sub
#End Region
#Region "GetInstance, GetSpecialData"
#Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
#End Region
#Region "UpdateCookies"
Friend Sub UpdateCookies(ByVal Source As Responser)
Responser.Cookies.Clear()
Responser.Cookies.AddRange(Source.Cookies)
Update_SaveCookiesNetscape(True)
End Sub
#End Region
#Region "Downloading"
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return Settings.YtdlpFile.Exists And (What = ISiteSettings.Download.SingleObject Or Responser.CookiesExists)
End Function
Friend Overrides Sub BeforeStartDownload(ByVal User As Object, ByVal What As ISiteSettings.Download)
If CookiesNetscapeFile.Exists Then
With Responser.Cookies
.Clear()
.AddRange(CookieKeeper.ParseNetscapeText(CookiesNetscapeFile.GetText, EDP.ReturnValue),, EDP.ReturnValue)
End With
End If
MyBase.BeforeStartDownload(User, What)
End Sub
#End Region
#Region "UserOptions"
#Region "GetUserUrl, IsMyUser, UserOptions"
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
With DirectCast(User, UserData)
If .IsUser Then
Return MyBase.GetUserUrl(User)
Else
Return .GetNonUserUrl(0)
End If
End With
End Function
Private ReadOnly AbstractExtractor As RParams = RParams.DM("[^/]+", 0, RegexReturn.List, EDP.ReturnValue)
Private Const P_Albums As String = "albums"
Friend Const P_Tags As String = "tags"
Friend Const P_Categories As String = "categories"
Friend Const P_Search As String = "search"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
If Not UserURL.IsEmptyString AndAlso UserURL.ToLower.Contains("thisvid.com") Then
Dim user$ = RegexReplace(UserURL, UserRegex)
If Not user.IsEmptyString Then
Return New ExchangeOptions(Site, user)
Else
Dim data As List(Of String) = RegexReplace(UserURL.ToLower, AbstractExtractor)
If data.ListExists Then
If data.Count >= 3 AndAlso Not data(2).IsEmptyString Then
Dim mode As SiteModes
Dim n$ = String.Empty, opt$ = String.Empty
Dim __data As Func(Of Integer, String) = Function(i) If(data.Count - 1 >= i, data(i), String.Empty)
Select Case data(2)
Case P_Albums
Case P_Tags
mode = SiteModes.Tags
If Not __data(3).IsEmptyString Then
n = __data(3)
If Not __data(4).IsEmptyString AndAlso Not IsNumeric(__data(4)) Then opt = __data(4)
End If
Case P_Categories
mode = SiteModes.Categories
If Not __data(3).IsEmptyString Then
n = __data(3)
If Not __data(4).IsEmptyString AndAlso Not IsNumeric(__data(4)) Then opt = __data(4)
End If
Case Else
mode = SiteModes.Search
If Not __data(3).IsEmptyString AndAlso Not IsNumeric(__data(3)) Then n = __data(3)
If n.IsEmptyString AndAlso Not __data(4).IsEmptyString AndAlso Not IsNumeric(__data(4)) Then n = __data(4)
If Not n.IsEmptyString Then n = n.TrimStart("?", "q", "=")
If Not n.IsEmptyString Then
If __data(2).IsEmptyString Then
n = String.Empty
Else
opt = __data(2)
End If
End If
End Select
opt = $"{n}@{opt}"
n = n.StringRemoveWinForbiddenSymbols
If Not n.IsEmptyString Then
n = $"{CInt(mode)}@{n}"
Return New ExchangeOptions(Site, n) With {.Options = opt}
End If
End If
End If
End If
End If
Return Nothing
End Function
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions(Me)
If OpenForm Then

View File

@@ -18,7 +18,11 @@ Namespace API.ThisVid
#Region "XML names"
Private Const Name_DownloadPublic As String = "DownloadPublic"
Private Const Name_DownloadPrivate As String = "DownloadPrivate"
Private Const Name_DownloadFavourite As String = "DownloadFavourite"
Private Const Name_DifferentFolders As String = "DifferentFolders"
Private Const Name_TrueName As String = "TrueName"
Private Const Name_SiteMode As String = "SiteMode"
Private Const Name_Arguments As String = "Arguments"
#End Region
#Region "Structures"
Private Structure Album : Implements IRegExCreator
@@ -34,21 +38,127 @@ Namespace API.ThisVid
End Structure
#End Region
#Region "Declarations"
Friend Overrides ReadOnly Property FeedIsUser As Boolean
Get
Return IsUser
End Get
End Property
Friend Property DownloadPublic As Boolean = True
Friend Property DownloadPrivate As Boolean = True
Friend Property DownloadFavourite As Boolean = False
Friend Property DifferentFolders As Boolean = True
Friend Property TrueName As String = String.Empty
Friend Property SiteMode As SiteModes = SiteModes.User
Private Property Arguments As String = String.Empty
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {SearchRequestLabelName}
End Get
End Property
Friend Property QueryString As String
Get
If SiteMode = SiteModes.User Then
Return String.Empty
Else
Return GetNonUserUrl(0)
End If
End Get
Set(ByVal q As String)
UpdateUserOptions(True, q)
End Set
End Property
Friend ReadOnly Property IsUser As Boolean
Get
Return SiteMode = SiteModes.User
End Get
End Property
Private ReadOnly Property MySettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
#End Region
#Region "Loaders"
Private Function UpdateUserOptions(Optional ByVal Force As Boolean = False, Optional ByVal NewUrl As String = Nothing) As Boolean
If Not Force OrElse (Not SiteMode = SiteModes.User AndAlso Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then
Dim eObj As Plugin.ExchangeOptions = Nothing
If Force Then eObj = MySettings.IsMyUser(NewUrl)
If (Force And Not eObj.UserName.IsEmptyString) Or (Not Force And TrueName.IsEmptyString) Then
Dim n$() = If(Force, eObj.UserName, Name).Split("@")
If n.ListExists(2) Then
If Force And SiteMode = SiteModes.User Then Return False
Dim __TrueName$, __Arguments$
Dim __Mode As SiteModes
Dim __ForceApply As Boolean = False
Dim opt$() = If(Force, eObj.Options, Options).Split("@")
__Mode = CInt(n(0))
If opt.Length > 1 Then
__Arguments = opt.ListTake(0, 100, EDP.ReturnValue).ListToString(String.Empty)
Else
__Arguments = String.Empty
End If
__TrueName = n(1)
If Force AndAlso (Not TrueName = __TrueName Or Not SiteMode = __Mode) Then
If ValidateChangeSearchOptions(ToStringForLog, $"{__Mode}: {__TrueName}", $"{SiteMode}: {TrueName}") Then
__ForceApply = True
Else
Return False
End If
End If
Arguments = __Arguments
Options = If(Force, eObj.Options, Options)
If Not Force Then
TrueName = __TrueName
SiteMode = __Mode
Settings.Labels.Add(SearchRequestLabelName)
Labels.ListAddValue(SearchRequestLabelName, LNC)
Labels.Sort()
UserSiteName = $"{SiteMode}: {TrueName}"
If FriendlyName.IsEmptyString Then FriendlyName = UserSiteName
ElseIf Force And __ForceApply Then
TrueName = __TrueName
SiteMode = __Mode
End If
Return True
Else
SiteMode = SiteModes.User
TrueName = Name
End If
End If
End If
Return False
End Function
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
DownloadPublic = .Value(Name_DownloadPublic).FromXML(Of Boolean)(True)
DownloadPrivate = .Value(Name_DownloadPrivate).FromXML(Of Boolean)(True)
DownloadFavourite = .Value(Name_DownloadFavourite).FromXML(Of Boolean)(False)
DifferentFolders = .Value(Name_DifferentFolders).FromXML(Of Boolean)(True)
TrueName = .Value(Name_TrueName)
SiteMode = .Value(Name_SiteMode).FromXML(Of Integer)(SiteModes.User)
Arguments = .Value(Name_Arguments)
UpdateUserOptions()
Else
If UpdateUserOptions() Then
.Value(Name_LabelsName) = LabelsString
.Value(Name_UserSiteName) = UserSiteName
.Value(Name_FriendlyName) = FriendlyName
End If
.Add(Name_DownloadPublic, DownloadPublic.BoolToInteger)
.Add(Name_DownloadPrivate, DownloadPrivate.BoolToInteger)
.Add(Name_DownloadFavourite, DownloadFavourite.BoolToInteger)
.Add(Name_DifferentFolders, DifferentFolders.BoolToInteger)
.Add(Name_TrueName, TrueName)
.Add(Name_SiteMode, CInt(SiteMode))
.Add(Name_Arguments, Arguments)
'Debug.WriteLine(GetNonUserUrl(0))
'Debug.WriteLine(GetNonUserUrl(2))
End If
End With
End Sub
@@ -60,7 +170,9 @@ Namespace API.ThisVid
With DirectCast(Obj, UserExchangeOptions)
DownloadPublic = .DownloadPublic
DownloadPrivate = .DownloadPrivate
DownloadFavourite = .DownloadFavourite
DifferentFolders = .DifferentFolders
QueryString = .QueryString
End With
End If
End Sub
@@ -111,37 +223,73 @@ Namespace API.ThisVid
End Function
#End Region
#Region "Download functions"
Private AddedCount As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
AddedCount = 0
Responser.Cookies.ChangedAllowInternalDrop = False
Responser.Cookies.Changed = False
If ID.IsEmptyString Then ID = Name
If IsValid() Then
If Not IsUser OrElse IsValid() Then
If IsSavedPosts Then
DownloadData(1, True, Token)
DownloadData(1, 0, Token)
DownloadData_Images(Token)
Else
If IsUser Then
If DownloadVideos Then
If DownloadPublic Then DownloadData(1, True, Token)
If DownloadPrivate Then DownloadData(1, False, Token)
If DownloadPublic Then DownloadData(1, 0, Token)
If DownloadPrivate Then DownloadData(1, 1, Token)
If DownloadFavourite Then DownloadData(1, 2, Token)
End If
If DownloadImages Then DownloadData_Images(Token)
If DownloadImages And Not IsSubscription Then DownloadData_Images(Token)
Else
DownloadData(1, 0, Token)
End If
End If
End If
If Responser.Cookies.Changed Then MySettings.UpdateCookies(Responser) : Responser.Cookies.Changed = False
End Sub
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal IsPublic As Boolean, ByVal Token As CancellationToken)
Friend Function GetNonUserUrl(ByVal Page As Integer) As String
Dim url$ = String.Empty
Select Case SiteMode
Case SiteModes.Tags
url = $"https://thisvid.com/{SiteSettings.P_Tags}/{TrueName}/"
If Not Arguments.IsEmptyString Then url &= $"{Arguments}/"
If Page > 1 Then url &= $"{Page}/"
Case SiteModes.Categories
url = $"https://thisvid.com/{SiteSettings.P_Categories}/{TrueName}/"
If Not Arguments.IsEmptyString Then url &= $"{Arguments}/"
If Page > 1 Then url &= $"{Page}/"
Case SiteModes.Search
If Not Arguments.IsEmptyString Then
url = $"https://thisvid.com/{Arguments}/"
If Page > 1 Then url &= $"{Page}/"
url &= $"?q={TrueName}/"
End If
End Select
Return url
End Function
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Model As Byte, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
ProgressPre.ChangeMax(1)
Dim limit% = If(DownloadTopCount, -1)
Dim p$ = IIf(Page = 1, String.Empty, $"{Page}/")
If IsSavedPosts Then
URL = $"https://thisvid.com/my_favourite_videos/{p}"
ElseIf IsUser Then
URL = $"https://thisvid.com/members/{ID}/{Interaction.Switch(Model = 0, "public", Model = 1, "private", Model = 2, "favourite")}_videos/{p}"
Else
URL = $"https://thisvid.com/members/{ID}/{IIf(IsPublic, "public", "private")}_videos/{p}"
URL = GetNonUserUrl(Page)
If URL.IsEmptyString Then Throw New ArgumentNullException With {.HelpLink = 1}
End If
ThrowAny(Token)
ProgressPre.Perform()
Dim r$ = Responser.GetResponse(URL)
Dim cBefore% = _TempMediaList.Count
If Not r.IsEmptyString Then
Dim __SpecialFolder$ = IIf(DifferentFolders, IIf(IsPublic, "Public", "Private"), String.Empty)
Dim __SpecialFolder$ = If(DifferentFolders And Not IsSavedPosts And IsUser,
Interaction.Switch(Model = 0, "Public", Model = 1, "Private", Model = 2, "Favourite"),
String.Empty)
Dim l As List(Of String) = RegexReplace(r, If(IsSavedPosts, RegExVideoListSavedPosts, RegExVideoList))
If l.ListExists Then
For Each u$ In l
@@ -149,6 +297,8 @@ Namespace API.ThisVid
If Not _TempPostsList.Contains(u) Then
_TempPostsList.Add(u)
_TempMediaList.Add(New UserMedia(u) With {.Type = UserMedia.Types.VideoPre, .SpecialFolder = __SpecialFolder})
AddedCount += 1
If limit > 0 And AddedCount >= limit Then Exit Sub
Else
Exit Sub
End If
@@ -156,7 +306,8 @@ Namespace API.ThisVid
Next
End If
End If
If Not cBefore = _TempMediaList.Count Then DownloadData(Page + 1, IsPublic, Token)
If Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000) Then DownloadData(Page + 1, Model, Token)
Catch aex As ArgumentNullException When aex.HelpLink = 1
Catch ex As Exception
ProcessException(ex, Token, $"videos downloading error [{URL}]")
End Try
@@ -239,13 +390,16 @@ Namespace API.ThisVid
#End Region
#Region "ReparseVideo"
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
If IsSubscription Then
ReparseVideoSubscriptions(Token)
Else
Try
If _TempMediaList.Count > 0 Then
Dim u As UserMedia
Dim dirCmd$ = String.Empty
Dim f As SFile = Settings.YtdlpFile.File
Dim n$
Dim cookieFile As SFile = DirectCast(HOST.Source, SiteSettings).CookiesNetscapeFile
Dim cookieFile As SFile = MySettings.CookiesNetscapeFile
Dim command$
Dim e As EContainer
ProgressPre.ChangeMax(_TempMediaList.Count)
@@ -287,6 +441,54 @@ Namespace API.ThisVid
Catch ex As Exception
ProcessException(ex, Token, "video reparsing error")
End Try
End If
End Sub
Private Sub ReparseVideoSubscriptions(ByVal Token As CancellationToken)
Try
If _TempMediaList.Count > 0 Then
Dim u As UserMedia
Dim n$, r$
Dim c% = 0
Progress.Maximum += _TempMediaList.Count
For i% = _TempMediaList.Count - 1 To 0 Step -1
Progress.Perform()
u = _TempMediaList(i)
If u.Type = UserMedia.Types.VideoPre Then
If Not DownloadTopCount.HasValue OrElse c <= DownloadTopCount.Value Then
ThrowAny(Token)
r = Responser.GetResponse(u.URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
n = TitleHtmlConverter(RegexReplace(r, RegExVideoTitle))
u.Post.ID = u.URL
If Not n.IsEmptyString Then n = n.Replace("ThisVid.com", String.Empty).StringTrim.StringTrimEnd("-").StringTrim
If n.IsEmptyString Then n = TitleHtmlConverter(u.URL.Replace("https://thisvid.com/videos/", String.Empty).StringTrim.StringTrimEnd("-").StringTrim)
If n.IsEmptyString Then n = "VideoFile"
u.File = $"{n}.mp4"
u.PictureOption = n
u.URL = RegexReplace(r, Regex_VideosThumb_OG_IMAGE)
If u.URL.IsEmptyString Then u.URL = RegexReplace(r, RegExVideosThumb1)
If u.URL.IsEmptyString Then u.URL = RegexReplace(r, RegExVideosThumb2)
If Not u.URL.IsEmptyString Then
u.URL = LinkFormatterSecure(u.URL)
u.Type = UserMedia.Types.Video
_TempPostsList.Add(u.Post.ID)
_TempMediaList(i) = u
c += 1
Else
_TempMediaList.RemoveAt(i)
End If
End If
Else
_TempMediaList.RemoveAt(i)
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "subscriptions video reparsing error")
Finally
If Responser.Cookies.Changed Then MySettings.UpdateCookies(Responser) : Responser.Cookies.Changed = False
End Try
End Sub
#End Region
#Region "GetJson"

View File

@@ -8,24 +8,29 @@
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes
Namespace API.ThisVid
Friend Class UserExchangeOptions
Friend Class UserExchangeOptions : Inherits Xhamster.UserExchangeOptions
<PSetting(Caption:="Download public videos")>
Friend Property DownloadPublic As Boolean = True
<PSetting(Caption:="Download private videos")>
Friend Property DownloadPrivate As Boolean = True
<PSetting(Caption:="Download favourite videos")>
Friend Property DownloadFavourite As Boolean = False
<PSetting(NameOf(SiteSettings.DifferentFolders), NameOf(MySettings), Caption:="Different video folders")>
Friend Property DifferentFolders As Boolean = True
Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal s As SiteSettings)
DownloadPublic = s.DownloadPublic.Value
DownloadPrivate = s.DownloadPrivate.Value
DownloadFavourite = s.DownloadFavourite.Value
DifferentFolders = s.DifferentFolders.Value
MySettings = s
End Sub
Friend Sub New(ByVal u As UserData)
DownloadPublic = u.DownloadPublic
DownloadPrivate = u.DownloadPrivate
DownloadFavourite = u.DownloadFavourite
DifferentFolders = u.DifferentFolders
QueryString = u.QueryString
MySettings = u.HOST.Source
End Sub
End Class

View File

@@ -9,53 +9,8 @@
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.TikTok
Friend Module Declarations
Friend ReadOnly RegexEnvir As New RegexParseEnvir
Friend ReadOnly CheckDateProvider As New CustomProvider(Function(v) IIf(CType(v, Date?).HasValue, CObj(CType(v, Date?).Value), Nothing))
Friend Class RegexParseEnvir
Private ReadOnly UrlIdRegex As RParams = RParams.DMS("http[s]?://[w\.]{0,4}tiktok.com/[^/]+?/video/(\d+)", 1, EDP.ReturnValue)
Private ReadOnly RegexItemsArrPre As RParams = RParams.DMS("ItemList"":\{""user-post"":\{""list"":\[([^\[]+)\]", 1)
Private ReadOnly RegexItemsArr As RParams = RParams.DM("\d+", 0, RegexReturn.List)
Private ReadOnly VideoPattern As New RParams(String.Empty, Nothing, 1, EDP.ReturnValue)
Private ReadOnly DatePattern As New RParams(String.Empty, Nothing, 1, EDP.ReturnValue)
Private ReadOnly UserIdFromVideo As RParams = RParams.DMS("/\?a=(\d+)", 1, EDP.ReturnValue)
Friend Function GetIDList(ByVal r As String) As List(Of String)
Try
If Not r.IsEmptyString Then
Dim l As List(Of String) = Nothing
Dim IdArr$ = RegexReplace(r, RegexItemsArrPre)
If Not IdArr.IsEmptyString Then l = RegexReplace(IdArr, RegexItemsArr)
If l.ListExists Then l.RemoveAll(Function(id) id.IsEmptyString)
Return l
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.TikTok.RegexParseEnvir.GetIDList]")
End Try
End Function
Friend Function GetVideoData(ByVal r As String, ByVal ID As String, ByRef URL As String, ByRef [Date] As Date?) As Boolean
Try
[Date] = Nothing
URL = String.Empty
If Not r.IsEmptyString Then
VideoPattern.Pattern = "video"":\{""id"":""" & ID & """[^\}]+?""downloadAddr"":""([^""]+)"""
DatePattern.Pattern = """:{""id"":""" & ID & """,""desc"":.+?""createTime"":""(\d+)"
Dim u$ = RegexReplace(r, VideoPattern)
If Not u.IsEmptyString Then URL = SymbolsConverter.Unicode.Decode(u, EDP.ReturnValue)
Dim d$ = RegexReplace(r, DatePattern)
If Not d.IsEmptyString Then [Date] = ADateTime.ParseUnix32(d)
Return Not URL.IsEmptyString
End If
Return False
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.TikTok.RegexParseEnvir.GetVideoData]", False)
End Try
End Function
Friend Function ExtractPostID(ByVal URL As String) As String
If Not URL.IsEmptyString Then Return RegexReplace(URL, UrlIdRegex) Else Return String.Empty
End Function
Friend Function ExtractUserID(ByVal VideoUrl As String) As String
If Not VideoUrl.IsEmptyString Then Return RegexReplace(VideoUrl, UserIdFromVideo) Else Return String.Empty
End Function
End Class
Friend ReadOnly SimpleDateConverter As New ADateTime("yyyyMMdd")
Friend ReadOnly RegexTagsReplacer As RParams = RParams.DM("#\w+\s?", -1, RegexReturn.Replace,
CType(Function(input$) String.Empty, Func(Of String, String)), EDP.ReturnValue)
End Module
End Namespace

View File

@@ -11,7 +11,7 @@ Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.TikTok
<Manifest("AndyProgram_TikTok")>
<Manifest("AndyProgram_TikTok"), SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
@@ -23,8 +23,22 @@ Namespace API.TikTok
Return My.Resources.SiteResources.TikTokPic_192
End Get
End Property
<PropertyOption(ControlText:="Remove tags from title"), PXML>
Friend Property RemoveTagsFromTitle As PropertyValue
<PropertyOption(ControlText:="Use native title", ControlToolTip:="Use a user-created video title for the filename instead of the video ID."), PXML>
Friend Property TitleUseNative As PropertyValue
<PropertyOption(ControlText:="Use native title in standalone downloader",
ControlToolTip:="Use a user-created video title for the filename instead of the video ID."), PXML>
Friend Property TitleUseNativeSTD As PropertyValue
<PropertyOption(ControlText:="Add video ID to video title"), PXML>
Friend Property TitleAddVideoID As PropertyValue
Friend Sub New()
MyBase.New("TikTok", "www.tiktok.com")
RemoveTagsFromTitle = New PropertyValue(False)
TitleUseNative = New PropertyValue(True)
TitleUseNativeSTD = New PropertyValue(False)
TitleAddVideoID = New PropertyValue(True)
UseNetscapeCookies = True
UrlPatternUser = "https://www.tiktok.com/@{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?tiktok.com/@([^/]+)", 1)
ImageVideoContains = "tiktok.com"
@@ -32,12 +46,14 @@ Namespace API.TikTok
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists
End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
'TODO: TikTok disabled
Return False
Return Settings.YtdlpFile.Exists
End Function
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions(Me)
If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
End Sub
End Class
End Namespace

View File

@@ -8,65 +8,261 @@
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Documents.JSON
Namespace API.TikTok
Friend Class UserData : Inherits UserDataBase
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
#Region "XML names"
Private Const Name_RemoveTagsFromTitle As String = "RemoveTagsFromTitle"
Private Const Name_TitleUseNative As String = "TitleUseNative"
Private Const Name_TitleAddVideoID As String = "TitleAddVideoID"
Private Const Name_LastDownloadDate As String = "LastDownloadDate"
#End Region
#Region "Declarations"
Private ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
End Get
End Property
Private ReadOnly Property RootCacheTikTok As ICacheKeeper
Get
With Settings.Cache
Dim f As SFile = $"{Settings.Cache.RootDirectory.PathWithSeparator}TikTokCache\"
If .ContainsFolder(f) Then
Return .GetInstance(f)
Else
f.Exists(SFO.Path, True)
With .NewInstance(Of BatchFileExchanger)(f)
.DeleteCacheOnDispose = False
.DeleteRootOnDispose = False
Return .Self
End With
End If
End With
End Get
End Property
Friend Property RemoveTagsFromTitle As Boolean = False
Friend Property TitleUseNative As Boolean = True
Friend Property TitleAddVideoID As Boolean = True
Private Property LastDownloadDate As Date? = Nothing
#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)
RemoveTagsFromTitle = .RemoveTagsFromTitle
TitleUseNative = .TitleUseNative
TitleAddVideoID = .TitleAddVideoID
End With
End If
End Sub
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
RemoveTagsFromTitle = .Value(Name_RemoveTagsFromTitle).FromXML(Of Boolean)(False)
TitleUseNative = .Value(Name_TitleUseNative).FromXML(Of Boolean)(True)
TitleAddVideoID = .Value(Name_TitleAddVideoID).FromXML(Of Boolean)(True)
LastDownloadDate = AConvert(Of Date)(.Value(Name_LastDownloadDate), ADateTime.Formats.BaseDateTime, Nothing)
Else
.Add(Name_RemoveTagsFromTitle, RemoveTagsFromTitle.BoolToInteger)
.Add(Name_TitleUseNative, TitleUseNative.BoolToInteger)
.Add(Name_TitleAddVideoID, TitleAddVideoID.BoolToInteger)
.Add(Name_LastDownloadDate, AConvert(Of String)(LastDownloadDate, AModes.XML, ADateTime.Formats.BaseDateTime, String.Empty))
End If
End With
End Sub
#End Region
#Region "Initializer"
Friend Sub New()
SeparateVideoFolder = False
UseInternalDownloadFileFunction = True
End Sub
#End Region
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Dim URL$ = $"https://www.tiktok.com/@{Name}"
Using cache As CacheKeeper = CreateCache()
Try
Dim PostIDs As List(Of String)
Dim PostDate As Date? = Nothing
Dim PostURL$ = String.Empty
Dim r$
URL = $"https://www.tiktok.com/@{Name}"
r = Responser.GetResponse(URL)
PostIDs = RegexEnvir.GetIDList(r)
If PostIDs.ListExists Then
For Each __id$ In PostIDs
If Not _TempPostsList.Contains(__id) Then
_TempPostsList.Add(__id)
If RegexEnvir.GetVideoData(r, __id, PostURL, PostDate) Then
Select Case CheckDatesLimit(PostDate, CheckDateProvider)
Dim postID$, title$, postUrl$
Dim postDate As Date?
Dim dateAfterC As Date? = Nothing
Dim dateBefore As Date? = DownloadDateTo
Dim dateAfter As Date? = DownloadDateFrom
If _ContentList.Count > 0 Then
With (From d In _ContentList Where d.Post.Date.HasValue Select d.Post.Date.Value)
If .ListExists Then dateAfterC = .Min
End With
End If
With {CStr(AConvert(Of String)(dateAfter, SimpleDateConverter, String.Empty)).FromXML(Of Integer)(-1),
CStr(AConvert(Of String)(dateAfterC, SimpleDateConverter, String.Empty)).FromXML(Of Integer)(-1)}.ListWithRemove(Function(d) d = -1)
If .ListExists Then dateAfter = AConvert(Of Date)(CStr(.Min), SimpleDateConverter, Nothing)
End With
If LastDownloadDate.HasValue Then
If dateAfter.HasValue And Not DownloadDateFrom.HasValue Then
If (LastDownloadDate.Value - dateAfter.Value).TotalDays > 1 Then dateAfter = dateAfter.Value.AddDays(1)
End If
End If
Using b As New TokenBatch(Token)
b.ChangeDirectory(cache)
b.Encoding = BatchExecutor.UnicodeEncoding
b.Execute(CreateYTCommand(cache.RootDirectory, URL, False, dateBefore, dateAfter))
End Using
ThrowAny(Token)
Dim files As List(Of SFile) = SFile.GetFiles(cache, "*.json",, EDP.ReturnValue)
If files.ListExists Then
Dim j As EContainer
For Each file As SFile In files
j = JsonDocument.Parse(file.GetText, EDP.ReturnValue)
If j.ListExists Then
If j.Value("_type").StringToLower = "video" Then
postID = j.Value("id")
If Not _TempPostsList.Contains(postID) Then
_TempPostsList.Add(postID)
Else
Exit Sub
End If
title = j.Value("title").StringRemoveWinForbiddenSymbols
If title.IsEmptyString Or Not TitleUseNative Then
title = postID
Else
If RemoveTagsFromTitle Then title = RegexReplace(title, RegexTagsReplacer)
title = title.StringTrim
If title.IsEmptyString Then
title = postID
ElseIf TitleAddVideoID Then
title &= $" ({postID})"
End If
End If
postDate = AConvert(Of Date)(j.Value("timestamp"), UnixDate32Provider, Nothing)
If Not postDate.HasValue Then postDate = AConvert(Of Date)(j.Value("upload_date"), SimpleDateConverter, Nothing)
Select Case CheckDatesLimit(postDate, SimpleDateConverter)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
If ID.IsEmptyString And Not PostURL.IsEmptyString Then ID = RegexEnvir.ExtractUserID(PostURL)
_TempMediaList.ListAddValue(MediaFromData(PostURL, __id, PostDate))
postUrl = j.Value("webpage_url")
If postUrl.IsEmptyString Then postUrl = $"https://www.tiktok.com/@{Name}/video/{postID}"
_TempMediaList.Add(New UserMedia(postUrl, UserMedia.Types.Video) With {
.File = $"{title}.mp4", .Post = New UserPost(postID, postDate)})
End If
Else
Exit Sub
j.Dispose()
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Using
End Sub
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
If ContentMissingExists Then
Dim m As UserMedia
Dim i%
Dim rList As New List(Of Integer)
For i = 0 To _ContentList.Count - 1
If _ContentList(i).State = UserMedia.States.Missing Then
m = _ContentList(i)
m.URL = m.URL_BASE
_TempMediaList.Add(m)
rList.Add(i)
End If
Next
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
End If
End If
End Sub
#End Region
#Region "YT-DLP Support"
Private Function CreateYTCommand(ByVal Output As SFile, ByVal URL As String, ByVal IsDownload As Boolean,
Optional ByVal DateBefore As Date? = Nothing, Optional ByVal DateAfter As Date? = Nothing,
Optional ByVal PrintTitle As Boolean = False, Optional ByVal SupportOutput As Boolean = True) As String
Dim command$ = $"""{Settings.YtdlpFile}"" "
If Not IsDownload Then command &= "--write-info-json --skip-download "
If PrintTitle Then
If Not command.Contains("--skip-download") Then command &= "--skip-download "
command &= "--print title "
End If
If DateBefore.HasValue Then command &= $"--datebefore {DateBefore.Value.AddDays(1).ToStringDate(SimpleDateConverter)} "
If DateAfter.HasValue Then command &= $"--dateafter {DateAfter.Value.AddDays(-1).ToStringDate(SimpleDateConverter)} "
If MySettings.CookiesNetscapeFile.Exists Then command &= $"--no-cookies-from-browser --cookies ""{MySettings.CookiesNetscapeFile}"" "
command &= $"{URL} "
If SupportOutput Then
If IsDownload Then
command &= $"-o ""{Output}"""
Else
command &= "-o %(id)s"
End If
End If
Return command
End Function
#End Region
#Region "DownloadContent, DownloadFile"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
Private Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As Date?) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, UserMedia.Types.Video) With {.Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = $"{PostID}.mp4"
If PostDate.HasValue Then m.Post.Date = PostDate
Return m
Protected Overrides Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Using b As New TokenBatch(Token) With {.FileExchanger = RootCacheTikTok}
b.Encoding = BatchExecutor.UnicodeEncoding
b.Execute(CreateYTCommand(DestinationFile, URL, True))
End Using
Return DestinationFile
End Function
#End Region
#Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
Dim f$ = String.Empty
If CBool(MySettings.TitleUseNativeSTD.Value) Then
Using b As New BatchExecutor(True) With {
.Encoding = BatchExecutor.UnicodeEncoding,
.CleanAutomaticallyViaRegEx = True,
.CleanAutomaticallyViaRegExRemoveAllCommands = True
}
b.Execute(CreateYTCommand(Nothing, Data.URL, True,,, True, False))
b.Clean()
With b.OutputData
If .Count > 0 Then
For Each vData$ In .Self
If Not vData.Contains($": {BatchExecutor.UnicodeEncoding}") Then f = vData : Exit For
Next
End If
End With
End Using
End If
Dim m As New UserMedia(Data.URL, UserMedia.Types.Video)
If Not f.IsEmptyString Then f = TitleHtmlConverter(f)
If Not f.IsEmptyString Then
If CBool(MySettings.RemoveTagsFromTitle.Value) Then f = RegexReplace(f, RegexTagsReplacer)
f = f.StringTrim
If Not f.IsEmptyString Then
If CBool(MySettings.TitleAddVideoID.Value) Then f &= $" ({m.File.Name})"
m.File.Name = f
End If
End If
_TempMediaList.Add(m)
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
If Responser.Status = Net.WebExceptionStatus.ConnectionClosed Then
UserExists = False
Return 1
Else
Return 0
End If
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.TikTok
Friend Class UserExchangeOptions
<PSetting(NameOf(SiteSettings.RemoveTagsFromTitle), NameOf(MySettings))>
Friend Property RemoveTagsFromTitle As Boolean
<PSetting(NameOf(SiteSettings.TitleUseNative), NameOf(MySettings))>
Friend Property TitleUseNative As Boolean
<PSetting(NameOf(SiteSettings.TitleAddVideoID), NameOf(MySettings))>
Friend Property TitleAddVideoID As Boolean
Private ReadOnly MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
MySettings = u.HOST.Source
RemoveTagsFromTitle = u.RemoveTagsFromTitle
TitleUseNative = u.TitleUseNative
TitleAddVideoID = u.TitleAddVideoID
End Sub
Friend Sub New(ByVal s As SiteSettings)
MySettings = s
RemoveTagsFromTitle = s.RemoveTagsFromTitle.Value
TitleUseNative = s.TitleUseNative.Value
TitleAddVideoID = s.TitleAddVideoID.Value
End Sub
End Class
End Namespace

View File

@@ -24,6 +24,8 @@ Namespace API.Twitter
ToolTip:="Existing files will be checked for duplicates and duplicates removed." & vbCr &
"Works only on the first activation 'Use MD5 comparison'.", LeftOffset:=DefaultOffset)>
Friend Property RemoveExistingDuplicates As Boolean = False
<PSetting(NameOf(SiteSettings.MediaModelAllowNonUserTweets), NameOf(MySettings), LeftOffset:=DefaultOffset)>
Friend Overridable Property MediaModelAllowNonUserTweets As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Media'",
ToolTip:="Download the data using the 'https://twitter.com/UserName/media' command.", LeftOffset:=DefaultOffset)>
@@ -36,12 +38,18 @@ Namespace API.Twitter
Caption:="Download model 'Search'",
ToolTip:="Download the data using the 'https://twitter.com/search?q=from:UserName+include:nativeretweets' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelSearch As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Force apply",
ToolTip:="Force overrides the default parameters for the first download." & vbCr & "Applies to first download only.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelForceApply As Boolean = False
Private ReadOnly Property MySettings As Object
Friend Sub New(ByVal s As SiteSettings)
GifsDownload = s.GifsDownload.Value
GifsSpecialFolder = s.GifsSpecialFolder.Value
GifsPrefix = s.GifsPrefix.Value
UseMD5Comparison = s.UseMD5Comparison.Value
DownloadModelForceApply = s.UseAppropriateModel.Value
MediaModelAllowNonUserTweets = s.MediaModelAllowNonUserTweets.Value
MySettings = s
End Sub
Friend Sub New(ByVal s As Mastodon.SiteSettings)
@@ -57,7 +65,9 @@ Namespace API.Twitter
GifsPrefix = u.GifsPrefix
UseMD5Comparison = u.UseMD5Comparison
RemoveExistingDuplicates = u.RemoveExistingDuplicates
MediaModelAllowNonUserTweets = u.MediaModelAllowNonUserTweets
If Not TypeOf u Is Mastodon.UserData Then
DownloadModelForceApply = u.DownloadModelForceApply
Dim dm As DModels() = EnumExtract(Of DModels)(u.DownloadModel)
If dm.ListExists Then
DownloadModelMedia = dm.Contains(DModels.Media)

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