Compare commits

...

15 Commits

Author SHA1 Message Date
Andy
45adf735a7 2023.11.17.0 2023-11-17 02:30:23 +03:00
Andy
496c9487cd 2023.11.15.0
ADD FACEBOOK
SiteSettingsBase: update 'CLONE_PROPERTIES' function (exclude 'DoNotUse' attribute)
API.Instagram: handle 401 error
API.ThreadsNet.SiteSettings: make the class compatible for Facebook
xHanster, XVideos, PornHub, ThisVid: update download function for search queries
Hosts.PropertyValueHost: set the 'Exists' value based on the 'DoNotUse' attribute
Hosts.SettingsHost: use 'GetObjectMembers' instead of 'GetTypeInfo.DeclaredMembers' to get class members
2023-11-17 02:30:23 +03:00
Andy
96705f1c59 2023.11.13.1
PornHub: add playlists downloading
2023-11-13 23:18:21 +03:00
Andy
f08a5f9259 2023.11.13.0
API.JFF: update UserAgent start value
ActiveDownloadingProgress: fix unnecessary focus of inactive form
FeedMedia: add additional buttons to the context menu
FeedSpecialCollection: 'Favorite' feed does not appear in the feeds list if it is created manually
UserCreatorForm: disable account selection when opening an empty form
MainFrame: fix background image resizing on form state changes
SettingsHost: inherit path when cloning an instance
SettingsHostCollection: Extract user path change function to static
2023-11-13 20:53:32 +03:00
Andy
95cbb6aeb1 2023.11.12.2
API.Instagram: handle JSON primitive error (simple line)
API.OnlyFans: handle 401 error; handle file update error
API.Xhamster: handle 503 error
Scheduler: handle automation start error
2023-11-12 22:34:47 +03:00
Andy
5af0dcc46e 2023.11.12.1
YouTube: add cc and subtitles merge
2023-11-12 20:57:05 +03:00
Andy
f5789862ba 2023.11.12.0
Add special feeds
2023-11-12 20:34:53 +03:00
Andy
12c02580f6 2023.11.9.0
ADD MULTI-ACCOUNT

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

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

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

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

STDownloader: add multi-acc compatibility

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

PluginsEnvironment: add 'PClonableAttribute'; add multi-acc support
2023-11-12 01:31:09 +03:00
Andy
6def34d5e9 2023.10.12.0
API.ThisVid: update parser ('SessionPosts')
2023-10-12 19:47:02 +03:00
Andy
831d9a5a09 2023.10.10.0 2023-10-10 18:10:45 +03:00
Andy
326e61a968 2023.10.9.0
YT.VideoListForm: hide clear and delete buttons in menu; add 'BTT_CLEAR_SELECTED' button
API.Base.TokenBatch: add debug option
API.ALL: fix missing posts
API.JFF: rewrite m3u8 downloader; add ffmpeg requirement for the download; fixed missing posts; fixed download to the date; fixed corrupted files
DownloadableMediaHost: remove thumbnail when removed from list if thumbnail is stored in cache
2023-10-09 18:52:37 +03:00
Andy
61903afe3f 2023.10.6.0
Collections: use the collection name as a friendly name; labels are removed when creating a new collection
API.UserDataBase: update comparator
API.ThisVid: add 'PagePosts' to continue parsing when new posts are added
2023-10-06 15:11:09 +03:00
Andy
fa3f39b905 2023.10.4.0
YT: file name is missing when destination is changed by selecting one of the saved locations; missing files still appear in the list
API.UserDataBase: hide 'OperationCanceledException' and 'ObjectDisposedException'
API.Reddit: unable to save settings without OAuth data
TDownloader: 'ReconfPool'
MainFrame: replace 'DownloadQueue.FormShow' with 'ShowDownloadQueueForm'
SettingsHost: add a notification if the user has disabled downloading from the site
2023-10-04 22:53:17 +03:00
Andy
c76fd7f918 2023.10.3.0
YT: add settings 'CreateUrlFiles' and 'CreateDescriptionFiles'
STDownloader: add setting 'CreateUrlFiles'
2023-10-03 23:33:42 +03:00
Andy
66085e0d95 2023.10.2.0
API.Threads: save new token if found
Feed: add 'Load current session'; update the session file retrieval function
TDownloader: change session files name; files count
SettingsCLS, GlobalSettingsForm: add session file count setting
2023-10-02 11:32:37 +03:00
133 changed files with 5951 additions and 2032 deletions

View File

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

View File

@@ -1,3 +1,59 @@
# 2023.11.17.0
*2023-11-17*
- Added
- **Facebook**
- **Multi-account**
- **Special feeds**
- Site settings: option `Download saved posts`
- Standalone downloader: support for multiple account
- PornHub: add playlists downloading
- YouTube: ability to download subtitles **and** `CC` if they both exists
- Other improvements
- PluginProvider
- `IDownloadableMedia`: added `AccountName` property
- `IPluginContentProvider`: added `AccountName` property
- `ISiteSettings`: added properties: `AccountName`, `Temporary`, `AvailableText`, `DefaultInstance`; added functions: `Clone`, `Update`, `Delete`; removed `Load` function; implement `IDisposable` interface
- `PropertyValue`: added functions: `BeginInit`, `EndInit`, `Clone`
- `Attributes.DoNotUse` - add `Value` field
- Fixed
- Instagram: handling 401 error
- OnlyFans: handling 401 error
- xHamster: handling 503 error
- xHamster: incorrect parsing of search queries
- XVideos: incorrect parsing of search queries
- ThisVid: incorrect parsing of search queries
- PornHub: incorrect parsing of search queries
- Automation: handle automation start error (in some cases) when changing scheduler
- Minor bugs
# 2023.10.10.0
*2023-10-10*
- Added
- Notification if the user has disabled downloading from the site
- Standalone downloader: new setting `Create URL files`
- Changed the sessions naming method to be more intuitive
- Settings that allow the user to change the number of saved session (`Settings` - `Feed` - `Store session data`)
- **YouTube: new settings `Create URL files` and `Create description files`**
- YouTube: added the `Clear selected` button
- YouTube: group the `Clear and remove` buttons in the menu
- Fixed
- Reddit: unable to save settings without OAuth data
- JustForFans: rewritten m3u8 downloader
- JustForFans: downloading of missing posts
- JustForFans: download to the date
- JustForFans: corrupted files
- Threads: new token is not saved if it was received during download
- ThisVid: parsing stops when new videos are added
- YouTube: file name is missing when destination is changed by selecting one of the saved locations
- YouTube: missing files still appear in the list
- Collections: labels are removed when creating a new collection
- Standalone downloader: cached thumbnail is not removed when item is removed from the list
- Minor bugs
# 2023.10.1.0 # 2023.10.1.0
*2023-10-01* *2023-10-01*

Binary file not shown.

Before

Width:  |  Height:  |  Size: 33 KiB

After

Width:  |  Height:  |  Size: 32 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 9.7 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 8.7 KiB

After

Width:  |  Height:  |  Size: 103 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 34 KiB

After

Width:  |  Height:  |  Size: 39 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 20 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 20 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 17 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 6.3 KiB

After

Width:  |  Height:  |  Size: 7.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 25 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 KiB

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 22 KiB

View File

@@ -4,6 +4,7 @@
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest) [![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
[![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE) [![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE)
[![Discord](https://img.shields.io/discord/1124032649682493462?logo=discord)](https://discord.gg/uFNUXvFFmg)
[![GitHub all releases](https://img.shields.io/github/downloads/aandyprogram/scrawler/total?label=Total%20downloads)](https://github.com/AAndyProgram/SCrawler/releases) [![GitHub all releases](https://img.shields.io/github/downloads/aandyprogram/scrawler/total?label=Total%20downloads)](https://github.com/AAndyProgram/SCrawler/releases)
[![FAQ](https://img.shields.io/badge/FAQ-green)](FAQ.md) [![FAQ](https://img.shields.io/badge/FAQ-green)](FAQ.md)
[![GUIDE](https://img.shields.io/badge/GUIDE-green)](https://github.com/AAndyProgram/SCrawler/wiki) [![GUIDE](https://img.shields.io/badge/GUIDE-green)](https://github.com/AAndyProgram/SCrawler/wiki)
@@ -11,7 +12,7 @@
:eu: :eu:
:greece: :greece:
A program to download photo and video from [any site](#supported-sites) (e.g. YouTube, YouTube Music, OnlyFans, Reddit, Twitter, Mastodon, Instagram, Threads, TikTok, RedGifs, JustForFans, PornHub, XHamster, XVIDEOS, ThisVid, LPSG, Pinterest). A program to download photo and video from [any site](#supported-sites) (e.g. YouTube, YouTube Music, OnlyFans, Reddit, Twitter, Mastodon, Instagram, Threads, Facebook, TikTok, RedGifs, JustForFans, PornHub, XHamster, XVIDEOS, ThisVid, LPSG, Pinterest).
**If you like SCrawler, please like the program on [this site](https://alternativeto.net/software/scrawler/about/) and/or [this](https://www.softpedia.com/get/Internet/Download-Managers/Social-networks-crawler.shtml)** **If you like SCrawler, please like the program on [this site](https://alternativeto.net/software/scrawler/about/) and/or [this](https://www.softpedia.com/get/Internet/Download-Managers/Social-networks-crawler.shtml)**
<!---Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush: <!---Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush:
@@ -38,6 +39,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- Mastodon images and videos, saved (bookmarked) posts; - Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories, saved posts; - Instagram images and videos, tagged posts, stories, saved posts;
- Threads images and videos; - Threads images and videos;
- Facebook images and videos, saved posts;
- TikTok videos; - TikTok videos;
- Pinterest boards, users, saved posts; - Pinterest boards, users, saved posts;
- Imgur images, galleries and videos; - Imgur images, galleries and videos;
@@ -53,6 +55,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **Advanced user management** - **Advanced user management**
- **Automation** ([downloading data automatically](https://github.com/AAndyProgram/SCrawler/wiki/Settings#automation) every ```X``` minutes) - **Automation** ([downloading data automatically](https://github.com/AAndyProgram/SCrawler/wiki/Settings#automation) every ```X``` minutes)
- **Feed** ([feed](https://github.com/AAndyProgram/SCrawler/wiki#feed) of downloaded media files and subscriptions posts) - **Feed** ([feed](https://github.com/AAndyProgram/SCrawler/wiki#feed) of downloaded media files and subscriptions posts)
- Multiple accounts support
- Labeling users - Labeling users
- Create [download groups](https://github.com/AAndyProgram/SCrawler/wiki/Settings#download-groups) - Create [download groups](https://github.com/AAndyProgram/SCrawler/wiki/Settings#download-groups)
- Adding users to favorites and temporary - Adding users to favorites and temporary
@@ -75,6 +78,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **Mastodon** - **Mastodon**
- **Instagram** - **Instagram**
- **Threads** - **Threads**
- **Facebook**
- JustForFans - JustForFans
- TikTok - TikTok
- RedGifs - RedGifs
@@ -127,6 +131,7 @@ First, the program downloads the full profile. After the program downloads only
- [Mastodon](https://github.com/AAndyProgram/SCrawler/wiki/Settings#mastodon) - [Mastodon](https://github.com/AAndyProgram/SCrawler/wiki/Settings#mastodon)
- [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram) - [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram)
- [Threads](https://github.com/AAndyProgram/SCrawler/wiki/Settings#threads) - [Threads](https://github.com/AAndyProgram/SCrawler/wiki/Settings#threads)
- [Facebook](https://github.com/AAndyProgram/SCrawler/wiki/Settings#facebook)
- [JustForFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#justforfans) - [JustForFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#justforfans)
- [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok) - [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok)
- [RedGifs](https://github.com/AAndyProgram/SCrawler/wiki/Settings#redgifs) - [RedGifs](https://github.com/AAndyProgram/SCrawler/wiki/Settings#redgifs)
@@ -194,7 +199,6 @@ F5-->[*]
Discord server: https://discord.gg/uFNUXvFFmg Discord server: https://discord.gg/uFNUXvFFmg
[e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me
<!-- <!--
[e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me [e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -28,8 +28,19 @@ Namespace API.YouTube.Base
End Structure End Structure
Public Structure Subtitles : Implements IIndexable, IComparable(Of Subtitles) Public Structure Subtitles : Implements IIndexable, IComparable(Of Subtitles)
Public ID As String Public ID As String
Public Name As String Private _Name As String
Public Property Name As String
Get
Dim n$ = _Name.IfNullOrEmpty(ID)
If CC Then n &= " (CC)"
Return n
End Get
Set(ByVal NewName As String)
_Name = NewName
End Set
End Property
Public Formats As String Public Formats As String
Public CC As Boolean
Public ReadOnly Property FullID As String Public ReadOnly Property FullID As String
Get Get
Return IIf(ID = "en", "en.*", ID) Return IIf(ID = "en", "en.*", ID)

View File

@@ -35,6 +35,7 @@ Namespace API.YouTube.Base
<Browsable(False)> Private Property Mode As GridUpdateModes = GridUpdateModes.OnConfirm Implements IGridValuesContainer.Mode <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), XMLVV(-1)> Friend ReadOnly Property PlaylistFormSplitterDistance As XMLValue(Of Integer)
<Browsable(False)> Friend ReadOnly Property DownloadLocations As DownloadLocationsCollection <Browsable(False)> Friend ReadOnly Property DownloadLocations As DownloadLocationsCollection
<Browsable(False)> Public Overridable Property AccountName As String
#Region "Environment" #Region "Environment"
#Region "Programs" #Region "Programs"
<Browsable(True), GridVisible(False), XMLVN({"Environment"}), Category("Environment programs"), DisplayName("Path to yt-dlp.exe"), <Browsable(True), GridVisible(False), XMLVN({"Environment"}), Category("Environment programs"), DisplayName("Path to yt-dlp.exe"),
@@ -132,6 +133,19 @@ Namespace API.YouTube.Base
End Set End Set
End Property End Property
#End Region #End Region
#Region "Info"
<Browsable(True), GridVisible, XMLVN({"Info"}), Category("Info"), DisplayName("Create URL files"),
Description("Create local URL files to link to the original page. Default: false.")>
Public ReadOnly Property CreateUrlFiles As XMLValue(Of Boolean)
Private ReadOnly Property IDownloaderSettings_CreateUrlFiles As Boolean Implements IDownloaderSettings.CreateUrlFiles
Get
Return CreateUrlFiles
End Get
End Property
<Browsable(True), GridVisible, XMLVN({"Info"}), Category("Info"), DisplayName("Create description files"),
Description("Create video description files. Default: false.")>
Public ReadOnly Property CreateDescriptionFiles As XMLValue(Of Boolean)
#End Region
#Region "Defaults" #Region "Defaults"
<Browsable(True), GridVisible, XMLVN({"Defaults"}, True), Category("Defaults"), DisplayName("Standardize URLs"), <Browsable(True), GridVisible, XMLVN({"Defaults"}, True), Category("Defaults"), DisplayName("Standardize URLs"),
Description("Standardize URLs by eliminating unwanted strings. Default: true.")> Description("Standardize URLs by eliminating unwanted strings. Default: true.")>
@@ -287,9 +301,17 @@ Namespace API.YouTube.Base
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Public Sub New() Public Sub New()
Me.New(String.Empty)
End Sub
Public Sub New(ByVal AccountName As String)
Me.AccountName = AccountName
DownloadLocations = New DownloadLocationsCollection DownloadLocations = New DownloadLocationsCollection
DownloadLocations.Load(False, True) DownloadLocations.Load(False, True)
XML = New XmlFile(YouTubeSettingsFile,, False) With {.AutoUpdateFile = True} Dim acc$ = String.Empty
If Not AccountName.IsEmptyString Then acc = $"_{AccountName}"
Dim f As SFile = YouTubeSettingsFile
f.Name &= acc
XML = New XmlFile(f,, False) With {.AutoUpdateFile = True}
XML.LoadData(EDP.None) XML.LoadData(EDP.None)
DesignXml = New XmlFile("Settings\DesignDownloader.xml", Protector.Modes.All, False) DesignXml = New XmlFile("Settings\DesignDownloader.xml", Protector.Modes.All, False)
DesignXml.LoadData(EDP.None) DesignXml.LoadData(EDP.None)
@@ -297,7 +319,9 @@ Namespace API.YouTube.Base
AddHandler ShowNotificationsEveryDownload.TempValueChanged, AddressOf ShowNotificationsEveryDownload_TempValueChanged AddHandler ShowNotificationsEveryDownload.TempValueChanged, AddressOf ShowNotificationsEveryDownload_TempValueChanged
Cookies = New CookieKeeper Cookies = New CookieKeeper
Grid.Abstract.DesignerXmlSource.Add(New Grid.Abstract.DesignerXmlData(GetType(CookieListForm2), DesignXml, "CookiesListForm")) Grid.Abstract.DesignerXmlSource.Add(New Grid.Abstract.DesignerXmlData(GetType(CookieListForm2), DesignXml, "CookiesListForm"))
If YouTubeCookieNetscapeFile.Exists Then Cookies.AddRange(CookieKeeper.ParseNetscapeText(YouTubeCookieNetscapeFile.GetText(EDP.ReturnValue), EDP.None),, EDP.None) f = YouTubeCookieNetscapeFile
f.Name &= acc
If f.Exists Then Cookies.AddRange(CookieKeeper.ParseNetscapeText(f.GetText(EDP.ReturnValue), EDP.None),, EDP.None)
If Not YTDLP.Value.Exists Then YTDLP.Value = ProgramPath("yt-dlp.exe") If Not YTDLP.Value.Exists Then YTDLP.Value = ProgramPath("yt-dlp.exe")
If Not FFMPEG.Value.Exists Then FFMPEG.Value = ProgramPath("ffmpeg.exe") If Not FFMPEG.Value.Exists Then FFMPEG.Value = ProgramPath("ffmpeg.exe")
If Not OutputPath.Value.Exists(SFO.Path, False) Then OutputPath.Value = YouTubeDownloadPathDefault If Not OutputPath.Value.Exists(SFO.Path, False) Then OutputPath.Value = YouTubeDownloadPathDefault

View File

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

View File

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

View File

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

View File

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

View File

@@ -343,15 +343,20 @@ Namespace DownloadObjects.STDownloader
ControlInvoke(TOOLBAR_TOP, BTT_STOP, Sub() BTT_STOP.Enabled = False, EDP.SendToLog) ControlInvoke(TOOLBAR_TOP, BTT_STOP, Sub() BTT_STOP.Enabled = False, EDP.SendToLog)
MyJob.Cancel() MyJob.Cancel()
End Sub End Sub
#Region "Delete / Clear"
Private Sub BTT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_DELETE.Click Private Sub BTT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_DELETE.Click
RemoveControls(ControlsChecked, True) RemoveControls(ControlsChecked, True)
End Sub End Sub
Private Sub BTT_CLEAR_SELECTED_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_SELECTED.Click
RemoveControls(ControlsChecked, False)
End Sub
Protected Overridable Sub BTT_CLEAR_DONE_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DONE.Click Protected Overridable Sub BTT_CLEAR_DONE_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DONE.Click
RemoveControls(ControlsDownloaded, False) RemoveControls(ControlsDownloaded, False)
End Sub End Sub
Protected Overridable Sub BTT_CLEAR_ALL_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_ALL.Click Protected Overridable Sub BTT_CLEAR_ALL_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_ALL.Click
RemoveControls(, False) RemoveControls(, False)
End Sub End Sub
#End Region
Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click
MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton) MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton)
End Sub End Sub

View File

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

View File

@@ -111,6 +111,7 @@ Namespace API.YouTube.Objects
_SiteKey = Key _SiteKey = Key
End Set End Set
End Property End Property
<XMLEC> Public Property AccountName As String = String.Empty Implements IDownloadableMedia.AccountName
<XMLEC(Name_IsMusic)> Public Property IsMusic As Boolean = False Implements IYouTubeMediaContainer.IsMusic <XMLEC(Name_IsMusic)> Public Property IsMusic As Boolean = False Implements IYouTubeMediaContainer.IsMusic
<XMLEC> Public Property IsShorts As Boolean = False Implements IYouTubeMediaContainer.IsShorts <XMLEC> Public Property IsShorts As Boolean = False Implements IYouTubeMediaContainer.IsShorts
<XMLEC> Public Property ID As String Implements IYouTubeMediaContainer.ID, IUserMedia.PostID <XMLEC> Public Property ID As String Implements IYouTubeMediaContainer.ID, IUserMedia.PostID
@@ -709,6 +710,19 @@ Namespace API.YouTube.Objects
End Sub End Sub
#End Region #End Region
#Region "Download" #Region "Download"
Protected Shared Sub CreateUrlFile(ByVal URL As String, ByVal File As SFile)
Try
File.Extension = "url"
Using t As New TextSaver(File)
t.AppendLine("[InternetShortcut]")
t.AppendLine("IDList=")
t.AppendLine($"URL={URL}")
t.AppendLine()
t.Save(EDP.None)
End Using
Catch ex As Exception
End Try
End Sub
Private ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue) Private ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue)
Public Property Progress As MyProgress Implements IYouTubeMediaContainer.Progress Public Property Progress As MyProgress Implements IYouTubeMediaContainer.Progress
Private Property IDownloadableMedia_Progress As Object Implements IDownloadableMedia.Progress Private Property IDownloadableMedia_Progress As Object Implements IDownloadableMedia.Progress
@@ -807,6 +821,13 @@ Namespace API.YouTube.Objects
Try Try
Dim url$ = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={PlsId}" Dim url$ = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={PlsId}"
Dim r$ Dim r$
If DownloadObjects.STDownloader.MyDownloaderSettings.CreateUrlFiles Then
Dim ff As SFile = f
ff.Name = "album"
ff.Extension = "url"
CreateUrlFile(url, ff)
If ff.Exists Then Files.Add(ff)
End If
Using resp As New Responser Using resp As New Responser
If UseCookies And MyYouTubeSettings.Cookies.Count > 0 Then resp.Cookies.AddRange(MyYouTubeSettings.Cookies,, EDP.SendToLog) If UseCookies And MyYouTubeSettings.Cookies.Count > 0 Then resp.Cookies.AddRange(MyYouTubeSettings.Cookies,, EDP.SendToLog)
r = resp.GetResponse(url,, EDP.ReturnValue) r = resp.GetResponse(url,, EDP.ReturnValue)
@@ -882,6 +903,21 @@ Namespace API.YouTube.Objects
End If End If
If Not File.Exists Then _File.Name = File.File If Not File.Exists Then _File.Name = File.File
If File.Exists Then If File.Exists Then
If DownloadObjects.STDownloader.MyDownloaderSettings.CreateUrlFiles Then
Dim fileUrl As SFile = File
fileUrl.Extension = "url"
CreateUrlFile(URL, fileUrl)
If fileUrl.Exists Then Files.Add(fileUrl)
End If
If MyYouTubeSettings.CreateDescriptionFiles And Not Description.IsEmptyString Then
Dim fileDesr As SFile = File
fileDesr.Extension = "txt"
TextSaver.SaveTextToFile(Description, fileDesr,,, EDP.None)
If fileDesr.Exists Then Files.Add(fileDesr)
End If
If PlaylistCount > 0 And Not CoverDownloaded And Not PlaylistID.IsEmptyString Then DownloadPlaylistCover(PlaylistID, File, UseCookies) If PlaylistCount > 0 And Not CoverDownloaded And Not PlaylistID.IsEmptyString Then DownloadPlaylistCover(PlaylistID, File, UseCookies)
If prExists Then Progress.InformationTemporary = $"Download {MediaType}: post processing" If prExists Then Progress.InformationTemporary = $"Download {MediaType}: post processing"
_ThumbnailFile = File _ThumbnailFile = File
@@ -1025,7 +1061,11 @@ Namespace API.YouTube.Objects
If fc.Exists(SFO.Path, False) AndAlso SFile.GetFiles(fc, "*.json",, EDP.ReturnValue).Count > 0 Then Parse(Nothing, fc, IsMusic) If fc.Exists(SFO.Path, False) AndAlso SFile.GetFiles(fc, "*.json",, EDP.ReturnValue).Count > 0 Then Parse(Nothing, fc, IsMusic)
XMLPopulateData(Me, x) XMLPopulateData(Me, x)
_MediaStateOnLoad = _MediaState _MediaStateOnLoad = _MediaState
If Me.MediaState = UMStates.Downloaded Then
_Exists = File.Exists(IIf(ObjectType = YouTubeMediaType.Single, SFO.File, SFO.Path), False)
Else
_Exists = True _Exists = True
End If
If If(x(Name_CheckedElements)?.Count, 0) > 0 Then ApplyElementCheckedValue(x(Name_CheckedElements)) If If(x(Name_CheckedElements)?.Count, 0) > 0 Then ApplyElementCheckedValue(x(Name_CheckedElements))
If ArrayMaxResolution <> -10 Then SetMaxResolution(ArrayMaxResolution) If ArrayMaxResolution <> -10 Then SetMaxResolution(ArrayMaxResolution)
End Using End Using
@@ -1382,18 +1422,27 @@ Namespace API.YouTube.Objects
Protected Sub ParseSubtitles(ByVal e As EContainer) Protected Sub ParseSubtitles(ByVal e As EContainer)
Dim subt As Subtitles Dim subt As Subtitles
Dim ee As EContainer Dim ee As EContainer
Dim se As EContainer = e({"subtitles"}) Dim eSUB As EContainer = e({"subtitles"})
If If(se?.Count, 0) = 0 OrElse (se.Count = 1 And se(0).Name = "live_chat") Then se = e({"automatic_captions"}) Dim eCC As EContainer = e({"automatic_captions"})
If If(se?.Count, 0) > 0 Then If If(eSUB?.Count, 0) = 0 OrElse (eSUB.Count = 1 And eSUB(0).Name = "live_chat") Then eSUB = Nothing
If se.Count > 1 OrElse Not se(0).Name = "live_chat" Then If If(eCC?.Count, 0) = 0 OrElse (eCC.Count = 1 And eCC(0).Name = "live_chat") Then eCC = Nothing
If If(eSUB?.Count, 0) > 0 Or If(eCC?.Count, 0) > 0 Then
Dim sl As New List(Of EContainer)
Dim ccExists As Boolean = False
Dim ccIndx% = -1, rIndx% = -1
If If(eSUB?.Count, 0) > 0 Then sl.Add(eSUB) : ccIndx += 1
If If(eCC?.Count, 0) > 0 Then sl.Add(eCC) : ccIndx += 1 : ccExists = True
For Each se As EContainer In sl
rIndx += 1
For Each ee In se For Each ee In se
subt = New Subtitles With {.ID = ee.Name} subt = New Subtitles With {.ID = ee.Name, .CC = rIndx = ccIndx And ccExists}
If ee.Count > 0 Then If ee.Count > 0 Then
subt.Name = ee(0).Value("name") subt.Name = ee(0).Value("name")
subt.Formats = ee.Select(Function(f) f.Value("ext")).ListToString(",") subt.Formats = ee.Select(Function(f) f.Value("ext")).ListToString(",")
End If End If
If Not subt.ID.IsEmptyString Then _Subtitles.Add(subt) If Not subt.ID.IsEmptyString Then _Subtitles.Add(subt)
Next Next
Next
With MyYouTubeSettings With MyYouTubeSettings
If Not .DefaultSubtitlesFormat.IsEmptyString Then OutputSubtitlesFormat = .DefaultSubtitlesFormat If Not .DefaultSubtitlesFormat.IsEmptyString Then OutputSubtitlesFormat = .DefaultSubtitlesFormat
If _Subtitles.Count > 0 And .DefaultSubtitles.Count > 0 Then If _Subtitles.Count > 0 And .DefaultSubtitles.Count > 0 Then
@@ -1404,7 +1453,6 @@ Namespace API.YouTube.Objects
End If End If
End With End With
End If End If
End If
End Sub End Sub
#End Region #End Region
#Region "IEContainerProvider Support" #Region "IEContainerProvider Support"

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -126,6 +126,7 @@ Namespace API.Base
#Region "XML Declarations" #Region "XML Declarations"
Private Const Name_Site As String = UserInfo.Name_Site Private Const Name_Site As String = UserInfo.Name_Site
Private Const Name_Plugin As String = UserInfo.Name_Plugin Private Const Name_Plugin As String = UserInfo.Name_Plugin
Private Const Name_AccountName As String = UserInfo.Name_AccountName
Protected Const Name_IsChannel As String = "IsChannel" Protected Const Name_IsChannel As String = "IsChannel"
Friend Const Name_UserName As String = "UserName" Friend Const Name_UserName As String = "UserName"
Private Const Name_Model_User As String = UserInfo.Name_Model_User Private Const Name_Model_User As String = UserInfo.Name_Model_User
@@ -168,10 +169,56 @@ Namespace API.Base
Protected Const Name_UseMD5Comparison As String = "UseMD5Comparison" Protected Const Name_UseMD5Comparison As String = "UseMD5Comparison"
Protected Const Name_RemoveExistingDuplicates As String = "RemoveExistingDuplicates" Protected Const Name_RemoveExistingDuplicates As String = "RemoveExistingDuplicates"
Protected Const Name_StartMD5Checked As String = "StartMD5Checked" Protected Const Name_StartMD5Checked As String = "StartMD5Checked"
#Region "Additional names"
Protected Const Name_SiteMode As String = "SiteMode"
Protected Const Name_TrueName As String = "TrueName"
Protected Const Name_Arguments As String = "Arguments"
#End Region
#End Region #End Region
#Region "Declarations" #Region "Declarations"
#Region "Host, Site, Progress" #Region "Host, Site, Progress"
Friend Property HostCollection As SettingsHostCollection
Private Function HostObtainCollection() As Boolean
If HostCollection Is Nothing Then
Dim k$ = If(_HOST?.Key, _HostKey)
If Not k.IsEmptyString Then HostCollection = Settings(k)
End If
Return Not HostCollection Is Nothing
End Function
Private _HOST As SettingsHost
Private _HostKey As String = String.Empty
Private _HostObtained As Boolean = False
Friend Property HOST As SettingsHost Implements IUserData.HOST Friend Property HOST As SettingsHost Implements IUserData.HOST
Get
If _HostObtained Or HostStatic Then
Return _HOST
ElseIf HostObtainCollection() Then
_HOST = HostCollection(AccountName)
_HostObtained = Not _HOST Is Nothing
Return _HOST
Else
Return Nothing
End If
End Get
Set(ByVal h As SettingsHost)
_HOST = h
_HostKey = h.Key
End Set
End Property
Private Sub ResetHost()
_HostObtained = False
End Sub
Friend Property HostStatic As Boolean = False Implements IUserData.HostStatic
Private _AccountName As String = String.Empty
Friend Overridable Property AccountName As String Implements IUserData.AccountName, IPluginContentProvider.AccountName
Get
Return _AccountName.IfNullOrEmpty(User.AccountName)
End Get
Set(ByVal name As String)
If Not _AccountName = name Then ResetHost()
_AccountName = name
End Set
End Property
Friend ReadOnly Property Site As String Implements IUserData.Site Friend ReadOnly Property Site As String Implements IUserData.Site
Get Get
Return HOST.Name Return HOST.Name
@@ -845,6 +892,7 @@ BlockNullPicture:
Friend Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean, Friend Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean,
Optional ByVal AttachUserInfo As Boolean = True) Implements IUserData.SetEnvironment Optional ByVal AttachUserInfo As Boolean = True) Implements IUserData.SetEnvironment
HOST = h HOST = h
HostObtainCollection()
If AttachUserInfo Then If AttachUserInfo Then
User = u User = u
If _LoadUserInformation Then LoadUserInformation() If _LoadUserInformation Then LoadUserInformation()
@@ -853,7 +901,7 @@ BlockNullPicture:
''' <exception cref="ArgumentOutOfRangeException"></exception> ''' <exception cref="ArgumentOutOfRangeException"></exception>
Friend Shared Function GetInstance(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True) As IUserData Friend Shared Function GetInstance(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True) As IUserData
If Not u.Plugin.IsEmptyString Then If Not u.Plugin.IsEmptyString Then
Return Settings(u.Plugin).GetInstance(ISiteSettings.Download.Main, u, _LoadUserInformation) Return Settings(u.Plugin).Default.GetInstance(ISiteSettings.Download.Main, u, _LoadUserInformation)
Else Else
Throw New ArgumentOutOfRangeException("Plugin", $"Plugin [{u.Plugin}] information does not recognized by loader") Throw New ArgumentOutOfRangeException("Plugin", $"Plugin [{u.Plugin}] information does not recognized by loader")
End If End If
@@ -865,7 +913,7 @@ BlockNullPicture:
With DirectCast(u, UserDataBase) With DirectCast(u, UserDataBase)
If Not .User.Plugin.IsEmptyString Then If Not .User.Plugin.IsEmptyString Then
uName = .User.Name uName = .User.Name
Return Settings(.User.Plugin).GetUserPostUrl(.Self, PostData) Return Settings(.User.Plugin).Default.GetUserPostUrl(.Self, PostData)
End If End If
End With End With
End If End If
@@ -937,6 +985,7 @@ BlockNullPicture:
Using x As New XmlFile With {.Name = "User"} Using x As New XmlFile With {.Name = "User"}
x.Add(Name_Site, Site) x.Add(Name_Site, Site)
x.Add(Name_Plugin, HOST.Key) x.Add(Name_Plugin, HOST.Key)
x.Add(Name_AccountName, AccountName)
x.Add(Name_UserName, User.Name) x.Add(Name_UserName, User.Name)
x.Add(Name_Model_User, CInt(UserModel)) x.Add(Name_Model_User, CInt(UserModel))
x.Add(Name_Model_Collection, CInt(CollectionModel)) x.Add(Name_Model_Collection, CInt(CollectionModel))
@@ -1130,11 +1179,13 @@ BlockNullPicture:
End If End If
End Sub End Sub
Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IUserData.DownloadData Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IUserData.DownloadData
ResetHost()
__DOWNLOAD_IN_PROGRESS = True __DOWNLOAD_IN_PROGRESS = True
OnUserDownloadStateChanged(True) OnUserDownloadStateChanged(True)
Dim Canceled As Boolean = False Dim Canceled As Boolean = False
TokenQueue = Token TokenQueue = Token
Try Try
If HOST Is Nothing Then Throw New ExitException($"Host '{AccountName}' not found")
EnvirDownloadSet() EnvirDownloadSet()
If Not Responser Is Nothing Then Responser.Dispose() If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Responser Responser = New Responser
@@ -1291,7 +1342,12 @@ BlockNullPicture:
#Region "DownloadSingleObject" #Region "DownloadSingleObject"
Protected IsSingleObjectDownload As Boolean = False Protected IsSingleObjectDownload As Boolean = False
Friend Overridable Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken) Implements IUserData.DownloadSingleObject Friend Overridable Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken) Implements IUserData.DownloadSingleObject
Dim URL$ = String.Empty
Try Try
ResetHost()
URL = Data.URL
AccountName = Data.AccountName
If HOST Is Nothing Then Throw New ExitException($"Host '{AccountName}' not found")
Data.DownloadState = UserMediaStates.Tried Data.DownloadState = UserMediaStates.Tried
Progress = Data.Progress Progress = Data.Progress
If Not Progress Is Nothing Then Progress.ResetProgressOnMaximumChanges = False If Not Progress Is Nothing Then Progress.ResetProgressOnMaximumChanges = False
@@ -1305,9 +1361,21 @@ BlockNullPicture:
DownloadSingleObject_CreateMedia(Data, Token) DownloadSingleObject_CreateMedia(Data, Token)
DownloadSingleObject_Download(Data, Token) DownloadSingleObject_Download(Data, Token)
DownloadSingleObject_PostProcessing(Data) DownloadSingleObject_PostProcessing(Data)
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Data.DownloadState = UserMediaStates.Missing
ErrorsDescriber.Execute(EDP.SendToLog, oex, $"{Site} download canceled: {URL}")
Catch dex As ObjectDisposedException When Disposed
Catch exit_ex As ExitException
If Not exit_ex.Silent Then
If exit_ex.SimpleLogLine Then
MyMainLOG = $"{URL}: downloading canceled (exit) ({exit_ex.Message})"
Else
ErrorsDescriber.Execute(EDP.SendToLog, exit_ex, $"{URL}: downloading canceled (exit)")
End If
End If
Catch ex As Exception Catch ex As Exception
Data.DownloadState = UserMediaStates.Missing Data.DownloadState = UserMediaStates.Missing
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"{Site} single data downloader error: {Data.URL}") ErrorsDescriber.Execute(EDP.SendToLog, ex, $"{Site} single data downloader error: {URL}")
End Try End Try
End Sub End Sub
Protected Overridable Sub DownloadSingleObject_CreateMedia(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken) Protected Overridable Sub DownloadSingleObject_CreateMedia(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken)
@@ -2112,7 +2180,11 @@ BlockNullPicture:
#End Region #End Region
#Region "IComparable Support" #Region "IComparable Support"
Friend Overridable Function CompareTo(ByVal Other As UserDataBase) As Integer Implements IComparable(Of UserDataBase).CompareTo Friend Overridable Function CompareTo(ByVal Other As UserDataBase) As Integer Implements IComparable(Of UserDataBase).CompareTo
If IsCollection Then
Return Name.CompareTo(Other.Name) Return Name.CompareTo(Other.Name)
Else
Return FriendlyName.IfNullOrEmpty(Name).StringTrim.CompareTo(Other.FriendlyName.IfNullOrEmpty(Other.Name).StringTrim)
End If
End Function End Function
Friend Overridable Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo Friend Overridable Function CompareTo(ByVal Obj As Object) As Integer Implements IComparable.CompareTo
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserDataBase Then If Not Obj Is Nothing AndAlso TypeOf Obj Is UserDataBase Then

View File

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

View File

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

View File

@@ -0,0 +1,37 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Text.RegularExpressions
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Facebook
Friend Module Declarations
Friend ReadOnly Regex_UserToken_dtsg As RParams = RParams.DMS("DTSGInitialData.:.?{\s*.token.:\s*""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_UserToken_lsd As RParams = RParams.DMS("LSD.:.?{\s*.token.:\s*""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_UserID As RParams = RParams.DMS("userid.:.(\d+)", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly Regex_Photos_by As RParams = RParams.DMS("photos_by"",""id"":""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_FileName As RParams = RParams.DM("([^/\?]+\..{3,4})(?=(\?|\Z))", 0, EDP.ReturnValue)
Friend ReadOnly Regex_ProfileUrlID As RParams = RParams.DMS("profile.php\?id=(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_VideoPageID As RParams = RParams.DMS("pageid.:.(\d+)", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly Regex_StoryBucket As RParams = RParams.DMS("story_bucket[^\>]*?(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_VideoIDFromURL As RParams = RParams.DMS("facebook.com/([^/]+/videos/|watch/\D*[\?&]{1}v=)(\d+)", 2, EDP.ReturnValue)
Friend ReadOnly Regex_PostHtmlFullPicture As RParams = RParams.DM("^((?!_[ps]{1}\d+x\d+).)*$", 0, EDP.ReturnValue)
Friend ReadOnly SpecialNode() As NodeParams = {New NodeParams("attachment", True, True, True, True, 30),
New NodeParams("media", True, True, True, True, 0),
New NodeParams("photo_image", True, True, True, True, 0),
New NodeParams("uri", True, True, True, True, 0)}
Friend ReadOnly SpecialNode2() As NodeParams = {New NodeParams("result", True, True, True, True, 30),
New NodeParams("data", True, True, True, True, 0),
New NodeParams("currmedia", True, True, True, True, 0),
New NodeParams("image", True, True, True, True, 0),
New NodeParams("uri", True, True, True, True, 0)}
End Module
End Namespace

View File

@@ -0,0 +1,110 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Facebook
<Manifest("AndyProgram_Facebook"), SavedPosts, SeparatedTasks(1), SpecialForm(False)>
Friend Class SiteSettings : Inherits ThreadsNet.SiteSettings
#Region "Declarations"
#Region "Auth"
<PropertyOption(AllowNull:=False, ControlText:="Accept", ControlToolTip:="Header 'Accept'", IsAuth:=True), ControlNumber(21), PXML, PClonable>
Friend ReadOnly Property Header_Accept As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", AllowNull:=True, IsAuth:=True)>
Friend Overrides ReadOnly Property HH_IG_APP_ID As PropertyValue
Get
Return __HH_IG_APP_ID
End Get
End Property
<DoNotUse> Friend Overrides ReadOnly Property HH_CSRF_TOKEN As PropertyValue
Get
Return __HH_CSRF_TOKEN
End Get
End Property
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", IsAuth:=True, LeftOffset:=120), ControlNumber(51), PXML, PClonable>
Friend ReadOnly Property HH_PLATFORM_VER As PropertyValue
#End Region
#Region "Defaults"
<PropertyOption(ControlText:="Download photos", IsAuth:=False), PXML, PClonable>
Friend ReadOnly Property ParsePhotoBlock As PropertyValue
<PropertyOption(ControlText:="Download videos", IsAuth:=False), PXML, PClonable>
Friend ReadOnly Property ParseVideoBlock As PropertyValue
<PropertyOption(ControlText:="Download stories", IsAuth:=False), PXML, PClonable>
Friend ReadOnly Property ParseStoriesBlock As PropertyValue
#End Region
#End Region
#Region "Initializer"
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("Facebook", "facebook.com", AccName, Temp, My.Resources.SiteResources.FacebookIcon_32, My.Resources.SiteResources.FacebookPic_37)
With Responser.Headers
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.facebook.com"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Origin, "https://www.facebook.com"))
.Remove(DeclaredNames.Header_FB_FRIENDLY_NAME)
End With
Header_Accept = New PropertyValue(String.Empty, GetType(String))
HH_PLATFORM_VER = New PropertyValue(String.Empty, GetType(String))
ParsePhotoBlock = New PropertyValue(True)
ParseVideoBlock = New PropertyValue(True)
ParseStoriesBlock = New PropertyValue(True)
UrlPatternUser = "https://www.facebook.com/{0}"
UserRegex = RParams.DMS("facebook.com/(profile.php\?id=\d+|[^\?&/]+)", 1)
ImageVideoContains = "facebook.com"
UserOptionsType = GetType(UserExchangeOptions)
End Sub
#End Region
#Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
#End Region
#Region "UpdateResponserData"
Friend Overrides Sub UpdateResponserData(ByVal Resp As Responser)
With Responser.Cookies
.Update(Resp.Cookies)
If .Changed Then Responser.SaveCookies() : .Changed = False
End With
End Sub
#End Region
#Region "BaseAuthExists, GetUserUrl, GetUserPostUrl, IsMyUser, IsMyImageVideo"
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists And ACheck(HH_IG_APP_ID.Value)
End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return DirectCast(User, UserData).GetProfileUrl
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return Media.URL_BASE
End Function
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim e As ExchangeOptions = MyBase.IsMyUser(UserURL)
If e.Exists Then
e.Options = e.UserName
Dim v$ = RegexReplace(e.UserName, Regex_ProfileUrlID)
If Not v.IsEmptyString Then
e.UserName = v
Else
e.UserName = e.UserName.StringRemoveWinForbiddenSymbols
End If
End If
Return e
End Function
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
If Not URL.IsEmptyString AndAlso Not CStr(AConvert(Of String)(URL, Regex_VideoIDFromURL, String.Empty)).IsEmptyString Then
Return New ExchangeOptions(Site, String.Empty) With {.Exists = True}
Else
Return Nothing
End If
End Function
#End Region
End Class
End Namespace

View File

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

View File

@@ -0,0 +1,32 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes
Namespace API.Facebook
Friend Class UserExchangeOptions
<PSetting(NameOf(SiteSettings.ParsePhotoBlock), NameOf(MySettings))>
Friend Property ParsePhotoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseVideoBlock), NameOf(MySettings))>
Friend Property ParseVideoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseStoriesBlock), NameOf(MySettings))>
Friend Property ParseStoriesBlock As Boolean = True
Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
MySettings = u.HostCollection.Default.Source
ParsePhotoBlock = u.ParsePhotoBlock
ParseVideoBlock = u.ParseVideoBlock
ParseStoriesBlock = u.ParseStoriesBlock
End Sub
Friend Sub New(ByVal s As SiteSettings)
MySettings = s
ParsePhotoBlock = s.ParsePhotoBlock.Value
ParseVideoBlock = s.ParseVideoBlock.Value
ParseStoriesBlock = s.ParseStoriesBlock.Value
End Sub
End Class
End Namespace

View File

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

View File

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

View File

@@ -17,6 +17,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Instagram Namespace API.Instagram
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
#Region "XML Names" #Region "XML Names"
@@ -70,7 +71,7 @@ Namespace API.Instagram
Return DirectCast(HOST.Source, SiteSettings) Return DirectCast(HOST.Source, SiteSettings)
End Get End Get
End Property End Property
Private ReadOnly PostsKVIDs As List(Of PostKV) Protected ReadOnly PostsKVIDs As List(Of PostKV)
Private ReadOnly PostsToReparse As List(Of PostKV) Private ReadOnly PostsToReparse As List(Of PostKV)
Private LastCursor As String = String.Empty Private LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = False Private FirstLoadingDone As Boolean = False
@@ -174,7 +175,7 @@ Namespace API.Instagram
End If End If
End If End If
End Sub End Sub
Private Overloads Function PostKvExists(ByVal pkv As PostKV) As Boolean Protected Overloads Function PostKvExists(ByVal pkv As PostKV) As Boolean
Return PostKvExists(pkv.ID, False, pkv.Section) OrElse PostKvExists(pkv.Code, True, pkv.Section) Return PostKvExists(pkv.ID, False, pkv.Section) OrElse PostKvExists(pkv.Code, True, pkv.Section)
End Function End Function
Private Overloads Function PostKvExists(ByVal PostCodeId As String, ByVal IsCode As Boolean, ByVal Section As Sections) As Boolean Private Overloads Function PostKvExists(ByVal PostCodeId As String, ByVal IsCode As Boolean, ByVal Section As Sections) As Boolean
@@ -296,7 +297,7 @@ Namespace API.Instagram
Declarations.UpdateResponser(e, Responser) Declarations.UpdateResponser(e, Responser)
End Sub End Sub
Protected Enum Sections : Timeline : Tagged : Stories : UserStories : SavedPosts : End Enum Protected Enum Sections : Timeline : Tagged : Stories : UserStories : SavedPosts : End Enum
Private Const StoriesFolder As String = "Stories" Protected Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged" Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass" #Region "429 bypass"
Private Const MaxPostsCount As Integer = 200 Private Const MaxPostsCount As Integer = 200
@@ -665,7 +666,8 @@ Namespace API.Instagram
Protected DefaultParser_IgnorePass As Boolean = False Protected DefaultParser_IgnorePass As Boolean = False
Protected DefaultParser_PostUrlCreator As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/" Protected DefaultParser_PostUrlCreator As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/"
Protected Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken, Protected Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
Optional ByVal SpecFolder As String = Nothing) As Boolean Optional ByVal SpecFolder As String = Nothing, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0) As Boolean
ThrowAny(Token) ThrowAny(Token)
If Items.Count > 0 Then If Items.Count > 0 Then
Dim PostIDKV As PostKV Dim PostIDKV As PostKV
@@ -699,7 +701,7 @@ Namespace API.Instagram
End Select End Select
End If End If
before = _TempMediaList.Count before = _TempMediaList.Count
ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate,, PostOriginUrl) ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate,, PostOriginUrl, State, Attempts)
If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1 If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
If _Limit > 0 And _TotalPostsParsed >= _Limit Then Return False If _Limit > 0 And _TotalPostsParsed >= _Limit Then Return False
End If End If
@@ -737,7 +739,8 @@ Namespace API.Instagram
Protected ObtainMedia_AllowAbstract As Boolean = False Protected ObtainMedia_AllowAbstract As Boolean = False
Protected Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing, Protected Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj As String = Nothing, Optional ByVal InitialType As Integer = -1, Optional ByVal DateObj As String = Nothing, Optional ByVal InitialType As Integer = -1,
Optional ByVal PostOriginUrl As String = Nothing) Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0)
Try Try
Dim wrongData As Predicate(Of Sizes) = Function(_ss) _ss.HasError Or _ss.Data.IsEmptyString Dim wrongData As Predicate(Of Sizes) = Function(_ss) _ss.HasError Or _ss.Data.IsEmptyString
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0 Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
@@ -798,7 +801,7 @@ Namespace API.Instagram
If l.Count > 0 Then l.RemoveAll(wrongData) If l.Count > 0 Then l.RemoveAll(wrongData)
If l.Count > 0 Then If l.Count > 0 Then
l.Sort() l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl), LNC) _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl, State, Attempts), LNC)
l.Clear() l.Clear()
End If End If
End If End If
@@ -815,7 +818,7 @@ Namespace API.Instagram
If l.Count > 0 Then l.RemoveAll(wrongData) If l.Count > 0 Then l.RemoveAll(wrongData)
If l.Count > 0 Then If l.Count > 0 Then
l.Sort() l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl), LNC) _TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder, PostOriginUrl, State, Attempts), LNC)
l.Clear() l.Clear()
End If End If
End If End If
@@ -970,7 +973,8 @@ Namespace API.Instagram
Try Try
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/highlights/{ID}/highlights_tray/",, EDP.ThrowException) Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/highlights/{ID}/highlights_tray/",, EDP.ThrowException)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing()("tray").XmlIfNothing Dim ee As New ErrorsDescriber(EDP.ReturnValue) With {.DeclaredMessage = New MMessage($"{ToStringForLog()}:")}
Using j As EContainer = JsonDocument.Parse(r, ee).XmlIfNothing()("tray").XmlIfNothing
If j.Count > 0 Then Return j.Select(Function(jj) jj.Value("id").Replace("highlight:", String.Empty)).ListIfNothing If j.Count > 0 Then Return j.Select(Function(jj) jj.Value("id").Replace("highlight:", String.Empty)).ListIfNothing
End Using End Using
End If End If
@@ -1007,7 +1011,7 @@ Namespace API.Instagram
Optional ByVal s As Object = Nothing) As Integer Optional ByVal s As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then '404 If Responser.StatusCode = HttpStatusCode.NotFound Then '404
If Not UserNameRequested AndAlso GetUserNameById() Then Return 1 Else UserExists = False If Not UserNameRequested AndAlso GetUserNameById() Then Return 1 Else UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then '400 ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Or Responser.StatusCode = HttpStatusCode.Unauthorized Then '400, 401
HasError = True HasError = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]" MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
DisableSection(s) DisableSection(s)
@@ -1049,12 +1053,14 @@ Namespace API.Instagram
#End Region #End Region
#Region "Create media" #Region "Create media"
Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String, Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal SpecialFolder As String = Nothing, Optional ByVal PostOriginUrl As String = Nothing) As UserMedia Optional ByVal SpecialFolder As String = Nothing, Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern)) _URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.URL_BASE = PostOriginUrl.IfNullOrEmpty(_URL), .Post = New UserPost With {.ID = PostID}} Dim m As New UserMedia(_URL, t) With {.URL_BASE = PostOriginUrl.IfNullOrEmpty(_URL), .Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern)) If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, UnixDate32Provider, Nothing) Else m.Post.Date = Nothing If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, UnixDate32Provider, Nothing) Else m.Post.Date = Nothing
m.SpecialFolder = SpecialFolder m.SpecialFolder = SpecialFolder
If State = UStates.Missing Then m.State = UStates.Missing : m.Attempts = Attempts
Return m Return m
End Function End Function
#End Region #End Region

