Compare commits

...

17 Commits

Author SHA1 Message Date
Andy
57b5377867 2026.10.29.0
API.Instagram: user stories are not downloading
2026-10-29 18:48:50 +03:00
Andy
59dacf67bd 2026.10.26.0
YT
Exclude AI from results and correct handling

SC
API.UserDataBase: force put text into the 'text' folder
API.Instagram: fix saved posts
API.OnlyFans: text posts are not downloading
API.Xhamster: correct processing progress
2026-10-26 17:59:40 +03:00
Andy
51d8326807 2026.9.21.0
YT
VideoOptionsForm: handling of type 'audio+video'
YouTubeMediaContainerBase: move 'DataReceivedEventHandler' to a public module

SC
REMOVE: Mastodon, Imgur
API.UserDataBase: remove unused references; optimize the use of '_ForceSaveUserData' and '_ForceSaveUserInfo'; update 'ErrorDownloading' function
API.Base.YTDLP: add 'SetProgress' and 'CreateFileExchanger' functions
API.Bluesky: add 'UseMD5Comparison' and 'RemoveExistingDuplicates' options; handling errors 502 and 504; update 'UserExists' detection
API.Instagram: switch to 'GraphQL'
API.OnlyFans: add a special label 'DRM'
API.PornHub: fix photo and video downloads; add yt-dlp support
API.Reddit: remove predefined 'ClientID' and 'ClientSecret'; update 'AvailableTrueValue' function; add REST API support; fix carousels downloading; remove Imgur support
API.ThisVid: fix profile info
API.Twitter: remove Mastodon compatibility; update bookmarks link
API.Xhamster: update yt-dlp
Automation: remove unused references
DownloadFeedForm: new feeds do not appear in the 'Load' toolbar dropdown
MissingPostsForm: add 'ESC' hotkey
TDownloader: implement the ability to add to the log a list of users who have missing posts; exclude the 'Path' plugin from downloading
VideoDownloaderForm: remove Imgur support
DownloadableMediaHost: remove Imgur support; protect photos from deletion
PluginHost: remove Mastodon
SettingsCLS: add 'AddMissingPostUsersToLog' property
2026-09-21 17:57:58 +03:00
Andy
ffab035cee 2026.8.7.0
API: updated EditorExchangeOptionsBase and its inheritances
API.Base.SiteSettingsBase: updated 'Responser' creation algorithm
API.Base.UserDataBase: updated 'DownloadContentDefault_ConvertWebp_Impl' function
API.Instagram: added 'USE_GQL_Highlights' property; updated 'DocId' to get highlights and user info; remove 'ValidateExtension'; add 'DownloadContentDefault_ConvertWebp' to convert 'heic' files; fix highlights downloading; update getting username by ID
API.Reddit: fix missing posts downloading
API.ThisVid: fix a bug with updating/adding cookies
API.Twitter: fix post text is not downloaded completely
API.Xhamster: fix some posts are not downloaded
DownloadFeedForm: improve filters; add loading buttons 'Current', 'Favorite' and 'Load'
FeedMedia: fix an issue where post text would not load in older feeds
FeedFilter: add search by labels; fix saving filters when selecting users; fix an issue with the 'TEMP' filter
SiteEditorForm: get a cookies instance from the source
2026-08-07 17:29:35 +03:00
Andy
9b3c172fc3 Update README.md 2026-06-01 11:12:04 +03:00
Andy
9ba78d2fa0 2026.5.13.0
API.Base: add 'IThumbList' interface; add the 'ReparseMissing_ClearList' function to the base class
API.Instagram: protect all necessary controls; fix error getting user info
API.OnlyFans: add the 'CookieDateProvider' class to avoid cookies error
API.PornHub: add image and title additional regex; fix subscription downloading bug
API.ThisVid: add 'ReparseMissing' function
Feed: add the most frequently used buttons to the top
FeedMedia: fix subscription bug
2026-05-13 20:45:18 +03:00
Andy
be97752b7c 2026.3.23.0
API.EditorExchangeOptionsBase: move the 'Apply' function
API.EditorExchangeOptionsBase_P: remove the 'Apply' function
API.UserDataBase: update the 'UserSiteNameUpdate' function; remove the '_ForceSaveUserInfoOnException' property; update the 'DownloadContentDefault_ConvertWebp' function; add the 'DownloadContentDefault_ConvertWebp_TestImg' and 'DownloadContentDefault_ConvertWebp_Impl' functions
API.Bluesky: add the 'EditorExchangeOptions' class; add 'did:' handle for recognizing
API.PornHub: update M3U8 download functions
API.TikTok: fix where gallery-dl would hang when downloading stories
API.Twitter: fix downloading a single media file (standalone downloader) fails
API.Xhamster: add 'webm' to 'jpg' correct conversion
FeedMedia: move the 'ImageRenderer2' class into the 'UserImage' class
UserImage: add the 'ImageRenderer2' class
2026-03-23 17:21:04 +03:00
Andy
d0d8e5470e 2026.2.14.0
TokenBatch: add 'MyWorkingDirectory' property
API.Instagram: update 'ID' extraction; reduce the number of downloaded stories (GQL) to 5
API.Twitter: get a new username based on the user ID
API.XHamster: videos aren't downloading
Feed: fix a bug when removing from favorites
2026-02-14 14:24:03 +03:00
Andy
164b999de7 2026.1.24.0
Instagram: update settings; fix a bug in line 1437
OnlyFans: update the URLs that open posts
2026-01-24 18:17:28 +03:00
Andy
e6d5fc2b95 2026.1.17.0
UserDataBase: move GLD functions from 'Twitter'
Instagram: add 'Reposts' and 'Likes' to the 'Sections' enum
OnlyFans: update the regex in 'DynamicRulesEnv'; handling error 502
PornHub: fix videos aren't downloading
ThreadsNet: add user name and description extraction
TikTok: fix downloading new videos; add downloading 'Stories' and 'Reposts'
Twitter: move GLD functions to 'UserDataBase'
Xhamster: fix a bug when adding new users; fix incorrect cache location
Download groups: add excluded groups
MainFrame: fix the 'Feed' tooltip
2026-01-17 20:06:37 +03:00
Andy
6d4380ccac 2025.11.25.0
YT
YouTubeSettings: add property 'DefaultSubtitlesEmbed'
YouTubeMediaContainerBase: improve trim options; update command for 'DefaultSubtitlesEmbed'

SCrawler
TokenBatch, GDLBatch, YTDLPBatch: optimize code; add default encoding
UserMedia: add property 'IsPhotoType'
API.TikTok: optimize code; download descriptions
API.Twitter: optimize code; fix downloading of site name, description and avatar
API.Xhamster: add the properties 'UseYTDLPJSON', 'UseYTDLPDownload' and 'UseYTDLPForceDisableInternal'; add yt-dlp support; update parsing functions
Groups, automation: delete 'Modes'; add groups downloading among other options; optimize code
DownloadSavedPostsForm, DownloadProgress: add hotkey 'Esc'
MainFrame: update 'BTT_VIEW_FILTER_LOAD_Click' function
2025-11-25 12:57:37 +03:00
Andy
8dfd4e8bd1 2025.10.4.0
YT
YouTubeSettings: add property 'ParseLongUserTitle'
YouTubeMediaContainerBase: concatenate artists

SCrawler
Bluesky: add saved posts downloading
xHamster: temporarily disable the plugin
2025-10-04 15:43:40 +03:00
Andy
1404afdfa3 2025.9.1.0
API.PornHub: update regex and data parsing
2025-09-01 16:41:44 +03:00
Andy
5857fcfae3 2025.8.30.0
YT
Add video trim
Fix downloading error
Add artist name when downloading audio
Embed chapters

SCrawler
Add correct handling of 'webp' files
API.Redgifs: hide 'Responser.Save' error
2025-08-30 14:36:36 +03:00
Andy
e09752a2d5 2025.8.1.0
YT
Update 'ReplaceModificationDate'

SCrawler
API.Instagram: fix 'LastCursor' issue
API.Reddit: add OAuth validation; add default credentials; hide unused controls; add 'SeparatedTasks'; bypass 429 error; fix crossposts downloading
API.Redgifs: force delete cookies if user added them
API.TikTok: yt-dlp modification (date change)
API.Twitter: simplify large profiles download
SettingsCLS: change default max value for channel downloads
2025-08-01 21:49:40 +03:00
Andy
05772a9fc4 2025.7.18.0
API.Instagram: fix special folder issue
API.OnlyFans: bypass unpurchased videos; add support for GIF files
API.Reddit: add OAuth credentials validation; add extended 429 error handling
API.Xhamster: remove 'UserOptions' function ('SiteSettings'); add support for downloading 'moments'
API.XVIDEOS: remove 'UserOptions' function ('SiteSettings'); remove 'UserExchangeOptions' class
Add 'EditorExchangeOptionsBase_P' and update base classes for user options
2025-07-18 20:29:35 +03:00
Andy
24ad338c60 2025.6.12.0
YT
MainModShared: fix environment output
YouTubeMediaContainerBase: fix 'm3u8' audio formats

SCrawler
UserDataBase: text downloading with saved posts; update 'ID' property (handle '_ForceSaveUserInfo')
API.Bluesky: data is not downloaded
API.Reddit: update 'RedditViewExchange'; set base inheritance; inherit default settings for new users
API.ALL: update functions with property 'ID'
2025-06-12 20:29:59 +03:00
147 changed files with 6628 additions and 2842 deletions

File diff suppressed because it is too large Load Diff

7
FAQ.md
View File

@@ -33,6 +33,7 @@ I strongly recommend you to **regularly** create backup copies of the settings f
## General questions
- **PROFILES**
- I added a profile but **nothing downloaded** :arrow_forward: check your cookies and [site requirements](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements). If there are any optional fields that you don't fill in, do so. Still nothing works - [report it](#how-to-report-a-problem)!
- :exclamation: **Try to avoid Chinese/Japanese symbols in the paths.**
- User downloading failed :arrow_forward: check your credentials and **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**. If all settings are set and nothing works, [report it](#how-to-report-a-problem). **Don't forget to attach the LOG.**
- [How to redownload user](https://github.com/AAndyProgram/SCrawler/wiki#redownload-user)
- How to **add profile** to download :arrow_forward: copy the **[profile URL](https://github.com/AAndyProgram/SCrawler/wiki#add-user)** and press `Insert` or `Ctrl+Insert`. **ALWAYS PASTE THE USER PROFILE URL**. After that select this user and press `F5` or click the `Download selected` button.
@@ -61,14 +62,14 @@ I strongly recommend you to **regularly** create backup copies of the settings f
*How to use: find the site you need in the list and read the answer.*
- Reddit: don't use credentials at all or configure [OAuth](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-get-reddit-credentials). **Reddit profiles can be downloaded without any credentials at all. Subreddits require OAuth! If nothing downloads, use OAuth!** Don't use OAuth token to download saved posts (use cookies only).
- Reddit: add cookies and/or configure [OAuth](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-get-reddit-credentials). **Reddit profiles can be downloaded without credentials using cookies. Subreddits require OAuth! If nothing downloads, use OAuth!** Don't use OAuth token to download saved posts (use cookies only).
- **META** (**Instagram**, Threads, Facebook): you need **cookies** and fill in **all fields**
- **Instagram [TIPS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram-tips)**
- **Instagram saved posts**: I don't consider questions like "I have 10k saved posts and only 1000 were downloaded". Download posts, remove them from saved posts, delete the `Saved posts` **settings folder**, repeat.
- TikTok: works via yt-dlp. If something doesn't download, we need to wait until yt-dlp fixes it. TikTok doesn't require cookies to download.
- TikTok: works via yt-dlp. If something doesn't download, we need to wait until yt-dlp fixes it. TikTok doesn't require cookies to download. Photos are downloaded using gallery-dl.
- Porn sites: **COOKIES**!
- ThisVid: https://github.com/AAndyProgram/SCrawler/wiki/Settings#thisvid-faq
- **OnlyFans**: cookies + **all fields** + [OF-Scraper (download the correct version that I pointed)](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper) & [mp4decrypt](https://www.bento4.com/downloads/) & **DRM keys** to download DRM protected videos. [OF-Scraper support](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper-support). Also read [this](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans-faq)
- **OnlyFans**: cookies + **all fields** + [OF-Scraper (download the correct version that I pointed)](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper) & **DRM keys** to download DRM protected videos. [OF-Scraper support](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper-support). Also read [this](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans-faq)
- **JustForFans**: **THE VIDEO ISN'T DOWNLOADING AT THE MOMENT** ([Issue](https://discord.com/channels/1124032649682493462/1205547615199039551/1231349555132366870))
## Other questions

View File

@@ -8,3 +8,4 @@ List of available plugins:
Tools:
- [image2post](https://github.com/unknown81311/SCrawler-image2post) by @unknown81311: **get reddit post URL from file.**
- [Update-SCrawler-Tools](https://github.com/cjb900/Update-SCrawler-Tools) by @cjb900: **a tool for updating third-party programs such as yt-dlp and gallery-dl**

Binary file not shown.

After

Width:  |  Height:  |  Size: 847 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 101 KiB

After

Width:  |  Height:  |  Size: 121 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 17 KiB

After

Width:  |  Height:  |  Size: 26 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 39 KiB

After

Width:  |  Height:  |  Size: 56 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 26 KiB

After

Width:  |  Height:  |  Size: 38 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 28 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 31 KiB

After

Width:  |  Height:  |  Size: 53 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 28 KiB

After

Width:  |  Height:  |  Size: 46 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 25 KiB

After

Width:  |  Height:  |  Size: 41 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 23 KiB

After

Width:  |  Height:  |  Size: 42 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 31 KiB

After

Width:  |  Height:  |  Size: 48 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 24 KiB

View File

@@ -1,5 +1,4 @@
# 🏳️‍🌈 Happy LGBT Pride Month 🎉
<!---# 🏳️‍🌈 Happy LGBT Pride Month 🎉--->
# 🏳️‍🌈 Social networks crawler 🏳️‍🌈
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
@@ -35,20 +34,17 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
# What can program do:
- Download pictures and videos from user profiles:
- YouTube videos, shorts, community feeds, users, artists, playlists, music, tracks;
- Reddit images, galleries of images, videos, saved posts;
- Reddit images, galleries of images, videos, text, saved posts;
- Redgifs images and videos (https://www.redgifs.com/);
- Twitter images and videos, saved (bookmarked) posts, likes, communities;
- Bluesky images and videos;
- OnlyFans images and videos, saved (bookmarked) posts, stories;
- Twitter images and videos, text, saved (bookmarked) posts, likes, communities;
- Bluesky images and videos, text;
- OnlyFans images and videos, text, saved (bookmarked) posts, stories;
- JustForFans images and videos, saved (bookmarked) posts;
- Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories, saved posts;
- Threads images and videos, saved posts;
- Instagram images and videos, text, tagged posts, stories, saved posts;
- Threads images and videos, text, saved posts;
- Facebook images and videos, stories, saved posts;
- TikTok images and videos;
- Pinterest boards, users, saved posts;
- Imgur images, galleries and videos;
- Gfycat videos;
- PornHub images, videos, save (liked) posts, search queries, search categories;
- XHamster images, videos, saved posts, search queries, search categories, search tags;
- XVIDEOS videos, saved posts, search queries, search categories;
@@ -85,12 +81,9 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **Threads**
- **Facebook**
- JustForFans *(partial support) ([video issue](https://discord.com/channels/1124032649682493462/1205547615199039551/1231349555132366870))*[^1]
- Mastodon *(out of support)*
- TikTok
- RedGifs
- Pinterest
- Imgur *(out of support)*
- Gfycat
- LPSG
- **PornHub**
- **XHamster**
@@ -135,7 +128,6 @@ First, the program downloads the full profile. After the program downloads only
- [Twitter](https://github.com/AAndyProgram/SCrawler/wiki/Settings#twitter)
- [Bluesky](https://github.com/AAndyProgram/SCrawler/wiki/Settings#bluesky)
- [OnlyFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans)
- [Mastodon](https://github.com/AAndyProgram/SCrawler/wiki/Settings#mastodon)
- [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram)
- [Threads](https://github.com/AAndyProgram/SCrawler/wiki/Settings#threads)
- [Facebook](https://github.com/AAndyProgram/SCrawler/wiki/Settings#facebook)

View File

@@ -113,6 +113,51 @@ Namespace API.YouTube.Base
Return Protocols.Undefined
End Get
End Property
Public Language As String
Public ReadOnly Property LanguageCaption(Optional ByVal IncludeNote As Boolean = False) As String
Get
Dim c$ = String.Empty
If Not Language.IsEmptyString Then c = $"[{Language}]"
If Not FormatNote.IsEmptyString And IncludeNote Then c.StringAppend($"({FormatNoteClean.IfNullOrEmpty(FormatNote)})", " ")
Return c
End Get
End Property
Public FormatNote As String
Public FormatNoteClean As String
Public ReadOnly Property IsAI As Boolean
Get
Return Not FormatNote.IsEmptyString AndAlso FormatNote.ToLower.Contains("dubbed-auto")
End Get
End Property
Public ReadOnly Property IsOriginalLanguage As Boolean
Get
Return Not FormatNote.IsEmptyString AndAlso FormatNote.ToLower.Contains("original")
End Get
End Property
Public ReadOnly Property IsDefaultLanguage As Boolean
Get
Return Not FormatNote.IsEmptyString AndAlso FormatNote.ToLower.Contains("default")
End Get
End Property
Public ReadOnly Property IsDefaultOrOriginal As Boolean
Get
Return IsDefaultLanguage Or IsOriginalLanguage
End Get
End Property
Public ReadOnly Property FormatQuality As String
Get
If Not FormatNote.IsEmptyString Then
If FormatNote.Contains("high") Then
Return "high"
ElseIf FormatNote.Contains("medium") Then
Return "medium"
ElseIf FormatNote.Contains("low") Then
Return "low"
End If
End If
Return String.Empty
End Get
End Property
Public URL As String
Public Property Index As Integer Implements IIndexable.Index
Private Function SetIndex(ByVal Obj As Object, ByVal Index As Integer) As Object Implements IIndexable.SetIndex
@@ -136,4 +181,34 @@ Namespace API.YouTube.Base
End If
End Function
End Structure
Public Structure TrimOption : Implements IComparable(Of TrimOption)
Public Name As String
Public Start As Integer
Public ReadOnly Property StartTime As TimeSpan
Get
Return TimeSpan.FromSeconds(Start)
End Get
End Property
Public [End] As Integer
Public ReadOnly Property EndTime As TimeSpan
Get
Return TimeSpan.FromSeconds([End])
End Get
End Property
Public Shared Widening Operator CType(ByVal t As TrimOption) As String
Return t.ToString
End Operator
Public Overrides Function ToString() As String
Dim v$ = $"{Start} - {[End]}"
If Not Name.IsEmptyString Then v = $"[{v}] - {Name}"
Return v
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
Try : With DirectCast(Obj, TrimOption) : Return Start = .Start And [End] = .End : End With : Catch : End Try
Return False
End Function
Private Function CompareTo(ByVal Other As TrimOption) As Integer Implements IComparable(Of TrimOption).CompareTo
Return Start.CompareTo(Other.Start)
End Function
End Structure
End Namespace

View File

@@ -268,6 +268,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"Defaults"}, FileDateMode.None), Category("Defaults"), DisplayName("Add channel to file name"),
Description("Add channel name before/after the file name")>
Public ReadOnly Property FileAddChannelToFileName As XMLValue(Of FileDateMode)
<Browsable(True), GridVisible, XMLVN({"Defaults"}, True), Category("Defaults"), DisplayName("Parse long user titles"),
Description("Suitable for multiple artists")>
Public ReadOnly Property ParseLongUserTitle As XMLValue(Of Boolean)
#End Region
#Region "Defaults ChannelsDownload"
<Browsable(True), GridVisible, XMLVN({"Defaults", "Channels"}), Category("Defaults"), DisplayName("Default download tabs for channels"),
@@ -319,8 +322,11 @@ Namespace API.YouTube.Base
Description("Convert non-AVC codecs (eg 'VP9') to AVC. Not recommended due to high CPU usage!")>
Public ReadOnly Property DefaultVideoConvertNonAVC As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, False), Category("Defaults Video"), DisplayName("Embed thumbnail (video)"),
Description("Embed thumbnail in the video as cover art. Default: true.")>
Description("Embed thumbnail in the video as cover art. Default: false.")>
Public ReadOnly Property DefaultVideoEmbedThumbnail As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, True), Category("Defaults Video"), DisplayName("Embed chapters"),
Description("Embed chapters in the video. Default: true.")>
Public ReadOnly Property DefaultVideoEmbedChapters As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}), Category("Defaults Video"), DisplayName("Include zero size formats"),
Description("Include formats with zero size (or undefined size).")>
Public ReadOnly Property DefaultVideoIncludeNullSize As XMLValue(Of Boolean)
@@ -407,6 +413,15 @@ Namespace API.YouTube.Base
Private Function AvailableAudioFormats_Impl() As String()
Return AvailableAudioFormats
End Function
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, True), Category("Defaults Audio"), DisplayName("Language: exclude AI"),
Description("Exclude AI from results. Default: true.")>
Public ReadOnly Property DefaultAudioLanguage_ExcludeAI As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, True), Category("Defaults Audio"), DisplayName("Language: exclude not default"),
Description("Exclude non-default or non-original languages from the results. Default: true.")>
Public ReadOnly Property DefaultAudioLanguage_ExcludeNonDefault As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, True), Category("Defaults Audio"), DisplayName("Use default"),
Description("Use the original or default language. Default: true.")>
Public ReadOnly Property DefaultAudioLanguageUseDefault As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, "MP3"), Category("Defaults Audio"), DisplayName("Default codec for music"),
TypeConverter(GetType(FieldsTypeConverter)), GridStandardValuesProvider(NameOf(AvailableAudioFormats_Impl)),
Description("The default audio format for downloading music.")>
@@ -495,6 +510,29 @@ Namespace API.YouTube.Base
TypeConverter(GetType(ValueCollectionConverter)),
Description("Additional format for downloading subtitles. This means that all subtitles will be converted to the formats you choose and saved as separate files.")>
Public ReadOnly Property DefaultSubtitlesFormatAddit As XMLValuesCollection(Of String)
<Browsable(True), GridVisible, XMLVN({"DefaultsSubtitles"}), Category("Defaults Subtitles"), DisplayName("Embed subtitles"),
Description("Embed subtitles in the video (only for mp4, webm and mkv videos)")>
Public ReadOnly Property DefaultSubtitlesEmbed As XMLValue(Of Boolean)
#End Region
#Region "Trim"
<Browsable(True), GridVisible, XMLVN({"DefaultsTrim"}, False), Category("Defaults Trimming"), DisplayName("Delete original file"),
Description("If true, the original file will be deleted after trimming")>
Public ReadOnly Property TrimDeleteOriginalFile As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsTrim"}, False), Category("Defaults Trimming"), DisplayName("Add to M3U8"),
Description("If true, the trimmed files will be added to the M3U8 playlist (if selected)")>
Public ReadOnly Property TrimAddTrimmedFilesToM3U8 As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsTrim"}, False), Category("Defaults Trimming"), DisplayName("Separate folder"),
Description("Place the trimmed files in a separate folder")>
Public ReadOnly Property TrimSeparateFolder As XMLValue(Of Boolean)
Friend Const TrimSeparateFolderNameDefault As String = "Trim"
<Browsable(True), GridVisible, XMLVN({"DefaultsTrim"}, TrimSeparateFolderNameDefault), Category("Defaults Trimming"), DisplayName("Separate folder name"),
Description("Name of a separate folder")>
Public ReadOnly Property TrimSeparateFolderName As XMLValue(Of String)
#End Region
#Region "Errors"
<Browsable(True), GridVisible, XMLVN({"Errors"}, True), Category("ERRORS"), DisplayName("Ignore downloading errors"),
Description("Ignore download errors if some files are missing (e.g. subtitles) and continue downloading")>
Public ReadOnly Property ErrorsIgnore As XMLValue(Of Boolean)
#End Region
#End Region
#Region "Initializer"

View File

@@ -0,0 +1,158 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.YouTube.Controls
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class ChaptersForm : 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 TP_BUTTONS As System.Windows.Forms.TableLayoutPanel
Me.BTT_ALL = New System.Windows.Forms.Button()
Me.BTT_NONE = New System.Windows.Forms.Button()
Me.BTT_INVERT = New System.Windows.Forms.Button()
Me.LIST_CHAPTERS = New System.Windows.Forms.CheckedListBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_BUTTONS = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
TP_BUTTONS.SuspendLayout()
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.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(TP_BUTTONS, 0, 1)
TP_MAIN.Controls.Add(Me.LIST_CHAPTERS, 0, 0)
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 = 2
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, 30.0!))
TP_MAIN.Size = New System.Drawing.Size(384, 361)
TP_MAIN.TabIndex = 0
'
'TP_BUTTONS
'
TP_BUTTONS.ColumnCount = 3
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33333!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33333!))
TP_BUTTONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33333!))
TP_BUTTONS.Controls.Add(Me.BTT_ALL, 0, 0)
TP_BUTTONS.Controls.Add(Me.BTT_NONE, 1, 0)
TP_BUTTONS.Controls.Add(Me.BTT_INVERT, 2, 0)
TP_BUTTONS.Dock = System.Windows.Forms.DockStyle.Fill
TP_BUTTONS.Location = New System.Drawing.Point(0, 331)
TP_BUTTONS.Margin = New System.Windows.Forms.Padding(0)
TP_BUTTONS.Name = "TP_BUTTONS"
TP_BUTTONS.RowCount = 1
TP_BUTTONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_BUTTONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_BUTTONS.Size = New System.Drawing.Size(384, 30)
TP_BUTTONS.TabIndex = 1
'
'BTT_ALL
'
Me.BTT_ALL.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_ALL.Location = New System.Drawing.Point(3, 3)
Me.BTT_ALL.Name = "BTT_ALL"
Me.BTT_ALL.Size = New System.Drawing.Size(122, 24)
Me.BTT_ALL.TabIndex = 0
Me.BTT_ALL.Text = "All"
Me.BTT_ALL.UseVisualStyleBackColor = True
'
'BTT_NONE
'
Me.BTT_NONE.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_NONE.Location = New System.Drawing.Point(131, 3)
Me.BTT_NONE.Name = "BTT_NONE"
Me.BTT_NONE.Size = New System.Drawing.Size(122, 24)
Me.BTT_NONE.TabIndex = 1
Me.BTT_NONE.Text = "None"
Me.BTT_NONE.UseVisualStyleBackColor = True
'
'BTT_INVERT
'
Me.BTT_INVERT.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_INVERT.Location = New System.Drawing.Point(259, 3)
Me.BTT_INVERT.Name = "BTT_INVERT"
Me.BTT_INVERT.Size = New System.Drawing.Size(122, 24)
Me.BTT_INVERT.TabIndex = 2
Me.BTT_INVERT.Text = "Invert"
Me.BTT_INVERT.UseVisualStyleBackColor = True
'
'LIST_CHAPTERS
'
Me.LIST_CHAPTERS.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_CHAPTERS.FormattingEnabled = True
Me.LIST_CHAPTERS.Location = New System.Drawing.Point(3, 3)
Me.LIST_CHAPTERS.Name = "LIST_CHAPTERS"
Me.LIST_CHAPTERS.Size = New System.Drawing.Size(378, 325)
Me.LIST_CHAPTERS.TabIndex = 0
'
'ChaptersForm
'
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.KeyPreview = True
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(400, 400)
Me.Name = "ChaptersForm"
Me.ShowIcon = False
Me.ShowInTaskbar = False
Me.Text = "Chapters"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
TP_BUTTONS.ResumeLayout(False)
Me.ResumeLayout(False)
End Sub
Private WithEvents BTT_ALL As Button
Private WithEvents BTT_NONE As Button
Private WithEvents BTT_INVERT As Button
Private WithEvents LIST_CHAPTERS As CheckedListBox
End Class
End Namespace

View File

@@ -0,0 +1,129 @@
<?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>
<metadata name="TP_BUTTONS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
</root>

View File

@@ -0,0 +1,66 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API.YouTube.Base
Imports SCrawler.API.YouTube.Objects
Namespace API.YouTube.Controls
Friend Class ChaptersForm
Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property MyData As YouTubeMediaContainerBase
Private ReadOnly Property MyDataSelected As List(Of TrimOption)
Friend ReadOnly Property MyResult As List(Of TrimOption)
Friend Sub New(ByRef data As YouTubeMediaContainerBase, ByVal selected As IEnumerable(Of TrimOption))
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, MyYouTubeSettings.DesignXml)
MyData = data
MyDataSelected = New List(Of TrimOption)
MyDataSelected.ListAddList(selected)
MyResult = New List(Of TrimOption)
End Sub
Private Sub ChaptersForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
.AddOkCancelToolbar()
With LIST_CHAPTERS
.BeginUpdate()
.Items.AddRange(MyData.Chapters.Cast(Of Object).ToArray)
If MyDataSelected.Count > 0 Then
For i% = 0 To .Items.Count - 1 : .SetItemChecked(i, MyDataSelected.Contains(MyData.Chapters(i))) : Next
End If
.EndUpdate()
End With
.EndLoaderOperations()
End With
End Sub
Private Sub ChaptersForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
MyResult.Clear()
MyDataSelected.Clear()
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With LIST_CHAPTERS
For i% = 0 To .Items.Count - 1
If .GetItemChecked(i) Then MyResult.Add(MyData.Chapters(i))
Next
End With
MyDefs.CloseForm()
End Sub
Private Sub BTT_ALL_NONE_INVERT_Click(sender As Object, e As EventArgs) Handles BTT_ALL.Click, BTT_NONE.Click, BTT_INVERT.Click
Dim v As Boolean = sender Is BTT_ALL
Dim isInvert As Boolean = sender Is BTT_INVERT
With LIST_CHAPTERS
.BeginUpdate()
For i% = 0 To .Items.Count - 1 : .SetItemChecked(i, If(isInvert, Not .GetItemChecked(i), v)) : Next
.EndUpdate()
End With
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,274 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.YouTube.Controls
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class TrimOptionForm : 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(TrimOptionForm))
Dim TP_OPTIONS As System.Windows.Forms.TableLayoutPanel
Me.TXT_NAME = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TP_TIME_TIME = New System.Windows.Forms.TableLayoutPanel()
Me.TXT_FROM_DATE = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_TO_DATE = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.OPT_INT = New System.Windows.Forms.RadioButton()
Me.OPT_TIME = New System.Windows.Forms.RadioButton()
Me.TP_TIME_INT = New System.Windows.Forms.TableLayoutPanel()
Me.TXT_FROM_INT = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_TO_INT = New PersonalUtilities.Forms.Controls.TextBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_OPTIONS = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).BeginInit()
TP_OPTIONS.SuspendLayout()
Me.TP_TIME_TIME.SuspendLayout()
CType(Me.TXT_FROM_DATE, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_TO_DATE, System.ComponentModel.ISupportInitialize).BeginInit()
Me.TP_TIME_INT.SuspendLayout()
CType(Me.TXT_FROM_INT, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_TO_INT, 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(334, 112)
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(334, 112)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
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.TXT_NAME, 0, 0)
TP_MAIN.Controls.Add(TP_OPTIONS, 0, 1)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 2
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(334, 112)
TP_MAIN.TabIndex = 0
'
'TXT_NAME
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Clear"
ActionButton1.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_NAME.Buttons.Add(ActionButton1)
Me.TXT_NAME.CaptionText = "Name"
Me.TXT_NAME.CaptionToolTipText = "Section name"
Me.TXT_NAME.CaptionWidth = 50.0R
Me.TXT_NAME.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_NAME.Location = New System.Drawing.Point(3, 3)
Me.TXT_NAME.Name = "TXT_NAME"
Me.TXT_NAME.Size = New System.Drawing.Size(328, 22)
Me.TXT_NAME.TabIndex = 0
'
'TP_OPTIONS
'
TP_OPTIONS.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_OPTIONS.ColumnCount = 2
TP_OPTIONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_OPTIONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_OPTIONS.Controls.Add(Me.TP_TIME_TIME, 1, 1)
TP_OPTIONS.Controls.Add(Me.OPT_INT, 0, 0)
TP_OPTIONS.Controls.Add(Me.OPT_TIME, 0, 1)
TP_OPTIONS.Controls.Add(Me.TP_TIME_INT, 1, 0)
TP_OPTIONS.Dock = System.Windows.Forms.DockStyle.Fill
TP_OPTIONS.Location = New System.Drawing.Point(3, 31)
TP_OPTIONS.Name = "TP_OPTIONS"
TP_OPTIONS.RowCount = 3
TP_OPTIONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_OPTIONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_OPTIONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_OPTIONS.Size = New System.Drawing.Size(328, 78)
TP_OPTIONS.TabIndex = 1
'
'TP_TIME_TIME
'
Me.TP_TIME_TIME.ColumnCount = 2
Me.TP_TIME_TIME.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
Me.TP_TIME_TIME.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
Me.TP_TIME_TIME.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.TP_TIME_TIME.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.TP_TIME_TIME.Controls.Add(Me.TXT_FROM_DATE, 0, 0)
Me.TP_TIME_TIME.Controls.Add(Me.TXT_TO_DATE, 1, 0)
Me.TP_TIME_TIME.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_TIME_TIME.Location = New System.Drawing.Point(32, 27)
Me.TP_TIME_TIME.Margin = New System.Windows.Forms.Padding(0)
Me.TP_TIME_TIME.Name = "TP_TIME_TIME"
Me.TP_TIME_TIME.RowCount = 1
Me.TP_TIME_TIME.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_TIME_TIME.Size = New System.Drawing.Size(295, 25)
Me.TP_TIME_TIME.TabIndex = 3
'
'TXT_FROM_DATE
'
Me.TXT_FROM_DATE.CaptionPadding = New System.Windows.Forms.Padding(0, 0, 6, 0)
Me.TXT_FROM_DATE.CaptionText = "From"
Me.TXT_FROM_DATE.CaptionWidth = 40.0R
Me.TXT_FROM_DATE.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_FROM_DATE.Location = New System.Drawing.Point(3, 3)
Me.TXT_FROM_DATE.Name = "TXT_FROM_DATE"
Me.TXT_FROM_DATE.PlaceholderEnabled = True
Me.TXT_FROM_DATE.PlaceholderText = "h:mm:ss"
Me.TXT_FROM_DATE.Size = New System.Drawing.Size(141, 22)
Me.TXT_FROM_DATE.TabIndex = 0
'
'TXT_TO_DATE
'
Me.TXT_TO_DATE.CaptionPadding = New System.Windows.Forms.Padding(0, 0, 6, 0)
Me.TXT_TO_DATE.CaptionText = "To"
Me.TXT_TO_DATE.CaptionWidth = 40.0R
Me.TXT_TO_DATE.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TO_DATE.Location = New System.Drawing.Point(150, 3)
Me.TXT_TO_DATE.Name = "TXT_TO_DATE"
Me.TXT_TO_DATE.PlaceholderEnabled = True
Me.TXT_TO_DATE.PlaceholderText = "h:mm:ss"
Me.TXT_TO_DATE.Size = New System.Drawing.Size(142, 22)
Me.TXT_TO_DATE.TabIndex = 1
'
'OPT_INT
'
Me.OPT_INT.AutoSize = True
Me.OPT_INT.CheckAlign = System.Drawing.ContentAlignment.MiddleCenter
Me.OPT_INT.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_INT.Location = New System.Drawing.Point(4, 4)
Me.OPT_INT.Name = "OPT_INT"
Me.OPT_INT.Size = New System.Drawing.Size(24, 19)
Me.OPT_INT.TabIndex = 0
Me.OPT_INT.TabStop = True
Me.OPT_INT.UseVisualStyleBackColor = True
'
'OPT_TIME
'
Me.OPT_TIME.AutoSize = True
Me.OPT_TIME.CheckAlign = System.Drawing.ContentAlignment.MiddleCenter
Me.OPT_TIME.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_TIME.Location = New System.Drawing.Point(4, 30)
Me.OPT_TIME.Name = "OPT_TIME"
Me.OPT_TIME.Size = New System.Drawing.Size(24, 19)
Me.OPT_TIME.TabIndex = 1
Me.OPT_TIME.TabStop = True
Me.OPT_TIME.UseVisualStyleBackColor = True
'
'TP_TIME_INT
'
Me.TP_TIME_INT.ColumnCount = 2
Me.TP_TIME_INT.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
Me.TP_TIME_INT.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
Me.TP_TIME_INT.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.TP_TIME_INT.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
Me.TP_TIME_INT.Controls.Add(Me.TXT_FROM_INT, 0, 0)
Me.TP_TIME_INT.Controls.Add(Me.TXT_TO_INT, 1, 0)
Me.TP_TIME_INT.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_TIME_INT.Location = New System.Drawing.Point(32, 1)
Me.TP_TIME_INT.Margin = New System.Windows.Forms.Padding(0)
Me.TP_TIME_INT.Name = "TP_TIME_INT"
Me.TP_TIME_INT.RowCount = 1
Me.TP_TIME_INT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_TIME_INT.Size = New System.Drawing.Size(295, 25)
Me.TP_TIME_INT.TabIndex = 2
'
'TXT_FROM_INT
'
Me.TXT_FROM_INT.CaptionPadding = New System.Windows.Forms.Padding(0, 0, 6, 0)
Me.TXT_FROM_INT.CaptionText = "From"
Me.TXT_FROM_INT.CaptionWidth = 40.0R
Me.TXT_FROM_INT.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_FROM_INT.Location = New System.Drawing.Point(3, 3)
Me.TXT_FROM_INT.Name = "TXT_FROM_INT"
Me.TXT_FROM_INT.Size = New System.Drawing.Size(141, 22)
Me.TXT_FROM_INT.TabIndex = 0
'
'TXT_TO_INT
'
Me.TXT_TO_INT.CaptionPadding = New System.Windows.Forms.Padding(0, 0, 6, 0)
Me.TXT_TO_INT.CaptionText = "To"
Me.TXT_TO_INT.CaptionWidth = 40.0R
Me.TXT_TO_INT.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_TO_INT.Location = New System.Drawing.Point(150, 3)
Me.TXT_TO_INT.Name = "TXT_TO_INT"
Me.TXT_TO_INT.Size = New System.Drawing.Size(142, 22)
Me.TXT_TO_INT.TabIndex = 1
'
'TrimOptionForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(334, 112)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(350, 151)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(350, 151)
Me.Name = "TrimOptionForm"
Me.ShowIcon = False
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Trim option"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).EndInit()
TP_OPTIONS.ResumeLayout(False)
TP_OPTIONS.PerformLayout()
Me.TP_TIME_TIME.ResumeLayout(False)
CType(Me.TXT_FROM_DATE, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_TO_DATE, System.ComponentModel.ISupportInitialize).EndInit()
Me.TP_TIME_INT.ResumeLayout(False)
CType(Me.TXT_FROM_INT, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_TO_INT, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Private WithEvents TXT_NAME As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents OPT_INT As RadioButton
Private WithEvents OPT_TIME As RadioButton
Private WithEvents TP_TIME_INT As TableLayoutPanel
Private WithEvents TP_TIME_TIME As TableLayoutPanel
Private WithEvents TXT_FROM_DATE As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_TO_DATE As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_FROM_INT As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_TO_INT As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class
End Namespace

View File

@@ -0,0 +1,138 @@
<?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>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
vgAADr4B6kKxwAAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value>
</data>
<metadata name="TP_OPTIONS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
</root>

View File

@@ -0,0 +1,79 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API.YouTube.Base
Namespace API.YouTube.Controls
Friend Class TrimOptionForm
Private WithEvents MyDefs As DefaultFormOptions
Friend Property MyTrimOption As TrimOption
Private ReadOnly FieldsDateProvider As New CustomProvider(Function(v) AConvert(Of TimeSpan)(v, Nothing, EDP.ReturnValue))
Private ReadOnly TCE As New ErrorsDescriber(False, False, False, New TimeSpan)
Friend Sub New(Optional ByVal Opt As TrimOption = Nothing)
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, MyYouTubeSettings.DesignXml)
MyTrimOption = Opt
End Sub
Private Sub TrimOptionForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
With MyDefs
.MyViewInitialize()
.AddOkCancelToolbar()
TXT_NAME.Text = MyTrimOption.Name
TXT_FROM_INT.Text = MyTrimOption.Start
TXT_TO_INT.Text = MyTrimOption.End
OPT_INT.Checked = True
.MyFieldsCheckerE = New FieldsChecker
With .MyFieldsCheckerE
.AddControl(Of Integer)(TXT_FROM_INT, "From")
.AddControl(Of Integer)(TXT_TO_INT, "To")
.AddControl(Of String)(TXT_FROM_DATE, "From (time)",, FieldsDateProvider)
.AddControl(Of String)(TXT_TO_DATE, "To (time)",, FieldsDateProvider)
.EndLoaderOperations()
End With
.EndLoaderOperations()
End With
Catch ex As Exception
MyDefs.InvokeLoaderError(ex)
End Try
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
If MyDefs.MyFieldsChecker.AllParamsOK Then
MyTrimOption = New TrimOption With {
.Name = TXT_NAME.Text,
.Start = AConvert(Of Integer)(TXT_FROM_INT.Text, 0),
.[End] = AConvert(Of Integer)(TXT_TO_INT.Text, 0)
}
MyDefs.CloseForm()
End If
End Sub
Private Sub OPT_INT_TIME_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_INT.CheckedChanged, OPT_TIME.CheckedChanged
TP_TIME_INT.Enabled = OPT_INT.Checked
TP_TIME_TIME.Enabled = OPT_TIME.Checked
End Sub
Private _TextHandlersEnabled As Boolean = True
Private Sub TXT_FROM_TO_TextChanged(sender As Object, e As EventArgs) Handles TXT_FROM_INT.ActionOnTextChanged, TXT_TO_INT.ActionOnTextChanged,
TXT_FROM_DATE.ActionOnTextChanged, TXT_TO_DATE.ActionOnTextChanged
If _TextHandlersEnabled Then
_TextHandlersEnabled = False
Select Case DirectCast(sender, Control).Name
Case TXT_FROM_INT.Name : TXT_FROM_DATE.Value = AConvert(Of String)(TimeSpan.FromSeconds(AConvert(Of Integer)(TXT_FROM_INT.Text, 0)), TimeToStringProviderH)
Case TXT_TO_INT.Name : TXT_TO_DATE.Value = AConvert(Of String)(TimeSpan.FromSeconds(AConvert(Of Integer)(TXT_TO_INT.Text, 0)), TimeToStringProviderH)
Case TXT_FROM_DATE.Name : TXT_FROM_INT.Text = CInt(CType(AConvert(Of TimeSpan)(TXT_FROM_DATE.Text, TCE), TimeSpan).TotalSeconds)
Case TXT_TO_DATE.Name : TXT_TO_INT.Text = CInt(CType(AConvert(Of TimeSpan)(TXT_TO_DATE.Text, TCE), TimeSpan).TotalSeconds)
End Select
_TextHandlersEnabled = True
End If
End Sub
End Class
End Namespace

View File

@@ -22,37 +22,36 @@ Namespace API.YouTube.Controls
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
Me.OPT_CHECKED = New System.Windows.Forms.RadioButton()
Me.LBL_DEFINITION_INFO = New System.Windows.Forms.Label()
Me.LBL_DEFINITION = New System.Windows.Forms.Label()
Me.LBL_CODECS = New System.Windows.Forms.Label()
Me.LBL_SIZE = New System.Windows.Forms.Label()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_MAIN.SuspendLayout()
Me.TP_MAIN.SuspendLayout()
Me.SuspendLayout()
'
'TP_MAIN
'
TP_MAIN.ColumnCount = 5
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 36.0!))
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 110.0!))
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 58.0!))
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, 71.0!))
TP_MAIN.Controls.Add(Me.OPT_CHECKED, 0, 0)
TP_MAIN.Controls.Add(Me.LBL_DEFINITION_INFO, 1, 0)
TP_MAIN.Controls.Add(Me.LBL_DEFINITION, 2, 0)
TP_MAIN.Controls.Add(Me.LBL_CODECS, 3, 0)
TP_MAIN.Controls.Add(Me.LBL_SIZE, 4, 0)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Margin = New System.Windows.Forms.Padding(0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 1
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(459, 30)
TP_MAIN.TabIndex = 0
Me.TP_MAIN.ColumnCount = 5
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 36.0!))
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 110.0!))
Me.TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 58.0!))
Me.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.Absolute, 71.0!))
Me.TP_MAIN.Controls.Add(Me.OPT_CHECKED, 0, 0)
Me.TP_MAIN.Controls.Add(Me.LBL_DEFINITION_INFO, 1, 0)
Me.TP_MAIN.Controls.Add(Me.LBL_DEFINITION, 2, 0)
Me.TP_MAIN.Controls.Add(Me.LBL_CODECS, 3, 0)
Me.TP_MAIN.Controls.Add(Me.LBL_SIZE, 4, 0)
Me.TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_MAIN.Location = New System.Drawing.Point(0, 0)
Me.TP_MAIN.Margin = New System.Windows.Forms.Padding(0)
Me.TP_MAIN.Name = "TP_MAIN"
Me.TP_MAIN.RowCount = 1
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(459, 30)
Me.TP_MAIN.TabIndex = 0
'
'OPT_CHECKED
'
@@ -115,11 +114,11 @@ Namespace API.YouTube.Controls
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.Controls.Add(TP_MAIN)
Me.Controls.Add(Me.TP_MAIN)
Me.Name = "VideoOption"
Me.Size = New System.Drawing.Size(459, 30)
TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout()
Me.TP_MAIN.ResumeLayout(False)
Me.TP_MAIN.PerformLayout()
Me.ResumeLayout(False)
End Sub
@@ -128,5 +127,6 @@ Namespace API.YouTube.Controls
Private WithEvents LBL_DEFINITION As Label
Private WithEvents LBL_CODECS As Label
Private WithEvents LBL_SIZE As Label
Private WithEvents TP_MAIN As TableLayoutPanel
End Class
End Namespace

View File

@@ -117,7 +117,4 @@
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
</root>

View File

@@ -8,10 +8,14 @@
' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports SCrawler.API.YouTube.Base
Imports SCrawler.API.YouTube.Objects
Imports UMTypes = SCrawler.Plugin.UserMediaTypes
Namespace API.YouTube.Controls
<DefaultEvent("CheckedChanged"), DesignTimeVisible(False), ToolboxItem(False)>
Friend Class VideoOption : Implements ISupportInitialize
Friend Event CheckedChanged As EventHandler
Private Const DRC As String = YouTubeMediaContainerBase.DRC
Private Const StringDelimiter As String = " " & ChrW(183) & " "
<Browsable(False)> Friend Property MyMedia As MediaObject
<Browsable(False)> Friend Property Checked As Boolean
Get
@@ -21,16 +25,43 @@ Namespace API.YouTube.Controls
OPT_CHECKED.Checked = _Checked
End Set
End Property
<Browsable(False)> Friend ReadOnly Property ContentType As UMTypes
Get
If MyMedia.Type = UMTypes.Audio Then
Return UMTypes.Audio
ElseIf MyMedia.Type = UMTypes.Video Or MyMedia.Type = YouTubeMediaContainerBase.TypeAudioVideo Then
Return UMTypes.Video
Else
Return UMTypes.Undefined
End If
End Get
End Property
Private _CodecLength As Integer = 0
<Browsable(False)> Friend ReadOnly Property CodecLengthBase As Integer
Get
With TP_MAIN.ColumnStyles
Return .Item(0).Width + .Item(1).Width + .Item(2).Width + .Item(4).Width
End With
End Get
End Property
<Browsable(False)> Friend ReadOnly Property CodecLength As Integer
Get
Return Math.Max(LBL_CODECS.PreferredWidth, _CodecLength)
End Get
End Property
Friend Sub SetAudioChangingHandler(ByVal obj As VideoOptionsForm)
AddHandler obj.AudioIndexChanged, AddressOf AudioChanged
End Sub
Friend Sub New()
InitializeComponent()
End Sub
Friend Sub New(ByVal m As MediaObject, Optional ByVal SelectedAudio As MediaObject = Nothing)
Me.New
Const d$ = " " & ChrW(183) & " "
Const DRC$ = Objects.YouTubeMediaContainerBase.DRC
MyMedia = m
If m.Type = Plugin.UserMediaTypes.Audio Then
If m.Bitrate >= 320 Then
If Not m.FormatQuality.IsEmptyString Then
LBL_DEFINITION_INFO.Text = $"{m.FormatQuality.ToUpperFirstChar} Quality"
ElseIf m.Bitrate >= 320 Then
LBL_DEFINITION_INFO.Text = "High Quality"
ElseIf m.Bitrate >= 190 Then
LBL_DEFINITION_INFO.Text = "Medium Quality"
@@ -38,8 +69,8 @@ Namespace API.YouTube.Controls
LBL_DEFINITION_INFO.Text = "Low Quality"
End If
LBL_DEFINITION.Text = $"{m.Bitrate}k"
LBL_CODECS.Text = $"{m.Extension} {d} {m.Codec} {d} {m.Bitrate}k"
If Not m.ID.IsEmptyString AndAlso m.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $" {d} DRC"
'LBL_CODECS.Text = $"{m.Extension} {d} {m.Codec} {d} {m.Bitrate}k{If(m.LanguageCaption.IsEmptyString, String.Empty, $" {d} {m.LanguageCaption}")}"
'If Not m.ID.IsEmptyString AndAlso m.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $" {d} DRC"
Else
If m.Height >= 1440 Then
LBL_DEFINITION_INFO.Text = "Ultra High Definition"
@@ -53,11 +84,13 @@ Namespace API.YouTube.Controls
LBL_DEFINITION_INFO.Text = "Low Definition"
End If
LBL_DEFINITION.Text = $"{m.Height}p"
LBL_CODECS.Text = $"{m.Extension.StringToUpper}{d}{m.Codec.StringToUpper}{d}{m.FPS}fps{d}{m.Bitrate}k"
If Not m.Protocol.IsEmptyString Then LBL_CODECS.Text &= $" ({m.Protocol})"
If Not m.ID.IsEmptyString AndAlso m.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC"
If Not SelectedAudio.ID.IsEmptyString Then LBL_CODECS.Text &= $" / {SelectedAudio.Extension}{d}{SelectedAudio.Codec}{d}{SelectedAudio.Bitrate}k"
If Not SelectedAudio.ID.IsEmptyString AndAlso SelectedAudio.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC"
'LBL_CODECS.Text = $"{m.Extension.StringToUpper}{d}{m.Codec.StringToUpper}{d}{m.FPS}fps{d}{m.Bitrate}k"
'If Not m.Protocol.IsEmptyString Then LBL_CODECS.Text &= $" ({m.Protocol})"
'If Not m.ID.IsEmptyString AndAlso m.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC"
'With SelectedAudio
' If Not .ID.IsEmptyString Then LBL_CODECS.Text &= $" / {If(.LanguageCaption.IsEmptyString, String.Empty, $"{ .LanguageCaption} {d}")}{ .Bitrate}k ({ .Extension}, { .Codec})"
' If Not .ID.IsEmptyString AndAlso .ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC"
'End With
If MyYouTubeSettings.DefaultVideoHighlightFPS_H > 0 AndAlso m.FPS > MyYouTubeSettings.DefaultVideoHighlightFPS_H Then _
BackColor = MyColor.DeleteBack : ForeColor = MyColor.DeleteFore
@@ -65,6 +98,8 @@ Namespace API.YouTube.Controls
BackColor = MyColor.UpdateBack : ForeColor = MyColor.UpdateFore
End If
GenerateInfoCaption(SelectedAudio)
Dim sv% = m.Size / 1024
If sv >= 1000 Then
LBL_SIZE.Text = AConvert(Of String)(sv / 1024, VideoSizeProvider)
@@ -74,9 +109,36 @@ Namespace API.YouTube.Controls
LBL_SIZE.Text &= " MB"
End If
End Sub
Private Sub GenerateInfoCaption(ByVal SelectedAudio As MediaObject)
Const d$ = StringDelimiter
If ContentType = UMTypes.Audio Then
With MyMedia
LBL_CODECS.Text = $"{ .Extension} {d} { .Codec} {d} { .Bitrate}k{If(.LanguageCaption.IsEmptyString, String.Empty, $" {d} { .LanguageCaption(True)}")}"
If Not .ID.IsEmptyString AndAlso .ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $" {d} DRC"
End With
Else
With MyMedia
LBL_CODECS.Text = $"{ .Extension.StringToUpper}{d}{ .Codec.StringToUpper}{d}{ .FPS}fps{d}{ .Bitrate}k"
If Not .Protocol.IsEmptyString Then LBL_CODECS.Text &= $" ({ .Protocol})"
If Not .ID.IsEmptyString AndAlso .ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC"
_CodecLength = LBL_CODECS.Text.MeasureTextDefault(LBL_CODECS.Font).Width
End With
With SelectedAudio
If Not .ID.IsEmptyString Then LBL_CODECS.Text &= $" / {If(.LanguageCaption.IsEmptyString, String.Empty, $"{ .LanguageCaption} {d}")}{ .Bitrate}k ({ .Extension}, { .Codec})"
If Not .ID.IsEmptyString AndAlso .ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC"
End With
End If
End Sub
Private Sub OPT_CHECKED_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_CHECKED.CheckedChanged
RaiseEvent CheckedChanged(Me, e)
End Sub
Private Sub AudioChanged(ByVal Sender As Object, ByVal e As EventArgs)
If ContentType = UMTypes.Video AndAlso Not Sender Is Nothing Then
With DirectCast(Sender, VideoOption)
If .ContentType = UMTypes.Audio And .Checked Then GenerateInfoCaption(.MyMedia)
End With
End If
End Sub
Private Sub Labels_Click(sender As Object, e As EventArgs) Handles LBL_DEFINITION_INFO.Click, LBL_DEFINITION.Click, LBL_CODECS.Click, LBL_SIZE.Click
OPT_CHECKED.Checked = True
End Sub

View File

@@ -73,6 +73,7 @@ Namespace API.YouTube.Controls
Me.OPT_VIDEO = New System.Windows.Forms.RadioButton()
Me.OPT_AUDIO = New System.Windows.Forms.RadioButton()
Me.LBL_AUDIO_CODEC = New System.Windows.Forms.Label()
Me.BTT_TRIM = New System.Windows.Forms.Button()
Me.TXT_FPS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_AUDIO_BITRATE = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TP_HEADER_BASE = New System.Windows.Forms.TableLayoutPanel()
@@ -545,20 +546,32 @@ Namespace API.YouTube.Controls
Me.LBL_AUDIO_CODEC.TextAlign = System.Drawing.ContentAlignment.MiddleRight
TT_MAIN.SetToolTip(Me.LBL_AUDIO_CODEC, "Output Audio Codec")
'
'BTT_TRIM
'
Me.BTT_TRIM.Dock = System.Windows.Forms.DockStyle.Fill
Me.BTT_TRIM.Location = New System.Drawing.Point(541, 3)
Me.BTT_TRIM.Name = "BTT_TRIM"
Me.BTT_TRIM.Size = New System.Drawing.Size(45, 22)
Me.BTT_TRIM.TabIndex = 2
Me.BTT_TRIM.Text = "Trim"
TT_MAIN.SetToolTip(Me.BTT_TRIM, "Trim the file by setting trimming options and/or selecting chapters")
Me.BTT_TRIM.UseVisualStyleBackColor = True
'
'TP_FPS_BITRATE
'
TP_FPS_BITRATE.ColumnCount = 2
TP_FPS_BITRATE.ColumnCount = 3
TP_FPS_BITRATE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_FPS_BITRATE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_FPS_BITRATE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 51.0!))
TP_FPS_BITRATE.Controls.Add(Me.TXT_FPS, 0, 0)
TP_FPS_BITRATE.Controls.Add(Me.TXT_AUDIO_BITRATE, 1, 0)
TP_FPS_BITRATE.Controls.Add(Me.BTT_TRIM, 2, 0)
TP_FPS_BITRATE.Dock = System.Windows.Forms.DockStyle.Fill
TP_FPS_BITRATE.Location = New System.Drawing.Point(6, 93)
TP_FPS_BITRATE.Margin = New System.Windows.Forms.Padding(6, 0, 6, 0)
TP_FPS_BITRATE.Name = "TP_FPS_BITRATE"
TP_FPS_BITRATE.RowCount = 1
TP_FPS_BITRATE.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_FPS_BITRATE.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_FPS_BITRATE.Size = New System.Drawing.Size(589, 28)
TP_FPS_BITRATE.TabIndex = 6
'
@@ -577,7 +590,7 @@ Namespace API.YouTube.Controls
Me.TXT_FPS.Location = New System.Drawing.Point(3, 2)
Me.TXT_FPS.Margin = New System.Windows.Forms.Padding(3, 2, 3, 3)
Me.TXT_FPS.Name = "TXT_FPS"
Me.TXT_FPS.Size = New System.Drawing.Size(288, 22)
Me.TXT_FPS.Size = New System.Drawing.Size(263, 22)
Me.TXT_FPS.TabIndex = 0
Me.TXT_FPS.TextBoxWidthMinimal = 30
'
@@ -593,9 +606,9 @@ Namespace API.YouTube.Controls
" to change."
Me.TXT_AUDIO_BITRATE.CaptionWidth = 75.0R
Me.TXT_AUDIO_BITRATE.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_AUDIO_BITRATE.Location = New System.Drawing.Point(297, 3)
Me.TXT_AUDIO_BITRATE.Location = New System.Drawing.Point(272, 3)
Me.TXT_AUDIO_BITRATE.Name = "TXT_AUDIO_BITRATE"
Me.TXT_AUDIO_BITRATE.Size = New System.Drawing.Size(289, 22)
Me.TXT_AUDIO_BITRATE.Size = New System.Drawing.Size(263, 22)
Me.TXT_AUDIO_BITRATE.TabIndex = 1
'
'TP_HEADER_BASE
@@ -920,5 +933,6 @@ Namespace API.YouTube.Controls
Private WithEvents CMB_PLS As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents BTT_PLS_BROWSE As SCrawler.API.YouTube.Controls.ButtonRC
Private WithEvents TXT_AUDIO_BITRATE As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents BTT_TRIM As Button
End Class
End Namespace

View File

@@ -139,98 +139,96 @@
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAFFJREFUOE9joAr49u3bf1Lw169f50O1QgBI0MnJCY4/vP8Ix8hiILqtrQ3TEFIM
AGGYIVDtpBsAwkQbgIyR1dDWAGLwqAGD0gByMFQ7JYCBAQChNviRiQ8ETwAAAABJRU5ErkJggg==
vAAADrwBlbxySQAAAEhJREFUOE9jYKAG+Pbt239S8NevX+djGODk5ATHH95/hGNkMRDd1taGaQgpBiAb
QrYBIEy0AdgMo70BxOBRAwalAeRguAGUAAChNviRcuLCdwAAAABJRU5ErkJggg==
</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
iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE0xJREFUeF7t
3X2MZWddB/BZSkspUFsoXZidOc/vnOfsTmGgARaaBgK2VkFBsIAEgkAQsX8QNJFEq39oMMEoSDREElOB
EFAKCkhEAUGqQlsLQkoBlZfy1kJ5awH7QrvtbldzdndmZ597Snd37szce8/nk3xTQjsz5/zOefbO3vO9
58zNAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
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
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwJQ6e/v2BzQpPSNHvLap4sM5xVeaFLflFP/XpfvfTYqvHfx3
6XXdf9t9Tfl9AIApkFM6P1fxrpzixysv9seQ7msu7b5H+X0BgAl04IU/4j97XtSPN1e1EeeVPwcAmAC7
5ned0aT07p4X8HFkf5viHWft2PGQ8ucCky8iTq7r+uwmpefkqr6ojfitnOpXtlX94qaqLsg5L5ZfA0yB
nXX9lJzihp4X7nHnupzSE8ufD0yeuq6Xmir+IKd0eU5xZ896LvO9nOKdbVW/SA8IpkCOeEFOsadnMW9U
7mxSelm5HcBE2NZW9TNzqq/oWbvHkluaVL+xaZqq/AHABGhS+pWc4u6exbsJqV8/Nzd3QrlNwNZoFpsn
tFV8cnStrit3dmt9+aHLDyx/HrBF2rp+ak5xV8+C3bS0Kf3j0tLSg8ptAzbPeXNz922r+OMN/ctAFdd3
lxrLnw1ssu5tuZzippFFuiVJn4+IKLcR2HgppYfnFFeOrsuNSNrbpvSqchuAzXOfMVzfG3e+l6vqSeWG
AhunjTh3k8q/RdKfdl2DcnuADZar+tdHF+RE5M4c8dJye4Hx65r6OcXtPetwk1K/ptwmYAN1H83JKb4/
uhgnJ23En3TvUpTbDqzf7t27T+za+eW625JU9UXl9gEb5ODNO3oW4uTlg23bnlpuP3D8upt95RSX9ay3
rcpdioGwObZ1D+3pWYQTmTbFNT5DDOPRpvS4gzfiGl1rW5xvV1V1erm9wBh1JbuexTfhSTf6GwKsz6Gb
fR3PQ702JW2Kt5TbDIxR17wtF96U5I7uhkXl/gD36oTuJjw9a2rSsr+7CVG58cCY5FR/umfhTU8i3qAc
CEdnYWHhwW3ER0bW0eTmA+U+AGOwvLx8Uk6xr2fRTVve6yEj8JM1C82jc4qv9qyfiU5bVY8s9wVYp50p
PaJcbFOczyoHQr+DD/KJm3vWzRTkwA2CgHE6dN//ngU3tfl2XdfnlPsJA9bd4fM13fX0nvUyLbmu3Clg
ndqq/uWexTbt2dPdzazcVxia7oFaOcX7etbI1KVpml3l/gHr0KT0wnKhzUj2txF/6L7iDFVEnJVTfLFn
bUxlmpReVu4jsA454sJyoc1SmpTePT8/f0q53zDLmpSenlP8qFwP05369eV+AutQL9ZPHl1os5b0qaXF
xfly32EGbcup/v2c4u7RdTDdaSLeX+4ssA67FhZ2lAttRnODG4owy5YfuvzANtXv6Tn3ZyMRHy/3GVif
bbP3VuE95sdd6bEcAEy7vJDbnNLne875mUmT4jPlfgPr1N1pq1xsM5yuHNg9Vlg5kJnQRjwtp/hhz7k+
a7mq3HdgnaboUcDjzKURcXI5C5gmOdW/PSN38jyK1B8t9x9Yp64gN4uloaPI1e2OdqGcB0y67pfXHPG2
nnN6ZuPJgLBBpuzhIONLFdfvjHhMOQ+YVHVdp+6X15FzedZTxe+UswDGYAZvCXzUaVLcllN6djkTmDSH
Prb73fIcHkLaiPPKeQDj0X0a4Mpy0Q0od7cRv1cOBSZFrurfyCnt7Tl3h5DbdXZgAzWLzeMH2gVYk/T2
tm3vV84GtsqB6/1VvHX0XB1U3lfOBRiznNLrehbf0HJVXdfby9nAZusKuk2KT/Sco8NKxIXlbIAx2717
94n+wDmQb9R1fXY5H9gsuaqelFN8p+fcHFqu6/5cKucDbIC2bR+aq/hyz0IcWNKt/ubBVshVfVFOcefo
OTm8tCm9opwPsIEO3lo0vlEuxgHm7u5mK+V8YCMsLy+flKv4y57zcJBpU3xBJwe2wMEHBc32/cWPOlW8
1R9EbKSud5JTunzk3Btu9u+s66eUcwI2SfeEsRzxDz2Lc4i5UjmQjdCm9FjvuJWp/6icE7D5TmhS/Nno
Ah1emhRfy4v5UeWA4Hjlqn5JTnFHea4NOd2dSbs/d8pZAVukTenXFJO6pFvbxfpZ5XzgGJ3QPZly9Pwa
fK5aWlp6UDksYIt11+RySjf2LNqhZV+b0qvK+cDR2DW/64yc4rKe82rouSwiTivnBUyIXVXV5BT/1bN4
B5j0pq65Xc4I7kn38Kmc4uuj59Kw06T6zT7vD1NAOXBt6ityzmeWM4JSjnj+wYdPlefQkJP2NlVcXM4K
mGyuYR7OV9uqemQ5IDhkWxvx6u6jbT3nzoDTXU5MP1MOC5gSyoGruaWpml8s58OwtW17qnfLRtOk+ExE
RDkvYMocum/598pFPsDs83YmK+q6XuruZtdzngw975yfnz+lnBcwpZQD1yb9lULTsHXvBuUU/zt6bgw6
fkGGWaUcuCYRH+8erFTOiJm3rXuRO/gciZ7zYqBpU/ygruqfK4cFzBblwMP5ys6UHlEOiNnU3cAmp/j7
nvNg6Pls9w5hOS9gRikHrubmJqVnlPNhthx6gqZLYGUi/u7s7dsfUM4LmHHKgavZl6v4zXI+zIYc8fM5
xQ97jvuQs797J7C7JFLOCxgI5cA1ibhEOXCmrFzv3zdyrIedm9uIXyqHBQyQcuDhdE86c7/z6de9rd29
vV0eX4kv6b0AJeXA1aRrI+KsckBMh5zzYk71p0eP69BT/1PTND9VzgvgAOXAg+k+FuU2qNPn4BMx9VqK
rFzvv085L4AjKAeuJO3NqX5lOR8mU67qi3KKu0aP45CTbm1Sek45K4B7pBy4JhGXnDc3d99yRkyGiDg5
V/HWkeM2+KRr26paLucFcK+UAw+nqeLDyoGTZ9fCwo62ik+Wx0viQ1VVnV7OC+BYKAeupIovdw+QKQfE
1jh0qeo7I8dp2Fm53n9COS+A46IceDCHyoHnl/Nhcx263j/483FtmhS3tVX9vHJWAOumHLiStLdN6RXl
fNh4bdveL6f0ptFjMvBUcX2uqt3lvADGRjlwTSLe4K3WzbO0uDifU/zHyHGQf885n1nOC2DslAOPyIfc
XGXjtSk9Lqe4rmf+w47bVwNbQDlwNenzSynV5YAYj7aqX5RT3D4690Hnjhzx0nJWAJtGOXA1N7URP13O
h+PX3XvBL5l9Sd9sFpsnlPMC2HTKgau509/KxmPX/K4zcorLemY88KTL67reXs4LYMsoB67JwXKg+64f
p50Rj8kpvj4y16HH9X5gUikHHpEPtm17ajkjfrIc8YKc4sc98xxy9nSX2spZAUwa5cCVRHwuIqIcEL2c
N/25oY04txwWwMRSDlxJurF7RG05Hw5bWFh4cBvxkdHZDT5XppQeXs4LYOIpB65mT67ql5TzYW6uWWge
nVN8tWdmw07EJcvLyyeV8wKYGsqBa6IceIS2qp+ZU9w8MqdBJ+1tqri4nBXAVFIOPCLvPXv79geUMxqY
bd2LXE5xd898hpzvtxHnlcMCmHZKXofz2aZpqnJAQ7C0tPSgnOJ9PTMZeq6u6zqV8wKYGcqBq/l2Xdfn
lPOZZc1CszOn+J+eWQw6bar/ZmFh4f7lvABmjnLgavZ097kv5zOLmpSenlP8qGcGA47r/cAAKQeuZn93
aWSGy4Gu9/fnpqaqLiiHBTAIyoGH06T07vn5+VPKGU2z7vi2qX5Pua9DT5viGk+PBFAOXE2T4jOzUg5s
Fxdz95jkch8l3jlrv+gBrIty4GpumPZHvbYRT8spftizb0POvkPX+7eV8wIYPOXA1dzRpPTCcj7TIFf1
RV25rWefBps2xQ/aun5qOSsA1lAOXM1KOXAq/sYYESfniLf17MewE/G57pwu5wVAD+XANYn420m/Ztzu
aBdySp8a2faBp4l4v0dCAxw75cDDubp7kS0HNAnqxfrJOcV3e7Z5yJn1j3YCbDzlwNV8K1fV7nI+W+ng
9f64q2dbh5xbcsSF5awAOA7KgQfTpLgtp/Tscj6brW3b+7Up3lJun8SXdqb0iHJeAKyDcuBqureXX71V
5cClxcX5JsUnerZr6PlARJxWzguAMVAOXJMq3rXZD5DJKT2xe4jRyLYMO673A2wS5cDDuaqu6+3lgDbC
oev9uhhHJN3apPTcclYAbCDlwJWkb7YpPa6cz7icNzd3X79w9SVdmxfzo8p5AbAJlANXkm7diOb5rvld
Z+QU/zb68wafD1VVdXo5LwA2kXLgalbKgWPRpvTYnOIbPT9nyFm53n9COS8AtoBy4BG5tLstbzmjY9E9
hyCnuL3new85d7RV/eJyVgBsPeXAw7nyOMuBZtiXKq6ftJswAVBoUnqZcmCXA+XAx5bzuSdn7djxkJzS
v4x+n2GnqeJjOeczy3kBMIGUA1eSbm0X62eV8ynVdX12k+Jro18/8ERcsnv37hPLeQEwwZQDV7OvqeLi
cj4rcsTzD95ieOTrhpw7csRLy1kBMCWUAw+nSfWbl5eXT1oznm3dpwa6Znv53w4836rr+pw1cwJgSim2
raa+orue3T2j3i9GfUmXR8TDyhMIgCnmzoGr+cqBu9iN/v+DTpPqN7reDzCjlAOlJ3vaVL+8PFcAmDHK
gbImN7QR55bnCAAzSjlQupslpZQeXp4bAMw+5cDBJr19vbdLBmDKuXPgkJL2/qR7IgAwMMqBQ0i6Mad0
fnnsARg45cCZztV1XafymAPAAcqBs5c2xTsWFhbuXx5rACgpB85EXO8H4DgoB051bmqq6oLymALAUVEO
nL60Ka5ZSqkujyUAHBPlwClKFe+an58/pTyGAHBclAMnPvsOXe/fVh47AFgv5cAJTJviB21dP7U8WAAw
VsqBE5UvRsRZ5TECgA2hHLj1aSLe37btqeWxAYANpRy4ZdnfXYqZm5u7T3lMAGBTKAduem7JEReWxwEA
toJy4Gakii+3VfXIcvgAsKWUAzc0H4iI08qZA8BEUA4ce1zvB2A6KAeOK+nWJqXnlvMFgImlHLjepGvz
Yn5UOVcAmAbKgceTKv65qqrTy2ECwFRRDjyGRLyh+8WpnCEATCXlwHvNHbmqX1LODQCmnnLgPaSK65vF
5vHlvABgZigHHpmmio/lnM8s5wQAs0g5sEvEJbt37z6xHA4AzLQBlwP3NBG/Ws4DAAZjgOXAb9V1fU45
BwAYnOGUA+srIuJh5f4DwGDNfDkw4pLl5eWTyv0GAGazHLinTfXLyx0FAAozVA68oY04t9w/AOAeTH85
sP500zRVuV8AwL2Y1nJgk9JfLyws3L/cHwDgKE1XOTDtbaq4uNwHAOD4TEE5MN2YUzq/3HAAYJ0muBx4
dV3XqdxeAGBMJrAceOn8/Pwp5XYCAGM2IeXAfa73A8Am2+Jy4E1N1fxsuU0AwOY4IUe8NqfY3/MivSFp
U1wTEVFuCACwydqqfmZO8Z3yxXrc6T7f73o/AEyQiDgtp/QXG/EpgTbFF3JKv1D+TABgQnQfx2ur+POc
4kflC/kx5u6c4l+blF7YXWoofw4AMIG6W/G2i/Wzckp/lVP896EX9PJFvkh3M5/6o03E7+acF8vvCQBM
mQO/EFTVctfezxEXtlX9vLaqX9z9s6mqC5YWF+fLrwEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA6LEtW/4flgYiLD1qeX0A
AAAASUVORK5CYII=
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAYIj+H5YGIizEb/aEAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
@@ -248,115 +246,113 @@
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAFFJREFUOE9joAr49u3bf1Lw169f50O1QgBI0MnJCY4/vP8Ix8hiILqtrQ3TEFIM
AGGYIVDtpBsAwkQbgIyR1dDWAGLwqAGD0gByMFQ7JYCBAQChNviRiQ8ETwAAAABJRU5ErkJggg==
vAAADrwBlbxySQAAAEhJREFUOE9jYKAG+Pbt239S8NevX+djGODk5ATHH95/hGNkMRDd1taGaQgpBiAb
QrYBIEy0AdgMo70BxOBRAwalAeRguAGUAAChNviRcuLCdwAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAeElE
QVQ4T2P4//8/RRhMFHQfKgDi/yAaXQEhDCZAmkNbnvyXta4CciESLEws//FhmDqYAQUgzUBMngsowVgF
ScFgYjQQsUsQi8FEYsXyAiD+D6LRFRDCYAKk2bPo6H9J40wgFyKBLeCQMUwdzIACkGYgHnKB+J8BAD5Q
tqhi4tzWAAAAAElFTkSuQmCC
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsMAAALDAE/QCLIAAAAd0lE
QVQ4T2P4//8/AyUYTBR0Hyoo6D70H0SjKyCEYQb8D2158l/Wuuo/TIKFieU/PoxuQAFIs6x1FXkuoARj
CJCKwcRoIGIKkoLBRGLF8oLEiuX/QTS6AkIYZsB/z6Kj/yWNM8kLRJDNIM2SxpnkuYASjCFAKgYAPlC2
qCS4LQgAAAAASUVORK5CYII=
</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
vAAADrwBlbxySQAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton6.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
iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE0xJREFUeF7t
3X2MZWddB/BZSkspUFsoXZidOc/vnOfsTmGgARaaBgK2VkFBsIAEgkAQsX8QNJFEq39oMMEoSDREElOB
EFAKCkhEAUGqQlsLQkoBlZfy1kJ5awH7QrvtbldzdndmZ597Snd37szce8/nk3xTQjsz5/zOefbO3vO9
58zNAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
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
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAwJQ6e/v2BzQpPSNHvLap4sM5xVeaFLflFP/XpfvfTYqvHfx3
6XXdf9t9Tfl9AIApkFM6P1fxrpzixysv9seQ7msu7b5H+X0BgAl04IU/4j97XtSPN1e1EeeVPwcAmAC7
5ned0aT07p4X8HFkf5viHWft2PGQ8ucCky8iTq7r+uwmpefkqr6ojfitnOpXtlX94qaqLsg5L5ZfA0yB
nXX9lJzihp4X7nHnupzSE8ufD0yeuq6Xmir+IKd0eU5xZ896LvO9nOKdbVW/SA8IpkCOeEFOsadnMW9U
7mxSelm5HcBE2NZW9TNzqq/oWbvHkluaVL+xaZqq/AHABGhS+pWc4u6exbsJqV8/Nzd3QrlNwNZoFpsn
tFV8cnStrit3dmt9+aHLDyx/HrBF2rp+ak5xV8+C3bS0Kf3j0tLSg8ptAzbPeXNz922r+OMN/ctAFdd3
lxrLnw1ssu5tuZzippFFuiVJn4+IKLcR2HgppYfnFFeOrsuNSNrbpvSqchuAzXOfMVzfG3e+l6vqSeWG
AhunjTh3k8q/RdKfdl2DcnuADZar+tdHF+RE5M4c8dJye4Hx65r6OcXtPetwk1K/ptwmYAN1H83JKb4/
uhgnJ23En3TvUpTbDqzf7t27T+za+eW625JU9UXl9gEb5ODNO3oW4uTlg23bnlpuP3D8upt95RSX9ay3
rcpdioGwObZ1D+3pWYQTmTbFNT5DDOPRpvS4gzfiGl1rW5xvV1V1erm9wBh1JbuexTfhSTf6GwKsz6Gb
fR3PQ702JW2Kt5TbDIxR17wtF96U5I7uhkXl/gD36oTuJjw9a2rSsr+7CVG58cCY5FR/umfhTU8i3qAc
CEdnYWHhwW3ER0bW0eTmA+U+AGOwvLx8Uk6xr2fRTVve6yEj8JM1C82jc4qv9qyfiU5bVY8s9wVYp50p
PaJcbFOczyoHQr+DD/KJm3vWzRTkwA2CgHE6dN//ngU3tfl2XdfnlPsJA9bd4fM13fX0nvUyLbmu3Clg
ndqq/uWexTbt2dPdzazcVxia7oFaOcX7etbI1KVpml3l/gHr0KT0wnKhzUj2txF/6L7iDFVEnJVTfLFn
bUxlmpReVu4jsA454sJyoc1SmpTePT8/f0q53zDLmpSenlP8qFwP05369eV+AutQL9ZPHl1os5b0qaXF
xfly32EGbcup/v2c4u7RdTDdaSLeX+4ssA67FhZ2lAttRnODG4owy5YfuvzANtXv6Tn3ZyMRHy/3GVif
bbP3VuE95sdd6bEcAEy7vJDbnNLne875mUmT4jPlfgPr1N1pq1xsM5yuHNg9Vlg5kJnQRjwtp/hhz7k+
a7mq3HdgnaboUcDjzKURcXI5C5gmOdW/PSN38jyK1B8t9x9Yp64gN4uloaPI1e2OdqGcB0y67pfXHPG2
nnN6ZuPJgLBBpuzhIONLFdfvjHhMOQ+YVHVdp+6X15FzedZTxe+UswDGYAZvCXzUaVLcllN6djkTmDSH
Prb73fIcHkLaiPPKeQDj0X0a4Mpy0Q0od7cRv1cOBSZFrurfyCnt7Tl3h5DbdXZgAzWLzeMH2gVYk/T2
tm3vV84GtsqB6/1VvHX0XB1U3lfOBRiznNLrehbf0HJVXdfby9nAZusKuk2KT/Sco8NKxIXlbIAx2717
94n+wDmQb9R1fXY5H9gsuaqelFN8p+fcHFqu6/5cKucDbIC2bR+aq/hyz0IcWNKt/ubBVshVfVFOcefo
OTm8tCm9opwPsIEO3lo0vlEuxgHm7u5mK+V8YCMsLy+flKv4y57zcJBpU3xBJwe2wMEHBc32/cWPOlW8
1R9EbKSud5JTunzk3Btu9u+s66eUcwI2SfeEsRzxDz2Lc4i5UjmQjdCm9FjvuJWp/6icE7D5TmhS/Nno
Ah1emhRfy4v5UeWA4Hjlqn5JTnFHea4NOd2dSbs/d8pZAVukTenXFJO6pFvbxfpZ5XzgGJ3QPZly9Pwa
fK5aWlp6UDksYIt11+RySjf2LNqhZV+b0qvK+cDR2DW/64yc4rKe82rouSwiTivnBUyIXVXV5BT/1bN4
B5j0pq65Xc4I7kn38Kmc4uuj59Kw06T6zT7vD1NAOXBt6ityzmeWM4JSjnj+wYdPlefQkJP2NlVcXM4K
mGyuYR7OV9uqemQ5IDhkWxvx6u6jbT3nzoDTXU5MP1MOC5gSyoGruaWpml8s58OwtW17qnfLRtOk+ExE
RDkvYMocum/598pFPsDs83YmK+q6XuruZtdzngw975yfnz+lnBcwpZQD1yb9lULTsHXvBuUU/zt6bgw6
fkGGWaUcuCYRH+8erFTOiJm3rXuRO/gciZ7zYqBpU/ygruqfK4cFzBblwMP5ys6UHlEOiNnU3cAmp/j7
nvNg6Pls9w5hOS9gRikHrubmJqVnlPNhthx6gqZLYGUi/u7s7dsfUM4LmHHKgavZl6v4zXI+zIYc8fM5
xQ97jvuQs797J7C7JFLOCxgI5cA1ibhEOXCmrFzv3zdyrIedm9uIXyqHBQyQcuDhdE86c7/z6de9rd29
vV0eX4kv6b0AJeXA1aRrI+KsckBMh5zzYk71p0eP69BT/1PTND9VzgvgAOXAg+k+FuU2qNPn4BMx9VqK
rFzvv085L4AjKAeuJO3NqX5lOR8mU67qi3KKu0aP45CTbm1Sek45K4B7pBy4JhGXnDc3d99yRkyGiDg5
V/HWkeM2+KRr26paLucFcK+UAw+nqeLDyoGTZ9fCwo62ik+Wx0viQ1VVnV7OC+BYKAeupIovdw+QKQfE
1jh0qeo7I8dp2Fm53n9COS+A46IceDCHyoHnl/Nhcx263j/483FtmhS3tVX9vHJWAOumHLiStLdN6RXl
fNh4bdveL6f0ptFjMvBUcX2uqt3lvADGRjlwTSLe4K3WzbO0uDifU/zHyHGQf885n1nOC2DslAOPyIfc
XGXjtSk9Lqe4rmf+w47bVwNbQDlwNenzSynV5YAYj7aqX5RT3D4690Hnjhzx0nJWAJtGOXA1N7URP13O
h+PX3XvBL5l9Sd9sFpsnlPMC2HTKgau509/KxmPX/K4zcorLemY88KTL67reXs4LYMsoB67JwXKg+64f
p50Rj8kpvj4y16HH9X5gUikHHpEPtm17ajkjfrIc8YKc4sc98xxy9nSX2spZAUwa5cCVRHwuIqIcEL2c
N/25oY04txwWwMRSDlxJurF7RG05Hw5bWFh4cBvxkdHZDT5XppQeXs4LYOIpB65mT67ql5TzYW6uWWge
nVN8tWdmw07EJcvLyyeV8wKYGsqBa6IceIS2qp+ZU9w8MqdBJ+1tqri4nBXAVFIOPCLvPXv79geUMxqY
bd2LXE5xd898hpzvtxHnlcMCmHZKXofz2aZpqnJAQ7C0tPSgnOJ9PTMZeq6u6zqV8wKYGcqBq/l2Xdfn
lPOZZc1CszOn+J+eWQw6bar/ZmFh4f7lvABmjnLgavZ097kv5zOLmpSenlP8qGcGA47r/cAAKQeuZn93
aWSGy4Gu9/fnpqaqLiiHBTAIyoGH06T07vn5+VPKGU2z7vi2qX5Pua9DT5viGk+PBFAOXE2T4jOzUg5s
Fxdz95jkch8l3jlrv+gBrIty4GpumPZHvbYRT8spftizb0POvkPX+7eV8wIYPOXA1dzRpPTCcj7TIFf1
RV25rWefBps2xQ/aun5qOSsA1lAOXM1KOXAq/sYYESfniLf17MewE/G57pwu5wVAD+XANYn420m/Ztzu
aBdySp8a2faBp4l4v0dCAxw75cDDubp7kS0HNAnqxfrJOcV3e7Z5yJn1j3YCbDzlwNV8K1fV7nI+W+ng
9f64q2dbh5xbcsSF5awAOA7KgQfTpLgtp/Tscj6brW3b+7Up3lJun8SXdqb0iHJeAKyDcuBqureXX71V
5cClxcX5JsUnerZr6PlARJxWzguAMVAOXJMq3rXZD5DJKT2xe4jRyLYMO673A2wS5cDDuaqu6+3lgDbC
oev9uhhHJN3apPTcclYAbCDlwJWkb7YpPa6cz7icNzd3X79w9SVdmxfzo8p5AbAJlANXkm7diOb5rvld
Z+QU/zb68wafD1VVdXo5LwA2kXLgalbKgWPRpvTYnOIbPT9nyFm53n9COS8AtoBy4BG5tLstbzmjY9E9
hyCnuL3new85d7RV/eJyVgBsPeXAw7nyOMuBZtiXKq6ftJswAVBoUnqZcmCXA+XAx5bzuSdn7djxkJzS
v4x+n2GnqeJjOeczy3kBMIGUA1eSbm0X62eV8ynVdX12k+Jro18/8ERcsnv37hPLeQEwwZQDV7OvqeLi
cj4rcsTzD95ieOTrhpw7csRLy1kBMCWUAw+nSfWbl5eXT1oznm3dpwa6Znv53w4836rr+pw1cwJgSim2
raa+orue3T2j3i9GfUmXR8TDyhMIgCnmzoGr+cqBu9iN/v+DTpPqN7reDzCjlAOlJ3vaVL+8PFcAmDHK
gbImN7QR55bnCAAzSjlQupslpZQeXp4bAMw+5cDBJr19vbdLBmDKuXPgkJL2/qR7IgAwMMqBQ0i6Mad0
fnnsARg45cCZztV1XafymAPAAcqBs5c2xTsWFhbuXx5rACgpB85EXO8H4DgoB051bmqq6oLymALAUVEO
nL60Ka5ZSqkujyUAHBPlwClKFe+an58/pTyGAHBclAMnPvsOXe/fVh47AFgv5cAJTJviB21dP7U8WAAw
VsqBE5UvRsRZ5TECgA2hHLj1aSLe37btqeWxAYANpRy4ZdnfXYqZm5u7T3lMAGBTKAduem7JEReWxwEA
toJy4Gakii+3VfXIcvgAsKWUAzc0H4iI08qZA8BEUA4ce1zvB2A6KAeOK+nWJqXnlvMFgImlHLjepGvz
Yn5UOVcAmAbKgceTKv65qqrTy2ECwFRRDjyGRLyh+8WpnCEATCXlwHvNHbmqX1LODQCmnnLgPaSK65vF
5vHlvABgZigHHpmmio/lnM8s5wQAs0g5sEvEJbt37z6xHA4AzLQBlwP3NBG/Ws4DAAZjgOXAb9V1fU45
BwAYnOGUA+srIuJh5f4DwGDNfDkw4pLl5eWTyv0GAGazHLinTfXLyx0FAAozVA68oY04t9w/AOAeTH85
sP500zRVuV8AwL2Y1nJgk9JfLyws3L/cHwDgKE1XOTDtbaq4uNwHAOD4TEE5MN2YUzq/3HAAYJ0muBx4
dV3XqdxeAGBMJrAceOn8/Pwp5XYCAGM2IeXAfa73A8Am2+Jy4E1N1fxsuU0AwOY4IUe8NqfY3/MivSFp
U1wTEVFuCACwydqqfmZO8Z3yxXrc6T7f73o/AEyQiDgtp/QXG/EpgTbFF3JKv1D+TABgQnQfx2ur+POc
4kflC/kx5u6c4l+blF7YXWoofw4AMIG6W/G2i/Wzckp/lVP896EX9PJFvkh3M5/6o03E7+acF8vvCQBM
mQO/EFTVctfezxEXtlX9vLaqX9z9s6mqC5YWF+fLrwEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA6LEtW/4flgYiLD1qeX0A
AAAASUVORK5CYII=
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAYIj+H5YGIizEb/aEAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="LB_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
@@ -383,122 +379,122 @@
<data name="ActionButton7.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
vAAADrwBlbxySQAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton8.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
vAAADrwBlbxySQAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton9.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
vAAADrwBlbxySQAAARlJREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbWujg3dATZPKYZC6BQhvw1AMkg3dP
XQyl7WIyJIEW5CbS0/jKE5GwpCghgg9s6/8/y5Kj6DA45zcAwAAAezB6rjNnB4XX244NHt8wGs7wblop
yRGxwZQBYKIfbn477EvqusY4jj2MgMpPiwav7l9UyYXmdrs9duzP4ApUmd72sfrxVsD33JQISyClvFUX
w9nJssvJFei9CJUtgQ7394Du3YKLJaCbLMuwqips21ZNuDve/35X8J7nuRcMsVwsbYEQYlSWpRcMMR5P
bAH9fU3TeMEQSZLYgsMpsDRNvXCIr89vWyCEeC6KwguGmL/ObYGU8oFOwA2ewwgYY9f6f7iUf3DGkTcu
khP7AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton10.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsMAAALDAE/QCLIAAACM0lE
QVQ4T2P4//8/AyHMzicsqh6c34guDsIYAshYQFadhZmZhU1c18Yp8NCP/7LWvjHoajA0gbCwpqW7YeGs
FXYTD15xnHnihuuiiw98D//6777kynNuAREpnAYwMjIyqQQX9zkvffDfZce3//b7//23PPD/v/HWr//1
Vr74b7jm3X/VpI7FTIyMjFgNUAku6nRd//6/0ZTT31QbNlxXbthwQa3/6CO1ZS/+K8y+91968u3/qr1X
/gsq6jliGCCoYmRp23/4u4R9eCczF782AwMDFwMDA7OYhV+C2ooP/5UnXf+vkDXnioi+cz4LG6cIhgGK
zlE1/PLakcguArsquXuOSvmqayLatmnMjAx86PJwBhMzM4YkCPNKKpkxMTAIootjGIANswtKSKKLoWMM
ARAW0LS20S2at1POM20quhyvspGFqLlfJoYBTCzsnEI6Dl6a6ZO32c66+t91/dv/Akq6wTB5IQVdfgnP
jGSlpr1vuKTVPDAM4FczD7Ceeum/w6J7/y2XP/2vt/rNf9mGTUekC+eulKtYuUW+5+Qj2TlP/4u4psxD
dhGSC9h4dUoWntZf9e6/0qr3/5V3/Puvuu//f6Xt///Lrvr8X3ryzf8SfsWbmNBiAsV/bJIqpkpLX/xU
2/n3v+qcmx9VZl77oth97L1U2pQTgtq2WUwMDGzI6jEMAGFR/7wGzS3f//PIagawcvIqsLJzKTAyMLCi
q8NpABMLK4dCfOsSZlYOUXQ5bBgArRReBMoH61gAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton11.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
vAAADrwBlbxySQAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton12.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
vAAADrwBlbxySQAAARlJREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbWujg3dATZPKYZC6BQhvw1AMkg3dP
XQyl7WIyJIEW5CbS0/jKE5GwpCghgg9s6/8/y5Kj6DA45zcAwAAAezB6rjNnB4XX244NHt8wGs7wblop
yRGxwZQBYKIfbn477EvqusY4jj2MgMpPiwav7l9UyYXmdrs9duzP4ApUmd72sfrxVsD33JQISyClvFUX
w9nJssvJFei9CJUtgQ7394Du3YKLJaCbLMuwqips21ZNuDve/35X8J7nuRcMsVwsbYEQYlSWpRcMMR5P
bAH9fU3TeMEQSZLYgsMpsDRNvXCIr89vWyCEeC6KwguGmL/ObYGU8oFOwA2ewwgYY9f6f7iUf3DGkTcu
khP7AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton13.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsMAAALDAE/QCLIAAACM0lE
QVQ4T2P4//8/AyHMzicsqh6c34guDsIYAshYQFadhZmZhU1c18Yp8NCP/7LWvjHoajA0gbCwpqW7YeGs
FXYTD15xnHnihuuiiw98D//6777kynNuAREpnAYwMjIyqQQX9zkvffDfZce3//b7//23PPD/v/HWr//1
Vr74b7jm3X/VpI7FTIyMjFgNUAku6nRd//6/0ZTT31QbNlxXbthwQa3/6CO1ZS/+K8y+91968u3/qr1X
/gsq6jliGCCoYmRp23/4u4R9eCczF782AwMDFwMDA7OYhV+C2ooP/5UnXf+vkDXnioi+cz4LG6cIhgGK
zlE1/PLakcguArsquXuOSvmqayLatmnMjAx86PJwBhMzM4YkCPNKKpkxMTAIootjGIANswtKSKKLoWMM
ARAW0LS20S2at1POM20quhyvspGFqLlfJoYBTCzsnEI6Dl6a6ZO32c66+t91/dv/Akq6wTB5IQVdfgnP
jGSlpr1vuKTVPDAM4FczD7Ceeum/w6J7/y2XP/2vt/rNf9mGTUekC+eulKtYuUW+5+Qj2TlP/4u4psxD
dhGSC9h4dUoWntZf9e6/0qr3/5V3/Puvuu//f6Xt///Lrvr8X3ryzf8SfsWbmNBiAsV/bJIqpkpLX/xU
2/n3v+qcmx9VZl77oth97L1U2pQTgtq2WUwMDGzI6jEMAGFR/7wGzS3f//PIagawcvIqsLJzKTAyMLCi
q8NpABMLK4dCfOsSZlYOUXQ5bBgArRReBMoH61gAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton14.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
vAAADrwBlbxySQAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton15.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
vAAADrwBlbxySQAAARlJREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbWujg3dATZPKYZC6BQhvw1AMkg3dP
XQyl7WIyJIEW5CbS0/jKE5GwpCghgg9s6/8/y5Kj6DA45zcAwAAAezB6rjNnB4XX244NHt8wGs7wblop
yRGxwZQBYKIfbn477EvqusY4jj2MgMpPiwav7l9UyYXmdrs9duzP4ApUmd72sfrxVsD33JQISyClvFUX
w9nJssvJFei9CJUtgQ7394Du3YKLJaCbLMuwqips21ZNuDve/35X8J7nuRcMsVwsbYEQYlSWpRcMMR5P
bAH9fU3TeMEQSZLYgsMpsDRNvXCIr89vWyCEeC6KwguGmL/ObYGU8oFOwA2ewwgYY9f6f7iUf3DGkTcu
khP7AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton16.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsMAAALDAE/QCLIAAACM0lE
QVQ4T2P4//8/AyHMzicsqh6c34guDsIYAshYQFadhZmZhU1c18Yp8NCP/7LWvjHoajA0gbCwpqW7YeGs
FXYTD15xnHnihuuiiw98D//6777kynNuAREpnAYwMjIyqQQX9zkvffDfZce3//b7//23PPD/v/HWr//1
Vr74b7jm3X/VpI7FTIyMjFgNUAku6nRd//6/0ZTT31QbNlxXbthwQa3/6CO1ZS/+K8y+91968u3/qr1X
/gsq6jliGCCoYmRp23/4u4R9eCczF782AwMDFwMDA7OYhV+C2ooP/5UnXf+vkDXnioi+cz4LG6cIhgGK
zlE1/PLakcguArsquXuOSvmqayLatmnMjAx86PJwBhMzM4YkCPNKKpkxMTAIootjGIANswtKSKKLoWMM
ARAW0LS20S2at1POM20quhyvspGFqLlfJoYBTCzsnEI6Dl6a6ZO32c66+t91/dv/Akq6wTB5IQVdfgnP
jGSlpr1vuKTVPDAM4FczD7Ceeum/w6J7/y2XP/2vt/rNf9mGTUekC+eulKtYuUW+5+Qj2TlP/4u4psxD
dhGSC9h4dUoWntZf9e6/0qr3/5V3/Puvuu//f6Xt///Lrvr8X3ryzf8SfsWbmNBiAsV/bJIqpkpLX/xU
2/n3v+qcmx9VZl77oth97L1U2pQTgtq2WUwMDGzI6jEMAGFR/7wGzS3f//PIagawcvIqsLJzKTAyMLCi
q8NpABMLK4dCfOsSZlYOUXQ5bBgArRReBMoH61gAAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton17.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
vAAADrwBlbxySQAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value>
</data>
</root>

View File

@@ -20,6 +20,7 @@ Imports UMTypes = SCrawler.Plugin.UserMediaTypes
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Namespace API.YouTube.Controls
Friend Class VideoOptionsForm : Implements IDesignXMLContainer
Friend Event AudioIndexChanged As EventHandler
#Region "Declarations"
Private MyView As FormView
Private ReadOnly MyFieldsChecker As FieldsChecker
@@ -29,6 +30,7 @@ Namespace API.YouTube.Controls
Private Const ControlsRow As Integer = 7
Private ReadOnly Property CNT_PROCESSOR As TableControlsProcessor
Friend Property MyContainer As YouTubeMediaContainerBase
Private ReadOnly AVControls As List(Of VideoOption)
Private Initialization As Boolean = True
Private ReadOnly InheritsFromContainer As Boolean
Private ReadOnly M3U8Files As List(Of SFile)
@@ -63,6 +65,7 @@ Namespace API.YouTube.Controls
InitializeComponent()
M3U8Files = New List(Of SFile)
MyContainer = Container
AVControls = New List(Of VideoOption)
CNT_PROCESSOR = New TableControlsProcessor(TP_CONTROLS)
Me.InheritsFromContainer = InheritsFromContainer
MyFieldsChecker = New FieldsChecker
@@ -137,6 +140,19 @@ Namespace API.YouTube.Controls
End If
CMB_FORMAT.Enabled = OPT_VIDEO.Checked
With .MediaObjects
Dim disableOpts As Boolean = False
If .Count = 0 Or .Count = 1 Then
disableOpts = True
ElseIf .Exists(Function(mm) mm.Type = UMTypes.Video Or mm.Type = YouTubeMediaContainerBase.TypeAudioVideo) And
.Exists(Function(mm) mm.Type = UMTypes.Audio) Then
disableOpts = False
Else
disableOpts = True
End If
If disableOpts Then OPT_AUDIO.Enabled = False : OPT_VIDEO.Enabled = False
End With
arr = AvailableVideoFormats
CMB_FORMAT.Items.AddRange(arr)
If InheritsFromContainer Then
@@ -197,6 +213,7 @@ Namespace API.YouTube.Controls
MyView.DisposeIfReady()
MyFieldsChecker.DisposeIfReady()
M3U8Files.Clear()
AVControls.ListClearDispose
End Sub
#End Region
#Region "Refill"
@@ -205,6 +222,7 @@ Namespace API.YouTube.Controls
Dim h% = -1
Dim rh% = IIf(MyContainer.HasElements, 60, 25)
Dim s As New Size(Width, h)
Dim codecW% = 0
Dim CalculateSize As Action(Of Integer) =
Sub(ByVal InitHeight As Integer)
With TP_MAIN.RowStyles(ControlsRow) : .SizeType = SizeType.Absolute : .Height = InitHeight : End With
@@ -217,7 +235,7 @@ Namespace API.YouTube.Controls
Dim __contentType As UMTypes = IIf(OPT_VIDEO.Checked, UMTypes.Video, UMTypes.Audio)
With TP_CONTROLS
If .Controls.Count > 0 Then
For Each cnt As Control In .Controls : cnt.Dispose() : Next
'For Each cnt As Control In .Controls : cnt.Dispose() : Next
.Controls.Clear()
End If
.RowStyles.Clear()
@@ -226,14 +244,29 @@ Namespace API.YouTube.Controls
With MyContainer
Dim audio As MediaObject = Nothing
If __contentType = UMTypes.Video Then audio = .SelectedAudio
Dim data As IEnumerable(Of Control)
Dim data As IEnumerable(Of Control) = Nothing
If .HasElements Then
data = .Elements.Select(Function(ee) New MediaItem(ee, True) With {.Dock = DockStyle.Fill, .Checked = ee.Checked, .UseCookies = UseCookies})
Else
data = (From m As MediaObject In .Self.MediaObjects
Where m.Type = __contentType
Select New VideoOption(m, audio) With {.Dock = DockStyle.Fill, .Checked = m.Index = MyContainer.SelectedVideoIndex})
If AVControls.Count = 0 Then
AVControls.AddRange(From m As MediaObject In .Self.MediaObjects
Where m.Type = UMTypes.Audio Or m.Type = UMTypes.Video Or m.Type = YouTubeMediaContainerBase.TypeAudioVideo
Select New VideoOption(m, audio) With {
.Dock = DockStyle.Fill,
.Checked = m.Index = If(m.Type = UMTypes.Audio, MyContainer.SelectedAudioIndex, MyContainer.SelectedVideoIndex)
})
If AVControls.Count > 0 Then
AVControls.ForEach(Sub(ByVal av As VideoOption)
AddHandler av.CheckedChanged, AddressOf VideoOption_CheckedChanged
av.SetAudioChangingHandler(Me)
End Sub)
End If
End If
'data = (From m As MediaObject In .Self.MediaObjects
' Where m.Type = __contentType Or (__contentType = UMTypes.Video And m.Type = YouTubeMediaContainerBase.TypeAudioVideo)
' Select New VideoOption(m, audio) With {.Dock = DockStyle.Fill, .Checked = m.Index = MyContainer.SelectedVideoIndex})
If AVControls.Count > 0 Then data = AVControls.Where(Function(av) av.ContentType = __contentType)
End If
If data.ListExists Then
@@ -299,6 +332,16 @@ Namespace API.YouTube.Controls
End With
End If
If Not .HasElements Then
codecW = AVControls.Max(Function(av) av.CodecLength)
Dim baseW% = DirectCast(TP_CONTROLS.Controls(0), VideoOption).CodecLengthBase
If baseW + codecW + 12 + 30 > Width Then
s.Width += Math.Abs((Size.Width - baseW - codecW - 12 - 30))
'MinimumSize = s
'Size = s
End If
End If
With TP_CONTROLS
.PerformLayout()
.Select()
@@ -319,6 +362,16 @@ Namespace API.YouTube.Controls
Private Sub MediaItem_CheckedChanged(ByVal Sender As MediaItem, ByVal Container As IYouTubeMediaContainer)
ControlInvokeFast(TP_CONTROLS, Sub() Container.Checked = Sender.Checked, EDP.None)
End Sub
Private Sub VideoOption_CheckedChanged(ByVal Sender As Object, ByVal e As EventArgs)
If Not Sender Is Nothing Then
With DirectCast(Sender, VideoOption)
If .MyMedia.Type = UMTypes.Audio And .Checked Then
MyContainer.SelectedAudioIndex = .MyMedia.Index
RaiseEvent AudioIndexChanged(Sender, e)
End If
End With
End If
End Sub
Private Sub MediaItem_BeforeOpenEditor(ByVal Sender As MediaItem, ByVal Container As IYouTubeMediaContainer)
MediaItem_BeforeOpenEditorImpl(Sender, Container, False)
End Sub
@@ -465,6 +518,9 @@ Namespace API.YouTube.Controls
TXT_FILE.Text = f
End If
End Sub
Private Sub BTT_TRIM_Click(sender As Object, e As EventArgs) Handles BTT_TRIM.Click
Using f As New VideoOptionsTrimForm(MyContainer) : f.ShowDialog() : End Using
End Sub
Private Sub TXT_SUBS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_SUBS.ActionOnButtonClick
Select Case Sender.DefaultButton
Case ADB.Open

View File

@@ -0,0 +1,166 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.YouTube.Controls
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class VideoOptionsTrimForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim TP_OPTIONS As System.Windows.Forms.TableLayoutPanel
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.LIST_TRIM = New System.Windows.Forms.ListBox()
Me.CH_DEL_ORIG = New System.Windows.Forms.CheckBox()
Me.CH_ADD_M3U8 = New System.Windows.Forms.CheckBox()
Me.CH_SEP_FOLDER = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_OPTIONS = New System.Windows.Forms.TableLayoutPanel()
TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
TP_OPTIONS.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(434, 236)
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(434, 261)
CONTAINER_MAIN.TabIndex = 0
'
'TP_MAIN
'
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Controls.Add(Me.LIST_TRIM, 0, 1)
TP_MAIN.Controls.Add(TP_OPTIONS, 0, 0)
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 = 2
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 30.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(434, 236)
TP_MAIN.TabIndex = 0
'
'LIST_TRIM
'
Me.LIST_TRIM.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_TRIM.FormattingEnabled = True
Me.LIST_TRIM.Location = New System.Drawing.Point(3, 33)
Me.LIST_TRIM.Name = "LIST_TRIM"
Me.LIST_TRIM.Size = New System.Drawing.Size(428, 200)
Me.LIST_TRIM.TabIndex = 0
'
'TP_OPTIONS
'
TP_OPTIONS.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_OPTIONS.ColumnCount = 3
TP_OPTIONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33333!))
TP_OPTIONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33334!))
TP_OPTIONS.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33334!))
TP_OPTIONS.Controls.Add(Me.CH_DEL_ORIG, 0, 0)
TP_OPTIONS.Controls.Add(Me.CH_ADD_M3U8, 1, 0)
TP_OPTIONS.Controls.Add(Me.CH_SEP_FOLDER, 2, 0)
TP_OPTIONS.Dock = System.Windows.Forms.DockStyle.Fill
TP_OPTIONS.Location = New System.Drawing.Point(3, 3)
TP_OPTIONS.Name = "TP_OPTIONS"
TP_OPTIONS.RowCount = 1
TP_OPTIONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_OPTIONS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 23.0!))
TP_OPTIONS.Size = New System.Drawing.Size(428, 24)
TP_OPTIONS.TabIndex = 1
'
'CH_DEL_ORIG
'
Me.CH_DEL_ORIG.AutoSize = True
Me.CH_DEL_ORIG.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DEL_ORIG.Location = New System.Drawing.Point(4, 4)
Me.CH_DEL_ORIG.Name = "CH_DEL_ORIG"
Me.CH_DEL_ORIG.Size = New System.Drawing.Size(135, 16)
Me.CH_DEL_ORIG.TabIndex = 0
Me.CH_DEL_ORIG.Text = "Delete original file"
TT_MAIN.SetToolTip(Me.CH_DEL_ORIG, "If checked, the original file will be deleted after trimming")
Me.CH_DEL_ORIG.UseVisualStyleBackColor = True
'
'CH_ADD_M3U8
'
Me.CH_ADD_M3U8.AutoSize = True
Me.CH_ADD_M3U8.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_ADD_M3U8.Location = New System.Drawing.Point(146, 4)
Me.CH_ADD_M3U8.Name = "CH_ADD_M3U8"
Me.CH_ADD_M3U8.Size = New System.Drawing.Size(135, 16)
Me.CH_ADD_M3U8.TabIndex = 1
Me.CH_ADD_M3U8.Text = "Add to M3U8"
TT_MAIN.SetToolTip(Me.CH_ADD_M3U8, "If checked, the trimmed files will be added to the M3U8 playlist (if selected)")
Me.CH_ADD_M3U8.UseVisualStyleBackColor = True
'
'CH_SEP_FOLDER
'
Me.CH_SEP_FOLDER.AutoSize = True
Me.CH_SEP_FOLDER.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_SEP_FOLDER.Location = New System.Drawing.Point(288, 4)
Me.CH_SEP_FOLDER.Name = "CH_SEP_FOLDER"
Me.CH_SEP_FOLDER.Size = New System.Drawing.Size(136, 16)
Me.CH_SEP_FOLDER.TabIndex = 2
Me.CH_SEP_FOLDER.Text = "Separate folder"
TT_MAIN.SetToolTip(Me.CH_SEP_FOLDER, "Place the trimmed files in a separate folder")
Me.CH_SEP_FOLDER.UseVisualStyleBackColor = True
'
'VideoOptionsTrimForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(434, 261)
Me.Controls.Add(CONTAINER_MAIN)
Me.KeyPreview = True
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(450, 300)
Me.Name = "VideoOptionsTrimForm"
Me.ShowIcon = False
Me.ShowInTaskbar = False
Me.Text = "Trimming options"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
TP_OPTIONS.ResumeLayout(False)
TP_OPTIONS.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents LIST_TRIM As ListBox
Private WithEvents CH_DEL_ORIG As CheckBox
Private WithEvents CH_ADD_M3U8 As CheckBox
Private WithEvents CH_SEP_FOLDER As CheckBox
End Class
End Namespace

View File

@@ -0,0 +1,135 @@
<?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>
<metadata name="TP_OPTIONS.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
</root>

View File

@@ -0,0 +1,167 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API.YouTube.Objects
Imports SCrawler.API.YouTube.Base
Imports ETC = PersonalUtilities.Forms.Toolbars.EditToolbar.ControlItem
Namespace API.YouTube.Controls
Friend Class VideoOptionsTrimForm
#Region "Declarations"
Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property MyMedia As YouTubeMediaContainerBase
Private ReadOnly Property TrimData As List(Of TrimOption)
Private WithEvents BTT_CLEAR_ALL As ToolStripButton
Private WithEvents BTT_CHAPTERS As ToolStripButton
#End Region
#Region "Initializer"
Friend Sub New(ByRef Media As YouTubeMediaContainerBase)
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, MyYouTubeSettings.DesignXml)
MyMedia = Media
TrimData = New List(Of TrimOption)
TrimData.ListAddList(Media.TrimOptions)
BTT_CLEAR_ALL = New ToolStripButton("Clear", PersonalUtilities.My.Resources.DeletePic_Red_24) With {
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText,
.BackColor = MyColor.DeleteBack,
.ForeColor = MyColor.DeleteFore
}
BTT_CHAPTERS = New ToolStripButton("Chapters") With {.DisplayStyle = ToolStripItemDisplayStyle.Text, .Enabled = Media.Chapters.Count > 0}
End Sub
#End Region
#Region "Form handlers"
Private Sub VideoOptionsTrimForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
.AddOkCancelToolbar()
.AddEditToolbar({ETC.Add, ETC.Edit, ETC.Delete, BTT_CLEAR_ALL, ETC.Separator, BTT_CHAPTERS})
Refill()
With MyMedia
If Not .TrimOptionsSet Then
With MyYouTubeSettings
CH_DEL_ORIG.Checked = .TrimDeleteOriginalFile
CH_ADD_M3U8.Checked = .TrimAddTrimmedFilesToM3U8
CH_SEP_FOLDER.Checked = .TrimSeparateFolder
End With
Else
CH_DEL_ORIG.Checked = .TrimDeleteOriginalFile
CH_ADD_M3U8.Checked = .TrimAddTrimmedFilesToM3U8
CH_SEP_FOLDER.Checked = .TrimSeparateFolder
End If
End With
.EndLoaderOperations()
End With
End Sub
Private Sub VideoOptionsTrimForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
TrimData.Clear()
End Sub
#End Region
#Region "Refill"
Private Sub Refill(Optional ByVal DEL As Boolean = False)
Dim indx% = _CurrentIndex
With LIST_TRIM
.BeginUpdate()
.Items.Clear()
If TrimData.Count > 0 Then
TrimData.Sort()
.Items.AddRange(TrimData.Cast(Of Object).ToArray)
If DEL Then indx -= IIf(indx - 1 < 0, 0, 1)
If indx.ValueBetween(0, TrimData.Count - 1) Then
.SelectedIndex = indx
ElseIf (indx - 1).ValueBetween(0, TrimData.Count - 1) Then
.SelectedIndex = indx - 1
ElseIf (indx + 1).ValueBetween(0, TrimData.Count - 1) Then
.SelectedIndex = indx + 1
End If
End If
.EndUpdate()
End With
End Sub
#End Region
#Region "Ok"
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With MyMedia
.TrimOptions.Clear()
.TrimDeleteOriginalFile = CH_DEL_ORIG.Checked
.TrimAddTrimmedFilesToM3U8 = CH_ADD_M3U8.Checked
.TrimSeparateFolder = CH_SEP_FOLDER.Checked
.TrimOptionsSet = True
End With
If TrimData.Count > 0 Then
TrimData.Sort()
Dim indx% = 0
Dim c%
Dim opt As TrimOption
Dim dic As New Dictionary(Of String, Integer)
For i% = 0 To TrimData.Count - 1
opt = TrimData(i)
If opt.Name.IsEmptyString Then
indx += 1
opt.Name = indx
Else
c = TrimData.LongCount(Function(d) Not d.Name.IsEmptyString AndAlso d.Name = opt.Name)
If c > 1 Then
If Not dic.ContainsKey(opt.Name) Then dic.Add(opt.Name, 0)
dic(opt.Name) += 1
opt.Name &= $"_{dic(opt.Name)}"
End If
End If
TrimData(i) = opt
Next
dic.Clear()
MyMedia.TrimOptions.AddRange(TrimData)
End If
MyDefs.CloseForm()
End Sub
#End Region
#Region "Edit"
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
Using f As New TrimOptionForm
f.ShowDialog()
If f.DialogResult = DialogResult.OK AndAlso
(TrimData.Count = 0 OrElse Not TrimData.Any(Function(t) t.End = f.MyTrimOption.End And t.Start = f.MyTrimOption.Start)) Then _
TrimData.Add(f.MyTrimOption) : Refill()
End Using
End Sub
Private Sub MyDefs_ButtonEditClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonEditClick
If _CurrentIndex.ValueBetween(0, TrimData.Count - 1) Then
Using f As New TrimOptionForm(TrimData(_CurrentIndex))
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then TrimData(_CurrentIndex) = f.MyTrimOption : Refill()
End Using
End If
End Sub
Private Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE
If _CurrentIndex.ValueBetween(0, TrimData.Count - 1) AndAlso
MsgBoxE({$"Are you sure you want to remove the following trim option?{vbCr}{vbCr}{TrimData(_CurrentIndex)}", "Remove trim option"}, vbYesNo + vbExclamation) = vbYes Then _
TrimData.RemoveAt(_CurrentIndex) : Refill(True)
End Sub
Private Sub BTT_CLEAR_ALL_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_ALL.Click
If MsgBoxE({$"Are you sure you want to remove ALL trim options?", "Remove trim option"}, vbYesNo + vbCritical) = vbYes Then TrimData.Clear() : Refill()
End Sub
Private Sub BTT_CHAPTERS_Click(sender As Object, e As EventArgs) Handles BTT_CHAPTERS.Click
Using f As New ChaptersForm(MyMedia, TrimData)
f.ShowDialog()
If f.DialogResult = DialogResult.OK AndAlso f.MyResult.Count > 0 Then TrimData.ListAddList(f.MyResult, LAP.NotContainsOnly) : Refill()
End Using
End Sub
#End Region
#Region "List"
Private _CurrentIndex As Integer = -1
Private Sub LIST_TRIM_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_TRIM.SelectedIndexChanged
_CurrentIndex = LIST_TRIM.SelectedIndex
End Sub
#End Region
End Class
End Namespace

View File

@@ -54,8 +54,11 @@ Namespace API.YouTube
Friend ReadOnly DateBaseProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Friend ReadOnly DateAddedProvider As New ADateTime(ADateTime.Formats.yyyymmdd) With {.DateSeparator = String.Empty}
Friend ReadOnly TimeToStringProvider As IFormatProvider = New TimeToStringConverter
Friend ReadOnly TimeToStringProviderH As IFormatProvider = New TimeToStringConverter(True)
Friend ReadOnly TitleHtmlConverter As Func(Of String, String) = Function(Input) Input.StringRemoveWinForbiddenSymbols().StringTrim()
Friend ReadOnly MediaObjParseLang As RParams = RParams.DM("(?i)^(.+?)(?:\s*-\s*( .+?))?(?=\s*(?:,\s*)?(?:low|medium|high|DRC)\b|$)", 0, EDP.ReturnValue)
Friend ReadOnly ProgressProvider As IMyProgressNumberProvider = MyProgressNumberProvider.Percentage
Friend ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue)
Public ReadOnly TrueUrlRegEx As RParams = RParams.DM(Base.YouTubeFunctions.TrueUrlPattern, 0, EDP.ReturnValue)
Friend ReadOnly MusicUrlApply As RParams = RParams.DMS("https://([w\.]*)youtube.com.+", 1, RegexReturn.Replace, EDP.ReturnValue,
CType(Function(input$) "music.", Func(Of String, String)), String.Empty)
@@ -77,14 +80,28 @@ Namespace API.YouTube
Return f
End If
End Function
Public Function CreateYtdlpProgressHandler(ByVal Progress As MyProgress, ByVal Token As Threading.CancellationToken, ByVal Batch As BatchExecutor,
Optional ByVal ValCalc As Func(Of Double, Double) = Nothing) As DataReceivedEventHandler
Return Sub(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
If Not e.Data.IsEmptyString Then
Dim v# = AConvert(Of Double)(RegexReplace(e.Data, DownloadProgressPattern), NumberProvider, -1)
If v >= 0 Then v = If(ValCalc Is Nothing, v, ValCalc.Invoke(v)) : Progress.Value = v : Progress.Perform(0)
If Token.IsCancellationRequested Then Batch.Kill()
End If
End Sub
End Function
Private Class TimeToStringConverter : Implements ICustomProvider
Private ReadOnly _Provider As New ADateTime("mm\:ss") With {.TimeParseMode = ADateTime.TimeModes.TimeSpan}
Private ReadOnly _ProviderWithHours As New ADateTime("h\:mm\:ss") With {.TimeParseMode = ADateTime.TimeModes.TimeSpan}
Private ReadOnly ForceHours As Boolean
Private ReadOnly Property Provider(ByVal t As TimeSpan) As IFormatProvider
Get
Return If(t.Hours > 0, _ProviderWithHours, _Provider)
Return If(t.Hours > 0 Or ForceHours, _ProviderWithHours, _Provider)
End Get
End Property
Friend Sub New(Optional ByVal ForceHours As Boolean = False)
Me.ForceHours = ForceHours
End Sub
Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
If Not IsNothing(Value) Then

View File

@@ -336,6 +336,7 @@ Namespace DownloadObjects.STDownloader
pForm.Dispose()
End If
If Not c Is Nothing Then
If Not c.HasElements Then DirectCast(c, YouTubeMediaContainerBase).FileForceArtist()
Dim f As Form
Select Case c.ObjectType
Case YouTubeMediaType.Single : f = New VideoOptionsForm(c) With {.UseCookies = useCookies}

View File

@@ -10,6 +10,7 @@ Imports System.Threading
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web
Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Functions.RegularExpressions
Imports SCrawler.DownloadObjects.STDownloader
Public Module MainModShared
Public Property BATCH As BatchExecutor
@@ -135,9 +136,11 @@ Namespace Editors
Public Shared Function GetProgramEnvirText(ByVal EnvirData As IDownloaderSettings, ByVal IsYouTube As Boolean) As String
Try
Dim output$ = String.Empty
Dim verAfter As RParams = RParams.DM("\A\w\:\\.*", 0, EDP.ReturnValue)
Using b As New BatchExecutor(True)
Dim f As SFile
Dim cmd$, ff$, vText$
Dim ii%
For i% = 0 To IIf(IsYouTube, 1, 3)
cmd = "--version"
@@ -154,7 +157,17 @@ Namespace Editors
Else
b.Reset()
b.Execute($"""{f}"" {cmd}", EDP.None)
If b.OutputData.Count > 3 Then vText = b.OutputData(3) Else vText = "undefined"
'If b.OutputData.Count > 3 Then vText = b.OutputData(3) Else vText = "undefined"
vText = String.Empty
With b.OutputData
If .Count > 0 Then
ii = .FindIndex(Function(bb) Not CStr(RegexReplace(bb, verAfter)).IsEmptyString)
If ii >= 0 And ii + 1 <= .Count - 1 Then vText = .Item(ii + 1)
End If
End With
If vText.IsEmptyString Then vText = "undefined"
output.StringAppendLine($"{ff} version: {vText}")
End If
End If

View File

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

View File

@@ -30,6 +30,11 @@ Namespace API.YouTube.Objects
_File = CleanFileName(_File)
End If
End Sub
Protected Friend Overrides Sub FileForceArtist()
Dim __artistName$ = UserTitle.IfNullOrEmpty(AccountName)
If Not _File.Name.IsEmptyString AndAlso Not _File.Name.ToLower.Contains(__artistName.ToLower) Then _
_File.Name = $"{__artistName} - {_File.Name}"
End Sub
Public Overrides Function ToString(ByVal ForMediaItem As Boolean) As String
Dim s$ = SizeStr
If Not s.IsEmptyString Then s = $" [{s}]"

View File

@@ -356,6 +356,14 @@ Namespace API.YouTube.Objects
End If
End Sub
#End Region
#Region "Chapters, Trimming"
Friend ReadOnly Property Chapters As List(Of TrimOption)
Friend ReadOnly Property TrimOptions As List(Of TrimOption)
Friend Property TrimDeleteOriginalFile As Boolean = False
Friend Property TrimAddTrimmedFilesToM3U8 As Boolean = False
Friend Property TrimSeparateFolder As Boolean = False
Friend Property TrimOptionsSet As Boolean = False
#End Region
#Region "IUserMedia Support"
<XMLEC> Private Property Attempts As Integer Implements IUserMedia.Attempts
Private _Object As Object = Nothing
@@ -684,6 +692,8 @@ Namespace API.YouTube.Objects
End If
End Set
End Property
Protected Friend Overridable Sub FileForceArtist()
End Sub
Friend Sub FileDateUpdate()
Dim n$ = _File.Name.StringTrim
Dim s$ = IIf(n.IsEmptyString, String.Empty, " ")
@@ -738,6 +748,7 @@ Namespace API.YouTube.Objects
#Region "Command"
<XMLEC> Public Property UseCookies As Boolean = MyYouTubeSettings.DefaultUseCookies Implements IYouTubeMediaContainer.UseCookies
Protected Const mp3 As String = "mp3"
Private Const mp4 As String = "mp4"
Private Const aac As String = "aac"
Private Const ac3 As String = "ac3"
Protected PostProcessing_AudioAC3 As Boolean = False
@@ -773,7 +784,12 @@ Namespace API.YouTube.Objects
'2023.3.4 -> 2023.7.6
'cmd.StringAppend($"ba*[format_id={SelectedAudio.ID}]", "+")
cmd.StringAppend(SelectedAudio.ID, "+")
If OutputAudioCodec.StringToLower = ac3 Then
If SelectedVideoIndex >= 0 And SelectedAudio.ProtocolType = Protocols.m3u8 And
(SelectedAudio.Codec.StringToLower = mp4 Or OutputAudioCodec.StringToLower = mp4) Then
PostProcessing_AudioAC3 = True
formats.StringAppend($"--merge-output-format ""{mp4}{IIf(OutputVideoExtension.IsEmptyString, String.Empty, $"/{OutputVideoExtension.StringToLower}")}""", " ")
atCodec = aac
ElseIf OutputAudioCodec.StringToLower = ac3 Then
PostProcessing_AudioAC3 = True
formats.StringAppend($"--audio-format {aac}", " ")
atCodec = aac
@@ -811,15 +827,20 @@ Namespace API.YouTube.Objects
subs = ListAddList(Nothing, Subtitles.Select(Function(s, i) If(SubtitlesSelectedIndexes.Contains(i), s.FullID, String.Empty)),
LAP.NotContainsOnly, EDP.ReturnValue).ListToString(",")
subs = $"--write-subs --write-auto-subs --sub-format {OutputSubtitlesFormat.StringToLower} --sub-langs ""{subs}"" --convert-subs {OutputSubtitlesFormat.StringToLower}"
If MyYouTubeSettings.DefaultSubtitlesEmbed Then subs = $"--write-auto-sub --embed-subs {subs}"
End If
If Not cmd.IsEmptyString Then
'2023.3.4 -> 2023.7.6
'cmd = $"yt-dlp -f ""{cmd}"""
'cmd = $"yt-dlp -f {cmd}"
cmd = $"{YTDLP_NAME} -f {cmd}"
If Not MyYouTubeSettings.ReplaceModificationDate Then cmd &= " --no-mtime"
'yt-dlp 2025.07.21
'If Not MyYouTubeSettings.ReplaceModificationDate Then cmd &= " --no-mtime"
cmd &= $" --{IIf(MyYouTubeSettings.ReplaceModificationDate.Value, String.Empty, "no-")}mtime"
If MyYouTubeSettings.DefaultVideoEmbedChapters Then cmd &= " --embed-chapters --add-chapters"
cmd.StringAppend(formats, " ")
cmd.StringAppend(subs, " ")
If MyYouTubeSettings.ErrorsIgnore Then cmd &= " --no-abort-on-error --ignore-errors"
cmd.StringAppend(YouTubeFunctions.GetCookiesCommand(WithCookies, YouTubeCookieNetscapeFile), " ")
cmd &= $" {URL} -o ""{File.PathWithSeparator}{File.Name}"""
File.Exists(SFO.Path, True)
@@ -837,6 +858,8 @@ Namespace API.YouTube.Objects
_Subtitles = New List(Of Subtitles)
_SubtitlesDelegated = New List(Of Subtitles)
SubtitlesSelectedIndexes = New List(Of Integer)
Chapters = New List(Of TrimOption)
TrimOptions = New List(Of TrimOption)
MediaObjects = New List(Of MediaObject)
_Files = New List(Of SFile)
@@ -928,7 +951,6 @@ Namespace API.YouTube.Objects
Return String.Format(m3u8DataRow, CInt(.Duration.TotalSeconds), fName, __f)
End With
End Function
Private ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue)
Public Property Progress As MyProgress Implements IYouTubeMediaContainer.Progress
Private Property IDownloadableMedia_Progress As Object Implements IDownloadableMedia.Progress
Get
@@ -1168,13 +1190,7 @@ Namespace API.YouTube.Objects
If MediaState = UMStates.Downloaded Or Not Checked Then Exit Sub
RaiseEvent FileDownloadStarted(Me, Nothing)
Using batch As New BatchExecutor(True) With {.Encoding = 65001}
Dim h As DataReceivedEventHandler = Sub(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
If Not e.Data.IsEmptyString Then
Dim v# = AConvert(Of Double)(RegexReplace(e.Data, DownloadProgressPattern), NumberProvider, -1)
If v >= 0 Then Progress.Value = v : Progress.Perform(0)
If Token.IsCancellationRequested Then batch.Kill()
End If
End Sub
Dim h As DataReceivedEventHandler = CreateYtdlpProgressHandler(Progress, Token, batch)
With batch
Dim prExists As Boolean = Not Progress Is Nothing
If prExists Then
@@ -1259,6 +1275,7 @@ Namespace API.YouTube.Objects
Dim fPatternFiles$ = $"{File.Name}*." & "{0}"
Dim fAacAudio As New TempFileConversion(New SFile(String.Format(fPattern, aac)), Me)
Dim mp3ThumbEmbedded As Boolean = False
Dim audioFiles As New List(Of SFile)
Dim tempFilesList As New List(Of TempFileConversion)
Dim ttFile As TempFileConversion
@@ -1366,13 +1383,17 @@ Namespace API.YouTube.Objects
format = format.StringToLower
f = String.Format(fPattern, format)
AddFile(f)
audioFiles.Add(f)
If Not f.Exists Then
tryToConvert.Invoke(format, f)
updateBitrate(f)
If f.Exists Then
If format = mp3 And Not mp3ThumbEmbedded And MyYouTubeSettings.DefaultAudioEmbedThumbnail_ExtractedFiles Then _
embedThumbTo.Invoke(f) : mp3ThumbEmbedded = True
If Not M3U8_PlaylistFiles.ListExists AndAlso f.Exists Then M3U8_Append(f)
If format = mp3 AndAlso f.Exists AndAlso MyYouTubeSettings.VideoPlaylist_AddExtractedMP3.Value Then M3U8_Append(f)
If M3U8_PlaylistFiles.ListExists OrElse
(format = mp3 AndAlso MyYouTubeSettings.VideoPlaylist_AddExtractedMP3.Value) Then _
M3U8_Append(f)
End If
End If
Next
End If
@@ -1425,6 +1446,69 @@ Namespace API.YouTube.Objects
If OutputVideoFPS > 0 AndAlso SelectedVideo.Bitrate <> OutputVideoFPS Then _
reencodeFile("ffmpeg -i ""{0}"" -filter:v fps=" & OutputVideoFPS.ToString.Replace(", ", ".") & " -c:a copy ""{1}""")
End If
'Trimming
If TrimOptions.Count > 0 AndAlso File.Exists Then
Const trimCommand$ = "ffmpeg -i ""{0}"" -ss {1} -to {2} -c:v copy -c:a copy ""{3}"""
Dim trimFirstFile As SFile = Nothing
Dim trimFirstAdded As Boolean = False
Dim trimSingleReplace As Boolean = TrimOptions.Count = 1 And TrimDeleteOriginalFile
Dim audioReplace As New Dictionary(Of SFile, SFile)
Dim processTrim As Action(Of TrimOption, SFile, Boolean) =
Sub(ByVal opt As TrimOption, ByVal pFile As SFile, ByVal isAudio As Boolean)
Dim fNew As SFile = pFile
fNew.Name &= $"_{opt.Name}"
If TrimSeparateFolder Then fNew = $"{fNew.PathNoSeparator}\{MyYouTubeSettings.TrimSeparateFolderName.Value.IfNullOrEmpty(YouTubeSettings.TrimSeparateFolderNameDefault)}\{fNew.File}" : fNew.Exists(SFO.Path)
format = fNew.Extension.StringToLower
.Execute(String.Format(trimCommand,
pFile,
AConvert(Of String)(opt.StartTime, TimeToStringProvider),
AConvert(Of String)(opt.EndTime, TimeToStringProvider),
fNew))
If fNew.Exists Then
If trimFirstFile.IsEmptyString Then trimFirstFile = fNew
If Not trimSingleReplace Then AddFile(fNew)
If isAudio And trimSingleReplace And Not audioReplace.ContainsKey(pFile) Then audioReplace.Add(pFile, fNew)
If format = mp3 And MyYouTubeSettings.DefaultAudioEmbedThumbnail_ExtractedFiles Then _
embedThumbTo.Invoke(fNew) : mp3ThumbEmbedded = True
If Not trimSingleReplace AndAlso
(TrimAddTrimmedFilesToM3U8 Or (TrimDeleteOriginalFile And Not trimFirstAdded)) AndAlso
(M3U8_PlaylistFiles.ListExists OrElse
(format = mp3 AndAlso MyYouTubeSettings.VideoPlaylist_AddExtractedMP3.Value)) Then _
M3U8_Append(fNew) : trimFirstAdded = True
End If
End Sub
For Each tr As TrimOption In TrimOptions
processTrim(tr, File, False)
If audioFiles.Count > 0 Then
For Each f In audioFiles : processTrim(tr, f, True) : Next
End If
Next
If TrimDeleteOriginalFile Then
Dim silentEDP As New ErrorsDescriber(EDP.ReturnValue)
File.Delete(,, silentEDP)
If trimSingleReplace Then
File = SFile.Rename(trimFirstFile, File,, New ErrorsDescriber(False, False, False, trimFirstFile))
If audioReplace.Count > 0 Then
For Each kvf As KeyValuePair(Of SFile, SFile) In audioReplace
If kvf.Key.Exists And kvf.Value.Exists Then
kvf.Key.Delete(,, silentEDP)
SFile.Rename(kvf.Value, kvf.Key,, silentEDP)
End If
Next
audioReplace.Clear()
End If
Else
File = trimFirstFile
If audioFiles.Count > 0 Then
For Each f In audioFiles
If Not f = File Then f.Delete(,, silentEDP)
Next
End If
End If
End If
End If
End If
End If
End With
@@ -1607,6 +1691,7 @@ Namespace API.YouTube.Objects
#End Region
#Region "Parse"
Friend Const DRC As String = "drc"
Friend Const TypeAudioVideo As UMTypes = UMTypes.Audio + UMTypes.Video
Public Overridable Function Parse(ByVal Container As EContainer, ByVal Path As SFile, ByVal IsMusic As Boolean,
Optional ByVal Token As CancellationToken = Nothing, Optional ByVal Progress As IMyProgress = Nothing) As Boolean Implements IYouTubeMediaContainer.Parse
Try
@@ -1652,12 +1737,20 @@ Namespace API.YouTube.Objects
If Not tmpPls.IsEmptyString Then PlaylistTitle = tmpPls
End If
Dim tmpTitle$
UserID = .Value("uploader_id")
UserTitle = TitleHtmlConverter.Invoke(.Value("uploader"))
If Not UserTitle.IsEmptyString Then
Dim tmpTitle$ = UserTitle.Replace("Topic", String.Empty).StringTrimEnd(" ", "-")
tmpTitle = UserTitle.Replace("Topic", String.Empty).StringTrimEnd(" ", "-")
If Not tmpTitle.IsEmptyString Then UserTitle = tmpTitle
End If
If MyYouTubeSettings.ParseLongUserTitle Or UserTitle.IsEmptyString Then
tmpTitle = TitleHtmlConverter.Invoke(.Value("artist"))
If Not tmpTitle.IsEmptyString Then
If Not UserTitle.IsEmptyString AndAlso Not tmpTitle.Contains(UserTitle) Then tmpTitle = $"{UserTitle}, {tmpTitle}"
UserTitle = ListAddList(Nothing, tmpTitle.Split(","), CType(Function(v$) v.StringTrim, Func(Of Object, Object)), EDP.ReturnValue).ListToString(" & ").IfNullOrEmpty(UserTitle)
End If
End If
Dim ext$ = IIf(IsMusic,
MyYouTubeSettings.DefaultAudioCodecMusic.Value.StringToLower,
@@ -1684,6 +1777,8 @@ Namespace API.YouTube.Objects
ParseThumbnails(.Self)
ParseSubtitles(.Self)
ParseChapters(.Self)
End With
Return True
End If
@@ -1749,13 +1844,15 @@ Namespace API.YouTube.Objects
Return _Exists
End Function
Protected Sub ParseFormats(ByVal e As EContainer)
Const av As UMTypes = UMTypes.Audio + UMTypes.Video
If If(e({"formats"})?.Count, 0) > 0 Then
Dim obj As MediaObject
Dim nValue#
Dim sValue$
Dim sValue$ = String.Empty
Dim allowWebm As Boolean = MyYouTubeSettings.DefaultVideoAllowWebm
Dim validCodecValue As Func(Of String, Boolean) = Function(codec) Not codec.IsEmptyString AndAlso Not codec = "none"
Dim validCodecValue As Func(Of String, Boolean) = Function(ByVal codec As String) As Boolean
sValue = codec
Return Not codec.IsEmptyString AndAlso Not codec = "none"
End Function
For Each ee In e({"formats"})
obj = New MediaObject With {
@@ -1769,6 +1866,12 @@ Namespace API.YouTube.Objects
obj.FPS = AConvert(Of Double)(ee.Value("fps"), NumberProvider, -1)
obj.Bitrate = AConvert(Of Double)(ee.Value("tbr"), NumberProvider, -1)
obj.Protocol = ee.Value("protocol")
obj.FormatNote = ee.Value("format_note")
If Not obj.FormatNote.IsEmptyString Then
obj.FormatNoteClean = RegexReplace(obj.FormatNote, MediaObjParseLang)
If Not obj.FormatNoteClean.IsEmptyString Then obj.FormatNoteClean = obj.FormatNoteClean.StringTrimEnd({CChar(" "), CChar("-"), CChar(",")})
End If
obj.Language = ee.Value("language")
If Not obj.Protocol.IsEmptyString Then obj.Protocol = obj.Protocol.Split("_").FirstOrDefault
nValue = AConvert(Of Double)(ee.Value("filesize"), NumberProvider, -1)
If nValue > 0 Then obj.Size = (nValue / 1024).RoundVal(2)
@@ -1779,23 +1882,40 @@ Namespace API.YouTube.Objects
If obj.Size <= 0 And obj.Bitrate > 0 And Duration.TotalSeconds > 0 Then _
obj.Size = (obj.Bitrate / 8 * Duration.TotalSeconds).RoundVal(2)
sValue = ee.Value("vcodec")
If validCodecValue(sValue) Then
'sValue = ee.Value("vcodec")
If validCodecValue(ee.Value("vcodec")) Then
obj.Type = UMTypes.Video
obj.Codec = sValue.Split(".").First
If validCodecValue(ee.Value("acodec")) Then obj.Type = av
Else
sValue = ee.Value("acodec")
If validCodecValue(sValue) Then
If validCodecValue(ee.Value("acodec")) Then obj.Type = TypeAudioVideo
ElseIf validCodecValue(ee.Value("acodec")) Then
obj.Type = UMTypes.Audio
obj.Codec = sValue.Split(".").First
Else
Continue For
Dim fd As Boolean = False
If Not obj.FormatQuality.IsEmptyString Or ee.Value("resolution") = "audio only" Then
obj.Type = UMTypes.Audio
obj.Codec = ee.Value("ext")
If obj.Protocol.StringToLower.StartsWith("m3u8") Then obj.Protocol = "m3u8"
If obj.Bitrate <= 0 Then obj.Bitrate = IIf(obj.FormatQuality = "high", 129, 53)
If obj.Size <= 0 Then obj.Size = 1
fd = True
End If
If Not fd Then Continue For
End If
MediaObjects.Add(obj)
Next
MediaObjects.RemoveAll(Function(m) (m.Type = UMTypes.Video And (m.Width <= 0 Or m.Height <= 0)) Or m.URL.IsEmptyString)
With MyYouTubeSettings
If .DefaultAudioLanguage_ExcludeAI Or .DefaultAudioLanguage_ExcludeNonDefault Then
If .DefaultAudioLanguage_ExcludeAI.Value AndAlso MediaObjects.LongCount(Function(m) m.Type = UMTypes.Audio And Not m.IsAI) > 0 Then _
MediaObjects.RemoveAll(Function(m) m.Type = UMTypes.Audio And m.IsAI)
If MediaObjects.Count > 0 AndAlso .DefaultAudioLanguage_ExcludeNonDefault.Value AndAlso
MediaObjects.LongCount(Function(m) m.Type = UMTypes.Audio And m.IsDefaultOrOriginal) > 0 Then _
MediaObjects.RemoveAll(Function(m) m.Type = UMTypes.Audio And Not m.IsDefaultOrOriginal)
End If
End With
Dim DupRemover As Action(Of UMTypes) =
Sub(ByVal t As UMTypes)
Const webm$ = "webm"
@@ -1803,8 +1923,9 @@ Namespace API.YouTube.Objects
Dim data As New List(Of MediaObject)(MediaObjects.Where(Function(mo) mo.Type = t And mo.Extension = webm))
If data.Count > 0 Then
Dim d As MediaObject = Nothing
Dim expWebm As Predicate(Of MediaObject) = Function(mo) mo.Extension = webm
Dim expAVC As Predicate(Of MediaObject) = Function(mo) mo.Codec.IfNullOrEmpty("/").ToLower.StartsWith(avc)
Dim allWebm As Boolean = False, allAVC As Boolean = False
Dim expWebm As Predicate(Of MediaObject) = Function(mo) Not allWebm And mo.Extension = webm
Dim expAVC As Predicate(Of MediaObject) = Function(mo) Not allAVC And mo.Codec.IfNullOrEmpty("/").ToLower.StartsWith(avc)
Dim comp As Func(Of MediaObject, Predicate(Of MediaObject), Boolean, Boolean, Boolean) =
Function(mo, exp, isTrue, checkHttp) mo.Type = t And exp.Invoke(mo) = isTrue And mo.Width = d.Width And
(Not checkHttp OrElse mo.ProtocolType = Protocols.https)
@@ -1812,6 +1933,8 @@ Namespace API.YouTube.Objects
Dim RemoveWebm As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expWebm, True, allowWebm)
Dim CountAVC As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expAVC, True, False)
Dim RemoveAVC As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expAVC, False, False)
allWebm = data.All(FPredicate(Of MediaObject).ToFunc(expWebm))
allAVC = data.All(FPredicate(Of MediaObject).ToFunc(expAVC))
For Each d In data
If MediaObjects.Count = 0 Then Exit For
If MediaObjects.LongCount(CountWebm) > 0 Then MediaObjects.RemoveAll(RemoveWebm)
@@ -1932,6 +2055,15 @@ Namespace API.YouTube.Objects
End With
End If
End Sub
Protected Sub ParseChapters(ByVal e As EContainer)
With e({"chapters"})
If .ListExists Then Chapters.AddRange(.Select(Function(ee) New TrimOption With {
.Start = CInt(AConvert(Of Double)(ee.Value("start_time"), 0, EDP.ReturnValue)),
.[End] = CInt(AConvert(Of Double)(ee.Value("end_time"), 0, EDP.ReturnValue)),
.Name = CleanFileName(New SFile With {.Name = ee.Value("title")}).Name
}))
End With
End Sub
#End Region
#Region "IEContainerProvider Support"
Private Function GetElementsChecked() As IEnumerable(Of EContainer)
@@ -2006,6 +2138,8 @@ Namespace API.YouTube.Objects
_Subtitles.Clear()
_SubtitlesDelegated.Clear()
SubtitlesSelectedIndexes.Clear()
Chapters.Clear()
TrimOptions.Clear()
MediaObjects.Clear()
_Files.Clear()
PostProcessing_OutputAudioFormats.Clear()

View File

@@ -124,6 +124,12 @@
<Compile Include="Controls\ChannelTabsChooserForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Controls\ChaptersForm.Designer.vb">
<DependentUpon>ChaptersForm.vb</DependentUpon>
</Compile>
<Compile Include="Controls\ChaptersForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Controls\FilterForm.Designer.vb">
<DependentUpon>FilterForm.vb</DependentUpon>
</Compile>
@@ -136,6 +142,18 @@
<Compile Include="Controls\PlayListParserForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Controls\TrimOptionForm.Designer.vb">
<DependentUpon>TrimOptionForm.vb</DependentUpon>
</Compile>
<Compile Include="Controls\TrimOptionForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Controls\VideoOptionsTrimForm.Designer.vb">
<DependentUpon>VideoOptionsTrimForm.vb</DependentUpon>
</Compile>
<Compile Include="Controls\VideoOptionsTrimForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Controls\YTDataFilter.vb" />
<Compile Include="Downloader\DownloadLocationsCollection.vb" />
<Compile Include="Downloader\IDownloaderSettings.vb" />
@@ -227,12 +245,21 @@
<EmbeddedResource Include="Controls\ChannelTabsChooserForm.resx">
<DependentUpon>ChannelTabsChooserForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Controls\ChaptersForm.resx">
<DependentUpon>ChaptersForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Controls\FilterForm.resx">
<DependentUpon>FilterForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Controls\PlayListParserForm.resx">
<DependentUpon>PlayListParserForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Controls\TrimOptionForm.resx">
<DependentUpon>TrimOptionForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Controls\VideoOptionsTrimForm.resx">
<DependentUpon>VideoOptionsTrimForm.vb</DependentUpon>
</EmbeddedResource>
<EmbeddedResource Include="Downloader\MediaItem.resx">
<DependentUpon>MediaItem.vb</DependentUpon>
</EmbeddedResource>

View File

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

View File

@@ -29,6 +29,8 @@ Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.Updater", "SCrawle
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.Shared", "SCrawler.Shared\SCrawler.Shared.vbproj", "{DC634700-24C7-42DD-BF8F-87E6CC54E625}"
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "PersonalUtilities.Images", "..\..\MyUtilities\PersonalUtilities.Images\PersonalUtilities.Images.vbproj", "{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
@@ -135,6 +137,18 @@ Global
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Release|x64.Build.0 = Release|x64
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Release|x86.ActiveCfg = Release|x86
{DC634700-24C7-42DD-BF8F-87E6CC54E625}.Release|x86.Build.0 = Release|x86
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Debug|Any CPU.Build.0 = Debug|Any CPU
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Debug|x64.ActiveCfg = Debug|x64
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Debug|x64.Build.0 = Debug|x64
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Debug|x86.ActiveCfg = Debug|x86
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Debug|x86.Build.0 = Debug|x86
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Release|Any CPU.ActiveCfg = Release|Any CPU
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Release|Any CPU.Build.0 = Release|Any CPU
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Release|x64.ActiveCfg = Release|x64
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Release|x64.Build.0 = Release|x64
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Release|x86.ActiveCfg = Release|x86
{B7EF76A9-96F3-4C53-B252-0AB5F79B67B3}.Release|x86.Build.0 = Release|x86
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE

View File

@@ -57,6 +57,17 @@ dotnet_naming_rule.constant_fields_should_be_pascal_case.style = pascal_case_
dotnet_naming_symbols.constant_fields.applicable_kinds = field
dotnet_naming_symbols.constant_fields.applicable_accessibilities = *
dotnet_naming_symbols.constant_fields.required_modifiers = const
dotnet_style_operator_placement_when_wrapping = beginning_of_line
tab_width = 4
end_of_line = crlf
dotnet_style_prefer_simplified_boolean_expressions = true:suggestion
dotnet_style_prefer_compound_assignment = true:suggestion
dotnet_style_prefer_simplified_interpolation = true:suggestion
dotnet_style_prefer_collection_expression = when_types_loosely_match:suggestion
dotnet_style_namespace_match_folder = true:suggestion
dotnet_style_allow_multiple_blank_lines_experimental = true:silent
dotnet_style_allow_statement_immediately_after_block_experimental = true:silent
dotnet_code_quality_unused_parameters = all:suggestion
###############################
# C# Coding Conventions #
###############################

View File

@@ -11,6 +11,9 @@ Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Base
Friend Module Declarations
Friend Interface IThumbList
Property Thumbs As List(Of String)
End Interface
Friend Const UserLabelName As String = "User"
Friend Const SearchRequestLabelName As String = "Search request"
Friend ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly)

View File

@@ -11,6 +11,10 @@ Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Base
Friend Class EditorExchangeOptionsBase
Friend Overridable Property SiteKey As String
<PSetting(Address:=SettingAddress.User, Caption:="Profile exists")>
Friend Overridable Property UserExists As Boolean = True
<PSetting(Address:=SettingAddress.User, Caption:="Profile suspended")>
Friend Overridable Property UserSuspended As Boolean = False
<PSetting(Address:=SettingAddress.User, Caption:=DN.UserNameChangeCaption, ToolTip:=DN.UserNameChangeToolTip)>
Friend Overridable Property UserName As String = String.Empty
<PSetting(Address:=SettingAddress.User, Caption:=DN.DownloadTextCaption, ToolTip:=DN.DownloadTextTip)>
@@ -20,6 +24,8 @@ Namespace API.Base
<PSetting(Address:=SettingAddress.User, Caption:=DN.DownloadTextSpecialFolderCaption, ToolTip:=DN.DownloadTextSpecialFolderTip)>
Friend Overridable Property DownloadTextSpecialFolder As Boolean = False
Friend Sub New(ByVal u As UserDataBase)
UserExists = u.UserExists
UserSuspended = u.UserSuspended
UserName = u.NameTrue(True)
DownloadText = u.DownloadText
DownloadTextPosts = u.DownloadTextPosts
@@ -35,6 +41,8 @@ Namespace API.Base
Protected _ApplyBase_Name As Boolean = True
Protected _ApplyBase_Text As Boolean = True
Friend Sub ApplyBase(ByRef u As UserDataBase)
u.UserExists = UserExists
u.UserSuspended = UserSuspended
If _ApplyBase_Name Then u.NameTrue = UserName
If _ApplyBase_Text Then
u.DownloadText = DownloadText
@@ -42,5 +50,9 @@ Namespace API.Base
u.DownloadTextSpecialFolder = DownloadTextSpecialFolder
End If
End Sub
Friend Overridable Sub Apply(ByRef u As UserDataBase)
ApplyBase(u)
If TypeOf u Is IPSite And TypeOf Me Is IPSite Then DirectCast(u, IPSite).QueryString = DirectCast(Me, IPSite).QueryString
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,39 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes
Namespace API.Base
Friend Interface IPSite
Property QueryString As String
End Interface
Friend Class EditorExchangeOptionsBase_P : Inherits EditorExchangeOptionsBase : Implements IPSite
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property UserName As String
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadText As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadTextPosts As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadTextSpecialFolder As Boolean
<PSetting(Address:=SettingAddress.User, Caption:="Query",
ToolTip:="Query string. Don't change this field when creating a user! Change it only for the same request.")>
Friend Property QueryString As String Implements IPSite.QueryString
Friend Sub New()
DisableBase()
End Sub
Friend Sub New(ByVal u As UserDataBase)
MyBase.New(u)
DisableBase()
If TypeOf u Is IPSite Then QueryString = DirectCast(u, IPSite).QueryString
End Sub
Friend Sub New(ByVal s As SiteSettingsBase)
MyBase.New(s)
DisableBase()
End Sub
Protected Overridable Sub DisableBase()
_ApplyBase_Name = False
_ApplyBase_Text = False
End Sub
End Class
End Namespace

View File

@@ -10,10 +10,8 @@ Namespace API.Base.GDL
Friend Class GDLBatch : Inherits TokenBatch
Friend Const UrlLibStart As String = "[urllib3.connectionpool][debug]"
Friend Const UrlTextStart As String = UrlLibStart & " https"
Friend Sub New(ByVal _Token As Threading.CancellationToken)
MyBase.New(_Token)
MainProcessName = "gallery-dl"
ChangeDirectory(Settings.GalleryDLFile.File)
Friend Sub New(ByVal _Token As Threading.CancellationToken, Optional ByVal __MainProcessName As String = Nothing, Optional ByVal WorkingDir As SFile = Nothing)
MyBase.New(_Token, __MainProcessName.IfNullOrEmpty(Settings.GalleryDLFile.File.Name), WorkingDir.IfNullOrEmpty(Settings.GalleryDLFile.File))
End Sub
Protected Overrides Async Sub OutputDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
If Not ProcessKilled Then

View File

@@ -53,7 +53,12 @@ Namespace API.Base
End Get
End Property
Private Property Logger As ILogProvider = LogConnector Implements ISiteSettings.Logger
Friend Overridable ReadOnly Property Responser As Responser
Protected _Responser As Responser = Nothing
Friend ReadOnly Property Responser As Responser
Get
Return _Responser
End Get
End Property
Private _UserOptionsExists As Boolean = False
Private _UserOptionsType As Type = Nothing
Protected Overridable Function UserOptionsValid(ByVal Options As Object) As Boolean
@@ -122,6 +127,11 @@ Namespace API.Base
_CookiesNetscapeFile.Name &= "_Cookies_Netscape"
_CookiesNetscapeFile.Extension = "txt"
End Sub
Protected Overridable Sub ChangeResponserOnInit()
End Sub
Friend Overridable Function GetCookieKeeperInstance() As CookieKeeper
Return New CookieKeeper
End Function
#End Region
#Region "GetInstance"
Friend MustOverride Function GetInstance(ByVal What As Download) As IPluginContentProvider Implements ISiteSettings.GetInstance
@@ -131,7 +141,8 @@ Namespace API.Base
Site = SiteName
_Icon = __Icon
_Image = __Image
Responser = New Responser With {.DeclaredError = EDP.ThrowException}
_Responser = New Responser With {.DeclaredError = EDP.ThrowException}
ChangeResponserOnInit()
SettingsVersion = New PropertyValue(0)
DownloadText = New PropertyValue(False)
DownloadTextPosts = New PropertyValue(False)

View File

@@ -58,6 +58,11 @@ Namespace API.Base
Return Type = Types.Audio Or Type = Types.AudioPre
End Get
End Property
Friend ReadOnly Property IsPhotoType As Boolean
Get
Return Type = Types.Picture Or Type = Types.GIF
End Get
End Property
Friend URL_BASE As String
Friend URL As String
Friend MD5 As String

View File

@@ -13,10 +13,21 @@ Namespace API.Base
Friend Property TempPostsList As List(Of String)
Protected ReadOnly Token As CancellationToken
Friend Property DebugMode As Boolean = False
Friend Sub New(ByVal _Token As CancellationToken)
Friend Overridable Property MyWorkingDirectory As SFile = Nothing
Friend Sub New(ByVal _Token As CancellationToken, Optional ByVal _MainProcessName As String = Nothing, Optional ByVal WorkingDir As SFile = Nothing)
MyBase.New(True)
Token = _Token
MainProcessName = _MainProcessName
If Not WorkingDir.IsEmptyString Then ChangeDirectory(WorkingDir)
End Sub
Public Overrides Sub ChangeDirectory(ByVal Directory As SFile)
MyBase.ChangeDirectory(Directory)
If Not Directory.IsEmptyString Then MyWorkingDirectory = Directory
End Sub
Protected Overrides Function Internal_Execute(ByVal Commands As IEnumerable(Of String), ByVal e As ErrorsDescriber) As Boolean
If Not Encoding.HasValue Then Encoding = UnicodeEncoding
Return MyBase.Internal_Execute(Commands, e)
End Function
Public Overrides Sub Create()
If TempPostsList Is Nothing Then TempPostsList = New List(Of String)
MyBase.Create()

View File

@@ -28,6 +28,7 @@ Namespace API.Base
Friend MustInherit Class UserDataBase : Implements IUserData, IPluginContentProvider, IThrower
Friend Const UserFileAppender As String = "User"
Friend Const PostTextSpecialFolderDefault As String = "txt"
Friend Const PostTextTEXTSpecialFolderDefault As String = "Text"
#Region "Events"
Private ReadOnly UserUpdatedEventHandlers As List(Of IUserData.UserUpdatedEventHandler)
Friend Custom Event UserUpdated As IUserData.UserUpdatedEventHandler Implements IUserData.UserUpdated
@@ -183,8 +184,6 @@ Namespace API.Base
#Region "Additional names"
Protected Const Name_SiteMode As String = "SiteMode"
Protected Const Name_TrueName As String = "TrueName"
'TODELETE Name_TrueName2
<Obsolete> Protected Const Name_TrueName2 As String = "NameTrue"
Protected Const Name_Arguments As String = "Arguments"
#End Region
#End Region
@@ -252,7 +251,20 @@ Namespace API.Base
#End Region
#Region "User name, ID, exist, suspend, options"
Friend User As UserInfo
Private _IsSavedPosts As Boolean = False
Friend Property IsSavedPosts As Boolean Implements IPluginContentProvider.IsSavedPosts
Get
Return _IsSavedPosts
End Get
Set(ByVal __IsSavedPosts As Boolean)
_IsSavedPosts = __IsSavedPosts
If _IsSavedPosts Then
DownloadText = True
DownloadTextPosts = True
DownloadTextSpecialFolder = True
End If
End Set
End Property
Private _UserExists As Boolean = True
Friend Overridable Property UserExists As Boolean Implements IUserData.Exists, IPluginContentProvider.UserExists
Get
@@ -300,7 +312,16 @@ Namespace API.Base
Return If(Exact, _NameTrue, _NameTrue.IfNullOrEmpty(Name))
End Get
End Property
Friend Overridable Property ID As String = String.Empty Implements IUserData.ID, IPluginContentProvider.ID
Private _ID As String = String.Empty
Friend Property ID As String Implements IUserData.ID, IPluginContentProvider.ID
Get
Return _ID
End Get
Set(ByVal NewId As String)
If Not _ID = NewId Then EnvirChanged(NewId)
_ID = NewId
End Set
End Property
Protected _FriendlyName As String = String.Empty
Friend Overridable Property FriendlyName As String Implements IUserData.FriendlyName
Get
@@ -338,8 +359,8 @@ Namespace API.Base
Me._UserSiteName = _UserSiteName
End Set
End Property
Protected Sub UserSiteNameUpdate(ByVal NewName As String)
If Not NewName.IsEmptyString And (UserSiteName.IsEmptyString Or Settings.UpdateUserSiteNameEveryTime) Then UserSiteName = NewName
Protected Sub UserSiteNameUpdate(ByVal NewName As String, Optional ByVal Force As Boolean = False)
If Not NewName.IsEmptyString And (UserSiteName.IsEmptyString Or Settings.UpdateUserSiteNameEveryTime Or Force) Then UserSiteName = NewName
End Sub
Friend ReadOnly Property UserModel As UsageModel Implements IUserData.UserModel
Get
@@ -955,9 +976,6 @@ BlockNullPicture:
Using x As New XmlFile(MyFileSettings) With {.XmlReadOnly = True}
If User.Name.IsEmptyString Then User.Name = x.Value(Name_UserName)
_NameTrue = x.Value(Name_TrueName)
#Disable Warning BC40008
If _NameTrue.IsEmptyString AndAlso x.Contains(Name_TrueName2) Then _NameTrue = x.Value(Name_TrueName2)
#Enable Warning
UserExists = x.Value(Name_UserExists).FromXML(Of Boolean)(True)
UserSuspended = x.Value(Name_UserSuspended).FromXML(Of Boolean)(False)
ID = x.Value(Name_UserID)
@@ -985,8 +1003,8 @@ BlockNullPicture:
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
DownloadImages = x.Value(Name_DownloadImages).FromXML(Of Boolean)(True)
DownloadVideos = x.Value(Name_DownloadVideos).FromXML(Of Boolean)(True)
DownloadText = x.Value(Name_DownloadText).FromXML(Of Boolean)(False)
DownloadTextPosts = x.Value(Name_DownloadTextPosts).FromXML(Of Boolean)(False)
DownloadText = x.Value(Name_DownloadText).FromXML(Of Boolean)(IsSavedPosts)
DownloadTextPosts = x.Value(Name_DownloadTextPosts).FromXML(Of Boolean)(IsSavedPosts)
DownloadTextSpecialFolder = x.Value(Name_DownloadTextSpecialFolder).FromXML(Of Boolean)(True)
_IconBannerDownloaded = x.Value(Name_IconBannerDownloaded).FromXML(Of Boolean)(False)
DownloadedVideos(True) = x.Value(Name_VideoCount).FromXML(Of Integer)(0)
@@ -1008,7 +1026,7 @@ BlockNullPicture:
End Try
End Sub
Private Sub UpdateUserInformation_Ex()
If _ForceSaveUserInfoOnException Then UpdateUserInformation()
If _ForceSaveUserInfo Then UpdateUserInformation()
End Sub
Friend Overridable Overloads Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation
UpdateUserInformation(False)
@@ -1185,7 +1203,6 @@ BlockNullPicture:
Protected UseClientTokens As Boolean = False
Protected _ForceSaveUserData As Boolean = False
Protected _ForceSaveUserInfo As Boolean = False
Protected _ForceSaveUserInfoOnException As Boolean = False
Private _DownloadInProgress As Boolean = False
Private _EnvirUserExists As Boolean
Private _EnvirUserSuspended As Boolean
@@ -1203,16 +1220,15 @@ BlockNullPicture:
_DownloadInProgress = True
_DescriptionChecked = False
_DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime
_ForceSaveUserData = False
_ForceSaveUserInfo = False
_ForceSaveUserInfoOnException = False
_EnvirUserExists = UserExists
_EnvirUserSuspended = UserSuspended
_EnvirCreatedByChannel = CreatedByChannel
_EnvirChanged = False
_EnvirInvokeUserUpdated = False
UserExists = True
UserSuspended = False
_EnvirCreatedByChannel = CreatedByChannel
_ForceSaveUserData = False
_ForceSaveUserInfo = False
_EnvirChanged = False
_EnvirInvokeUserUpdated = False
DownloadedPictures(False) = 0
DownloadedVideos(False) = 0
_PictureExists = Settings.ViewModeIsPicture AndAlso Not GetPicture(Of Image)(False) Is Nothing
@@ -1220,9 +1236,10 @@ BlockNullPicture:
Private Sub EnvirChanged(ByVal NewValue As Object, <CallerMemberName> Optional ByVal Caller As String = Nothing)
If _DownloadInProgress Then
Select Case Caller
Case NameOf(UserExists) : If Not _EnvirUserExists = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
Case NameOf(UserSuspended) : If Not _EnvirUserSuspended = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
Case NameOf(NameTrue) : _EnvirChanged = True : _EnvirInvokeUserUpdated = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True
Case NameOf(UserExists) : If Not _EnvirUserExists = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True : _ForceSaveUserInfo = True
Case NameOf(UserSuspended) : If Not _EnvirUserSuspended = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True : _ForceSaveUserInfo = True
Case NameOf(NameTrue) : _EnvirChanged = True : _ForceSaveUserInfo = True
Case NameOf(ID) : _EnvirChanged = True : _ForceSaveUserInfo = True
Case Else : _EnvirChanged = True
End Select
End If
@@ -1416,6 +1433,18 @@ BlockNullPicture:
Cache.Validate()
Return Cache
End Function
#Region "GDL File Names"
Protected GDLFileNameProvider As ANumbers = Nothing
Protected Sub GDLResetFileNameProvider(Optional ByVal GroupSize As Integer? = Nothing)
GDLFileNameProvider = New ANumbers With {
.FormatOptions = ANumbers.Options.FormatNumberGroup + ANumbers.Options.Groups,
.GroupSize = If(GroupSize, 3)
}
End Sub
Protected Function GDLRenameFile(ByVal Input As SFile, ByVal i As Integer) As SFile
Return SFile.Rename(Input, $"{Input.PathWithSeparator}{i.NumToString(GDLFileNameProvider)}.{Input.Extension}",, EDP.ThrowException)
End Function
#End Region
#Region "DownloadSingleObject"
Protected IsSingleObjectDownload As Boolean = False
Friend Overridable Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken) Implements IUserData.DownloadSingleObject
@@ -1519,6 +1548,12 @@ BlockNullPicture:
''' </summary>
Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken)
End Sub
Protected Sub ReparseMissing_ClearList(ByRef rList As List(Of Integer))
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Sub
#End Region
#Region "MD5 support"
Private Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR"
@@ -1695,11 +1730,12 @@ BlockNullPicture:
If _ContentNew.Count > 0 Then
If UseMD5Comparison Then LoadMD5()
MyFile.Exists(SFO.Path)
Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog
Dim MissingErrorsAdd As Boolean = Settings.AddMissingToLog And Settings.AddMissingErrorsToLog
Dim MyDir$ = DownloadContentDefault_GetRootDir()
Dim vsf As Boolean = SeparateVideoFolderF
Dim __isVideo As Boolean
Dim __interrupt As Boolean
Dim postProcessWebp As Boolean
Dim f As SFile, fTxt As SFile
Dim v As UserMedia
Dim __fileDeleted As Boolean
@@ -1759,6 +1795,7 @@ BlockNullPicture:
If v.URL_BASE.IsEmptyString Then v.URL_BASE = v.URL
__fileDeleted = False
postProcessWebp = False
If (v.Type = UTypes.Text And DownloadText) Or (Not f.IsEmptyString And Not v.URL.IsEmptyString) Then
Try
@@ -1771,8 +1808,9 @@ BlockNullPicture:
Case UTypes.Video, UTypes.m3u8 : f.Extension = "mp4"
Case UTypes.GIF : f.Extension = "gif"
End Select
ElseIf f.Extension = "webp" And Settings.DownloadNativeImageFormat Then
f.Extension = "jpg"
ElseIf f.Extension = UserImage.ExtWebp And Settings.DownloadNativeImageFormat And Settings.FfmpegFile.Exists Then
'f.Extension = "jpg"
postProcessWebp = True
End If
If Not v.SpecialFolder.IsEmptyString Then
@@ -1808,6 +1846,7 @@ BlockNullPicture:
updateDownCount(False)
v.File = ChangeFileNameByProvider(f, v)
v.File = DownloadContentDefault_ConvertWebp(v, postProcessWebp)
v.State = UStates.Downloaded
DownloadContentDefault_PostProcessing(v, f, Token)
If UseMD5Comparison And (v.Type = UTypes.GIF Or v.Type = UTypes.Picture) Then
@@ -1838,8 +1877,13 @@ stxt:
Continue For
End If
End If
If Not fTxt.Path.StartsWith(MyDir) Then fTxt.Path = MyDir
v.PostTextFileSpecialFolder = DownloadTextSpecialFolder
If DownloadTextSpecialFolder Then fTxt.Path = $"{fTxt.Path.StringTrimEnd("\")}\{PostTextSpecialFolderDefault}"
If v.Type = UTypes.Text Then
fTxt.Path = $"{fTxt.Path.StringTrimEnd("\")}\{PostTextTEXTSpecialFolderDefault}"
ElseIf DownloadTextSpecialFolder Then
fTxt.Path = $"{fTxt.Path.StringTrimEnd("\")}\{PostTextSpecialFolderDefault}"
End If
fTxt.Extension = "txt"
v.PostTextFile = TextSaver.SaveTextToFile(v.PostText, fTxt,,, Settings.FeedShowTextPosts_LogErrors_E)
If Not v.PostTextFile.Exists Then Throw New ArgumentNullException("Text", "Error downloading text") With {.HelpLink = 10}
@@ -1907,6 +1951,44 @@ stxt:
End Function
Protected Overridable Sub DownloadContentDefault_PostProcessing(ByRef m As UserMedia, ByVal File As SFile, ByVal Token As CancellationToken)
End Sub
Protected Overridable Function DownloadContentDefault_ConvertWebp(ByVal m As UserMedia, ByVal Process As Boolean) As SFile
Return DownloadContentDefault_ConvertWebp_Impl(m, Process)
End Function
Protected Overridable Function DownloadContentDefault_ConvertWebp_Impl(ByVal m As UserMedia, ByVal Process As Boolean, Optional ByVal ConvertWebpForce As Boolean = False) As SFile
Dim WebpFile As SFile = m.File
Dim f As SFile = WebpFile
If Process AndAlso f.Exists Then
f.Path = $"{f.PathWithSeparator}Sources"
f.Exists(SFO.Path)
If WebpFile.Copy(f) Then
Dim newFile As SFile = WebpFile
newFile.Extension = UserImage.ExtJpg
f = UserImage.ConvertWebp(f, newFile, ConvertWebpForce)
If f.Exists Then WebpFile.Delete(SFO.File, SFODelete.DeletePermanently, EDP.ReturnValue)
Else
f = WebpFile
End If
End If
Return f
End Function
Protected Function DownloadContentDefault_ConvertWebp_TestImg(ByVal m As UserMedia, ByVal Process As Boolean) As SFile
If m.Type = UTypes.Picture And Settings.DownloadNativeImageFormat Then
Using testImg As New UserImage.ImageRenderer2(m.File, EDP.ReturnValue)
If testImg.IsWebP Then
Dim f As SFile = m.File
If f.Extension.IsEmptyString OrElse Not f.Extension = UserImage.ExtWebp Then
f.Extension = UserImage.ExtWebp
f = SFile.Rename(m.File, f,, EDP.ReturnValue).IfNullOrEmpty(m.File)
End If
m.File = f
Return DownloadContentDefault_ConvertWebp_Impl(m, True).IfNullOrEmpty(f)
End If
End Using
ElseIf Process Then
Return DownloadContentDefault_ConvertWebp_Impl(m, Process)
End If
Return m.File
End Function
Protected Overridable Function DownloadContentDefault_ProcessDownloadException() As Boolean
Return True
End Function
@@ -2265,11 +2347,12 @@ stxt:
End Function
#End Region
#Region "Errors functions"
''' <summary>ToStringForLog(): Message</summary>
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String, Optional ByVal e As ErrorsDescriber = Nothing)
ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}")
End Sub
Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String)
If Not f.Exists Then MyMainLOG = $"Error downloading from [{URL}] to [{f}]"
If Not f.Exists Then LogError(Nothing, $"error downloading{vbCr}{URL}{vbCr}{f}")
End Sub
''' <exception cref="ObjectDisposedException"></exception>
Protected Sub ThrowIfDisposed()
@@ -2410,6 +2493,7 @@ stxt:
_TempPostsList.Clear()
_MD5List.Clear()
TokenPersonal = Nothing
GDLFileNameProvider = Nothing
If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose()
If Not Responser Is Nothing Then Responser.Dispose()
If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose()

View File

@@ -6,13 +6,20 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API.YouTube
Namespace API.Base.YTDLP
Friend Class YTDLPBatch : Inherits GDL.GDLBatch
Friend Sub New(ByVal _Token As Threading.CancellationToken)
MyBase.New(_Token)
Commands.Clear()
MainProcessName = Settings.YtdlpFile.File.Name '"yt-dlp"
ChangeDirectory(Settings.YtdlpFile.File)
Friend Sub New(ByVal _Token As Threading.CancellationToken, Optional ByVal __MainProcessName As String = Nothing, Optional ByVal WorkingDir As SFile = Nothing)
MyBase.New(_Token, __MainProcessName.IfNullOrEmpty(Settings.YtdlpFile.File.Name), WorkingDir.IfNullOrEmpty(Settings.YtdlpFile.File))
End Sub
Friend Sub SetProgress(ByVal Progress As MyProgress, Optional ByVal ValCalc As Func(Of Double, Double) = Nothing)
If Not Progress Is Nothing Then AddHandler OutputDataReceived, CreateYtdlpProgressHandler(Progress, Token, Me, ValCalc)
End Sub
Friend Sub CreateFileExchanger(ByVal cache As CacheKeeper, Optional ByVal root As SFile = Nothing)
FileExchanger = cache.NewInstance(Of BatchFileExchanger)(root, EDP.ReturnValue)
If Not FileExchanger Is Nothing Then FileExchanger.DeleteCacheOnDispose = True
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,56 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes
Namespace API.Bluesky
Friend Class EditorExchangeOptions : Inherits EditorExchangeOptionsBase
Friend Overrides Property SiteKey As String = BlueskySiteKey
<PSetting(NameOf(SiteSettings.DownloadModelMedia), NameOf(MySettings), Address:=SettingAddress.User)>
Friend Overridable Property DownloadModelMedia As Boolean = False
<PSetting(NameOf(SiteSettings.DownloadModelProfile), NameOf(MySettings), Address:=SettingAddress.User)>
Friend Overridable Property DownloadModelProfile As Boolean = False
<PSetting(NameOf(Twitter.SiteSettings.UseMD5Comparison), NameOf(MySettings))>
Friend Property UseMD5Comparison As Boolean = False
<PSetting(Caption:="Remove existing duplicates",
ToolTip:="Existing files will be checked for duplicates and duplicates removed." & vbCr &
"Works only on the first activation 'Use MD5 comparison'.")>
Friend Property RemoveExistingDuplicates As Boolean = False
Private ReadOnly Property MySettings As Object
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
DownloadModelMedia = s.DownloadModelMedia.Value
DownloadModelProfile = s.DownloadModelProfile.Value
MySettings = s
End Sub
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
DownloadModelMedia = u.DownloadModelMedia
DownloadModelProfile = u.DownloadModelProfile
UseMD5Comparison = u.UseMD5Comparison
RemoveExistingDuplicates = u.RemoveExistingDuplicates
MySettings = u.HOST.Source
End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u)
If Not DownloadModelMedia And Not DownloadModelProfile Then
DownloadModelMedia = True
ElseIf DownloadModelMedia Then
DownloadModelProfile = False
Else
DownloadModelMedia = False
End If
With DirectCast(u, UserData)
.DownloadModelMedia = DownloadModelMedia
.DownloadModelProfile = DownloadModelProfile
.UseMD5Comparison = UseMD5Comparison
.RemoveExistingDuplicates = RemoveExistingDuplicates
End With
End Sub
End Class
End Namespace

View File

@@ -14,7 +14,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Namespace API.Bluesky
<Manifest(BlueskySiteKey), SpecialForm(False)>
<Manifest(BlueskySiteKey), SpecialForm(False), SavedPosts>
Friend Class SiteSettings : Inherits SiteSettingsBase
<PropertyOption(ControlText:="Cookies enabled", ControlToolTip:="If checked, cookies will be used in requests", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property CookiesEnabled As PropertyValue
@@ -26,6 +26,10 @@ Namespace API.Bluesky
<PXML> Friend ReadOnly Property TokenUpdateTime As PropertyValue
<PropertyOption(ControlText:="Token update", ControlToolTip:="Token refresh interval (in minutes)." & vbCr & "Default: 120.", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property TokenRefreshInterval As PropertyValue
<PropertyOption(ControlText:="Download model 'Media'", ControlToolTip:="Parse the 'Media' block", Category:=DeclaredNames.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadModelMedia As PropertyValue
<PropertyOption(ControlText:="Download model 'Profile'", ControlToolTip:="Parse the 'Posts' block", Category:=DeclaredNames.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadModelProfile As PropertyValue
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("Bluesky", "bsky.app", AccName, Temp, My.Resources.SiteResources.BlueskyIcon_32, My.Resources.SiteResources.BlueskyPic_32)
@@ -38,11 +42,14 @@ Namespace API.Bluesky
TokenUpdateTime = New PropertyValue(Now.AddYears(-1))
TokenRefreshInterval = New PropertyValue(120)
DownloadModelMedia = New PropertyValue(True)
DownloadModelProfile = New PropertyValue(False)
_AllowUserAgentUpdate = False
UrlPatternUser = "https://bsky.app/profile/{0}"
ImageVideoContains = "bsky.app"
UserRegex = RParams.DMS("bsky.app/profile/([^/\?]+)", 1, EDP.ReturnValue)
UserOptionsType = GetType(EditorExchangeOptionsBase)
UserOptionsType = GetType(EditorExchangeOptions)
End Sub
Protected Overrides Function UserOptionsValid(ByVal Options As Object) As Boolean
Return DirectCast(Options, EditorExchangeOptionsBase).SiteKey = BlueskySiteKey
@@ -96,5 +103,10 @@ Namespace API.Bluesky
_TokenUpdating = False
End Try
End Function
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim e As ExchangeOptions = MyBase.IsMyUser(UserURL)
If Not e.UserName.IsEmptyString AndAlso e.UserName.StartsWith("did:") Then e.UserName = e.UserName.Replace(":", "@")
Return e
End Function
End Class
End Namespace

View File

@@ -7,15 +7,22 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.Plugin
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Bluesky
Friend Class UserData : Inherits UserDataBase
#Region "XML names"
Private Const Name_DownloadModelMedia As String = "DownloadModelMedia"
Private Const Name_DownloadModelProfile As String = "DownloadModelProfile"
Private Const Name_ForceParseProfileInfo As String = "ForceParseProfileInfo"
#End Region
#Region "Declarations"
Private ReadOnly Property MySettings As SiteSettings
Get
@@ -27,21 +34,56 @@ Namespace API.Bluesky
Return If(ID.IsEmptyString, String.Empty, SymbolsConverter.ASCII.EncodeSymbolsOnly(ID))
End Get
End Property
Private ReadOnly _TmpPosts2 As List(Of String)
Friend Property DownloadModelMedia As Boolean = True
Friend Property DownloadModelProfile As Boolean = False
Private Property ForceParseProfileInfo As Boolean = False
#End Region
#Region "Loader"
Private Sub UpdateUserOptions()
If ID.IsEmptyString AndAlso Not Name.IsEmptyString AndAlso Name.StartsWith("did@") Then
NameTrue = Name.Replace("@", ":")
ID = NameTrue
ForceParseProfileInfo = True
End If
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
If .Contains(Name_DownloadModelMedia) Then
DownloadModelMedia = .Value(Name_DownloadModelMedia).FromXML(Of Boolean)(True)
DownloadModelProfile = .Value(Name_DownloadModelProfile).FromXML(Of Boolean)(False)
Else
DownloadModelMedia = ParseUserMediaOnly
DownloadModelProfile = Not ParseUserMediaOnly
End If
ForceParseProfileInfo = .Value(Name_ForceParseProfileInfo).FromXML(Of Boolean)(False)
UseMD5Comparison = .Value(Name_UseMD5Comparison).FromXML(Of Boolean)(False)
RemoveExistingDuplicates = .Value(Name_RemoveExistingDuplicates).FromXML(Of Boolean)(False)
Else
If ID.IsEmptyString Then
UpdateUserOptions()
.Value(Name_UserID) = ID
End If
.Add(Name_DownloadModelMedia, DownloadModelMedia.BoolToInteger)
.Add(Name_DownloadModelProfile, DownloadModelProfile.BoolToInteger)
.Add(Name_ForceParseProfileInfo, ForceParseProfileInfo.BoolToInteger)
.Add(Name_UseMD5Comparison, UseMD5Comparison.BoolToInteger)
.Add(Name_RemoveExistingDuplicates, RemoveExistingDuplicates.BoolToInteger)
End If
End With
End Sub
Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptionsBase(Me) With {.SiteKey = BlueskySiteKey}
Return New EditorExchangeOptions(Me)
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptionsBase AndAlso
DirectCast(Obj, EditorExchangeOptionsBase).SiteKey = BlueskySiteKey Then DirectCast(Obj, EditorExchangeOptionsBase).ApplyBase(Me)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then DirectCast(Obj, EditorExchangeOptions).Apply(Me)
End Sub
#End Region
#Region "Initializer"
Friend Sub New()
UseInternalM3U8Function = True
_TmpPosts2 = New List(Of String)
End Sub
#End Region
#Region "Token"
@@ -62,32 +104,59 @@ Namespace API.Bluesky
#Region "Download"
Private _PostCount As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_CurlProfileTried = False
_TmpPosts2.Clear()
Try
If Not DownloadModelMedia And Not DownloadModelProfile Then
DownloadModelMedia = True
ElseIf DownloadModelMedia Then
DownloadModelProfile = False
Else
DownloadModelMedia = False
End If
If Not CBool(MySettings.CookiesEnabled.Value) Then Responser.Cookies.Clear()
UpdateToken(, True)
_TokenUpdateCount = 0
_PostCount = 0
DownloadData(String.Empty, Token)
Finally
_TempPostsList.ListAddList(_TmpPosts2, LNC)
_TmpPosts2.Clear()
End Try
End Sub
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
If ID.IsEmptyString Then GetProfileInfo(Token)
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "ID is null")
If (Not IsSavedPosts And ID.IsEmptyString) Or ForceParseProfileInfo Then GetProfileInfo(Token)
If Not IsSavedPosts And ID.IsEmptyString Then Throw New ArgumentNullException("ID", "ID is null")
If UpdateToken() Then
Dim nextCursor$ = String.Empty
Dim c%
URL = $"https://bsky.social/xrpc/app.bsky.feed.getAuthorFeed?actor={ID_Encoded}&filter=posts_and_author_threads&includePins=false&limit=99"
Dim n$(), p$()
If IsSavedPosts Then
URL = "https://bsky.social/xrpc/app.bsky.bookmark.getBookmarks"
If Not Cursor.IsEmptyString Then URL &= $"?cursor={Cursor}"
n = {"bookmarks"}
p = {"item"}
Else
'posts_and_author_threads
'posts_with_media
URL = $"https://bsky.social/xrpc/app.bsky.feed.getAuthorFeed?actor={ID_Encoded}&filter={IIf(DownloadModelMedia, "posts_with_media", "posts_and_author_threads")}&includePins=false&limit=99"
If Not Cursor.IsEmptyString Then URL &= $"&cursor={SymbolsConverter.ASCII.EncodeSymbolsOnly(Cursor)}"
n = {"feed"}
p = {"post"}
End If
Dim r$ = Responser.GetResponse(URL)
TokenUpdateCountReset()
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
With j("feed")
nextCursor = j.Value("cursor")
With j(n)
If .ListExists Then
For Each post As EContainer In .Self
With post({"post"})
c = DefaultParser(.Self,, nextCursor)
With post(p)
c = DefaultParser(.Self) ',, nextCursor)
Select Case c
Case CInt(DateResult.Skip) * -1 : Continue For
Case CInt(DateResult.Exit) * -1 : Exit Sub
@@ -96,6 +165,8 @@ Namespace API.Bluesky
If DownloadTopCount.HasValue AndAlso DownloadTopCount.Value <= _PostCount Then Exit Sub
End With
Next
ElseIf IsSavedPosts Then
nextCursor = String.Empty
End If
End With
End If
@@ -105,7 +176,11 @@ Namespace API.Bluesky
End If
End If
Catch ex As Exception
ProcessException(ex, Token, $"DownloadData({URL})")
Select Case ProcessException(ex, Token, $"DownloadData({URL})")
Case 1 : DownloadData(Cursor, Token)
Case 2 : Throw ex
Case Else : Throw New ExitException($"StatusCode = {CInt(Responser.StatusCode)}", ex) With {.Silent = True}
End Select
End Try
End Sub
#End Region
@@ -117,7 +192,8 @@ Namespace API.Bluesky
Private Function DefaultParser(ByVal e As EContainer, Optional ByVal CheckDateLimits As Boolean = True, Optional ByRef NextCursor As String = Nothing,
Optional ByVal CheckTempPosts As Boolean = True, Optional ByVal State As UStates = UStates.Unknown) As Integer
Const exitReturn% = CInt(DateResult.Exit) * -1
Dim postID$, postDate$, __url$, __urlBase$, __txt$
Const skipReturn% = CInt(DateResult.Skip) * -1
Dim postID$, postDate$, __url$, __urlBase$, __txt$, __userId$, __postAuthor$
Dim updateUrl As Boolean
Dim c% = 0
Dim m As UserMedia
@@ -128,22 +204,29 @@ Namespace API.Bluesky
postDate = String.Empty
__urlBase = String.Empty
__txt = String.Empty
__userId = .Value({"author"}, "did")
__postAuthor = String.Empty
With .Item({"record"})
If .ListExists Then
'2025-01-28T02:42:12.415Z
postDate = .Value("createdAt")
NextCursor = postDate
If Not IsSavedPosts Then NextCursor = postDate
If CheckDateLimits Then
Select Case CheckDatesLimit(postDate, DateProvider)
Case DateResult.Skip : Return CInt(DateResult.Skip) * -1 'Continue For
Case DateResult.Skip : Return skipReturn 'Continue For
Case DateResult.Exit : Return exitReturn 'Exit Sub
End Select
End If
If CheckTempPosts Then
If _TempPostsList.Contains(postID) Then Return exitReturn Else _TempPostsList.Add(postID)
'If _TempPostsList.Contains(postID) Then Return exitReturn Else _TempPostsList.Add(postID)
If _TempPostsList.Contains(postID) Then Return exitReturn Else _TmpPosts2.Add(postID)
End If
__urlBase = $"https://bsky.app/profile/{NameTrue}/post/{postID}"
If ParseUserMediaOnly And Not IsSavedPosts And Not ID.IsEmptyString And Not __userId.IsEmptyString And Not ID = __userId Then Return skipReturn
__postAuthor = e.Value({"author"}, "did")
__urlBase = $"https://bsky.app/profile/{If(IsSavedPosts, __postAuthor, NameTrue)}/post/{postID}"
End If
End With
@@ -176,7 +259,11 @@ Namespace API.Bluesky
__url = d.Value("fullsize")
If __url.IsEmptyString Then __url = d.Value({"image", "ref"}, "$link") : updateUrl = True
If __url.IsEmptyString And SecondExtraction Then updateUrl = False : __url = e.Value({"embed"}, "thumb")
If Not __url.IsEmptyString Then createMedia(__url, UTypes.Picture)
If Not __url.IsEmptyString Then
If updateUrl AndAlso Not __url.StartsWith("http") Then _
__url = $"https://cdn.bsky.app/img/feed_fullsize/plain/{__postAuthor}/{__url}@jpeg"
createMedia(__url, UTypes.Picture)
End If
Next
End With
End If
@@ -203,14 +290,33 @@ Namespace API.Bluesky
End Function
#End Region
#Region "GetProfileInfo"
Private Sub GetProfileInfo(ByVal Token As CancellationToken)
Private _CurlProfileTried As Boolean = False
Private Sub GetProfileInfo(ByVal Token As CancellationToken, Optional ByVal UseCurl As Boolean = False)
Try
If UpdateToken() Then
If ForceParseProfileInfo Then ForceParseProfileInfo = False : _ForceSaveUserInfo = True
If UseCurl OrElse UpdateToken() Then
If UseCurl Then
With Responser
.Mode = Responser.Modes.Curl
.CurlSslNoRevoke = True
.CurlInsecure = True
End With
_CurlProfileTried = True
End If
Dim r$ = Responser.GetResponse($"https://bsky.social/xrpc/app.bsky.actor.getProfile?actor={ID.IfNullOrEmpty(NameTrue)}")
TokenUpdateCountReset()
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
If UseCurl Then
If j.Value("error").StringToLower = "accountdeactivated" OrElse
(j.Value("error").StringToLower = "invalidrequest" And j.Value("message").StringToLower = "profile not found") Then
UserExists = False
Throw New ExitException(r) With {.Silent = True}
Else
Throw New Exception(r)
End If
Else
ID = j.Value("did")
UserSiteNameUpdate(j.Value("displayName"))
UserDescriptionUpdate(j.Value("description"))
@@ -218,6 +324,7 @@ Namespace API.Bluesky
SimpleDownloadAvatar(j.Value("avatar"))
SimpleDownloadAvatar(j.Value("banner"))
End If
End If
End Using
End If
Else
@@ -225,6 +332,8 @@ Namespace API.Bluesky
End If
Catch ex As Exception
ProcessException(ex, Token, "GetProfileInfo")
Finally
If UseCurl Then Responser.Mode = Responser.Modes.Default
End Try
End Sub
#End Region
@@ -311,6 +420,9 @@ Namespace API.Bluesky
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(URL, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function
Protected Overrides Function DownloadContentDefault_ConvertWebp(ByVal m As UserMedia, ByVal Process As Boolean) As SFile
Return DownloadContentDefault_ConvertWebp_TestImg(m, Process)
End Function
#End Region
#Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
@@ -329,15 +441,27 @@ Namespace API.Bluesky
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = Net.HttpStatusCode.BadRequest Then '400
If _TokenUpdateCount = 0 AndAlso UpdateToken(True) Then
If Not _CurlProfileTried Then
GetProfileInfo(Nothing, True)
Return 1
ElseIf _TokenUpdateCount = 0 AndAlso UpdateToken(True) Then
If _CurlProfileTried Then GetProfileInfo(Nothing, True) : _CurlProfileTried = False
Return 1
Else
Return 0
Return 2
End If
ElseIf Responser.StatusCode = Net.HttpStatusCode.BadGateway Or Responser.StatusCode = Net.HttpStatusCode.GatewayTimeout Then '502, 504
Return 3
Else
Return 0
End If
End Function
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then _TmpPosts2.Clear()
MyBase.Dispose(disposing)
End Sub
#End Region
End Class
End Namespace

View File

@@ -68,14 +68,7 @@ Namespace API.Facebook
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
ParseReelsBlock = .ParseReelsBlock
ParseStoriesBlock = .ParseStoriesBlock
End With
End If
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
End Sub
#End Region
#Region "Loader"
@@ -676,10 +669,7 @@ Namespace API.Facebook
End If
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
If ID.IsEmptyString Then ID = RegexReplace(r, Regex_UserID)
End If
Catch ex As Exception
ProcessException(ex, Token, "get user token",, resp)

View File

@@ -6,9 +6,10 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes
Namespace API.Facebook
Friend Class UserExchangeOptions
Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase
<PSetting(NameOf(SiteSettings.ParsePhotoBlock), NameOf(MySettings))>
Friend Property ParsePhotoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseVideoBlock), NameOf(MySettings))>
@@ -19,6 +20,7 @@ Namespace API.Facebook
Friend Property ParseStoriesBlock As Boolean = True
Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
MySettings = u.HostCollection.Default.Source
ParsePhotoBlock = u.ParsePhotoBlock
ParseVideoBlock = u.ParseVideoBlock
@@ -26,11 +28,21 @@ Namespace API.Facebook
ParseStoriesBlock = u.ParseStoriesBlock
End Sub
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
MySettings = s
ParsePhotoBlock = s.ParsePhotoBlock.Value
ParseVideoBlock = s.ParseVideoBlock.Value
ParseReelsBlock = s.ParseReelsBlock.Value
ParseStoriesBlock = s.ParseStoriesBlock.Value
End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u)
With DirectCast(u, UserData)
.ParsePhotoBlock = ParsePhotoBlock
.ParseVideoBlock = ParseVideoBlock
.ParseReelsBlock = ParseReelsBlock
.ParseStoriesBlock = ParseStoriesBlock
End With
End Sub
End Class
End Namespace

View File

@@ -1,139 +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 System.Net
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.Imgur.Declarations
Imports SCrawler.API.YouTube.Objects
Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Documents.JSON
Namespace API.Imgur
Namespace Declarations
Friend Module Imgur_Declarations
Friend ReadOnly PostRegex As RParams = RParams.DMS("/([^/]+?)(|#.*?|\.[\w]{0,4})(|\?.*?)\Z", 1)
End Module
End Namespace
Friend NotInheritable Class Envir : Inherits UserDataBase
Friend Const SiteKey As String = "AndyProgram_Imgur"
Friend Const SiteName As String = "Imgur"
Friend Sub New()
End Sub
#Region "UserDataBase Support"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
SeparateVideoFolder = False
DownloadContentDefault(Token)
End Sub
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
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
Dim videos As IEnumerable(Of UserMedia) = GetVideoInfo(Data.URL, EDP.SendToLog)
If videos.ListExists Then _TempMediaList.AddRange(videos)
End Sub
Friend Shared Function GetGallery(ByVal URL As String, Optional ByVal e As ErrorsDescriber = Nothing) As List(Of String)
Try
If Not Settings.ImgurClientID.IsEmptyString And Not URL.IsEmptyString Then
Dim __url$ = RegexReplace(URL, PostRegex)
If Not __url.IsEmptyString Then
__url = $"https://api.imgur.com/post/v1/albums/{__url}?client_id={Settings.ImgurClientID.Value}&include=media"
Using w As New WebClient
Dim r$ = w.DownloadString(__url)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Contains("media") Then
Dim UrlsList As New List(Of String)
Dim tmpUrl$
For Each m As EContainer In j("media")
tmpUrl = m.Value("url")
If Not tmpUrl.IsEmptyString Then UrlsList.ListAddValue(tmpUrl, Base.LNC)
Next
Return UrlsList
End If
End Using
End If
End Using
End If
End If
Return Nothing
Catch ex As Exception
Return DownloadingException_Internal(ex, $"[API.Imgur.Envir.GetGallery({URL})]", Nothing, e)
End Try
End Function
Friend Shared Function GetImage(ByVal URL As String, Optional ByVal e As ErrorsDescriber = Nothing) As String
Try
If Not Settings.ImgurClientID.IsEmptyString And Not URL.IsEmptyString Then
Dim __url$ = RegexReplace(URL, PostRegex)
If Not __url.IsEmptyString Then
__url = $"https://api.imgur.com/3/image/{__url}?client_id={Settings.ImgurClientID.Value}&include=media"
Using w As New WebClient
Dim r$ = w.DownloadString(__url)
If Not r.IsEmptyString Then Return JsonDocument.Parse(r).XmlIfNothing.Value({"data"}, "link")
End Using
End If
End If
Return String.Empty
Catch ex As Exception
Return DownloadingException_Internal(ex, $"[API.Imgur.Envir.GetImage({URL})]", String.Empty, e)
End Try
End Function
Friend Shared Function GetVideoInfo(ByVal URL As String, Optional ByVal e As ErrorsDescriber = Nothing) As IEnumerable(Of UserMedia)
Try
If Not URL.IsEmptyString AndAlso URL.ToLower.Contains("imgur") AndAlso Not Settings.ImgurClientID.IsEmptyString Then
Dim imgList As List(Of String) = GetGallery(URL, EDP.ReturnValue)
If imgList.ListExists Then
Return imgList.Select(Function(u) New UserMedia(u))
Else
Dim img$ = GetImage(URL, EDP.ReturnValue)
If Not img.IsEmptyString Then Return {New UserMedia(img)}
End If
End If
Return Nothing
Catch ex As Exception
If Not e.Exists Then e = EDP.LogMessageValue
Return ErrorsDescriber.Execute(e, ex, $"[API.Imgur.Envir.GetVideoInfo({URL})]: fetch media error")
End Try
End Function
Friend Shared Function GetSingleMediaInstance(ByVal URL As String, ByVal OutputFile As SFile) As IYouTubeMediaContainer
If Not URL.IsEmptyString AndAlso URL.Contains("imgur.com") Then
Return New DownloadableMediaHost(URL, OutputFile) With {
.Instance = New Envir,
.Site = SiteName,
.SiteKey = SiteKey,
.SiteIcon = Nothing
}
Else
Return Nothing
End If
End Function
Private Shared Function DownloadingException_Internal(ByVal ex As Exception, ByVal Message As String,
ByVal NullArg As Object, ByVal e As ErrorsDescriber) As Object
If TypeOf ex Is WebException Then
Dim obj As HttpWebResponse = TryCast(DirectCast(ex, WebException).Response, HttpWebResponse)
If Not obj Is Nothing Then
If obj.StatusCode = HttpStatusCode.NotFound Then
Return NullArg
ElseIf obj.StatusCode = HttpStatusCode.Unauthorized Then
MyMainLOG = "Imgur credentials expired"
Return NullArg
End If
End If
End If
If Not e.Exists Then e = New ErrorsDescriber(EDP.ReturnValue + EDP.SendToLog)
Return ErrorsDescriber.Execute(e, ex, Message, NullArg)
End Function
End Class
End Namespace

View File

@@ -20,6 +20,8 @@ Namespace API.Instagram
Friend Const PageTokenRegexPatternDefault As String = "\[\],{""token"":""(.*?)""},\d+\]"
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_BlockVersionID As RParams = RParams.DMS("""versioningID"":""([^""]+)""", 1, EDP.ReturnValue)
Friend ReadOnly Regex_ProfileID As RParams = RParams.DMS("profilePage_(\d+)", 1, EDP.ReturnValue)
Friend Sub UpdateResponser(ByVal Source As IResponse, ByRef Destination As Responser, ByVal UpdateWwwClaim As Boolean)
Const r_wwwClaimName$ = "x-ig-set-www-claim"
Const r_tokenName$ = SiteSettings.Header_CSRF_TOKEN_COOKIE

View File

@@ -36,6 +36,8 @@ Namespace API.Instagram
<PSetting(Caption:="Place the extracted image into the video folder")>
Friend Property PutImageVideoFolder As Boolean
Friend Overrides Property UserName As String
<PSetting(Address:=SettingAddress.User, Caption:="Verified profile", ToolTip:="This profile has a verified mark")>
Friend Property IsVerifiedProfile As Boolean = False
<PSetting(Address:=SettingAddress.User, Caption:="Force update UserName", ToolTip:="Try to force update UserName if it is not found on the site")>
Friend Property ForceUpdateUserName As Boolean = False
<PSetting(Address:=SettingAddress.User, Caption:="Force update user information")>
@@ -57,6 +59,8 @@ Namespace API.Instagram
PutImageVideoFolder = .PutImageVideoFolder
IsVerifiedProfile = .IsVerifiedProfile
ForceUpdateUserName = .ForceUpdateUserName
ForceUpdateUserInfo = .ForceUpdateUserInfo
End With

View File

@@ -70,7 +70,7 @@ Namespace API.Instagram
Friend Const Header_Browser As String = "Sec-Ch-Ua"
Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
Friend Const Header_Platform_Verion As String = "Sec-Ch-Ua-Platform-Version"
<PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Can be automatically extracted from cookies", IsAuth:=True, AllowNull:=True), PClonable(Clone:=False)>
<PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Can be automatically extracted from cookies", IsAuth:=True, AllowNull:=False), PClonable(Clone:=False)>
Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue
<CookieValueExtractor(NameOf(HH_CSRF_TOKEN))>
Private Function GetValueFromCookies(ByVal PropName As String, ByVal c As CookieKeeper) As String
@@ -78,7 +78,7 @@ Namespace API.Instagram
End Function
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), PClonable(Clone:=False)>
Friend ReadOnly Property HH_IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-asbd-id", IsAuth:=True, AllowNull:=True), PClonable(Clone:=False)>
<PropertyOption(ControlText:="x-asbd-id", IsAuth:=True, AllowNull:=False), PClonable(Clone:=False)>
Friend ReadOnly Property HH_ASBD_ID As PropertyValue
'PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=True)
<PClonable(Clone:=False)>
@@ -89,16 +89,16 @@ Namespace API.Instagram
Return Not v.IsEmptyString AndAlso v = "0"
End Get
End Property
<PropertyOption(ControlText:="sec-ch-ua", IsAuth:=True, AllowNull:=True,
<PropertyOption(ControlText:="sec-ch-ua", IsAuth:=True, AllowNull:=False,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", IsAuth:=True, AllowNull:=True,
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:="sec-ch-ua-full-version-list", IsAuth:=True, AllowNull:=False,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_full_version_list), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER_EXT As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", IsAuth:=True, AllowNull:=True, LeftOffset:=135,
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:="sec-ch-ua-platform-version", IsAuth:=True, AllowNull:=False, LeftOffset:=135,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_platform_version), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_PLATFORM As PropertyValue
<PropertyOption(ControlText:="UserAgent", IsAuth:=True, AllowNull:=True,
<PropertyOption(ControlText:="UserAgent", IsAuth:=True, AllowNull:=False,
InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_USER_AGENT As PropertyValue
Friend Overrides Function BaseAuthExists() As Boolean
@@ -146,8 +146,12 @@ Namespace API.Instagram
<Provider(NameOf(HH_IG_WWW_CLAIM_UPDATE_INTERVAL), FieldsChecker:=True)>
Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider
#End Region
<PropertyOption(ControlText:="Use GraphQL to download", IsAuth:=True), PXML, PClonable>
<PropertyOption(ControlText:="Use GraphQL to download", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property USE_GQL As PropertyValue
<PropertyOption(ControlText:="Use GraphQL to download user data", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property USE_GQL_UserData As PropertyValue
<PropertyOption(ControlText:="Use GraphQL to download user stories (highlights)", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property USE_GQL_Highlights As PropertyValue
#End Region
#Region "Download data"
<PropertyOption(ControlText:="Download timeline", Category:=CAT_DOWN), PXML, PClonable>
@@ -165,6 +169,14 @@ Namespace API.Instagram
<PropertyOption(ControlText:="Download tagged posts", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property DownloadTagged As PropertyValue
<PXML> Private ReadOnly Property DownloadTagged_Def As PropertyValue
<PropertyOption(ControlText:="Number of posts (verified)", ControlToolTip:="The number of posts received per request if the profile has a verified mark", Category:=CAT_DOWN), PXML, PClonable, HiddenControl>
Friend ReadOnly Property PostNumberVerified As PropertyValue
<Provider(NameOf(PostNumberVerified), FieldsChecker:=True)>
Private ReadOnly Property PostNumberVerifiedProvider As IFormatProvider
<PropertyOption(ControlText:="Number of posts (unverified)", ControlToolTip:="The number of posts received per request if the profile doesn't have a verified mark", Category:=CAT_DOWN), PXML, PClonable, HiddenControl>
Friend ReadOnly Property PostNumberVerifiedNot As PropertyValue
<Provider(NameOf(PostNumberVerifiedNot), FieldsChecker:=True)>
Private ReadOnly Property PostNumberVerifiedNotProvider As IFormatProvider
#End Region
#Region "Timers"
Friend Const TimersUrgentTip As String = vbCr & "It is highly recommended not to change the default value."
@@ -480,11 +492,13 @@ Namespace API.Instagram
HH_IG_WWW_CLAIM_UPDATE_INTERVAL = New PropertyValue(120)
HH_IG_WWW_CLAIM_ALWAYS_ZERO = New PropertyValue(False)
HH_IG_WWW_CLAIM_RESET_EACH_SESSION = New PropertyValue(True)
HH_IG_WWW_CLAIM_RESET_EACH_TARGET = New PropertyValue(True)
HH_IG_WWW_CLAIM_RESET_EACH_TARGET = New PropertyValue(False)
HH_IG_WWW_CLAIM_USE = New PropertyValue(True)
HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO = New PropertyValue(True)
TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider
USE_GQL = New PropertyValue(False)
USE_GQL = New PropertyValue(True)
USE_GQL_UserData = New PropertyValue(True)
USE_GQL_Highlights = New PropertyValue(True)
DownloadTimeline = New PropertyValue(True)
DownloadTimeline_Def = New PropertyValue(DownloadTimeline.Value, GetType(Boolean))
@@ -496,8 +510,12 @@ Namespace API.Instagram
DownloadStoriesUser_Def = New PropertyValue(DownloadStoriesUser.Value, GetType(Boolean))
DownloadTagged = New PropertyValue(False)
DownloadTagged_Def = New PropertyValue(DownloadTagged.Value, GetType(Boolean))
PostNumberVerified = New PropertyValue(50)
PostNumberVerifiedProvider = New TimersChecker(12)
PostNumberVerifiedNot = New PropertyValue(12)
PostNumberVerifiedNotProvider = New TimersChecker(12)
RequestsWaitTimer_Any = New PropertyValue(1000)
RequestsWaitTimer_Any = New PropertyValue(5000)
RequestsWaitTimer_AnyProvider = New TimersChecker(0)
RequestsWaitTimer = New PropertyValue(1000)
RequestsWaitTimerProvider = New TimersChecker(100)
@@ -526,10 +544,10 @@ Namespace API.Instagram
SkipErrors_AddToLog_Silent = New PropertyValue(String.Empty, GetType(String))
IgnoreStoriesDownloadingErrors = New PropertyValue(False)
DownDetectorValue = New PropertyValue(20)
DownDetectorValue = New PropertyValue(30)
DownDetectorValueProvider = New TimersChecker(-1)
DownDetectorValueAddToLog = New PropertyValue(False)
TaggedNotifyLimit = New PropertyValue(200)
DownDetectorValueAddToLog = New PropertyValue(True)
TaggedNotifyLimit = New PropertyValue(50)
TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
DownloadingErrorDate = New PropertyValue(Now.AddYears(-10), GetType(Date))
@@ -545,18 +563,13 @@ Namespace API.Instagram
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "instagram.com/"), 1)
ImageVideoContains = "instagram.com"
End Sub
Private Const SettingsVersionCurrent As Integer = 2
Private Const SettingsVersionCurrent As Integer = 4
Friend Overrides Sub EndInit()
Try : MyLastRequests.Add(LastDownloadDate.Value, LastRequestsCount.Value) : Catch : End Try
If Not CBool(HH_IG_WWW_CLAIM_USE.Value) Then Responser.Headers.Remove(Header_IG_WWW_CLAIM)
If CInt(SettingsVersion.Value) < SettingsVersionCurrent Then
SettingsVersion.Value = SettingsVersionCurrent
HH_IG_WWW_CLAIM_UPDATE_INTERVAL.Value = 120
HH_IG_WWW_CLAIM_ALWAYS_ZERO.Value = False
HH_IG_WWW_CLAIM_RESET_EACH_SESSION.Value = True
HH_IG_WWW_CLAIM_RESET_EACH_TARGET.Value = True
HH_IG_WWW_CLAIM_USE.Value = True
HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO.Value = True
USE_GQL.Value = True
End If
MyBase.EndInit()
End Sub

View File

@@ -6,12 +6,13 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Security.Cryptography
Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.API.Base
Namespace API.Instagram
Partial Friend Class UserData
#Region "Tokens"
@@ -26,26 +27,30 @@ Namespace API.Instagram
Token_dtsg = String.Empty
Token_lsd = String.Empty
End Sub
Protected Property BlockVersionID As String = String.Empty
#End Region
#Region "Headers"
Friend Const GQL_HEADER_FB_FRINDLY_NAME As String = "x-fb-friendly-name"
Friend Const GQL_HEADER_FB_LSD As String = "x-fb-lsd"
Friend Const GQL_HEADER_BLOCK_VERSION_ID As String = "x-bloks-version-id"
Friend Const GQL_HEADER_ROOT_FIELD_NAME As String = "x-root-field-name"
Friend Const GQL_HEADER_ROOT_FIELD_NAME_Value As String = "fetch__XDTUserDict"
#End Region
#Region "Data constants"
Private Const GQL_UserData_DocId As String = "7381344031985950"
Private Const GQL_UserData_DocId As String = "26672929172408668" '"35710877621861450" '"7381344031985950"
Private Const GQL_UserData_FbFriendlyName As String = "PolarisProfilePageContentQuery"
Private Const GQL_Highlights_DocId As String = "8298007123561120"
Private Const GQL_Highlights_DocId_Second As String = "7559771384111300"
Private Const GQL_Highlights_DocId As String = "36997000523232338" '"8298007123561120"
Private Const GQL_Highlights_DocId_Second As String = "27618287167780519" '"7559771384111300"
Private Const GQL_Highlights_FbFriendlyName As String = "PolarisProfileStoryHighlightsTrayContentQuery"
Private Const GQL_Highlights_FbFriendlyName_Second As String = "PolarisStoriesV3HighlightsPageQuery"
Private Const GQL_UserStories_DocId As String = "25231722019806941"
Private Const GQL_UserStories_DocId As String = "29170422829314651" '"25231722019806941"
Private Const GQL_UserStories_FbFriendlyName As String = "PolarisStoriesV3ReelPageStandaloneQuery"
Private Const GQL_Timeline_DocId As String = "7268577773270422"
Private Const GQL_Timeline_DocId As String = "7268577773270422" '"34579740524958711" '"7268577773270422"
Private Const GQL_Timeline_FbFriendlyName As String = "PolarisProfilePostsQuery"
Private Const GQL_Timeline_DocId_Second As String = "7286316061475375"
Private Const GQL_Timeline_DocId_Second As String = "7286316061475375" '"33944389991841132" '"7286316061475375"
Private Const GQL_Timeline_FbFriendlyName_Second As String = "PolarisProfilePostsTabContentQuery_connection"
Private Const GQL_Reels_DocId As String = "7191572580905225"
@@ -60,52 +65,80 @@ Namespace API.Instagram
Private Const GQL_URL_Q As String = "https://www.instagram.com/graphql/query"
#End Region
#Region "Download functions"
Protected Sub UpdateHeadersGQL(ByVal HeaderValue As String)
Responser.Headers.Add(GQL_HEADER_FB_FRINDLY_NAME, HeaderValue)
Responser.Headers.Add(GQL_HEADER_FB_LSD, Token_lsd)
Protected Sub UpdateHeadersGQL(ByVal HeaderValue As String, Optional ByVal Add As Boolean = True)
With Responser.Headers
If Add Then
.Add(GQL_HEADER_FB_FRINDLY_NAME, HeaderValue)
.Add(GQL_HEADER_FB_LSD, Token_lsd)
'.Add(GQL_HEADER_BLOCK_VERSION_ID, BlockVersionID)
'.Add(GQL_HEADER_ROOT_FIELD_NAME, GQL_HEADER_ROOT_FIELD_NAME_Value)
Else
.Remove(GQL_HEADER_FB_FRINDLY_NAME)
.Remove(GQL_HEADER_FB_LSD)
'.Remove(GQL_HEADER_BLOCK_VERSION_ID)
'.Remove(GQL_HEADER_ROOT_FIELD_NAME)
End If
End With
End Sub
<Obsolete("Use 'GET' function: 'GetUserData'", False)>
Private Sub GetUserDataGQL(ByVal Token As CancellationToken)
'<Obsolete("Use 'GET' function: 'GetUserData'", False)>
Private Function GetUserDataGQL(ByVal Token As CancellationToken) As String
UpdateTokens(Not ValidateBaseTokens())
'Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_UserData_DocId, Token_lsd, Token_dtsg_Var, GQL_UserData_FbFriendlyName,
' SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""id"":""{ID}"",""relay_header"":false,""render_surface"":""PROFILE""" & "}"))
Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_UserData_DocId, Token_lsd, Token_dtsg_Var, GQL_UserData_FbFriendlyName,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""id"":""{ID}"",""relay_header"":false,""render_surface"":""PROFILE""" & "}"))
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""enable_integrity_filters"":true,""id"":""{ID}"",""__relay_internal__pv__PolarisCannesGuardianExperienceEnabledrelayprovider"":true,""__relay_internal__pv__PolarisCASB976ProfileEnabledrelayprovider"":false,""__relay_internal__pv__PolarisWebSchoolsEnabledrelayprovider"":false,""__relay_internal__pv__PolarisRepostsConsumptionEnabledrelayprovider"":true" & "}"))
UpdateRequestNumber()
ChangeResponserMode(True)
UpdateHeadersGQL(GQL_UserData_FbFriendlyName)
Dim r$ = Responser.GetResponse(GQL_URL, vars)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
With j({"data", "user"})
If .ListExists Then
UserSiteName = .Value("full_name").IfNullOrEmpty(UserSiteName)
Dim f As New SFile With {.Path = DownloadContentDefault_GetRootDir(), .Name = "ProfilePicture", .Extension = "jpg"}
Dim pic$ = .Value({"hd_profile_pic_url_info"}, "url").IfNullOrEmpty(.Value("profile_pic_url"))
If Not pic.IsEmptyString Then GetWebFile(pic, f, EDP.ReturnValue)
UserDescriptionUpdate(.Value("biography"))
End If
End With
End If
End Using
End If
End Sub
Dim r$ = Responser.GetResponse(GQL_URL_Q, vars)
Return r
'If Not r.IsEmptyString Then
' Using j As EContainer = JsonDocument.Parse(r)
' If j.ListExists Then
' With j({"data", "user"})
' If .ListExists Then
' UserSiteName = .Value("full_name").IfNullOrEmpty(UserSiteName)
' IsVerifiedProfile = .Value("is_verified").FromXML(Of Boolean)(False)
' IsVerifiedProfile_Checked = True
' Dim descr$ = .Value("biography")
' If If(.Item("bio_links")?.Count, 0) > 0 Then descr.StringAppend(.Item("bio_links").Select(Function(bl) bl.Value("url")).ListToString(vbNewLine), vbNewLine)
' Dim eUrl$ = .Value("external_url")
' If Not eUrl.IsEmptyString AndAlso (descr.IsEmptyString OrElse Not descr.Contains(eUrl)) Then descr.StringAppendLine(eUrl)
' UserDescriptionUpdate(descr)
' Dim f As New SFile With {.Path = DownloadContentDefault_GetRootDir(), .Name = "ProfilePicture", .Extension = "jpg"}
' Dim pic$ = .Value({"hd_profile_pic_url_info"}, "url").IfNullOrEmpty(.Value("profile_pic_url"))
' If Not pic.IsEmptyString Then GetWebFile(pic, f, EDP.ReturnValue)
' End If
' End With
' End If
' End Using
'End If
End Function
Private Function GetTimelineGQL(ByVal Cursor As String, ByVal Token As CancellationToken) As String
Const none_cursor$ = "none"
Dim nextCursor$ = String.Empty, hasNextPage$ = String.Empty
Dim nextCursor$ = String.Empty
Dim hasNextPage As Boolean = False
Dim vars$
ThrowAny(Token)
UpdateTokens(Not ValidateBaseTokens())
UpdateRequestNumber()
ChangeResponserMode(True)
If Cursor.IsEmptyString Then
vars = "{""data"":{""count"":50,""include_relationship_info"":true,""latest_besties_reel_media"":true,""latest_reel_media"":true},""username"":""" &
vars = "{""data"":{""count"":" & PostNumberPerRequest & ",""include_relationship_info"":true,""latest_besties_reel_media"":true,""latest_reel_media"":true},""username"":""" &
NameTrue & """,""__relay_internal__pv__PolarisShareMenurelayprovider"":false}"
'vars = "{""data"":{""count"":" & PostNumberPerRequest & ",""include_reel_media_seen_timestamp"":true,""include_relationship_info"":true,""latest_besties_reel_media"":true,""latest_reel_media"":true},""username"":""" &
' NameTrue & """,""__relay_internal__pv__PolarisShareMenurelayprovider"":false}"
vars = String.Format(GQL_URL_PATTERN_VARS, GQL_Timeline_DocId, Token_lsd, Token_dtsg_Var, GQL_Timeline_FbFriendlyName,
SymbolsConverter.ASCII.EncodeSymbolsOnly(vars))
UpdateHeadersGQL(GQL_Timeline_FbFriendlyName)
Else
vars = "{""after"":""" & Cursor & """,""before"":null,""data"":{""count"":50,""include_relationship_info"":true,""latest_besties_reel_media"":true,""latest_reel_media"":true},""first"":50,""last"":null,""username"":""" &
vars = "{""after"":""" & Cursor & """,""before"":null,""data"":{""count"":" & PostNumberPerRequest & ",""include_relationship_info"":true,""latest_besties_reel_media"":true,""latest_reel_media"":true},""first"":" & PostNumberPerRequest & ",""last"":null,""username"":""" &
NameTrue & """,""__relay_internal__pv__PolarisShareMenurelayprovider"":false}"
'vars = "{""after"":""" & Cursor & """,""before"":null,""data"":{""count"":" & PostNumberPerRequest & ",""include_reel_media_seen_timestamp"":true,""include_relationship_info"":true,""latest_besties_reel_media"":true,""latest_reel_media"":true},""first"":" & PostNumberPerRequest & ",""last"":null,""username"":""" &
' NameTrue & """}"
vars = String.Format(GQL_URL_PATTERN_VARS, GQL_Timeline_DocId_Second, Token_lsd, Token_dtsg_Var, GQL_Timeline_FbFriendlyName_Second,
SymbolsConverter.ASCII.EncodeSymbolsOnly(vars))
UpdateHeadersGQL(GQL_Timeline_FbFriendlyName_Second)
@@ -139,8 +172,9 @@ Namespace API.Instagram
Return If(hasNextPage And (Not nextCursor.IsEmptyString AndAlso Not nextCursor.StringToLower = none_cursor), nextCursor, String.Empty)
End Function
Private Function GetHighlightsGQL_List() As List(Of String)
Dim nextCursor$ = String.Empty, hasNextPage$ = String.Empty
UpdateTokens(Not ValidateBaseTokens())
Dim nextCursor$ = String.Empty
Dim hasNextPage As Boolean = False
Dim i% = -1
Dim hList As New List(Of String)
Dim tmpList As New List(Of String)
@@ -174,12 +208,15 @@ Namespace API.Instagram
Return hList
End Function
Private Sub GetHighlightsGQL(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken)
Const highlightData$ = """first"":50,""initial_reel_id"":""{0}"",""last"":2,""reel_ids"":[{1}]"
Const highlightData$ = """initial_reel_id"":""{0}"",""reel_ids"":[{1}],""first"":50,""last"":2,""__relay_internal__pv__PolarisCommunityNoteStoriesLabelEnabledrelayprovider"":true"
Dim tmpList As New List(Of String)
Dim i% = -1
If StoriesList.ListExists Then
tmpList.AddRange(StoriesList.Take(10))
'TODO: 5 Instagram stories
'tmpList.AddRange(StoriesList.Take(10))
tmpList.AddRange(StoriesList.Take(5))
StoriesList.RemoveRange(0, tmpList.Count)
UpdateTokens(Not ValidateBaseTokens())
Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_Highlights_DocId_Second, Token_lsd, Token_dtsg_Var, GQL_Highlights_FbFriendlyName_Second,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(highlightData, tmpList(0), tmpList.Select(Function(hl) $"""{hl}""").ListToString(",")) & "}"))
@@ -206,9 +243,10 @@ Namespace API.Instagram
tmpList.Clear()
End Sub
Private Sub GetUserStoriesGQL(ByVal Token As CancellationToken)
UpdateTokens(Not ValidateBaseTokens())
'"{" & $"""user_id"":""{ID}""" & "}"
Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_UserStories_DocId, Token_lsd, Token_dtsg_Var, GQL_UserStories_FbFriendlyName,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""reel_ids_arr"":[""{ID}""]" & "}"))
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""reel_ids_arr"":[""{ID}""],""__relay_internal__pv__PolarisCommunityNoteStoriesLabelEnabledrelayprovider"":true" & "}"))
UpdateRequestNumber()
ChangeResponserMode(True)
UpdateHeadersGQL(GQL_UserStories_FbFriendlyName)
@@ -238,11 +276,9 @@ Namespace API.Instagram
Private Function GetReelsGQL(ByVal Cursor As String) As String
GetReelsGQL_SetEnvir = True
Dim errData$ = String.Empty
If Cursor.IsEmptyString And Not ValidateBaseTokens() Then GetPageTokens()
If Cursor.IsEmptyString And Not ValidateBaseTokens(errData) Then ValidateBaseTokens_Error(errData)
UpdateTokens(Cursor.IsEmptyString Or Not ValidateBaseTokens())
Dim vars$ = """data"":{""include_feed_video"":true,""page_size"":50,""target_user_id"":""" & ID & """}"
Dim vars$ = """data"":{""include_feed_video"":true,""page_size"":" & PostNumberPerRequest & ",""target_user_id"":""" & ID & """}"
If Not Cursor.IsEmptyString Then vars = $"""after"":""{Cursor}"",""before"":null,{vars},""first"":4,""last"":null"
vars = String.Format(GQL_URL_PATTERN_VARS, GQL_Reels_DocId, Token_lsd, Token_dtsg_Var, GQL_Reels_FbFriendlyName,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & vars & "}"))
@@ -253,15 +289,16 @@ Namespace API.Instagram
End Function
''' <summary>Response</summary>
Private Function GetTaggedGQL(ByVal Cursor As String) As String
UpdateTokens(Not ValidateBaseTokens())
'default count = 12
'max count = 21
Dim vars$
If Cursor.IsEmptyString Then
vars = String.Format(GQL_URL_PATTERN_VARS, GQL_Tagged_DocId, Token_lsd, Token_dtsg_Var, GQL_Tagged_FbFriendlyName,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""count"":50,""user_id"":""{ID}""" & "}"))
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""count"":{PostNumberPerRequest},""user_id"":""{ID}""" & "}"))
Else
vars = String.Format(GQL_URL_PATTERN_VARS, GQL_Tagged_DocId, Token_lsd, Token_dtsg_Var, GQL_Tagged_FbFriendlyName,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""after"":""{Cursor}"",""before"":null,""count"":50,""first"":50,""last"":null,""user_id"":""{ID}""" & "}"))
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & $"""after"":""{Cursor}"",""before"":null,""count"":{PostNumberPerRequest},""first"":{PostNumberPerRequest},""last"":null,""user_id"":""{ID}""" & "}"))
End If
UpdateRequestNumber()
ChangeResponserMode(True)
@@ -270,6 +307,13 @@ Namespace API.Instagram
End Function
#End Region
#Region "ValidateBaseTokens"
Private Sub UpdateTokens(ByVal process As Boolean)
If process Then
Dim TokensErrData$ = String.Empty
If Not ValidateBaseTokens() Then GetPageTokens()
If Not ValidateBaseTokens(TokensErrData) Then ValidateBaseTokens_Error(TokensErrData)
End If
End Sub
Protected Overridable Overloads Function ValidateBaseTokens() As Boolean
Return ValidateBaseTokens(Nothing)
End Function
@@ -296,7 +340,12 @@ Namespace API.Instagram
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "navigate"))
End With
End With
Dim r$ = Responser.GetResponse(MySiteSettings.GetUserUrl(Me))
Dim r$
If UserNameRequested Then
r = Responser.GetResponse("https://www.instagram.com/")
Else
r = Responser.GetResponse(MySiteSettings.GetUserUrl(Me))
End If
ParseTokens(r, 0)
Catch ex As Exception
Finally
@@ -307,6 +356,10 @@ Namespace API.Instagram
Try
If Not r.IsEmptyString Then
ResetBaseTokens()
If ID.IsEmptyString Then
Dim __id$ = RegexReplace(r, Regex_ProfileID)
If CLng(AConvert(Of Long)(__id, 0, EDP.ReturnValue)) <> 0 Then ID = __id
End If
Select Case Attempt
Case 0
Dim rr As RParams = RParams.DM(PageTokenRegexPatternDefault, 0, RegexReturn.List, EDP.ReturnValue)
@@ -318,6 +371,7 @@ Namespace API.Instagram
.MatchSub = 1
.WhatGet = RegexReturn.Value
End With
BlockVersionID = RegexReplace(r, Regex_BlockVersionID)
For Each tt In tokens
If Not Token_lsd.IsEmptyString And Not Token_dtsg.IsEmptyString Then
Exit For
@@ -336,6 +390,7 @@ Namespace API.Instagram
Case 1
Token_dtsg = RegexReplace(r, Regex_UserToken_dtsg)
Token_lsd = RegexReplace(r, Regex_UserToken_lsd)
BlockVersionID = RegexReplace(r, Regex_BlockVersionID)
End Select
If Not ValidateBaseTokens() And Attempt = 0 Then ParseTokens(r, Attempt + 1)
End If

View File

@@ -39,6 +39,8 @@ Namespace API.Instagram
Private Const Name_TaggedChecked As String = "TaggedChecked"
Private Const Name_ForceUpdateUserName As String = "ForceUpdateUserName"
Private Const Name_ForceUpdateUserInfo As String = "ForceUpdateUserInfo"
Private Const Name_IsVerifiedProfile As String = "IsVerifiedProfile"
Private Const Name_IsVerifiedProfile_Checked As String = "IsVerifiedProfile_Checked"
#End Region
#Region "Declarations"
Friend Structure PostKV : Implements IEContainerProvider
@@ -115,6 +117,13 @@ Namespace API.Instagram
Private UserNameRequested As Boolean = False
Friend Property ForceUpdateUserName As Boolean = False
Friend Property ForceUpdateUserInfo As Boolean = False
Friend Property IsVerifiedProfile As Boolean = False
Friend Property IsVerifiedProfile_Checked As Boolean = False
Private ReadOnly Property PostNumberPerRequest As Integer
Get
With MySiteSettings : Return If(IsVerifiedProfile, .PostNumberVerified, .PostNumberVerifiedNot).Value : End With
End Get
End Property
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
@@ -136,6 +145,8 @@ Namespace API.Instagram
TaggedChecked = .Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
ForceUpdateUserName = .Value(Name_ForceUpdateUserName).FromXML(Of Boolean)(False)
ForceUpdateUserInfo = .Value(Name_ForceUpdateUserInfo).FromXML(Of Boolean)(False)
IsVerifiedProfile = .Value(Name_IsVerifiedProfile).FromXML(Of Boolean)(False)
IsVerifiedProfile_Checked = .Value(Name_IsVerifiedProfile_Checked).FromXML(Of Boolean)(False)
Else
.Add(Name_LastCursor, LastCursor)
.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
@@ -153,6 +164,8 @@ Namespace API.Instagram
.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
.Add(Name_ForceUpdateUserName, ForceUpdateUserName.BoolToInteger)
.Add(Name_ForceUpdateUserInfo, ForceUpdateUserInfo.BoolToInteger)
.Add(Name_IsVerifiedProfile, IsVerifiedProfile.BoolToInteger)
.Add(Name_IsVerifiedProfile_Checked, IsVerifiedProfile_Checked.BoolToInteger)
End If
End With
End Sub
@@ -164,7 +177,7 @@ Namespace API.Instagram
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions)
.ApplyBase(Me)
.Apply(Me)
GetTimeline = .GetTimeline
GetReels = .GetReels
GetStories = .GetStories
@@ -179,6 +192,9 @@ Namespace API.Instagram
PutImageVideoFolder = .PutImageVideoFolder
IsVerifiedProfile = .IsVerifiedProfile
If IsVerifiedProfile Then IsVerifiedProfile_Checked = True
ForceUpdateUserName = .ForceUpdateUserName
ForceUpdateUserInfo = .ForceUpdateUserInfo
End With
@@ -317,6 +333,7 @@ Namespace API.Instagram
Private _LastWwwClaim As String = String.Empty
Private _ResponserGQLMode As Boolean = False
Private _UseGQL As Boolean = False
Private Const ImgHeic$ = "heic"
Private Sub ChangeResponserMode(ByVal GQL As Boolean, Optional ByVal Force As Boolean = False)
If Not _ResponserGQLMode = GQL Or Force Then
_ResponserGQLMode = GQL
@@ -346,8 +363,7 @@ Namespace API.Instagram
With .Headers
.Remove("origin")
.Remove("authority")
.Remove(GQL_HEADER_FB_FRINDLY_NAME)
.Remove(GQL_HEADER_FB_LSD)
UpdateHeadersGQL(String.Empty, False)
Dim hv$ = MySiteSettings.Responser.Headers.Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest)).IfNullOrEmpty("empty")
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest, hv))
hv = MySiteSettings.Responser.Headers.Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode)).IfNullOrEmpty("cors")
@@ -412,6 +428,7 @@ Namespace API.Instagram
ThrowAny(Token)
HasError = False
Dim dt As Func(Of Boolean) = Function() (CBool(MySiteSettings.DownloadTimeline.Value) And GetTimeline) Or IsSavedPosts
If FirstLoadingDone Then LastCursor = String.Empty
If dt.Invoke And Not LastCursor.IsEmptyString Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
upClaimRequest.Invoke
@@ -490,26 +507,26 @@ Namespace API.Instagram
If Not errorFound Then LoadSavePostsKV(False)
End Try
End Sub
'TODELETE: ValidateExtension
Protected Sub ValidateExtension()
Dim tmpList As List(Of UserMedia) = Nothing
Try
Const heic$ = "heic"
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = heic) Then
Dim m As UserMedia
tmpList = New List(Of UserMedia)
tmpList.ListAddList(_TempMediaList)
_TempMediaList.Clear()
For i% = 0 To tmpList.Count - 1
m = tmpList(i)
_TempMediaList.Add(m)
If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = heic Then _
m.File.Extension = "jpg" : _TempMediaList.Add(m)
Next
tmpList.Clear()
End If
Catch ex As Exception
If tmpList.ListExists Then _TempMediaList.Clear() : _TempMediaList.ListAddList(tmpList) : tmpList.Clear()
End Try
'Dim tmpList As List(Of UserMedia) = Nothing
'Try
' If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = ImgHeic) Then
' Dim m As UserMedia
' tmpList = New List(Of UserMedia)
' tmpList.ListAddList(_TempMediaList)
' _TempMediaList.Clear()
' For i% = 0 To tmpList.Count - 1
' m = tmpList(i)
' _TempMediaList.Add(m)
' If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = ImgHeic Then _
' m.File.Extension = "jpg" : _TempMediaList.Add(m)
' Next
' tmpList.Clear()
' End If
'Catch ex As Exception
' If tmpList.ListExists Then _TempMediaList.Clear() : _TempMediaList.ListAddList(tmpList) : tmpList.Clear()
'End Try
End Sub
Protected Overridable Sub UpdateResponser()
Try
@@ -524,7 +541,7 @@ Namespace API.Instagram
Protected Overrides Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
Declarations.UpdateResponser(e, Responser, WwwClaimUpdate)
End Sub
Friend Enum Sections : Timeline : Reels : Tagged : Stories : UserStories : SavedPosts : End Enum
Friend Enum Sections : Timeline : Reels : Tagged : Stories : UserStories : SavedPosts : Reposts : Likes : End Enum
Protected Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass"
@@ -662,6 +679,7 @@ Namespace API.Instagram
Dim StoriesList As List(Of String) = Nothing
Dim StoriesRequested As Boolean = False
Dim dValue% = 1
Dim __idIsEmpty As Boolean = ID.IsEmptyString
LastCursor = Cursor
Try
Do While dValue = 1
@@ -675,7 +693,6 @@ Namespace API.Instagram
Dim HasNextPage As Boolean = False
Dim EndCursor$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty
Dim TokensErrData$ = String.Empty
Dim PostIDKV As PostKV
Dim ENode() As Object = Nothing
Dim processGetResponse As Boolean = True
@@ -683,14 +700,11 @@ Namespace API.Instagram
'Check environment
If Not IsSavedPosts Then
If ID.IsEmptyString Then GetUserData()
If ID.IsEmptyString Then UserExists = False : _ForceSaveUserInfoOnException = True : Throw New Plugin.ExitException("can't get user ID")
If _UseGQL And Cursor.IsEmptyString And Not Section = Sections.SavedPosts Then
If Not ValidateBaseTokens() Then GetPageTokens()
If Not ValidateBaseTokens(TokensErrData) Then ValidateBaseTokens_Error(TokensErrData)
End If
If ForceUpdateUserName Then GetUserNameById()
If ForceUpdateUserInfo Then GetUserData()
If _UseGQL And Cursor.IsEmptyString And Not Section = Sections.SavedPosts Then UpdateTokens(True)
If ID.IsEmptyString Or __idIsEmpty Or Not IsVerifiedProfile_Checked Then GetUserData(Token)
If ID.IsEmptyString Then UserExists = False : _ForceSaveUserInfo = True : Throw New Plugin.ExitException("can't get user ID")
If ForceUpdateUserName Then GetUserNameById(Token)
If ForceUpdateUserInfo Then GetUserData(Token)
End If
'Create query
@@ -702,7 +716,7 @@ Namespace API.Instagram
MySiteSettings.TooManyRequests(False)
GoTo NextPageBlock
Else
URL = $"https://www.instagram.com/api/v1/feed/user/{NameTrue}/username/?count=50" &
URL = $"https://www.instagram.com/api/v1/feed/user/{NameTrue}/username/?count={PostNumberPerRequest}" &
If(Cursor.IsEmptyString, String.Empty, $"&max_id={Cursor}")
ENode = Nothing
End If
@@ -713,7 +727,7 @@ Namespace API.Instagram
processGetResponse = False
Case Sections.SavedPosts
ChangeResponserMode(False)
EndCursor = SavedPostsDownload(String.Empty, Token)
EndCursor = DownloadSavedPosts(Cursor, Token)
HasNextPage = Not EndCursor.IsEmptyString
MySiteSettings.TooManyRequests(False)
ThrowAny(Token)
@@ -725,7 +739,7 @@ Namespace API.Instagram
ENode = {"data", "xdt_api__v1__usertags__user_id__feed_connection"}
processGetResponse = False
Else
Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}"
Dim vars$ = "{""id"":" & ID & $",""first"":{PostNumberPerRequest},""after"":""" & Cursor & """}"
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)
URL = $"https://www.instagram.com/graphql/query/?doc_id=17946422347485809&variables={vars}"
ENode = {"data", "user", "edge_user_to_photos_of_you"}
@@ -951,7 +965,7 @@ NextPageBlock:
End Try
End Sub
''' <summary>Cursor</summary>
Private Function SavedPostsDownload(ByVal Cursor As String, ByVal Token As CancellationToken) As String
Private Function DownloadSavedPosts(ByVal Cursor As String, ByVal Token As CancellationToken) As String
Dim URL$ = $"https://www.instagram.com/api/v1/feed/saved/posts/?max_id={Cursor}"
Dim HasNextPage As Boolean = False
Dim NextCursor$ = String.Empty
@@ -1151,12 +1165,30 @@ NextPageBlock:
If TryExtractImage Then
t = 1
abstractDecision = True
If Not SpecialFolder.IsEmptyString AndAlso PutImageVideoFolder Then
Dim endsAbs As Boolean = SpecialFolder.EndsWith("*")
If endsAbs Then SpecialFolder = SpecialFolder.TrimEnd("*")
If Not SpecialFolder.IsEmptyString Then SpecialFolder = $"{SpecialFolder.TrimEnd("\")}\{VideoFolderName}{IIf(Not endsAbs, "*", String.Empty)}"
If endsAbs Then SpecialFolder &= "*"
Dim endsAbs As Boolean
Dim newFolderName$
If PutImageVideoFolder Then
If SpecialFolder.IsEmptyString Then
newFolderName = $"{VideoFolderName}\*"
Else
endsAbs = SpecialFolder.EndsWith("*")
SpecialFolder = SpecialFolder.TrimEnd({CChar("\"), CChar("*")})
If Not endsAbs Then SpecialFolder = $"{SpecialFolder}\{VideoFolderName}"
newFolderName = $"{SpecialFolder}*"
End If
'Dim endsAbs As Boolean = SpecialFolder.EndsWith("*")
'If endsAbs Then SpecialFolder = SpecialFolder.TrimEnd("*")
'If Not SpecialFolder.IsEmptyString Then SpecialFolder = $"{SpecialFolder.TrimEnd("\")}\{VideoFolderName}{IIf(Not endsAbs, "*", String.Empty)}"
'If endsAbs Then SpecialFolder &= "*"
ElseIf Not SpecialFolder.IsEmptyString Then
endsAbs = SpecialFolder.EndsWith("*")
SpecialFolder = SpecialFolder.TrimEnd({CChar("\"), CChar("*")})
If endsAbs Then SpecialFolder = $"{SpecialFolder}\Photos"
newFolderName = $"{SpecialFolder}*"
Else
newFolderName = SpecialFolder
End If
SpecialFolder = newFolderName
ElseIf t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then
If n.Contains(vid) Then
t = 2
@@ -1222,26 +1254,38 @@ NextPageBlock:
End Sub
#End Region
#Region "GetUserId, GetUserName"
Private Sub GetUserData()
Private Sub GetUserData(ByVal Token As CancellationToken)
Dim __idFound As Boolean = False
If ForceUpdateUserInfo Then ForceUpdateUserInfo = False : _ForceSaveUserInfo = True
Try
Dim r$
Dim ____dataGql As Boolean = _UseGQL Or CBool(MySiteSettings.USE_GQL_UserData.Value)
If ____dataGql Then
UpdateTokens(True)
r = GetUserDataGQL(Token)
If Not _UseGQL Then ChangeResponserMode(_UseGQL)
Else
ChangeResponserMode(False)
UpdateRequestNumber()
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/users/web_profile_info/?username={NameTrue}")
r = Responser.GetResponse($"https://i.instagram.com/api/v1/users/web_profile_info/?username={NameTrue}")
End If
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing AndAlso j.Contains({"data", "user"}) Then
With j({"data", "user"})
ID = .Value("id")
_ForceSaveUserData = True
If Not ____dataGql Or ID.IsEmptyString Then ID = .Value("id")
__idFound = True
If Not .Value("username").IsEmptyString Then NameTrue = .Value("username")
UserSiteNameUpdate(.Value("full_name"))
IsVerifiedProfile = .Value("is_verified").FromXML(Of Boolean)(False)
IsVerifiedProfile_Checked = True
Dim descr$ = .Value("biography")
If If(.Item("bio_links")?.Count, 0) > 0 Then descr.StringAppend(.Item("bio_links").Select(Function(bl) bl.Value("url")).ListToString(vbNewLine), vbNewLine)
Dim eUrl$ = .Value("external_url")
If Not eUrl.IsEmptyString AndAlso (descr.IsEmptyString OrElse Not descr.Contains(eUrl)) Then descr.StringAppendLine(eUrl)
UserDescriptionUpdate(descr)
Dim f As New SFile With {.Path = DownloadContentDefault_GetRootDir(), .Name = "ProfilePicture", .Extension = "jpg"}
f = SFile.IndexReindex(f)
If Not f.Exists Then
@@ -1265,9 +1309,17 @@ NextPageBlock:
ChangeResponserMode(_UseGQL)
End Try
End Sub
Private Function GetUserNameById() As Boolean
Private Function GetUserNameById(ByVal Token As CancellationToken) As Boolean
UserNameRequested = True
If ForceUpdateUserName Then ForceUpdateUserName = False : _ForceSaveUserInfo = True
If Not ID.IsEmptyString Then
Dim currentName$ = NameTrue
GetUserData(Token)
If Not currentName = NameTrue Then UserNameRequested = False : Return True
End If
Return False
Try
If Not ID.IsEmptyString Then
UpdateRequestNumber()
@@ -1301,6 +1353,7 @@ NextPageBlock:
#Region "Pinned stories"
Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal GetUserStory As Boolean, ByVal Token As CancellationToken)
Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}"
Const hPattern$ = "highlight:"
Dim tmpList As IEnumerable(Of String) = Nothing
Dim qStr$, r$
Dim i% = -1
@@ -1313,7 +1366,7 @@ NextPageBlock:
If GetUserStory Then
qStr = $"https://www.instagram.com/api/v1/feed/reels_media/?reel_ids={ID}"
Else
qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids=highlight:{q}").ListToString("&"))
qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids={hPattern}{q.Replace(hPattern, String.Empty)}").ListToString("&"))
End If
UpdateRequestNumber()
r = Responser.GetResponse(qStr,, EDP.ThrowException)
@@ -1362,6 +1415,11 @@ NextPageBlock:
End If
End Sub
Private Function GetStoriesList() As List(Of String)
If CBool(MySiteSettings.USE_GQL_Highlights.Value) Then
Dim hList As List(Of String) = GetHighlightsGQL_List()
If Not _UseGQL Then ChangeResponserMode(_UseGQL)
Return hList
Else
UpdateRequestNumber()
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/highlights/{ID}/highlights_tray/",, EDP.ThrowException)
If Not r.IsEmptyString Then
@@ -1371,12 +1429,20 @@ NextPageBlock:
End Using
End If
Return Nothing
End If
End Function
#End Region
#Region "Download content"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
Protected Overrides Function DownloadContentDefault_ConvertWebp(ByVal m As UserMedia, ByVal Process As Boolean) As SFile
If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = ImgHeic Then
Return DownloadContentDefault_ConvertWebp_Impl(m, True, True)
Else
Return MyBase.DownloadContentDefault_ConvertWebp(m, Process)
End If
End Function
#End Region
#Region "Erase"
Protected Overrides Sub EraseData_AdditionalDataFiles()
@@ -1399,7 +1465,7 @@ NextPageBlock:
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal s As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then '404
If Not UserNameRequested AndAlso GetUserNameById() Then Return 1 Else UserExists = False
If Not UserNameRequested AndAlso GetUserNameById(New CancellationToken) Then Return 1 Else UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Or Responser.StatusCode = HttpStatusCode.Unauthorized Then '400, 401
HasError = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
@@ -1416,7 +1482,7 @@ NextPageBlock:
MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1
ElseIf Responser.StatusCode = 560 Or Responser.StatusCode = HttpStatusCode.InternalServerError Then '560, 500
If Responser.StatusCode = 560 And s = Sections.Stories And MySiteSettings.IgnoreStoriesDownloadingErrors Then
If Responser.StatusCode = 560 And s = Sections.Stories And MySiteSettings.IgnoreStoriesDownloadingErrors.Value Then
MyMainLOG = $"{ToStringForLog()}: Stories downloading skipped (560)"
Return ErrHandlingValueStories
Else

View File

@@ -1,48 +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.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Namespace API.Mastodon
Friend Structure Credentials : Implements IEContainerProvider
Private Const Name_Bearer As String = "Bearer"
Private Const Name_Csrf As String = "Csrf"
Friend Domain As String
Friend Bearer As String
Friend Csrf As String
Friend ReadOnly Property Exists As Boolean
Get
Return Not Domain.IsEmptyString And Not Bearer.IsEmptyString And Not Csrf.IsEmptyString
End Get
End Property
Private Sub New(ByVal e As EContainer)
Domain = e.Value
Bearer = e.Attribute(Name_Bearer)
Csrf = e.Attribute(Name_Csrf)
End Sub
Public Shared Widening Operator CType(ByVal e As EContainer) As Credentials
Return New Credentials(e)
End Operator
Public Shared Widening Operator CType(ByVal Domain As String) As Credentials
Return New Credentials With {.Domain = Domain}
End Operator
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return New EContainer("Item", Domain, {New EAttribute(Name_Bearer, Bearer), New EAttribute(Name_Csrf, Csrf)})
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not IsNothing(Obj) Then
If TypeOf Obj Is Credentials Then
Return Domain = DirectCast(Obj, Credentials).Domain
Else
Return Domain = CStr(Obj)
End If
End If
Return False
End Function
End Structure
End Namespace

View File

@@ -1,14 +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
Friend Module Declarations
Friend Const MastodonSiteKey As String = "AndyProgram_Mastodon"
Friend ReadOnly DateProvider As New ADateTime("O")
End Module
End Namespace

View File

@@ -1,27 +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.Attributes
Namespace API.Mastodon
Friend Class EditorExchangeOptions : Inherits Twitter.EditorExchangeOptions
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property MediaModelAllowNonUserTweets As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelMedia As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelProfile As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelSearch As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelForceApply As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelLikes As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadBroadcasts As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property UserName As String
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
End Sub
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
End Sub
End Class
End Namespace

View File

@@ -1,253 +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.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Mastodon
<Manifest(MastodonSiteKey), SavedPosts, SpecialForm(True), SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
#Region "Domains"
<PXML("Domains"), PClonable> Private ReadOnly Property SiteDomains As PropertyValue
Private Shadows ReadOnly Property DefaultInstance As SiteSettings
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
#Region "Auth"
<PropertyOption(IsAuth:=True, AllowNull:=False, ControlText:="My domain",
ControlToolTip:="Your account domain without 'https://' (for example, 'mastodon.social')"), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property MyDomain As PropertyValue
<PropertyOption(AllowNull:=False, IsAuth:=True, ControlText:="Authorization",
ControlToolTip:="Set authorization from [authorization] response header. This field must start from [Bearer] key word"), PClonable(Clone:=False)>
Friend ReadOnly Property Auth As PropertyValue
<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
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then
Dim f$ = String.Empty
Select Case PropName
Case NameOf(Auth) : f = DN.Header_Authorization
Case NameOf(Token) : f = DN.Header_CSRFToken
End Select
If Not f.IsEmptyString Then
Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
Responser.SaveSettings()
End If
End If
End Sub
#End Region
#Region "Other properties"
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsDownloadCaption, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsDownload As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsSpecialFolder As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsPrefix As PropertyValue
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
Private ReadOnly Property GifStringChecker As IFormatProvider
<PropertyOption(IsAuth:=False, ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property UseMD5Comparison As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:="User related to my domain",
ControlToolTip:="Open user profiles and user posts through my domain."), PXML, PClonable>
Friend ReadOnly Property UserRelatedToMyDomain As PropertyValue
<DoNotUse> Friend Overrides Property DownloadText As PropertyValue
<DoNotUse> Friend Overrides Property DownloadTextPosts As PropertyValue
<DoNotUse> Friend Overrides Property DownloadTextSpecialFolder As PropertyValue
#End Region
#End Region
#Region "Initializer"
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("Mastodon", "mastodon.social", AccName, Temp, My.Resources.SiteResources.MastodonIcon_48, My.Resources.SiteResources.MastodonPic_48)
_Domains = New DomainsContainer(Me, "mastodon.social")
SiteDomains = New PropertyValue(Domains.DomainsDefault, GetType(String))
Domains.DestinationProp = SiteDomains
Base_DomainsLastUpdateDate = New PropertyValue(Now.AddYears(-1))
Auth = New PropertyValue(Responser.Headers.Value(DN.Header_Authorization), GetType(String), Sub(v) ChangeResponserFields(NameOf(Auth), v))
Token = New PropertyValue(Responser.Headers.Value(DN.Header_CSRFToken), GetType(String), Sub(v) ChangeResponserFields(NameOf(Token), v))
GifsDownload = New PropertyValue(True)
GifsSpecialFolder = New PropertyValue(String.Empty, GetType(String))
GifsPrefix = New PropertyValue("GIF_")
GifStringChecker = New API.Twitter.SiteSettings.GifStringProvider
UseMD5Comparison = New PropertyValue(False)
MyDomain = New PropertyValue(String.Empty, GetType(String))
UserRelatedToMyDomain = New PropertyValue(False)
UserRegex = RParams.DMS("", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
End Sub
Friend Overrides Sub EndInit()
Domains.PopulateInitialDomains(SiteDomains.Value)
If CDate(DomainsLastUpdateDate.Value).AddDays(7) < Now Then UpdateServersList()
MyBase.EndInit()
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 "Domains Support"
Protected Overrides Sub DomainsApply()
Domains.Apply()
MyBase.DomainsApply()
End Sub
Protected Overrides Sub DomainsReset()
Domains.Reset()
MyBase.DomainsReset()
End Sub
Friend Overrides Sub OpenSettingsForm()
Domains.OpenSettingsForm()
End Sub
#End Region
#Region "Update"
Friend Overrides Sub Update()
If _SiteEditorFormOpened Then
Dim tf$ = GifsSpecialFolder.Value
If Not tf.IsEmptyString Then tf = tf.StringTrim("\") : GifsSpecialFolder.Value = tf
Dim md$ = AConvert(Of String)(MyDomain.Value, String.Empty)
If Not md.IsEmptyString AndAlso Not Domains.Domains.Contains(md) AndAlso Not Domains.DomainsTemp.Contains(md) Then
If Domains.Changed Then
Domains.DomainsTemp.Add(md)
Else
Domains.Domains.Add(md)
Domains.Save()
End If
End If
End If
MyBase.Update()
End Sub
#End Region
#Region "UserOptions"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse (Not TypeOf Options Is EditorExchangeOptions OrElse
Not DirectCast(Options, EditorExchangeOptions).SiteKey = MastodonSiteKey) Then _
Options = New EditorExchangeOptions(Me) With {.SiteKey = MastodonSiteKey}
If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
End Sub
#End Region
#Region "Download"
Friend Overrides Function BaseAuthExists() As Boolean
Return ACheck(Token.Value) And ACheck(Auth.Value) And ACheck(MyDomain.Value)
End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
If What = ISiteSettings.Download.SavedPosts Or What = ISiteSettings.Download.SingleObject Then
If Not ACheck(MyDomain.Value) Then MyMainLOG = "Mastodon account domain not set" : Return False
Else
If CDate(DomainsLastUpdateDate.Value).AddDays(7) < Now Then UpdateServersList()
End If
Return MyBase.Available(What, Silent)
End Function
#End Region
#Region "GetUserUrl, GetUserPostUrl"
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
If Not ACheck(MyDomain.Value) Then Return String.Empty
With DirectCast(User, UserData)
If UserRelatedToMyDomain.Value Then
If MyDomain.Value = .UserDomain Then
Return $"https://{ .UserDomain}/@{ .NameTrue}"
Else
Return $"https://{MyDomain.Value}/@{ .NameTrue}@{ .UserDomain}"
End If
Else
Return $"https://{ .UserDomain}/@{ .NameTrue}"
End If
End With
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
If Not ACheck(MyDomain.Value) Then Return String.Empty
Return $"{GetUserUrl(User)}/{Media.Post.ID}"
End Function
#End Region
#Region "IsMyUser, IsMyImageVideo"
Private Const UserRegexDefault As String = "https?://{0}/@([^/@]+)@?([^/]*)"
Friend Overloads Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
If Domains.Count > 0 Then
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
e = IsMyUser(UserURL, domain)
If Not e.SiteName.IsEmptyString Then Return e
Next
End If
Return Nothing
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
If Not URL.IsEmptyString And Domains.Count > 0 Then
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
Return Nothing
End Function
#End Region
#Region "UpdateServersList"
Private Sub UpdateServersList()
Try
Using resp As New Responser With {
.ProcessExceptionDecision = Function(rr, obj, e) If(rr.StatusCode = Net.HttpStatusCode.ServiceUnavailable,
EDP.ReturnValue, EDP.ThrowException)}
Dim r$ = resp.GetResponse("https://api.joinmastodon.org/servers?language=&category=&region=&ownership=&registrations=")
If Not r.IsEmptyString Then
Dim j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If If(j?.Count, 0) > 0 Then
Domains.Domains.ListAddList(j.Select(Function(e) e.Value("domain")), LAP.NotContainsOnly, EDP.ReturnValue)
Domains.Domains.Sort()
Domains.Save()
j.Dispose()
End If
DomainsLastUpdateDate.Value = Now
End If
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.Mastodon.SiteSettings.UpdateServersList]")
End Try
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 Class
End Namespace

View File

@@ -1,319 +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 System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Mastodon
Friend Class UserData : Inherits Twitter.UserData
#Region "XML names"
Private Const Name_UserDomain As String = "UserDomain"
#End Region
#Region "Declarations"
Private _UserDomain As String = String.Empty
Friend Property UserDomain As String
Get
Return _UserDomain.IfNullOrEmpty(MySettings.MyDomain.Value)
End Get
Set(ByVal d As String)
_UserDomain = d
End Set
End Property
Private ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
End Get
End Property
Private MyCredentials As Credentials
Private Sub ResetCredentials()
MyCredentials = New Credentials With {.Domain = MySettings.MyDomain.Value, .Bearer = MySettings.Auth.Value, .Csrf = MySettings.Token.Value}
With MyCredentials
Responser.Headers.Add(DeclaredNames.Header_Authorization, .Bearer)
Responser.Headers.Add(DeclaredNames.Header_CSRFToken, .Csrf)
End With
End Sub
#End Region
#Region "LoadUserInformation"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
MyBase.LoadUserInformation_OptionalFields(Container, Loading)
Dim obtainNames As Action = Sub()
If _UserDomain.IsEmptyString And Not Name.IsEmptyString Then
Dim l$() = Name.Split("@")
If l.ListExists(2) Then
_UserDomain = l(0)
NameTrue = l(1)
Else
_UserDomain = MySettings.MyDomain.Value
NameTrue = Name
End If
If FriendlyName.IsEmptyString Then FriendlyName = NameTrue
End If
End Sub
If Loading Then
_UserDomain = Container.Value(Name_UserDomain)
obtainNames.Invoke
Else
obtainNames.Invoke
Container.Add(Name_UserDomain, _UserDomain)
Container.Add(Name_TrueName, NameTrue(True))
Container.Value(Name_FriendlyName) = FriendlyName
End If
End Sub
#End Region
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
ResetCredentials()
DownloadData(String.Empty, Token)
End Sub
Private Overloads Sub DownloadData(ByVal POST As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
Dim PostID$ = String.Empty
Dim PostDate$
Dim s As EContainer, ss As EContainer
Dim NewPostDetected As Boolean = False
Dim ExistsDetected As Boolean = False
If IsSavedPosts Then
URL = $"https://{MySettings.MyDomain.Value}/api/v1/bookmarks"
If Not POST.IsEmptyString Then URL &= $"?max_id={POST}"
Else
If POST.IsEmptyString And ID.IsEmptyString Then
ObtainUserID()
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "Unable to get user ID") With {.HelpLink = 1}
End If
URL = $"https://{MyCredentials.Domain}/api/v1/accounts/{ID}/statuses?"
If ParseUserMediaOnly Then URL &= "only_media=true&"
URL &= "limit=40"
If Not POST.IsEmptyString Then URL &= $"&max_id={POST}"
End If
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If If(j?.Count, 0) > 0 Then
ProgressPre.ChangeMax(j.Count)
For Each jj As EContainer In j
ProgressPre.Perform()
With jj
If Not IsSavedPosts And POST.IsEmptyString And Not .Item("account") Is Nothing Then
With .Item("account")
If .Value("id") = ID Then
UserSiteNameUpdate(.Value("display_name"))
UserDescriptionUpdate(.Value("note"))
Dim __getImage As Action(Of String) = Sub(ByVal img As String)
If Not img.IsEmptyString Then
Dim __imgFile As SFile = img
If Not __imgFile.Name.IsEmptyString Then
If __imgFile.Extension.IsEmptyString Then __imgFile.Extension = "jpg"
__imgFile.Path = MyFile.CutPath.Path
If Not __imgFile.Exists Then GetWebFile(img, __imgFile, EDP.None)
If __imgFile.Exists Then IconBannerDownloaded = True
End If
End If
End Sub
If DownloadIconBanner Then
__getImage.Invoke(.Value("header").IfNullOrEmpty(.Value("header_static")))
__getImage.Invoke(.Value("avatar").IfNullOrEmpty(.Value("avatar_static")))
End If
End If
End With
End If
PostID = .Value("id")
PostDate = .Value("created_at")
If Not IsSavedPosts And Not PostDate.IsEmptyString Then
Select Case CheckDatesLimit(PostDate, DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
End If
If Not _TempPostsList.Contains(PostID) Then
NewPostDetected = True
_TempPostsList.Add(PostID)
Else
ExistsDetected = True
Continue For
End If
If IsSavedPosts OrElse (Not ParseUserMediaOnly OrElse
(If(.Item("reblog")?.Count, 0) = 0 OrElse .Value({"reblog", "account"}, "id") = ID)) Then
If If(.Item("media_attachments")?.Count, 0) > 0 Then
s = .Item("media_attachments")
Else
s = .Item({"reblog"}, "media_attachments")
End If
If s.ListExists Then
For Each ss In s : ObtainMedia(ss, PostID, PostDate) : Next
End If
End If
End With
Next
End If
End Using
End If
If POST.IsEmptyString And ExistsDetected Then Exit Sub
If Not PostID.IsEmptyString And NewPostDetected Then DownloadData(PostID, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error{IIf(IsSavedPosts, " (Saved Posts)", String.Empty)} [{URL}]")
End Try
End Sub
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal BaseUrl As String = Nothing,
Optional ByVal SourceMedia As UserMedia = Nothing)
Dim t As UTypes = UTypes.Undefined
Select Case e.Value("type")
Case "video" : t = UTypes.Video
Case "image" : t = UTypes.Picture
Case "gifv" : t = UTypes.GIF
End Select
If Not t = UTypes.Undefined Then
Dim m As New UserMedia(e.Value("url"), t) With {
.Post = New UserPost(PostID, AConvert(Of Date)(PostDate, DateProvider, Nothing, EDP.ReturnValue)),
.URL_BASE = BaseUrl.IfNullOrEmpty(MySettings.GetUserPostUrl(Me, m))
}
If Not t = UTypes.GIF Or GifsDownload Then
If t = UTypes.GIF Then
If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = GifsSpecialFolder
If Not GifsPrefix.IsEmptyString Then m.File.Name = $"{GifsPrefix}{m.File.Name}"
End If
If Not m.URL.IsEmptyString Then
If SourceMedia.State = UStates.Missing Then
m.State = UStates.Missing
m.Attempts = SourceMedia.Attempts
End If
_TempMediaList.ListAddValue(m, LNC)
End If
End If
End If
End Sub
Private Sub ObtainUserID()
Try
If ID.IsEmptyString Then
Dim url$ = $"https://{MyCredentials.Domain}/api/v1/accounts/lookup?acct="
If Not UserDomain.IsEmptyString Then
If UserDomain = MyCredentials.Domain Then
url &= $"@{NameTrue}"
Else
url &= $"@{NameTrue}@{UserDomain}"
End If
Else
url &= $"@{NameTrue}"
End If
Dim r$ = Responser.GetResponse(url)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing Then ID = j.Value("id")
End Using
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"API.Mastodon.UserData.ObtainUserID({ToStringForLog()})")
End Try
End Sub
Private Function GetSinglePostPattern(ByVal Domain As String) As String
Return $"https://{Domain}/api/v1/statuses/" & "{0}"
End Function
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
Try
If ContentMissingExists Then
Dim SinglePostUrl$ = GetSinglePostPattern(MyCredentials.Domain)
Dim m As UserMedia
Dim r$, PostDate$
Dim j As EContainer
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
If _ContentList(i).State = UStates.Missing Then
m = _ContentList(i)
If Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
URL = String.Format(SinglePostUrl, m.Post.ID)
r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
PostDate = String.Empty
If j.Contains("created_at") Then PostDate = j("created_at").Value Else PostDate = String.Empty
ObtainMedia(j, m.Post.ID, PostDate, m.URL_BASE, m)
rList.Add(i)
j.Dispose()
End If
End If
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, $"ReparseMissing error [{URL}]")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try
End Sub
#End Region
#Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
Dim PostID$ = RegexReplace(Data.URL, RParams.DM("(?<=/)\d+", 0, EDP.ReturnValue))
If Not PostID.IsEmptyString Then
ResetCredentials()
Dim pattern$
If Not ACheck(MySettings.MyDomain.Value) Then
Throw New ArgumentNullException("Mastodon domain", "Mastodon domain not set")
Else
pattern = GetSinglePostPattern(MySettings.MyDomain.Value)
End If
Dim r$ = Responser.GetResponse(String.Format(pattern, PostID),, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists AndAlso j.Contains("media_attachments") Then
For Each jj As EContainer In j("media_attachments") : ObtainMedia(jj, PostID, String.Empty, Data.URL) : Next
End If
End Using
End If
End If
End Sub
#End Region
#Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
If TypeOf ex Is ArgumentNullException AndAlso Not ex.HelpLink.IsEmptyString And ex.HelpLink = 1 Then
Return 0
Else
If Responser.Status = Net.WebExceptionStatus.NameResolutionFailure Then
MyMainLOG = $"User domain ({UserDomain}) not found: {ToStringForLog()}"
Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Or Responser.StatusCode = Net.HttpStatusCode.Forbidden Then
UserExists = False
Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.Unauthorized Then
MyMainLOG = $"{ToStringForLog()}: account credentials have expired"
Return 2
ElseIf Responser.StatusCode = Net.HttpStatusCode.Gone Then
UserSuspended = True
Return 1
Else
Return 0
End If
End If
End Function
#End Region
End Class
End Namespace

View File

@@ -17,5 +17,23 @@ Namespace API.OnlyFans
{{"files", "full", "url"}}
}
Friend Property Rules As DynamicRulesEnv
Friend Class CookieDateProvider : Implements ICustomProvider
Private ReadOnly DefaultProvider As IFormatProvider
Friend Sub New()
DefaultProvider = PersonalUtilities.Tools.Web.Cookies.CookieKeeper.DateProviderDefault
End Sub
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
If Not IsNothing(Value) AndAlso TypeOf Value Is String AndAlso Not CStr(Value).IsEmptyString Then
Dim v$ = Value
If v.Contains(",_") Then v = v.Substring(0, v.IndexOf(",_"))
Value = v
End If
Return AConvert(Of Date)(Value, DefaultProvider, Nothing)
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("'GetFormat' is not available in the 'CookieDateProvider'")
End Function
End Class
End Module
End Namespace

View File

@@ -219,12 +219,12 @@ Namespace API.OnlyFans
DynamicRulesXml.Extension = "xml"
ReplacePattern_RepoToRaw = New RParams("(.*github.com/([^/]+)/([^/]+)/blob/(.+))", Nothing, 0,
RegexReturn.ReplaceChangeListMatch, EDP.ReturnValue) With {
.PatternReplacement = "https://raw.githubusercontent.com/{2}/{3}/{4}"}
.PatternReplacement = "https://raw.githubusercontent.com/{2}/{3}/refs/heads/{4}"}
ReplacePattern_JsonInfo = ReplacePattern_RepoToRaw.Copy
ReplacePattern_JsonInfo.PatternReplacement = "https://github.com/{2}/{3}/latest-commit/{4}"
ReplacePattern_RawToRepo = ReplacePattern_RepoToRaw.Copy
ReplacePattern_RawToRepo.Pattern = "(.*raw.githubusercontent.com/([^/]+)/([^/]+)/([^/]+)/(.+))"
ReplacePattern_RawToRepo.PatternReplacement = "https://github.com/{2}/{3}/blob/{4}/{5}"
ReplacePattern_RawToRepo.Pattern = "(.*raw.githubusercontent.com/([^/]+)/([^/]+)(/refs/heads)?/([^/]+)/(.+))"
ReplacePattern_RawToRepo.PatternReplacement = "https://github.com/{2}/{3}/blob/{5}/{6}"
ConfigRulesExtract = RParams.DMS("DYNAMIC_RULE"":(\{.+?\}[\r\n]+)", 1, RegexOptions.Singleline, EDP.ReturnValue)
OFLOG = New TextSaver($"LOGs\OF_{Now:yyyyMMdd_HHmmss}.txt") With {.LogMode = True, .AutoSave = True, .AutoClear = True}
AddHandler OFLOG.TextSaved, AddressOf OFLOG_TextSaved

View File

@@ -99,6 +99,19 @@ Namespace API.OnlyFans
End Get
End Property
#End Region
#Region "Other"
<PClonable, PXML("OpenPostsUsingID")> Private ReadOnly Property OpenPostsUsingID_XML As PropertyValue
<PropertyOption(ControlText:="Open posts using ID", ControlToolTip:="Open posts using the user ID instead of the user name"), HiddenControl>
Private ReadOnly Property OpenPostsUsingID As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
Return DirectCast(DefaultInstance, SiteSettings).OpenPostsUsingID_XML
Else
Return OpenPostsUsingID_XML
End If
End Get
End Property
#End Region
#Region "OFScraper"
<PClonable, PXML("OFScraperPath")> Private ReadOnly Property OFScraperPath_XML As PropertyValue
<PropertyOption(ControlText:="OF-Scraper path", ControlToolTip:="The path to the 'ofscraper.exe'", Category:=CAT_OFS)>
@@ -240,6 +253,7 @@ Namespace API.OnlyFans
.CookiesUpdateMode = CookieKeeper.UpdateModes.Disabled
.Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False
.Cookies.DateProvider = New CookieDateProvider
With .Headers
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile))
@@ -285,6 +299,8 @@ Namespace API.OnlyFans
UpdateRules401_XML = New PropertyValue(False)
OpenPostsUsingID_XML = New PropertyValue(True)
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "onlyfans.com/"), 1, EDP.ReturnValue)
UrlPatternUser = "https://onlyfans.com/{0}"
ImageVideoContains = "onlyfans.com"
@@ -363,8 +379,9 @@ Namespace API.OnlyFans
End If
If p.IsEmptyString Then
Return GetUserUrl(User)
ElseIf CBool(OpenPostsUsingID.Value) Then
Return String.Format(UserPostPattern, p, If(User.ID.IsEmptyString, User.NameTrue, $"u{User.ID}"))
Else
'Return String.Format(UserPostPattern, p, If(User.ID.IsEmptyString, User.Name, $"u{User.ID}"))
Return String.Format(UserPostPattern, p, User.NameTrue)
End If
Else

View File

@@ -31,6 +31,7 @@ Namespace API.OnlyFans
Friend Property CCookie As CookieKeeper = Nothing
Private Const HeaderSign As String = "Sign"
Private Const HeaderTime As String = "Time"
Private Const LabelDRM As String = "DRM"
Private ReadOnly HighlightsList As List(Of String)
Friend Property MediaDownloadTimeline As Boolean = True
Friend Property MediaDownloadStories As Boolean = True
@@ -41,6 +42,11 @@ Namespace API.OnlyFans
Return HOST.Source
End Get
End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {LabelDRM}
End Get
End Property
#End Region
#Region "Load"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
@@ -66,7 +72,7 @@ Namespace API.OnlyFans
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions)
.ApplyBase(Me)
.Apply(Me)
MediaDownloadTimeline = .DownloadTimeline
MediaDownloadStories = .DownloadStories
MediaDownloadHighlights = .DownloadHighlights
@@ -88,6 +94,7 @@ Namespace API.OnlyFans
Private _DownloadedPostsSession As Integer = 0
Private FunctionErr As Integer = FunctionErrDef
Private Const FunctionErrDef As Integer = -100
Private _TimelineDownloading As Boolean = False
Private Sub ValidateOFScraper()
_OFScraperExists = ACheck(MySettings.OFScraperPath.Value) AndAlso CStr(MySettings.OFScraperPath.Value).CSFile.Exists
End Sub
@@ -110,12 +117,15 @@ Namespace API.OnlyFans
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "Unable to get user ID")
End If
_TimelineDownloading = True
If MediaDownloadTimeline Then DownloadTimeline(IIf(IsSavedPosts, 0, String.Empty), Token)
_TimelineDownloading = False
If Not IsSavedPosts Then
If MediaDownloadStories And FunctionErr = FunctionErrDef Then DownloadStories(Token)
If MediaDownloadHighlights And FunctionErr = FunctionErrDef Then DownloadHighlights(Token)
If MediaDownloadChatMedia And FunctionErr = FunctionErrDef Then DownloadChatMedia(0, Token)
End If
If _TempMediaList.Count > 0 And Not _NameUpdated Then GetUserID(True)
End If
Finally
Responser_ResponseReceived_RemoveHandler()
@@ -154,8 +164,12 @@ Namespace API.OnlyFans
If IsSavedPosts Then
path = $"/api2/v2/posts/bookmarks/all/?format=infinite&limit=10&offset={Cursor}"
Else
If DownloadTextPosts And DownloadText Then
path = $"/api2/v2/users/{ID}/posts?limit=10&order=publish_date_desc&skip_users=all&format=infinite&pinned=0"
Else
path = $"/api2/v2/users/{ID}/posts/medias?limit=50&order=publish_date_desc&skip_users=all&format=infinite&counters=1"
End If
If Not Cursor.IsEmptyString Then path &= $"&counters=0&beforePublishTime={Cursor}" Else path &= "&counters=1"
End If
@@ -430,7 +444,7 @@ Namespace API.OnlyFans
Result = False
With n("media")
If .ListExists Then
For Each m In .Self
For Each m As EContainer In .Self
postUrl = GetMediaURL(m)
'If IsHL Then
' 'postUrl = m.Value({"files", "source"}, "url")
@@ -439,10 +453,11 @@ Namespace API.OnlyFans
' 'postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
' postUrl = GetMediaURL(m)
'End If
If m.Value("canView").FromXML(Of Boolean)(True) Then
postUrlBase = String.Empty
Select Case m.Value("type")
Case "photo" : t = UTypes.Picture : ext = "jpg"
Case "video"
Case "video", "gif"
t = UTypes.Video
ext = "mp4"
If postUrl.IsEmptyString And Not IsHL And TryUseOFS Then
@@ -466,6 +481,7 @@ Namespace API.OnlyFans
Result = True
mList.Add(media)
End If
End If
Next
End If
End With
@@ -486,10 +502,9 @@ Namespace API.OnlyFans
_NameUpdated = True
If UpdateNameOnly Then Exit Sub
ID = j.Value("id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
UserSiteNameUpdate(j.Value("name"))
Dim descr$ = j.Value("about")
If Not descr.IsEmptyString Then descr = descr.Replace(brTag, String.Empty)
If Not descr.IsEmptyString Then descr = descr.Replace(brTag, vbCrLf)
UserDescriptionUpdate(descr)
SimpleDownloadAvatar(j.Value("avatar"))
SimpleDownloadAvatar(j.Value("header"))
@@ -621,6 +636,7 @@ Namespace API.OnlyFans
#Region "OFScraper support"
Private Function OFS_DownloadFile(ByVal URL As String, ByVal Token As CancellationToken) As List(Of SFile)
Try
If Labels.Count = 0 OrElse Not Labels.Contains(LabelDRM) Then Labels.Add(LabelDRM) : _ForceSaveUserInfo = True
Const requestPattern$ = """{0}"" manual --config ""{1}"" --url {2}"
Dim conf As SFile = OFS_CreateConfig()
If conf.Exists Then
@@ -785,6 +801,7 @@ Namespace API.OnlyFans
End If
End If
End If
If Not f.Exists Then f = Nothing
Return f
End If
Return Nothing
@@ -825,6 +842,8 @@ Namespace API.OnlyFans
Return 3
ElseIf Responser.StatusCode = Net.HttpStatusCode.InternalServerError Then '500
Return 3
ElseIf Not _TimelineDownloading And Responser.StatusCode = Net.HttpStatusCode.BadGateway Then '502
Return 3
Else
Return 0
End If

View File

@@ -6,15 +6,21 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes
Namespace API.Pinterest
Friend Class EditorExchangeOptions
Friend Class EditorExchangeOptions : Inherits EditorExchangeOptionsBase
<PSetting(Caption:="Get Sub-Boards", ToolTip:="Extract the Sub-Boards from the boards and download them")>
Friend Property ExtractSubBoards As Boolean = True
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
ExtractSubBoards = u.ExtractSubBoards
End Sub
Friend Sub New()
End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u)
DirectCast(u, UserData).ExtractSubBoards = ExtractSubBoards
End Sub
End Class
End Namespace

View File

@@ -97,7 +97,7 @@ Namespace API.Pinterest
Return New EditorExchangeOptions(Me)
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then ExtractSubBoards = DirectCast(Obj, EditorExchangeOptions).ExtractSubBoards
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then DirectCast(Obj, EditorExchangeOptions).Apply(Me)
End Sub
#End Region
#Region "Download overrides"

View File

@@ -20,11 +20,16 @@ Namespace API.PornHub
Friend ReadOnly RegexVideo_FlashVars_Vars As RParams = RParams.DM("var ([\w\d]{10,})=("".+?)(?=(;|\Z))", 0, RegexReturn.List)
Friend ReadOnly RegexVideo_FlashVars_Compiler As RParams = RParams.DM("(?<=\*/)([\w\d\S]{10,})", 0, RegexReturn.List)
Friend ReadOnly RegexVideo_FlashVars_UrlResolution As RParams = RParams.DMS("/(\d+)[^/]+\.mp4", 1, EDP.ReturnValue)
Friend ReadOnly RegexUserVideos As RParams = RParams.DM("(\<li class=""pcVideoListItem)((?:(?!/li\>).)*?)(\<div.class=.private-vid-title((?:(?!/li\>).)*?)|)(\<a.href=.([^""]+?)"".title=.([^""]*?)"")(((?:(?!/li\>).)+?)(\<div class=.videoUploaderBlock)|)((?:(?!/li\>).)*?)(\</li\>)",
Friend ReadOnly RegexUserVideos As RParams = RParams.DM("(\<li class=""pcVideoListItem)((?:(?!/li\>).)*?)(\<div.class=.private-vid-title((?:(?!/li\>).)*?)|)(\<a.href=.([^""]+?)"".title=.([^""]*?)"")(((?:(?!/li\>).)+?)(\<div class=.videoUploaderBlock.*?href=""([^""]+)"")|)((?:(?!/li\>).)*?)(\</li\>)",
0, RegexOptions.Singleline, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter)
Friend ReadOnly RegexVideo_Video_VideoKey As RParams = RParams.DMS("viewkey=([\w\d]+)", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideoPageTitle As RParams = RParams.DMS("meta (property|name)=""[^:]+?:title"" content=""([^""]+)""", 2, EDP.ReturnValue)
Friend ReadOnly RegexVideoPageTitle2 As RParams = RParams.DMS("\<title\>([^\<]+)\</title>", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideoPageTitle3 As RParams = RParams.DMS("videoTitle...([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideoPageTitle_NoTitle As RParams = RParams.DMS("(?<=(\=|/))([\w\d]+)(?=(\?|\&|\Z))", 2, EDP.ReturnValue)
Friend ReadOnly RegexDataToken As RParams = RParams.DMS("data-token=""([^""]+)", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideoAdditImg As RParams = RParams.DMS("twitter.image..content=""([^""]+)""", 1, EDP.ReturnValue)
Friend ReadOnly RegexVideoAdditImg2 As RParams = RParams.DMS("thumbnailUrl""[^""]*?""([^""]+)""", 1, EDP.ReturnValue)
#End Region
#Region "Declarations M3U8"
Friend ReadOnly Regex_M3U8_FilesList As RParams = RParams.DM("RESOLUTION=\d+x(\d+).*?[\r\n]*?(.+?m3u8.*)", 0, RegexReturn.List, EDP.ReturnValue)
@@ -42,6 +47,7 @@ Namespace API.PornHub
CType(Function(Input$) If(Input.IsEmptyString, String.Empty, $"https://www.pornhub.com{Input.Trim}"), Func(Of String, String)))
Friend ReadOnly Regex_Photo_PornHub_SinglePhoto As RParams = RParams.DM("data-image=""([^""]+)""\s*src=""([^""]+)""", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
Friend ReadOnly Regex_Photo_PornHub_SinglePhoto2 As RParams = RParams.DMS("image:src"" content=""([^""]+)""", 1, EDP.ReturnValue)
Friend ReadOnly Regex_Photo_PornHub_SinglePhoto3 As RParams = RParams.DMS("div id=""photoImageSection"".*?a href=""[^""\d]+\d+""\>[\r\n\s\t]*\<img src=""([^""]+)""", 1, RegexOptions.Singleline, EDP.ReturnValue)
Friend ReadOnly Regex_Photo_File As RParams = RParams.DM("\d+\.[\w]{3,4}", 0, EDP.ReturnValue)
#End Region
End Module

View File

@@ -22,7 +22,7 @@ Namespace API.PornHub
If Not r.IsEmptyString Then
Dim files As List(Of Sizes) = RegexFields(Of Sizes)(r, {Regex_M3U8_FilesList}, {1, 2}, EDP.ReturnValue)
Dim file$
If files.ListExists Then files.RemoveAll(Function(f) f.Value = 0 Or (Not DownloadUHD And f.Value > 1080))
If files.ListExists Then files.RemoveAll(Function(f) f.Value = 0 Or (Not DownloadUHD And f.Value > 1080) Or (f.Data.IsEmptyString OrElse f.Data.Contains("""")))
If files.ListExists Then
files.Sort()
file = files(0).Data

View File

@@ -14,7 +14,14 @@ Imports PersonalUtilities.Tools.Web.Clients
Namespace API.PornHub
<Manifest("AndyProgram_PornHub"), SavedPosts, SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Categories"
Private Const CAT_YTDLP As String = "yt-dlp support"
#End Region
#Region "Declarations"
#Region "Auth"
<PropertyOption(ControlText:="Use cookies", ControlToolTip:="Use cookies to download", IsAuth:=True), PXML, PClonable>
Friend Property CookiesUse As PropertyValue
#End Region
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML, PClonable>
Friend Property DownloadUHD As PropertyValue
<PropertyOption(ControlText:="Download uploaded", ControlToolTip:="Download uploaded videos"), PXML, PClonable>
@@ -34,12 +41,19 @@ Namespace API.PornHub
<DoNotUse> Friend Overrides Property DownloadText As PropertyValue
<DoNotUse> Friend Overrides Property DownloadTextPosts As PropertyValue
<DoNotUse> Friend Overrides Property DownloadTextSpecialFolder As PropertyValue
#Region "YT-DLP"
<PropertyOption(ControlText:="Use yt-dlp", ControlToolTip:="Use yt-dlp to download videos", Category:=CAT_YTDLP), PXML, PClonable>
Friend Property YTDLP_Use As PropertyValue
<PropertyOption(ControlText:="yt-dlp use cookies", ControlToolTip:="Using cookies in yt-dlp commands", Category:=CAT_YTDLP), PXML, PClonable>
Friend Property YTDLP_UseCookies As PropertyValue
#End Region
#End Region
#Region "Initializer"
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
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
CookiesUse = New PropertyValue(False)
DownloadUHD = New PropertyValue(False)
DownloadUploaded = New PropertyValue(True)
DownloadTagged = New PropertyValue(False)
@@ -49,10 +63,14 @@ Namespace API.PornHub
DownloadGifs = New PropertyValue(CInt(CheckState.Indeterminate), GetType(Integer))
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
YTDLP_Use = New PropertyValue(True)
YTDLP_UseCookies = New PropertyValue(False)
_SubscriptionsAllowed = True
UrlPatternUser = "https://www.pornhub.com/{0}/{1}"
UserRegex = RParams.DMS("pornhub.com/(model|user[s]?|pornstar|channel[s]?)/([^/]+).*?", 0, RegexReturn.ListByMatch)
ImageVideoContains = "pornhub.com"
UseNetscapeCookies = True
End Sub
#End Region
#Region "GetInstance"

View File

@@ -6,16 +6,20 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.IO
Imports System.Security.Policy
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.API.Base
Imports SCrawler.API.Base.YTDLP
Imports SCrawler.API.YouTube.Objects
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.PornHub
Friend Class UserData : Inherits UserDataBase
Friend Class UserData : Inherits UserDataBase : Implements IPSite
Private Const UrlPattern As String = "https://www.pornhub.com/{0}"
#Region "Declarations"
#Region "XML names"
@@ -50,12 +54,14 @@ Namespace API.PornHub
Friend URL As String
Friend ID As String
Friend Title As String
Friend UserRef As String
Friend Type As VideoTypes
Friend Function ToUserMedia(Optional ByVal SpecialFolder As String = Nothing) As UserMedia
Return New UserMedia(URL, UTypes.VideoPre) With {
.File = If(Title.IsEmptyString, .File, New SFile($"{Title}.mp4")),
Friend Function ToUserMedia(Optional ByVal SpecialFolder As String = Nothing, Optional ByVal UseYTDLP As Boolean = False) As UserMedia
Return New UserMedia(URL, If(UseYTDLP, UTypes.Video, UTypes.VideoPre)) With {
.File = If(Title.IsEmptyString, .File, New SFile($"{TitleHtmlConverter(Title)}.mp4")),
.Post = ID,
.SpecialFolder = SpecialFolder
.SpecialFolder = SpecialFolder,
.Type = If(UseYTDLP And Not Title.IsEmptyString, UTypes.Video, UTypes.VideoPre)
}
End Function
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
@@ -66,14 +72,16 @@ Namespace API.PornHub
URL = String.Empty
Else
URL = String.Format(UrlPattern, URL.TrimStart("/"))
Title = TitleHtmlConverter(ParamsArray(1))
If Not ParamsArray(2).IsEmptyString Then
Type = VideoTypes.Private
ElseIf Not ParamsArray(3).IsEmptyString Then
Type = VideoTypes.Tagged
'ElseIf Not ParamsArray(3).IsEmptyString Then
' Type = VideoTypes.Tagged
Else
Type = VideoTypes.Uploaded
End If
If Not ParamsArray(3).IsEmptyString Then UserRef = ParamsArray(3).StringTrim
End If
End If
Return Me
@@ -93,6 +101,9 @@ Namespace API.PornHub
Return Me
End Function
End Structure
Private Structure PHObj : Implements IThumbList
Friend Property Thumbs As List(Of String) Implements IThumbList.Thumbs
End Structure
#End Region
#Region "Enums"
Private Enum VideoTypes
@@ -140,7 +151,7 @@ Namespace API.PornHub
End Get
End Property
Friend Property SiteMode As SiteModes = SiteModes.User
Friend Property QueryString As String
Friend Property QueryString As String Implements IPSite.QueryString
Get
If IsUser Then
Return String.Empty
@@ -163,17 +174,7 @@ Namespace API.PornHub
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)
DownloadUHD = .DownloadUHD
DownloadUploaded = .DownloadUploaded
DownloadTagged = .DownloadTagged
DownloadPrivate = .DownloadPrivate
DownloadFavorite = .DownloadFavorite
DownloadGifs = .DownloadGifs
QueryString = .QueryString
End With
End If
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
End Sub
#End Region
Private ReadOnly Property MySettings As SiteSettings
@@ -181,6 +182,7 @@ Namespace API.PornHub
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
Private MyCache As CacheKeeper = Nothing
#End Region
#Region "Initializer"
Friend Sub New()
@@ -265,11 +267,12 @@ Namespace API.PornHub
Private _PageVideosRepeat As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
UpdateM3U8URLS = False
PlaylistToken = String.Empty
Responser.ResetStatus()
If Not CBool(MySettings.CookiesUse.Value) Then Responser.Cookies.Clear()
_PageVideosRepeat = 0
SessionPosts.Clear()
UseInternalDownloadFileFunction = MySettings.YTDLP_Use.Value
If IsSavedPosts Then
PersonType = PersonTypeUser
@@ -308,7 +311,7 @@ Namespace API.PornHub
End If
End If
If _TempMediaList.Count > 0 Then
If Not CBool(MySettings.YTDLP_Use.Value) And _TempMediaList.Count > 0 Then
_TempMediaList.RemoveAll(Function(m) Not m.Type = UTypes.m3u8 And Not m.Type = UTypes.VideoPre)
If limit > 0 And _TempMediaList.Count > limit Then _TempMediaList.ListAddList(_TempMediaList.ListTake(-1, limit), LAP.ClearBeforeAdd)
End If
@@ -345,13 +348,17 @@ Namespace API.PornHub
ProgressPre.ChangeMax(1)
Try
Dim specFolder$ = String.Empty
Dim useYtdlp As Boolean = MySettings.YTDLP_Use.Value
Dim tryNextPage As Boolean = False
Dim limit% = If(DownloadTopCount, -1)
Dim cBefore% = _TempMediaList.Count
Dim usrRef$ = String.Empty
Dim npd$ = "?"
If IsUser Then
URL = $"https://www.pornhub.com/{PersonType}/{NameTrue}"
usrRef = $"/{PersonType}/{NameTrue}"
If Type = VideoTypes.Uploaded Then
URL &= "/videos/upload"
If Not PersonType = PersonTypeCannel Then URL &= "/videos/upload?o=mr" : npd = "&"
ElseIf Type = VideoTypes.Tagged Then
If Not SecondMode Then URL &= "/videos"
specFolder = "Tagged"
@@ -364,7 +371,7 @@ Namespace API.PornHub
Else
Throw New ArgumentException($"Type '{Type}' is not implemented in the video download function", "Type")
End If
If Page > 1 Then URL &= $"?page={Page}"
If Page > 1 Then URL &= $"{npd}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)
@@ -377,12 +384,21 @@ Namespace API.PornHub
'Debug.WriteLine(URL)
Dim r$ = Responser.GetResponse(URL)
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, 11})
'If l.ListExists And Not SiteMode = SiteModes.Playlists Then l = l.ListTake(3, l.Count).ToList
If l.ListExists And Not SiteMode = SiteModes.Playlists Then l = l.ListTake(1, l.Count).ToList
If l.ListExists And Not SiteMode = SiteModes.Playlists And Not IsUser Then l = l.ListTake(1, l.Count).ToList
If l.ListExists Then
If IsUser Then
If Type = VideoTypes.Favorite Then
If Type = VideoTypes.Tagged Then
l = l.ListTake(4, l.Count)
If l.ListExists Then l.RemoveAll(Function(uv) Not uv.UserRef.IsEmptyString AndAlso uv.UserRef = usrRef)
ElseIf Type = VideoTypes.Uploaded Then
If PersonType = PersonTypeCannel Then
l = l.ListTake(4, l.Count)
Else
l.RemoveAll(Function(uv) Not uv.UserRef.IsEmptyString AndAlso Not uv.UserRef = usrRef)
End If
ElseIf Type = VideoTypes.Favorite Then
l.RemoveAll(Function(uv) uv.Type = VideoTypes.Private)
ElseIf Not PersonType = PersonTypeCannel Then
l.RemoveAll(Function(uv) Not uv.Type = Type)
@@ -400,7 +416,7 @@ Namespace API.PornHub
_TempPostsList.Add(uv.ID)
newPostsFound = True
Return False
ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(uv.id) Then
ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(uv.ID) Then
prevPostsFound = True
Return True
Else
@@ -412,7 +428,7 @@ Namespace API.PornHub
'Debug.WriteLineIf(l.Count > 0, l.Select(Function(ll) ll.Title).ListToString(vbNewLine))
If prevPostsFound And Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : _PageVideosRepeat += 1
If prevPostsFound And newPostsFound And pageRepeatSet Then _PageVideosRepeat -= 1
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, useYtdlp)))
SessionPosts.ListAddList(newLastPageIDs, LNC)
newLastPageIDs.Clear()
@@ -552,6 +568,7 @@ Namespace API.PornHub
If .ListExists(3) Then url = .Item(2).IfNullOrEmpty(.Item(1)).StringTrim
End With
If url.IsEmptyString Then url = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto2)
If url.IsEmptyString Then url = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto3)
Return url
End Function
Private Overloads Function DownloadUserPhotos_PornHub(ByVal Page As Integer, ByVal AlbumID As String, ByVal AlbumName As String,
@@ -643,6 +660,21 @@ Namespace API.PornHub
#End Region
#End Region
#Region "ReparseVideo"
Private Function GetVideoTitle(ByVal r As String, ByVal URL As String) As String
Dim tmpName$ = String.Empty
Dim rr As RParams
For i As Byte = 0 To 3
Select Case i
Case 0 : rr = RegexVideoPageTitle
Case 1 : rr = RegexVideoPageTitle2
Case 2 : rr = RegexVideoPageTitle3
Case Else : rr = RegexVideoPageTitle_NoTitle
End Select
tmpName = RegexReplace(IIf(i = 3, URL, r), rr)
If Not tmpName.IsEmptyString Then Exit For
Next
Return tmpName
End Function
Protected Overloads Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
If IsSubscription Then
ReparseVideoSubscriptions(Token)
@@ -654,10 +686,12 @@ Namespace API.PornHub
Optional ByRef Data As IYouTubeMediaContainer = Nothing)
Const ERR_NEW_URL$ = "ERR_NEW_URL"
Dim URL$ = String.Empty
Dim useYtdlp As Boolean = MySettings.YTDLP_Use.Value
Try
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
Dim m As UserMedia
Dim r$, NewUrl$, tmpName$
Dim isCurl%
ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform()
@@ -666,16 +700,22 @@ Namespace API.PornHub
ThrowAny(Token)
Try
URL = m.URL
r = Responser.Curl(URL)
For isCurl = 1 To 0 Step -1
If CBool(isCurl) Then r = Responser.Curl(URL) Else r = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
NewUrl = CreateVideoURL(r)
If NewUrl.IsEmptyString Then
NewUrl = String.Empty
If Not useYtdlp Then NewUrl = CreateVideoURL(r)
If Not useYtdlp And NewUrl.IsEmptyString Then
Throw New Exception With {.HelpLink = ERR_NEW_URL}
Else
If useYtdlp Then
m.Type = UTypes.Video
Else
m.URL = NewUrl
m.Type = UTypes.m3u8
If CreateFileName Then
tmpName = RegexReplace(r, RegexVideoPageTitle)
End If
If CreateFileName Or useYtdlp Then
tmpName = GetVideoTitle(r, URL)
If Not tmpName.IsEmptyString Then
If Not Data Is Nothing Then Data.Title = tmpName
m.File.Name = TitleHtmlConverter(tmpName)
@@ -684,9 +724,11 @@ Namespace API.PornHub
End If
_TempMediaList(i) = m
End If
Else
Exit For
ElseIf Not CBool(isCurl) Then
_TempMediaList.RemoveAt(i)
End If
Next
Catch mid_ex As Exception
If mid_ex.HelpLink = ERR_NEW_URL OrElse DownloadingException(mid_ex, "") = 1 Then
m.State = UserMedia.States.Missing
@@ -708,6 +750,10 @@ Namespace API.PornHub
Dim m As UserMedia
Dim r$, URL$, tmpName$, thumb$
Dim c% = 0
Dim thumbObj As PHObj
Dim thumbAdded As Boolean
Dim rp As RParams
Dim rpa() As RParams = {RegexVideoAdditImg, RegexVideoAdditImg2}
Dim rErr As New ErrorsDescriber(EDP.ReturnValue)
Progress.Maximum += _TempMediaList.Count
For i% = _TempMediaList.Count - 1 To 0 Step -1
@@ -722,10 +768,24 @@ Namespace API.PornHub
If Not r.IsEmptyString Then
m.Type = UTypes.m3u8
thumbObj = New PHObj With {.Thumbs = New List(Of String)}
thumbAdded = False
thumb = RegexReplace(r, Regex_VideosThumb_OG_IMAGE)
If Not thumb.IsEmptyString Then m.URL = thumb
If Not thumb.IsEmptyString Then m.URL = thumb : thumbAdded = True
For Each rp In rpa
thumb = RegexReplace(r, rp)
If Not thumb.IsEmptyString Then
If Not thumbAdded Then
m.URL = thumb
thumbAdded = True
Else
thumbObj.Thumbs.Add(thumb)
End If
End If
Next
If thumbObj.Thumbs.Count > 0 Then m.Object = thumbObj
tmpName = RegexReplace(r, RegexVideoPageTitle)
tmpName = GetVideoTitle(r, URL)
If Not tmpName.IsEmptyString Then
m.File.Name = TitleHtmlConverter(tmpName)
m.File.Extension = "mp4"
@@ -754,6 +814,7 @@ Namespace API.PornHub
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
If CBool(MySettings.YTDLP_Use.Value) Then UseInternalDownloadFileFunction = True
Try
If ContentMissingExists Then
Dim m As UserMedia
@@ -765,6 +826,12 @@ Namespace API.PornHub
m = _ContentList(i)
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
If CBool(MySettings.YTDLP_Use.Value) Then
m.URL = m.URL_BASE
m.Type = UTypes.Video
_TempMediaList.ListAddValue(m, LNC)
rList.Add(i)
Else
r = Responser.Curl(m.URL_BASE,, eCurl)
If Not r.IsEmptyString Then
Dim NewUrl$ = CreateVideoURL(r)
@@ -775,48 +842,72 @@ Namespace API.PornHub
End If
End If
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
ReparseMissing_ClearList(rList)
End Try
End Sub
#End Region
#Region "Download content"
Private UpdateM3U8URLS As Boolean = False
Private UpdateM3U8URLS_Error As Boolean = False
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
Try : DownloadContentDefault(Token) : Finally : UpdateM3U8URLS = False : End Try
DownloadContentDefault(Token)
End Sub
Protected Overloads Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken) As SFile
UpdateM3U8URLS_Error = False
Return DownloadM3U8(URL, Media, DestinationFile, Token, UpdateM3U8URLS)
Return DownloadM3U8(URL, Media, DestinationFile, Token, 0)
End Function
Private Overloads Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken, ByVal Second As Boolean) As SFile
ByVal Token As CancellationToken, ByVal Round As Integer) As SFile
Const MaxRound% = 2
Try
If Second Then
If Round > 0 Then
Dim r$ = Responser.Curl(Media.URL_BASE,, EDP.ReturnValue)
If Not r.IsEmptyString Then Media.URL = CreateVideoURL(r).IfNullOrEmpty(URL) : URL = Media.URL
End If
Dim f As SFile = M3U8.Download(URL, Responser, DestinationFile, DownloadUHD, Token, Progress, Not IsSingleObjectDownload)
If Not f.Exists And Not Second Then UpdateM3U8URLS = True : f = DownloadM3U8(URL, Media, DestinationFile, Token, True)
If Not f.Exists Then f = Nothing
If f.IsEmptyString And Round < MaxRound Then f = DownloadM3U8(URL, Media, DestinationFile, Token, Round + 1)
Return f
Catch ex As Exception
If Not UpdateM3U8URLS_Error Then
UpdateM3U8URLS_Error = True
If Round < MaxRound Then
Thread.Sleep(1000)
Return DownloadM3U8(URL, Media, DestinationFile, Token, True)
Return DownloadM3U8(URL, Media, DestinationFile, Token, Round + 1)
End If
Return Nothing
End Try
End Function
Protected Overrides Function ValidateDownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByRef Interrupt As Boolean) As Boolean
Return Media.Type = UTypes.Video
End Function
Protected Overrides Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Dim cc As CacheKeeper
If IsSingleObjectDownload Then
cc = Settings.Cache
Else
If MyCache Is Nothing Then MyCache = CreateCache()
cc = MyCache
End If
cc.Validate()
Dim cmd$ = YTDLP_CreateCommand(URL, cc)
Dim f As SFile = Nothing
If Not cmd.IsEmptyString Then
Dim path As SFile = cc.NewPath
path.Exists()
cmd &= $" -o ""{DestinationFile}"""
Using b As New YTDLPBatch(Token)
b.Encoding = Settings.CMDEncoding
b.CreateFileExchanger(cc)
If IsSingleObjectDownload Then b.SetProgress(Progress)
b.Execute(cmd)
End Using
If DestinationFile.Exists Then f = DestinationFile
End If
Return f
End Function
#End Region
#Region "CreateVideoURL"
Private Function CreateVideoURL(ByVal r As String) As String
@@ -910,9 +1001,43 @@ Namespace API.PornHub
End Try
End Function
#End Region
#Region "YT-DLP support"
Private Function YTDLP_CreateCommand(ByVal URL As String, ByRef Cache As CacheKeeper) As String
Dim path As SFile = Cache.NewPath
Dim c$ = If(CBool(MySettings.YTDLP_UseCookies.Value) And MySettings.CookiesNetscapeFile.Exists,
$" --no-cookies-from-browser --cookies ""{MySettings.CookiesNetscapeFile}""", String.Empty)
Dim cmd$ = $"""{Settings.YtdlpFile}"" --write-info-json --skip-download{c} {URL} -o ""{path.PathWithSeparator}file"""
path.Exists()
Using ytdlp As New YTDLPBatch(TokenPersonal,, path) : ytdlp.Encoding = Settings.CMDEncoding : ytdlp.Execute(cmd) : End Using
cmd = String.Empty
Dim f As SFile = SFile.GetFiles(path, "*.json",, EDP.ReturnValue).FirstOrDefault
If f.Exists Then
Using j As EContainer = JsonDocument.Parse(f.GetText(EDP.ReturnValue), EDP.ReturnValue)
If j.ListExists Then
With j("formats")
If .ListExists Then
Dim formats As List(Of Sizes) = Nothing
Try : formats = .Select(Function(ee) New Sizes(CInt(ee.Value("height")), ee.Value("format_id"))).ListIfNothing : Catch : End Try
If formats.ListExists Then
formats.RemoveAll(Function(ff) ff.Value <= 0 Or (Not CBool(MySettings.DownloadUHD.Value) AndAlso ff.Value > 1080) Or ff.Data.IsEmptyString)
If formats.Count > 0 Then
formats.Sort()
cmd = $"-f {formats(0).Data} "
formats.Clear()
End If
End If
End If
End With
End If
End Using
End If
Return $"""{Settings.YtdlpFile}"" {cmd}{URL}"
End Function
#End Region
#Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
UpdateM3U8URLS = False
If CBool(MySettings.YTDLP_Use.Value) Then UseInternalDownloadFileFunction = True
If Not CBool(MySettings.CookiesUse.Value) Then Responser.Cookies.Clear()
_TempMediaList.Add(New UserMedia(Data.URL, UTypes.VideoPre))
ReparseVideo(Token, True, Data)
End Sub
@@ -934,7 +1059,7 @@ Namespace API.PornHub
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then SessionPosts.Clear()
If Not disposedValue And disposing Then SessionPosts.Clear() : MyCache.DisposeIfReady
MyBase.Dispose(disposing)
End Sub
#End Region

View File

@@ -6,9 +6,10 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes
Namespace API.PornHub
Friend Class UserExchangeOptions : Inherits Xhamster.UserExchangeOptions
Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase_P
<PSetting(NameOf(SiteSettings.DownloadUHD), NameOf(MySettings))>
Friend Property DownloadUHD As Boolean
<PSetting(NameOf(SiteSettings.DownloadUploaded), NameOf(MySettings))>
@@ -23,16 +24,17 @@ Namespace API.PornHub
Friend Property DownloadGifs As Boolean
Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
DownloadUHD = u.DownloadUHD
DownloadUploaded = u.DownloadUploaded
DownloadTagged = u.DownloadTagged
DownloadPrivate = u.DownloadPrivate
DownloadFavorite = u.DownloadFavorite
DownloadGifs = u.DownloadGifs
QueryString = u.QueryString
MySettings = u.HOST.Source
End Sub
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
Dim v As CheckState = CInt(s.DownloadGifs.Value)
DownloadUHD = s.DownloadUHD.Value
DownloadUploaded = s.DownloadUploaded.Value
@@ -42,5 +44,16 @@ Namespace API.PornHub
DownloadGifs = Not v = CheckState.Unchecked
MySettings = s
End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u)
With DirectCast(u, UserData)
.DownloadUHD = DownloadUHD
.DownloadUploaded = DownloadUploaded
.DownloadTagged = DownloadTagged
.DownloadPrivate = DownloadPrivate
.DownloadFavorite = DownloadFavorite
.DownloadGifs = DownloadGifs
End With
End Sub
End Class
End Namespace

View File

@@ -32,22 +32,26 @@ Namespace API.Reddit
Property RedditAccount As String
Sub SetView(ByVal Options As IRedditView)
End Interface
Friend Class RedditViewExchange : Implements IRedditView
Friend Class RedditViewExchange : Inherits Base.EditorExchangeOptionsBase : Implements IRedditView
Friend Const Name_ViewMode As String = "ViewMode"
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 ViewPeriod As IRedditView.Period Implements IRedditView.ViewPeriod
Friend Property DownloadText As Boolean Implements IRedditView.DownloadText
Friend Property DownloadTextPosts As Boolean Implements IRedditView.DownloadTextPosts
Friend Property DownloadTextSpecialFolder As Boolean Implements IRedditView.DownloadTextSpecialFolder
Friend Overrides Property DownloadText As Boolean Implements IRedditView.DownloadText
Friend Overrides Property DownloadTextPosts As Boolean Implements IRedditView.DownloadTextPosts
Friend Overrides Property DownloadTextSpecialFolder As Boolean Implements IRedditView.DownloadTextSpecialFolder
Friend Property RedGifsAccount As String Implements IRedditView.RedGifsAccount
Friend Property RedditAccount As String Implements IRedditView.RedditAccount
Friend Sub New()
End Sub
Friend Sub New(ByVal Options As IRedditView)
MyBase.New(DirectCast(Options, UserData))
SetView(Options)
_ApplyBase_Name = False
End Sub
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
_ApplyBase_Name = False
End Sub
Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView
If Not Options Is Nothing Then

View File

@@ -9,15 +9,17 @@
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports System.Reflection
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.Base
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Imports DownDetector = SCrawler.API.Base.DownDetector
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Reddit
<Manifest(RedditSiteKey), SavedPosts, SpecialForm(False), UseDownDetector>
<Manifest(RedditSiteKey), SavedPosts, SeparatedTasks, SpecialForm(False), UseDownDetector>
Friend Class SiteSettings : Inherits SiteSettingsBase : Implements DownDetector.IDownDetector
#Region "Declarations"
#Region "Authorization"
@@ -58,14 +60,59 @@ Namespace API.Reddit
Return {AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString)
End Get
End Property
<PropertiesDataChecker({NameOf(AuthUserName), NameOf(AuthPassword), NameOf(ApiClientID), NameOf(ApiClientSecret),
NameOf(UseTokenForTimelines), NameOf(UseCookiesForTimelines)})>
Private Function OAuthCredentialsChecker(ByVal p As IEnumerable(Of PropertyData)) As Boolean
Const msgTitle$ = "OAuth credentials"
If p.ListExists Then
Dim useToken As Boolean = False, useCookies As Boolean = False
Dim d$ = String.Empty
Dim dCount As Byte = 0
Dim members As IEnumerable(Of MemberInfo) = GetObjectMembers(Me)
Dim getPropText As Func(Of String, String) = Function(name) members.First(Function(m) m.Name = name).GetCustomAttribute(Of PropertyOption).ControlText
Dim dataStr As Action(Of String, String) = Sub(dd, name) If dd.IsEmptyString Then d.StringAppendLine(getPropText(name)) : dCount += 1
For Each pp As PropertyData In p
Select Case pp.Name
Case NameOf(AuthUserName) : dataStr(pp.Value, NameOf(AuthUserName))
Case NameOf(AuthPassword) : dataStr(pp.Value, NameOf(AuthPassword))
Case NameOf(ApiClientID) : dataStr(pp.Value, NameOf(ApiClientID))
Case NameOf(ApiClientSecret) : dataStr(pp.Value, NameOf(ApiClientSecret))
Case NameOf(UseTokenForTimelines) : useToken = pp.Value
Case NameOf(UseCookiesForTimelines) : useCookies = pp.Value
Case Else : Throw New ArgumentException($"Property name '{pp.Name}' is not implemented", "Property Name")
End Select
Next
If d.IsEmptyString Then
If useToken And useCookies Then
Return True
Else
If Not useToken Then d.StringAppendLine(getPropText(NameOf(UseTokenForTimelines)))
If Not useCookies Then d.StringAppendLine(getPropText(NameOf(UseCookiesForTimelines)))
MsgBoxE({$"You need to check the following options:{vbCr}{d}", msgTitle}, vbCritical)
Return False
End If
ElseIf dCount = 4 Then
Return MsgBoxE({$"You haven't configured OAuth. It's highly recommended to use OAuth.{vbCr}Do you still want to continue?", msgTitle},
vbExclamation,,, {"Process", "Cancel"}) = 0
Else
MsgBoxE({$"You haven't filled in the following fields:{vbCr}{d}.{vbCr}{vbCr}" &
"To use OAuth authorization, you must fill in all authorization fields.", msgTitle}, vbCritical)
Return False
End If
End If
Return True
End Function
#End Region
#Region "Other"
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML, PClonable>
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos"), PXML, PClonable, HiddenControl>
Friend ReadOnly Property UseM3U8 As PropertyValue
<PropertyOption(ControlText:="Check image", ControlToolTip:="Check the image if it exists before downloading (it makes downloading very slow)", IsAuth:=False), PXML, PClonable>
<PropertyOption(ControlText:="Check image", ControlToolTip:="Check the image if it exists before downloading (it makes downloading very slow)"), PXML, PClonable, HiddenControl>
Friend ReadOnly Property CheckImage As PropertyValue
<PropertyOption(ControlText:="Check image: get original", ControlToolTip:="Get the original image if it exists", IsAuth:=False), PXML, PClonable>
<PropertyOption(ControlText:="Check image: get original", ControlToolTip:="Get the original image if it exists"), PXML, PClonable, HiddenControl>
Friend ReadOnly Property CheckImageReturnOrig As PropertyValue
<PropertyOption(ControlText:=DN.ConcurrentDownloadsCaption,
ControlToolTip:=DN.ConcurrentDownloadsToolTip, AllowNull:=False), PXML, TaskCounter, PClonable>
Friend ReadOnly Property ConcurrentDownloads As PropertyValue
#End Region
#Region "IDownDetector Support"
Private ReadOnly Property IDownDetector_Value As Integer Implements DownDetector.IDownDetector.Value
@@ -117,6 +164,7 @@ Namespace API.Reddit
UseM3U8 = New PropertyValue(True)
CheckImage = New PropertyValue(False)
CheckImageReturnOrig = New PropertyValue(True)
ConcurrentDownloads = New PropertyValue(1)
MDD = New MyDownDetector(Me)
@@ -124,10 +172,13 @@ Namespace API.Reddit
ImageVideoContains = "reddit.com"
UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/\?&]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
End Sub
Private Const SettingsVersionCurrent As Integer = 2
Private Const SettingsVersionCurrent As Integer = 3
Friend Overrides Sub EndInit()
If CInt(SettingsVersion.Value) < SettingsVersionCurrent Then
SettingsVersion.Value = SettingsVersionCurrent
UseM3U8.Value = True
CheckImage.Value = False
CheckImageReturnOrig.Value = True
BearerTokenUseCurl.Value = False
End If
MyBase.EndInit()
@@ -165,6 +216,7 @@ Namespace API.Reddit
End Sub
End Class
Friend Property SessionInterrupted As Boolean = False
Friend Property RequestCount As Integer = 0
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If What = Download.Main Then
Return Not SessionInterrupted
@@ -176,10 +228,18 @@ Namespace API.Reddit
Return AvailableTrueValue(What) AndAlso UpdateTokenIfRequired()
End Function
Private Function AvailableTrueValue(ByVal What As Download) As Boolean
Return Not What = Download.SavedPosts OrElse (Responser.CookiesExists And ACheck(SavedPostsUserName.Value))
'Return Not What = Download.SavedPosts OrElse (Responser.CookiesExists And ACheck(SavedPostsUserName.Value))
If What = Download.SavedPosts Then
Return Responser.CookiesExists And ACheck(SavedPostsUserName.Value)
ElseIf CredentialsExists Then
Return Not CBool(UseCookiesForTimelines.Value) OrElse Responser.CookiesExists
Else
Return Responser.CookiesExists
End If
End Function
Friend Overrides Sub DownloadDone(ByVal What As Download)
SessionInterrupted = False
RequestCount = 0
MDD.Reset()
MyBase.DownloadDone(What)
End Sub
@@ -212,7 +272,7 @@ Namespace API.Reddit
#End Region
#Region "UserOptions"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange
If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange(Me)
If OpenForm Then
Using f As New RedditViewSettingsForm(Options, True) : f.ShowDialog() : End Using
End If
@@ -233,23 +293,6 @@ Namespace API.Reddit
End Sub
#End Region
#Region "Token"
<PropertiesDataChecker({NameOf(AuthUserName), NameOf(AuthPassword), NameOf(ApiClientID), NameOf(ApiClientSecret)})>
Private Function TokenPropertiesChecker(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists Then
Dim wrong As New List(Of String)
For i% = 0 To p.Count - 1
If CStr(p(i).Value).IsEmptyString Then wrong.Add(p(i).Name)
Next
If wrong.Count > 0 And wrong.Count <> 4 Then
MsgBoxE({$"You have not completed the following fields: {wrong.ListToString}." & vbCr &
"To use OAuth authorization, all authorization fields must be filled in.", "Validate token fields"}, vbCritical)
Return False
Else
Return True
End If
End If
Return False
End Function
Private Function UpdateTokenIfRequired() As Boolean
UpdateRedGifsToken()
If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso CredentialsExists Then

View File

@@ -8,19 +8,20 @@
' but WITHOUT ANY WARRANTY
Imports System.Net
Imports System.Threading
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools.ImageRenderer
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.Base
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.API.Base
Imports SCrawler.API.Reddit.RedditViewExchange
Imports SCrawler.API.YouTube.Objects
Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.ImageRenderer
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
Imports CView = SCrawler.API.Reddit.IRedditView.View
Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports CView = SCrawler.API.Reddit.IRedditView.View
Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit
Friend Class UserData : Inherits UserDataBase : Implements IChannelLimits, IRedditView
#Region "Declarations"
@@ -135,6 +136,7 @@ Namespace API.Reddit
DownloadTextSpecialFolder = .DownloadTextSpecialFolder
RedGifsAccount = .RedGifsAccount
RedditAccount = .RedditAccount
If TypeOf Options Is RedditViewExchange Then DirectCast(Options, RedditViewExchange).Apply(Me)
End With
End If
End Sub
@@ -268,6 +270,8 @@ Namespace API.Reddit
End If
End With
Responser.ProcessExceptionDecision = AddressOf Err429Process
_TotalPostsDownloaded = 0
If IsSavedPosts Then
Responser.DecodersError = EDP.ReturnValue
@@ -303,6 +307,7 @@ Namespace API.Reddit
#End Region
#Region "Download Functions (User, Channel)"
Private Err429Count As Integer = 0
Private Err429TryAgain As Boolean = False
Private _TotalPostsDownloaded As Integer = 0
Private ReadOnly _CrossPosts As List(Of String)
Private Const SiteGfycatKey As String = "gfycat"
@@ -310,6 +315,28 @@ Namespace API.Reddit
Private Const Node_CrosspostRootId As String = "crosspostRootId"
Private Const Node_CrosspostParentId As String = "crosspostParentId"
Private Const Node_CrosspostParent As String = "crosspost_parent"
Private Sub Wait429()
With MySiteSettings
If Not Err429TryAgain Then .RequestCount += 1
Err429TryAgain = False
If (.RequestCount Mod 100) = 0 Then Thread.Sleep(60100)
End With
End Sub
Private Function Err429Process(ByVal Status As IResponserStatus, ByVal NullArg As Object, ByVal CurrErr As ErrorsDescriber) As ErrorsDescriber
If Not Status Is Nothing AndAlso Status.StatusCode = 429 Then
If Err429Count = 0 Then
Err429Count += 1
MySiteSettings.RequestCount = 100
Err429TryAgain = True
Return EDP.ReturnValue
End If
End If
Return CurrErr
End Function
Private Sub Err429Reset()
Err429Count = 0
Err429TryAgain = False
End Sub
Private Sub DownloadDataUser(ByVal POST As String, ByVal Token As CancellationToken)
Dim eObj% = 0
Dim round% = 0
@@ -328,10 +355,16 @@ Namespace API.Reddit
Dim _PostID As Func(Of String) = Function() PostTmp.IfNullOrEmpty(PostID)
'URL = $"https://gateway.reddit.com/desktopapi/v1/user/{NameTrue}/posts?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
If MySiteSettings.CredentialsExists Then
URL = $"https://oauth.reddit.com/user/{NameTrue}/submitted.json?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
Else
URL = $"https://www.reddit.com/user/{NameTrue}/.json?raw_json=1&rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
End If
ThrowAny(Token)
Wait429()
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Err429Reset()
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
If w.Count > 0 Then
'n = w.GetNode(JsonNodesJson)
@@ -346,6 +379,7 @@ Namespace API.Reddit
If CheckNode(.Self) Then
'Obtain post ID
PostID = String.Empty
PostTmp = .Value("name") '.Name
If PostTmp.IsEmptyString Then PostTmp = .Value("id")
If PostTmp.IsEmptyString Then Continue For
@@ -353,8 +387,9 @@ Namespace API.Reddit
If IsCrossPost(.Self) Then
_CrossPosts.ListAddList({ .Value(Node_CrosspostRootId),
.Value(Node_CrosspostParentId),
.Value(Node_CrosspostParent)}, LNC)
Continue For
.Value(Node_CrosspostParent),
PostTmp}, LNC)
If ParseUserMediaOnly Then Continue For
Else
If Not _CrossPosts.Contains(PostTmp) Then PostID = PostTmp : PostTmp = String.Empty
End If
@@ -383,6 +418,8 @@ Namespace API.Reddit
End Using
If POST.IsEmptyString And ExistsDetected Then Exit Sub
If Not _PostID().IsEmptyString And NewPostDetected Then DownloadDataUser(_PostID(), Token)
ElseIf Err429TryAgain Then
Continue Do
End If
_completed = True
Catch ex As Exception
@@ -419,9 +456,11 @@ Namespace API.Reddit
End If
ThrowAny(Token)
Wait429()
Dim r$ = Responser.GetResponse(URL)
If IsSavedPosts Then Err429Count = 0
'If IsSavedPosts Then Err429Count = 0
If Not r.IsEmptyString Then
Err429Reset()
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
If w.Count > 0 Then
n = w.GetNode(ChannelJsonNodes)
@@ -478,6 +517,8 @@ Namespace API.Reddit
End Using
If POST.IsEmptyString And ExistsDetected Then Exit Sub
If Not PostID.IsEmptyString And NewPostDetected Then DownloadDataChannel(PostID, Token)
ElseIf Err429TryAgain Then
Continue Do
End If
_completed = True
Catch ex As Exception
@@ -495,11 +536,13 @@ Namespace API.Reddit
End Sub
#End Region
#Region "GetUserInfo"
Private Sub GetUserInfo()
Private Sub GetUserInfo(Optional ByVal Round As Integer = 0)
Try
If Not IsSavedPosts And ChannelInfo Is Nothing Then
Wait429()
Dim r$ = Responser.GetResponse($"https://reddit.com/{IIf(IsChannel, "r", "user")}/{NameTrue}/about.json",, EDP.ReturnValue)
If Not r.IsEmptyString Then
Err429Reset()
Using j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing AndAlso j.Contains({"data", "subreddit"}) Then
If ID.IsEmptyString Then ID = j.Value({"data"}, "id")
@@ -515,6 +558,8 @@ Namespace API.Reddit
End With
End If
End Using
ElseIf Err429TryAgain And Round < 2 Then
GetUserInfo(Round + 1)
End If
End If
Catch ex As Exception
@@ -542,8 +587,6 @@ Namespace API.Reddit
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, PostID, PostDate, UserID,, PostText), LNC)
_TotalPostsDownloaded += 1
End If
ElseIf CreateImgurMedia(tmpUrl, PostID, PostDate, UserID, IsChannel, PostText) Then
_TotalPostsDownloaded += 1
ElseIf DownloadGallery(e, PostID, PostDate, UserID, SaveToCache, PostText) Then
_TotalPostsDownloaded += 1
ElseIf Not If(e({"media"}, "type")?.Value, String.Empty).IsEmptyString Then
@@ -630,8 +673,11 @@ Namespace API.Reddit
Else
Dim tPostId$ = e.Value(Node_CrosspostParent).IfNullOrEmpty(e.Value(Node_CrosspostParentId)).IfNullOrEmpty(e.Value(Node_CrosspostRootId))
If Not PostID.IsEmptyString Then
For ri% = 0 To 1
Wait429()
Dim r$ = Responser.GetResponse($"https://www.reddit.com/comments/{tPostId.Split("_").LastOrDefault}/.json",, EDP.ReturnValue)
If Not r.IsEmptyString Then
Err429Reset()
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If j.ListExists Then
With j.ItemF({0, "data", "children", 0, "data"})
@@ -639,7 +685,9 @@ Namespace API.Reddit
End With
End If
End Using
Exit For
End If
Next
End If
End If
End If
@@ -732,62 +780,15 @@ Namespace API.Reddit
End Function
#End Region
#Region "Download Base Functions"
Private Function CreateImgurMedia(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _UserID As String = "", Optional ByVal IsChannel As Boolean = False,
Optional ByVal PostText As String = Nothing) As Boolean
If Not _URL.IsEmptyString AndAlso _URL.Contains("imgur") Then
If _URL.StringContains({".jpg", ".png", ".jpeg"}) Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID,, PostText), LNC)
ElseIf _URL.Contains(".gifv") Then
If SaveToCache Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL.Replace(".gifv", ".gif"), PostID, PostDate, _UserID,, PostText), LNC)
Else
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, _URL.Replace(".gifv", ".mp4"), PostID, PostDate, _UserID,, PostText), LNC)
End If
ElseIf _URL.Contains(".mp4") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, _URL, PostID, PostDate, _UserID,, PostText), LNC)
ElseIf _URL.Contains(".gif") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.GIF, _URL, PostID, PostDate, _UserID,, PostText), LNC)
Else
Dim obj As IEnumerable(Of UserMedia) = Imgur.Envir.GetVideoInfo(_URL, EDP.ReturnValue)
If Not obj.ListExists Then
If Not TryFile(_URL) Then _URL &= ".jpg"
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID,, PostText), LNC)
Else
Dim ut As UTypes
Dim m As UserMedia
For Each data As UserMedia In obj
With data
If Not .URL.IsEmptyString Then
If Not .File.IsEmptyString Then
Select Case .File.Extension
Case "jpg", "png", "jpeg" : ut = UTypes.Picture
Case "gifv" : ut = IIf(SaveToCache, UTypes.Picture, UTypes.Video)
Case "mp4" : ut = UTypes.Video
Case "gif" : ut = UTypes.GIF
Case Else : ut = UTypes.Picture : .File.Extension = "jpg"
End Select
m = MediaFromData(ut, _URL, PostID, PostDate, _UserID,, PostText)
m.URL = .URL
m.File = .File.File
_TempMediaList.ListAddValue(m, LNC)
End If
End If
End With
Next
End If
End If
Return True
Else
Return False
End If
End Function
Private Function DownloadGallery(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _UserID As String = Nothing, Optional ByVal FirstOnly As Boolean = False,
Optional ByVal PostText As String = Nothing) As Boolean
Try
Dim added As Boolean = False
Dim node As EContainer = Nothing
Dim m As UserMedia
Dim isGif As Boolean
Dim i%
If e.Contains("media_metadata") Then
node = e("media_metadata")
ElseIf e.Contains("mediaMetadata") Then
@@ -796,13 +797,26 @@ Namespace API.Reddit
If If(node?.Count, 0) > 0 Then
Dim t As EContainer
For Each n As EContainer In node
t = n.ItemF({"s", "u"})
isGif = False
Select Case n.Value("e")
Case "AnimatedImage" : isGif = True : t = Nothing
Case Else : t = n.ItemF({"s", "u"})
End Select
For i = 0 To IIf(isGif, 1, 0)
If isGif Then t = If(i = 0, n.ItemF({"s", "gif"}), n.ItemF({"s", "mp4"}))
If Not t Is Nothing AndAlso Not t.Value.IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, t.Value, PostID, PostDate, _UserID,, PostText), LNC)
m = MediaFromData(IIf(i = 0, IIf(isGif, UTypes.GIF, UTypes.Picture), UTypes.GIF), t.Value, PostID, PostDate, _UserID,, PostText)
If isGif And i = 1 Then
m.File = CreateFileFromUrl(t.Value)
m.File.Extension = "mp4"
m.URL = t.Value
End If
_TempMediaList.ListAddValue(m, LNC)
added = True
If FirstOnly Then Exit For
End If
Next
Next
End If
Return added
Catch ex As Exception
@@ -905,7 +919,10 @@ Namespace API.Reddit
End If
Continue For
Else
Wait429()
r = Responser.GetResponse(m.URL,, e)
If r.IsEmptyString And Err429TryAgain Then _repeatForRedgifs = True
If Not r.IsEmptyString Then Err429Reset()
End If
Loop While _repeatForRedgifs
Else
@@ -943,11 +960,13 @@ Namespace API.Reddit
RedGifsResponser = RedGifsHost.Responser.Copy
Dim respNoHeaders As Responser = Responser.Copy
Dim m As UserMedia, m2 As UserMedia
Dim r$, url$
Dim r$ = String.Empty, url$
Dim ri As Byte
Dim j As EContainer
Dim lastCount%, li%
Dim rv As New ErrorsDescriber(EDP.ReturnValue)
respNoHeaders.Headers.Clear()
respNoHeaders.ProcessExceptionDecision = AddressOf Err429Process
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
@@ -955,9 +974,14 @@ Namespace API.Reddit
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
url = $"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json"
For ri = 0 To 1
Wait429()
r = Responser.GetResponse(url,, rv)
If r.IsEmptyString Then r = respNoHeaders.GetResponse(url,, rv)
If r.IsEmptyString Then Wait429() : r = respNoHeaders.GetResponse(url,, rv)
If Not (r.IsEmptyString And Err429TryAgain) Then Exit For
Next
If Not r.IsEmptyString Then
Err429Reset()
j = JsonDocument.Parse(r, rv)
If Not j Is Nothing Then
If j.Count > 0 Then
@@ -966,11 +990,11 @@ Namespace API.Reddit
If .ListExists AndAlso ParseContainer(.Self, m.Post.ID, String.Empty,,, GetTextDocument(.Self)) Then
If lastCount <> _TempMediaList.Count Then
For li = IIf(lastCount < 0, 0, lastCount) To _TempMediaList.Count - 1
m2 = _TempMediaList(i)
m2 = _TempMediaList(li)
m2.Post.Date = m.Post.Date
m2.State = UStates.Missing
m2.Attempts = m.Attempts
_TempMediaList(i) = m2
_TempMediaList(li) = m2
Next
End If
rList.Add(i)
@@ -1089,25 +1113,37 @@ Namespace API.Reddit
ElseIf .StatusCode = HttpStatusCode.Forbidden Then '403
UserSuspended = True
ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then '502, 503
MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] Reddit is currently unavailable"
LogError(Nothing, $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable")
Throw New Plugin.ExitException With {.Silent = True}
ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then '504
Return 1
ElseIf .StatusCode = HttpStatusCode.Unauthorized Then '401
MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] Reddit credentials expired"
LogError(Nothing, $"[{CInt(Responser.StatusCode)}] Reddit credentials expired")
MySiteSettings.SessionInterrupted = True
Throw New Plugin.ExitException With {.Silent = True}
ElseIf .StatusCode = HttpStatusCode.InternalServerError Then '500
If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1
Return HttpStatusCode.InternalServerError
ElseIf .StatusCode = 429 And IsSavedPosts And Err429Count = 0 Then
Err429Count += 1
Return 429
ElseIf .StatusCode = 429 AndAlso
((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso
Not MySiteSettings.CredentialsExists Then '429
MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] You should use OAuth authorization or disable " &
IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines")
'ElseIf .StatusCode = 429 And IsSavedPosts And Err429Count = 0 Then '429 (saved)
' Err429Count += 1
' Return 429
ElseIf .StatusCode = 429 Then '429 (all)
'If ((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso
' Not MySiteSettings.CredentialsExists Then
' LogError(Nothing, "[429] You should use OAuth authorization or disable " &
' IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines"))
'Else
' LogError(Nothing, "Too many requests (429). Try again later!")
'End If
'MySiteSettings.SessionInterrupted = True
'Throw New Plugin.ExitException With {.Silent = True}
If ((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso
Not MySiteSettings.CredentialsExists Then
LogError(Nothing, "[429] You should use OAuth authorization or disable " &
IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines"))
Else
LogError(Nothing, "Too many requests (429). Try again later!")
End If
MySiteSettings.SessionInterrupted = True
Throw New Plugin.ExitException With {.Silent = True}
Else

View File

@@ -22,6 +22,7 @@ Namespace API.RedGifs
Friend ReadOnly Property Token As PropertyValue
<PropertyOption, ControlNumber(2), PClonable, HiddenControl>
Private ReadOnly Property UserAgent As PropertyValue
<PXML> Friend ReadOnly Property UseCookies As PropertyValue
<PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue
Private Const TokenName As String = "authorization"
#Region "TokenUpdateInterval"
@@ -47,6 +48,7 @@ Namespace API.RedGifs
End With
Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(NameOf(Token), v))
UserAgent = New PropertyValue(If(Responser.UserAgentExists, Responser.UserAgent, String.Empty), GetType(String), Sub(v) UpdateResponse(NameOf(UserAgent), v))
UseCookies = New PropertyValue(False)
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date))
TokenUpdateInterval = New PropertyValue(60 * 12, GetType(Integer))
TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider
@@ -62,11 +64,16 @@ Namespace API.RedGifs
Case NameOf(Token) : Responser.Headers.Add(TokenName, Value)
Case NameOf(UserAgent) : Responser.UserAgent = Value
End Select
Responser.SaveSettings()
Responser.SaveSettings(, New ErrorsDescriber(EDP.ReturnValue + If(_TokenUpdating, EDP.None, EDP.SendToLog)))
End Sub
#End Region
#Region "Token updaters"
Private _TokenUpdating As Boolean = False
Friend Function UpdateTokenIfRequired() As Boolean
While _TokenUpdating : Threading.Thread.Sleep(100) : End While
Return UpdateTokenIfRequired_Impl()
End Function
Private Function UpdateTokenIfRequired_Impl() As Boolean
Dim d As Date? = AConvert(Of Date)(TokenLastDateUpdated.Value, AModes.Var, Nothing)
If Not d.HasValue OrElse d.Value < Now.AddMinutes(-CInt(TokenUpdateInterval.Value)) Then
Return UpdateToken()
@@ -76,7 +83,12 @@ Namespace API.RedGifs
End Function
<PropertyUpdater(NameOf(Token))>
Friend Function UpdateToken() As Boolean
While _TokenUpdating : Threading.Thread.Sleep(100) : End While
Return UpdateToken_Impl()
End Function
Private Function UpdateToken_Impl() As Boolean
Try
_TokenUpdating = True
Dim r$
Dim NewToken$ = String.Empty, NewAgent$ = String.Empty
Using resp As New Responser : r = resp.GetResponse("https://api.redgifs.com/v2/auth/temporary",, EDP.ThrowException) : End Using
@@ -98,6 +110,8 @@ Namespace API.RedGifs
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog, ex, "[API.RedGifs.SiteSettings.UpdateToken]", False)
Finally
_TokenUpdating = False
End Try
End Function
#End Region

View File

@@ -36,6 +36,7 @@ Namespace API.RedGifs
#End Region
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not MySettings.UseCookies.Value Then Responser.Cookies.Clear()
DownloadData(1, Token)
End Sub
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken)

View File

@@ -7,6 +7,8 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Tools.Web.Clients
Namespace API.ThisVid
Friend Module Declarations
Friend Const ThisVidSiteKey As String = "AndyProgram_ThisVid"
@@ -22,5 +24,27 @@ Namespace API.ThisVid
Friend ReadOnly RegExVideosThumb1 As RParams = RParams.DMS("preview_url:\s*'([^""']+)'", 1, EDP.ReturnValue)
Friend ReadOnly RegExVideosThumb2 As RParams = RParams.DMS("preview_url1:\s*'([^""']+)'", 1, EDP.ReturnValue)
Friend ReadOnly RegExVideoTitle As RParams = RParams.DMS("meta property=.og:title..content=""([^""]*)""", 1, EDP.ReturnValue)
Friend Class CookieKeeper2 : Inherits CookieKeeper
Public Overrides Function Update(Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
If Count > 0 Then
If Not ConvertToContainer(_Container, CookieList, EDP.ReturnValue) Then CookieList.RemoveAt(CookieList.Count - 1) Else Return True
End If
Return MyBase.Update(e)
End Function
End Class
Friend Class Responser2 : Inherits Responser
Friend Sub New()
MyBase.New
ChangeCookieKeeper()
End Sub
Friend Sub New(ByVal f As SFile)
MyBase.New(f)
ChangeCookieKeeper()
End Sub
Private Sub ChangeCookieKeeper()
_Cookies = New CookieKeeper2
Reset()
End Sub
End Class
End Module
End Namespace

View File

@@ -50,6 +50,14 @@ Namespace API.ThisVid
UrlPatternUser = "https://thisvid.com/members/{0}/"
ImageVideoContains = "https://thisvid.com/videos/"
End Sub
Protected Overrides Sub ChangeResponserOnInit()
_Responser.DisposeIfReady(False)
_Responser = Nothing
_Responser = New Responser2 With {.DeclaredError = EDP.ThrowException}
End Sub
Friend Overrides Function GetCookieKeeperInstance() As CookieKeeper
Return New CookieKeeper2
End Function
#End Region
#Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider

View File

@@ -14,7 +14,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Documents.JSON
Namespace API.ThisVid
Friend Class UserData : Inherits UserDataBase
Friend Class UserData : Inherits UserDataBase : Implements IPSite
#Region "XML names"
Private Const Name_DownloadPublic As String = "DownloadPublic"
Private Const Name_DownloadPrivate As String = "DownloadPrivate"
@@ -51,7 +51,7 @@ Namespace API.ThisVid
Return {SearchRequestLabelName}
End Get
End Property
Friend Property QueryString As String
Friend Property QueryString As String Implements IPSite.QueryString
Get
If SiteMode = SiteModes.User Then
Return String.Empty
@@ -161,15 +161,7 @@ Namespace API.ThisVid
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)
DownloadPublic = .DownloadPublic
DownloadPrivate = .DownloadPrivate
DownloadFavourite = .DownloadFavourite
DifferentFolders = .DifferentFolders
QueryString = .QueryString
End With
End If
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
End Sub
#End Region
#Region "Initializer"
@@ -187,7 +179,7 @@ Namespace API.ThisVid
If Not IsSavedPosts Then
Dim r$ = Responser.GetResponse($"https://thisvid.com/members/{ID}/")
If Not r.IsEmptyString Then
Dim rr As New RParams("", Nothing, 1, EDP.ReturnValue)
Dim rr As RParams = RParams.DMS("", 1, EDP.ReturnValue)
Dim __getValue As Func(Of String, Boolean, String) = Function(ByVal member As String, ByVal appendMember As Boolean) As String
rr.Pattern = String.Format(ProfileDataPattern, member)
Dim v$ = CStr(RegexReplace(r, rr)).StringTrim
@@ -198,13 +190,14 @@ Namespace API.ThisVid
If Not UserSiteName.IsEmptyString And FriendlyName.IsEmptyString Then FriendlyName = UserSiteName : _ForceSaveUserData = True
Dim descr$ = String.Empty
descr.StringAppendLine(__getValue("Birth date", True))
descr.StringAppendLine(__getValue("Country", True))
descr.StringAppendLine(__getValue("City", True))
descr.StringAppendLine(__getValue("Location", True))
'descr.StringAppendLine(__getValue("City", True))
descr.StringAppendLine(__getValue("Gender", True))
descr.StringAppendLine(__getValue("Orientation", True))
descr.StringAppendLine(__getValue("Relationship status", True))
descr.StringAppendLine(__getValue("Favourite category", True))
descr.StringAppendLine(__getValue("My interests", True))
descr.StringAppendLine(__getValue("Favorite niche", True))
rr.Pattern = DescriptionPattern
descr.StringAppendLine(CStr(RegexReplace(r, rr)).StringTrim)
UserDescriptionUpdate(descr)
@@ -411,6 +404,30 @@ Namespace API.ThisVid
End Sub
#End Region
#Region "ReparseVideo"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
If Not IsSubscription And ContentMissingExists Then
Dim m As UserMedia
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
ProgressPre.Perform()
m = _ContentList(i)
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
m.URL = m.URL_BASE
m.Type = UserMedia.Types.VideoPre
_TempMediaList.ListAddValue(m, LNC)
rList.Add(i)
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "missing data downloading error")
Finally
ReparseMissing_ClearList(rList)
End Try
End Sub
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
If IsSubscription Then
ReparseVideoSubscriptions(Token)
@@ -448,11 +465,12 @@ Namespace API.ThisVid
If n.IsEmptyString Then n = u.Post.ID
If n.IsEmptyString Then n = "VideoFile"
u.File = $"{n}.mp4"
If u.URL.IsEmptyString OrElse (Not u.Post.ID.IsEmptyString AndAlso _TempPostsList.Contains(u.Post.ID)) Then
If Not u.State = UserMedia.States.Missing AndAlso
(u.URL.IsEmptyString OrElse (Not u.Post.ID.IsEmptyString AndAlso _TempPostsList.Contains(u.Post.ID))) Then
_TempMediaList.RemoveAt(i)
Else
u.Type = UserMedia.Types.Video
_TempPostsList.Add(u.Post.ID)
_TempPostsList.ListAddValue(u.Post.ID, LNC)
_TempMediaList(i) = u
End If
e.Dispose()

View File

@@ -6,9 +6,10 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes
Namespace API.ThisVid
Friend Class UserExchangeOptions : Inherits Xhamster.UserExchangeOptions
Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase_P
<PSetting(Caption:="Download public videos")>
Friend Property DownloadPublic As Boolean = True
<PSetting(Caption:="Download private videos")>
@@ -19,6 +20,7 @@ Namespace API.ThisVid
Friend Property DifferentFolders As Boolean = True
Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
DownloadPublic = s.DownloadPublic.Value
DownloadPrivate = s.DownloadPrivate.Value
DownloadFavourite = s.DownloadFavourite.Value
@@ -26,12 +28,21 @@ Namespace API.ThisVid
MySettings = s
End Sub
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
DownloadPublic = u.DownloadPublic
DownloadPrivate = u.DownloadPrivate
DownloadFavourite = u.DownloadFavourite
DifferentFolders = u.DifferentFolders
QueryString = u.QueryString
MySettings = u.HOST.Source
End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u)
With DirectCast(u, UserData)
.DownloadPublic = DownloadPublic
.DownloadPrivate = DownloadPrivate
.DownloadFavourite = DownloadFavourite
.DifferentFolders = DifferentFolders
End With
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,17 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.ThreadsNet
Friend Module Declarations
Friend ReadOnly RegexUserID As RParams = RParams.DMS("""props"":\{[^\{\}]*?""user_id"":""(\d+)""", 1, EDP.ReturnValue)
Friend ReadOnly RegexUserName As RParams = RParams.DMS("\<meta property=""og:title"" content=""([^\>]+)""\s*/\>", 1, TitleHtmlConverter, EDP.ReturnValue)
Friend ReadOnly RegexUserDescr As RParams = RParams.DMS("\<meta property=""og:description"" content=""([^\>]+)""\s*/\>", 1, HtmlConverter, EDP.ReturnValue)
End Module
End Namespace

View File

@@ -55,7 +55,7 @@ Namespace API.ThreadsNet
Return New EditorExchangeOptionsBase(Me)
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptionsBase Then DirectCast(Obj, EditorExchangeOptionsBase).ApplyBase(Me)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptionsBase Then DirectCast(Obj, EditorExchangeOptionsBase).Apply(Me)
End Sub
#End Region
#Region "Initializer"
@@ -184,7 +184,6 @@ Namespace API.ThreadsNet
If uex.UserNotFound Then
UserExists = False
_ForceSaveUserInfo = True
_ForceSaveUserInfoOnException = True
ElseIf ThrowEx Then
Throw New ExitException(uex.ErrMessage) With {.SimpleLogLine = True}
Else
@@ -388,8 +387,10 @@ Namespace API.ThreadsNet
Dim newID$
Dim idStr$ = String.Empty
If Not r.IsEmptyString Then
UserSiteNameUpdate(RegexReplace(r, RegexUserName))
UserDescriptionUpdate(RegexReplace(r, RegexUserDescr))
ParseTokens(r, 0)
newID = RegexReplace(r, RParams.DMS("""props"":\{[^\{\}]*?""user_id"":""(\d+)""", 1, EDP.ReturnValue))
newID = RegexReplace(r, RegexUserID)
If ID.IsEmptyString OrElse ID = newID Then
_IdChanged = ID.IsEmptyString
ID = newID
@@ -402,7 +403,6 @@ Namespace API.ThreadsNet
If _IdChanged Then
If Not idStr.IsEmptyString Then UserDescriptionUpdate(idStr, True, True, True)
_ForceSaveUserInfo = True
_ForceSaveUserInfoOnException = True
End If
End If
Return Valid

View File

@@ -11,6 +11,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.TikTok
Friend Module Declarations
Friend ReadOnly SimpleDateConverter As New ADateTime("yyyyMMdd")
Friend ReadOnly SimpleDateConverterWithTime As New ADateTime("yyyyMMdd_HHmmss")
Friend ReadOnly RegexTagsReplacer As RParams = RParams.DM("#\w+\s?", -1, RegexReturn.Replace,
CType(Function(input$) String.Empty, Func(Of String, String)), EDP.ReturnValue)
Friend ReadOnly RegexPhotoJson As RParams = RParams.DMS("UNIVERSAL_DATA_FOR_REHYDRATION__"" type=""application/json""\>([^\<]+)\<", 1,

View File

@@ -10,11 +10,13 @@ Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.TikTok
<Manifest("AndyProgram_TikTok"), SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Categories"
Private Const CAT_DOWN As String = "Download"
Private Const CAT_UserDefs_Title As String = DN.CAT_UserDefs & " (Title)"
#End Region
#Region "Download"
<PropertyOption(ControlText:="Download videos", Category:=CAT_DOWN), PXML, PClonable>
@@ -22,33 +24,47 @@ Namespace API.TikTok
<PropertyOption(ControlText:="Download photos", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property DownloadTTPhotos As PropertyValue
#End Region
<PropertyOption(ControlText:="Remove tags from title"), PXML, PClonable>
#Region "User defaults"
#Region "Sections"
<PropertyOption(ControlText:="Get Timeline", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetTimeline As PropertyValue
<PropertyOption(ControlText:="Get User Stories", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetStoriesUser As PropertyValue
<PropertyOption(ControlText:="Get Reposts", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetReposts As PropertyValue
#End Region
#Region "Title"
<PropertyOption(ControlText:="Remove tags from title", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly 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, PClonable>
<PropertyOption(ControlText:="Use native title", ControlToolTip:="Use a user-created video title for the filename instead of the video ID.",
Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleUseNative As PropertyValue
<PropertyOption(ControlText:="Use native title (standalone downloader)",
ControlToolTip:="Use a user-created video title for the filename instead of the video ID."), PXML, PClonable>
ControlToolTip:="Use a user-created video title for the filename instead of the video ID.", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleUseNativeSTD As PropertyValue
<PropertyOption(ControlText:="Add video ID to video title"), PXML, PClonable>
<PropertyOption(ControlText:="Add video ID to video title", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleAddVideoID As PropertyValue
<PropertyOption(ControlText:="Add video ID to video title (standalone downloader)"), PXML, PClonable>
<PropertyOption(ControlText:="Add video ID to video title (standalone downloader)", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleAddVideoIDSTD As PropertyValue
<PropertyOption(ControlText:="Use regex to clean video title"), PXML, PClonable>
<PropertyOption(ControlText:="Use regex to clean video title", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleUseRegexForTitle As PropertyValue
<PropertyOption(ControlText:="Title regex", ControlToolTip:="Regex to clean video title"), PXML, PClonable>
<PropertyOption(ControlText:="Title regex", ControlToolTip:="Regex to clean video title", Category:=CAT_UserDefs_Title), PXML, PClonable>
Friend ReadOnly Property TitleUseRegexForTitle_Value As PropertyValue
#End Region
#End Region
<PropertyOption(ControlText:="Use video date as file date",
ControlToolTip:="Set the file date to the date the video was added (website) (if available)."), PXML, PClonable>
Friend ReadOnly Property UseParsedVideoDate As PropertyValue
<PropertyOption(ControlText:="Use video date as file date (standalone downloader)",
ControlToolTip:="Set the file date to the date the video was added (website) (if available)."), PXML, PClonable>
Friend ReadOnly Property UseParsedVideoDateSTD As PropertyValue
<DoNotUse> Friend Overrides Property DownloadText As PropertyValue
<DoNotUse> Friend Overrides Property DownloadTextPosts As PropertyValue
<DoNotUse> Friend Overrides Property DownloadTextSpecialFolder As PropertyValue
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("TikTok", "www.tiktok.com", AccName, Temp, My.Resources.SiteResources.TikTokIcon_32, My.Resources.SiteResources.TikTokPic_192)
GetTimeline = New PropertyValue(True)
GetStoriesUser = New PropertyValue(False)
GetReposts = New PropertyValue(False)
DownloadTTVideos = New PropertyValue(True)
DownloadTTPhotos = New PropertyValue(True)
@@ -79,5 +95,10 @@ Namespace API.TikTok
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
End Sub
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Dim url$ = MyBase.GetUserPostUrl(User, Media)
If Not url.IsEmptyString AndAlso url.EndsWith(UserData.GDL_POSTFIX) Then url = url.Replace(UserData.GDL_POSTFIX, String.Empty)
Return url
End Function
End Class
End Namespace

View File

@@ -7,16 +7,21 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports SCrawler.Plugin.Attributes
Imports Sections = SCrawler.API.Instagram.UserData.Sections
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.TikTok
Friend Class UserData : Inherits UserDataBase
#Region "XML names"
Private Const Name_GetTimeline As String = "GetTimeline"
Private Const Name_GetStoriesUser As String = "GetStoriesUser"
Private Const Name_GetReposts As String = "GetReposts"
Private Const Name_RemoveTagsFromTitle As String = "RemoveTagsFromTitle"
Private Const Name_TitleUseNative As String = "TitleUseNative"
Private Const Name_TitleAddVideoID As String = "TitleAddVideoID"
@@ -27,6 +32,7 @@ Namespace API.TikTok
Private Const Name_PhotosDownloaded As String = "PhotosDownloaded"
#End Region
#Region "Declarations"
Friend Const GDL_POSTFIX As String = "--GDL"
Private ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
@@ -57,6 +63,9 @@ Namespace API.TikTok
End If
End Get
End Property
Friend Property GetTimeline As Boolean = True
Friend Property GetStoriesUser As Boolean = False
Friend Property GetReposts As Boolean = False
Friend Property RemoveTagsFromTitle As Boolean = False
Friend Property TitleUseNative As Boolean = True
Friend Property TitleAddVideoID As Boolean = True
@@ -71,22 +80,16 @@ Namespace API.TikTok
Return New UserExchangeOptions(Me)
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions)
RemoveTagsFromTitle = .RemoveTagsFromTitle
TitleUseNative = .TitleUseNative
TitleAddVideoID = .TitleAddVideoID
TitleUseRegexForTitle = .TitleUseRegexForTitle
TitleUseRegexForTitle_Value = .TitleUseRegexForTitle_Value
TitleUseGlobalRegexOptions = .TitleUseGlobalRegexOptions
End With
End If
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
End Sub
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
GetTimeline = .Value(Name_GetTimeline).FromXML(Of Boolean)(True)
GetStoriesUser = .Value(Name_GetStoriesUser).FromXML(Of Boolean)(False)
GetReposts = .Value(Name_GetReposts).FromXML(Of Boolean)(False)
RemoveTagsFromTitle = .Value(Name_RemoveTagsFromTitle).FromXML(Of Boolean)(False)
TitleUseNative = .Value(Name_TitleUseNative).FromXML(Of Boolean)(True)
TitleAddVideoID = .Value(Name_TitleAddVideoID).FromXML(Of Boolean)(True)
@@ -97,6 +100,9 @@ Namespace API.TikTok
TitleUseGlobalRegexOptions = .Value(Name_TitleUseGlobalRegexOptions).FromXML(Of Boolean)(True)
PhotosDownloaded = .Value(Name_PhotosDownloaded).FromXML(Of Boolean)(False)
Else
.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
.Add(Name_GetStoriesUser, GetStoriesUser.BoolToInteger)
.Add(Name_GetReposts, GetReposts.BoolToInteger)
.Add(Name_RemoveTagsFromTitle, RemoveTagsFromTitle.BoolToInteger)
.Add(Name_TitleUseNative, TitleUseNative.BoolToInteger)
.Add(Name_TitleAddVideoID, TitleAddVideoID.BoolToInteger)
@@ -165,17 +171,29 @@ Namespace API.TikTok
Private Function GetPhotoNode() As Object()
Return {"imageURL", "urlList", 0, 0}
End Function
Private Sub ValidateCache()
If If(UserCache?.Disposed, True) Then UserCache = CreateCache()
End Sub
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
MyBase.DownloadData(Token)
UserCache.DisposeIfReady(False)
UserCache = Nothing
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Private StoryStatus As Boolean = True
Private StoryStatusFound As Boolean = False
Protected Overloads Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
ValidateCache()
StoryStatus = True
StoryStatusFound = False
If GetTimeline Then DownloadDataF(Sections.Timeline, Token)
If GetStoriesUser And StoryStatus Then DownloadDataF(Sections.UserStories, Token)
If GetReposts Then DownloadDataF(Sections.Reposts, Token)
End Sub
Protected Overloads Sub DownloadDataF(ByVal Section As Sections, ByVal Token As CancellationToken)
Dim URL$ = $"https://www.tiktok.com/@{NameTrue}"
UserCache = CreateCache()
Try
Const photoPrefix$ = "photo_"
Dim postID$, title$, postUrl$, newName$, t$, postID2$, imgUrl$
Dim postID$, title$, postUrl$, newName$, t$, tOrig$, postID2$, imgUrl$, pText$
Dim postDate As Date?
Dim dateAfterC As Date? = Nothing
Dim dateBefore As Date? = DownloadDateTo
@@ -184,12 +202,24 @@ Namespace API.TikTok
Dim titleRegex As RParams = GetTitleRegex()
Dim vPath As SFile = Nothing, pPath As SFile = Nothing
Dim file As SFile
Dim j As EContainer, photo As EContainer
Dim j As EContainer = Nothing, photo As EContainer, item As EContainer
Dim photoNode As Object() = GetPhotoNode()
Dim c%, cc%, i%
Dim errDef As New ErrorsDescriber(EDP.ReturnValue)
Dim infoParsed As Boolean = False
Dim gdlTmpIDs As New Dictionary(Of String, Integer)
Dim gdlCmd$ = String.Empty
Dim gdlIsNativeJson As Boolean
Dim __specFolder$ = String.Empty
Dim __specFolder_Cr As Func(Of String, String) = Function(_sp$) String.Empty.StringAppend(__specFolder).StringAppend(_sp, "\") &
IIf(__specFolder.IsEmptyString, String.Empty, "*")
Select Case Section
Case Sections.UserStories : URL &= "/stories" : __specFolder = "Stories (user)" : gdlCmd = "-o videos -o photos"
Case Sections.Reposts : URL &= "/reposts" : __specFolder = "Reposts"
End Select
If _ContentList.Count > 0 Then
With (From d In _ContentList Where d.Post.Date.HasValue Select d.Post.Date.Value)
If .ListExists Then dateAfterC = .Min
@@ -214,19 +244,16 @@ Namespace API.TikTok
End If
End If
If DownloadVideos And Settings.YtdlpFile.Exists And CBool(MySettings.DownloadTTVideos.Value) Then
If Section = Sections.Timeline And DownloadVideos And Settings.YtdlpFile.Exists And CBool(MySettings.DownloadTTVideos.Value) Then
With UserCache.NewInstance : .Validate() : vPath = .RootDirectory : End With
Using b As New YTDLP.YTDLPBatch(Token) With {.TempPostsList = _TempPostsList}
b.Commands.Clear()
b.ChangeDirectory(vPath)
b.Encoding = BatchExecutor.UnicodeEncoding
Using b As New YTDLP.YTDLPBatch(Token,, vPath) With {.TempPostsList = _TempPostsList}
b.Execute(CreateYTCommand(vPath, URL, False, dateBefore, dateAfter))
End Using
End If
If DownloadImages And Settings.GalleryDLFile.Exists And CBool(MySettings.DownloadTTPhotos.Value) Then
With UserCache.NewInstance : .Validate() : pPath = .RootDirectory : End With
Using b As New GDL.GDLBatch(Token)
Using b As New GDL.GDLBatch(Token,, pPath)
With b
If PhotosDownloaded And _TempPostsList.Count > 0 Then
.TempPostsList = (From p As String In _TempPostsList
@@ -235,10 +262,8 @@ Namespace API.TikTok
Else
.TempPostsList = New List(Of String)
End If
.ChangeDirectory(pPath)
.Encoding = BatchExecutor.UnicodeEncoding
.Execute(CreateGDLCommand(URL))
If Not PhotosDownloaded Then _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True
.Execute(CreateGDLCommand(URL, gdlCmd,,,, CObj(IIf(Section = Sections.Timeline, dateAfter, Nothing))))
If Not PhotosDownloaded Then _ForceSaveUserInfo = True
PhotosDownloaded = True
End With
End Using
@@ -247,6 +272,7 @@ Namespace API.TikTok
ThrowAny(Token)
Dim files As List(Of SFile)
'YTDLP
If Not vPath.IsEmptyString AndAlso vPath.Exists(SFO.Path, False) Then
files = SFile.GetFiles(vPath, "*.json",, errDef)
If files.ListExists Then
@@ -254,12 +280,9 @@ Namespace API.TikTok
j = JsonDocument.Parse(file.GetText, errDef)
If j.ListExists Then
If j.Value("_type").StringToLower = "video" Then
If Not baseDataObtained Then
If Not baseDataObtained And Section = Sections.Timeline Then
baseDataObtained = True
If ID.IsEmptyString Then
ID = j.Value("uploader_id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
If ID.IsEmptyString Then ID = j.Value("uploader_id")
newName = j.Value("uploader")
If Not newName.IsEmptyString Then NameTrue = newName
newName = j.Value("creator")
@@ -269,10 +292,13 @@ Namespace API.TikTok
If Not _TempPostsList.Contains(postID) Then
_TempPostsList.ListAddValue(postID, LNC)
Else
Exit For 'Exit Sub
'Exit For 'Exit Sub
Continue For
End If
title = GetNewFileName(j.Value("title").StringRemoveWinForbiddenSymbols,
TitleUseNative, RemoveTagsFromTitle, TitleAddVideoID, postID, titleRegex)
pText = j.Value("title")
If Not j.Value("description").IsEmptyString Then pText &= vbCr & vbCr & j.Value("description")
postDate = AConvert(Of Date)(j.Value("timestamp"), UnixDate32Provider, Nothing)
If Not postDate.HasValue Then postDate = AConvert(Of Date)(j.Value("upload_date"), SimpleDateConverter, Nothing)
Select Case CheckDatesLimit(postDate, SimpleDateConverter)
@@ -283,7 +309,13 @@ Namespace API.TikTok
postUrl = j.Value("webpage_url")
If postUrl.IsEmptyString Then postUrl = $"https://www.tiktok.com/@{Name}/video/{postID}"
_TempMediaList.Add(New UserMedia(postUrl, UTypes.Video) With {
.File = $"{title}.mp4", .Post = New UserPost(postID, postDate)})
.File = $"{title}.mp4",
.SpecialFolder = __specFolder_Cr(String.Empty),
.Post = New UserPost(postID, postDate),
.PostText = pText,
.PostTextFileSpecialFolder = DownloadTextSpecialFolder,
.PostTextFile = $"{ .File.Name}.txt"
})
End If
j.Dispose()
End If
@@ -291,25 +323,126 @@ Namespace API.TikTok
End If
End If
j.DisposeIfReady
'GDL
If Not pPath.IsEmptyString AndAlso pPath.Exists(SFO.Path, False) Then
files = SFile.GetFiles(pPath, "*.txt",, errDef)
If files.ListExists Then
If Not Section = Sections.Timeline Then
GDLResetFileNameProvider(Math.Max(files.Count.ToString.Length, 2))
For i = 0 To files.Count - 1 : files(i) = GDLRenameFile(files(i), i) : Next
End If
For Each file In files
t = file.GetText(errDef)
If Not t.IsEmptyString Then t = RegexReplace(t, RegexPhotoJson)
tOrig = t
gdlIsNativeJson = False
If Not t.IsEmptyString And Not Section = Sections.UserStories Then
t = RegexReplace(t, RegexPhotoJson)
If t.IsEmptyString Then t = tOrig : gdlIsNativeJson = True
End If
If Not t.IsEmptyString Then
j = JsonDocument.Parse(t, errDef)
If j.ListExists Then
With j.ItemF({0, "webapp.video-detail", "itemInfo", "itemStruct"})
If Section = Sections.UserStories Then
With j("itemList")
If .ListExists Then
For Each item In .Self
With item
postID = .Value("id")
postDate = AConvert(Of Date)(.Value("createTime"), UnixDate32Provider, Nothing)
If Not _TempPostsList.Contains(postID) Then
_TempPostsList.Add(postID)
postUrl = $"https://www.tiktok.com/@{Name}/video/{postID}{GDL_POSTFIX}"
If postDate.HasValue Then
title = CStr(AConvert(Of String)(postDate.Value, SimpleDateConverterWithTime, String.Empty)).StringAppend(postID, " ")
Else
title = postID
End If
_TempMediaList.Add(New UserMedia(postUrl, UTypes.Video) With {
.URL_BASE = postUrl,
.SpecialFolder = __specFolder_Cr(String.Empty),
.File = $"{title}.mp4",
.Post = New UserPost(postID, postDate)
})
With .Item("video")
If .ListExists AndAlso Not .Value("cover").IsEmptyString Then _
_TempMediaList.Add(New UserMedia(.Value("cover"), UTypes.Picture) With {
.URL_BASE = postUrl,
.SpecialFolder = __specFolder_Cr("Photo"),
.File = $"{title}.jpg"
})
End With
Else
Continue For
End If
End With
Next
End If
End With
ElseIf Section = Sections.Reposts And gdlIsNativeJson Then
With j("itemList")
If .ListExists Then
For Each item In .Self
With item
postID = .Value("id")
postID2 = $"{photoPrefix}{postID}"
If Not _TempPostsList.Contains(postID2) Then _TempPostsList.ListAddValue(postID2, LNC) Else Exit For 'Exit Sub
If Not _TempPostsList.Contains(postID) And Not _TempPostsList.Contains(postID2) Then
title = GetNewFileName(.Value("title").StringRemoveWinForbiddenSymbols,
TitleUseNative, RemoveTagsFromTitle, TitleAddVideoID, postID, titleRegex)
pText = .Value("title")
If Not .Value("desc").IsEmptyString Then
pText &= vbCr & vbCr & .Value("desc")
If title.IsEmptyString Then title = GetNewFileName(.Value("desc").StringRemoveWinForbiddenSymbols,
TitleUseNative, RemoveTagsFromTitle, TitleAddVideoID, postID, titleRegex)
End If
postDate = AConvert(Of Date)(j.Value("createTime"), UnixDate32Provider, Nothing)
If postDate.HasValue Then
Select Case CheckDatesLimit(postDate, SimpleDateConverter)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit For 'Exit Sub
End Select
End If
postUrl = .Value({"author"}, "uniqueId")
If Not postUrl.IsEmptyString Then
postUrl = $"https://www.tiktok.com/@{postUrl}/video/{postID}"
_TempMediaList.Add(New UserMedia(postUrl, UTypes.Video) With {
.File = $"{title}.mp4",
.SpecialFolder = __specFolder_Cr(String.Empty),
.Post = New UserPost(postID, postDate),
.PostText = pText,
.PostTextFileSpecialFolder = DownloadTextSpecialFolder,
.PostTextFile = $"{ .File.Name}.txt"
})
If Not gdlTmpIDs.ContainsKey(postID) Then gdlTmpIDs.Add(postID, _TempMediaList.Count - 1)
End If
Else
Continue For
End If
End With
Next
End If
End With
Else
If Section = Sections.Timeline And Not StoryStatusFound And j.ContainsF({0, "webapp.user-detail", "userInfo", "user"}, "UserStoryStatus") Then
StoryStatusFound = True
StoryStatus = j.ItemF({0, "webapp.user-detail", "userInfo", "user"}, "UserStoryStatus").Value.FromXML(Of Boolean)(False)
End If
With j.ItemF({0, "webapp.video-detail", "itemInfo", "itemStruct"})
If .ListExists Then
postID = .Value("id")
postID2 = $"{photoPrefix}{postID}"
'If Not _TempPostsList.Contains(postID2) Then _TempPostsList.ListAddValue(postID2, LNC) Else Exit For 'Exit Sub
postDate = AConvert(Of Date)(.Value("createTime"), UnixDate32Provider, Nothing)
If Not Section = Sections.UserStories Then
Select Case CheckDatesLimit(postDate, SimpleDateConverter)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit For 'Exit Sub
End Select
End If
If Not infoParsed Then
With .Item("author")
@@ -333,11 +466,22 @@ Namespace API.TikTok
End With
End If
title = GetNewFileName(j.Value({"imagePost"}, "title").StringRemoveWinForbiddenSymbols,
title = GetNewFileName(.Value({"imagePost"}, "title").StringRemoveWinForbiddenSymbols,
TitleUseNative, RemoveTagsFromTitle, TitleAddVideoID, postID, titleRegex)
pText = .Value({"imagePost"}, "title")
If Not .Value("desc").IsEmptyString Then pText &= vbCr & vbCr & .Value("desc")
postUrl = $"https://www.tiktok.com/@{Name}/photo/{postID}"
With .Item({"imagePost", "images"})
If .ListExists Then
If Not _TempPostsList.Contains(postID2) Then
_TempPostsList.ListAddValue(postID2, LNC)
If gdlTmpIDs.ContainsKey(postID) Then
_TempMediaList.RemoveAt(gdlTmpIDs(postID))
gdlTmpIDs.Remove(postID)
End If
Else
Continue For 'Exit Sub
End If
i = 0
c = .Count
cc = Math.Max(c.ToString.Length, 3)
@@ -347,14 +491,19 @@ Namespace API.TikTok
If Not imgUrl.IsEmptyString Then _
_TempMediaList.Add(New UserMedia(imgUrl, UTypes.Picture) With {
.URL_BASE = postUrl,
.SpecialFolder = "Photo",
.SpecialFolder = __specFolder_Cr("Photo"),
.File = $"{title}{IIf(c > 1, $"_{i.NumToString(ANumbers.Formats.NumberGroup, cc)}", String.Empty)}.jpg",
.Post = New UserPost(postID, postDate)})
.Post = New UserPost(postID, postDate),
.PostText = pText,
.PostTextFileSpecialFolder = DownloadTextSpecialFolder,
.PostTextFile = $"{ .File.Name}.txt"
})
Next
End If
End With
End If
End With
End If
j.Dispose()
End If
End If
@@ -362,6 +511,9 @@ Namespace API.TikTok
End If
End If
j.DisposeIfReady
_TempPostsList.ListAddList(gdlTmpIDs.Keys)
gdlTmpIDs.Clear()
If _TempMediaList.Count > 0 Then LastDownloadDate = Now
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
@@ -425,7 +577,11 @@ Namespace API.TikTok
End If
If DateBefore.HasValue Then command &= $"--datebefore {DateBefore.Value.AddDays(1).ToStringDate(SimpleDateConverter)} "
If DateAfter.HasValue Then command &= $"--dateafter {DateAfter.Value.AddDays(-1).ToStringDate(SimpleDateConverter)} "
If Not CBool(If(IsSingleObjectDownload, MySettings.UseParsedVideoDateSTD, MySettings.UseParsedVideoDate).Value) Then command &= "--no-mtime "
If Not CBool(If(IsSingleObjectDownload, MySettings.UseParsedVideoDateSTD, MySettings.UseParsedVideoDate).Value) Then
command &= "--no-mtime "
Else
command &= "--mtime "
End If
If MySettings.CookiesNetscapeFile.Exists Then command &= $"--no-cookies-from-browser --cookies ""{MySettings.CookiesNetscapeFile}"" "
command &= $"{URL} "
If SupportOutput Then
@@ -442,8 +598,21 @@ Namespace API.TikTok
End Function
#End Region
#Region "GDL Support"
Private Function CreateGDLCommand(ByVal URL As String) As String
Return $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip --write-pages {URL}"
Private Function CreateGDLCommand(ByVal URL As String, Optional ByVal SectionCommand As String = Nothing,
Optional ByVal IsDownload As Boolean = False, Optional ByVal Output As SFile = Nothing,
Optional ByVal DateBefore As Date? = Nothing, Optional ByVal DateAfter As Date? = Nothing) As String
Dim command$ = $"""{Settings.GalleryDLFile}"" "
If Not IsDownload Then
command &= "--verbose --no-download --no-skip --write-pages "
Else
command &= $"--dest ""{Output.PathNoSeparator}"" "
End If
If DateBefore.HasValue Or DateAfter.HasValue Then
With If(DateAfter, DateBefore).Value : command &= $"--filter ""date {IIf(DateAfter.HasValue, ">", "<")} datetime({ .Year}, { .Month}, { .Day}) or terminate()"" " : End With
End If
If Not CBool(If(IsSingleObjectDownload, MySettings.UseParsedVideoDateSTD, MySettings.UseParsedVideoDate).Value) Then command &= "--no-mtime "
command &= $"{SectionCommand} {URL}"
Return command
End Function
#End Region
#Region "DownloadContent, DownloadFile"
@@ -455,8 +624,16 @@ Namespace API.TikTok
End Function
Protected Overrides Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Using b As New TokenBatch(Token) With {.FileExchanger = RootCacheTikTok}
b.Encoding = BatchExecutor.UnicodeEncoding
If URL.EndsWith(GDL_POSTFIX) Then
ValidateCache()
Dim tmpPath As SFile
With UserCache.NewInstance : .Validate() : tmpPath = .RootDirectory : End With
b.Execute(CreateGDLCommand(URL.Replace(GDL_POSTFIX, String.Empty),, True, tmpPath))
tmpPath = SFile.GetFiles(tmpPath, "*.mp4", IO.SearchOption.AllDirectories, EDP.ReturnValue).FirstOrDefault
If Not tmpPath.IsEmptyString Then SFile.Move(tmpPath, DestinationFile)
Else
b.Execute(CreateYTCommand(DestinationFile, URL, True))
End If
End Using
If DestinationFile.Exists Then Return DestinationFile Else Return Nothing
End Function
@@ -476,7 +653,6 @@ Namespace API.TikTok
t = UTypes.Video
If CBool(MySettings.TitleUseNativeSTD.Value) Then
Using b As New BatchExecutor(True) With {
.Encoding = BatchExecutor.UnicodeEncoding,
.CleanAutomaticallyViaRegEx = True,
.CleanAutomaticallyViaRegExRemoveAllCommands = True
}
@@ -497,11 +673,7 @@ Namespace API.TikTok
Data.Title = defName
Dim dir As SFile
With If(Cache, Settings.Cache).NewInstance() : .Validate() : dir = .RootDirectory : End With
Using b As New GDL.GDLBatch(Token)
b.ChangeDirectory(dir)
b.Encoding = BatchExecutor.UnicodeEncoding
b.Execute(CreateGDLCommand(Data.URL))
End Using
Using b As New GDL.GDLBatch(Token,, dir) : b.Execute(CreateGDLCommand(Data.URL)) : End Using
Dim file As SFile = SFile.GetFiles(dir, "*.txt",, EDP.ReturnValue).FirstOrDefault
If file.Exists Then
Dim r$ = file.GetText(EDP.ReturnValue)

View File

@@ -6,9 +6,17 @@
'
' 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
Namespace API.TikTok
Friend Class UserExchangeOptions
Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase
<PSetting(NameOf(SiteSettings.GetTimeline), NameOf(MySettings))>
Friend Property GetTimeline As Boolean
<PSetting(NameOf(SiteSettings.GetStoriesUser), NameOf(MySettings))>
Friend Property GetStoriesUser As Boolean
<PSetting(NameOf(SiteSettings.GetReposts), NameOf(MySettings))>
Friend Property GetReposts As Boolean
<PSetting(NameOf(SiteSettings.RemoveTagsFromTitle), NameOf(MySettings))>
Friend Property RemoveTagsFromTitle As Boolean
<PSetting(NameOf(SiteSettings.TitleUseNative), NameOf(MySettings))>
@@ -21,9 +29,15 @@ Namespace API.TikTok
Friend Property TitleUseRegexForTitle_Value As String
<PSetting(Caption:="Use global regex", ToolTip:="Use the global regex from the site settings to clean the video title")>
Friend Property TitleUseGlobalRegexOptions As Boolean = True
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property UserName As String
Private ReadOnly MySettings As SiteSettings
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
_ApplyBase_Name = False
MySettings = u.HOST.Source
GetTimeline = u.GetTimeline
GetStoriesUser = u.GetStoriesUser
GetReposts = u.GetReposts
RemoveTagsFromTitle = u.RemoveTagsFromTitle
TitleUseNative = u.TitleUseNative
TitleAddVideoID = u.TitleAddVideoID
@@ -32,12 +46,31 @@ Namespace API.TikTok
TitleUseGlobalRegexOptions = u.TitleUseGlobalRegexOptions
End Sub
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
_ApplyBase_Name = False
MySettings = s
GetTimeline = s.GetTimeline.Value
GetStoriesUser = s.GetStoriesUser.Value
GetReposts = s.GetReposts.Value
RemoveTagsFromTitle = s.RemoveTagsFromTitle.Value
TitleUseNative = s.TitleUseNative.Value
TitleAddVideoID = s.TitleAddVideoID.Value
TitleUseRegexForTitle = s.TitleUseRegexForTitle.Value
TitleUseRegexForTitle_Value = s.TitleUseRegexForTitle_Value.Value
End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u)
With DirectCast(u, UserData)
.GetTimeline = GetTimeline
.GetStoriesUser = GetStoriesUser
.GetReposts = GetReposts
.RemoveTagsFromTitle = RemoveTagsFromTitle
.TitleUseNative = TitleUseNative
.TitleAddVideoID = TitleAddVideoID
.TitleUseRegexForTitle = TitleUseRegexForTitle
.TitleUseRegexForTitle_Value = TitleUseRegexForTitle_Value
.TitleUseGlobalRegexOptions = TitleUseGlobalRegexOptions
End With
End Sub
End Class
End Namespace

View File

@@ -17,6 +17,10 @@ Namespace API.Twitter
Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly StatusRegEx As RParams = RParams.DM(".*?(twitter|x)\.com/\S+/status/\d+", 0, EDP.ReturnValue)
Friend ReadOnly BroadcastsUrls As Object() = {"entities", "urls", 0, "expanded_url"}
Friend ReadOnly RichTextNode As New List(Of String()) From {
{{"content", "itemContent", "tweet_results", "result", "note_tweet", "note_tweet_results", "result", "text"}},
{{"item", "itemContent", "tweet_results", "result", "note_tweet", "note_tweet_results", "result", "text"}}
}
Friend ReadOnly GdlLimitRegEx As RParams = RParams.DM("Waiting until[\s\W\d\:]+\(rate limit\)", 0, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly GdlPostCoutNumberNodes As String() = {"data", "user", "result", "legacy", "statuses_count"}
Private Function GetDateProvider() As ADateTime

View File

@@ -50,6 +50,10 @@ Namespace API.Twitter
Caption:="Force apply",
ToolTip:="Force overrides the default parameters for the first download." & vbCr & "Applies to first download only.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelForceApply As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Large profile",
ToolTip:="This setting is only used on the first download and is intended to temporarily override the default site settings if they are incompatible with downloading large profiles. After the first download is complete, this option will be disabled and cannot be enabled again.")>
Friend Overridable Property LargeProfile As Boolean = False
Private ReadOnly Property MySettings As Object
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
@@ -61,13 +65,6 @@ Namespace API.Twitter
MediaModelAllowNonUserTweets = s.MediaModelAllowNonUserTweets.Value
MySettings = s
End Sub
Friend Sub New(ByVal s As Mastodon.SiteSettings)
GifsDownload = s.GifsDownload.Value
GifsSpecialFolder = s.GifsSpecialFolder.Value
GifsPrefix = s.GifsPrefix.Value
UseMD5Comparison = s.UseMD5Comparison.Value
MySettings = s
End Sub
Friend Sub New(ByVal u As UserData)
MyBase.New(u)
GifsDownload = u.GifsDownload
@@ -76,7 +73,7 @@ Namespace API.Twitter
UseMD5Comparison = u.UseMD5Comparison
RemoveExistingDuplicates = u.RemoveExistingDuplicates
MediaModelAllowNonUserTweets = u.MediaModelAllowNonUserTweets
If Not TypeOf u Is Mastodon.UserData Then
LargeProfile = u.LargeProfile
DownloadModelForceApply = u.DownloadModelForceApply
DownloadBroadcasts = u.DownloadBroadcasts
Dim dm As DModels() = EnumExtract(Of DModels)(u.DownloadModel)
@@ -86,7 +83,6 @@ Namespace API.Twitter
DownloadModelSearch = dm.Contains(DModels.Search)
DownloadModelLikes = dm.Contains(DModels.Likes)
End If
End If
MySettings = u.HOST.Source
End Sub
End Class

View File

@@ -38,6 +38,7 @@ Namespace API.Twitter
Private Const CAT_DOWN As String = "Downloading"
#End Region
#Region "Auth"
Friend Property CookiesUpdateForce As Boolean = False
<PropertyOption(ControlText:="Update cookies", ControlToolTip:="Update cookies during requests", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property CookiesUpdate As PropertyValue
<PropertyOption(ControlText:="Use UserAgent", ControlToolTip:="Use UserAgent in requests", IsAuth:=True), PXML, PClonable>
@@ -45,9 +46,9 @@ Namespace API.Twitter
<PropertyOption(ControlText:="UserAgent", IsAuth:=True, AllowNull:=True, InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent),
PXML("UserAgent", OnlyForChecked:=True), PClonable>
Private ReadOnly Property UserAgentXML As PropertyValue
Friend ReadOnly Property UserAgent As String
Friend ReadOnly Property UserAgent(Optional ByVal Force As Boolean = False) As String
Get
If CBool(UserAgentUse.Value) AndAlso Not CStr(UserAgentXML.Value).IsEmptyString Then
If (CBool(UserAgentUse.Value) Or Force) AndAlso Not CStr(UserAgentXML.Value).IsEmptyString Then
Return UserAgentXML.Value
Else
Return String.Empty
@@ -73,6 +74,7 @@ Namespace API.Twitter
#Region "Limits"
Friend Const TimerDisabled As Integer = -1
Friend Const TimerFirstUseTheSame As Integer = -2
Friend Const TimerDefault As Integer = 20
<PropertyOption(ControlText:="Abort on limit", ControlToolTip:="Abort twitter downloading when limit is reached", Category:=CAT_DOWN), PXML, PClonable>
Friend Property AbortOnLimit As PropertyValue
<PropertyOption(ControlText:="Download already parsed", ControlToolTip:="Download already parsed content on abort", Category:=CAT_DOWN), PXML, PClonable>
@@ -143,6 +145,7 @@ Namespace API.Twitter
End Property
#End Region
#Region "Initializer"
Private Const SettingsVersionCurrent As Integer = 1
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New(TwitterSite, "x.com", AccName, Temp, My.Resources.SiteResources.TwitterIcon_32, My.Resources.SiteResources.TwitterIcon_32.ToBitmap)
@@ -153,7 +156,7 @@ Namespace API.Twitter
.Cookies.Changed = False
End With
UseNewIconXML = New PropertyValue(False)
UseNewIconXML = New PropertyValue(True)
CookiesUpdate = New PropertyValue(False)
UserAgentUse = New PropertyValue(True)
@@ -192,6 +195,10 @@ Namespace API.Twitter
UseNetscapeCookies = True
End Sub
Friend Overrides Sub EndInit()
If Not SettingsVersion.Value = SettingsVersionCurrent Then
UseNewIconXML.Value = True
SettingsVersion.Value = SettingsVersionCurrent
End If
UpdateIcon()
MyBase.EndInit()
End Sub
@@ -223,7 +230,7 @@ Namespace API.Twitter
End Sub
Friend Overrides Sub DownloadDone(ByVal What As ISiteSettings.Download)
If UserNumber > 0 Then
If CBool(CookiesUpdate.Value) Then
If CBool(CookiesUpdate.Value) Or CookiesUpdateForce Then
With CookieKeeper.ParseNetscapeText(CookiesNetscapeFile.GetText(EDP.ReturnValue), EDP.ReturnValue)
If .ListExists Then
Responser.Cookies.Clear()
@@ -250,6 +257,7 @@ Namespace API.Twitter
End With
End If
LIMIT_ABORT = False
CookiesUpdateForce = False
MyBase.DownloadDone(What)
End Sub
#End Region

View File

@@ -30,6 +30,7 @@ Namespace API.Twitter
Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder"
Private Const Name_GifsPrefix As String = "GifsPrefix"
Private Const Name_IsCommunity As String = "IsCommunity"
Private Const Name_LargeProfile As String = "LargeProfile"
Private Const Name_DownloadModelChanged As String = "DownloadModelChanged"
#End Region
#Region "Declarations"
@@ -62,6 +63,47 @@ Namespace API.Twitter
Friend Property GifsSpecialFolder As String = String.Empty
Friend Property GifsPrefix As String = String.Empty
Friend Property IsCommunity As Boolean = False
#Region "LargeProfile"
Friend Property LargeProfile As Boolean = False
Private ReadOnly Property LargeProfileOverride As Boolean
Get
Return LargeProfile And Not FirstDownloadComplete
End Get
End Property
Private ReadOnly Property CookiesUpdate As Boolean
Get
If LargeProfileOverride Then
MySettings.CookiesUpdateForce = True
Return True
Else
Return MySettings.CookiesUpdate.Value
End If
End Get
End Property
Private ReadOnly Property UserAgent As String
Get
If LargeProfileOverride Then
Return MySettings.UserAgent(True).IfNullOrEmpty(Settings.UserAgent)
Else
Return MySettings.UserAgent
End If
End Get
End Property
Private ReadOnly Property SleepTimerBeforeFirst As Integer
Get
Dim v% = MySettings.SleepTimerBeforeFirst.Value
If LargeProfileOverride And v <= 0 And v <> SiteSettings.TimerFirstUseTheSame Then v = SiteSettings.TimerFirstUseTheSame
Return v
End Get
End Property
Private ReadOnly Property SleepTimer As Integer
Get
Dim v% = MySettings.SleepTimer.Value
If LargeProfileOverride And v <= 0 Then v = SiteSettings.TimerDefault
Return v
End Get
End Property
#End Region
Private ReadOnly LikesPosts As List(Of String)
Private ReadOnly PostsKV As List(Of PKV)
Private ReadOnly _DataNames As List(Of String)
@@ -70,14 +112,6 @@ Namespace API.Twitter
Return HOST.Source
End Get
End Property
Private FileNameProvider As ANumbers = Nothing
Private Sub ResetFileNameProvider(Optional ByVal GroupSize As Integer? = Nothing)
FileNameProvider = New ANumbers With {.FormatOptions = ANumbers.Options.FormatNumberGroup + ANumbers.Options.Groups}
FileNameProvider.GroupSize = If(GroupSize, 3)
End Sub
Private Function RenameGdlFile(ByVal Input As SFile, ByVal i As Integer) As SFile
Return SFile.Rename(Input, $"{Input.PathWithSeparator}{i.NumToString(FileNameProvider)}.{Input.Extension}",, EDP.ThrowException)
End Function
Friend Function GetUserUrl() As String
Return $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/{NameTrue}"
End Function
@@ -89,7 +123,7 @@ Namespace API.Twitter
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions)
.ApplyBase(Me)
.Apply(Me)
GifsDownload = .GifsDownload
GifsSpecialFolder = .GifsSpecialFolder
GifsPrefix = .GifsPrefix
@@ -100,6 +134,7 @@ Namespace API.Twitter
DownloadModelForceApply = .DownloadModelForceApply
MediaModelAllowNonUserTweets = .MediaModelAllowNonUserTweets
DownloadBroadcasts = .DownloadBroadcasts
LargeProfile = .LargeProfile
Dim dModel As DownloadModels = DownloadModel
If .DownloadModelMedia Then DownloadModel += DownloadModels.Media
If .DownloadModelProfile Or .DownloadBroadcasts Then DownloadModel += DownloadModels.Profile
@@ -155,6 +190,7 @@ Namespace API.Twitter
StartMD5Checked = .Value(Name_StartMD5Checked).FromXML(Of Boolean)(False)
MediaModelAllowNonUserTweets = .Value(Name_MediaModelAllowNonUserTweets).FromXML(Of Boolean)(False)
IsCommunity = .Value(Name_IsCommunity).FromXML(Of Boolean)(False)
LargeProfile = .Value(Name_LargeProfile).FromXML(Of Boolean)(False)
Else
If Name.Contains("@") And Not IsCommunity Then
IsCommunity = True
@@ -180,6 +216,7 @@ Namespace API.Twitter
.Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger)
.Add(Name_MediaModelAllowNonUserTweets, MediaModelAllowNonUserTweets.BoolToInteger)
.Add(Name_IsCommunity, IsCommunity.BoolToInteger)
.Add(Name_LargeProfile, LargeProfile.BoolToInteger)
.Add(Name_TrueName, NameTrue(True))
End If
End With
@@ -260,10 +297,17 @@ Namespace API.Twitter
Private Const DEBUG_PROFILE As Boolean = False
Private Const DEBUG_LEAVE_CACHE As Boolean = False
Private JsonNullErr As Boolean = False
Private ____UserExists As Boolean = True
Private NotUserExistsAttempts As Integer = 0
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
____UserExists = UserExists
MyBase.DownloadData(Token)
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
GDL_REQUESTS_COUNT = 0
JsonNullErr = False
NotUserExistsAttempts = 0
If MySettings.LIMIT_ABORT Then
Throw New TwitterLimitException(Me)
Else
@@ -280,6 +324,14 @@ Namespace API.Twitter
End If
LikesPosts.Clear()
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
If Not ____UserExists Then
For i% = 0 To 1
NotUserExistsAttempts += 1
DownloadData_Timeline(Token)
If UserExists Then ____UserExists = True : Exit For
Next
End If
If Not UserExists Then Exit Sub
DownloadData_Timeline(Token)
If _TempMediaList.Count = 0 And LikesPosts.Count = 0 And JsonNullErr Then Throw New Plugin.ExitException("No deserialized data found")
LoadSavePostsKV(False)
@@ -329,6 +381,7 @@ Namespace API.Twitter
Dim j As EContainer, rootNode As EContainer, optionalNode As EContainer, workingNode As EContainer, tmpNode As EContainer, nn As EContainer = Nothing
Dim multiMode As Boolean = IsMultiMode
Dim currentModel As DownloadModels = DownloadModels.Undefined
Dim onlyUpdateUser As Boolean = Not ____UserExists
Dim __parseContainer As Func(Of EContainer, Boolean) =
Function(ByVal ee As EContainer) As Boolean
@@ -389,7 +442,7 @@ Namespace API.Twitter
End If
End If
Else
ObtainMedia(nn, PostID, PostDate)
ObtainMedia(nn, PostID, PostDate,,,, ee)
End If
End If
End If
@@ -434,13 +487,14 @@ Namespace API.Twitter
ThrowAny(Token)
Dim timelineFiles As List(Of SFile) = SFile.GetFiles(dir, "*.txt",, EDP.ReturnValue)
If timelineFiles.ListExists Then
ResetFileNameProvider(Math.Max(timelineFiles.Count.ToString.Length, 2))
GDLResetFileNameProvider(Math.Max(timelineFiles.Count.ToString.Length, 2))
'rename files
If Not DEBUG_PROFILE Then
For i = 0 To timelineFiles.Count - 1 : timelineFiles(i) = RenameGdlFile(timelineFiles(i), i) : Next
For i = 0 To timelineFiles.Count - 1 : timelineFiles(i) = GDLRenameFile(timelineFiles(i), i) : Next
End If
'parse files
For i = 0 To timelineFiles.Count - 1
If userInfoParsed And onlyUpdateUser Then Exit Sub
j = JsonDocument.Parse(timelineFiles(i).GetText, jsonArgs)
If jsonArgs.State = WebDocumentEventArgs.States.Error Then
jsonArgs.Reset(Token)
@@ -469,7 +523,7 @@ Namespace API.Twitter
With .ItemF({0, "content", "items", 0, "item", "itemContent", "tweet_results", "result", "tweet", "community_results", "result"})
If .ListExists Then
If ID = .Value("id_str") Then
UserSiteNameUpdate(.Value("name"))
UserSiteNameUpdate(.Value("name"), True)
UserDescriptionUpdate(.Value("description"))
icon = .Value({"custom_banner_media", "media_info"}, "original_img_url").
@@ -487,20 +541,28 @@ Namespace API.Twitter
Else
With j({"data", "user", "result"})
If .ListExists Then
If ID.IsEmptyString Then
ID = .Value("rest_id")
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
If ID.IsEmptyString Then ID = .Value("rest_id")
icon = .Value({"avatar"}, "image_url")
UserSiteNameUpdate(.Value({"core"}, "name"), True)
Dim tScreenName$ = .Value({"core"}, "screen_name")
With .Item({"legacy"})
If .ListExists Then
If .Value("screen_name").StringToLower = NameTrue.ToLower Then
UserSiteNameUpdate(.Value("name"))
If onlyUpdateUser Then
If Not NameTrue = tScreenName Then
Dim uStr$ = $"username changed from '{NameTrue}' to '{tScreenName}'"
LogError(Nothing, uStr)
UserDescriptionUpdate(uStr, True, True, True)
End If
NameTrue = tScreenName
End If
If .Value("screen_name").IfNullOrEmpty(tScreenName).StringToLower = NameTrue.ToLower Then
UserSiteNameUpdate(.Value("name"), True)
UserDescriptionUpdate(.Value("description"))
icon = .Value("profile_image_url_https")
If icon.IsEmptyString Then icon = .Value("profile_image_url_https")
If Not icon.IsEmptyString Then icon = icon.Replace("_normal", String.Empty)
If DownloadIconBanner Then
SimpleDownloadAvatar(.Value("profile_banner_url"), fileCrFunc)
SimpleDownloadAvatar(.Value("profile_banner_url").IfNullOrEmpty(.Value({"legacy"}, "profile_banner_url")), fileCrFunc)
SimpleDownloadAvatar(icon, fileCrFunc)
End If
End If
@@ -618,6 +680,7 @@ nextpIndx:
End If
DownloadModelForceApply = False
FirstDownloadComplete = True
LargeProfile = False
Catch jsonNull_ex As JsonDocumentException When jsonNull_ex.State = WebDocumentEventArgs.States.Error
Throw New Plugin.ExitException("No deserialized data found")
Catch limit_ex As TwitterLimitException
@@ -632,17 +695,17 @@ nextpIndx:
End Sub
Private Sub DownloadData_SavedPosts(ByVal Token As CancellationToken)
Try
Dim f As SFile = GetDataFromGalleryDL("https://x.com/i/bookmarks", Settings.Cache, True, Token)
Dim f As SFile = GetDataFromGalleryDL("https://x.com/i/history", Settings.Cache, True, Token)
Dim files As List(Of SFile) = SFile.GetFiles(f, "*.txt")
If files.ListExists Then
ResetFileNameProvider(Math.Max(files.Count.ToString.Length, 3))
GDLResetFileNameProvider(Math.Max(files.Count.ToString.Length, 3))
Dim id$
Dim nodes As List(Of String()) = GetContainerSubnodes()
Dim node$()
Dim j As EContainer, jj As EContainer
Dim jErr As New ErrorsDescriber(EDP.ReturnValue)
For i% = 0 To files.Count - 1
f = RenameGdlFile(files(i), i)
f = GDLRenameFile(files(i), i)
j = JsonDocument.Parse(f.GetText, jErr)
If Not j Is Nothing Then
With j.ItemF({"data", 0, "timeline", "instructions", 0, "entries"})
@@ -654,7 +717,7 @@ nextpIndx:
With jj(node)
If .ListExists Then
id = .Value("id_str")
If _TempPostsList.Contains(id) Then j.Dispose() : Exit Sub Else ObtainMedia(.Self, id, .Value("created_at"))
If _TempPostsList.Contains(id) Then j.Dispose() : Exit Sub Else ObtainMedia(.Self, id, .Value("created_at"),,,, jj)
Exit For
End If
End With
@@ -675,11 +738,27 @@ nextpIndx:
#End Region
#Region "Obtain media"
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0, Optional ByVal SpecialFolder As String = Nothing)
Optional ByVal Attempts As Integer = 0, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal RootElem As EContainer = Nothing)
Dim s As EContainer = e({"extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status", "extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"})
Dim txt$ = If(DownloadText, e.Value("full_text"), String.Empty)
Dim txt$ = String.Empty
If DownloadText Then
txt = e.Value("full_text")
If RootElem.ListExists Then
For Each n As String() In RichTextNode
With RootElem(n)
If Not .Self Is Nothing AndAlso Not .Value.IsEmptyString Then
If Not txt.IsEmptyString AndAlso .Value.Contains(txt) Then txt = String.Empty
If txt.IsEmptyString Then txt = .Value Else txt = $"{ .Value}{vbCr}{vbCr}----{vbCr}{vbCr}{txt}"
Exit For
End If
End With
Next
End If
End If
Dim mUrl$
Dim media As UserMedia
@@ -808,10 +887,25 @@ nextpIndx:
Private Class TwitterGDL : Inherits GDL.GDLBatch
Private ReadOnly KillOnLimit As Boolean
Friend LimitReached As Boolean = False
Private _GetOnlyUserInfo As Boolean = False
Friend Overrides Property MyWorkingDirectory As SFile
Get
Return If(MyBase.MyWorkingDirectory.IsEmptyString, If(FileExchanger?.RootDirectory, MyBase.MyWorkingDirectory), MyBase.MyWorkingDirectory)
End Get
Set(ByVal dir As SFile)
MyBase.MyWorkingDirectory = dir
End Set
End Property
Friend Property GetOnlyUserInfo As Boolean
Get
Return _GetOnlyUserInfo And Not MyWorkingDirectory.IsEmptyString
End Get
Set(ByVal __GetOnlyUserInfo As Boolean)
_GetOnlyUserInfo = __GetOnlyUserInfo
End Set
End Property
Friend Sub New(ByVal Dir As SFile, ByVal _Token As CancellationToken, ByVal _KillOnLimit As Boolean)
MyBase.New(_Token)
Commands.Clear()
If Not Dir.IsEmptyString Then ChangeDirectory(Dir)
MyBase.New(_Token,, Dir)
KillOnLimit = _KillOnLimit
End Sub
Protected Overrides Async Function Validate(ByVal Value As String) As Task
@@ -819,11 +913,15 @@ nextpIndx:
End Function
Private Function IdExists(ByVal Value As String) As Boolean
Try
If GetOnlyUserInfo Then
Return CheckForData()
Else
Value = Value.StringTrim
If Not Value.IsEmptyString AndAlso (Value.StartsWith("*") Or Value.StartsWith(".\gallery-dl\")) Then
Dim id$ = Value.Split("\").Last.Split(".").First.Split("_").First
If Not id.IsEmptyString Then Return TempPostsList.Contains(id)
End If
End If
Catch ex As Exception
End Try
Return False
@@ -831,8 +929,14 @@ nextpIndx:
Protected Overrides Async Sub ErrorDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
Await Task.Run(Sub() CheckForLimit(e.Data))
End Sub
Private Function CheckForData()
If GetOnlyUserInfo Then
If SFile.GetFiles(MyWorkingDirectory, "*.txt",, EDP.ReturnValue).Count > 2 Then Return True
End If
Return False
End Function
Private Sub CheckForLimit(ByVal Value As String)
If Token.IsCancellationRequested Or (KillOnLimit AndAlso Not ProcessKilled AndAlso
If CheckForData() Or Token.IsCancellationRequested Or (KillOnLimit AndAlso Not ProcessKilled AndAlso
Not Value.IsEmptyString AndAlso (Value.ToLower.Contains("for rate limit reset") OrElse
Not CStr(RegexReplace(Value, GdlLimitRegEx)).IsEmptyString)) Then
LimitReached = True
@@ -842,8 +946,8 @@ nextpIndx:
End Class
Private ReadOnly Property SleepTimerValue(ByVal First As Boolean) As Integer
Get
Dim fTimer% = If(First, MySettings.SleepTimerBeforeFirst, MySettings.SleepTimer).Value
If First And fTimer = SiteSettings.TimerFirstUseTheSame Then fTimer = MySettings.SleepTimer.Value
Dim fTimer% = If(First, SleepTimerBeforeFirst, SleepTimer)
If First And fTimer = SiteSettings.TimerFirstUseTheSame Then fTimer = SleepTimer
Return fTimer
End Get
End Property
@@ -981,11 +1085,12 @@ nextpIndx:
.AutoClear = True,
.AutoReset = True,
.CommandPermanent = $"chcp {BatchExecutor.UnicodeEncoding}",
.FileExchanger = confCache
.FileExchanger = confCache,
.GetOnlyUserInfo = NotUserExistsAttempts > 0
}
tgdl.FileExchanger.DeleteCacheOnDispose = False
tgdl.FileExchanger.DeleteRootOnDispose = False
For i As Byte = 0 To IIf(IsCommunity, 0, 3)
For i As Byte = 0 To IIf(IsCommunity Or NotUserExistsAttempts > 0, 0, 3)
dir = rootDir.NewPath
dir.Exists(SFO.Path, True, EDP.ThrowException)
outList.Add(dir)
@@ -996,6 +1101,20 @@ nextpIndx:
Else
command &= GdlGetIdFilterString()
End If
If NotUserExistsAttempts > 0 Then
Select Case NotUserExistsAttempts
Case 1 : command &= $"{urlPrePattern}{NameTrue}/media" : currentModel = DownloadModels.Media : process = True
Case 2
If ID.IsEmptyString Then
process = False
Else
command &= $"https://x.com/intent/user?user_id={ID}"
currentModel = DownloadModels.Media
process = True
End If
Case Else : process = False
End Select
Else
Select Case i
Case 0 : command &= $"{urlPrePattern}{NameTrue}/media" : currentModel = DownloadModels.Media : process = dm.Contains(currentModel) Or IsCommunity
Case 1 : command &= $"{urlPrePattern}{NameTrue}" : currentModel = DownloadModels.Profile : process = dm.Contains(currentModel)
@@ -1003,6 +1122,7 @@ nextpIndx:
Case 3 : command &= $"{urlPrePattern}{NameTrue}/likes" : currentModel = DownloadModels.Likes : process = dm.Contains(currentModel)
Case Else : process = False
End Select
End If
'#If DEBUG Then
'Debug.WriteLine(command)
'#End If
@@ -1063,10 +1183,10 @@ nextpIndx:
Private Function GdlCreateConf(ByVal Path As SFile) As SFile
Try
Dim conf As SFile = $"{Path.PathWithSeparator}TwitterGdlConfig.conf"
Dim __userAgent$ = MySettings.UserAgent
Dim __userAgent$ = UserAgent
If Not __userAgent.IsEmptyString Then __userAgent = $"""user-agent"": ""{__userAgent}"","
Dim confText$ = "{""extractor"":{""cookies"": """ & MySettings.CookiesNetscapeFile.ToString.Replace("\", "/") &
$""",""cookies-update"": {IIf(CBool(MySettings.CookiesUpdate.Value), "true", "false")}," & __userAgent &
$""",""cookies-update"": {IIf(CookiesUpdate, "true", "false")}," & __userAgent &
"""twitter"":{""tweet-endpoint"": ""detail"",""cards"": false,""conversations"": true,""pinned"": false,""quoted"": false,""replies"": true,""retweets"": true,""strategy"": null,""text-tweets"": false,""twitpic"": false,""unique"": true,""users"": ""timeline"",""videos"": true}}}"
If conf.Exists(SFO.Path, True, EDP.ThrowException) Then TextSaver.SaveTextToFile(confText, conf)
If Not conf.Exists Then Throw New IO.FileNotFoundException("Can't find Twitter GDL config file", conf)
@@ -1086,17 +1206,19 @@ nextpIndx:
Dim cache As CacheKeeper = Nothing
Try
If ContentMissingExists Or (_ReparseLikes And LikesPosts.Count > 0) Then
Const __entries$ = "entries"
Dim m As UserMedia, mTmp As UserMedia
Dim PostDate$
Dim nodes As List(Of String()) = GetContainerSubnodes()
Dim node$()
Dim entriesNode As Predicate(Of EContainer) = Function(ee) ee.Contains(__entries)
Dim j As EContainer, n As EContainer
Dim f As SFile
Dim i%, ii%
Dim files As List(Of SFile)
Dim lim%
Dim specFolder$ = IIf(_ReparseLikes, "Likes", String.Empty)
ResetFileNameProvider()
GDLResetFileNameProvider()
cache = If(IsSingleObjectDownload, Settings.Cache, CreateCache())
If _ReparseLikes Then lim = LikesPosts.Count Else lim = _ContentList.Count
ProgressPre.ChangeMax(lim)
@@ -1122,10 +1244,10 @@ nextpIndx:
files = SFile.GetFiles(f, "*.txt")
If files.ListExists Then
For ii = 0 To files.Count - 1
f = RenameGdlFile(files(ii), ii)
f = GDLRenameFile(files(ii), ii)
j = JsonDocument.Parse(f.GetText)
If Not j Is Nothing Then
With j.ItemF({"data", 0, "instructions", 0, "entries"})
With j.ItemF({"data", 0, "instructions", entriesNode, __entries})
If .ListExists Then
If IsSingleObjectDownload Or DownloadBroadcasts Then
mTmp = ExtractBroadcast(.Self, m.Post.ID, String.Empty, nodes)
@@ -1140,7 +1262,7 @@ nextpIndx:
If .ListExists Then
PostDate = String.Empty
If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts, specFolder)
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts, specFolder, n)
rList.ListAddValue(i, LNC)
End If
End With

View File

@@ -50,6 +50,7 @@ Namespace API.XVIDEOS
_SubscriptionsAllowed = True
UrlPatternUser = "https://xvideos.com/{0}"
UserOptionsType = GetType(EditorExchangeOptionsBase_P)
End Sub
Friend Overrides Sub EndInit()
Domains.PopulateInitialDomains(SiteDomains.Value)
@@ -152,14 +153,6 @@ Namespace API.XVIDEOS
Return Nothing
End Function
#End Region
#Region "UserOptions"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions
If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
End Sub
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _Domains.Dispose()

View File

@@ -15,7 +15,7 @@ Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.XVIDEOS
Friend Class UserData : Inherits UserDataBase
Friend Class UserData : Inherits UserDataBase : Implements IPSite
#Region "XML names"
Private Const Name_PersonType As String = "PersonType"
#End Region
@@ -62,7 +62,7 @@ Namespace API.XVIDEOS
Return {SearchRequestLabelName}
End Get
End Property
Friend Property QueryString As String
Friend Property QueryString As String Implements IPSite.QueryString
Get
If SiteMode = SiteModes.User Then
Return String.Empty
@@ -82,10 +82,10 @@ Namespace API.XVIDEOS
#End Region
#Region "Load"
Friend Overrides Function ExchangeOptionsGet() As Object
Return New UserExchangeOptions(Me)
Return New EditorExchangeOptionsBase_P(Me)
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then QueryString = DirectCast(Obj, UserExchangeOptions).QueryString
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptionsBase_P Then DirectCast(Obj, EditorExchangeOptionsBase_P).Apply(Me)
End Sub
Private Function UpdateUserOptions(Optional ByVal Force As Boolean = False, Optional ByVal NewUrl As String = Nothing) As Boolean
If Not Force OrElse (Not SiteMode = SiteModes.User AndAlso Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then

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