View File

@@ -24,6 +24,7 @@ Namespace API.JustForFans
Private DestinationFile As SFile Private DestinationFile As SFile
Private ReadOnly Thrower As Plugin.IThrower Private ReadOnly Thrower As Plugin.IThrower
Private ReadOnly Responser As Responser Private ReadOnly Responser As Responser
Private ReadOnly ResponserInternal As Boolean
Private Const R_VIDEO_REGEX_PATTERN As String = "(#EXT-X-STREAM-INF)(.+)(RESOLUTION=\d+x)(\d+)(.+""\s*)(\S+)(\s*)" Private Const R_VIDEO_REGEX_PATTERN As String = "(#EXT-X-STREAM-INF)(.+)(RESOLUTION=\d+x)(\d+)(.+""\s*)(\S+)(\s*)"
Private ReadOnly REGEX_AUDIO_URL As RParams = RParams.DMS("EXT-X-MEDIA.*?URI=.([^""]+)"".*?TYPE=""AUDIO""", 1, EDP.ReturnValue) Private ReadOnly REGEX_AUDIO_URL As RParams = RParams.DMS("EXT-X-MEDIA.*?URI=.([^""]+)"".*?TYPE=""AUDIO""", 1, EDP.ReturnValue)
Private ReadOnly REGEX_PLS_FILES As RParams = RParams.DM("EXT-X-MAP:URI=""([^""]+)""|EXTINF.+?[\r\n]{1,2}(.+)", 0, RegexReturn.List, EDP.ReturnValue) Private ReadOnly REGEX_PLS_FILES As RParams = RParams.DM("EXT-X-MAP:URI=""([^""]+)""|EXTINF.+?[\r\n]{1,2}(.+)", 0, RegexReturn.List, EDP.ReturnValue)
@@ -37,20 +38,24 @@ Namespace API.JustForFans
Private ReadOnly ProgressPre As PreProgress Private ReadOnly ProgressPre As PreProgress
Private ReadOnly ProgressExists As Boolean Private ReadOnly ProgressExists As Boolean
Private ReadOnly UsePreProgress As Boolean Private ReadOnly UsePreProgress As Boolean
Private Property Token As CancellationToken
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Private Sub New(ByVal m As UserMedia, ByVal Destination As SFile, ByVal Resp As Responser, ByVal _Thrower As Plugin.IThrower, Private Sub New(ByVal m As UserMedia, ByVal Destination As SFile, ByVal Resp As Responser, ByVal _Thrower As Plugin.IThrower,
ByVal _Progress As MyProgress, ByVal _UsePreProgress As Boolean) ByVal _Progress As MyProgress, ByVal _UsePreProgress As Boolean, ByVal _Token As CancellationToken)
Media = m Media = m
DataVideo = New List(Of String) DataVideo = New List(Of String)
DataAudio = New List(Of String) DataAudio = New List(Of String)
DestinationFile = Destination DestinationFile = Destination
Thrower = _Thrower Thrower = _Thrower
Responser = Resp 'Responser = Resp
Responser = New Responser
ResponserInternal = True
Progress = _Progress Progress = _Progress
ProgressExists = Not Progress Is Nothing ProgressExists = Not Progress Is Nothing
If ProgressExists Then ProgressPre = New PreProgress(Progress) If ProgressExists Then ProgressPre = New PreProgress(Progress)
UsePreProgress = _UsePreProgress UsePreProgress = _UsePreProgress
Token = _Token
Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{M3U8Base.TempCacheFolderName}\") Cache = New CacheKeeper($"{DestinationFile.PathWithSeparator}_{M3U8Base.TempCacheFolderName}\")
With Cache With Cache
.CacheDeleteError = CacheDeletionError(Cache) .CacheDeleteError = CacheDeletionError(Cache)
@@ -101,49 +106,15 @@ Namespace API.JustForFans
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim data As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {REGEX_PLS_FILES}, {1, 2}, EDP.ReturnValue) Dim data As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {REGEX_PLS_FILES}, {1, 2}, EDP.ReturnValue)
If data.ListExists Then If data.ListExists Then
Dim appender$ = URL.Replace(URL.Split("/").LastOrDefault, String.Empty)
With (From d As RegexMatchStruct In data
Where Not d.Arr(0).IfNullOrEmpty(d.Arr(1)).IsEmptyString
Select M3U8Base.CreateUrl(appender, d.Arr(0).IfNullOrEmpty(d.Arr(1)))).ToList
If .ListExists Then
File = $"{Cache.RootDirectory.PathWithSeparator}{IIf(IsAudio, "AUDIO.aac", "VIDEO.mp4")}" File = $"{Cache.RootDirectory.PathWithSeparator}{IIf(IsAudio, "AUDIO.aac", "VIDEO.mp4")}"
Dim tmpCache As CacheKeeper = Cache.NewInstance Using b As New TokenBatch(Token) With {.Encoding = Settings.CMDEncoding, .MainProcessName = "ffmpeg"}
Dim tmpFile As SFile = .Item(0) AddHandler b.ErrorDataReceived, AddressOf Batch_OutputDataReceived
If tmpFile.Extension.IsEmptyString Then tmpFile.Extension = "ts" ProgressChangeMax(data.Count)
tmpFile.Path = tmpCache.RootDirectory.Path b.ChangeDirectory(Cache.RootDirectory)
tmpFile.Separator = "\" b.Execute($"""{Settings.FfmpegFile}"" -i {URL} -vcodec copy -strict -2 ""{File}""")
Token.ThrowIfCancellationRequested()
Dim cFile As SFile = tmpFile
cFile.Name = "all"
tmpCache.Validate()
Using bat As New TextSaver
Using b As New BatchExecutor(True) With {.Encoding = Settings.CMDEncoding}
AddHandler b.OutputDataReceived, AddressOf Batch_OutputDataReceived
bat.AppendLine($"chcp {BatchExecutor.UnicodeEncoding}")
bat.AppendLine(BatchExecutor.GetDirectoryCommand(tmpCache))
ProgressChangeMax(.Count * 2 + 1)
For i = 0 To .Count - 1
tmpFile.Name = $"ConPart_{i}"
Thrower.ThrowAny()
Responser.DownloadFile(.Item(i), tmpFile)
ProgressPerform()
tmpCache.AddFile(tmpFile, True)
bat.AppendLine($"type {tmpFile.File} >> {cFile.File}")
Next
bat.AppendLine($"""{Settings.FfmpegFile}"" -i {cFile.File} -c copy ""{File}""")
Dim batFile As SFile = bat.SaveAs($"{tmpCache.RootDirectory.PathWithSeparator}command.bat")
b.Execute($"""{batFile}""")
If Not File.Exists Then File = Nothing If Not File.Exists Then File = Nothing
End Using End Using
End Using
End If
End With
End If End If
End If End If
Catch oex As OperationCanceledException Catch oex As OperationCanceledException
@@ -155,8 +126,72 @@ Namespace API.JustForFans
$"API.JustForFans.M3U8.GetFiles({IIf(IsAudio, "audio", "video")}):{vbCr}URL: {URL}{vbCr}File: {File}") $"API.JustForFans.M3U8.GetFiles({IIf(IsAudio, "audio", "video")}):{vbCr}URL: {URL}{vbCr}File: {File}")
End Try End Try
End Sub End Sub
'TODELETE: JFF.M3U8.GetFiles_OLD 20231008
'Private Sub GetFiles_OLD(ByVal URL As String, ByRef File As SFile, ByVal IsAudio As Boolean)
' Try
' Dim r$ = Responser.GetResponse(URL)
' If Not r.IsEmptyString Then
' Dim data As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {REGEX_PLS_FILES}, {1, 2}, EDP.ReturnValue)
' If data.ListExists Then
' Dim appender$ = URL.Replace(URL.Split("/").LastOrDefault, String.Empty)
' With (From d As RegexMatchStruct In data
' Where Not d.Arr(0).IfNullOrEmpty(d.Arr(1)).IsEmptyString
' Select M3U8Base.CreateUrl(appender, d.Arr(0).IfNullOrEmpty(d.Arr(1)).Trim)).ToList
' If .ListExists Then
' File = $"{Cache.RootDirectory.PathWithSeparator}{IIf(IsAudio, "AUDIO.aac", "VIDEO.mp4")}"
' Dim tmpCache As CacheKeeper = Cache.NewInstance
' Dim tmpFile As SFile = .Item(0)
' If tmpFile.Extension.IsEmptyString Then tmpFile.Extension = "ts"
' tmpFile.Path = tmpCache.RootDirectory.Path
' tmpFile.Separator = "\"
' Dim cFile As SFile = tmpFile
' cFile.Name = "all"
' tmpCache.Validate()
' Using bat As New TextSaver
' Using b As New BatchExecutor(True) With {.Encoding = Settings.CMDEncoding}
' AddHandler b.OutputDataReceived, AddressOf Batch_OutputDataReceived
' bat.AppendLine($"chcp {BatchExecutor.UnicodeEncoding}")
' bat.AppendLine(BatchExecutor.GetDirectoryCommand(tmpCache))
' ProgressChangeMax(.Count * 2 + 1)
' Using w As New WebClient
' For i = 0 To .Count - 1
' tmpFile.Name = $"ConPart_{i}"
' Thrower.ThrowAny()
' 'Responser.DownloadFile(.Item(i), tmpFile)
' w.DownloadFile(.Item(i), tmpFile)
' ProgressPerform()
' tmpCache.AddFile(tmpFile, True)
' bat.AppendLine($"type {tmpFile.File} >> {cFile.File}")
' Next
' End Using
' bat.AppendLine($"""{Settings.FfmpegFile}"" -i {cFile.File} -c copy ""{File}""")
' Dim batFile As SFile = bat.SaveAs($"{tmpCache.RootDirectory.PathWithSeparator}command.bat")
' b.Execute($"""{batFile}""")
' If Not File.Exists Then File = Nothing
' End Using
' End Using
' End If
' End With
' End If
' End If
' Catch oex As OperationCanceledException
' Throw oex
' Catch dex As ObjectDisposedException
' Throw dex
' Catch ex As Exception
' ErrorsDescriber.Execute(EDP.SendToLog + EDP.ThrowException, ex,
' $"API.JustForFans.M3U8.GetFiles({IIf(IsAudio, "audio", "video")}):{vbCr}URL: {URL}{vbCr}File: {File}")
' End Try
'End Sub
Private Async Sub Batch_OutputDataReceived(ByVal Sender As Object, ByVal e As DataReceivedEventArgs) Private Async Sub Batch_OutputDataReceived(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
Await Task.Run(Sub() ProgressPerform()) Await Task.Run(Sub() If Not e.Data.IsEmptyString AndAlso e.Data.Contains("] Opening") Then ProgressPerform())
End Sub End Sub
Private Sub MergeFiles() Private Sub MergeFiles()
Try Try
@@ -194,8 +229,8 @@ Namespace API.JustForFans
#End Region #End Region
#Region "Static Download" #Region "Static Download"
Friend Shared Function Download(ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Resp As Responser, ByVal Thrower As Plugin.IThrower, Friend Shared Function Download(ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Resp As Responser, ByVal Thrower As Plugin.IThrower,
ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean, ByVal _Token As CancellationToken) As SFile
Using m As New M3U8(Media, DestinationFile, Resp, Thrower, Progress, UsePreProgress) Using m As New M3U8(Media, DestinationFile, Resp, Thrower, Progress, UsePreProgress, _Token)
m.Download() m.Download()
If m.DestinationFile.Exists Then Return m.DestinationFile Else Return Nothing If m.DestinationFile.Exists Then Return m.DestinationFile Else Return Nothing
End Using End Using
@@ -210,6 +245,7 @@ Namespace API.JustForFans
DataAudio.Clear() DataAudio.Clear()
ProgressPre.DisposeIfReady ProgressPre.DisposeIfReady
Cache.Dispose() Cache.Dispose()
If ResponserInternal Then Responser.DisposeIfReady
End If End If
disposedValue = True disposedValue = True
End If End If

View File

@@ -15,32 +15,22 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.JustForFans Namespace API.JustForFans
<Manifest("AndyProgram_JustForFans"), SavedPosts, SeparatedTasks(1)> <Manifest("AndyProgram_JustForFans"), SavedPosts, SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.JFFIcon_64
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.JFFPic_76
End Get
End Property
Friend Const UserHash4_CookieName As String = "userhash4" Friend Const UserHash4_CookieName As String = "userhash4"
<PropertyOption(ControlText:="User ID", AllowNull:=False), PXML> <PropertyOption(ControlText:="User ID", AllowNull:=False), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property UserID As PropertyValue Friend ReadOnly Property UserID As PropertyValue
<PropertyOption, PXML> <PropertyOption, PXML, PClonable(Clone:=False)>
Friend ReadOnly Property UserHash4 As PropertyValue Friend ReadOnly Property UserHash4 As PropertyValue
<PropertyOption(ControlText:="Accept", ControlToolTip:="Header 'Accept'")> <PropertyOption(ControlText:="Accept", ControlToolTip:="Header 'Accept'"), PClonable>
Friend ReadOnly Property HeaderAccept As PropertyValue Friend ReadOnly Property HeaderAccept As PropertyValue
<PropertyOption> Friend ReadOnly Property UserAgent As PropertyValue <PropertyOption, PClonable> Friend ReadOnly Property UserAgent As PropertyValue
Private Sub UpdateHeader(ByVal HeaderName As String, ByVal HeaderValue As String) Private Sub UpdateHeader(ByVal HeaderName As String, ByVal HeaderValue As String)
Select Case HeaderName Select Case HeaderName
Case NameOf(HeaderAccept) : If HeaderValue.IsEmptyString Then Responser.Accept = Nothing Else Responser.Accept = HeaderValue Case NameOf(HeaderAccept) : If HeaderValue.IsEmptyString Then Responser.Accept = Nothing Else Responser.Accept = HeaderValue
Case NameOf(UserAgent) : If Not HeaderValue.IsEmptyString Then Responser.UserAgent = HeaderValue Case NameOf(UserAgent) : If Not HeaderValue.IsEmptyString Then Responser.UserAgent = HeaderValue
End Select End Select
End Sub End Sub
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("JustForFans", "justfor.fans") MyBase.New("JustForFans", "justfor.fans", AccName, Temp, My.Resources.SiteResources.JFFIcon_64, My.Resources.SiteResources.JFFPic_76)
With Responser With Responser
.CookiesExtractMode = Responser.CookiesExtractModes.Any .CookiesExtractMode = Responser.CookiesExtractModes.Any
@@ -53,7 +43,7 @@ Namespace API.JustForFans
UserID = New PropertyValue(String.Empty, GetType(String)) UserID = New PropertyValue(String.Empty, GetType(String))
UserHash4 = New PropertyValue(String.Empty, GetType(String)) UserHash4 = New PropertyValue(String.Empty, GetType(String))
HeaderAccept = New PropertyValue(Responser.Accept.Value, GetType(String), Sub(v) UpdateHeader(NameOf(HeaderAccept), v)) HeaderAccept = New PropertyValue(Responser.Accept.Value, GetType(String), Sub(v) UpdateHeader(NameOf(HeaderAccept), v))
UserAgent = New PropertyValue(Responser.UserAgent, GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v)) UserAgent = New PropertyValue(If(Responser.UserAgentExists, Responser.UserAgent, String.Empty), GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v))
_AllowUserAgentUpdate = False _AllowUserAgentUpdate = False
UserRegex = RParams.DMS("https://justfor.fans/([^/\?]+)", 1, EDP.ReturnValue) UserRegex = RParams.DMS("https://justfor.fans/([^/\?]+)", 1, EDP.ReturnValue)
@@ -82,7 +72,7 @@ Namespace API.JustForFans
End If End If
End Sub End Sub
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return Responser.CookiesExists And ACheck(UserID.Value) And ACheck(UserHash4.Value) Return Settings.FfmpegFile.Exists And Responser.CookiesExists And ACheck(UserID.Value) And ACheck(UserHash4.Value)
End Function End Function
End Class End Class
End Namespace End Namespace

View File

@@ -168,7 +168,8 @@ Namespace API.JustForFans
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
UseInternalM3U8Function = True UseInternalM3U8Function = True
UseResponserClient = True 'TODELETE: UseResponserClient 20231008
'UseResponserClient = True
End Sub End Sub
#End Region #End Region
#Region "Download functions" #Region "Download functions"
@@ -176,10 +177,13 @@ Namespace API.JustForFans
Private _Limit As Integer = -1 Private _Limit As Integer = -1
Private FileSerialInstance As FileSerial Private FileSerialInstance As FileSerial
Private _UserHash4 As String = String.Empty Private _UserHash4 As String = String.Empty
Private Sub InitializeFileSerial()
If FileSerialInstance Is Nothing Then FileSerialInstance = New FileSerial(DownloadContentDefault_GetRootDir())
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try Try
_UserHash4 = MySettings.UserHash4.Value _UserHash4 = MySettings.UserHash4.Value
FileSerialInstance = New FileSerial(DownloadContentDefault_GetRootDir()) InitializeFileSerial()
Responser.Cookies.Changed = False Responser.Cookies.Changed = False
If Not ResponserNoHandlers Is Nothing Then ResponserNoHandlers.Dispose() : ResponserNoHandlers = Nothing If Not ResponserNoHandlers Is Nothing Then ResponserNoHandlers.Dispose() : ResponserNoHandlers = Nothing
ResponserNoHandlers = Responser.Copy ResponserNoHandlers = Responser.Copy
@@ -233,7 +237,7 @@ Namespace API.JustForFans
Select Case CheckDatesLimit(post.PostDate, Nothing) Select Case CheckDatesLimit(post.PostDate, Nothing)
Case DateResult.Skip : Continue For Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub Case DateResult.Exit : If post.Pinned Then Continue For Else Exit Sub
End Select End Select
_DownloadedPostsCount += 1 _DownloadedPostsCount += 1
@@ -290,8 +294,14 @@ Namespace API.JustForFans
Dim rList As New List(Of Integer) Dim rList As New List(Of Integer)
Try Try
If ContentMissingExists Then If ContentMissingExists Then
InitializeFileSerial()
Dim r$ Dim r$
Dim m As UserMedia Dim m As UserMedia
Dim stateRefill As Func(Of UserMedia, Integer, UserMedia) = Function(ByVal input As UserMedia, ByVal ii As Integer) As UserMedia
input.State = UserMedia.States.Missing
input.Attempts = m.Attempts
Return input
End Function
Dim p As PostBlock Dim p As PostBlock
Dim rErr As New ErrorsDescriber(EDP.ReturnValue) Dim rErr As New ErrorsDescriber(EDP.ReturnValue)
For i% = 0 To _ContentList.Count - 1 For i% = 0 To _ContentList.Count - 1
@@ -304,7 +314,7 @@ Namespace API.JustForFans
If .ListExists Then If .ListExists Then
rList.Add(i) rList.Add(i)
For Each p In .Self For Each p In .Self
If p.Valid Then _TempMediaList.ListAddList(p.GetUserMedia(FileSerialInstance), LNC) If p.Valid Then _TempMediaList.ListAddList(p.GetUserMedia(FileSerialInstance).ListForEachCopy(stateRefill, True), LNC)
Next Next
End If End If
End With End With
@@ -327,7 +337,7 @@ Namespace API.JustForFans
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(Media, DestinationFile, ResponserNoHandlers, Me, Progress, Not IsSingleObjectDownload) Return M3U8.Download(Media, DestinationFile, ResponserNoHandlers, Me, Progress, Not IsSingleObjectDownload, Token)
End Function End Function
#End Region #End Region
#Region "DownloadSingleObject" #Region "DownloadSingleObject"

View File

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

View File

@@ -1,65 +0,0 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Namespace API.Mastodon
Friend Class MastodonDomains : Inherits DomainsContainer
Friend ReadOnly Property Credentials As List(Of Credentials)
Friend ReadOnly Property CredentialsTemp As List(Of Credentials)
Private ReadOnly CredentialsFile As SFile = $"{SettingsFolderName}\Responser_Mastodon_DomainsCredentials.xml"
Friend Sub New(ByVal _Instance As ISiteSettings, ByVal DefaultValue As String)
MyBase.New(_Instance, DefaultValue)
Credentials = New List(Of Credentials)
CredentialsTemp = New List(Of Credentials)
If CredentialsFile.Exists Then
Using x As New XmlFile(CredentialsFile,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then Credentials.ListAddList(x, LAP.IgnoreICopier)
End Using
End If
End Sub
Friend Overrides Function Apply() As Boolean
If Changed Then
Credentials.Clear()
If CredentialsTemp.Count > 0 Then Credentials.AddRange(CredentialsTemp)
CredentialsTemp.Clear()
End If
Return MyBase.Apply()
End Function
Friend Overrides Sub Save()
If Credentials.Count > 0 Then
Using x As New XmlFile With {.AllowSameNames = True}
x.AddRange(Credentials)
x.Name = "DomainsCredentials"
x.Save(CredentialsFile)
End Using
Else
CredentialsFile.Delete(,, EDP.None)
End If
MyBase.Save()
End Sub
Friend Overrides Sub Reset()
CredentialsTemp.Clear()
MyBase.Reset()
End Sub
Friend Overrides Sub OpenSettingsForm()
Using f As New SettingsForm(Instance)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
Changed = True
CredentialsTemp.Clear()
If f.MyCredentials.Count > 0 Then CredentialsTemp.AddRange(f.MyCredentials)
DomainsTemp.Clear()
If f.MyDomains.Count > 0 Then DomainsTemp.ListAddList(f.MyDomains, LAP.NotContainsOnly)
End If
End Using
End Sub
End Class
End Namespace

View File

@@ -1,165 +0,0 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Mastodon
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class SettingsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(SettingsForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton5 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton6 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.CMB_DOMAINS = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.TXT_AUTH = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_TOKEN = New PersonalUtilities.Forms.Controls.TextBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
CType(Me.CMB_DOMAINS, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_AUTH, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_TOKEN, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(384, 361)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(384, 361)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_MAIN.Controls.Add(Me.CMB_DOMAINS, 0, 0)
TP_MAIN.Controls.Add(Me.TXT_AUTH, 0, 1)
TP_MAIN.Controls.Add(Me.TXT_TOKEN, 0, 2)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 3
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.Size = New System.Drawing.Size(384, 361)
TP_MAIN.TabIndex = 0
'
'CMB_DOMAINS
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Add"
ActionButton1.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Add
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Delete"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Delete
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Clear"
ActionButton3.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "ArrowDown"
ActionButton4.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.ArrowDown
ActionButton4.Visible = False
Me.CMB_DOMAINS.Buttons.Add(ActionButton1)
Me.CMB_DOMAINS.Buttons.Add(ActionButton2)
Me.CMB_DOMAINS.Buttons.Add(ActionButton3)
Me.CMB_DOMAINS.Buttons.Add(ActionButton4)
Me.CMB_DOMAINS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_DOMAINS.ListDropDownStyle = PersonalUtilities.Forms.Controls.ComboBoxExtended.ListMode.Simple
Me.CMB_DOMAINS.Location = New System.Drawing.Point(4, 4)
Me.CMB_DOMAINS.Name = "CMB_DOMAINS"
Me.CMB_DOMAINS.Size = New System.Drawing.Size(378, 296)
Me.CMB_DOMAINS.TabIndex = 0
'
'TXT_AUTH
'
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Name = "Clear"
ActionButton5.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_AUTH.Buttons.Add(ActionButton5)
Me.TXT_AUTH.CaptionText = "Auth"
Me.TXT_AUTH.CaptionToolTipEnabled = True
Me.TXT_AUTH.CaptionToolTipText = "Bearer token"
Me.TXT_AUTH.CaptionWidth = 50.0R
Me.TXT_AUTH.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_AUTH.Location = New System.Drawing.Point(4, 306)
Me.TXT_AUTH.Name = "TXT_AUTH"
Me.TXT_AUTH.Size = New System.Drawing.Size(376, 22)
Me.TXT_AUTH.TabIndex = 1
'
'TXT_TOKEN
'
ActionButton6.BackgroundImage = CType(resources.GetObject("ActionButton6.BackgroundImage"), System.Drawing.Image)
ActionButton6.Name = "Clear"
ActionButton6.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_TOKEN.Buttons.Add(ActionButton6)
Me.TXT_TOKEN.CaptionText = "Token"
Me.TXT_TOKEN.CaptionToolTipEnabled = True
Me.TXT_TOKEN.CaptionToolTipText = "csrf token"
Me.TXT_TOKEN.CaptionWidth = 50.0R
Me.TXT_TOKEN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TOKEN.Location = New System.Drawing.Point(4, 335)
Me.TXT_TOKEN.Name = "TXT_TOKEN"
Me.TXT_TOKEN.Size = New System.Drawing.Size(376, 22)
Me.TXT_TOKEN.TabIndex = 2
'
'SettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(384, 361)
Me.Controls.Add(CONTAINER_MAIN)
Me.Icon = Global.SCrawler.My.Resources.SiteResources.MastodonIcon_48
Me.MinimumSize = New System.Drawing.Size(400, 400)
Me.Name = "SettingsForm"
Me.ShowInTaskbar = False
Me.Text = "Mastodon domains"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
CType(Me.CMB_DOMAINS, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_AUTH, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_TOKEN, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Private WithEvents CMB_DOMAINS As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents TXT_AUTH As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_TOKEN As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class
End Namespace

View File

@@ -1,292 +0,0 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<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>
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="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGPC/xhBQAAABl0RVh0U29m
dHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVoSURBVEhLhZVrTJNXGMdfrtNSQIoadKRz2o0CorU3
WkDIVBRaaGNbwAteh+AARRQlitEYTTRekiX7sH3YPmyZH9wtziybigLRCWTaCW5sCBWhlrb0Ci9zSxbo
2f+UliGX7SS/tO85z/k9T57zXhhCCPO7Wh3VIhB83JKQ0Nu4bNlHm5YseZ1hmHC69n+Y5HLFcz7/ft/S
pY+vr1hhwL4oEBJcZ0x793If5uZ+1VNfT/qvXCHP6+p8tzMymqRxcW8hMGKqbDo9MlmWddu2AfbiRTJ6
+TIZKC52fyAUVi2JiYkLJmGaBYIPnx4+TPrOnCH9p08TC4LNx46RWwrF/ZXR0W/PleRZZuY669atZvbS
JcJiL9vQQEZPnSKmwkLPjcTE97GPB8KZlvh4C5X31dWRgRMniAVBtvPnyWB9ve+2XP7jmtjYpOlJTOnp
G60lJRZaOZWPQs4ePUpGUZh3xw7SnJDQhT0KEM3c5fOv9paVkX4kMAPL8ePEig1D584RG9rVpFS2rY6J
EQaTmKTSjbbiYsvIhQuERTGjKIrFvtHaWjK8fz9plsudexYu/BLxKsBj9ALBGzel0vt9e/b4XiBoENhQ
zRDOxIWWOY4cIS0KRZs4Nja5QyLJtRoM1pGzZ/0tYVExi/ayNTVkBPJ76enuJA7nM4j3gVWAHjgTIYqL
E96SStvMu3YR64EDxF5dTYYOHSJOJPNA5Kiu9rUrlZ1mrdbCnjzpr5jFGotYtqpqQi6TuVM4nKvwlYHU
gDzU31OMSGl8fPJtsbjVsn27z15RQRzAVVlJ3BB4kcx78CAZQbUjVIxrFtd+OdrbmpHhEXG5VE4rTwHz
wMRdFDw4jEgFj5dyRyRqsxYVEcfu3cQFPPv2ES8qHEbCYRzgsFZLvO+8Q7xKJXGDVoXCK46Ovob95YBW
Ph/8+xwE/wSTyHi81OZVq9qsGs2Ye8sW4srPJy6JhDgTE4kzOpo4IyKIMyyMOLhcX9Py5R4lj0cPtAKs
BBwwKfc7p174J5BEhHY9FIk6bBDaIRuiQkDFfsLDSbdU+pdBKPwe8e+BNDBD7vdNn6BYd+6stK5da7bP
nz9TDujcoEAw1lJY+CyFz9dCHDubnDJjwltRccS5fr3TjurnlIMBYE5NJY8Nhq7SrCwREsz6xL9y4S4v
b3Bt2uSyR0XNkDvQe9ouKu8HvaGh5FfQIxL5OgyG30qUStqmGUkm/3jKy0+48vLcs1XuiI8nL/Ly/rYl
JfmovCcgN4JW+l8iGe8oKuoqzcyckSQob3CpVB47l+sXv9KWxYtJt0r1x9ns7HZjQYHNnJxMfoH0EXgA
7oFm0CmTjRsNhs6Na9bQF+Tkq57xlJXVu9Rqz9Bs8kWLSG9BwcsqieQONlXnpaaWdul0z7rR+6C8CTSC
m8Aol4+36/XGT7VaevCRIIRx6/WWoQULZq2cyveLxY0IrAT0IHm1OTmZT3Q6U2da2qT8B/Ad+BZ05OSM
GXW6p4hdBiIZZ1FRt5vPn6vyuwiqCsj9Xyq6qXbDBkWnXm/6OS3NN1X+dUgIeZSdPXZPoxlEXC6IY9pL
S7faNBqXC9Iplf95YBb5ZF+RpGbdunQcbO/D1avJ9YC8LT19/Iv8/BeqpKRPEDORAGNeY3HxSYtG43Eq
FL5etfpljUzWhPlZ5VOTlGVliR+hHUbs+0mpHP9GpRqM5XAuY20zmGgRRohYKIx9rNd/3qfTOa7l5uLu
C63BvARw6fp0eRCMyBslJe8+2bx58EFhoVMlFNJvgQ4kgggQEgykvV0ApEAd+J3z8Z8KxmuA3pr0zikA
b4LJZ2FqYBigFdOPNf0NC679Fxi0OPr+XxiAJgwURph/AJfOQQebMR8TAAAAAElFTkSuQmCC
</value>
</data>
<data name="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>
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>
<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
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
</root>

View File

@@ -1,154 +0,0 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls.Base
Namespace API.Mastodon
Friend Class SettingsForm
Private WithEvents MyDefs As DefaultFormOptions
Friend ReadOnly Property MyCredentials As List(Of Credentials)
Friend ReadOnly Property MyDomains As List(Of String)
Friend Sub New(ByVal s As SiteSettings)
InitializeComponent()
MyCredentials = New List(Of Credentials)
If s.Domains.Credentials.Count > 0 Then MyCredentials.AddRange(s.Domains.Credentials)
MyDomains = New List(Of String)
MyDomains.ListAddList(s.Domains)
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
Private Sub MyForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyView = New FormView(Me, Settings.Design, "MastodonSettingsForm")
.MyView.Import()
.MyView.SetFormSize()
.AddOkCancelToolbar()
RefillList()
.EndLoaderOperations()
End With
End Sub
Private Sub SettingsForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
MyCredentials.Clear()
MyDomains.Clear()
End Sub
Private Sub RefillList()
CMB_DOMAINS.Items.Clear()
If MyDomains.Count > 0 Then
MyDomains.Sort()
CMB_DOMAINS.BeginUpdate()
CMB_DOMAINS.Items.AddRange(MyDomains.Select(Function(d) New ListItem(d)))
CMB_DOMAINS.EndUpdate(True)
End If
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
ApplyCredentials()
If MyCredentials.Count > 0 Then MyCredentials.RemoveAll(Function(c) c.Domain.IsEmptyString Or c.Bearer.IsEmptyString Or c.Csrf.IsEmptyString)
If MyDomains.Count > 0 Then
If MyCredentials.Count > 0 Then
MyCredentials.RemoveAll(Function(c) Not MyDomains.Contains(c.Domain))
Else
MyCredentials.Clear()
End If
End If
MyDefs.CloseForm()
End Sub
Private Sub CMB_DOMAINS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles CMB_DOMAINS.ActionOnButtonClick
Try
Dim d$
Dim i% = -1
Select Case e.DefaultButton
Case ActionButton.DefaultButtons.Add
d = InputBoxE("Enter a new domain using the pattern [mastodon.social]:", "New domain")
If Not d.IsEmptyString Then
If MyDomains.Count > 0 Then i = MyDomains.IndexOf(d)
If i >= 0 Then
MsgBoxE({$"Domain '{d}' already exists", "Add domain"}, vbExclamation)
If i <= CMB_DOMAINS.Count - 1 Then CMB_DOMAINS.SelectedIndex = i
Else
ApplyCredentials()
ClearCredentials()
MyDomains.Add(d)
_Suspended = True
RefillList()
_Suspended = False
i = MyDomains.IndexOf(d)
If i.ValueBetween(0, CMB_DOMAINS.Count - 1) Then
CMB_DOMAINS.SelectedIndex = i
Else
_LatestSelected = -1
_CurrentCredentialsIndex = -1
_CurrentDomain = String.Empty
End If
End If
End If
Case ActionButton.DefaultButtons.Delete
If _LatestSelected >= 0 Then
d = CMB_DOMAINS.Items(_LatestSelected).Value(0)
If Not d.IsEmptyString AndAlso MsgBoxE({$"Are you sure you want to delete the [{d}] domain?",
"Removing domains"}, vbYesNo) = vbYes Then
i = MyDomains.IndexOf(d)
Dim l% = _LatestSelected
If i >= 0 Then
ClearCredentials()
MyDomains.RemoveAt(i)
_Suspended = True
RefillList()
_Suspended = False
If (l - 1).ValueBetween(0, CMB_DOMAINS.Count - 1) Then
CMB_DOMAINS.SelectedIndex = l - 1
Else
_LatestSelected = -1
_CurrentCredentialsIndex = -1
_CurrentDomain = String.Empty
End If
End If
End If
End If
End Select
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "API.Mastodon.SettingsForm.ActionButtonClick")
End Try
End Sub
Private _LatestSelected As Integer = -1
Private _CurrentCredentialsIndex As Integer = -1
Private _CurrentDomain As String = String.Empty
Private _Suspended As Boolean = False
Private Sub CMB_DOMAINS_ActionSelectedItemChanged(ByVal Sender As Object, ByVal e As EventArgs, ByVal Item As ListViewItem) Handles CMB_DOMAINS.ActionSelectedItemChanged
If Not MyDefs.Initializing And Not _Suspended Then
Dim DropCredentials As Boolean = True
If Not Item Is Nothing Then
ApplyCredentials()
_LatestSelected = Item.Index
_CurrentDomain = Item.Text
If MyCredentials.Count > 0 And Not _CurrentDomain.IsEmptyString Then
_CurrentCredentialsIndex = MyCredentials.IndexOf(_CurrentDomain)
If _CurrentCredentialsIndex >= 0 Then
With MyCredentials(_CurrentCredentialsIndex) : TXT_AUTH.Text = .Bearer : TXT_TOKEN.Text = .Csrf : End With
DropCredentials = False
End If
Else
_CurrentCredentialsIndex = -1
End If
End If
If DropCredentials Then ClearCredentials()
End If
End Sub
Private Sub ClearCredentials()
TXT_AUTH.Clear()
TXT_TOKEN.Clear()
End Sub
Private Sub ApplyCredentials()
Try
If _LatestSelected >= 0 And Not _CurrentDomain.IsEmptyString Then
Dim c As New Credentials With {.Domain = _CurrentDomain, .Bearer = TXT_AUTH.Text, .Csrf = TXT_TOKEN.Text}
If _CurrentCredentialsIndex.ValueBetween(0, MyCredentials.Count - 1) Then MyCredentials(_CurrentCredentialsIndex) = c Else MyCredentials.Add(c)
End If
Catch ex As Exception
End Try
End Sub
End Class
End Namespace

View File

@@ -18,29 +18,34 @@ Namespace API.Mastodon
<Manifest(MastodonSiteKey), SavedPosts, SpecialForm(True), SpecialForm(False)> <Manifest(MastodonSiteKey), SavedPosts, SpecialForm(True), SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.MastodonIcon_48
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.MastodonPic_48
End Get
End Property
#Region "Domains" #Region "Domains"
<PXML("Domains")> Private ReadOnly Property SiteDomains As PropertyValue <PXML("Domains"), PClonable> Private ReadOnly Property SiteDomains As PropertyValue
Friend ReadOnly Property Domains As MastodonDomains Private Shadows ReadOnly Property DefaultInstance As SiteSettings
<PXML> Private ReadOnly Property DomainsLastUpdateDate As PropertyValue Get
Return MyBase.DefaultInstance
End Get
End Property
Private ReadOnly _Domains As DomainsContainer
Friend ReadOnly Property Domains As DomainsContainer
Get
Return If(DefaultInstance?.Domains, _Domains)
End Get
End Property
<PXML("DomainsLastUpdateDate")> Private ReadOnly Property Base_DomainsLastUpdateDate As PropertyValue
Private ReadOnly Property DomainsLastUpdateDate As PropertyValue
Get
Return If(DefaultInstance?.DomainsLastUpdateDate, Base_DomainsLastUpdateDate)
End Get
End Property
#End Region #End Region
#Region "Auth" #Region "Auth"
<PropertyOption(IsAuth:=True, AllowNull:=False, ControlText:="My domain", <PropertyOption(IsAuth:=True, AllowNull:=False, ControlText:="My domain",
ControlToolTip:="Your account domain without 'https://' (for example, 'mastodon.social')"), PXML> ControlToolTip:="Your account domain without 'https://' (for example, 'mastodon.social')"), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property MyDomain As PropertyValue Friend ReadOnly Property MyDomain As PropertyValue
<PropertyOption(AllowNull:=False, IsAuth:=True, ControlText:="Authorization", <PropertyOption(AllowNull:=False, IsAuth:=True, ControlText:="Authorization",
ControlToolTip:="Set authorization from [authorization] response header. This field must start from [Bearer] key word")> ControlToolTip:="Set authorization from [authorization] response header. This field must start from [Bearer] key word"), PClonable(Clone:=False)>
Friend ReadOnly Property Auth As PropertyValue Friend ReadOnly Property Auth As PropertyValue
<PropertyOption(AllowNull:=False, IsAuth:=True, ControlText:="Token", ControlToolTip:="Set token from [x-csrf-token] response header")> <PropertyOption(AllowNull:=False, IsAuth:=True, ControlText:="Token", ControlToolTip:="Set token from [x-csrf-token] response header"), PClonable(Clone:=False)>
Friend ReadOnly Property Token As PropertyValue Friend ReadOnly Property Token As PropertyValue
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object) Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then If Not PropName.IsEmptyString Then
@@ -58,29 +63,29 @@ Namespace API.Mastodon
End Sub End Sub
#End Region #End Region
#Region "Other properties" #Region "Other properties"
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsDownloadCaption), PXML> <PropertyOption(IsAuth:=False, ControlText:=DN.GifsDownloadCaption), PXML, PClonable>
Friend ReadOnly Property GifsDownload As PropertyValue Friend ReadOnly Property GifsDownload As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip), PXML> <PropertyOption(IsAuth:=False, ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip), PXML, PClonable>
Friend ReadOnly Property GifsSpecialFolder As PropertyValue Friend ReadOnly Property GifsSpecialFolder As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip), PXML> <PropertyOption(IsAuth:=False, ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip), PXML, PClonable>
Friend ReadOnly Property GifsPrefix As PropertyValue Friend ReadOnly Property GifsPrefix As PropertyValue
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)> <Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
Private ReadOnly Property GifStringChecker As IFormatProvider Private ReadOnly Property GifStringChecker As IFormatProvider
<PropertyOption(IsAuth:=False, ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip), PXML> <PropertyOption(IsAuth:=False, ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip), PXML, PClonable>
Friend ReadOnly Property UseMD5Comparison As PropertyValue Friend ReadOnly Property UseMD5Comparison As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:="User related to my domain", <PropertyOption(IsAuth:=False, ControlText:="User related to my domain",
ControlToolTip:="Open user profiles and user posts through my domain."), PXML> ControlToolTip:="Open user profiles and user posts through my domain."), PXML, PClonable>
Friend ReadOnly Property UserRelatedToMyDomain As PropertyValue Friend ReadOnly Property UserRelatedToMyDomain As PropertyValue
#End Region #End Region
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("Mastodon", "mastodon.social") MyBase.New("Mastodon", "mastodon.social", AccName, Temp, My.Resources.SiteResources.MastodonIcon_48, My.Resources.SiteResources.MastodonPic_48)
Domains = New MastodonDomains(Me, "mastodon.social") _Domains = New DomainsContainer(Me, "mastodon.social")
SiteDomains = New PropertyValue(Domains.DomainsDefault, GetType(String)) SiteDomains = New PropertyValue(Domains.DomainsDefault, GetType(String))
Domains.DestinationProp = SiteDomains Domains.DestinationProp = SiteDomains
DomainsLastUpdateDate = New PropertyValue(Now.AddYears(-1)) Base_DomainsLastUpdateDate = New PropertyValue(Now.AddYears(-1))
Auth = New PropertyValue(Responser.Headers.Value(DN.Header_Authorization), GetType(String), Sub(v) ChangeResponserFields(NameOf(Auth), 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)) Token = New PropertyValue(Responser.Headers.Value(DN.Header_CSRFToken), GetType(String), Sub(v) ChangeResponserFields(NameOf(Token), v))
@@ -182,20 +187,32 @@ Namespace API.Mastodon
#End Region #End Region
#Region "IsMyUser, IsMyImageVideo" #Region "IsMyUser, IsMyImageVideo"
Private Const UserRegexDefault As String = "https?://{0}/@([^/@]+)@?([^/]*)" Private Const UserRegexDefault As String = "https?://{0}/@([^/@]+)@?([^/]*)"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions Friend Overloads Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
If Domains.Count > 0 Then If Domains.Count > 0 Then
Dim l As List(Of String) Dim e As ExchangeOptions
If ACheck(MyDomain.Value) Then
e = IsMyUser(UserURL, MyDomain.Value)
If Not e.SiteName.IsEmptyString Then Return e
End If
For Each domain$ In Domains For Each domain$ In Domains
UserRegex.Pattern = String.Format(UserRegexDefault, domain) e = IsMyUser(UserURL, domain)
l = RegexReplace(UserURL, UserRegex) If Not e.SiteName.IsEmptyString Then Return e
If l.ListExists(2) Then Return New ExchangeOptions(Site, $"{l(2).IfNullOrEmpty(domain)}@{l(1)}")
Next Next
End If End If
Return Nothing Return Nothing
End Function End Function
Private Overloads Function IsMyUser(ByVal UserURL As String, ByVal Domain As String) As ExchangeOptions
UserRegex.Pattern = String.Format(UserRegexDefault, Domain)
Dim l As List(Of String) = RegexReplace(UserURL, UserRegex)
If l.ListExists(2) Then Return New ExchangeOptions(Site, $"{l(2).IfNullOrEmpty(Domain)}@{l(1)}") Else Return Nothing
End Function
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
If Not URL.IsEmptyString And Domains.Count > 0 Then If Not URL.IsEmptyString And Domains.Count > 0 Then
If Domains.Domains.Exists(Function(d) URL.Contains(d)) Then Return New ExchangeOptions(Site, URL) With {.Exists = True} Dim urlDomain$ = RegexReplace(URL, RParams.DM("[^/]+", 1, EDP.ReturnValue, String.Empty))
If Not urlDomain.IsEmptyString Then
urlDomain = urlDomain.StringToLower
If Domains.Domains.Exists(Function(d) urlDomain = d.StringToLower) Then Return New ExchangeOptions(Site, URL) With {.Exists = True}
End If
End If End If
Return Nothing Return Nothing
End Function End Function
@@ -222,6 +239,12 @@ Namespace API.Mastodon
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.Mastodon.SiteSettings.UpdateServersList]") ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.Mastodon.SiteSettings.UpdateServersList]")
End Try End Try
End Sub End Sub
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _Domains.Dispose()
MyBase.Dispose(disposing)
End Sub
#End Region #End Region
End Class End Class
End Namespace End Namespace

View File

@@ -18,7 +18,6 @@ Namespace API.Mastodon
Friend Class UserData : Inherits Twitter.UserData Friend Class UserData : Inherits Twitter.UserData
#Region "XML names" #Region "XML names"
Private Const Name_UserDomain As String = "UserDomain" Private Const Name_UserDomain As String = "UserDomain"
Private Const Name_TrueName As String = "TrueName"
#End Region #End Region
#Region "Declarations" #Region "Declarations"
Private _UserDomain As String = String.Empty Private _UserDomain As String = String.Empty
@@ -38,22 +37,7 @@ Namespace API.Mastodon
End Property End Property
Private MyCredentials As Credentials Private MyCredentials As Credentials
Private Sub ResetCredentials() Private Sub ResetCredentials()
MyCredentials = Nothing MyCredentials = New Credentials With {.Domain = MySettings.MyDomain.Value, .Bearer = MySettings.Auth.Value, .Csrf = MySettings.Token.Value}
With MySettings
Dim setDef As Boolean = True
If Not IsSavedPosts Then
If ACheck(.MyDomain.Value) AndAlso UserDomain = .MyDomain.Value Then
setDef = True
ElseIf .Domains.Credentials.Count > 0 Then
Dim i% = .Domains.Credentials.IndexOf(UserDomain)
If i >= 0 Then
MyCredentials = .Domains.Credentials(i)
setDef = Not MyCredentials.Exists
End If
End If
End If
If setDef Then MyCredentials = New Credentials With {.Domain = UserDomain, .Bearer = MySettings.Auth.Value, .Csrf = MySettings.Token.Value}
End With
With MyCredentials With MyCredentials
Responser.Headers.Add(DeclaredNames.Header_Authorization, .Bearer) Responser.Headers.Add(DeclaredNames.Header_Authorization, .Bearer)
Responser.Headers.Add(DeclaredNames.Header_CSRFToken, .Csrf) Responser.Headers.Add(DeclaredNames.Header_CSRFToken, .Csrf)
@@ -190,7 +174,8 @@ Namespace API.Mastodon
ProcessException(ex, Token, $"data downloading error{IIf(IsSavedPosts, " (Saved Posts)", String.Empty)} [{URL}]") ProcessException(ex, Token, $"data downloading error{IIf(IsSavedPosts, " (Saved Posts)", String.Empty)} [{URL}]")
End Try End Try
End Sub End Sub
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal BaseUrl As String = Nothing) Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal BaseUrl As String = Nothing,
Optional ByVal SourceMedia As UserMedia = Nothing)
Dim t As UTypes = UTypes.Undefined Dim t As UTypes = UTypes.Undefined
Select Case e.Value("type") Select Case e.Value("type")
Case "video" : t = UTypes.Video Case "video" : t = UTypes.Video
@@ -207,7 +192,13 @@ Namespace API.Mastodon
If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = GifsSpecialFolder If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = GifsSpecialFolder
If Not GifsPrefix.IsEmptyString Then m.File.Name = $"{GifsPrefix}{m.File.Name}" If Not GifsPrefix.IsEmptyString Then m.File.Name = $"{GifsPrefix}{m.File.Name}"
End If End If
If Not m.URL.IsEmptyString Then _TempMediaList.ListAddValue(m, LNC) If Not m.URL.IsEmptyString Then
If SourceMedia.State = UStates.Missing Then
m.State = UStates.Missing
m.Attempts = SourceMedia.Attempts
End If
_TempMediaList.ListAddValue(m, LNC)
End If
End If End If
End If End If
End Sub End Sub
@@ -261,7 +252,7 @@ Namespace API.Mastodon
If Not j Is Nothing Then If Not j Is Nothing Then
PostDate = String.Empty PostDate = String.Empty
If j.Contains("created_at") Then PostDate = j("created_at").Value Else PostDate = String.Empty If j.Contains("created_at") Then PostDate = j("created_at").Value Else PostDate = String.Empty
ObtainMedia(j, m.Post.ID, PostDate, m.URL_BASE) ObtainMedia(j, m.Post.ID, PostDate, m.URL_BASE, m)
rList.Add(i) rList.Add(i)
j.Dispose() j.Dispose()
End If End If

View File

@@ -16,23 +16,11 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.OnlyFans Namespace API.OnlyFans
<Manifest("AndyProgram_OnlyFans"), SavedPosts, SpecialForm(False), SeparatedTasks(1)> <Manifest("AndyProgram_OnlyFans"), SavedPosts, SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Icon"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.OnlyFansIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.OnlyFansPic_32
End Get
End Property
#End Region
#Region "Declarations" #Region "Declarations"
#Region "Options" #Region "Options"
<PropertyOption(ControlText:="Download highlights", ControlToolTip:="Download profile highlights if they exists"), PXML> <PropertyOption(ControlText:="Download highlights", ControlToolTip:="Download profile highlights if they exists"), PXML, PClonable>
Friend Property DownloadHighlights As PropertyValue Friend Property DownloadHighlights As PropertyValue
<PropertyOption(ControlText:="Download chat", ControlToolTip:="Download unlocked chat media"), PXML> <PropertyOption(ControlText:="Download chat", ControlToolTip:="Download unlocked chat media"), PXML, PClonable>
Friend Property DownloadChatMedia As PropertyValue Friend Property DownloadChatMedia As PropertyValue
#End Region #End Region
#Region "Headers" #Region "Headers"
@@ -40,15 +28,15 @@ Namespace API.OnlyFans
Private Const HeaderUserID As String = "User-Id" Private Const HeaderUserID As String = "User-Id"
Private Const HeaderXBC As String = "X-Bc" Private Const HeaderXBC As String = "X-Bc"
Private Const HeaderAppToken As String = "App-Token" Private Const HeaderAppToken As String = "App-Token"
<PropertyOption(ControlText:=HeaderUserID, AllowNull:=False)> <PropertyOption(ControlText:=HeaderUserID, AllowNull:=False), PClonable(Clone:=False)>
Friend ReadOnly Property HH_USER_ID As PropertyValue Friend ReadOnly Property HH_USER_ID As PropertyValue
<PropertyOption(ControlText:=HeaderXBC, AllowNull:=False)> <PropertyOption(ControlText:=HeaderXBC, AllowNull:=False), PClonable(Clone:=False)>
Private ReadOnly Property HH_X_BC As PropertyValue Private ReadOnly Property HH_X_BC As PropertyValue
<PropertyOption(ControlText:=HeaderAppToken, AllowNull:=False)> <PropertyOption(ControlText:=HeaderAppToken, AllowNull:=False), PClonable(Clone:=False)>
Private ReadOnly Property HH_APP_TOKEN As PropertyValue Private ReadOnly Property HH_APP_TOKEN As PropertyValue
<PropertyOption(ControlText:=HeaderBrowser, ControlToolTip:="Can be null", AllowNull:=True)> <PropertyOption(ControlText:=HeaderBrowser, ControlToolTip:="Can be null", AllowNull:=True), PClonable>
Private ReadOnly Property HH_BROWSER As PropertyValue Private ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(AllowNull:=False)> <PropertyOption(AllowNull:=False), PClonable>
Private ReadOnly Property UserAgent As PropertyValue Private ReadOnly Property UserAgent As PropertyValue
Private Sub UpdateHeader(ByVal PropertyName As String, ByVal Value As String) Private Sub UpdateHeader(ByVal PropertyName As String, ByVal Value As String)
Dim hName$ = String.Empty Dim hName$ = String.Empty
@@ -79,21 +67,21 @@ Namespace API.OnlyFans
End Property End Property
<PropertyOption(ControlText:="Use old authorization rules", <PropertyOption(ControlText:="Use old authorization rules",
ControlToolTip:="Use old dynamic rules (from 'DATAHOARDERS') or new ones (from 'DIGITALCRIMINALS')." & vbCr & ControlToolTip:="Use old dynamic rules (from 'DATAHOARDERS') or new ones (from 'DIGITALCRIMINALS')." & vbCr &
"Change this value only if you know what you are doing."), PXML> "Change this value only if you know what you are doing."), PXML, PClonable>
Friend ReadOnly Property UseOldAuthRules As PropertyValue Friend ReadOnly Property UseOldAuthRules As PropertyValue
<PropertyOption(ControlText:="Dynamic rules update", ControlToolTip:="'Dynamic rules' update interval (minutes). Default: 1440", LeftOffset:=110), PXML> <PropertyOption(ControlText:="Dynamic rules update", ControlToolTip:="'Dynamic rules' update interval (minutes). Default: 1440", LeftOffset:=110), PXML, PClonable>
Friend ReadOnly Property DynamicRulesUpdateInterval As PropertyValue Friend ReadOnly Property DynamicRulesUpdateInterval As PropertyValue
<Provider(NameOf(DynamicRulesUpdateInterval), FieldsChecker:=True)> <Provider(NameOf(DynamicRulesUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property DynamicRulesUpdateIntervalProvider As IFormatProvider Private ReadOnly Property DynamicRulesUpdateIntervalProvider As IFormatProvider
<PropertyOption(ControlText:="Dynamic rules", <PropertyOption(ControlText:="Dynamic rules",
ControlToolTip:="Overwrite 'Dynamic rules' with this URL" & vbCr & ControlToolTip:="Overwrite 'Dynamic rules' with this URL" & vbCr &
"Change this value only if you know what you are doing."), PXML> "Change this value only if you know what you are doing."), PXML, PClonable>
Friend ReadOnly Property DynamicRules As PropertyValue Friend ReadOnly Property DynamicRules As PropertyValue
#End Region #End Region
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("OnlyFans", ".onlyfans.com") MyBase.New("OnlyFans", ".onlyfans.com", AccName, Temp, My.Resources.SiteResources.OnlyFansIcon_32, My.Resources.SiteResources.OnlyFansPic_32)
With Responser With Responser
.Accept = "application/json, text/plain, */*" .Accept = "application/json, text/plain, */*"

View File

@@ -380,6 +380,11 @@ Namespace API.OnlyFans
Try Try
If ContentMissingExists Then If ContentMissingExists Then
Dim m As UserMedia Dim m As UserMedia
Dim stateRefill As Func(Of UserMedia, Integer, UserMedia) = Function(ByVal input As UserMedia, ByVal ii As Integer) As UserMedia
input.State = UStates.Missing
input.Attempts = m.Attempts
Return input
End Function
Dim mList As List(Of UserMedia) Dim mList As List(Of UserMedia)
Dim mediaResult As Boolean Dim mediaResult As Boolean
Dim r$, path$, postDate$ Dim r$, path$, postDate$
@@ -402,7 +407,7 @@ Namespace API.OnlyFans
mediaResult = False mediaResult = False
mList = TryCreateMedia(j, m.Post.ID, postDate, mediaResult) mList = TryCreateMedia(j, m.Post.ID, postDate, mediaResult)
If mediaResult Then If mediaResult Then
_TempMediaList.ListAddList(mList, LNC) _TempMediaList.ListAddList(mList.ListForEachCopy(stateRefill, True), LNC)
rList.Add(i) rList.Add(i)
mList.Clear() mList.Clear()
End If End If
@@ -439,11 +444,25 @@ Namespace API.OnlyFans
Return f Return f
End Get End Get
End Property End Property
Private Function UpdateSignature(ByVal Path As String, Optional ByVal ForceUpdateAuth As Boolean = False) As Boolean Private Function UpdateSignature(ByVal Path As String, Optional ByVal ForceUpdateAuth As Boolean = False,
Optional ByVal Round As Integer = 0) As Boolean
Try Try
If UpdateAuthFile(ForceUpdateAuth) Then If UpdateAuthFile(ForceUpdateAuth) Then
Const nullMsg$ = "The auth parameter is null" Const nullMsg$ = "The auth parameter is null"
Dim j As EContainer = JsonDocument.Parse(AuthFile.GetText) Dim j As EContainer
Try
j = JsonDocument.Parse(AuthFile.GetText)
Catch jex As Exception
If Round = 0 Then
AuthFile.Delete()
UpdateAuthFile(True)
Return UpdateSignature(Path, ForceUpdateAuth, Round + 1)
Else
MySettings.SessionAborted = True
Return False
End If
End Try
If Not j Is Nothing Then
Dim pattern$ = j.Value("format") Dim pattern$ = j.Value("format")
If pattern.IsEmptyString Then Throw New ArgumentNullException("format", nullMsg) If pattern.IsEmptyString Then Throw New ArgumentNullException("format", nullMsg)
pattern = pattern.Replace("{}", "{0}").Replace("{:x}", "{1:x}") pattern = pattern.Replace("{}", "{0}").Replace("{:x}", "{1:x}")
@@ -472,9 +491,9 @@ Namespace API.OnlyFans
j.Dispose() j.Dispose()
Return True Return True
Else
Return False
End If End If
End If
Return False
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"{ToStringForLog()}: UpdateSignature", False) Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"{ToStringForLog()}: UpdateSignature", False)
End Try End Try
@@ -521,7 +540,7 @@ Namespace API.OnlyFans
Private _DownloadingException_AuthFileUpdate As Boolean = False Private _DownloadingException_AuthFileUpdate As Boolean = False
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = Net.HttpStatusCode.BadRequest Then If Responser.StatusCode = Net.HttpStatusCode.BadRequest Then '400
If Not _DownloadingException_AuthFileUpdate AndAlso UpdateAuthFile(True) Then If Not _DownloadingException_AuthFileUpdate AndAlso UpdateAuthFile(True) Then
_DownloadingException_AuthFileUpdate = True _DownloadingException_AuthFileUpdate = True
Return 2 Return 2
@@ -530,13 +549,17 @@ Namespace API.OnlyFans
MyMainLOG = $"{ToStringForLog()}: OnlyFans credentials expired" MyMainLOG = $"{ToStringForLog()}: OnlyFans credentials expired"
Return 1 Return 1
End If End If
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then '404
UserExists = False UserExists = False
Return 1 Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.GatewayTimeout Or Responser.StatusCode = 429 Then ElseIf Responser.StatusCode = Net.HttpStatusCode.GatewayTimeout Or Responser.StatusCode = 429 Then '504, 429
If Responser.StatusCode = 429 Then MyMainLOG = $"[429] OnlyFans too many requests ({ToStringForLog()})" If Responser.StatusCode = 429 Then MyMainLOG = $"[429] OnlyFans too many requests ({ToStringForLog()})"
MySettings.SessionAborted = True MySettings.SessionAborted = True
Return 1 Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.Unauthorized Then '401
MySettings.SessionAborted = True
MyMainLOG = $"{ToStringForLog()}: OnlyFans credentials expired"
Return 1
Else Else
Return 0 Return 0
End If End If

View File

@@ -12,19 +12,8 @@ Imports SCrawler.Plugin.Attributes
Namespace API.PathPlugin Namespace API.PathPlugin
<Manifest(PluginKey)> <Manifest(PluginKey)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
Private ReadOnly _Icon As Icon = Nothing
Friend Overrides ReadOnly Property Icon As Icon
Get
Return _Icon
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return PersonalUtilities.My.Resources.FolderOpenPic_Orange_16
End Get
End Property
Friend Sub New() Friend Sub New()
MyBase.New(PluginName) MyBase.New(PluginName,, PersonalUtilities.My.Resources.FolderOpenPic_Orange_16)
_Icon = PersonalUtilities.Tools.ImageRenderer.GetIcon(PersonalUtilities.My.Resources.FolderOpenPic_Orange_16, EDP.ReturnValue) _Icon = PersonalUtilities.Tools.ImageRenderer.GetIcon(PersonalUtilities.My.Resources.FolderOpenPic_Orange_16, EDP.ReturnValue)
End Sub End Sub
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider

View File

@@ -9,33 +9,22 @@
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Pinterest Namespace API.Pinterest
<Manifest("AndyProgram_Pinterest"), SavedPosts, SeparatedTasks> <Manifest("AndyProgram_Pinterest"), SavedPosts, SeparatedTasks>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.PinterestIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.PinterestPic_48
End Get
End Property
<PropertyOption(ControlText:=DeclaredNames.ConcurrentDownloadsCaption, <PropertyOption(ControlText:=DeclaredNames.ConcurrentDownloadsCaption,
ControlToolTip:=DeclaredNames.ConcurrentDownloadsToolTip, AllowNull:=False, LeftOffset:=120), PXML, TaskCounter> ControlToolTip:=DeclaredNames.ConcurrentDownloadsToolTip, AllowNull:=False, LeftOffset:=120), PXML, TaskCounter, PClonable>
Friend ReadOnly Property ConcurrentDownloads As PropertyValue Friend ReadOnly Property ConcurrentDownloads As PropertyValue
<Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)> <Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)>
Private ReadOnly Property MyConcurrentDownloadsProvider As IFormatProvider Private ReadOnly Property MyConcurrentDownloadsProvider As IFormatProvider
<PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip), PXML> <PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue Friend ReadOnly Property SavedPostsUserName As PropertyValue
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("Pinterest", "pinterest.com") MyBase.New("Pinterest", "pinterest.com", AccName, Temp, My.Resources.SiteResources.PinterestIcon_32, My.Resources.SiteResources.PinterestPic_48)
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String)) SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
ConcurrentDownloads = New PropertyValue(1) ConcurrentDownloads = New PropertyValue(1)
MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider

View File

@@ -24,6 +24,7 @@ Namespace API.PornHub
0, RegexOptions.Singleline, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter) 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 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) Friend ReadOnly RegexVideoPageTitle As RParams = RParams.DMS("meta (property|name)=""[^:]+?:title"" content=""([^""]+)""", 2, EDP.ReturnValue)
Friend ReadOnly RegexDataToken As RParams = RParams.DMS("data-token=""([^""]+)", 1, EDP.ReturnValue)
#End Region #End Region
#Region "Declarations M3U8" #Region "Declarations M3U8"
Friend ReadOnly Regex_M3U8_FilesList As RParams = RParams.DM("RESOLUTION=\d+x(\d+).*?[\r\n]*?(.+?m3u8.*)", 0, RegexReturn.List, EDP.ReturnValue) Friend ReadOnly Regex_M3U8_FilesList As RParams = RParams.DM("RESOLUTION=\d+x(\d+).*?[\r\n]*?(.+?m3u8.*)", 0, RegexReturn.List, EDP.ReturnValue)

View File

@@ -15,40 +15,30 @@ Namespace API.PornHub
<Manifest("AndyProgram_PornHub"), SavedPosts, SpecialForm(False), SeparatedTasks(1)> <Manifest("AndyProgram_PornHub"), SavedPosts, SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon <PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML, PClonable>
Get
Return My.Resources.SiteResources.PornHubIcon_16
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.PornHubPic_16
End Get
End Property
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML>
Friend Property DownloadUHD As PropertyValue Friend Property DownloadUHD As PropertyValue
<PropertyOption(ControlText:="Download uploaded", ControlToolTip:="Download uploaded videos"), PXML> <PropertyOption(ControlText:="Download uploaded", ControlToolTip:="Download uploaded videos"), PXML, PClonable>
Friend Property DownloadUploaded As PropertyValue Friend Property DownloadUploaded As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged videos"), PXML> <PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged videos"), PXML, PClonable>
Friend Property DownloadTagged As PropertyValue Friend Property DownloadTagged As PropertyValue
<PropertyOption(ControlText:="Download private", ControlToolTip:="Download private videos"), PXML> <PropertyOption(ControlText:="Download private", ControlToolTip:="Download private videos"), PXML, PClonable>
Friend Property DownloadPrivate As PropertyValue Friend Property DownloadPrivate As PropertyValue
<PropertyOption(ControlText:="Download favorite", ControlToolTip:="Download favorite videos"), PXML> <PropertyOption(ControlText:="Download favorite", ControlToolTip:="Download favorite videos"), PXML, PClonable>
Friend Property DownloadFavorite As PropertyValue Friend Property DownloadFavorite As PropertyValue
<PropertyOption(ControlText:="Download GIF", ControlToolTip:="Default for new users", ThreeStates:=True), PXML> <PropertyOption(ControlText:="Download GIF", ControlToolTip:="Default for new users", ThreeStates:=True), PXML, PClonable>
Friend ReadOnly Property DownloadGifs As PropertyValue Friend ReadOnly Property DownloadGifs As PropertyValue
<PropertyOption(ControlText:="Download GIFs as mp4", ControlToolTip:="Download gifs in 'mp4' format instead of native 'webm'"), PXML> <PropertyOption(ControlText:="Download GIFs as mp4", ControlToolTip:="Download gifs in 'mp4' format instead of native 'webm'"), PXML, PClonable>
Friend ReadOnly Property DownloadGifsAsMp4 As PropertyValue Friend ReadOnly Property DownloadGifsAsMp4 As PropertyValue
<PropertyOption(ControlText:="Photo ModelHub only", <PropertyOption(ControlText:="Photo ModelHub only",
ControlToolTip:="Download photo only from ModelHub. Prornstar photos hosted on PornHub itself will not be downloaded." & vbCr & 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> "Attention! Downloading photos hosted on PornHub is a very heavy job."), PXML, PClonable>
Friend ReadOnly Property DownloadPhotoOnlyFromModelHub As PropertyValue Friend ReadOnly Property DownloadPhotoOnlyFromModelHub As PropertyValue
<PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip), PXML> <PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue Friend ReadOnly Property SavedPostsUserName As PropertyValue
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("PornHub", "pornhub.com") MyBase.New("PornHub", "pornhub.com", AccName, Temp, My.Resources.SiteResources.PornHubIcon_16, My.Resources.SiteResources.PornHubPic_16)
With Responser : .CurlSslNoRevoke = True : .CurlInsecure = True : End With With Responser : .CurlSslNoRevoke = True : .CurlInsecure = True : End With
DownloadUHD = New PropertyValue(False) DownloadUHD = New PropertyValue(False)

View File

@@ -29,7 +29,7 @@ Namespace API.PornHub
Private Const Name_DownloadFavorite As String = "DownloadFavorite" Private Const Name_DownloadFavorite As String = "DownloadFavorite"
Private Const Name_DownloadGifs As String = "DownloadGifs" Private Const Name_DownloadGifs As String = "DownloadGifs"
Private Const Name_DownloadPhotoOnlyFromModelHub As String = "DownloadPhotoOnlyFromModelHub" Private Const Name_DownloadPhotoOnlyFromModelHub As String = "DownloadPhotoOnlyFromModelHub"
Private Const Name_IsUser As String = "IsUser" <Obsolete> Private Const Name_IsUser As String = "IsUser"
#End Region #End Region
#Region "Structures" #Region "Structures"
Private Structure FlashVar : Implements IRegExCreator Private Structure FlashVar : Implements IRegExCreator
@@ -117,6 +117,8 @@ Namespace API.PornHub
Private Const PersonTypeUser As String = "users" Private Const PersonTypeUser As String = "users"
Private Const PersonTypePornstar As String = "pornstar" Private Const PersonTypePornstar As String = "pornstar"
Private Const PersonTypeCannel As String = "channels" Private Const PersonTypeCannel As String = "channels"
Private Const PersonTypePlaylist As String = "playlist"
Private Const PlaylistsLabelName As String = "Playlist"
#End Region #End Region
#Region "Person" #Region "Person"
Friend Property PersonType As String Friend Property PersonType As String
@@ -133,7 +135,7 @@ Namespace API.PornHub
#Region "Advanced fields" #Region "Advanced fields"
Friend Overrides ReadOnly Property FeedIsUser As Boolean Friend Overrides ReadOnly Property FeedIsUser As Boolean
Get Get
Return IsUser Return IsUser Or SiteMode = SiteModes.Playlists
End Get End Get
End Property End Property
Private Property PhotoPageModel As PhotoPageModels = PhotoPageModels.Undefined Private Property PhotoPageModel As PhotoPageModels = PhotoPageModels.Undefined
@@ -144,12 +146,12 @@ Namespace API.PornHub
Friend Property DownloadFavorite As Boolean = False Friend Property DownloadFavorite As Boolean = False
Friend Property DownloadGifs As Boolean Friend Property DownloadGifs As Boolean
Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True
Private _IsUser As Boolean = True
Friend Overrides ReadOnly Property IsUser As Boolean Friend Overrides ReadOnly Property IsUser As Boolean
Get Get
Return _IsUser Return SiteMode = SiteModes.User
End Get End Get
End Property End Property
Friend Property SiteMode As SiteModes = SiteModes.User
Friend Property QueryString As String Friend Property QueryString As String
Get Get
If IsUser Then If IsUser Then
@@ -164,7 +166,7 @@ Namespace API.PornHub
End Property End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String) Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get Get
Return {SearchRequestLabelName} Return {SearchRequestLabelName, PlaylistsLabelName}
End Get End Get
End Property End Property
#End Region #End Region
@@ -192,38 +194,43 @@ Namespace API.PornHub
Return DirectCast(HOST.Source, SiteSettings) Return DirectCast(HOST.Source, SiteSettings)
End Get End Get
End Property End Property
Private ReadOnly LastPageIDs As List(Of String)
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
LastPageIDs = New List(Of String)
UseInternalM3U8Function = True UseInternalM3U8Function = True
UseClientTokens = True UseClientTokens = True
SessionPosts = New List(Of String)
End Sub End Sub
#End Region #End Region
#Region "Loader" #Region "Loader"
Private Function UpdateUserOptions(Optional ByVal Force As Boolean = False, Optional ByVal NewUrl As String = Nothing) As Boolean 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 If Not Force OrElse (Not IsUser AndAlso Not SiteMode = SiteModes.Playlists AndAlso Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then
Dim eObj As Plugin.ExchangeOptions = Nothing Dim eObj As Plugin.ExchangeOptions = Nothing
If Force Then eObj = MySettings.IsMyUser(NewUrl) 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 (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 Not If(Force, eObj.Options, Options).IsEmptyString Then
If IsUser And Force Then If (IsUser Or SiteMode = SiteModes.Playlists) And Force Then
Return False Return False
Else Else
_IsUser = False SiteMode = SiteModes.Search
Options = If(Force, eObj.Options, Options) Options = If(Force, eObj.Options, Options)
If Options.ToLower.StartsWith(PersonTypePlaylist) Then
SiteMode = SiteModes.Playlists
NameTrue = Options.ToLower.Replace(PersonTypePlaylist, String.Empty).StringTrim.TrimStart("/")
Else
NameTrue = Options NameTrue = Options
End If
If Not Force Then If Not Force Then
Settings.Labels.Add(SearchRequestLabelName) Dim l$ = IIf(SiteMode = SiteModes.Playlists, PlaylistsLabelName, SearchRequestLabelName)
Labels.ListAddValue(SearchRequestLabelName, LNC) Settings.Labels.Add(l)
Labels.ListAddValue(l, LNC)
Labels.Sort() Labels.Sort()
Return True Return True
End If End If
End If End If
Else Else
_IsUser = True SiteMode = SiteModes.User
Dim n$() = Name.Split("_") Dim n$() = Name.Split("_")
If n.ListExists(2) Then If n.ListExists(2) Then
NameTrue = Name.Replace($"{n(0)}_", String.Empty) NameTrue = Name.Replace($"{n(0)}_", String.Empty)
@@ -247,7 +254,14 @@ Namespace API.PornHub
DownloadFavorite = .Value(Name_DownloadFavorite).FromXML(Of Boolean)(False) DownloadFavorite = .Value(Name_DownloadFavorite).FromXML(Of Boolean)(False)
DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False) DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False)
DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True) DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True)
_IsUser = .Value(Name_IsUser).FromXML(Of Boolean)(True) If .Contains(Name_SiteMode) Then
SiteMode = .Value(Name_SiteMode).FromXML(Of Integer)(SiteModes.User)
Else
'TODELETE: PornHub 'IsUser' 20231113
#Disable Warning BC40008
SiteMode = IIf(.Value(Name_IsUser).FromXML(Of Boolean)(True), SiteModes.User, SiteModes.Search)
#Enable Warning
End If
UpdateUserOptions() UpdateUserOptions()
Else Else
If UpdateUserOptions() Then .Value(Name_LabelsName) = LabelsString If UpdateUserOptions() Then .Value(Name_LabelsName) = LabelsString
@@ -261,7 +275,7 @@ Namespace API.PornHub
.Add(Name_DownloadFavorite, DownloadFavorite.BoolToInteger) .Add(Name_DownloadFavorite, DownloadFavorite.BoolToInteger)
.Add(Name_DownloadGifs, DownloadGifs.BoolToInteger) .Add(Name_DownloadGifs, DownloadGifs.BoolToInteger)
.Add(Name_DownloadPhotoOnlyFromModelHub, DownloadPhotoOnlyFromModelHub.BoolToInteger) .Add(Name_DownloadPhotoOnlyFromModelHub, DownloadPhotoOnlyFromModelHub.BoolToInteger)
.Add(Name_IsUser, IsUser.BoolToInteger) .Add(Name_SiteMode, CInt(SiteMode))
'Debug.WriteLine(GetNonUserUrl(0)) 'Debug.WriteLine(GetNonUserUrl(0))
'Debug.WriteLine(GetNonUserUrl(2)) 'Debug.WriteLine(GetNonUserUrl(2))
@@ -271,9 +285,16 @@ Namespace API.PornHub
#End Region #End Region
#Region "Downloading" #Region "Downloading"
#Region "Download override" #Region "Download override"
Private Const PlayListUrlPattern As String = "https://www.pornhub.com/playlist/viewChunked?id={0}&token={1}&page={2}"
Private PlaylistToken As String = String.Empty
Private ReadOnly SessionPosts As List(Of String)
Private _PageVideosRepeat As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try Try
PlaylistToken = String.Empty
Responser.ResetStatus() Responser.ResetStatus()
_PageVideosRepeat = 0
SessionPosts.Clear()
If IsSavedPosts Then If IsSavedPosts Then
PersonType = PersonTypeUser PersonType = PersonTypeUser
@@ -283,28 +304,32 @@ Namespace API.PornHub
Dim limit% = If(DownloadTopCount, -1) Dim limit% = If(DownloadTopCount, -1)
If DownloadVideos Then If DownloadVideos Then
If IsSavedPosts Or Not IsUser Or PersonType = PersonTypeUser Then If SiteMode = SiteModes.Playlists Then
Responser.Mode = Responser.Modes.Default
GetPlaylistToken(Token)
DownloadUserVideos(1, VideoTypes.Favorite, False, Token)
ElseIf IsSavedPosts Or Not IsUser Or PersonType = PersonTypeUser Then
DownloadUserVideos(1, VideoTypes.Favorite, False, Token) DownloadUserVideos(1, VideoTypes.Favorite, False, Token)
Else Else
If DownloadUploaded Then If DownloadUploaded Then
LastPageIDs.Clear() SessionPosts.Clear()
DownloadUserVideos(1, VideoTypes.Uploaded, False, Token) DownloadUserVideos(1, VideoTypes.Uploaded, False, Token)
End If End If
If DownloadTagged Then If DownloadTagged Then
LastPageIDs.Clear() SessionPosts.Clear()
Dim lBefore% = _TempMediaList.Count Dim lBefore% = _TempMediaList.Count
DownloadUserVideos(1, VideoTypes.Tagged, False, Token) DownloadUserVideos(1, VideoTypes.Tagged, False, Token)
If PersonType = PersonTypePornstar And lBefore = _TempMediaList.Count Then If PersonType = PersonTypePornstar And lBefore = _TempMediaList.Count Then
LastPageIDs.Clear() SessionPosts.Clear()
DownloadUserVideos(1, VideoTypes.Tagged, True, Token) DownloadUserVideos(1, VideoTypes.Tagged, True, Token)
End If End If
End If End If
If DownloadPrivate Then If DownloadPrivate Then
LastPageIDs.Clear() SessionPosts.Clear()
DownloadUserVideos(1, VideoTypes.Private, False, Token) DownloadUserVideos(1, VideoTypes.Private, False, Token)
End If End If
If DownloadFavorite Then If DownloadFavorite Then
LastPageIDs.Clear() SessionPosts.Clear()
DownloadUserVideos(1, VideoTypes.Favorite, False, Token) DownloadUserVideos(1, VideoTypes.Favorite, False, Token)
End If End If
End If End If
@@ -348,6 +373,7 @@ Namespace API.PornHub
Dim specFolder$ = String.Empty Dim specFolder$ = String.Empty
Dim tryNextPage As Boolean = False Dim tryNextPage As Boolean = False
Dim limit% = If(DownloadTopCount, -1) Dim limit% = If(DownloadTopCount, -1)
Dim cBefore% = _TempMediaList.Count
If IsUser Then If IsUser Then
URL = $"https://www.pornhub.com/{PersonType}/{NameTrue}" URL = $"https://www.pornhub.com/{PersonType}/{NameTrue}"
If Type = VideoTypes.Uploaded Then If Type = VideoTypes.Uploaded Then
@@ -365,6 +391,9 @@ Namespace API.PornHub
Throw New ArgumentException($"Type '{Type}' is not implemented in the video download function", "Type") Throw New ArgumentException($"Type '{Type}' is not implemented in the video download function", "Type")
End If End If
If Page > 1 Then URL &= $"?page={Page}" If Page > 1 Then URL &= $"?page={Page}"
ElseIf SiteMode = SiteModes.Playlists Then
If PlaylistToken.IsEmptyString Then Throw New ArgumentNullException("PlaylistToken", "Unable to get 'PlaylistToken'")
URL = String.Format(PlayListUrlPattern, NameTrue, PlaylistToken, Page)
Else Else
URL = GetNonUserUrl(Page) URL = GetNonUserUrl(Page)
End If End If
@@ -375,7 +404,7 @@ Namespace API.PornHub
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim l As List(Of UserVideo) = RegexFields(Of UserVideo)(r, {RegexUserVideos}, {6, 7, 3, 10}) 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 And Not SiteMode = SiteModes.Playlists Then l = l.ListTake(3, l.Count).ToList
If l.ListExists Then If l.ListExists Then
If IsUser Then If IsUser Then
If Type = VideoTypes.Favorite Then If Type = VideoTypes.Favorite Then
@@ -389,23 +418,37 @@ Namespace API.PornHub
Dim lBefore% = l.Count Dim lBefore% = l.Count
Dim nonLastPageDetected As Boolean = False Dim nonLastPageDetected As Boolean = False
Dim newLastPageIDs As New List(Of String) Dim newLastPageIDs As New List(Of String)
Dim pageRepeatSet As Boolean = False, prevPostsFound As Boolean = False, newPostsFound As Boolean = False
l.RemoveAll(Function(ByVal uv As UserVideo) As Boolean l.RemoveAll(Function(ByVal uv As UserVideo) As Boolean
newLastPageIDs.Add(uv.ID)
If Not _TempPostsList.Contains(uv.ID) Then If Not _TempPostsList.Contains(uv.ID) Then
_TempPostsList.Add(uv.ID) _TempPostsList.Add(uv.ID)
newLastPageIDs.Add(uv.ID)
Return False Return False
ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(uv.id) Then
prevPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
Return True
Else Else
If Not LastPageIDs.Contains(uv.ID) Then nonLastPageDetected = True 'TODELETE: PornHub old validating
'If Not SessionPosts.Contains(uv.ID) Then nonLastPageDetected = True
If Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : _PageVideosRepeat += 1
'Debug.WriteLine($"[REMOVED]: {uv.Title}") 'Debug.WriteLine($"[REMOVED]: {uv.Title}")
Return True Return True
End If End If
End Function) End Function)
'Debug.WriteLineIf(l.Count > 0, l.Select(Function(ll) ll.Title).ListToString(vbNewLine)) '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))) If l.Count > 0 Then _TempMediaList.ListAddList(l.Select(Function(uv) uv.ToUserMedia(specFolder)))
LastPageIDs.Clear() SessionPosts.ListAddList(newLastPageIDs, LNC)
If newLastPageIDs.Count > 0 Then LastPageIDs.AddRange(newLastPageIDs) : newLastPageIDs.Clear() newLastPageIDs.Clear()
If l.Count > 0 AndAlso (l.Count = lBefore Or Not nonLastPageDetected) AndAlso 'TODELETE: PornHub old validating
Not (limit > 0 And _TempMediaList.Count >= limit) Then tryNextPage = True 'If l.Count > 0 AndAlso (l.Count = lBefore Or Not nonLastPageDetected) AndAlso
' Not (limit > 0 And _TempMediaList.Count >= limit) Then tryNextPage = True
If limit > 0 And _TempMediaList.Count >= limit Then Exit Sub
If (Not IsUser And prevPostsFound And Not newPostsFound And Page < 1000) Or
(Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000)) Then tryNextPage = True
l.Clear()
End If End If
End If End If
End If End If
@@ -419,6 +462,15 @@ Namespace API.PornHub
ProgressPre.Perform() ProgressPre.Perform()
End Try End Try
End Sub End Sub
Private Sub GetPlaylistToken(ByVal Token As CancellationToken)
Dim URL$ = GetNonUserUrl(0)
Try
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then PlaylistToken = RegexReplace(r, RegexDataToken)
Catch ex As Exception
ProcessException(ex, Token, $"token getting error [{URL}]")
End Try
End Sub
#End Region #End Region
#Region "Download GIF" #Region "Download GIF"
Private Sub DownloadUserGifs(ByVal Token As CancellationToken) Private Sub DownloadUserGifs(ByVal Token As CancellationToken)
@@ -931,7 +983,7 @@ Namespace API.PornHub
#End Region #End Region
#Region "IDisposable Support" #Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then LastPageIDs.Clear() If Not disposedValue And disposing Then SessionPosts.Clear()
MyBase.Dispose(disposing) MyBase.Dispose(disposing)
End Sub End Sub
#End Region #End Region

View File

@@ -18,7 +18,7 @@ Imports Period = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit Namespace API.Reddit
Friend Class Channel : Implements ICollection(Of UserPost), IEquatable(Of Channel), IComparable(Of Channel), Friend Class Channel : Implements ICollection(Of UserPost), IEquatable(Of Channel), IComparable(Of Channel),
IRangeSwitcherContainer(Of UserPost), ILoaderSaver, IMyEnumerator(Of UserPost), IChannelLimits, IRedditView, IDisposable IRangeSwitcherContainer(Of UserPost), ILoaderSaver, IMyEnumerator(Of UserPost), IChannelLimits, IRedditView, IDisposable
#Region "XML Nodes' Names" #Region "XML Names"
Private Const Name_Name As String = "Name" Private Const Name_Name As String = "Name"
Private Const Name_ID As String = "ID" Private Const Name_ID As String = "ID"
Private Const Name_Date As String = "Date" Private Const Name_Date As String = "Date"
@@ -88,10 +88,14 @@ Namespace API.Reddit
End Property End Property
Friend Property ViewMode As View = View.New Implements IRedditView.ViewMode Friend Property ViewMode As View = View.New Implements IRedditView.ViewMode
Friend Property ViewPeriod As Period = Period.All Implements IRedditView.ViewPeriod Friend Property ViewPeriod As Period = Period.All Implements IRedditView.ViewPeriod
Friend Property RedGifsAccount As String = String.Empty Implements IRedditView.RedGifsAccount
Friend Property RedditAccount As String = String.Empty Implements IRedditView.RedditAccount
Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView
If Not Options Is Nothing Then If Not Options Is Nothing Then
ViewMode = Options.ViewMode ViewMode = Options.ViewMode
ViewPeriod = Options.ViewPeriod ViewPeriod = Options.ViewPeriod
RedditAccount = Options.RedditAccount
RedGifsAccount = Options.RedGifsAccount
End If End If
End Sub End Sub
#Region "Statistics support" #Region "Statistics support"
@@ -215,7 +219,17 @@ Namespace API.Reddit
End Sub End Sub
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
#End Region #End Region
Private _HOST As SettingsHost
Friend ReadOnly Property HOST As SettingsHost Friend ReadOnly Property HOST As SettingsHost
Get
_HOST = Settings(RedditSiteKey, RedditAccount)
If _HOST Is Nothing Then
MyMainLOG = $"Reddit account '{RedditAccount}' for channel '{Name}' not found in the accounts. The default account will be used."
_HOST = Settings(RedditSiteKey).Default
End If
Return _HOST
End Get
End Property
Friend Sub New() Friend Sub New()
Posts = New List(Of UserPost) Posts = New List(Of UserPost)
PostsLatest = New List(Of UserPost) PostsLatest = New List(Of UserPost)
@@ -223,7 +237,6 @@ Namespace API.Reddit
CountOfAddedUsers = New List(Of Integer) CountOfAddedUsers = New List(Of Integer)
CountOfLoadedPostsPerSession = New List(Of Integer) CountOfLoadedPostsPerSession = New List(Of Integer)
ChannelExistentUserNames = New List(Of String) ChannelExistentUserNames = New List(Of String)
HOST = Settings(RedditSiteKey)
End Sub End Sub
Friend Sub New(ByVal f As SFile) Friend Sub New(ByVal f As SFile)
Me.New Me.New
@@ -350,6 +363,8 @@ Namespace API.Reddit
ID = x.Value(Name_ID) ID = x.Value(Name_ID)
ViewMode = x.Value(Name_ViewMode).FromXML(Of Integer)(CInt(View.[New])) ViewMode = x.Value(Name_ViewMode).FromXML(Of Integer)(CInt(View.[New]))
ViewPeriod = x.Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(Period.All)) ViewPeriod = x.Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(Period.All))
RedGifsAccount = x.Value(Name_RedGifsAccount)
RedditAccount = x.Value(Name_RedditAccount)
If FilePosts.Exists Then PostsNames.ListAddList(FilePosts.GetText.StringToList(Of String)("|"), LNC) If FilePosts.Exists Then PostsNames.ListAddList(FilePosts.GetText.StringToList(Of String)("|"), LNC)
LatestParsedDate = AConvert(Of Date)(x.Value(Name_Date), DateTimeDefaultProvider, Nothing) LatestParsedDate = AConvert(Of Date)(x.Value(Name_Date), DateTimeDefaultProvider, Nothing)
CountOfAddedUsers.ListAddList(x.Value(Name_UsersAdded).StringToList(Of Integer)("|"), lc) CountOfAddedUsers.ListAddList(x.Value(Name_UsersAdded).StringToList(Of Integer)("|"), lc)
@@ -388,6 +403,8 @@ Namespace API.Reddit
x.Add(Name_UsersAdded, CountOfAddedUsers.ListToString("|")) x.Add(Name_UsersAdded, CountOfAddedUsers.ListToString("|"))
x.Add(Name_PostsDownloaded, CountOfLoadedPostsPerSession.ListToString("|")) x.Add(Name_PostsDownloaded, CountOfLoadedPostsPerSession.ListToString("|"))
x.Add(Name_UsersExistent, ChannelExistentUserNames.ListToString("|")) x.Add(Name_UsersExistent, ChannelExistentUserNames.ListToString("|"))
x.Add(Name_RedGifsAccount, RedGifsAccount)
x.Add(Name_RedditAccount, RedditAccount)
If Posts.Count > 0 Or PostsLatest.Count > 0 Then If Posts.Count > 0 Or PostsLatest.Count > 0 Then
Dim tmpPostList As List(Of UserPost) = Nothing Dim tmpPostList As List(Of UserPost) = Nothing
tmpPostList.ListAddList(Posts).ListAddList(PostsLatest) tmpPostList.ListAddList(Posts).ListAddList(PostsLatest)

View File

@@ -23,17 +23,25 @@ Namespace API.Reddit
End Enum End Enum
Property ViewMode As View Property ViewMode As View
Property ViewPeriod As Period Property ViewPeriod As Period
Property RedGifsAccount As String
Property RedditAccount As String
Sub SetView(ByVal Options As IRedditView) Sub SetView(ByVal Options As IRedditView)
End Interface End Interface
Friend Class RedditViewExchange : Implements IRedditView Friend Class RedditViewExchange : Implements IRedditView
Friend Const Name_ViewMode As String = "ViewMode" Friend Const Name_ViewMode As String = "ViewMode"
Friend Const Name_ViewPeriod As String = "ViewPeriod" Friend Const Name_ViewPeriod As String = "ViewPeriod"
Friend Const Name_RedGifsAccount As String = "RedGifsAccount"
Friend Const Name_RedditAccount As String = "RedditAccount"
Friend Property ViewMode As IRedditView.View Implements IRedditView.ViewMode Friend Property ViewMode As IRedditView.View Implements IRedditView.ViewMode
Friend Property ViewPeriod As IRedditView.Period Implements IRedditView.ViewPeriod Friend Property ViewPeriod As IRedditView.Period Implements IRedditView.ViewPeriod
Friend Property RedGifsAccount As String Implements IRedditView.RedGifsAccount
Friend Property RedditAccount As String Implements IRedditView.RedditAccount
Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView
If Not Options Is Nothing Then If Not Options Is Nothing Then
ViewMode = Options.ViewMode ViewMode = Options.ViewMode
ViewPeriod = Options.ViewPeriod ViewPeriod = Options.ViewPeriod
RedGifsAccount = Options.RedGifsAccount
RedditAccount = Options.RedditAccount
End If End If
End Sub End Sub
End Class End Class

View File

@@ -23,10 +23,13 @@ Namespace API.Reddit
<System.Diagnostics.DebuggerStepThrough()> <System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent() Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim TP_VIEW_MODE As System.Windows.Forms.TableLayoutPanel Dim TP_VIEW_MODE As System.Windows.Forms.TableLayoutPanel
Dim LBL_VIEW_MODE As System.Windows.Forms.Label Dim LBL_VIEW_MODE As System.Windows.Forms.Label
Dim LBL_PERIOD As System.Windows.Forms.Label Dim LBL_PERIOD As System.Windows.Forms.Label
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(RedditViewSettingsForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
Me.OPT_VIEW_MODE_NEW = New System.Windows.Forms.RadioButton() Me.OPT_VIEW_MODE_NEW = New System.Windows.Forms.RadioButton()
Me.OPT_VIEW_MODE_HOT = New System.Windows.Forms.RadioButton() Me.OPT_VIEW_MODE_HOT = New System.Windows.Forms.RadioButton()
Me.OPT_VIEW_MODE_TOP = New System.Windows.Forms.RadioButton() Me.OPT_VIEW_MODE_TOP = New System.Windows.Forms.RadioButton()
@@ -37,16 +40,19 @@ Namespace API.Reddit
Me.OPT_PERIOD_WEEK = New System.Windows.Forms.RadioButton() Me.OPT_PERIOD_WEEK = New System.Windows.Forms.RadioButton()
Me.OPT_PERIOD_MONTH = New System.Windows.Forms.RadioButton() Me.OPT_PERIOD_MONTH = New System.Windows.Forms.RadioButton()
Me.OPT_PERIOD_YEAR = New System.Windows.Forms.RadioButton() Me.OPT_PERIOD_YEAR = New System.Windows.Forms.RadioButton()
Me.CMB_REDGIFS_ACC = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.CMB_REDDIT_ACC = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer() CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_VIEW_MODE = New System.Windows.Forms.TableLayoutPanel() TP_VIEW_MODE = New System.Windows.Forms.TableLayoutPanel()
LBL_VIEW_MODE = New System.Windows.Forms.Label() LBL_VIEW_MODE = New System.Windows.Forms.Label()
LBL_PERIOD = New System.Windows.Forms.Label() LBL_PERIOD = New System.Windows.Forms.Label()
CONTAINER_MAIN.ContentPanel.SuspendLayout() CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout() CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout() Me.TP_MAIN.SuspendLayout()
TP_VIEW_MODE.SuspendLayout() TP_VIEW_MODE.SuspendLayout()
Me.TP_PERIOD.SuspendLayout() Me.TP_PERIOD.SuspendLayout()
CType(Me.CMB_REDGIFS_ACC, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.CMB_REDDIT_ACC, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout() Me.SuspendLayout()
' '
'CONTAINER_MAIN 'CONTAINER_MAIN
@@ -54,34 +60,37 @@ Namespace API.Reddit
' '
'CONTAINER_MAIN.ContentPanel 'CONTAINER_MAIN.ContentPanel
' '
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN) CONTAINER_MAIN.ContentPanel.Controls.Add(Me.TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(477, 87) CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(477, 169)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0) CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
CONTAINER_MAIN.Name = "CONTAINER_MAIN" CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(477, 112) CONTAINER_MAIN.Size = New System.Drawing.Size(477, 169)
CONTAINER_MAIN.TabIndex = 0 CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False CONTAINER_MAIN.TopToolStripPanelVisible = False
' '
'TP_MAIN 'TP_MAIN
' '
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single] Me.TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1 Me.TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Controls.Add(TP_VIEW_MODE, 0, 0) Me.TP_MAIN.Controls.Add(TP_VIEW_MODE, 0, 0)
TP_MAIN.Controls.Add(Me.TP_PERIOD, 0, 1) Me.TP_MAIN.Controls.Add(Me.TP_PERIOD, 0, 1)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill Me.TP_MAIN.Controls.Add(Me.CMB_REDGIFS_ACC, 0, 3)
TP_MAIN.Location = New System.Drawing.Point(0, 0) Me.TP_MAIN.Controls.Add(Me.CMB_REDDIT_ACC, 0, 2)
TP_MAIN.Name = "TP_MAIN" Me.TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.RowCount = 3 Me.TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!)) Me.TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 56.0!)) Me.TP_MAIN.RowCount = 5
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) Me.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, 20.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 56.0!))
TP_MAIN.Size = New System.Drawing.Size(477, 87) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.TabIndex = 0 Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(477, 169)
Me.TP_MAIN.TabIndex = 0
' '
'TP_VIEW_MODE 'TP_VIEW_MODE
' '
@@ -258,19 +267,55 @@ Namespace API.Reddit
Me.OPT_PERIOD_YEAR.Text = "Year" Me.OPT_PERIOD_YEAR.Text = "Year"
Me.OPT_PERIOD_YEAR.UseVisualStyleBackColor = True Me.OPT_PERIOD_YEAR.UseVisualStyleBackColor = True
' '
'CMB_REDGIFS_ACC
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "ArrowDown"
ActionButton1.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.ArrowDown
Me.CMB_REDGIFS_ACC.Buttons.Add(ActionButton1)
Me.CMB_REDGIFS_ACC.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.Label
Me.CMB_REDGIFS_ACC.CaptionSizeType = System.Windows.Forms.SizeType.Percent
Me.CMB_REDGIFS_ACC.CaptionText = "RedGifs account"
Me.CMB_REDGIFS_ACC.CaptionVisible = True
Me.CMB_REDGIFS_ACC.CaptionWidth = 26.0R
Me.CMB_REDGIFS_ACC.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_REDGIFS_ACC.Location = New System.Drawing.Point(4, 119)
Me.CMB_REDGIFS_ACC.Name = "CMB_REDGIFS_ACC"
Me.CMB_REDGIFS_ACC.Size = New System.Drawing.Size(469, 22)
Me.CMB_REDGIFS_ACC.TabIndex = 4
Me.CMB_REDGIFS_ACC.TextBoxBorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
'
'CMB_REDDIT_ACC
'
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "ArrowDown"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.ArrowDown
Me.CMB_REDDIT_ACC.Buttons.Add(ActionButton2)
Me.CMB_REDDIT_ACC.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.Label
Me.CMB_REDDIT_ACC.CaptionSizeType = System.Windows.Forms.SizeType.Percent
Me.CMB_REDDIT_ACC.CaptionText = "Reddit account"
Me.CMB_REDDIT_ACC.CaptionVisible = True
Me.CMB_REDDIT_ACC.CaptionWidth = 26.0R
Me.CMB_REDDIT_ACC.Dock = System.Windows.Forms.DockStyle.Fill
Me.CMB_REDDIT_ACC.Location = New System.Drawing.Point(4, 90)
Me.CMB_REDDIT_ACC.Name = "CMB_REDDIT_ACC"
Me.CMB_REDDIT_ACC.Size = New System.Drawing.Size(469, 22)
Me.CMB_REDDIT_ACC.TabIndex = 3
Me.CMB_REDDIT_ACC.TextBoxBorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
'
'RedditViewSettingsForm 'RedditViewSettingsForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(477, 112) Me.ClientSize = New System.Drawing.Size(477, 169)
Me.Controls.Add(CONTAINER_MAIN) Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteResources.RedditIcon_128 Me.Icon = Global.SCrawler.My.Resources.SiteResources.RedditIcon_128
Me.KeyPreview = True Me.KeyPreview = True
Me.MaximizeBox = False Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(493, 151) Me.MaximumSize = New System.Drawing.Size(493, 208)
Me.MinimizeBox = False Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(493, 151) Me.MinimumSize = New System.Drawing.Size(493, 208)
Me.Name = "RedditViewSettingsForm" Me.Name = "RedditViewSettingsForm"
Me.ShowInTaskbar = False Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
@@ -278,11 +323,13 @@ Namespace API.Reddit
CONTAINER_MAIN.ContentPanel.ResumeLayout(False) CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False) CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout() CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False) Me.TP_MAIN.ResumeLayout(False)
TP_VIEW_MODE.ResumeLayout(False) TP_VIEW_MODE.ResumeLayout(False)
TP_VIEW_MODE.PerformLayout() TP_VIEW_MODE.PerformLayout()
Me.TP_PERIOD.ResumeLayout(False) Me.TP_PERIOD.ResumeLayout(False)
Me.TP_PERIOD.PerformLayout() Me.TP_PERIOD.PerformLayout()
CType(Me.CMB_REDGIFS_ACC, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.CMB_REDDIT_ACC, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False) Me.ResumeLayout(False)
End Sub End Sub
@@ -296,5 +343,8 @@ Namespace API.Reddit
Private WithEvents OPT_PERIOD_MONTH As RadioButton Private WithEvents OPT_PERIOD_MONTH As RadioButton
Private WithEvents OPT_PERIOD_YEAR As RadioButton Private WithEvents OPT_PERIOD_YEAR As RadioButton
Private WithEvents TP_PERIOD As TableLayoutPanel Private WithEvents TP_PERIOD As TableLayoutPanel
Private WithEvents CMB_REDGIFS_ACC As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents CMB_REDDIT_ACC As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents TP_MAIN As TableLayoutPanel
End Class End Class
End Namespace End Namespace

View File

@@ -120,9 +120,6 @@
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> <metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </metadata>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_VIEW_MODE.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> <metadata name="TP_VIEW_MODE.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </metadata>
@@ -132,4 +129,185 @@
<metadata name="LBL_PERIOD.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> <metadata name="LBL_PERIOD.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </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>
<data name="ActionButton2.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> </root>

View File

@@ -6,16 +6,21 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls
Imports PersonalUtilities.Forms.Controls.Base
Imports CView = SCrawler.API.Reddit.IRedditView.View Imports CView = SCrawler.API.Reddit.IRedditView.View
Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit Namespace API.Reddit
Friend Class RedditViewSettingsForm Friend Class RedditViewSettingsForm
Private WithEvents MyDefs As DefaultFormOptions Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property MyOptions As IRedditView Private ReadOnly Property MyOptions As IRedditView
Friend Sub New(ByRef opt As IRedditView) Private ReadOnly Property IsUserSettings As Boolean
Friend Sub New(ByRef opt As IRedditView, ByVal _IsUserSettings As Boolean)
InitializeComponent() InitializeComponent()
MyOptions = opt MyOptions = opt
IsUserSettings = _IsUserSettings
MyDefs = New DefaultFormOptions(Me, Settings.Design) MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub End Sub
Private Sub RedditViewSettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load Private Sub RedditViewSettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
@@ -44,12 +49,52 @@ Namespace API.Reddit
Case Else : OPT_PERIOD_ALL.Checked = True Case Else : OPT_PERIOD_ALL.Checked = True
End Select End Select
ChangePeriodEnabled() ChangePeriodEnabled()
PopulateCMB(Settings(RedditSiteKey), CMB_REDDIT_ACC, MyOptions.RedditAccount)
PopulateCMB(Settings(RedGifs.RedGifsSiteKey), CMB_REDGIFS_ACC, MyOptions.RedGifsAccount)
If IsUserSettings Then
TP_MAIN.Controls.Remove(CMB_REDDIT_ACC)
TP_MAIN.RowStyles(2).Height = 0
TP_MAIN.Refresh()
Dim s As Size = Size
s.Height -= 28
MaximumSize = Nothing
MinimumSize = Nothing
Size = s
MinimumSize = s
MaximumSize = s
Refresh()
End If
.EndLoaderOperations() .EndLoaderOperations()
End With End With
Catch ex As Exception Catch ex As Exception
MyDefs.InvokeLoaderError(ex) MyDefs.InvokeLoaderError(ex)
End Try End Try
End Sub End Sub
Private Sub PopulateCMB(ByVal Plugin As SettingsHostCollection, ByRef CMB As ComboBoxExtended, ByVal Acc As String)
With CMB
Dim indx% = 0
.BeginUpdate()
If Plugin.Count = 1 Then
.Text = SettingsHost.NameAccountNameDefault
.LeaveDefaultButtons = False
.Buttons.Clear()
.Buttons.UpdateButtonsPositions(True)
.CaptionWidth -= 1
Else
Dim data As List(Of String) = Plugin.Select(Function(h) h.AccountName.IfNullOrEmpty(SettingsHost.NameAccountNameDefault)).ToList
If Not Acc.IsEmptyString Then
indx = data.IndexOf(Acc)
If indx = -1 Then indx = 0
End If
.Items.AddRange(data.Select(Function(d) New ListItem(d)))
End If
.EndUpdate(True)
If .Count > 0 Then .SelectedIndex = indx
.Enabled = .Count > 1
End With
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With MyOptions With MyOptions
Select Case True Select Case True
@@ -65,6 +110,8 @@ Namespace API.Reddit
Case OPT_PERIOD_YEAR.Checked : .ViewPeriod = CPeriod.Year Case OPT_PERIOD_YEAR.Checked : .ViewPeriod = CPeriod.Year
Case Else : .ViewPeriod = CPeriod.All Case Else : .ViewPeriod = CPeriod.All
End Select End Select
.RedGifsAccount = CMB_REDGIFS_ACC.Text
If Not IsUserSettings Then .RedditAccount = CMB_REDDIT_ACC.Text
End With End With
MyDefs.CloseForm() MyDefs.CloseForm()
End Sub End Sub

View File

@@ -18,27 +18,15 @@ Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Reddit Namespace API.Reddit
<Manifest(RedditSiteKey), SavedPosts, SpecialForm(False)> <Manifest(RedditSiteKey), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Icons"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.RedditIcon_128
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.RedditPic_512
End Get
End Property
#End Region
#Region "Declarations" #Region "Declarations"
#Region "Authorization" #Region "Authorization"
<PropertyOption(ControlText:="Login", ControlToolTip:="Your authorization username", IsAuth:=True), PXML> <PropertyOption(ControlText:="Login", ControlToolTip:="Your authorization username", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property AuthUserName As PropertyValue Friend ReadOnly Property AuthUserName As PropertyValue
<PropertyOption(ControlText:="Password", ControlToolTip:="Your authorization password", IsAuth:=True), PXML> <PropertyOption(ControlText:="Password", ControlToolTip:="Your authorization password", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property AuthPassword As PropertyValue Friend ReadOnly Property AuthPassword As PropertyValue
<PropertyOption(ControlText:="Client ID", ControlToolTip:="Your registered app client ID", IsAuth:=True), PXML> <PropertyOption(ControlText:="Client ID", ControlToolTip:="Your registered app client ID", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property ApiClientID As PropertyValue Friend ReadOnly Property ApiClientID As PropertyValue
<PropertyOption(ControlText:="Client Secret", ControlToolTip:="Your registered app client secret", IsAuth:=True), PXML> <PropertyOption(ControlText:="Client Secret", ControlToolTip:="Your registered app client secret", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property ApiClientSecret As PropertyValue Friend ReadOnly Property ApiClientSecret As PropertyValue
<PropertyOption(ControlText:="Bearer token", <PropertyOption(ControlText:="Bearer token",
ControlToolTip:="Bearer token (can be null)." & vbCr & ControlToolTip:="Bearer token (can be null)." & vbCr &
@@ -48,29 +36,29 @@ Namespace API.Reddit
Friend ReadOnly Property BearerToken As PropertyValue Friend ReadOnly Property BearerToken As PropertyValue
#Region "TokenUpdateInterval" #Region "TokenUpdateInterval"
<PropertyOption(ControlText:="Token refresh interval", ControlToolTip:="Interval (in minutes) to refresh the token", <PropertyOption(ControlText:="Token refresh interval", ControlToolTip:="Interval (in minutes) to refresh the token",
AllowNull:=False, LeftOffset:=120, IsAuth:=True), PXML> AllowNull:=False, LeftOffset:=120, IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property TokenUpdateInterval As PropertyValue Friend ReadOnly Property TokenUpdateInterval As PropertyValue
<Provider(NameOf(TokenUpdateInterval), FieldsChecker:=True)> <Provider(NameOf(TokenUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider
#End Region #End Region
<PXML> Private ReadOnly Property BearerTokenDateUpdate As PropertyValue <PXML, PClonable> Private ReadOnly Property BearerTokenDateUpdate As PropertyValue
<PropertyOption(ControlText:="Use the token to download the timeline", IsAuth:=True), PXML> <PropertyOption(ControlText:="Use the token to download the timeline", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property UseTokenForTimelines As PropertyValue Friend ReadOnly Property UseTokenForTimelines As PropertyValue
<PropertyOption(ControlText:="Use the token to download saved posts", IsAuth:=True), PXML> <PropertyOption(ControlText:="Use the token to download saved posts", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property UseTokenForSavedPosts As PropertyValue Friend ReadOnly Property UseTokenForSavedPosts As PropertyValue
<PropertyOption(ControlText:="Use cookies to download the timeline", IsAuth:=True), PXML> <PropertyOption(ControlText:="Use cookies to download the timeline", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property UseCookiesForTimelines As PropertyValue Friend ReadOnly Property UseCookiesForTimelines As PropertyValue
<PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip, IsAuth:=True), PXML> <PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip, IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue Friend ReadOnly Property SavedPostsUserName As PropertyValue
#End Region #End Region
#Region "Other" #Region "Other"
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML> <PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML, PClonable>
Friend ReadOnly Property UseM3U8 As PropertyValue Friend ReadOnly Property UseM3U8 As PropertyValue
#End Region #End Region
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New(RedditSite, "reddit.com") MyBase.New(RedditSite, "reddit.com", AccName, Temp, My.Resources.SiteResources.RedditIcon_128, My.Resources.SiteResources.RedditPic_512)
Dim token$ Dim token$
With Responser With Responser
@@ -144,6 +132,7 @@ Namespace API.Reddit
End Function End Function
Private Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean Private Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean
Try Try
AvailableText = String.Empty
Dim trueValue As Boolean = Not What = Download.SavedPosts OrElse (Responser.CookiesExists And ACheck(SavedPostsUserName.Value)) Dim trueValue As Boolean = Not What = Download.SavedPosts OrElse (Responser.CookiesExists And ACheck(SavedPostsUserName.Value))
If Not trueValue Then Return False If Not trueValue Then Return False
Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("reddit") Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("reddit")
@@ -151,13 +140,13 @@ Namespace API.Reddit
dl = dl.Take(4).ToList dl = dl.Take(4).ToList
Dim avg% = dl.Average(Function(d) d.Value) Dim avg% = dl.Average(Function(d) d.Value)
If avg > 100 Then If avg > 100 Then
AvailableText = "Over the past hour, Reddit has received an average of " &
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
dl.ListToString(vbCr)
If Silent Then If Silent Then
Return False Return False
Else Else
If MsgBoxE({"Over the past hour, Reddit has received an average of " & If MsgBoxE({$"{AvailableText}{vbCr}{vbCr}Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes Then
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
If trueValue Then UpdateRedGifsToken() If trueValue Then UpdateRedGifsToken()
Return trueValue AndAlso UpdateTokenIfRequired() Return trueValue AndAlso UpdateTokenIfRequired()
Else Else
@@ -182,7 +171,7 @@ Namespace API.Reddit
MyBase.DownloadDone(What) MyBase.DownloadDone(What)
End Sub End Sub
Private Sub UpdateRedGifsToken() Private Sub UpdateRedGifsToken()
DirectCast(Settings(RedGifs.RedGifsSiteKey).Source, RedGifs.SiteSettings).UpdateTokenIfRequired() Settings(RedGifs.RedGifsSiteKey).ListForEach(Sub(h, i) DirectCast(h.Source, RedGifs.SiteSettings).UpdateTokenIfRequired())
End Sub End Sub
#End Region #End Region
#Region "IsMyUser, GetUserUrl, GetUserPostUrl" #Region "IsMyUser, GetUserUrl, GetUserPostUrl"
@@ -212,7 +201,7 @@ Namespace API.Reddit
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange
If OpenForm Then If OpenForm Then
Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using Using f As New RedditViewSettingsForm(Options, True) : f.ShowDialog() : End Using
End If End If
End Sub End Sub
#End Region #End Region
@@ -238,7 +227,7 @@ Namespace API.Reddit
For i% = 0 To p.Count - 1 For i% = 0 To p.Count - 1
If CStr(p(i).Value).IsEmptyString Then wrong.Add(p(i).Name) If CStr(p(i).Value).IsEmptyString Then wrong.Add(p(i).Name)
Next Next
If wrong.Count > 0 Then If wrong.Count > 0 And wrong.Count <> 4 Then
MsgBoxE({$"You have not completed the following fields: {wrong.ListToString}." & vbCr & MsgBoxE({$"You have not completed the following fields: {wrong.ListToString}." & vbCr &
"To use OAuth authorization, all authorization fields must be filled in.", "Validate token fields"}, vbCritical) "To use OAuth authorization, all authorization fields must be filled in.", "Validate token fields"}, vbCritical)
Return False Return False

View File

@@ -23,9 +23,6 @@ Imports CView = SCrawler.API.Reddit.IRedditView.View
Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit Namespace API.Reddit
Friend Class UserData : Inherits UserDataBase : Implements IChannelLimits, IRedditView Friend Class UserData : Inherits UserDataBase : Implements IChannelLimits, IRedditView
#Region "XML names"
Private Const Name_TrueName As String = "TrueName"
#End Region
#Region "Declarations" #Region "Declarations"
Private Const CannelsLabelName As String = "Channels" Private Const CannelsLabelName As String = "Channels"
Friend Const CannelsLabelName_ChannelsForm As String = "RChannels" Friend Const CannelsLabelName_ChannelsForm As String = "RChannels"
@@ -51,6 +48,42 @@ Namespace API.Reddit
Return {CannelsLabelName, CannelsLabelName_ChannelsForm, UserLabelName} Return {CannelsLabelName, CannelsLabelName_ChannelsForm, UserLabelName}
End Get End Get
End Property End Property
Private _RedGifsAccount As String = String.Empty
Friend Property RedGifsAccount As String Implements IRedditView.RedGifsAccount
Get
If Not _RedGifsAccount.IsEmptyString Then
Return _RedGifsAccount
ElseIf Not ChannelInfo Is Nothing Then
Return ChannelInfo.RedGifsAccount
Else
Return String.Empty
End If
End Get
Set(ByVal acc As String)
_RedGifsAccount = acc
End Set
End Property
Private _RedditAccount As String = String.Empty
Friend Property RedditAccount As String Implements IRedditView.RedditAccount
Get
If IsChannelForm Then
Return _RedditAccount
Else
Return MyBase.AccountName
End If
End Get
Set(ByVal acc As String)
_RedditAccount = acc
End Set
End Property
Friend Overrides Property AccountName As String
Get
Return RedditAccount
End Get
Set(ByVal acc As String)
MyBase.AccountName = acc
End Set
End Property
#End Region #End Region
#Region "Channels Support" #Region "Channels Support"
#Region "IChannelLimits Support" #Region "IChannelLimits Support"
@@ -72,6 +105,11 @@ Namespace API.Reddit
End With End With
End Sub End Sub
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
Private ReadOnly Property IsChannelForm As Boolean
Get
Return Not IsSavedPosts AndAlso IsChannel AndAlso Not ChannelInfo Is Nothing
End Get
End Property
#End Region #End Region
Friend Property ChannelInfo As Channel Friend Property ChannelInfo As Channel
Private ReadOnly ChannelPostsNames As List(Of String) Private ReadOnly ChannelPostsNames As List(Of String)
@@ -91,6 +129,8 @@ Namespace API.Reddit
If Not Options Is Nothing Then If Not Options Is Nothing Then
ViewMode = Options.ViewMode ViewMode = Options.ViewMode
ViewPeriod = Options.ViewPeriod ViewPeriod = Options.ViewPeriod
RedGifsAccount = Options.RedGifsAccount
RedditAccount = Options.RedditAccount
End If End If
End Sub End Sub
Private ReadOnly Property View As String Private ReadOnly Property View As String
@@ -162,6 +202,8 @@ Namespace API.Reddit
ViewPeriod = .Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(CPeriod.All)) ViewPeriod = .Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(CPeriod.All))
IsChannel = .Value(Name_IsChannel).FromXML(Of Boolean)(False) IsChannel = .Value(Name_IsChannel).FromXML(Of Boolean)(False)
TrueName = .Value(Name_TrueName) TrueName = .Value(Name_TrueName)
RedGifsAccount = .Value(Name_RedGifsAccount)
RedditAccount = .Value(Name_RedditAccount)
UpdateNames() UpdateNames()
Else Else
If UpdateNames() Then .Value(Name_LabelsName) = LabelsString If UpdateNames() Then .Value(Name_LabelsName) = LabelsString
@@ -169,11 +211,13 @@ Namespace API.Reddit
.Add(Name_ViewPeriod, CInt(ViewPeriod)) .Add(Name_ViewPeriod, CInt(ViewPeriod))
.Add(Name_IsChannel, IsChannel.BoolToInteger) .Add(Name_IsChannel, IsChannel.BoolToInteger)
.Add(Name_TrueName, TrueName) .Add(Name_TrueName, TrueName)
.Add(Name_RedGifsAccount, RedGifsAccount)
.Add(Name_RedditAccount, RedditAccount)
End If End If
End With End With
End Sub End Sub
Friend Overrides Function ExchangeOptionsGet() As Object Friend Overrides Function ExchangeOptionsGet() As Object
Return New RedditViewExchange With {.ViewMode = ViewMode, .ViewPeriod = ViewPeriod} Return New RedditViewExchange With {.ViewMode = ViewMode, .ViewPeriod = ViewPeriod, .RedGifsAccount = RedGifsAccount, .RedditAccount = RedditAccount}
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is IRedditView Then SetView(DirectCast(Obj, IRedditView)) If Not Obj Is Nothing AndAlso TypeOf Obj Is IRedditView Then SetView(DirectCast(Obj, IRedditView))
@@ -187,7 +231,7 @@ Namespace API.Reddit
If IsChannel Or IsSavedPosts Then UseMD5Comparison = False If IsChannel Or IsSavedPosts Then UseMD5Comparison = False
If IsSavedPosts Then TrueName = MySiteSettings.SavedPostsUserName.Value If IsSavedPosts Then TrueName = MySiteSettings.SavedPostsUserName.Value
UpdateNames() UpdateNames()
If Not IsSavedPosts AndAlso (IsChannel AndAlso Not ChannelInfo Is Nothing) Then If IsChannelForm Then
UseMD5Comparison = False UseMD5Comparison = False
EnvirDownloadSet() EnvirDownloadSet()
If Not Responser Is Nothing Then Responser.Dispose() If Not Responser Is Nothing Then Responser.Dispose()
@@ -790,8 +834,9 @@ Namespace API.Reddit
Dim r$, v$ Dim r$, v$
Dim e As New ErrorsDescriber(EDP.ReturnValue) Dim e As New ErrorsDescriber(EDP.ReturnValue)
Dim m As UserMedia, m2 As UserMedia Dim m As UserMedia, m2 As UserMedia
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey) Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey, RedGifsAccount)
Dim _repeatForRedgifs As Boolean Dim _repeatForRedgifs As Boolean
If RedGifsHost Is Nothing Then RedGifsHost = Settings(RedGifs.RedGifsSiteKey).Default
RedGifsResponser = RedGifsHost.Responser.Copy RedGifsResponser = RedGifsHost.Responser.Copy
ProgressPre.ChangeMax(_TempMediaList.Count) ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1 For i% = _TempMediaList.Count - 1 To 0 Step -1
@@ -806,7 +851,7 @@ Namespace API.Reddit
r = Gfycat.Envir.GetVideo(m.URL) r = Gfycat.Envir.GetVideo(m.URL)
If Not r.IsEmptyString AndAlso r.Contains("redgifs.com") Then m.URL = r : _repeatForRedgifs = True If Not r.IsEmptyString AndAlso r.Contains("redgifs.com") Then m.URL = r : _repeatForRedgifs = True
ElseIf m.URL.Contains(SiteRedGifsKey) Then ElseIf m.URL.Contains(SiteRedGifsKey) Then
m2 = RedGifs.UserData.GetDataFromUrlId(m.URL, False, RedGifsResponser, RedGifsHost) m2 = RedGifs.UserData.GetDataFromUrlId(m.URL, False, RedGifsResponser, RedGifsHost, RedGifsAccount)
If m2.State = UStates.Missing Then If m2.State = UStates.Missing Then
m.State = UStates.Missing m.State = UStates.Missing
_ContentList.Add(m) _ContentList.Add(m)
@@ -853,7 +898,8 @@ Namespace API.Reddit
Try Try
If Not ChannelInfo Is Nothing Or SaveToCache Then Exit Sub If Not ChannelInfo Is Nothing Or SaveToCache Then Exit Sub
If ContentMissingExists Then If ContentMissingExists Then
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey) Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey, RedGifsAccount)
If RedGifsHost Is Nothing Then RedGifsHost = Settings(RedGifs.RedGifsSiteKey).Default
RedGifsResponser = RedGifsHost.Responser.Copy RedGifsResponser = RedGifsHost.Responser.Copy
Dim m As UserMedia, m2 As UserMedia Dim m As UserMedia, m2 As UserMedia
Dim r$ Dim r$
@@ -877,6 +923,8 @@ Namespace API.Reddit
For li = IIf(lastCount < 0, 0, lastCount) To _TempMediaList.Count - 1 For li = IIf(lastCount < 0, 0, lastCount) To _TempMediaList.Count - 1
m2 = _TempMediaList(i) m2 = _TempMediaList(i)
m2.Post.Date = m.Post.Date m2.Post.Date = m.Post.Date
m2.State = UStates.Missing
m2.Attempts = m.Attempts
_TempMediaList(i) = m2 _TempMediaList(i) = m2
Next Next
End If End If
@@ -943,7 +991,7 @@ Namespace API.Reddit
If _ContentNew.Count > 0 Then If _ContentNew.Count > 0 Then
Try Try
If Not _RedGifsResponser Is Nothing Then _RedGifsResponser.Dispose() If Not _RedGifsResponser Is Nothing Then _RedGifsResponser.Dispose()
_RedGifsResponser = Settings(RedGifs.RedGifsSiteKey).Responser.Copy _RedGifsResponser = If(Settings(RedGifs.RedGifsSiteKey, RedGifsAccount), Settings(RedGifs.RedGifsSiteKey).Default).Responser.Copy
DownloadContentDefault(Token) DownloadContentDefault(Token)
Finally Finally
If Not _RedGifsResponser Is Nothing Then _RedGifsResponser.Dispose() : _RedGifsResponser = Nothing If Not _RedGifsResponser Is Nothing Then _RedGifsResponser.Dispose() : _RedGifsResponser = Nothing

View File

@@ -18,33 +18,23 @@ Namespace API.RedGifs
<Manifest(RedGifsSiteKey)> <Manifest(RedGifsSiteKey)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon <PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), DependentFields(NameOf(UserAgent)), ControlNumber(1), PClonable(Clone:=False)>
Get
Return My.Resources.SiteResources.RedGifsIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.RedGifsPic_32
End Get
End Property
<PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), DependentFields(NameOf(UserAgent)), ControlNumber(1)>
Friend ReadOnly Property Token As PropertyValue Friend ReadOnly Property Token As PropertyValue
<PropertyOption, ControlNumber(2)> <PropertyOption, ControlNumber(2), PClonable>
Private ReadOnly Property UserAgent As PropertyValue Private ReadOnly Property UserAgent As PropertyValue
<PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue <PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue
Private Const TokenName As String = "authorization" Private Const TokenName As String = "authorization"
#Region "TokenUpdateInterval" #Region "TokenUpdateInterval"
<PropertyOption(ControlText:="Token refresh interval", ControlToolTip:="Interval (in minutes) to refresh the token", AllowNull:=False, LeftOffset:=120), <PropertyOption(ControlText:="Token refresh interval", ControlToolTip:="Interval (in minutes) to refresh the token", AllowNull:=False, LeftOffset:=120),
PXML, ControlNumber(0)> PXML, ControlNumber(0), PClonable>
Friend ReadOnly Property TokenUpdateInterval As PropertyValue Friend ReadOnly Property TokenUpdateInterval As PropertyValue
<Provider(NameOf(TokenUpdateInterval), FieldsChecker:=True)> <Provider(NameOf(TokenUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider
#End Region #End Region
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New(RedGifsSite, "redgifs.com") MyBase.New(RedGifsSite, "redgifs.com", AccName, Temp, My.Resources.SiteResources.RedGifsIcon_32, My.Resources.SiteResources.RedGifsPic_32)
Dim t$ = String.Empty Dim t$ = String.Empty
With Responser With Responser
.Mode = Responser.Modes.WebClient .Mode = Responser.Modes.WebClient

View File

@@ -74,10 +74,10 @@ Namespace API.RedGifs
#Region "Media obtain, extract" #Region "Media obtain, extract"
Private Sub ObtainMedia(ByVal j As EContainer, ByVal PostID As String, Private Sub ObtainMedia(ByVal j As EContainer, ByVal PostID As String,
Optional ByVal PostDateStr As String = Nothing, Optional ByVal PostDateDate As Date? = Nothing, Optional ByVal PostDateStr As String = Nothing, Optional ByVal PostDateDate As Date? = Nothing,
Optional ByVal State As UStates = UStates.Unknown) Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0)
Dim tMedia As UserMedia = ExtractMedia(j) Dim tMedia As UserMedia = ExtractMedia(j)
If Not tMedia.Type = UTypes.Undefined Then _ If Not tMedia.Type = UTypes.Undefined Then _
_TempMediaList.ListAddValue(MediaFromData(tMedia.Type, tMedia.URL, PostID, PostDateStr, PostDateDate, State)) _TempMediaList.ListAddValue(MediaFromData(tMedia.Type, tMedia.URL, PostID, PostDateStr, PostDateDate, State, Attempts))
End Sub End Sub
Private Shared Function ExtractMedia(ByVal j As EContainer) As UserMedia Private Shared Function ExtractMedia(ByVal j As EContainer) As UserMedia
If Not j Is Nothing Then If Not j Is Nothing Then
@@ -122,7 +122,7 @@ Namespace API.RedGifs
j = JsonDocument.Parse(r) j = JsonDocument.Parse(r)
If Not j Is Nothing Then If Not j Is Nothing Then
If If(j("gif")?.Count, 0) > 0 Then If If(j("gif")?.Count, 0) > 0 Then
ObtainMedia(j("gif"), u.Post.ID,, u.Post.Date, UStates.Missing) ObtainMedia(j("gif"), u.Post.ID,, u.Post.Date, UStates.Missing, u.Attempts)
rList.Add(i) rList.Add(i)
End If End If
End If End If
@@ -166,16 +166,19 @@ Namespace API.RedGifs
End If End If
End Function End Function
Friend Shared Function GetDataFromUrlId(ByVal Obj As String, ByVal ObjIsID As Boolean, ByVal Responser As Responser, Friend Shared Function GetDataFromUrlId(ByVal Obj As String, ByVal ObjIsID As Boolean, ByVal Responser As Responser,
ByVal Host As Plugin.Hosts.SettingsHost) As UserMedia ByVal Host As Plugin.Hosts.SettingsHost, ByVal AccountName As String) As UserMedia
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
If Obj.IsEmptyString Then Return Nothing If Obj.IsEmptyString Then Return Nothing
If Not ObjIsID Then If Not ObjIsID Then
Obj = GetVideoIdFromUrl(Obj) Obj = GetVideoIdFromUrl(Obj)
If Not Obj.IsEmptyString Then Return GetDataFromUrlId(Obj, True, Responser, Host) If Not Obj.IsEmptyString Then Return GetDataFromUrlId(Obj, True, Responser, Host, AccountName)
Else Else
If Host Is Nothing Then Host = Settings(RedGifsSiteKey) If Host Is Nothing Then
If Host.Source.Available(Plugin.ISiteSettings.Download.Main, True) Then Host = Settings(RedGifsSiteKey, AccountName)
If Host Is Nothing Then Host = Settings(RedGifsSiteKey).Default
End If
If Not Host Is Nothing AndAlso Host.Source.Available(Plugin.ISiteSettings.Download.Main, True) Then
If Responser Is Nothing Then Responser = Host.Responser.Copy If Responser Is Nothing Then Responser = Host.Responser.Copy
URL = String.Format(PostDataUrl, Obj.ToLower) URL = String.Format(PostDataUrl, Obj.ToLower)
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException) Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
@@ -220,7 +223,7 @@ Namespace API.RedGifs
#End Region #End Region
#Region "Single data downloader" #Region "Single data downloader"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken) Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
Dim m As UserMedia = GetDataFromUrlId(Data.URL, False, Responser, HOST) Dim m As UserMedia = GetDataFromUrlId(Data.URL, False, Responser, HOST, AccountName)
If Not m.State = UStates.Missing And Not m.State = DataGone And (m.Type = UTypes.Picture Or m.Type = UTypes.Video) Then If Not m.State = UStates.Missing And Not m.State = DataGone And (m.Type = UTypes.Picture Or m.Type = UTypes.Video) Then
m.URL_BASE = MySettings.GetUserPostUrl(Me, m) m.URL_BASE = MySettings.GetUserPostUrl(Me, m)
_TempMediaList.Add(m) _TempMediaList.Add(m)
@@ -229,7 +232,7 @@ Namespace API.RedGifs
#End Region #End Region
#Region "Create media" #Region "Create media"
Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, Private Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String,
ByVal PostDateStr As String, ByVal PostDateDate As Date?, ByVal State As UStates) As UserMedia ByVal PostDateStr As String, ByVal PostDateDate As Date?, ByVal State As UStates, Optional ByVal Attempts As Integer = 0) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern)) _URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}} Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern)) If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
@@ -241,6 +244,7 @@ Namespace API.RedGifs
m.Post.Date = Nothing m.Post.Date = Nothing
End If End If
m.State = State m.State = State
m.Attempts = Attempts
Return m Return m
End Function End Function
#End Region #End Region

View File

@@ -16,31 +16,21 @@ Namespace API.ThisVid
<Manifest(ThisVidSiteKey), SeparatedTasks(1), SpecialForm(False), SavedPosts> <Manifest(ThisVidSiteKey), SeparatedTasks(1), SpecialForm(False), SavedPosts>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon <PXML, PropertyOption(ControlText:="Public videos", ControlToolTip:="Download public videos"), PClonable>
Get
Return My.Resources.SiteResources.ThisVidIcon_16
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.ThisVidPic_16
End Get
End Property
<PXML, PropertyOption(ControlText:="Public videos", ControlToolTip:="Download public videos")>
Friend ReadOnly Property DownloadPublic As PropertyValue Friend ReadOnly Property DownloadPublic As PropertyValue
<PXML, PropertyOption(ControlText:="Private videos", ControlToolTip:="Download private videos")> <PXML, PropertyOption(ControlText:="Private videos", ControlToolTip:="Download private videos"), PClonable>
Friend ReadOnly Property DownloadPrivate As PropertyValue Friend ReadOnly Property DownloadPrivate As PropertyValue
<PXML, PropertyOption(ControlText:="Favourite videos", ControlToolTip:="Download favourite videos")> <PXML, PropertyOption(ControlText:="Favourite videos", ControlToolTip:="Download favourite videos"), PClonable>
Friend ReadOnly Property DownloadFavourite As PropertyValue Friend ReadOnly Property DownloadFavourite As PropertyValue
<PXML, PropertyOption(ControlText:="Different folders", <PXML, PropertyOption(ControlText:="Different folders",
ControlToolTip:="Use different folders to store video files." & vbCr & 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 & "If true, then public videos will be stored in the 'Public' folder, private - in the 'Private' folder." & vbCr &
"If false, all videos will be stored in the 'Video' folder.")> "If false, all videos will be stored in the 'Video' folder."), PClonable>
Friend ReadOnly Property DifferentFolders As PropertyValue Friend ReadOnly Property DifferentFolders As PropertyValue
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("ThisVid", "thisvid.com") MyBase.New("ThisVid", "thisvid.com", AccName, Temp, My.Resources.SiteResources.ThisVidIcon_16, My.Resources.SiteResources.ThisVidPic_16)
With Responser With Responser
.CookiesExtractMode = Responser.CookiesExtractModes.Any .CookiesExtractMode = Responser.CookiesExtractModes.Any
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll .CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll

View File

@@ -20,9 +20,6 @@ Namespace API.ThisVid
Private Const Name_DownloadPrivate As String = "DownloadPrivate" Private Const Name_DownloadPrivate As String = "DownloadPrivate"
Private Const Name_DownloadFavourite As String = "DownloadFavourite" Private Const Name_DownloadFavourite As String = "DownloadFavourite"
Private Const Name_DifferentFolders As String = "DifferentFolders" 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 #End Region
#Region "Structures" #Region "Structures"
Private Structure Album : Implements IRegExCreator Private Structure Album : Implements IRegExCreator
@@ -180,6 +177,7 @@ Namespace API.ThisVid
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
UseClientTokens = True UseClientTokens = True
SessionPosts = New List(Of String)
End Sub End Sub
#End Region #End Region
#Region "Validation" #Region "Validation"
@@ -223,9 +221,14 @@ Namespace API.ThisVid
End Function End Function
#End Region #End Region
#Region "Download functions" #Region "Download functions"
Private ReadOnly SessionPosts As List(Of String)
Private AddedCount As Integer = 0 Private AddedCount As Integer = 0
Private _PageVideosRepeat As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
SessionPosts.Clear()
AddedCount = 0 AddedCount = 0
_PageVideosRepeat = 0
SessionPosts.Clear()
Responser.Cookies.ChangedAllowInternalDrop = False Responser.Cookies.ChangedAllowInternalDrop = False
Responser.Cookies.Changed = False Responser.Cookies.Changed = False
If ID.IsEmptyString Then ID = Name If ID.IsEmptyString Then ID = Name
@@ -286,6 +289,8 @@ Namespace API.ThisVid
ProgressPre.Perform() ProgressPre.Perform()
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
Dim cBefore% = _TempMediaList.Count Dim cBefore% = _TempMediaList.Count
Dim pageRepeatSet As Boolean = False, prevPostsFound As Boolean = False, newPostsFound As Boolean = False
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim __SpecialFolder$ = If(DifferentFolders And Not IsSavedPosts And IsUser, Dim __SpecialFolder$ = If(DifferentFolders And Not IsSavedPosts And IsUser,
Interaction.Switch(Model = 0, "Public", Model = 1, "Private", Model = 2, "Favourite"), Interaction.Switch(Model = 0, "Public", Model = 1, "Private", Model = 2, "Favourite"),
@@ -298,15 +303,29 @@ Namespace API.ThisVid
_TempPostsList.Add(u) _TempPostsList.Add(u)
_TempMediaList.Add(New UserMedia(u) With {.Type = UserMedia.Types.VideoPre, .SpecialFolder = __SpecialFolder}) _TempMediaList.Add(New UserMedia(u) With {.Type = UserMedia.Types.VideoPre, .SpecialFolder = __SpecialFolder})
AddedCount += 1 AddedCount += 1
newPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
If limit > 0 And AddedCount >= limit Then Exit Sub If limit > 0 And AddedCount >= limit Then Exit Sub
ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(u) Then
prevPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
Continue For
Else Else
If _PageVideosRepeat > 2 Then
Exit Sub Exit Sub
ElseIf Not pageRepeatSet And Not newPostsFound Then
pageRepeatSet = True
_PageVideosRepeat += 1
End If
End If End If
End If End If
Next Next
SessionPosts.ListAddList(l, LNC)
l.Clear()
End If End If
End If End If
If Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000) Then DownloadData(Page + 1, Model, Token) If (Not IsUser And prevPostsFound And Not newPostsFound And Page < 1000) Or
(Not cBefore = _TempMediaList.Count And (IsUser Or Page < 1000)) Then DownloadData(Page + 1, Model, Token)
Catch aex As ArgumentNullException When aex.HelpLink = 1 Catch aex As ArgumentNullException When aex.HelpLink = 1
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"videos downloading error [{URL}]") ProcessException(ex, Token, $"videos downloading error [{URL}]")
@@ -537,6 +556,12 @@ Namespace API.ThisVid
Return 0 Return 0
End If End If
End Function End Function
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then SessionPosts.Clear()
MyBase.Dispose(disposing)
End Sub
#End Region #End Region
End Class End Class
End Namespace End Namespace

View File

@@ -17,31 +17,30 @@ Namespace API.ThreadsNet
<Manifest("AndyProgram_ThreadsNet"), SeparatedTasks(1)> <Manifest("AndyProgram_ThreadsNet"), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.ThreadsIcon_192
End Get
End Property
Private ReadOnly _Image As Image
Friend Overrides ReadOnly Property Image As Image
Get
Return _Image
End Get
End Property
#Region "Authorization" #Region "Authorization"
<PropertyOption(ControlText:="x-csrftoken", AllowNull:=False)> <PClonable(Clone:=False)> Protected ReadOnly __HH_CSRF_TOKEN As PropertyValue
Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue <PropertyOption(ControlText:="x-csrftoken", AllowNull:=False, IsAuth:=True), ControlNumber(0)>
<PropertyOption(ControlText:="x-ig-app-id", AllowNull:=False)> Friend Overridable ReadOnly Property HH_CSRF_TOKEN As PropertyValue
Friend Property HH_IG_APP_ID As PropertyValue Get
<PropertyOption(ControlText:="x-asbd-id", AllowNull:=True)> Return __HH_CSRF_TOKEN
Friend Property HH_ASBD_ID As PropertyValue End Get
<PropertyOption(ControlText:="sec-ch-ua", AllowNull:=True)> End Property
Private Property HH_BROWSER As PropertyValue <PClonable> Protected ReadOnly __HH_IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", AllowNull:=True)> <PropertyOption(ControlText:="x-ig-app-id", AllowNull:=False, IsAuth:=True), ControlNumber(10)>
Private Property HH_BROWSER_EXT As PropertyValue Friend Overridable ReadOnly Property HH_IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", AllowNull:=True, LeftOffset:=120)> Get
Private Property HH_PLATFORM As PropertyValue Return __HH_IG_APP_ID
<PropertyOption(ControlText:="UserAgent")> End Get
End Property
<PropertyOption(ControlText:="x-asbd-id", AllowNull:=True, IsAuth:=True), ControlNumber(20), PClonable>
Friend ReadOnly Property HH_ASBD_ID As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua", AllowNull:=True, IsAuth:=True), ControlNumber(30), PClonable>
Private ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", AllowNull:=True, IsAuth:=True), ControlNumber(40), PClonable>
Private ReadOnly Property HH_BROWSER_EXT As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-platform", ControlToolTip:="sec-ch-ua-platform", AllowNull:=True, IsAuth:=True, LeftOffset:=120), ControlNumber(50), PClonable>
Private ReadOnly Property HH_PLATFORM As PropertyValue
<PropertyOption(ControlText:="UserAgent", IsAuth:=True), ControlNumber(60), PClonable>
Private ReadOnly Property HH_USER_AGENT As PropertyValue Private ReadOnly Property HH_USER_AGENT As PropertyValue
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object) Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then If Not PropName.IsEmptyString Then
@@ -67,10 +66,15 @@ Namespace API.ThreadsNet
#End Region #End Region
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("Threads", "threads.net") Me.New("Threads", "threads.net", AccName, Temp, My.Resources.SiteResources.ThreadsIcon_192, My.Resources.SiteResources.ThreadsIcon_192.ToBitmap)
End Sub
Protected Sub New(ByVal SiteName As String, ByVal CookiesDomain As String, ByVal AccName As String, ByVal Temp As Boolean,
Optional ByVal __Icon As Icon = Nothing, Optional ByVal __Image As Image = Nothing)
MyBase.New(SiteName, CookiesDomain, AccName, Temp,
If(__Icon, My.Resources.SiteResources.ThreadsIcon_192),
If(__Image, My.Resources.SiteResources.ThreadsIcon_192.ToBitmap))
_AllowUserAgentUpdate = False _AllowUserAgentUpdate = False
_Image = My.Resources.SiteResources.ThreadsIcon_192.ToBitmap
Dim app_id$ = String.Empty Dim app_id$ = String.Empty
Dim token$ = String.Empty Dim token$ = String.Empty
@@ -94,17 +98,17 @@ Namespace API.ThreadsNet
browserExt = .Value(IG.Header_BrowserExt) browserExt = .Value(IG.Header_BrowserExt)
platform = .Value(IG.Header_Platform) platform = .Value(IG.Header_Platform)
End If End If
.Add("Authority", "www.threads.net") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.threads.net"))
.Add("Origin", "https://www.threads.net") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Origin, "https://www.threads.net"))
.Add("Upgrade-Insecure-Requests", 1) .Add("Upgrade-Insecure-Requests", 1)
.Add("Sec-Ch-Ua-Model", "") .Add("Sec-Ch-Ua-Model", "")
.Add("Sec-Ch-Ua-Mobile", "?0") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile, "?0"))
.Add("Sec-Ch-Ua-Platform", """Windows""") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform, """Windows"""))
.Add("Sec-Fetch-Dest", "empty") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest, "empty"))
.Add("Sec-Fetch-Mode", "cors") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "cors"))
.Add("Sec-Fetch-Site", "same-origin") .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchSite, "same-origin"))
.Add("Sec-Fetch-User", "?1") .Add("Sec-Fetch-User", "?1")
.Add("x-fb-friendly-name", "BarcelonaProfileThreadsTabRefetchableQuery") .Add(DeclaredNames.Header_FB_FRIENDLY_NAME, "BarcelonaProfileThreadsTabRefetchableQuery")
End With End With
.CookiesExtractMode = Responser.CookiesExtractModes.Any .CookiesExtractMode = Responser.CookiesExtractModes.Any
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll .CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
@@ -113,8 +117,8 @@ Namespace API.ThreadsNet
.Cookies.Changed = False .Cookies.Changed = False
End With End With
HH_CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_CSRF_TOKEN), v)) __HH_CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_CSRF_TOKEN), v))
HH_IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_IG_APP_ID), v)) __HH_IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_IG_APP_ID), v))
HH_ASBD_ID = New PropertyValue(asbd, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_ASBD_ID), v)) HH_ASBD_ID = New PropertyValue(asbd, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_ASBD_ID), v))
HH_BROWSER = New PropertyValue(browser, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER), v)) HH_BROWSER = New PropertyValue(browser, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER), v))
HH_BROWSER_EXT = New PropertyValue(browserExt, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER_EXT), v)) HH_BROWSER_EXT = New PropertyValue(browserExt, GetType(String), Sub(v) ChangeResponserFields(NameOf(HH_BROWSER_EXT), v))
@@ -127,7 +131,7 @@ Namespace API.ThreadsNet
End Sub End Sub
#End Region #End Region
#Region "UpdateResponserData" #Region "UpdateResponserData"
Friend Sub UpdateResponserData(ByVal Resp As Responser) Friend Overridable Sub UpdateResponserData(ByVal Resp As Responser)
With Responser.Cookies With Responser.Cookies
Dim csrf$ = String.Empty Dim csrf$ = String.Empty
.Update(Resp.Cookies) .Update(Resp.Cookies)
@@ -136,7 +140,7 @@ Namespace API.ThreadsNet
.Changed = False .Changed = False
csrf = If(.FirstOrDefault(Function(c) c.Name.StringToLower = IG.Header_CSRF_TOKEN_COOKIE)?.Value, String.Empty) csrf = If(.FirstOrDefault(Function(c) c.Name.StringToLower = IG.Header_CSRF_TOKEN_COOKIE)?.Value, String.Empty)
End If End If
If Not csrf.IsEmptyString AndAlso Not AEquals(Of String)(csrf, HH_CSRF_TOKEN.Value) Then HH_CSRF_TOKEN.Value = csrf If Not csrf.IsEmptyString AndAlso Not AEquals(Of String)(csrf, HH_CSRF_TOKEN.Value) Then HH_CSRF_TOKEN.Value = csrf : Responser.SaveSettings()
End With End With
End Sub End Sub
#End Region #End Region

View File

@@ -18,7 +18,7 @@ Imports IGS = SCrawler.API.Instagram.SiteSettings
Namespace API.ThreadsNet Namespace API.ThreadsNet
Friend Class UserData : Inherits Instagram.UserData Friend Class UserData : Inherits Instagram.UserData
#Region "Declarations" #Region "Declarations"
Private Const Header_FB_LSD As String = "x-fb-lsd" Friend Const Header_FB_LSD As String = "x-fb-lsd"
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Get Get
Return HOST.Source Return HOST.Source

View File

@@ -13,27 +13,17 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.TikTok Namespace API.TikTok
<Manifest("AndyProgram_TikTok"), SpecialForm(False), SeparatedTasks(1)> <Manifest("AndyProgram_TikTok"), SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon <PropertyOption(ControlText:="Remove tags from title"), PXML, PClonable>
Get
Return My.Resources.SiteResources.TikTokIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.TikTokPic_192
End Get
End Property
<PropertyOption(ControlText:="Remove tags from title"), PXML>
Friend Property RemoveTagsFromTitle As PropertyValue 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> <PropertyOption(ControlText:="Use native title", ControlToolTip:="Use a user-created video title for the filename instead of the video ID."), PXML, PClonable>
Friend Property TitleUseNative As PropertyValue Friend Property TitleUseNative As PropertyValue
<PropertyOption(ControlText:="Use native title in standalone downloader", <PropertyOption(ControlText:="Use native title in standalone downloader",
ControlToolTip:="Use a user-created video title for the filename instead of the video ID."), PXML> ControlToolTip:="Use a user-created video title for the filename instead of the video ID."), PXML, PClonable>
Friend Property TitleUseNativeSTD As PropertyValue Friend Property TitleUseNativeSTD As PropertyValue
<PropertyOption(ControlText:="Add video ID to video title"), PXML> <PropertyOption(ControlText:="Add video ID to video title"), PXML, PClonable>
Friend Property TitleAddVideoID As PropertyValue Friend Property TitleAddVideoID As PropertyValue
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("TikTok", "www.tiktok.com") MyBase.New("TikTok", "www.tiktok.com", AccName, Temp, My.Resources.SiteResources.TikTokIcon_32, My.Resources.SiteResources.TikTokPic_192)
RemoveTagsFromTitle = New PropertyValue(False) RemoveTagsFromTitle = New PropertyValue(False)
TitleUseNative = New PropertyValue(True) TitleUseNative = New PropertyValue(True)
TitleUseNativeSTD = New PropertyValue(False) TitleUseNativeSTD = New PropertyValue(False)

View File

@@ -16,43 +16,32 @@ Namespace API.Twitter
<Manifest(TwitterSiteKey), SavedPosts, SeparatedTasks, SpecialForm(False)> <Manifest(TwitterSiteKey), SavedPosts, SeparatedTasks, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.TwitterIcon_32
End Get
End Property
Private ReadOnly _Image As Image
Friend Overrides ReadOnly Property Image As Image
Get
Return _Image
End Get
End Property
#Region "Other properties" #Region "Other properties"
<PropertyOption(ControlText:="Use the appropriate model", <PropertyOption(ControlText:="Use the appropriate model",
ControlToolTip:="Use the appropriate model for new users." & vbCr & ControlToolTip:="Use the appropriate model for new users." & vbCr &
"If disabled, all download models will be used for the first download. " & "If disabled, all download models will be used for the first download. " &
"Next, the appropriate download model will be automatically selected." & vbCr & "Next, the appropriate download model will be automatically selected." & vbCr &
"Otherwise the appropriate download model will be selected right from the start."), PXML> "Otherwise the appropriate download model will be selected right from the start."), PXML, PClonable>
Friend ReadOnly Property UseAppropriateModel As PropertyValue Friend ReadOnly Property UseAppropriateModel As PropertyValue
#Region "End points" #Region "End points"
<PropertyOption(ControlText:="New endpoint: search", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the search model."), PXML> <PropertyOption(ControlText:="New endpoint: search", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the search model."), PXML, PClonable>
Friend Property UseNewEndPointSearch As PropertyValue Friend Property UseNewEndPointSearch As PropertyValue
<PropertyOption(ControlText:="New endpoint: profiles", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the profile models."), PXML> <PropertyOption(ControlText:="New endpoint: profiles", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the profile models."), PXML, PClonable>
Friend Property UseNewEndPointProfiles As PropertyValue Friend Property UseNewEndPointProfiles As PropertyValue
#End Region #End Region
#Region "Limits" #Region "Limits"
<PropertyOption(ControlText:="Abort on limit", ControlToolTip:="Abort twitter downloading when limit is reached"), PXML> <PropertyOption(ControlText:="Abort on limit", ControlToolTip:="Abort twitter downloading when limit is reached"), PXML, PClonable>
Friend Property AbortOnLimit As PropertyValue Friend Property AbortOnLimit As PropertyValue
<PropertyOption(ControlText:="Download already parsed", ControlToolTip:="Download already parsed content on abort"), PXML> <PropertyOption(ControlText:="Download already parsed", ControlToolTip:="Download already parsed content on abort"), PXML, PClonable>
Friend Property DownloadAlreadyParsed As PropertyValue Friend Property DownloadAlreadyParsed As PropertyValue
#End Region #End Region
<PropertyOption(ControlText:="Media Model: allow non-user tweets", ControlToolTip:="Allow downloading non-user tweets in the media-model."), PXML> <PropertyOption(ControlText:="Media Model: allow non-user tweets", ControlToolTip:="Allow downloading non-user tweets in the media-model."), PXML, PClonable>
Friend ReadOnly Property MediaModelAllowNonUserTweets As PropertyValue Friend ReadOnly Property MediaModelAllowNonUserTweets As PropertyValue
<PropertyOption(ControlText:=DN.GifsDownloadCaption), PXML> <PropertyOption(ControlText:=DN.GifsDownloadCaption), PXML, PClonable>
Friend ReadOnly Property GifsDownload As PropertyValue Friend ReadOnly Property GifsDownload As PropertyValue
<PropertyOption(ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip), PXML> <PropertyOption(ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip), PXML, PClonable>
Friend ReadOnly Property GifsSpecialFolder As PropertyValue Friend ReadOnly Property GifsSpecialFolder As PropertyValue
<PropertyOption(ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip), PXML> <PropertyOption(ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip), PXML, PClonable>
Friend ReadOnly Property GifsPrefix As PropertyValue Friend ReadOnly Property GifsPrefix As PropertyValue
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)> <Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
Private ReadOnly Property GifStringChecker As IFormatProvider Private ReadOnly Property GifStringChecker As IFormatProvider
@@ -74,19 +63,18 @@ Namespace API.Twitter
Throw New NotImplementedException("[GetFormat] is not available in the context of [GifStringProvider]") Throw New NotImplementedException("[GetFormat] is not available in the context of [GifStringProvider]")
End Function End Function
End Class End Class
<PropertyOption(ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip), PXML> <PropertyOption(ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip), PXML, PClonable>
Friend ReadOnly Property UseMD5Comparison As PropertyValue Friend ReadOnly Property UseMD5Comparison As PropertyValue
<PropertyOption(ControlText:=DN.ConcurrentDownloadsCaption, <PropertyOption(ControlText:=DN.ConcurrentDownloadsCaption,
ControlToolTip:=DN.ConcurrentDownloadsToolTip, AllowNull:=False, LeftOffset:=120), PXML, TaskCounter> ControlToolTip:=DN.ConcurrentDownloadsToolTip, AllowNull:=False, LeftOffset:=120), PXML, TaskCounter, PClonable>
Friend ReadOnly Property ConcurrentDownloads As PropertyValue Friend ReadOnly Property ConcurrentDownloads As PropertyValue
<Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)> <Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)>
Private ReadOnly Property MyConcurrentDownloadsProvider As IFormatProvider Private ReadOnly Property MyConcurrentDownloadsProvider As IFormatProvider
#End Region #End Region
#End Region #End Region
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New(TwitterSite, "twitter.com") MyBase.New(TwitterSite, "twitter.com", AccName, Temp, My.Resources.SiteResources.TwitterIcon_32, My.Resources.SiteResources.TwitterIcon_32.ToBitmap)
_Image = My.Resources.SiteResources.TwitterIcon_32.ToBitmap
LimitSkippedUsers = New List(Of UserDataBase) LimitSkippedUsers = New List(Of UserDataBase)
With Responser With Responser

View File

@@ -392,7 +392,8 @@ Namespace API.Twitter
End Sub End Sub
#End Region #End Region
#Region "Obtain media" #Region "Obtain media"
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown) Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0)
Dim s As EContainer = e({"extended_entities", "media"}) Dim s As EContainer = e({"extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status", "extended_entities", "media"}) If If(s?.Count, 0) = 0 Then s = e({"retweeted_status", "extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"}) If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"})
@@ -406,7 +407,7 @@ Namespace API.Twitter
Dim dName$ = UrlFile(mUrl) Dim dName$ = UrlFile(mUrl)
If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then
_DataNames.Add(dName) _DataNames.Add(dName)
_TempMediaList.ListAddValue(MediaFromData(mUrl, PostID, PostDate, GetPictureOption(m), State, UTypes.Picture), LNC) _TempMediaList.ListAddValue(MediaFromData(mUrl, PostID, PostDate, GetPictureOption(m), State, UTypes.Picture, Attempts), LNC)
End If End If
End If End If
End If End If
@@ -712,7 +713,7 @@ Namespace API.Twitter
If .ListExists Then If .ListExists Then
PostDate = String.Empty PostDate = String.Empty
If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing) ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts)
rList.ListAddValue(i, LNC) rList.ListAddValue(i, LNC)
End If End If
End With End With
@@ -804,7 +805,8 @@ Namespace API.Twitter
Private Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String, Private Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _PictureOption As String = Nothing, Optional ByVal _PictureOption As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Type As UTypes = UTypes.Undefined) As UserMedia Optional ByVal Type As UTypes = UTypes.Undefined,
Optional ByVal Attempts As Integer = 0) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern)) _URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL) With {.PictureOption = _PictureOption, .Post = New UserPost With {.ID = PostID}, .Type = Type} Dim m As New UserMedia(_URL) With {.PictureOption = _PictureOption, .Post = New UserPost With {.ID = PostID}, .Type = Type}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern)) If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
@@ -813,6 +815,7 @@ Namespace API.Twitter
End If End If
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, Declarations.DateProvider, Nothing) Else m.Post.Date = Nothing If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, Declarations.DateProvider, Nothing) Else m.Post.Date = Nothing
m.State = State m.State = State
m.Attempts = Attempts
Return m Return m
End Function End Function
#End Region #End Region

View File

@@ -71,17 +71,9 @@ Namespace API
End Property End Property
Friend Overrides Property FriendlyName As String Friend Overrides Property FriendlyName As String
Get Get
If Count > 0 Then Return CollectionName
Return Collections(0).FriendlyName
Else
Return String.Empty
End If
End Get End Get
Set(ByVal NewName As String) Set(ByVal NewName As String)
If Count > 0 Then Collections.ForEach(Sub(c)
c.FriendlyName = NewName
c.UpdateUserInformation()
End Sub)
End Set End Set
End Property End Property
Friend Overrides Property UserExists As Boolean Friend Overrides Property UserExists As Boolean
@@ -500,12 +492,14 @@ Namespace API
With _Item With _Item
If .MoveFiles(CollectionName, CollectionPath) Then If .MoveFiles(CollectionName, CollectionPath) Then
If Not .Self.IsVirtual And DataMerging Then DirectCast(.Self, UserDataBase).MergeData() If Not .Self.IsVirtual And DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
ConsolidateLabels(.Self) ConsolidateLabels(.Self)
ConsolidateScripts(.Self) ConsolidateScripts(.Self)
ConsolidateColors(.Self) ConsolidateColors(.Self)
Collections.Add(.Self)
With Collections.Last
Collections.Add(.Self)
With Collections.Last
If _CollectionName.IsEmptyString Then _CollectionName = .CollectionName If _CollectionName.IsEmptyString Then _CollectionName = .CollectionName
.Temporary = Temporary .Temporary = Temporary
.Favorite = Favorite .Favorite = Favorite
@@ -548,7 +542,7 @@ Namespace API
End Try End Try
End Sub End Sub
Private Sub ConsolidateLabels(ByVal Destination As UserDataBase) Private Sub ConsolidateLabels(ByVal Destination As UserDataBase)
UpdateLabels(If(Destination, Me), ListAddList(Nothing, Labels.ListWithRemove(SpecialLabels)), 1, True) If Count > 0 Then UpdateLabels(Destination, ListAddList(Nothing, Labels.ListWithRemove(SpecialLabels)), 0, True)
End Sub End Sub
Private Sub ConsolidateScripts(ByVal Destination As UserDataBase) Private Sub ConsolidateScripts(ByVal Destination As UserDataBase)
If Count > 0 AndAlso ScriptUse Then If Count > 0 AndAlso ScriptUse Then

View File

@@ -15,31 +15,31 @@ Namespace API.XVIDEOS
<Manifest(XvideosSiteKey), SavedPosts, SpecialForm(True), SpecialForm(False), TaskGroup(SettingsCLS.TaskStackNamePornSite)> <Manifest(XvideosSiteKey), SavedPosts, SpecialForm(True), SpecialForm(False), TaskGroup(SettingsCLS.TaskStackNamePornSite)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon <PXML("Domains"), PClonable> Private ReadOnly Property SiteDomains As PropertyValue
Private Shadows ReadOnly Property DefaultInstance As SiteSettings
Get Get
Return My.Resources.SiteResources.XvideosIcon_48 Return MyBase.DefaultInstance
End Get End Get
End Property End Property
Friend Overrides ReadOnly Property Image As Image Private ReadOnly _Domains As DomainsContainer
Get
Return My.Resources.SiteResources.XvideosPic_32
End Get
End Property
<PXML("Domains")> Private ReadOnly Property SiteDomains As PropertyValue
Friend ReadOnly Property Domains As DomainsContainer Friend ReadOnly Property Domains As DomainsContainer
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML> Get
Return If(DefaultInstance?.Domains, _Domains)
End Get
End Property
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML, PClonable>
Friend Property DownloadUHD As PropertyValue Friend Property DownloadUHD As PropertyValue
<PropertyOption(ControlText:="Playlist of saved videos", <PropertyOption(ControlText:="Playlist of saved videos",
ControlToolTip:="Your personal videos playlist to download as 'saved posts'. " & vbCr & ControlToolTip:="Your personal videos playlist to download as 'saved posts'. " & vbCr &
"This playlist must be private (Visibility = 'Only me'). It also required cookies." & vbCr & "This playlist must be private (Visibility = 'Only me'). It also required cookies." & vbCr &
"This playlist must be entered by pattern: https://www.xvideos.com/favorite/01234567/playlistname.", "This playlist must be entered by pattern: https://www.xvideos.com/favorite/01234567/playlistname.",
LeftOffset:=130), PXML> LeftOffset:=130), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property SavedVideosPlaylist As PropertyValue Friend ReadOnly Property SavedVideosPlaylist As PropertyValue
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("XVIDEOS", "www.xvideos.com") MyBase.New("XVIDEOS", "www.xvideos.com", AccName, Temp, My.Resources.SiteResources.XvideosIcon_48, My.Resources.SiteResources.XvideosPic_32)
Domains = New DomainsContainer(Me, "xvideos.com|xnxx.com") _Domains = New DomainsContainer(Me, "xvideos.com|xnxx.com")
SiteDomains = New PropertyValue(Domains.DomainsDefault, GetType(String)) SiteDomains = New PropertyValue(Domains.DomainsDefault, GetType(String))
Domains.DestinationProp = SiteDomains Domains.DestinationProp = SiteDomains
DownloadUHD = New PropertyValue(False) DownloadUHD = New PropertyValue(False)
@@ -156,6 +156,12 @@ Namespace API.XVIDEOS
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If End If
End Sub End Sub
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _Domains.Dispose()
MyBase.Dispose(disposing)
End Sub
#End Region #End Region
End Class End Class
End Namespace End Namespace

View File

@@ -17,9 +17,6 @@ Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.XVIDEOS Namespace API.XVIDEOS
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
#Region "XML names" #Region "XML names"
Private Const Name_SiteMode As String = "SiteMode"
Private Const Name_TrueName As String = "TrueName"
Private Const Name_Arguments As String = "Arguments"
Private Const Name_PersonType As String = "PersonType" Private Const Name_PersonType As String = "PersonType"
#End Region #End Region
#Region "Structures" #Region "Structures"
@@ -56,6 +53,11 @@ Namespace API.XVIDEOS
Return SiteMode = SiteModes.User Return SiteMode = SiteModes.User
End Get End Get
End Property End Property
Friend ReadOnly Property IsSearch As Boolean
Get
Return SiteMode = SiteModes.Search Or SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories
End Get
End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String) Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get Get
Return {SearchRequestLabelName} Return {SearchRequestLabelName}
@@ -175,6 +177,7 @@ Namespace API.XVIDEOS
UseClientTokens = True UseClientTokens = True
End Sub End Sub
#End Region #End Region
#Region "GetUserUrl"
Friend Function GetUserUrl(ByVal Page As Integer) As String Friend Function GetUserUrl(ByVal Page As Integer) As String
Dim url$ = String.Empty Dim url$ = String.Empty
If SiteMode = SiteModes.User Then If SiteMode = SiteModes.User Then
@@ -196,6 +199,8 @@ Namespace API.XVIDEOS
End If End If
Return url Return url
End Function End Function
#End Region
#Region "Download functions"
Private Sub Wait429(ByVal Round As Integer) Private Sub Wait429(ByVal Round As Integer)
If (Round Mod 5) = 0 Then If (Round Mod 5) = 0 Then
Thread.Sleep(5000 + (Round / 5).RoundDown) Thread.Sleep(5000 + (Round / 5).RoundDown)
@@ -321,7 +326,11 @@ Namespace API.XVIDEOS
Dim r$ Dim r$
Dim round% = 0 Dim round% = 0
Dim data As List(Of PlayListVideo) Dim data As List(Of PlayListVideo)
Dim pids As New List(Of String)
Dim cBefore% Dim cBefore%
Dim pageRepeatSet As Boolean, prevPostsFound As Boolean, newPostsFound As Boolean
Dim sessionPosts As New List(Of String)
Dim pageVideosRepeat As Integer = 0
Dim limit% = If(DownloadTopCount, -1) Dim limit% = If(DownloadTopCount, -1)
Do Do
@@ -329,7 +338,11 @@ Namespace API.XVIDEOS
Wait429(round) Wait429(round)
ThrowAny(Token) ThrowAny(Token)
NextPage += 1 NextPage += 1
newPostsFound = False
pageRepeatSet = False
prevPostsFound = False
cBefore = _TempMediaList.Count cBefore = _TempMediaList.Count
pids.Clear()
If SiteMode = SiteModes.User Then If SiteMode = SiteModes.User Then
URL = $"{MySettings.SavedVideosPlaylist.Value}{If(NextPage = 0, String.Empty, $"/{NextPage}")}" URL = $"{MySettings.SavedVideosPlaylist.Value}{If(NextPage = 0, String.Empty, $"/{NextPage}")}"
@@ -355,14 +368,35 @@ Namespace API.XVIDEOS
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
data = RegexFields(Of PlayListVideo)(r, {Regex_SavedVideosPlaylist}, {1, 2, 3}, EDP.ReturnValue) data = RegexFields(Of PlayListVideo)(r, {Regex_SavedVideosPlaylist}, {1, 2, 3}, EDP.ReturnValue)
If data.ListExists Then If data.ListExists Then
If data.RemoveAll(Function(d) _TempPostsList.Contains(d.ID)) > 0 Then __continue = False pids.ListAddList(data.Select(Function(d) d.ID), LNC)
If data.RemoveAll(Function(d) _TempPostsList.Contains(d.ID)) > 0 And Not IsSearch Then __continue = False
If data.ListExists Then If data.ListExists Then
_TempPostsList.ListAddList(data.Select(Function(d) d.ID), LNC) _TempPostsList.ListAddList(data.Select(Function(d) d.ID), LNC)
_TempMediaList.ListAddList(data.Select(Function(d) d.ToUserMedia()), LNC) _TempMediaList.ListAddList(data.Select(Function(d) d.ToUserMedia()), LNC)
newPostsFound = cBefore <> _TempMediaList.Count
ElseIf sessionPosts.Count > 0 AndAlso sessionPosts.ListContains(pids) Then
If pageRepeatSet Then pageRepeatSet = False : pageVideosRepeat -= 1
Else
If pageVideosRepeat > 2 Then
Exit Do
ElseIf Not pageRepeatSet And Not newPostsFound Then
pageRepeatSet = True
pageVideosRepeat += 1
End If End If
End If End If
sessionPosts.ListAddList(pids, LNC)
End If End If
Loop While NextPage < 100 And __continue And _TempMediaList.Count > cBefore And (limit < 0 Or _TempMediaList.Count < limit) End If
If limit > 0 And _TempMediaList.Count >= limit Then Exit Do
If IsSearch Then
__continue = NextPage < 1000 And (newPostsFound Or (prevPostsFound And Not newPostsFound))
ElseIf __continue Then
__continue = Not cBefore = _TempMediaList.Count
End If
Loop While NextPage < 1000 And __continue
pids.Clear()
sessionPosts.Clear()
If limit > 0 And _TempMediaList.Count >= limit Then _TempMediaList.ListAddList(_TempMediaList.ListTake(-1, limit), LAP.ClearBeforeAdd) If limit > 0 And _TempMediaList.Count >= limit Then _TempMediaList.ListAddList(_TempMediaList.ListTake(-1, limit), LAP.ClearBeforeAdd)
If _TempMediaList.Count > 0 Then If _TempMediaList.Count > 0 Then
@@ -451,16 +485,22 @@ Namespace API.XVIDEOS
Return Nothing Return Nothing
End Try End Try
End Function End Function
#End Region
#Region "DownloadContent"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
Dim m As UserMedia = GetVideoData(New UserMedia(Data.URL, UTypes.VideoPre))
If Not m.URL.IsEmptyString Then _TempMediaList.Add(m)
End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(Media.URL, Media.PictureOption, DestinationFile, Token, Progress, Not IsSingleObjectDownload) Return M3U8.Download(Media.URL, Media.PictureOption, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function End Function
#End Region
#Region "SingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
Dim m As UserMedia = GetVideoData(New UserMedia(Data.URL, UTypes.VideoPre))
If Not m.URL.IsEmptyString Then _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, 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 Optional ByVal EObj As Object = Nothing) As Integer
Dim isQuickies As Boolean = False Dim isQuickies As Boolean = False
@@ -474,5 +514,6 @@ Namespace API.XVIDEOS
Return 0 Return 0
End If End If
End Function End Function
#End Region
End Class End Class
End Namespace End Namespace

View File

@@ -15,26 +15,26 @@ Namespace API.Xhamster
<Manifest(XhamsterSiteKey), SavedPosts, SpecialForm(True), SpecialForm(False), TaskGroup(SettingsCLS.TaskStackNamePornSite)> <Manifest(XhamsterSiteKey), SavedPosts, SpecialForm(True), SpecialForm(False), TaskGroup(SettingsCLS.TaskStackNamePornSite)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon <PXML("Domains"), PClonable> Private ReadOnly Property SiteDomains As PropertyValue
Private Shadows ReadOnly Property DefaultInstance As SiteSettings
Get Get
Return My.Resources.SiteResources.XhamsterIcon_32 Return MyBase.DefaultInstance
End Get End Get
End Property End Property
Friend Overrides ReadOnly Property Image As Image Private ReadOnly _Domains As DomainsContainer
Get
Return My.Resources.SiteResources.XhamsterPic_32
End Get
End Property
<PXML("Domains")> Private ReadOnly Property SiteDomains As PropertyValue
Friend ReadOnly Property Domains As DomainsContainer Friend ReadOnly Property Domains As DomainsContainer
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML> Get
Return If(DefaultInstance?.Domains, _Domains)
End Get
End Property
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML, PClonable>
Friend Property DownloadUHD As PropertyValue Friend Property DownloadUHD As PropertyValue
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("XHamster", "xhamster.com") MyBase.New("XHamster", "xhamster.com", AccName, Temp, My.Resources.SiteResources.XhamsterIcon_32, My.Resources.SiteResources.XhamsterPic_32)
Domains = New DomainsContainer(Me, "xhamster.com") _Domains = New DomainsContainer(Me, "xhamster.com")
SiteDomains = New PropertyValue(Domains.DomainsDefault, GetType(String)) SiteDomains = New PropertyValue(Domains.DomainsDefault, GetType(String))
Domains.DestinationProp = SiteDomains Domains.DestinationProp = SiteDomains
DownloadUHD = New PropertyValue(False) DownloadUHD = New PropertyValue(False)
@@ -149,6 +149,12 @@ Namespace API.Xhamster
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If End If
End Sub End Sub
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _Domains.Dispose()
MyBase.Dispose(disposing)
End Sub
#End Region #End Region
End Class End Class
End Namespace End Namespace

View File

@@ -18,10 +18,7 @@ Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Xhamster Namespace API.Xhamster
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
#Region "XML names" #Region "XML names"
Private Const Name_TrueName As String = "TrueName"
Private Const Name_Gender As String = "Gender" Private Const Name_Gender As String = "Gender"
Private Const Name_SiteMode As String = "SiteMode"
Private Const Name_Arguments As String = "Arguments"
#End Region #End Region
#Region "Declarations" #Region "Declarations"
Friend Overrides ReadOnly Property FeedIsUser As Boolean Friend Overrides ReadOnly Property FeedIsUser As Boolean
@@ -39,6 +36,11 @@ Namespace API.Xhamster
Return SiteMode = SiteModes.User Or SiteMode = SiteModes.Pornstars Return SiteMode = SiteModes.User Or SiteMode = SiteModes.Pornstars
End Get End Get
End Property End Property
Friend ReadOnly Property IsSearch As Boolean
Get
Return SiteMode = SiteModes.Search Or SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories
End Get
End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String) Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get Get
Return {SearchRequestLabelName} Return {SearchRequestLabelName}
@@ -171,6 +173,7 @@ Namespace API.Xhamster
UseInternalM3U8Function = True UseInternalM3U8Function = True
UseClientTokens = True UseClientTokens = True
_TempPhotoData = New List(Of UserMedia) _TempPhotoData = New List(Of UserMedia)
SessionPosts = New List(Of String)
End Sub End Sub
#End Region #End Region
#Region "Download functions" #Region "Download functions"
@@ -218,9 +221,13 @@ Namespace API.Xhamster
End If End If
End Function End Function
Private SearchPostsCount As Integer = 0 Private SearchPostsCount As Integer = 0
Private ReadOnly SessionPosts As List(Of String)
Private _PageVideosRepeat As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TempPhotoData.Clear() _TempPhotoData.Clear()
SearchPostsCount = 0 SearchPostsCount = 0
_PageVideosRepeat = 0
SessionPosts.Clear()
If DownloadVideos Then DownloadData(1, True, Token) If DownloadVideos Then DownloadData(1, True, Token)
If Not IsChannel And DownloadImages And Not IsSubscription Then If Not IsChannel And DownloadImages And Not IsSubscription Then
DownloadData(1, False, Token) DownloadData(1, False, Token)
@@ -238,6 +245,8 @@ Namespace API.Xhamster
Dim skipped As Boolean = False Dim skipped As Boolean = False
Dim limit% = If(DownloadTopCount, -1) Dim limit% = If(DownloadTopCount, -1)
Dim cBefore% = _TempMediaList.Count Dim cBefore% = _TempMediaList.Count
Dim pageRepeatSet As Boolean = False, prevPostsFound As Boolean = False, newPostsFound As Boolean = False
Dim pids As New List(Of String)
Dim m As UserMedia Dim m As UserMedia
Dim checkLimit As Func(Of Boolean) = Function() limit > 0 And SearchPostsCount >= limit And IsVideo Dim checkLimit As Func(Of Boolean) = Function() limit > 0 And SearchPostsCount >= limit And IsVideo
@@ -284,6 +293,7 @@ Namespace API.Xhamster
ProgressPre.Perform() ProgressPre.Perform()
m = ExtractMedia(e, Type) m = ExtractMedia(e, Type)
If Not m.URL.IsEmptyString Then If Not m.URL.IsEmptyString Then
pids.ListAddValue(m.Post.ID, LNC)
If m.File.IsEmptyString Then Continue For If m.File.IsEmptyString Then Continue For
If m.Post.Date.HasValue Then If m.Post.Date.HasValue Then
@@ -297,6 +307,8 @@ Namespace API.Xhamster
_TempPostsList.Add(m.Post.ID) _TempPostsList.Add(m.Post.ID)
_TempMediaList.ListAddValue(m, LNC) _TempMediaList.ListAddValue(m, LNC)
SearchPostsCount += 1 SearchPostsCount += 1
newPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
If checkLimit.Invoke Then Exit Sub If checkLimit.Invoke Then Exit Sub
ElseIf Not IsVideo Then ElseIf Not IsVideo Then
If DirectCast(m.Object, ExchObj).IsPhoto Then If DirectCast(m.Object, ExchObj).IsPhoto Then
@@ -307,11 +319,24 @@ Namespace API.Xhamster
Else Else
_TempPhotoData.ListAddValue(m, LNC) _TempPhotoData.ListAddValue(m, LNC)
End If End If
ElseIf IsVideo And _TempPostsList.Contains(m.Post.ID) Then
If SessionPosts.Count > 0 AndAlso SessionPosts.Contains(m.Post.ID) Then
prevPostsFound = True
If pageRepeatSet Then pageRepeatSet = False : _PageVideosRepeat -= 1
Continue For
ElseIf _PageVideosRepeat > 2 Then
Exit Sub
ElseIf Not pageRepeatSet And Not newPostsFound Then
pageRepeatSet = True
_PageVideosRepeat += 1
End If
Else Else
Exit Sub Exit Sub
End If End If
End If End If
Next Next
SessionPosts.ListAddList(pids, LNC)
pids.Clear()
Exit For Exit For
End If End If
End With End With
@@ -322,8 +347,11 @@ Namespace API.Xhamster
containerNodes.Clear() containerNodes.Clear()
If (Not _TempMediaList.Count = cBefore Or skipped) And If (
(IsChannel Or (MaxPage > 0 And Page < MaxPage) Or (Not SiteMode = SiteModes.User And Page < 1000)) Then DownloadData(Page + 1, IsVideo, Token) (MaxPage = -1 Or Page < MaxPage) And
((Not _TempMediaList.Count = cBefore Or skipped) And (IsUser Or Page < 1000))
) Or
(IsChannel Or (Not IsUser And Page < 1000 And prevPostsFound And Not newPostsFound)) Then DownloadData(Page + 1, IsVideo, Token)
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]") ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try End Try
@@ -344,6 +372,7 @@ Namespace API.Xhamster
m = _TempMediaList(i) m = _TempMediaList(i)
If Not m.URL_BASE.IsEmptyString Then If Not m.URL_BASE.IsEmptyString Then
m2 = Nothing m2 = Nothing
ThrowAny(Token)
If GetM3U8(m2, m.URL_BASE) Then If GetM3U8(m2, m.URL_BASE) Then
m2.URL_BASE = m.URL_BASE m2.URL_BASE = m.URL_BASE
_TempMediaList(i) = m2 _TempMediaList(i) = m2
@@ -373,6 +402,7 @@ Namespace API.Xhamster
m = _TempMediaList(i) m = _TempMediaList(i)
If Not m.URL_BASE.IsEmptyString Then If Not m.URL_BASE.IsEmptyString Then
m2 = Nothing m2 = Nothing
ThrowAny(Token)
If GetM3U8(m2, m.URL_BASE) Then If GetM3U8(m2, m.URL_BASE) Then
m2.URL_BASE = m.URL_BASE m2.URL_BASE = m.URL_BASE
_TempMediaList(i) = m2 _TempMediaList(i) = m2
@@ -456,6 +486,8 @@ Namespace API.Xhamster
m2 = Nothing m2 = Nothing
If GetM3U8(m2, m.URL_BASE) Then If GetM3U8(m2, m.URL_BASE) Then
m2.URL_BASE = m.URL_BASE m2.URL_BASE = m.URL_BASE
m2.State = UserMedia.States.Missing
m2.Attempts = m.Attempts
_TempMediaList.ListAddValue(m2, LNC) _TempMediaList.ListAddValue(m2, LNC)
rList.Add(i) rList.Add(i)
End If End If
@@ -580,12 +612,13 @@ Namespace API.Xhamster
#Region "Exception" #Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer Optional ByVal EObj As Object = Nothing) As Integer
Return If(Responser.Status = Net.WebExceptionStatus.ConnectionClosed, 1, 0) '8, 503
Return If(Responser.Status = Net.WebExceptionStatus.ConnectionClosed Or Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable, 1, 0)
End Function End Function
#End Region #End Region
#Region "IDisposable support" #Region "IDisposable support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _TempPhotoData.Clear() If Not disposedValue And disposing Then _TempPhotoData.Clear() : SessionPosts.Clear()
MyBase.Dispose(disposing) MyBase.Dispose(disposing)
End Sub End Sub
#End Region #End Region

View File

@@ -14,28 +14,18 @@ Namespace API.YouTube
<Manifest(YouTubeSiteKey), SpecialForm(True), SpecialForm(False), SeparatedTasks(1)> <Manifest(YouTubeSiteKey), SpecialForm(True), SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon <PXML, PropertyOption(ControlText:="Download user videos"), PClonable>
Get
Return My.Resources.SiteYouTube.YouTubeIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteYouTube.YouTubePic_96
End Get
End Property
<PXML, PropertyOption(ControlText:="Download user videos")>
Friend ReadOnly Property DownloadVideos As PropertyValue Friend ReadOnly Property DownloadVideos As PropertyValue
<PXML, PropertyOption(ControlText:="Download user shorts")> <PXML, PropertyOption(ControlText:="Download user shorts"), PClonable>
Friend ReadOnly Property DownloadShorts As PropertyValue Friend ReadOnly Property DownloadShorts As PropertyValue
<PXML, PropertyOption(ControlText:="Download user playlists")> <PXML, PropertyOption(ControlText:="Download user playlists"), PClonable>
Friend ReadOnly Property DownloadPlaylists As PropertyValue Friend ReadOnly Property DownloadPlaylists As PropertyValue
<PXML, PropertyOption(ControlText:="Use cookies", ControlToolTip:="Default value for new users." & vbCr & "Use cookies when downloading data.")> <PXML, PropertyOption(ControlText:="Use cookies", ControlToolTip:="Default value for new users." & vbCr & "Use cookies when downloading data."), PClonable>
Friend ReadOnly Property UseCookies As PropertyValue Friend ReadOnly Property UseCookies As PropertyValue
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New(YouTubeSite, "youtube.com") MyBase.New(YouTubeSite, "youtube.com", AccName, Temp, My.Resources.SiteYouTube.YouTubeIcon_32, My.Resources.SiteYouTube.YouTubePic_96)
Responser.Cookies.ChangedAllowInternalDrop = False Responser.Cookies.ChangedAllowInternalDrop = False
DownloadVideos = New PropertyValue(True) DownloadVideos = New PropertyValue(True)
DownloadShorts = New PropertyValue(False) DownloadShorts = New PropertyValue(False)

View File

@@ -124,7 +124,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Private Sub SetLimit(ByVal Source As IChannelLimits) Implements IChannelLimits.SetLimit Private Sub SetLimit(ByVal Source As IChannelLimits) Implements IChannelLimits.SetLimit
End Sub End Sub
#End Region #End Region
Private ReadOnly HOST As SettingsHost Private ReadOnly HOST_COLLECTION As SettingsHostCollection
Private ReadOnly PendingUsers As List(Of PendingUser) Private ReadOnly PendingUsers As List(Of PendingUser)
Private ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly) Private ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly)
Private WithEvents MyRange As RangeSwitcherToolbar(Of UserPost) Private WithEvents MyRange As RangeSwitcherToolbar(Of UserPost)
@@ -148,7 +148,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
CProvider = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral} CProvider = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
LimitProvider = New ADateTime("dd.MM.yyyy HH:mm") LimitProvider = New ADateTime("dd.MM.yyyy HH:mm")
PendingUsers = New List(Of PendingUser) PendingUsers = New List(Of PendingUser)
HOST = Settings(RedditSiteKey) HOST_COLLECTION = Settings(RedditSiteKey)
CMB_CHANNELS = New ComboBoxExtended With { CMB_CHANNELS = New ComboBoxExtended With {
.CaptionMode = ICaptionControl.Modes.CheckBox, .CaptionMode = ICaptionControl.Modes.CheckBox,
@@ -312,7 +312,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Dim Added% = 0, Skipped% = 0 Dim Added% = 0, Skipped% = 0
Dim StartIndex% = Settings.Users.Count Dim StartIndex% = Settings.Users.Count
Dim f As SFile Dim f As SFile
Dim umo As Boolean = HOST.GetUserMediaOnly Dim umo As Boolean
Settings.Labels.Add(UserData.CannelsLabelName_ChannelsForm) Settings.Labels.Add(UserData.CannelsLabelName_ChannelsForm)
Settings.Labels.Add(LabelsKeeper.NoParsedUser) Settings.Labels.Add(LabelsKeeper.NoParsedUser)
Dim rUsers$() = UserBanned(PendingUsers.Select(Function(u) u.ID).ToArray) Dim rUsers$() = UserBanned(PendingUsers.Select(Function(u) u.ID).ToArray)
@@ -321,13 +321,23 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Dim c As New ListAddParams(LAP.NotContainsOnly) Dim c As New ListAddParams(LAP.NotContainsOnly)
Dim cn$ Dim cn$
Dim tmpUser As IUserData Dim tmpUser As IUserData
With PendingUsers.Select(Function(u) New UserInfo(u, HOST)) Dim h As SettingsHost
With PendingUsers.Select(Function(u) New UserInfo(u, If(u.Channel?.HOST, HOST_COLLECTION.Default)))
For i = 0 To .Count - 1 For i = 0 To .Count - 1
If Not Settings.UsersList.Contains(.ElementAt(i)) Then If Not Settings.UsersList.Contains(.ElementAt(i)) Then
f = PendingUsers(i).File f = PendingUsers(i).File
cn = If(PendingUsers(i).Channel?.Name, String.Empty) If Not PendingUsers(i).Channel Is Nothing Then
cn = PendingUsers(i).Channel.Name
umo = PendingUsers(i).Channel.HOST.GetUserMediaOnly
h = PendingUsers(i).Channel.HOST
Else
cn = String.Empty
umo = True
h = Nothing
End If
If h Is Nothing Then h = HOST_COLLECTION.Default
Settings.UpdateUsersList(.ElementAt(i)) Settings.UpdateUsersList(.ElementAt(i))
tmpUser = HOST.GetInstance(Plugin.ISiteSettings.Download.Main, .ElementAt(i), False) tmpUser = h.GetInstance(Plugin.ISiteSettings.Download.Main, .ElementAt(i), False)
With DirectCast(tmpUser, UserData) With DirectCast(tmpUser, UserData)
.Temporary = Settings.ChannelsDefaultTemporary .Temporary = Settings.ChannelsDefaultTemporary
.CreatedByChannel = True .CreatedByChannel = True
@@ -417,7 +427,18 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Private Async Sub BTT_DOWNLOAD_Click(sender As Object, e As EventArgs) Handles BTT_DOWNLOAD.Click Private Async Sub BTT_DOWNLOAD_Click(sender As Object, e As EventArgs) Handles BTT_DOWNLOAD.Click
Try Try
AppendPendingUsers() AppendPendingUsers()
If Not TokenSource Is Nothing OrElse Not HOST.Source.Available(Plugin.ISiteSettings.Download.Main, False) Then Exit Sub Dim c As Channel
If CMB_CHANNELS.Count > 0 Then
Dim hList As IEnumerable(Of String) = Nothing
If CMB_CHANNELS.Checked Then
hList = Settings.Channels.Select(Function(cc) cc.RedditAccount.IfNullOrEmpty(SettingsHost.NameAccountNameDefault)).Distinct
Else
c = GetCurrentChannel()
If Not c Is Nothing Then hList = {c.RedditAccount}
End If
If Not TokenSource Is Nothing OrElse Not HOST_COLLECTION.Available(Plugin.ISiteSettings.Download.Main, False, False,
hList, Not hList Is Nothing) Then Exit Sub
End If
Dim InvokeToken As Action = Sub() Dim InvokeToken As Action = Sub()
If TokenSource Is Nothing Then If TokenSource Is Nothing Then
CProgress.Maximum = 0 CProgress.Maximum = 0
@@ -437,7 +458,6 @@ Friend Class ChannelViewForm : Implements IChannelLimits
MyRange.Enabled = False MyRange.Enabled = False
End If End If
End Sub End Sub
Dim c As Channel
If CMB_CHANNELS.Count > 0 Then If CMB_CHANNELS.Count > 0 Then
BTT_DOWNLOAD.Enabled = False BTT_DOWNLOAD.Enabled = False
BTT_STOP.Enabled = True BTT_STOP.Enabled = True
@@ -607,7 +627,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Try Try
c = GetCurrentChannel() c = GetCurrentChannel()
If Not c Is Nothing Then If Not c Is Nothing Then
Using f As New RedditViewSettingsForm(c) Using f As New RedditViewSettingsForm(c, False)
f.ShowDialog() f.ShowDialog()
If f.DialogResult = DialogResult.OK Then c.Save() If f.DialogResult = DialogResult.OK Then c.Save()
End Using End Using

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.3 KiB

View File

@@ -11,6 +11,8 @@ Imports PersonalUtilities.Forms
Namespace DownloadObjects Namespace DownloadObjects
Friend Class ActiveDownloadingProgress Friend Class ActiveDownloadingProgress
Private Const MinWidth As Integer = 450 Private Const MinWidth As Integer = 450
Private Const TP_RowHeight As Integer = 30
Private Const TP_LowestValue As Integer = 39
Private MyView As FormView Private MyView As FormView
Private Opened As Boolean = False Private Opened As Boolean = False
Friend ReadOnly Property ReadyToOpen As Boolean Friend ReadOnly Property ReadyToOpen As Boolean
@@ -40,9 +42,26 @@ Namespace DownloadObjects
Private Sub ActiveDownloadingProgress_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed Private Sub ActiveDownloadingProgress_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
MyView.DisposeIfReady() MyView.DisposeIfReady()
End Sub End Sub
Private Sub ActiveDownloadingProgress_VisibleChanged(sender As Object, e As EventArgs) Handles Me.VisibleChanged
Try
If Visible Then
ControlInvokeFast(Me, Sub()
Dim s As Size = Size
Dim ss As Size = Screen.PrimaryScreen.WorkingArea.Size
Dim c% = TP_MAIN.RowStyles.Count - 1
s.Height = c * TP_RowHeight + TP_LowestValue + (PaddingE.GetOf({TP_MAIN}).Vertical(c) / c).RoundDown
If s.Height > ss.Height Then s.Height = ss.Height
MinimumSize = Nothing
Size = s
MinimumSize = New Size(MinWidth, s.Height)
End Sub)
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Change 'ActiveDownloadingProgress' size")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub Downloader_Reconfigured() Private Sub Downloader_Reconfigured()
Const RowHeight% = 30
Const LowestValue% = 39
Dim a As Action = Sub() Dim a As Action = Sub()
With TP_MAIN With TP_MAIN
If .Controls.Count > 0 Then If .Controls.Count > 0 Then
@@ -59,7 +78,7 @@ Namespace DownloadObjects
If .Pool.Count > 0 Then If .Pool.Count > 0 Then
For Each j As TDownloader.Job In .Pool For Each j As TDownloader.Job In .Pool
With TP_MAIN With TP_MAIN
.RowStyles.Add(New RowStyle(SizeType.Absolute, RowHeight)) .RowStyles.Add(New RowStyle(SizeType.Absolute, TP_RowHeight))
.RowCount += 1 .RowCount += 1
JobsList.Add(New DownloadProgress(j)) JobsList.Add(New DownloadProgress(j))
AddHandler JobsList.Last.ProgressChanged, AddressOf Jobs_ProgressChanged AddHandler JobsList.Last.ProgressChanged, AddressOf Jobs_ProgressChanged
@@ -69,14 +88,14 @@ Namespace DownloadObjects
TP_MAIN.RowStyles.Add(New RowStyle(SizeType.AutoSize)) TP_MAIN.RowStyles.Add(New RowStyle(SizeType.AutoSize))
TP_MAIN.RowCount += 1 TP_MAIN.RowCount += 1
Dim s As Size = Size 'Dim s As Size = Size
Dim ss As Size = Screen.PrimaryScreen.WorkingArea.Size 'Dim ss As Size = Screen.PrimaryScreen.WorkingArea.Size
Dim c% = TP_MAIN.RowStyles.Count - 1 'Dim c% = TP_MAIN.RowStyles.Count - 1
s.Height = c * RowHeight + LowestValue + (PaddingE.GetOf({TP_MAIN}).Vertical(c) / c).RoundDown 's.Height = c * TP_RowHeight + TP_LowestValue + (PaddingE.GetOf({TP_MAIN}).Vertical(c) / c).RoundDown
If s.Height > ss.Height Then s.Height = ss.Height 'If s.Height > ss.Height Then s.Height = ss.Height
MinimumSize = Nothing 'MinimumSize = Nothing
Size = s 'Size = s
MinimumSize = New Size(MinWidth, s.Height) 'MinimumSize = New Size(MinWidth, s.Height)
End If End If
End With End With
TP_MAIN.Refresh() TP_MAIN.Refresh()

View File

@@ -130,6 +130,7 @@ Namespace DownloadObjects
#End Region #End Region
#Region "Execution" #Region "Execution"
Friend Async Function Start(ByVal Init As Boolean) As Task Friend Async Function Start(ByVal Init As Boolean) As Task
Try
Await Task.Run(Sub() Await Task.Run(Sub()
If Count > 0 Then If Count > 0 Then
If Plans.Exists(PlanDownloading) Then PlansWaiter(PlanDownloading) If Plans.Exists(PlanDownloading) Then PlansWaiter(PlanDownloading)
@@ -140,6 +141,14 @@ Namespace DownloadObjects
Next Next
End If End If
End Sub) End Sub)
Catch ex As Exception
If Init Then
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Start automation")
MainFrameObj.UpdateLogButton()
Else
Throw ex
End If
End Try
End Function End Function
Friend Sub [Stop]() Friend Sub [Stop]()
If Count > 0 Then Plans.ForEach(Sub(p) p.Stop()) If Count > 0 Then Plans.ForEach(Sub(p) p.Stop())

View File

@@ -49,8 +49,8 @@ Namespace DownloadObjects
} }
CreateButton(BTT_STOP, My.Resources.DeletePic_24) CreateButton(BTT_STOP, My.Resources.DeletePic_24)
Dim img As Image = Nothing Dim img As Image = Nothing
If Not _Job.Host Is Nothing Then If Not _Job.Host(String.Empty) Is Nothing Then
With Job.Host.Source With Job.Host(String.Empty).Source
If Not .Icon Is Nothing Then img = .Icon.ToBitmap If Not .Icon Is Nothing Then img = .Icon.ToBitmap
If img Is Nothing AndAlso Not .Image Is Nothing Then img = .Image If img Is Nothing AndAlso Not .Image Is Nothing Then img = .Image
End With End With
@@ -131,8 +131,8 @@ Namespace DownloadObjects
End With End With
End With End With
If Job.Type = Download.SavedPosts And Not Job.Progress Is Nothing Then Job.Progress.InformationTemporary = Job.Host.Name If Job.Type = Download.SavedPosts And Not Job.Progress Is Nothing Then Job.Progress.InformationTemporary = Job.HostCollection.Name
Instance = New API.Base.ProfileSaved(Job.Host, Job.Progress) Instance = New API.Base.ProfileSaved(Job.HostCollection, Job.Progress)
End Sub End Sub
Private Sub CreateButton(ByRef BTT As Button, ByVal Img As Image) Private Sub CreateButton(ByRef BTT As Button, ByVal Img As Image)
BTT = New Button With { BTT = New Button With {
@@ -154,7 +154,7 @@ Namespace DownloadObjects
[Stop]() [Stop]()
End Sub End Sub
Private Sub BTT_OPEN_Click(sender As Object, e As EventArgs) Handles BTT_OPEN.Click Private Sub BTT_OPEN_Click(sender As Object, e As EventArgs) Handles BTT_OPEN.Click
GlobalOpenPath(Job.Host.SavedPostsPath) GlobalOpenPath(If(Job.HostCollection.FirstOrDefault(Function(h) h.DownloadSavedPosts), Job.HostCollection.Default).SavedPostsPath)
End Sub End Sub
#End Region #End Region
#Region "Start, Stop" #Region "Start, Stop"
@@ -173,13 +173,13 @@ Namespace DownloadObjects
Try Try
btte.Invoke(BTT_START, False) btte.Invoke(BTT_START, False)
btte.Invoke(BTT_STOP, True) btte.Invoke(BTT_STOP, True)
Job.Progress.InformationTemporary = $"{Job.Host.Name} downloading started" Job.Progress.InformationTemporary = $"{Job.HostCollection.Name} downloading started"
Job.Start() Job.Start()
Instance.Download(Job.Token, _IsMultiple) Instance.Download(Job.Token, _IsMultiple)
RaiseEvent DownloadDone(SettingsCLS.NotificationObjects.SavedPosts, $"Downloading saved {Job.Host.Name} posts is completed") RaiseEvent DownloadDone(SettingsCLS.NotificationObjects.SavedPosts, $"Downloading saved {Job.HostCollection.Name} posts is completed")
Catch ex As Exception Catch ex As Exception
Job.Progress.InformationTemporary = $"{Job.Host.Name} downloading error" Job.Progress.InformationTemporary = $"{Job.HostCollection.Name} downloading error"
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, {$"{Job.Host.Name} saved posts downloading error", "Saved posts"}) ErrorsDescriber.Execute(EDP.LogMessageValue, ex, {$"{Job.HostCollection.Name} saved posts downloading error", "Saved posts"})
Finally Finally
_IsMultiple = False _IsMultiple = False
btte.Invoke(BTT_START, True) btte.Invoke(BTT_START, True)

View File

@@ -25,7 +25,7 @@ Friend Class DownloadSavedPostsForm
If Settings.Plugins.Count > 0 Then If Settings.Plugins.Count > 0 Then
Dim j As TDownloader.Job Dim j As TDownloader.Job
For Each p As PluginHost In Settings.Plugins For Each p As PluginHost In Settings.Plugins
If p.Settings.IsSavedPostsCompatible Then If p.Settings.Default.IsSavedPostsCompatible Then
j = New TDownloader.Job(Plugin.ISiteSettings.Download.SavedPosts) j = New TDownloader.Job(Plugin.ISiteSettings.Download.SavedPosts)
j.AddHost(p.Settings) j.AddHost(p.Settings)
JobsList.Add(New DownloadProgress(j)) JobsList.Add(New DownloadProgress(j))

View File

@@ -26,12 +26,23 @@ Namespace DownloadObjects
Dim SEP_2 As System.Windows.Forms.ToolStripSeparator Dim SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim MENU_VIEW As System.Windows.Forms.ToolStripDropDownButton Dim MENU_VIEW As System.Windows.Forms.ToolStripDropDownButton
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(DownloadFeedForm)) Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(DownloadFeedForm))
Dim MENU_LOAD_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_3 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_4 As System.Windows.Forms.ToolStripSeparator
Me.OPT_DEFAULT = New System.Windows.Forms.ToolStripMenuItem() Me.OPT_DEFAULT = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_SUBSCRIPTIONS = New System.Windows.Forms.ToolStripMenuItem() Me.OPT_SUBSCRIPTIONS = New System.Windows.Forms.ToolStripMenuItem()
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip() Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
Me.MENU_LOAD_SESSION = New System.Windows.Forms.ToolStripDropDownButton() Me.MENU_LOAD_SESSION = New System.Windows.Forms.ToolStripDropDownButton()
Me.BTT_LOAD_SESSION_CURRENT = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOAD_SESSION_LAST = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_LOAD_SESSION_LAST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOAD_SESSION_CHOOSE = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_LOAD_SESSION_CHOOSE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOAD_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOAD_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_ADD_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_REMOVE_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_ADD_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_REMOVE_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.SEP_0 = New System.Windows.Forms.ToolStripSeparator() Me.SEP_0 = New System.Windows.Forms.ToolStripSeparator()
Me.MENU_DOWN = New System.Windows.Forms.ToolStripDropDownButton() Me.MENU_DOWN = New System.Windows.Forms.ToolStripDropDownButton()
Me.BTT_DOWN_ALL = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_DOWN_ALL = New System.Windows.Forms.ToolStripMenuItem()
@@ -39,9 +50,18 @@ Namespace DownloadObjects
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton() Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.BTT_CLEAR = New System.Windows.Forms.ToolStripButton() Me.BTT_CLEAR = New System.Windows.Forms.ToolStripButton()
Me.TP_DATA = New System.Windows.Forms.TableLayoutPanel() Me.TP_DATA = New System.Windows.Forms.TableLayoutPanel()
Me.BTT_FEED_CLEAR_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_CLEAR_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_LIST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_DATE = New System.Windows.Forms.ToolStripMenuItem()
SEP_1 = New System.Windows.Forms.ToolStripSeparator() SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator() SEP_2 = New System.Windows.Forms.ToolStripSeparator()
MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton() MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton()
MENU_LOAD_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_3 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_4 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout() Me.ToolbarTOP.SuspendLayout()
Me.SuspendLayout() Me.SuspendLayout()
' '
@@ -77,6 +97,21 @@ Namespace DownloadObjects
Me.OPT_SUBSCRIPTIONS.Size = New System.Drawing.Size(145, 22) Me.OPT_SUBSCRIPTIONS.Size = New System.Drawing.Size(145, 22)
Me.OPT_SUBSCRIPTIONS.Text = "Subscriptions" Me.OPT_SUBSCRIPTIONS.Text = "Subscriptions"
' '
'MENU_LOAD_SEP_1
'
MENU_LOAD_SEP_1.Name = "MENU_LOAD_SEP_1"
MENU_LOAD_SEP_1.Size = New System.Drawing.Size(264, 6)
'
'MENU_LOAD_SEP_2
'
MENU_LOAD_SEP_2.Name = "MENU_LOAD_SEP_2"
MENU_LOAD_SEP_2.Size = New System.Drawing.Size(264, 6)
'
'MENU_LOAD_SEP_3
'
MENU_LOAD_SEP_3.Name = "MENU_LOAD_SEP_3"
MENU_LOAD_SEP_3.Size = New System.Drawing.Size(264, 6)
'
'ToolbarTOP 'ToolbarTOP
' '
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
@@ -89,27 +124,76 @@ Namespace DownloadObjects
'MENU_LOAD_SESSION 'MENU_LOAD_SESSION
' '
Me.MENU_LOAD_SESSION.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image Me.MENU_LOAD_SESSION.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_LAST, Me.BTT_LOAD_SESSION_CHOOSE}) Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_CURRENT, Me.BTT_LOAD_SESSION_LAST, Me.BTT_LOAD_SESSION_CHOOSE, MENU_LOAD_SEP_1, Me.BTT_LOAD_FAV, Me.BTT_LOAD_SPEC, MENU_LOAD_SEP_2, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_REMOVE_FAV, MENU_LOAD_SEP_3, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_REMOVE_SPEC, MENU_LOAD_SEP_4, Me.BTT_FEED_CLEAR_FAV, Me.BTT_FEED_CLEAR_SPEC, Me.BTT_FEED_DELETE_SPEC, Me.BTT_FEED_DELETE_DAILY_LIST, Me.BTT_FEED_DELETE_DAILY_DATE})
Me.MENU_LOAD_SESSION.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24 Me.MENU_LOAD_SESSION.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.MENU_LOAD_SESSION.ImageTransparentColor = System.Drawing.Color.Magenta Me.MENU_LOAD_SESSION.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_LOAD_SESSION.Name = "MENU_LOAD_SESSION" Me.MENU_LOAD_SESSION.Name = "MENU_LOAD_SESSION"
Me.MENU_LOAD_SESSION.Size = New System.Drawing.Size(29, 22) Me.MENU_LOAD_SESSION.Size = New System.Drawing.Size(29, 22)
Me.MENU_LOAD_SESSION.Text = "Load session" Me.MENU_LOAD_SESSION.Text = "Load session"
' '
'BTT_LOAD_SESSION_CURRENT
'
Me.BTT_LOAD_SESSION_CURRENT.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_LOAD_SESSION_CURRENT.Name = "BTT_LOAD_SESSION_CURRENT"
Me.BTT_LOAD_SESSION_CURRENT.Size = New System.Drawing.Size(267, 22)
Me.BTT_LOAD_SESSION_CURRENT.Text = "Load current session"
'
'BTT_LOAD_SESSION_LAST 'BTT_LOAD_SESSION_LAST
' '
Me.BTT_LOAD_SESSION_LAST.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24 Me.BTT_LOAD_SESSION_LAST.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_LOAD_SESSION_LAST.Name = "BTT_LOAD_SESSION_LAST" Me.BTT_LOAD_SESSION_LAST.Name = "BTT_LOAD_SESSION_LAST"
Me.BTT_LOAD_SESSION_LAST.Size = New System.Drawing.Size(189, 22) Me.BTT_LOAD_SESSION_LAST.Size = New System.Drawing.Size(267, 22)
Me.BTT_LOAD_SESSION_LAST.Text = "Load last session" Me.BTT_LOAD_SESSION_LAST.Text = "Load last session"
' '
'BTT_LOAD_SESSION_CHOOSE 'BTT_LOAD_SESSION_CHOOSE
' '
Me.BTT_LOAD_SESSION_CHOOSE.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24 Me.BTT_LOAD_SESSION_CHOOSE.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_LOAD_SESSION_CHOOSE.Name = "BTT_LOAD_SESSION_CHOOSE" Me.BTT_LOAD_SESSION_CHOOSE.Name = "BTT_LOAD_SESSION_CHOOSE"
Me.BTT_LOAD_SESSION_CHOOSE.Size = New System.Drawing.Size(189, 22) Me.BTT_LOAD_SESSION_CHOOSE.Size = New System.Drawing.Size(267, 22)
Me.BTT_LOAD_SESSION_CHOOSE.Text = "Select loading session" Me.BTT_LOAD_SESSION_CHOOSE.Text = "Select loading session"
' '
'BTT_LOAD_FAV
'
Me.BTT_LOAD_FAV.Image = Global.SCrawler.My.Resources.Resources.HeartPic_32
Me.BTT_LOAD_FAV.Name = "BTT_LOAD_FAV"
Me.BTT_LOAD_FAV.Size = New System.Drawing.Size(267, 22)
Me.BTT_LOAD_FAV.Text = "Load Favorite"
'
'BTT_LOAD_SPEC
'
Me.BTT_LOAD_SPEC.Image = Global.SCrawler.My.Resources.Resources.RSSPic_512
Me.BTT_LOAD_SPEC.Name = "BTT_LOAD_SPEC"
Me.BTT_LOAD_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_LOAD_SPEC.Text = "Load special feed"
'
'BTT_FEED_ADD_FAV
'
Me.BTT_FEED_ADD_FAV.Image = Global.SCrawler.My.Resources.Resources.HeartPic_32
Me.BTT_FEED_ADD_FAV.Name = "BTT_FEED_ADD_FAV"
Me.BTT_FEED_ADD_FAV.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_ADD_FAV.Text = "Add checked to Favorite"
'
'BTT_FEED_REMOVE_FAV
'
Me.BTT_FEED_REMOVE_FAV.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_REMOVE_FAV.Name = "BTT_FEED_REMOVE_FAV"
Me.BTT_FEED_REMOVE_FAV.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_REMOVE_FAV.Text = "Remove checked from Favorite"
'
'BTT_FEED_ADD_SPEC
'
Me.BTT_FEED_ADD_SPEC.Image = Global.SCrawler.My.Resources.Resources.RSSPic_512
Me.BTT_FEED_ADD_SPEC.Name = "BTT_FEED_ADD_SPEC"
Me.BTT_FEED_ADD_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_ADD_SPEC.Text = "Add checked to special feed..."
'
'BTT_FEED_REMOVE_SPEC
'
Me.BTT_FEED_REMOVE_SPEC.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_REMOVE_SPEC.Name = "BTT_FEED_REMOVE_SPEC"
Me.BTT_FEED_REMOVE_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_REMOVE_SPEC.Text = "Remove checked from special feed..."
'
'SEP_0 'SEP_0
' '
Me.SEP_0.Name = "SEP_0" Me.SEP_0.Name = "SEP_0"
@@ -130,7 +214,7 @@ Namespace DownloadObjects
' '
Me.BTT_DOWN_ALL.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16 Me.BTT_DOWN_ALL.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_DOWN_ALL.Name = "BTT_DOWN_ALL" Me.BTT_DOWN_ALL.Name = "BTT_DOWN_ALL"
Me.BTT_DOWN_ALL.Size = New System.Drawing.Size(180, 22) Me.BTT_DOWN_ALL.Size = New System.Drawing.Size(174, 22)
Me.BTT_DOWN_ALL.Tag = "a" Me.BTT_DOWN_ALL.Tag = "a"
Me.BTT_DOWN_ALL.Text = "Download ALL" Me.BTT_DOWN_ALL.Text = "Download ALL"
' '
@@ -138,7 +222,7 @@ Namespace DownloadObjects
' '
Me.BTT_DOWN_SELECTED.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16 Me.BTT_DOWN_SELECTED.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_DOWN_SELECTED.Name = "BTT_DOWN_SELECTED" Me.BTT_DOWN_SELECTED.Name = "BTT_DOWN_SELECTED"
Me.BTT_DOWN_SELECTED.Size = New System.Drawing.Size(180, 22) Me.BTT_DOWN_SELECTED.Size = New System.Drawing.Size(174, 22)
Me.BTT_DOWN_SELECTED.Tag = "s" Me.BTT_DOWN_SELECTED.Tag = "s"
Me.BTT_DOWN_SELECTED.Text = "Download selected" Me.BTT_DOWN_SELECTED.Text = "Download selected"
' '
@@ -185,6 +269,46 @@ Namespace DownloadObjects
Me.TP_DATA.Size = New System.Drawing.Size(484, 436) Me.TP_DATA.Size = New System.Drawing.Size(484, 436)
Me.TP_DATA.TabIndex = 1 Me.TP_DATA.TabIndex = 1
' '
'MENU_LOAD_SEP_4
'
MENU_LOAD_SEP_4.Name = "MENU_LOAD_SEP_4"
MENU_LOAD_SEP_4.Size = New System.Drawing.Size(264, 6)
'
'BTT_FEED_CLEAR_FAV
'
Me.BTT_FEED_CLEAR_FAV.Image = Global.SCrawler.My.Resources.Resources.BrushToolPic_16
Me.BTT_FEED_CLEAR_FAV.Name = "BTT_FEED_CLEAR_FAV"
Me.BTT_FEED_CLEAR_FAV.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_CLEAR_FAV.Text = "Clear Favorite"
'
'BTT_FEED_CLEAR_SPEC
'
Me.BTT_FEED_CLEAR_SPEC.Image = Global.SCrawler.My.Resources.Resources.BrushToolPic_16
Me.BTT_FEED_CLEAR_SPEC.Name = "BTT_FEED_CLEAR_SPEC"
Me.BTT_FEED_CLEAR_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_CLEAR_SPEC.Text = "Clear special feed..."
'
'BTT_FEED_DELETE_SPEC
'
Me.BTT_FEED_DELETE_SPEC.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_SPEC.Name = "BTT_FEED_DELETE_SPEC"
Me.BTT_FEED_DELETE_SPEC.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_SPEC.Text = "Delete special feed..."
'
'BTT_FEED_DELETE_DAILY_LIST
'
Me.BTT_FEED_DELETE_DAILY_LIST.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_DAILY_LIST.Name = "BTT_FEED_DELETE_DAILY_LIST"
Me.BTT_FEED_DELETE_DAILY_LIST.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_DAILY_LIST.Text = "Delete daily feed (by list)"
'
'BTT_FEED_DELETE_DAILY_DATE
'
Me.BTT_FEED_DELETE_DAILY_DATE.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_DELETE_DAILY_DATE.Name = "BTT_FEED_DELETE_DAILY_DATE"
Me.BTT_FEED_DELETE_DAILY_DATE.Size = New System.Drawing.Size(267, 22)
Me.BTT_FEED_DELETE_DAILY_DATE.Text = "Delete daily feed (by date)"
'
'DownloadFeedForm 'DownloadFeedForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -218,5 +342,17 @@ Namespace DownloadObjects
Private WithEvents MENU_DOWN As ToolStripDropDownButton Private WithEvents MENU_DOWN As ToolStripDropDownButton
Private WithEvents BTT_DOWN_ALL As ToolStripMenuItem Private WithEvents BTT_DOWN_ALL As ToolStripMenuItem
Private WithEvents BTT_DOWN_SELECTED As ToolStripMenuItem Private WithEvents BTT_DOWN_SELECTED As ToolStripMenuItem
Private WithEvents BTT_LOAD_SESSION_CURRENT As ToolStripMenuItem
Private WithEvents BTT_FEED_ADD_FAV As ToolStripMenuItem
Private WithEvents BTT_FEED_REMOVE_FAV As ToolStripMenuItem
Private WithEvents BTT_FEED_ADD_SPEC As ToolStripMenuItem
Private WithEvents BTT_FEED_REMOVE_SPEC As ToolStripMenuItem
Private WithEvents BTT_LOAD_FAV As ToolStripMenuItem
Private WithEvents BTT_LOAD_SPEC As ToolStripMenuItem
Private WithEvents BTT_FEED_CLEAR_FAV As ToolStripMenuItem
Private WithEvents BTT_FEED_CLEAR_SPEC As ToolStripMenuItem
Private WithEvents BTT_FEED_DELETE_SPEC As ToolStripMenuItem
Private WithEvents BTT_FEED_DELETE_DAILY_LIST As ToolStripMenuItem
Private WithEvents BTT_FEED_DELETE_DAILY_DATE As ToolStripMenuItem
End Class End Class
End Namespace End Namespace

View File

@@ -135,7 +135,19 @@
MeQCkYEBAD3tUdo+/cEPAAAAAElFTkSuQmCC MeQCkYEBAD3tUdo+/cEPAAAAAElFTkSuQmCC
</value> </value>
</data> </data>
<metadata name="MENU_LOAD_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_LOAD_SEP_2.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_LOAD_SEP_3.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="ToolbarTOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> <metadata name="ToolbarTOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value> <value>17, 17</value>
</metadata> </metadata>
<metadata name="MENU_LOAD_SEP_4.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
</root> </root>

View File

@@ -13,6 +13,7 @@ Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports RCI = PersonalUtilities.Forms.Toolbars.RangeSwitcherToolbar.ControlItem Imports RCI = PersonalUtilities.Forms.Toolbars.RangeSwitcherToolbar.ControlItem
Imports UserMediaD = SCrawler.DownloadObjects.TDownloader.UserMediaD Imports UserMediaD = SCrawler.DownloadObjects.TDownloader.UserMediaD
Imports DTSModes = PersonalUtilities.Forms.DateTimeSelectionForm.Modes
Namespace DownloadObjects Namespace DownloadObjects
Friend Class DownloadFeedForm Friend Class DownloadFeedForm
#Region "Declarations" #Region "Declarations"
@@ -26,6 +27,8 @@ Namespace DownloadObjects
Private ReadOnly FilterSubscriptions As New FPredicate(Of UserMediaD)(Function(d) If(d.User?.IsSubscription, False)) Private ReadOnly FilterSubscriptions As New FPredicate(Of UserMediaD)(Function(d) If(d.User?.IsSubscription, False))
Private ReadOnly FilterUsers As New FPredicate(Of UserMediaD)(Function(d) Not FilterSubscriptions.Invoke(d)) Private ReadOnly FilterUsers As New FPredicate(Of UserMediaD)(Function(d) Not FilterSubscriptions.Invoke(d))
Private ReadOnly FileNotExist As New FPredicate(Of UserMediaD)(Function(d) Not d.Data.File.Exists And Not FilterSubscriptions.Invoke(d)) Private ReadOnly FileNotExist As New FPredicate(Of UserMediaD)(Function(d) Not d.Data.File.Exists And Not FilterSubscriptions.Invoke(d))
Private ReadOnly SessionDateStringProvider As New CustomProvider(Function(v As SFile) AConvert(Of String)(AConvert(Of Date)(v.Name, SessionDateTimeProvider, v.Name),
DateTimeDefaultProvider, v.Name))
Private BttRefreshToolTipText As String = "Refresh data list" Private BttRefreshToolTipText As String = "Refresh data list"
Private CenterImage As Boolean = False Private CenterImage As Boolean = False
Private NumberOfVisibleImages As Integer = 1 Private NumberOfVisibleImages As Integer = 1
@@ -66,6 +69,22 @@ Namespace DownloadObjects
End With End With
ToolbarTOP.Items.AddRange({New ToolStripSeparator, BTT_DELETE_SELECTED}) ToolbarTOP.Items.AddRange({New ToolStripSeparator, BTT_DELETE_SELECTED})
With Settings With Settings
With .Feeds
.Load()
AddHandler .FeedAdded, AddressOf Feed_FeedAdded
AddHandler .FeedRemoved, AddressOf Feed_FeedRemoved
If .Count > 0 Then
For Each feed As FeedSpecial In .Self
If Not feed.IsFavorite Then
AddNewFeedItem(BTT_LOAD_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD)
AddNewFeedItem(BTT_FEED_ADD_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD)
AddNewFeedItem(BTT_FEED_REMOVE_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_REMOVE)
AddNewFeedItem(BTT_FEED_DELETE_SPEC, feed, My.Resources.DeletePic_24, AddressOf Feed_SPEC_DELETE)
AddNewFeedItem(BTT_FEED_CLEAR_SPEC, feed, My.Resources.BrushToolPic_16, AddressOf Feed_SPEC_CLEAR)
End If
Next
End If
End With
If .FeedOpenLastMode Then If .FeedOpenLastMode Then
If .FeedLastModeSubscriptions Then OPT_SUBSCRIPTIONS.Checked = True Else OPT_DEFAULT.Checked = True If .FeedLastModeSubscriptions Then OPT_SUBSCRIPTIONS.Checked = True Else OPT_DEFAULT.Checked = True
Else Else
@@ -93,6 +112,94 @@ Namespace DownloadObjects
If e.KeyCode = Keys.F5 Then RefillList() : e.Handled = True If e.KeyCode = Keys.F5 Then RefillList() : e.Handled = True
End Sub End Sub
#End Region #End Region
#Region "Feeds handlers"
Private Overloads Sub AddNewFeedItem(ByVal Destination As ToolStripMenuItem, ByVal Feed As FeedSpecial, ByVal Image As Image,
ByVal Handler As EventHandler, Optional ByVal Insert As Boolean = False)
AddNewFeedItem(Destination, ToolbarTOP, Feed, Image, Handler, Insert)
End Sub
Friend Overloads Shared Function AddNewFeedItem(ByVal Destination As ToolStripMenuItem, ByVal Toolbar As ToolStrip,
ByVal Feed As FeedSpecial, ByVal Image As Image,
ByVal Handler As EventHandler, Optional ByVal Insert As Boolean = False) As ToolStripMenuItem
Dim item As New ToolStripMenuItem(Feed.Name, Image) With {.Tag = Feed}
If Not Handler Is Nothing Then AddHandler item.Click, Handler
ControlInvokeFast(Toolbar, Destination, Sub()
If Destination.DropDownItems.Count > 0 And Insert Then
Destination.DropDownItems.Insert(0, item)
Else
Destination.DropDownItems.Add(item)
End If
End Sub, EDP.None)
Return item
End Function
Private Sub Feed_FeedAdded(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial)
AddNewFeedItem(BTT_LOAD_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD, True)
AddNewFeedItem(BTT_FEED_ADD_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD, True)
AddNewFeedItem(BTT_FEED_REMOVE_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_REMOVE, True)
AddNewFeedItem(BTT_FEED_DELETE_SPEC, Feed, My.Resources.DeletePic_24, AddressOf Feed_SPEC_DELETE, True)
AddNewFeedItem(BTT_FEED_CLEAR_SPEC, Feed, My.Resources.BrushToolPic_16, AddressOf Feed_SPEC_CLEAR, True)
End Sub
Private Overloads Sub Feed_FeedRemoved(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial)
Feed_FeedRemoved(BTT_LOAD_SPEC, Feed)
Feed_FeedRemoved(BTT_FEED_ADD_SPEC, Feed)
Feed_FeedRemoved(BTT_FEED_REMOVE_SPEC, Feed)
Feed_FeedRemoved(BTT_FEED_DELETE_SPEC, Feed)
Feed_FeedRemoved(BTT_FEED_CLEAR_SPEC, Feed)
End Sub
Private Overloads Sub Feed_FeedRemoved(ByVal Destination As ToolStripMenuItem, ByVal Feed As FeedSpecial)
Feed_FeedRemoved(Destination, ToolbarTOP, Feed)
End Sub
Friend Overloads Shared Sub Feed_FeedRemoved(ByVal Destination As ToolStripMenuItem, ByVal Toolbar As ToolStrip, ByVal Feed As FeedSpecial)
Try
With Destination
ControlInvokeFast(Toolbar, .Self,
Sub()
If .DropDownItems.Count > 0 Then
Dim item As Object
For i% = .DropDownItems.Count - 1 To 0 Step -1
item = .DropDownItems(i)
If TypeOf item Is ToolStripMenuItem AndAlso Feed.Equals(DirectCast(item, ToolStripMenuItem).Tag) Then
With DirectCast(item, ToolStripMenuItem) : .Tag = Nothing : .Dispose() : End With
'.DropDownItems.RemoveAt(i)
End If
Next
End If
End Sub, EDP.None)
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Feed removed")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub Feed_SPEC_LOAD(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
Dim f As FeedSpecial = Source.Tag
If Not f Is Nothing AndAlso Not f.Disposed Then
DataList.Clear()
If f.Count > 0 Then DataList.ListAddList(f) : CleanDataList()
RefillList(False)
End If
End Sub
Private Sub Feed_SPEC_ADD(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
Dim f As FeedSpecial = Source.Tag
If Not f Is Nothing AndAlso Not f.Disposed Then f.Add(GetCheckedMedia())
End Sub
Private Sub Feed_SPEC_CLEAR(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
Dim f As FeedSpecial = Source.Tag
If Not f Is Nothing AndAlso Not f.Disposed Then
If MsgBoxE({$"Are you sure you want to clear the '{f.Name}' feed?", "Clear feed"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then f.Clear()
End If
End Sub
Private Sub Feed_SPEC_REMOVE(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
Dim f As FeedSpecial = Source.Tag
If Not f Is Nothing AndAlso Not f.Disposed Then f.Remove(GetCheckedMedia())
End Sub
Private Sub Feed_SPEC_DELETE(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
Dim f As FeedSpecial = Source.Tag
If Not f Is Nothing AndAlso Not f.Disposed Then
If MsgBoxE({$"Are you sure you want to delete the '{f.Name}' feed?", "Delete feed"}, vbExclamation,,, {"Process", "Cancel"}) = 0 AndAlso
f.Delete() Then Feed_FeedRemoved(Settings.Feeds, f)
End If
End Sub
#End Region
#Region "Settings" #Region "Settings"
Friend Sub UpdateSettings() Friend Sub UpdateSettings()
With Settings With Settings
@@ -151,13 +258,6 @@ Namespace DownloadObjects
End Sub End Sub
#End Region #End Region
#Region "Refill" #Region "Refill"
Friend Sub Downloader_FilesChanged(ByVal Added As Boolean)
ControlInvokeFast(ToolbarTOP, BTT_REFRESH, Sub() BTT_REFRESH.ToolTipText = If(Added, "New files found", "Some files have been removed"))
BTT_REFRESH.ControlChangeColor(ToolbarTOP, Added, False)
End Sub
Private Sub BTT_REFRESH_Click(sender As Object, e As EventArgs) Handles BTT_REFRESH.Click
RefillList()
End Sub
Private Sub RefillList(Optional ByVal RefillDataList As Boolean = True) Private Sub RefillList(Optional ByVal RefillDataList As Boolean = True)
DataPopulated = False DataPopulated = False
If RefillDataList Then If RefillDataList Then
@@ -176,9 +276,21 @@ Namespace DownloadObjects
MyRange_IndexChanged(MyRange, Nothing) MyRange_IndexChanged(MyRange, Nothing)
End If End If
End Sub End Sub
Private Sub BTT_CLEAR_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR.Click Private Sub CleanDataList()
Downloader.Files.Clear() If DataList.Count > 0 Then
ClearTable() If IsSubscription Then
DataList.RemoveAll(FilterUsers)
Else
DataList.RemoveAll(FilterSubscriptions)
DataList.RemoveAll(FileNotExist)
End If
End If
End Sub
#End Region
#Region "Toolbar controls"
#Region "Feed"
#Region "Load"
Private Sub BTT_LOAD_SESSION_CURRENT_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CURRENT.Click
RefillList() RefillList()
End Sub End Sub
Private Sub BTT_LOAD_SESSION_LAST_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_LAST.Click Private Sub BTT_LOAD_SESSION_LAST_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_LAST.Click
@@ -187,33 +299,42 @@ Namespace DownloadObjects
Private Sub BTT_LOAD_SESSION_CHOOSE_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CHOOSE.Click Private Sub BTT_LOAD_SESSION_CHOOSE_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CHOOSE.Click
SessionChooser(False) SessionChooser(False)
End Sub End Sub
Private Sub SessionChooser(ByVal GetLast As Boolean) Private Sub SessionChooser(ByVal GetLast As Boolean, Optional ByVal GetFilesOnly As Boolean = False,
Optional ByRef ResultFilesList As List(Of SFile) = Nothing)
Try Try
Downloader.ClearSessions()
Dim f As SFile = TDownloader.SessionsPath.CSFileP Dim f As SFile = TDownloader.SessionsPath.CSFileP
Dim fList As List(Of SFile) = Nothing Dim fList As List(Of SFile) = Nothing
Dim m As New MMessage("Saved sessions not selected", "Sessions",, vbExclamation) Dim m As New MMessage("Saved sessions not selected", "Sessions",, vbExclamation)
Dim x As XmlFile Dim x As XmlFile
Dim lcr As New ListAddParams(LAP.NotContainsOnly + LAP.IgnoreICopier) Dim lcr As New ListAddParams(LAP.NotContainsOnly + LAP.IgnoreICopier)
Dim __clearList As Action = Sub() Dim __getFiles As Func(Of Boolean) = Function() As Boolean
If IsSubscription Then If f.Exists(SFO.Path, False) Then fList = SFile.GetFiles(f, "*.xml",, EDP.ReturnValue)
DataList.RemoveAll(FilterUsers) If fList.ListExists Then fList.RemoveAll(Settings.Feeds.FeedSpecialRemover)
If fList.ListExists Then
fList.Reverse()
Return True
Else Else
DataList.RemoveAll(FilterSubscriptions) Return False
DataList.RemoveAll(FileNotExist)
End If End If
End Sub End Function
If Not GetLast AndAlso f.Exists(SFO.Path, False) Then fList = SFile.GetFiles(f, "*.xml",, EDP.ReturnValue) If Not GetLast Then __getFiles.Invoke
If Not GetLast AndAlso fList.ListExists Then If Not GetLast And GetFilesOnly And Not fList.ListExists Then
MsgBoxE({"No session files found", "Get session files"}, vbExclamation)
ElseIf Not GetLast AndAlso fList.ListExists Then
Using chooser As New SimpleListForm(Of SFile)(fList, Settings.Design) With { Using chooser As New SimpleListForm(Of SFile)(fList, Settings.Design) With {
.FormText = "Sessions", .FormText = "Sessions",
.Icon = My.Resources.ArrowDownIcon_Blue_24, .Icon = My.Resources.ArrowDownIcon_Blue_24,
.Mode = SimpleListFormModes.CheckedItems, .Mode = SimpleListFormModes.CheckedItems,
.Provider = New CustomProvider(Function(v, d, p, n, ee) DirectCast(v, SFile).File) .Provider = SessionDateStringProvider
} }
chooser.ClearButtons() chooser.ClearButtons()
If chooser.ShowDialog = DialogResult.OK Then If chooser.ShowDialog = DialogResult.OK Then
fList = chooser.DataResult fList = chooser.DataResult
If fList.ListExists Then If fList.ListExists Then
If GetFilesOnly Then
ResultFilesList.AddRange(fList)
Else
DataList.Clear() DataList.Clear()
For Each f In fList For Each f In fList
x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True} x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
@@ -221,8 +342,9 @@ Namespace DownloadObjects
If x.Count > 0 Then DataList.ListAddList(x, lcr) If x.Count > 0 Then DataList.ListAddList(x, lcr)
x.Dispose() x.Dispose()
Next Next
__clearList.Invoke CleanDataList()
RefillList(False) RefillList(False)
End If
Else Else
MsgBoxE(m) MsgBoxE(m)
End If End If
@@ -230,12 +352,17 @@ Namespace DownloadObjects
MsgBoxE(m) MsgBoxE(m)
End If End If
End Using End Using
ElseIf Downloader.FilesSessionActual.Exists Then ElseIf Downloader.FilesSessionActual(False).Exists OrElse __getFiles.Invoke Then
x = New XmlFile(Downloader.FilesSessionActual,, False) With {.AllowSameNames = True, .XmlReadOnly = True} If Downloader.FilesSessionActual(False).Exists Then
f = Downloader.FilesSessionActual(False)
Else
f = fList(0)
End If
x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData() x.LoadData()
If x.Count > 0 Then DataList.Clear() : DataList.ListAddList(x, lcr) If x.Count > 0 Then DataList.Clear() : DataList.ListAddList(x, lcr)
x.Dispose() x.Dispose()
__clearList.Invoke CleanDataList()
RefillList(False) RefillList(False)
Else Else
m.Text = "Saved sessions not found" m.Text = "Saved sessions not found"
@@ -246,6 +373,147 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"[DownloadObjects.DownloadFeedForm.SessionChooser({GetLast})]") ErrorsDescriber.Execute(EDP.SendToLog, ex, $"[DownloadObjects.DownloadFeedForm.SessionChooser({GetLast})]")
End Try End Try
End Sub End Sub
#End Region
#Region "Load fav, spec"
Private Sub BTT_LOAD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_FAV.Click
DataList.Clear()
With Settings.Feeds.Favorite
.RemoveNotExist(FileNotExist)
If .Count > 0 Then DataList.AddRange(.Self) : CleanDataList() : RefillList(False)
End With
End Sub
Private Sub BTT_LOAD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SPEC.Click
With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then
DataList.Clear()
Dim d As New List(Of UserMediaD)
.ForEach(Sub(ByVal f As FeedSpecial)
f.RemoveNotExist(FileNotExist)
If f.Count > 0 Then d.AddRange(f)
End Sub)
If d.Count > 0 Then DataList.ListAddList(d.Distinct)
CleanDataList()
RefillList(False)
End If
End With
End Sub
#End Region
#Region "Add remove fav spec"
Private Sub BTT_FEED_ADD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_FAV.Click
Settings.Feeds.Favorite.Add(GetCheckedMedia())
End Sub
Private Sub BTT_FEED_REMOVE_FAV_Click(sender As Object, e As EventArgs) Handles BTT_FEED_REMOVE_FAV.Click
Settings.Feeds.Favorite.Remove(GetCheckedMedia())
End Sub
Private Sub BTT_FEED_ADD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_SPEC.Click
Dim c As IEnumerable(Of UserMediaD) = GetCheckedMedia()
If c.ListExists Then
With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then .ForEach(Sub(f) f.Add(c))
End With
Else
MsgBoxE({"You haven't selected media to add to your feed(s)", "Add to feed(s)"}, vbExclamation)
End If
End Sub
Private Sub BTT_FEED_REMOVE_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_REMOVE_SPEC.Click
Dim c As IEnumerable(Of UserMediaD) = GetCheckedMedia()
If c.ListExists Then
With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then .ForEach(Sub(f) f.Remove(c))
End With
Else
MsgBoxE({"You haven't selected media to remove from your feed(s)", "Remove from feed(s)"}, vbExclamation)
End If
End Sub
Private Function GetCheckedMedia() As IEnumerable(Of UserMediaD)
Return ControlInvoke(Of IEnumerable(Of UserMediaD))(TP_DATA,
Function() As IEnumerable(Of UserMediaD)
If TP_DATA.Controls.Count > 0 Then
Return (From cnt As FeedMedia In TP_DATA.Controls Where cnt.Checked Select cnt.Media)
Else
Return New UserMediaD() {}
End If
End Function, New UserMediaD() {}, EDP.ReturnValue)
End Function
#End Region
#Region "Clear delete"
Private Sub BTT_FEED_CLEAR_FAV_Click(sender As Object, e As EventArgs) Handles BTT_FEED_CLEAR_FAV.Click
If MsgBoxE({"Are you sure you want to clear your Favorite feed?", "Clear feed"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then _
Settings.Feeds.Favorite.Delete()
End Sub
Private Sub BTT_FEED_CLEAR_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_CLEAR_SPEC.Click
With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then
If MsgBoxE({$"Are you sure you want to clear the following feeds?{vbCr}{vbCr}{ .ListToString(vbCr)}", "Clear feed"}, vbExclamation,,,
{"Process", "Cancel"}) = 0 Then .ForEach(Sub(f) f.Clear())
End If
End With
End Sub
Private Sub BTT_FEED_DELETE_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_DELETE_SPEC.Click
With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then
If MsgBoxE({$"Are you sure you want to delete the following feeds?{vbCr}{vbCr}{ .ListToString(vbCr)}", "Delete feed"}, vbExclamation,,,
{"Process", "Cancel"}) = 0 Then .ForEach(Sub(f) f.Delete())
End If
End With
End Sub
Private Sub BTT_FEED_DELETE_DAILY_LIST_Click(sender As Object, e As EventArgs) Handles BTT_FEED_DELETE_DAILY_LIST.Click
Try
Dim l As New List(Of SFile)
SessionChooser(False, True, l)
If l.Count > 0 Then
If MsgBoxE({$"Are you sure you want to delete the following sessions?{vbCr}{vbCr}{l.ListToStringE(vbCr, SessionDateStringProvider)}", "Delete session"}, vbExclamation,,,
{"Process", "Cancel"}) = 0 Then
l.ForEach(Sub(f) f.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.None))
MsgBoxE({"Sessions have been deleted", "Delete session"})
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Delete daily sessions (by list)")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub BTT_FEED_DELETE_DAILY_DATE_Click(sender As Object, e As EventArgs) Handles BTT_FEED_DELETE_DAILY_DATE.Click
Try
Using f As New DateTimeSelectionForm(DTSModes.CheckBoxes + DTSModes.Date + DTSModes.Start + DTSModes.End, Settings.Design) With {
.DesignXMLNodeName = "SessionRemoverDateTimeForm"
}
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
Dim _dStart As Date? = f.MyDateStart
Dim _dEnd As Date? = f.MyDateEnd
If _dStart.HasValue Or _dEnd.HasValue Then
Dim dStart As Date = If(_dStart, Date.MinValue)
dStart = dStart.Date
Dim dEnd As Date = If(_dEnd, Date.MaxValue)
dEnd = dEnd.Date
Dim filesDir As SFile = TDownloader.SessionsPath.CSFileP
If filesDir.Exists(SFO.Path, False) Then
Dim files As List(Of SFile) = SFile.GetFiles(filesDir, "*.xml",, EDP.ReturnValue)
If files.ListExists Then files.RemoveAll(Settings.Feeds.FeedSpecialRemover)
If files.ListExists Then
Dim fd As IEnumerable(Of KeyValuePair(Of SFile, Date?)) =
files.Select(Function(ff) New KeyValuePair(Of SFile, Date?)(
ff, AConvert(Of Date)(ff.Name, SessionDateTimeProvider, AModes.Var, Nothing)))
If fd.ListExists Then
For Each optFile As KeyValuePair(Of SFile, Date?) In fd
If optFile.Value.HasValue AndAlso optFile.Value.Value.ValueBetween(dStart, dEnd) Then _
optFile.Key.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.None)
Next
End If
End If
End If
End If
End If
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Delete daily sessions (by date)")
MainFrameObj.UpdateLogButton()
End Try
End Sub
#End Region
#End Region
#Region "View modes"
Private Sub OPT_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_DEFAULT.Click, OPT_SUBSCRIPTIONS.Click Private Sub OPT_Click(ByVal Sender As ToolStripMenuItem, ByVal e As EventArgs) Handles OPT_DEFAULT.Click, OPT_SUBSCRIPTIONS.Click
Dim __refill As Boolean = False Dim __refill As Boolean = False
ControlInvokeFast(ToolbarTOP, Sender, ControlInvokeFast(ToolbarTOP, Sender,
@@ -264,6 +532,19 @@ Namespace DownloadObjects
End Sub, EDP.None) End Sub, EDP.None)
If __refill Then RefillList() If __refill Then RefillList()
End Sub End Sub
#End Region
Friend Sub Downloader_FilesChanged(ByVal Added As Boolean)
ControlInvokeFast(ToolbarTOP, BTT_REFRESH, Sub() BTT_REFRESH.ToolTipText = If(Added, "New files found", "Some files have been removed"))
BTT_REFRESH.ControlChangeColor(ToolbarTOP, Added, False)
End Sub
Private Sub BTT_REFRESH_Click(sender As Object, e As EventArgs) Handles BTT_REFRESH.Click
RefillList()
End Sub
Private Sub BTT_CLEAR_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR.Click
Downloader.Files.Clear()
ClearTable()
RefillList()
End Sub
#End Region #End Region
#Region "Download" #Region "Download"
Private Sub FeedMedia_Download(ByVal Sender As Object, ByVal e As EventArgs) Handles BTT_DOWN_ALL.Click, BTT_DOWN_SELECTED.Click Private Sub FeedMedia_Download(ByVal Sender As Object, ByVal e As EventArgs) Handles BTT_DOWN_ALL.Click, BTT_DOWN_SELECTED.Click
@@ -623,6 +904,9 @@ Namespace DownloadObjects
If TP_DATA.Controls.Count > 0 Then If TP_DATA.Controls.Count > 0 Then
For Each cnt As Control In TP_DATA.Controls : cnt.Dispose() : Next For Each cnt As Control In TP_DATA.Controls : cnt.Dispose() : Next
TP_DATA.Controls.Clear() TP_DATA.Controls.Clear()
GC.Collect()
GC.WaitForPendingFinalizers()
GC.WaitForFullGCComplete()
End If End If
End Sub) End Sub)
End Sub End Sub

View File

@@ -42,6 +42,11 @@ Namespace DownloadObjects
Me.ICON_SITE = New System.Windows.Forms.PictureBox() Me.ICON_SITE = New System.Windows.Forms.PictureBox()
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel() Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
Me.LBL_TITLE = New System.Windows.Forms.Label() Me.LBL_TITLE = New System.Windows.Forms.Label()
Me.CONTEXT_SEP_4 = New System.Windows.Forms.ToolStripSeparator()
Me.BTT_FEED_ADD_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_ADD_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_REMOVE_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_REMOVE_SPEC = New System.Windows.Forms.ToolStripMenuItem()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator() CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_2 = New System.Windows.Forms.ToolStripSeparator() CONTEXT_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
TP_LBL = New System.Windows.Forms.TableLayoutPanel() TP_LBL = New System.Windows.Forms.TableLayoutPanel()
@@ -54,12 +59,12 @@ Namespace DownloadObjects
'CONTEXT_SEP_1 'CONTEXT_SEP_1
' '
CONTEXT_SEP_1.Name = "CONTEXT_SEP_1" CONTEXT_SEP_1.Name = "CONTEXT_SEP_1"
CONTEXT_SEP_1.Size = New System.Drawing.Size(134, 6) CONTEXT_SEP_1.Size = New System.Drawing.Size(217, 6)
' '
'CONTEXT_SEP_2 'CONTEXT_SEP_2
' '
CONTEXT_SEP_2.Name = "CONTEXT_SEP_2" CONTEXT_SEP_2.Name = "CONTEXT_SEP_2"
CONTEXT_SEP_2.Size = New System.Drawing.Size(134, 6) CONTEXT_SEP_2.Size = New System.Drawing.Size(217, 6)
' '
'TP_LBL 'TP_LBL
' '
@@ -103,76 +108,76 @@ Namespace DownloadObjects
' '
'CONTEXT_DATA 'CONTEXT_DATA
' '
Me.CONTEXT_DATA.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_CONTEXT_DOWN, Me.CONTEXT_SEP_0, Me.BTT_CONTEXT_OPEN_MEDIA, Me.BTT_CONTEXT_OPEN_USER, CONTEXT_SEP_1, Me.BTT_CONTEXT_OPEN_USER_URL, Me.BTT_CONTEXT_OPEN_USER_POST, CONTEXT_SEP_2, Me.BTT_CONTEXT_FIND_USER, Me.BTT_CONTEXT_INFO, Me.CONTEXT_SEP_3, Me.BTT_CONTEXT_DELETE}) Me.CONTEXT_DATA.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_CONTEXT_DOWN, Me.CONTEXT_SEP_0, Me.BTT_CONTEXT_OPEN_MEDIA, Me.BTT_CONTEXT_OPEN_USER, CONTEXT_SEP_1, Me.BTT_CONTEXT_OPEN_USER_URL, Me.BTT_CONTEXT_OPEN_USER_POST, CONTEXT_SEP_2, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_REMOVE_FAV, Me.BTT_FEED_REMOVE_SPEC, Me.CONTEXT_SEP_3, Me.BTT_CONTEXT_FIND_USER, Me.BTT_CONTEXT_INFO, Me.CONTEXT_SEP_4, Me.BTT_CONTEXT_DELETE})
Me.CONTEXT_DATA.Name = "CONTEXT_PIC" Me.CONTEXT_DATA.Name = "CONTEXT_PIC"
Me.CONTEXT_DATA.Size = New System.Drawing.Size(138, 204) Me.CONTEXT_DATA.Size = New System.Drawing.Size(221, 320)
' '
'BTT_CONTEXT_DOWN 'BTT_CONTEXT_DOWN
' '
Me.BTT_CONTEXT_DOWN.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16 Me.BTT_CONTEXT_DOWN.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_CONTEXT_DOWN.Name = "BTT_CONTEXT_DOWN" Me.BTT_CONTEXT_DOWN.Name = "BTT_CONTEXT_DOWN"
Me.BTT_CONTEXT_DOWN.Size = New System.Drawing.Size(137, 22) Me.BTT_CONTEXT_DOWN.Size = New System.Drawing.Size(220, 22)
Me.BTT_CONTEXT_DOWN.Text = "Download" Me.BTT_CONTEXT_DOWN.Text = "Download"
Me.BTT_CONTEXT_DOWN.Visible = False Me.BTT_CONTEXT_DOWN.Visible = False
' '
'CONTEXT_SEP_0 'CONTEXT_SEP_0
' '
Me.CONTEXT_SEP_0.Name = "CONTEXT_SEP_0" Me.CONTEXT_SEP_0.Name = "CONTEXT_SEP_0"
Me.CONTEXT_SEP_0.Size = New System.Drawing.Size(134, 6) Me.CONTEXT_SEP_0.Size = New System.Drawing.Size(217, 6)
Me.CONTEXT_SEP_0.Visible = False Me.CONTEXT_SEP_0.Visible = False
' '
'BTT_CONTEXT_OPEN_MEDIA 'BTT_CONTEXT_OPEN_MEDIA
' '
Me.BTT_CONTEXT_OPEN_MEDIA.Image = Global.SCrawler.My.Resources.Resources.FolderPic_32 Me.BTT_CONTEXT_OPEN_MEDIA.Image = Global.SCrawler.My.Resources.Resources.FolderPic_32
Me.BTT_CONTEXT_OPEN_MEDIA.Name = "BTT_CONTEXT_OPEN_MEDIA" Me.BTT_CONTEXT_OPEN_MEDIA.Name = "BTT_CONTEXT_OPEN_MEDIA"
Me.BTT_CONTEXT_OPEN_MEDIA.Size = New System.Drawing.Size(137, 22) Me.BTT_CONTEXT_OPEN_MEDIA.Size = New System.Drawing.Size(220, 22)
Me.BTT_CONTEXT_OPEN_MEDIA.Text = "Open" Me.BTT_CONTEXT_OPEN_MEDIA.Text = "Open"
' '
'BTT_CONTEXT_OPEN_USER 'BTT_CONTEXT_OPEN_USER
' '
Me.BTT_CONTEXT_OPEN_USER.Image = Global.SCrawler.My.Resources.Resources.FolderPic_32 Me.BTT_CONTEXT_OPEN_USER.Image = Global.SCrawler.My.Resources.Resources.FolderPic_32
Me.BTT_CONTEXT_OPEN_USER.Name = "BTT_CONTEXT_OPEN_USER" Me.BTT_CONTEXT_OPEN_USER.Name = "BTT_CONTEXT_OPEN_USER"
Me.BTT_CONTEXT_OPEN_USER.Size = New System.Drawing.Size(137, 22) Me.BTT_CONTEXT_OPEN_USER.Size = New System.Drawing.Size(220, 22)
Me.BTT_CONTEXT_OPEN_USER.Text = "Open user" Me.BTT_CONTEXT_OPEN_USER.Text = "Open user"
' '
'BTT_CONTEXT_OPEN_USER_URL 'BTT_CONTEXT_OPEN_USER_URL
' '
Me.BTT_CONTEXT_OPEN_USER_URL.Image = Global.SCrawler.My.Resources.Resources.GlobePic_32 Me.BTT_CONTEXT_OPEN_USER_URL.Image = Global.SCrawler.My.Resources.Resources.GlobePic_32
Me.BTT_CONTEXT_OPEN_USER_URL.Name = "BTT_CONTEXT_OPEN_USER_URL" Me.BTT_CONTEXT_OPEN_USER_URL.Name = "BTT_CONTEXT_OPEN_USER_URL"
Me.BTT_CONTEXT_OPEN_USER_URL.Size = New System.Drawing.Size(137, 22) Me.BTT_CONTEXT_OPEN_USER_URL.Size = New System.Drawing.Size(220, 22)
Me.BTT_CONTEXT_OPEN_USER_URL.Text = "Open user" Me.BTT_CONTEXT_OPEN_USER_URL.Text = "Open user"
' '
'BTT_CONTEXT_OPEN_USER_POST 'BTT_CONTEXT_OPEN_USER_POST
' '
Me.BTT_CONTEXT_OPEN_USER_POST.Image = Global.SCrawler.My.Resources.Resources.GlobePic_32 Me.BTT_CONTEXT_OPEN_USER_POST.Image = Global.SCrawler.My.Resources.Resources.GlobePic_32
Me.BTT_CONTEXT_OPEN_USER_POST.Name = "BTT_CONTEXT_OPEN_USER_POST" Me.BTT_CONTEXT_OPEN_USER_POST.Name = "BTT_CONTEXT_OPEN_USER_POST"
Me.BTT_CONTEXT_OPEN_USER_POST.Size = New System.Drawing.Size(137, 22) Me.BTT_CONTEXT_OPEN_USER_POST.Size = New System.Drawing.Size(220, 22)
Me.BTT_CONTEXT_OPEN_USER_POST.Text = "Open post" Me.BTT_CONTEXT_OPEN_USER_POST.Text = "Open post"
' '
'BTT_CONTEXT_FIND_USER 'BTT_CONTEXT_FIND_USER
' '
Me.BTT_CONTEXT_FIND_USER.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32 Me.BTT_CONTEXT_FIND_USER.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.BTT_CONTEXT_FIND_USER.Name = "BTT_CONTEXT_FIND_USER" Me.BTT_CONTEXT_FIND_USER.Name = "BTT_CONTEXT_FIND_USER"
Me.BTT_CONTEXT_FIND_USER.Size = New System.Drawing.Size(137, 22) Me.BTT_CONTEXT_FIND_USER.Size = New System.Drawing.Size(220, 22)
Me.BTT_CONTEXT_FIND_USER.Text = "Find user" Me.BTT_CONTEXT_FIND_USER.Text = "Find user"
' '
'BTT_CONTEXT_INFO 'BTT_CONTEXT_INFO
' '
Me.BTT_CONTEXT_INFO.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32 Me.BTT_CONTEXT_INFO.Image = Global.SCrawler.My.Resources.Resources.InfoPic_32
Me.BTT_CONTEXT_INFO.Name = "BTT_CONTEXT_INFO" Me.BTT_CONTEXT_INFO.Name = "BTT_CONTEXT_INFO"
Me.BTT_CONTEXT_INFO.Size = New System.Drawing.Size(137, 22) Me.BTT_CONTEXT_INFO.Size = New System.Drawing.Size(220, 22)
Me.BTT_CONTEXT_INFO.Text = "Information" Me.BTT_CONTEXT_INFO.Text = "Information"
' '
'CONTEXT_SEP_3 'CONTEXT_SEP_3
' '
Me.CONTEXT_SEP_3.Name = "CONTEXT_SEP_3" Me.CONTEXT_SEP_3.Name = "CONTEXT_SEP_3"
Me.CONTEXT_SEP_3.Size = New System.Drawing.Size(134, 6) Me.CONTEXT_SEP_3.Size = New System.Drawing.Size(217, 6)
' '
'BTT_CONTEXT_DELETE 'BTT_CONTEXT_DELETE
' '
Me.BTT_CONTEXT_DELETE.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24 Me.BTT_CONTEXT_DELETE.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_CONTEXT_DELETE.Name = "BTT_CONTEXT_DELETE" Me.BTT_CONTEXT_DELETE.Name = "BTT_CONTEXT_DELETE"
Me.BTT_CONTEXT_DELETE.Size = New System.Drawing.Size(137, 22) Me.BTT_CONTEXT_DELETE.Size = New System.Drawing.Size(220, 22)
Me.BTT_CONTEXT_DELETE.Text = "Delete" Me.BTT_CONTEXT_DELETE.Text = "Delete"
' '
'ICON_SITE 'ICON_SITE
@@ -212,6 +217,39 @@ Namespace DownloadObjects
Me.LBL_TITLE.Size = New System.Drawing.Size(140, 25) Me.LBL_TITLE.Size = New System.Drawing.Size(140, 25)
Me.LBL_TITLE.TabIndex = 1 Me.LBL_TITLE.TabIndex = 1
' '
'CONTEXT_SEP_4
'
Me.CONTEXT_SEP_4.Name = "CONTEXT_SEP_4"
Me.CONTEXT_SEP_4.Size = New System.Drawing.Size(217, 6)
'
'BTT_FEED_ADD_FAV
'
Me.BTT_FEED_ADD_FAV.Image = Global.SCrawler.My.Resources.Resources.HeartPic_32
Me.BTT_FEED_ADD_FAV.Name = "BTT_FEED_ADD_FAV"
Me.BTT_FEED_ADD_FAV.Size = New System.Drawing.Size(220, 22)
Me.BTT_FEED_ADD_FAV.Text = "Add to Favorite"
'
'BTT_FEED_ADD_SPEC
'
Me.BTT_FEED_ADD_SPEC.Image = Global.SCrawler.My.Resources.Resources.RSSPic_512
Me.BTT_FEED_ADD_SPEC.Name = "BTT_FEED_ADD_SPEC"
Me.BTT_FEED_ADD_SPEC.Size = New System.Drawing.Size(220, 22)
Me.BTT_FEED_ADD_SPEC.Text = "Add to special feed..."
'
'BTT_FEED_REMOVE_FAV
'
Me.BTT_FEED_REMOVE_FAV.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_REMOVE_FAV.Name = "BTT_FEED_REMOVE_FAV"
Me.BTT_FEED_REMOVE_FAV.Size = New System.Drawing.Size(220, 22)
Me.BTT_FEED_REMOVE_FAV.Text = "Remove from Favorite"
'
'BTT_FEED_REMOVE_SPEC
'
Me.BTT_FEED_REMOVE_SPEC.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_FEED_REMOVE_SPEC.Name = "BTT_FEED_REMOVE_SPEC"
Me.BTT_FEED_REMOVE_SPEC.Size = New System.Drawing.Size(220, 22)
Me.BTT_FEED_REMOVE_SPEC.Text = "Remove from special feed..."
'
'FeedMedia 'FeedMedia
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -249,5 +287,10 @@ Namespace DownloadObjects
Private WithEvents BTT_CONTEXT_DOWN As ToolStripMenuItem Private WithEvents BTT_CONTEXT_DOWN As ToolStripMenuItem
Private WithEvents CONTEXT_SEP_0 As ToolStripSeparator Private WithEvents CONTEXT_SEP_0 As ToolStripSeparator
Private WithEvents LBL_TITLE As Label Private WithEvents LBL_TITLE As Label
Private WithEvents BTT_FEED_ADD_FAV As ToolStripMenuItem
Private WithEvents BTT_FEED_ADD_SPEC As ToolStripMenuItem
Private WithEvents BTT_FEED_REMOVE_FAV As ToolStripMenuItem
Private WithEvents BTT_FEED_REMOVE_SPEC As ToolStripMenuItem
Private WithEvents CONTEXT_SEP_4 As ToolStripSeparator
End Class End Class
End Namespace End Namespace

View File

@@ -61,6 +61,7 @@ Namespace DownloadObjects
End Property End Property
Private ReadOnly UserKey As String Private ReadOnly UserKey As String
Friend ReadOnly Post As UserMedia Friend ReadOnly Post As UserMedia
Friend ReadOnly Media As UserMediaD
Friend Property Checked As Boolean Friend Property Checked As Boolean
Get Get
Return CH_CHECKED.Checked Return CH_CHECKED.Checked
@@ -161,6 +162,7 @@ Namespace DownloadObjects
Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Height As Integer) Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Height As Integer)
Try Try
InitializeComponent() InitializeComponent()
Me.Media = Media
IsSubscription = If(Media.User?.IsSubscription, False) IsSubscription = If(Media.User?.IsSubscription, False)
If IsSubscription Then If IsSubscription Then
@@ -174,7 +176,7 @@ Namespace DownloadObjects
BTT_CONTEXT_DOWN.Visible = True BTT_CONTEXT_DOWN.Visible = True
CONTEXT_SEP_0.Visible = True CONTEXT_SEP_0.Visible = True
BTT_CONTEXT_OPEN_USER.Visible = False BTT_CONTEXT_OPEN_USER.Visible = False
CONTEXT_SEP_3.Visible = False CONTEXT_SEP_4.Visible = False
BTT_CONTEXT_DELETE.Visible = False BTT_CONTEXT_DELETE.Visible = False
If Not Media.Data.URL.IsEmptyString Then If Not Media.Data.URL.IsEmptyString Then
@@ -297,6 +299,22 @@ Namespace DownloadObjects
Else Else
Throw New ArgumentNullException With {.HelpLink = 1} Throw New ArgumentNullException With {.HelpLink = 1}
End If End If
If Settings.Feeds.FavoriteExists AndAlso Settings.Feeds.Favorite.Contains(Media) Then BTT_FEED_ADD_FAV.ControlChangeColor(True, False)
If Settings.FeedShowSpecialFeedsMediaItem Then
With Settings.Feeds
AddHandler .FeedAdded, AddressOf Feed_FeedAdded
AddHandler .FeedRemoved, AddressOf Feed_FeedRemoved
If .Count > 0 Then
For Each fItem As FeedSpecial In .Self
If Not fItem.IsFavorite Then
DownloadFeedForm.AddNewFeedItem(BTT_FEED_ADD_SPEC, CONTEXT_DATA, fItem, Nothing, AddressOf Feed_SPEC_ADD)
DownloadFeedForm.AddNewFeedItem(BTT_FEED_REMOVE_SPEC, CONTEXT_DATA, fItem, Nothing, AddressOf Feed_SPEC_REMOVE)
End If
Next
End If
End With
End If
Catch aex As ArgumentNullException When aex.HelpLink = 1 Catch aex As ArgumentNullException When aex.HelpLink = 1
HasError = True HasError = True
Catch tex As Threading.ThreadStateException Catch tex As Threading.ThreadStateException
@@ -307,11 +325,38 @@ Namespace DownloadObjects
End Try End Try
End Sub End Sub
#End Region #End Region
#Region "Feed handlers"
Private Sub Feed_FeedAdded(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial)
DownloadFeedForm.AddNewFeedItem(BTT_FEED_ADD_SPEC, CONTEXT_DATA, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD, True)
DownloadFeedForm.AddNewFeedItem(BTT_FEED_REMOVE_SPEC, CONTEXT_DATA, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_REMOVE, True)
End Sub
Private Sub Feed_FeedRemoved(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial)
DownloadFeedForm.Feed_FeedRemoved(BTT_FEED_ADD_SPEC, CONTEXT_DATA, Feed)
DownloadFeedForm.Feed_FeedRemoved(BTT_FEED_REMOVE_SPEC, CONTEXT_DATA, Feed)
End Sub
Private Sub Feed_SPEC_ADD(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
Dim f As FeedSpecial = Source.Tag
If Not f Is Nothing AndAlso Not f.Disposed Then f.Add(Media)
End Sub
Private Sub Feed_SPEC_REMOVE(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
Dim f As FeedSpecial = Source.Tag
If Not f Is Nothing AndAlso Not f.Disposed Then f.Remove(Media)
End Sub
#End Region
#Region "Dispose" #Region "Dispose"
Private Sub FeedImage_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed Private Sub FeedImage_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
If Not MyImage Is Nothing Then MyImage.Dispose() If Not MyImage Is Nothing Then MyImage.Dispose()
If Not MyPicture Is Nothing Then MyPicture.Dispose() If Not MyPicture Is Nothing Then MyPicture.Dispose() : MyPicture = Nothing
If Not MyVideo Is Nothing Then MyVideo.Dispose() If Not MyVideo Is Nothing Then MyVideo.Dispose()
Try
If Settings.FeedShowSpecialFeedsMediaItem Then
With Settings.Feeds
RemoveHandler .FeedAdded, AddressOf Feed_FeedAdded
RemoveHandler .FeedRemoved, AddressOf Feed_FeedRemoved
End With
End If
Catch
End Try
End Sub End Sub
#End Region #End Region
#Region "LBL" #Region "LBL"
@@ -336,9 +381,12 @@ Namespace DownloadObjects
End Sub End Sub
#End Region #End Region
#Region "Context" #Region "Context"
#Region "Down"
Private Sub BTT_CONTEXT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DOWN.Click Private Sub BTT_CONTEXT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DOWN.Click
RaiseEvent MediaDownload(Me, EventArgs.Empty) RaiseEvent MediaDownload(Me, EventArgs.Empty)
End Sub End Sub
#End Region
#Region "Open media, folder"
Private Sub BTT_CONTEXT_OPEN_MEDIA_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_MEDIA.Click Private Sub BTT_CONTEXT_OPEN_MEDIA_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_MEDIA.Click
File.Open() File.Open()
End Sub End Sub
@@ -348,6 +396,8 @@ Namespace DownloadObjects
If Not u Is Nothing Then u.OpenFolder() If Not u Is Nothing Then u.OpenFolder()
End If End If
End Sub End Sub
#End Region
#Region "Open URL"
Private Sub BTT_CONTEXT_OPEN_USER_URL_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_USER_URL.Click Private Sub BTT_CONTEXT_OPEN_USER_URL_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_USER_URL.Click
If Not UserKey.IsEmptyString Then If Not UserKey.IsEmptyString Then
Dim u As IUserData = Settings.GetUser(UserKey) Dim u As IUserData = Settings.GetUser(UserKey)
@@ -372,15 +422,44 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, $"[FeedMedia.OpenPost({UserKey}, {Post.Post.ID})]") ErrorsDescriber.Execute(EDP.LogMessageValue, ex, $"[FeedMedia.OpenPost({UserKey}, {Post.Post.ID})]")
End Try End Try
End Sub End Sub
#End Region
#Region "Feed"
Private Sub BTT_FEED_ADD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_FAV.Click
With Settings.Feeds.Favorite
If Not .Contains(Media) Then .Add(Media)
BTT_FEED_ADD_FAV.ControlChangeColor(True, False)
End With
End Sub
Private Sub BTT_FEED_ADD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_SPEC.Click
With FeedSpecialCollection.ChooseFeeds(True)
If .ListExists Then .ForEach(Sub(f) f.Add(Media))
End With
End Sub
Private Sub BTT_FEED_REMOVE_FAV_Click(sender As Object, e As EventArgs) Handles BTT_FEED_REMOVE_FAV.Click
With Settings.Feeds.Favorite
If .Contains(Media) Then .Remove(Media)
BTT_FEED_ADD_FAV.ControlChangeColor(True)
End With
End Sub
Private Sub BTT_FEED_REMOVE_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_REMOVE_SPEC.Click
With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then .ForEach(Sub(f) f.Remove(Media))
End With
End Sub
#End Region
#Region "Info"
Private Sub BTT_CONTEXT_FIND_USER_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_FIND_USER.Click Private Sub BTT_CONTEXT_FIND_USER_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_FIND_USER.Click
If Not UserKey.IsEmptyString Then MainFrameObj.FocusUser(UserKey, True) If Not UserKey.IsEmptyString Then MainFrameObj.FocusUser(UserKey, True)
End Sub End Sub
Private Sub BTT_CONTEXT_INFO_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_INFO.Click Private Sub BTT_CONTEXT_INFO_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_INFO.Click
MsgBoxE({Information, "Post information"}) MsgBoxE({Information, "Post information"})
End Sub End Sub
#End Region
#Region "Delete"
Private Sub BTT_CONTEXT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DELETE.Click Private Sub BTT_CONTEXT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DELETE.Click
DeleteFile(False) DeleteFile(False)
End Sub End Sub
#End Region
Friend Function DeleteFile(ByVal Silent As Boolean) As Boolean Friend Function DeleteFile(ByVal Silent As Boolean) As Boolean
Const msgTitle$ = "Deleting a file" Const msgTitle$ = "Deleting a file"
Try Try

View File

@@ -0,0 +1,252 @@
' 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.Tools
Imports PersonalUtilities.Functions.XML
Imports UserMediaD = SCrawler.DownloadObjects.TDownloader.UserMediaD
Namespace DownloadObjects
Friend Class FeedSpecial : Implements IEnumerable(Of UserMediaD), IMyEnumerator(Of UserMediaD), IDisposableSuspend
#Region "SEComparer"
Friend Class SEComparer : Implements IComparer(Of UserMediaD)
Friend Function Compare(ByVal x As UserMediaD, ByVal y As UserMediaD) As Integer Implements IComparer(Of UserMediaD).Compare
Dim v% = x.Date.Ticks.CompareTo(y.Date.Ticks) * -1
If v <> 0 Then Return v
v = If(x.User?.GetHashCode, 0).CompareTo(If(y.User?.GetHashCode, 0))
If v <> 0 Then Return v
Return 0
End Function
End Class
#End Region
#Region "Events"
Friend Event FeedDeleted As FeedSpecialCollection.FeedActionEventHandler
#End Region
#Region "Declarations"
Friend Const FavoriteName As String = "Favorite"
Friend Const SpecialName As String = "Special"
Private ReadOnly Items As List(Of UserMediaD)
Private _File As SFile
Friend ReadOnly Property File As SFile
Get
If _File.IsEmptyString AndAlso Not Name.IsEmptyString Then
If _IsFavorite Then
_File = $"{TDownloader.SessionsPath}{FavoriteName}.xml"
Else
_File = $"{TDownloader.SessionsPath}{SpecialName}_{Name}.xml"
End If
End If
Return _File
End Get
End Property
Private _IsFavorite As Boolean
Friend ReadOnly Property IsFavorite As Boolean
Get
Return _IsFavorite
End Get
End Property
Private _Name As String
Friend ReadOnly Property Name As String
Get
If _Name.IsEmptyString And IsFavorite Then
Return FavoriteName
Else
Return _Name
End If
End Get
End Property
#End Region
#Region "Initializers"
Private Sub New()
Items = New List(Of UserMediaD)
End Sub
Friend Sub New(ByVal f As SFile)
Me.New
_File = f
If Not File.Name.IsEmptyString Then
_IsFavorite = File.Name.StartsWith(FavoriteName)
If Not _IsFavorite Then _Name = File.Name.Split("_").ListTake(0, 100, EDP.ReturnValue).ListToString("").StringTrim.StringTrimStart("_")
End If
Load()
End Sub
Friend Shared Function CreateFavorite() As FeedSpecial
Return New FeedSpecial With {._IsFavorite = True}
End Function
Friend Shared Function CreateSpecial(ByVal Name As String) As FeedSpecial
Return New FeedSpecial With {._Name = Name}
End Function
Friend Sub Load()
If File.Exists Then
Using x As New XmlFile(File, Protector.Modes.All, False) With {.AllowSameNames = True}
x.LoadData()
If x.Count > 0 Then Items.ListAddList(x, LAP.IgnoreICopier)
End Using
End If
End Sub
#End Region
#Region "Data functions"
#Region "Item, Count"
Default Friend ReadOnly Property Item(ByVal Index As Integer) As UserMediaD Implements IMyEnumerator(Of UserMediaD).MyEnumeratorObject
Get
Return Items(Index)
End Get
End Property
Friend ReadOnly Property Count As Integer Implements IMyEnumerator(Of UserMediaD).MyEnumeratorCount
Get
Return Items.Count
End Get
End Property
#End Region
#Region "Clear, Sort, Save"
Friend Function Clear()
Dim result As Boolean = Count > 0
Items.Clear()
If result Then Save()
Return result
End Function
Friend Sub Sort()
If Count > 0 Then Items.Sort(Settings.Feeds.Comparer)
End Sub
Friend Sub Save()
If Not File.IsEmptyString Then
Sort()
Using x As New XmlFile With {.Name = "Feed", .AllowSameNames = True}
x.AddRange(Items)
x.Save(File, EDP.SendToLog)
End Using
End If
End Sub
#End Region
#Region "Add"
Friend Overloads Function Add(ByVal Item As UserMediaD, Optional ByVal AutoSave As Boolean = True) As Boolean
If Not Items.Contains(Item) Then
Items.Add(Item)
If AutoSave Then Save()
Return True
Else
Return False
End If
End Function
Friend Overloads Function Add(ByVal Items As IEnumerable(Of UserMediaD), Optional ByVal AutoSave As Boolean = True) As Integer
Dim ri% = 0
If Items.ListExists Then
For Each item As UserMediaD In Items : ri += Add(item, False).BoolToInteger : Next
If ri > 0 And AutoSave Then Save()
End If
Return ri
End Function
#End Region
#Region "Remove"
Friend Overloads Function Remove(ByVal Item As UserMediaD, Optional ByVal AutoSave As Boolean = True) As Boolean
If Count > 0 Then
Dim i% = Items.IndexOf(Item)
If i >= 0 Then
Items.RemoveAt(i)
If AutoSave Then Save()
Return True
End If
End If
Return False
End Function
Friend Overloads Function Remove(ByVal Items As IEnumerable(Of UserMediaD), Optional ByVal AutoSave As Boolean = True) As Integer
Dim ri% = 0
If Items.ListExists Then
For Each item As UserMediaD In Items : ri += Me.Items.Remove(item).BoolToInteger : Next
If ri > 0 And AutoSave Then Save()
End If
Return ri
End Function
Private _NotExistRemoved As Boolean = False
Friend Function RemoveNotExist(ByVal p As Predicate(Of UserMediaD)) As Integer
If Count > 0 And Not _NotExistRemoved Then
_NotExistRemoved = True
Dim ri% = Items.RemoveAll(p)
If ri > 0 Then Save()
Return ri
Else
Return 0
End If
End Function
#End Region
#Region "Delete"
Friend Overloads Function Delete() As Boolean
If File.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.ReturnValue) Then
Items.Clear()
RaiseEvent FeedDeleted(Settings.Feeds, Me)
Return True
Else
Return False
End If
End Function
Friend Overloads Function Delete(ByVal Item As UserMediaD, Optional ByVal AutoSave As Boolean = True) As Boolean
Dim result As Boolean = False
If Item.Data.File.Exists Then result = Item.Data.File.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.ReturnValue)
If result And AutoSave Then Save()
Return result
End Function
#End Region
#Region "Contains"
Friend Function Contains(ByVal Item As UserMediaD) As Boolean
Return Items.Contains(Item)
End Function
#End Region
#End Region
#Region "Base Overrides"
Public Overrides Function ToString() As String
Return Name
End Function
Public Overrides Function GetHashCode() As Integer
Return Name.GetHashCode
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not IsNothing(Obj) Then
If TypeOf Obj Is FeedSpecial Then
Return Name = DirectCast(Obj, FeedSpecial).Name
ElseIf TypeOf Obj Is String Then
Return Name = CStr(Obj)
End If
End If
Return False
End Function
#End Region
#Region "IEnumerable Support"
Private Function GetEnumerator() As IEnumerator(Of UserMediaD) Implements IEnumerable(Of UserMediaD).GetEnumerator
Return New MyEnumerator(Of UserMediaD)(Me)
End Function
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return GetEnumerator()
End Function
#End Region
#Region "IDisposable Support"
Friend Property DisposeSuspended As Boolean Implements IDisposableSuspend.DisposeSuspended
Get
Return IsFavorite
End Get
Private Set : End Set
End Property
Friend ReadOnly Property Disposed As Boolean Implements IDisposableSuspend.Disposed
Get
Return disposedValue
End Get
End Property
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then Items.Clear()
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
End Namespace

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