Compare commits

...

11 Commits

Author SHA1 Message Date
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
124 changed files with 4158 additions and 2403 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 ## General questions
- **PROFILES** - **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)! - 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.** - 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 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. - 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.* *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** - **META** (**Instagram**, Threads, Facebook): you need **cookies** and fill in **all fields**
- **Instagram [TIPS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram-tips)** - **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. - **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**! - Porn sites: **COOKIES**!
- ThisVid: https://github.com/AAndyProgram/SCrawler/wiki/Settings#thisvid-faq - 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)) - **JustForFans**: **THE VIDEO ISN'T DOWNLOADING AT THE MOMENT** ([Issue](https://discord.com/channels/1124032649682493462/1205547615199039551/1231349555132366870))
## Other questions ## Other questions

View File

@@ -8,3 +8,4 @@ List of available plugins:
Tools: Tools:
- [image2post](https://github.com/unknown81311/SCrawler-image2post) by @unknown81311: **get reddit post URL from file.** - [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 🏳️‍🌈 # 🏳️‍🌈 Social networks crawler 🏳️‍🌈
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest) [![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
@@ -41,14 +40,11 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- Bluesky images and videos, text; - Bluesky images and videos, text;
- OnlyFans images and videos, text, saved (bookmarked) posts, stories; - OnlyFans images and videos, text, saved (bookmarked) posts, stories;
- JustForFans images and videos, saved (bookmarked) posts; - JustForFans images and videos, saved (bookmarked) posts;
- Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, text, tagged posts, stories, saved posts; - Instagram images and videos, text, tagged posts, stories, saved posts;
- Threads images and videos, text, saved posts; - Threads images and videos, text, saved posts;
- Facebook images and videos, stories, saved posts; - Facebook images and videos, stories, saved posts;
- TikTok images and videos; - TikTok images and videos;
- Pinterest boards, users, saved posts; - Pinterest boards, users, saved posts;
- Imgur images, galleries and videos;
- Gfycat videos;
- PornHub images, videos, save (liked) posts, search queries, search categories; - PornHub images, videos, save (liked) posts, search queries, search categories;
- XHamster images, videos, saved posts, search queries, search categories, search tags; - XHamster images, videos, saved posts, search queries, search categories, search tags;
- XVIDEOS videos, saved posts, search queries, search categories; - 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** - **Threads**
- **Facebook** - **Facebook**
- JustForFans *(partial support) ([video issue](https://discord.com/channels/1124032649682493462/1205547615199039551/1231349555132366870))*[^1] - JustForFans *(partial support) ([video issue](https://discord.com/channels/1124032649682493462/1205547615199039551/1231349555132366870))*[^1]
- Mastodon *(out of support)*
- TikTok - TikTok
- RedGifs - RedGifs
- Pinterest - Pinterest
- Imgur *(out of support)*
- Gfycat
- LPSG - LPSG
- **PornHub** - **PornHub**
- **XHamster** - **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) - [Twitter](https://github.com/AAndyProgram/SCrawler/wiki/Settings#twitter)
- [Bluesky](https://github.com/AAndyProgram/SCrawler/wiki/Settings#bluesky) - [Bluesky](https://github.com/AAndyProgram/SCrawler/wiki/Settings#bluesky)
- [OnlyFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans) - [OnlyFans](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans)
- [Mastodon](https://github.com/AAndyProgram/SCrawler/wiki/Settings#mastodon)
- [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram) - [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram)
- [Threads](https://github.com/AAndyProgram/SCrawler/wiki/Settings#threads) - [Threads](https://github.com/AAndyProgram/SCrawler/wiki/Settings#threads)
- [Facebook](https://github.com/AAndyProgram/SCrawler/wiki/Settings#facebook) - [Facebook](https://github.com/AAndyProgram/SCrawler/wiki/Settings#facebook)

View File

@@ -113,6 +113,51 @@ Namespace API.YouTube.Base
Return Protocols.Undefined Return Protocols.Undefined
End Get End Get
End Property 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 URL As String
Public Property Index As Integer Implements IIndexable.Index Public Property Index As Integer Implements IIndexable.Index
Private Function SetIndex(ByVal Obj As Object, ByVal Index As Integer) As Object Implements IIndexable.SetIndex Private Function SetIndex(ByVal Obj As Object, ByVal Index As Integer) As Object Implements IIndexable.SetIndex

View File

@@ -268,6 +268,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"Defaults"}, FileDateMode.None), Category("Defaults"), DisplayName("Add channel to file name"), <Browsable(True), GridVisible, XMLVN({"Defaults"}, FileDateMode.None), Category("Defaults"), DisplayName("Add channel to file name"),
Description("Add channel name before/after the file name")> Description("Add channel name before/after the file name")>
Public ReadOnly Property FileAddChannelToFileName As XMLValue(Of FileDateMode) 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 #End Region
#Region "Defaults ChannelsDownload" #Region "Defaults ChannelsDownload"
<Browsable(True), GridVisible, XMLVN({"Defaults", "Channels"}), Category("Defaults"), DisplayName("Default download tabs for channels"), <Browsable(True), GridVisible, XMLVN({"Defaults", "Channels"}), Category("Defaults"), DisplayName("Default download tabs for channels"),
@@ -410,6 +413,15 @@ Namespace API.YouTube.Base
Private Function AvailableAudioFormats_Impl() As String() Private Function AvailableAudioFormats_Impl() As String()
Return AvailableAudioFormats Return AvailableAudioFormats
End Function 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"), <Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, "MP3"), Category("Defaults Audio"), DisplayName("Default codec for music"),
TypeConverter(GetType(FieldsTypeConverter)), GridStandardValuesProvider(NameOf(AvailableAudioFormats_Impl)), TypeConverter(GetType(FieldsTypeConverter)), GridStandardValuesProvider(NameOf(AvailableAudioFormats_Impl)),
Description("The default audio format for downloading music.")> Description("The default audio format for downloading music.")>
@@ -498,6 +510,9 @@ Namespace API.YouTube.Base
TypeConverter(GetType(ValueCollectionConverter)), 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.")> 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) 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 #End Region
#Region "Trim" #Region "Trim"
<Browsable(True), GridVisible, XMLVN({"DefaultsTrim"}, False), Category("Defaults Trimming"), DisplayName("Delete original file"), <Browsable(True), GridVisible, XMLVN({"DefaultsTrim"}, False), Category("Defaults Trimming"), DisplayName("Delete original file"),

View File

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

View File

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

View File

@@ -8,10 +8,14 @@
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.ComponentModel Imports System.ComponentModel
Imports SCrawler.API.YouTube.Base Imports SCrawler.API.YouTube.Base
Imports SCrawler.API.YouTube.Objects
Imports UMTypes = SCrawler.Plugin.UserMediaTypes
Namespace API.YouTube.Controls Namespace API.YouTube.Controls
<DefaultEvent("CheckedChanged"), DesignTimeVisible(False), ToolboxItem(False)> <DefaultEvent("CheckedChanged"), DesignTimeVisible(False), ToolboxItem(False)>
Friend Class VideoOption : Implements ISupportInitialize Friend Class VideoOption : Implements ISupportInitialize
Friend Event CheckedChanged As EventHandler 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 MyMedia As MediaObject
<Browsable(False)> Friend Property Checked As Boolean <Browsable(False)> Friend Property Checked As Boolean
Get Get
@@ -21,16 +25,43 @@ Namespace API.YouTube.Controls
OPT_CHECKED.Checked = _Checked OPT_CHECKED.Checked = _Checked
End Set End Set
End Property 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() Friend Sub New()
InitializeComponent() InitializeComponent()
End Sub End Sub
Friend Sub New(ByVal m As MediaObject, Optional ByVal SelectedAudio As MediaObject = Nothing) Friend Sub New(ByVal m As MediaObject, Optional ByVal SelectedAudio As MediaObject = Nothing)
Me.New Me.New
Const d$ = " " & ChrW(183) & " "
Const DRC$ = Objects.YouTubeMediaContainerBase.DRC
MyMedia = m MyMedia = m
If m.Type = Plugin.UserMediaTypes.Audio Then 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" LBL_DEFINITION_INFO.Text = "High Quality"
ElseIf m.Bitrate >= 190 Then ElseIf m.Bitrate >= 190 Then
LBL_DEFINITION_INFO.Text = "Medium Quality" LBL_DEFINITION_INFO.Text = "Medium Quality"
@@ -38,8 +69,8 @@ Namespace API.YouTube.Controls
LBL_DEFINITION_INFO.Text = "Low Quality" LBL_DEFINITION_INFO.Text = "Low Quality"
End If End If
LBL_DEFINITION.Text = $"{m.Bitrate}k" LBL_DEFINITION.Text = $"{m.Bitrate}k"
LBL_CODECS.Text = $"{m.Extension} {d} {m.Codec} {d} {m.Bitrate}k" '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" 'If Not m.ID.IsEmptyString AndAlso m.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $" {d} DRC"
Else Else
If m.Height >= 1440 Then If m.Height >= 1440 Then
LBL_DEFINITION_INFO.Text = "Ultra High Definition" LBL_DEFINITION_INFO.Text = "Ultra High Definition"
@@ -53,11 +84,13 @@ Namespace API.YouTube.Controls
LBL_DEFINITION_INFO.Text = "Low Definition" LBL_DEFINITION_INFO.Text = "Low Definition"
End If End If
LBL_DEFINITION.Text = $"{m.Height}p" LBL_DEFINITION.Text = $"{m.Height}p"
LBL_CODECS.Text = $"{m.Extension.StringToUpper}{d}{m.Codec.StringToUpper}{d}{m.FPS}fps{d}{m.Bitrate}k" '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.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 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" 'With SelectedAudio
If Not SelectedAudio.ID.IsEmptyString AndAlso SelectedAudio.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC" ' 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 _ If MyYouTubeSettings.DefaultVideoHighlightFPS_H > 0 AndAlso m.FPS > MyYouTubeSettings.DefaultVideoHighlightFPS_H Then _
BackColor = MyColor.DeleteBack : ForeColor = MyColor.DeleteFore BackColor = MyColor.DeleteBack : ForeColor = MyColor.DeleteFore
@@ -65,6 +98,8 @@ Namespace API.YouTube.Controls
BackColor = MyColor.UpdateBack : ForeColor = MyColor.UpdateFore BackColor = MyColor.UpdateBack : ForeColor = MyColor.UpdateFore
End If End If
GenerateInfoCaption(SelectedAudio)
Dim sv% = m.Size / 1024 Dim sv% = m.Size / 1024
If sv >= 1000 Then If sv >= 1000 Then
LBL_SIZE.Text = AConvert(Of String)(sv / 1024, VideoSizeProvider) LBL_SIZE.Text = AConvert(Of String)(sv / 1024, VideoSizeProvider)
@@ -74,9 +109,36 @@ Namespace API.YouTube.Controls
LBL_SIZE.Text &= " MB" LBL_SIZE.Text &= " MB"
End If End If
End Sub 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 Private Sub OPT_CHECKED_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_CHECKED.CheckedChanged
RaiseEvent CheckedChanged(Me, e) RaiseEvent CheckedChanged(Me, e)
End Sub 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 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 OPT_CHECKED.Checked = True
End Sub End Sub

View File

@@ -20,6 +20,7 @@ Imports UMTypes = SCrawler.Plugin.UserMediaTypes
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Namespace API.YouTube.Controls Namespace API.YouTube.Controls
Friend Class VideoOptionsForm : Implements IDesignXMLContainer Friend Class VideoOptionsForm : Implements IDesignXMLContainer
Friend Event AudioIndexChanged As EventHandler
#Region "Declarations" #Region "Declarations"
Private MyView As FormView Private MyView As FormView
Private ReadOnly MyFieldsChecker As FieldsChecker Private ReadOnly MyFieldsChecker As FieldsChecker
@@ -29,6 +30,7 @@ Namespace API.YouTube.Controls
Private Const ControlsRow As Integer = 7 Private Const ControlsRow As Integer = 7
Private ReadOnly Property CNT_PROCESSOR As TableControlsProcessor Private ReadOnly Property CNT_PROCESSOR As TableControlsProcessor
Friend Property MyContainer As YouTubeMediaContainerBase Friend Property MyContainer As YouTubeMediaContainerBase
Private ReadOnly AVControls As List(Of VideoOption)
Private Initialization As Boolean = True Private Initialization As Boolean = True
Private ReadOnly InheritsFromContainer As Boolean Private ReadOnly InheritsFromContainer As Boolean
Private ReadOnly M3U8Files As List(Of SFile) Private ReadOnly M3U8Files As List(Of SFile)
@@ -63,6 +65,7 @@ Namespace API.YouTube.Controls
InitializeComponent() InitializeComponent()
M3U8Files = New List(Of SFile) M3U8Files = New List(Of SFile)
MyContainer = Container MyContainer = Container
AVControls = New List(Of VideoOption)
CNT_PROCESSOR = New TableControlsProcessor(TP_CONTROLS) CNT_PROCESSOR = New TableControlsProcessor(TP_CONTROLS)
Me.InheritsFromContainer = InheritsFromContainer Me.InheritsFromContainer = InheritsFromContainer
MyFieldsChecker = New FieldsChecker MyFieldsChecker = New FieldsChecker
@@ -137,6 +140,19 @@ Namespace API.YouTube.Controls
End If End If
CMB_FORMAT.Enabled = OPT_VIDEO.Checked 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 arr = AvailableVideoFormats
CMB_FORMAT.Items.AddRange(arr) CMB_FORMAT.Items.AddRange(arr)
If InheritsFromContainer Then If InheritsFromContainer Then
@@ -197,6 +213,7 @@ Namespace API.YouTube.Controls
MyView.DisposeIfReady() MyView.DisposeIfReady()
MyFieldsChecker.DisposeIfReady() MyFieldsChecker.DisposeIfReady()
M3U8Files.Clear() M3U8Files.Clear()
AVControls.ListClearDispose
End Sub End Sub
#End Region #End Region
#Region "Refill" #Region "Refill"
@@ -205,6 +222,7 @@ Namespace API.YouTube.Controls
Dim h% = -1 Dim h% = -1
Dim rh% = IIf(MyContainer.HasElements, 60, 25) Dim rh% = IIf(MyContainer.HasElements, 60, 25)
Dim s As New Size(Width, h) Dim s As New Size(Width, h)
Dim codecW% = 0
Dim CalculateSize As Action(Of Integer) = Dim CalculateSize As Action(Of Integer) =
Sub(ByVal InitHeight As Integer) Sub(ByVal InitHeight As Integer)
With TP_MAIN.RowStyles(ControlsRow) : .SizeType = SizeType.Absolute : .Height = InitHeight : End With 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) Dim __contentType As UMTypes = IIf(OPT_VIDEO.Checked, UMTypes.Video, UMTypes.Audio)
With TP_CONTROLS With TP_CONTROLS
If .Controls.Count > 0 Then 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() .Controls.Clear()
End If End If
.RowStyles.Clear() .RowStyles.Clear()
@@ -226,14 +244,29 @@ Namespace API.YouTube.Controls
With MyContainer With MyContainer
Dim audio As MediaObject = Nothing Dim audio As MediaObject = Nothing
If __contentType = UMTypes.Video Then audio = .SelectedAudio If __contentType = UMTypes.Video Then audio = .SelectedAudio
Dim data As IEnumerable(Of Control) Dim data As IEnumerable(Of Control) = Nothing
If .HasElements Then If .HasElements Then
data = .Elements.Select(Function(ee) New MediaItem(ee, True) With {.Dock = DockStyle.Fill, .Checked = ee.Checked, .UseCookies = UseCookies}) data = .Elements.Select(Function(ee) New MediaItem(ee, True) With {.Dock = DockStyle.Fill, .Checked = ee.Checked, .UseCookies = UseCookies})
Else Else
data = (From m As MediaObject In .Self.MediaObjects If AVControls.Count = 0 Then
Where m.Type = __contentType AVControls.AddRange(From m As MediaObject In .Self.MediaObjects
Select New VideoOption(m, audio) With {.Dock = DockStyle.Fill, .Checked = m.Index = MyContainer.SelectedVideoIndex}) 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 End If
If data.ListExists Then If data.ListExists Then
@@ -299,6 +332,16 @@ Namespace API.YouTube.Controls
End With End With
End If 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 With TP_CONTROLS
.PerformLayout() .PerformLayout()
.Select() .Select()
@@ -319,6 +362,16 @@ Namespace API.YouTube.Controls
Private Sub MediaItem_CheckedChanged(ByVal Sender As MediaItem, ByVal Container As IYouTubeMediaContainer) Private Sub MediaItem_CheckedChanged(ByVal Sender As MediaItem, ByVal Container As IYouTubeMediaContainer)
ControlInvokeFast(TP_CONTROLS, Sub() Container.Checked = Sender.Checked, EDP.None) ControlInvokeFast(TP_CONTROLS, Sub() Container.Checked = Sender.Checked, EDP.None)
End Sub 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) Private Sub MediaItem_BeforeOpenEditor(ByVal Sender As MediaItem, ByVal Container As IYouTubeMediaContainer)
MediaItem_BeforeOpenEditorImpl(Sender, Container, False) MediaItem_BeforeOpenEditorImpl(Sender, Container, False)
End Sub End Sub

View File

@@ -56,7 +56,9 @@ Namespace API.YouTube
Friend ReadOnly TimeToStringProvider As IFormatProvider = New TimeToStringConverter Friend ReadOnly TimeToStringProvider As IFormatProvider = New TimeToStringConverter
Friend ReadOnly TimeToStringProviderH As IFormatProvider = New TimeToStringConverter(True) Friend ReadOnly TimeToStringProviderH As IFormatProvider = New TimeToStringConverter(True)
Friend ReadOnly TitleHtmlConverter As Func(Of String, String) = Function(Input) Input.StringRemoveWinForbiddenSymbols().StringTrim() 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 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) 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, 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) CType(Function(input$) "music.", Func(Of String, String)), String.Empty)
@@ -78,6 +80,16 @@ Namespace API.YouTube
Return f Return f
End If End If
End Function 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 Class TimeToStringConverter : Implements ICustomProvider
Private ReadOnly _Provider As New ADateTime("mm\:ss") With {.TimeParseMode = ADateTime.TimeModes.TimeSpan} 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 _ProviderWithHours As New ADateTime("h\:mm\:ss") With {.TimeParseMode = ADateTime.TimeModes.TimeSpan}

View File

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

View File

@@ -827,6 +827,7 @@ Namespace API.YouTube.Objects
subs = ListAddList(Nothing, Subtitles.Select(Function(s, i) If(SubtitlesSelectedIndexes.Contains(i), s.FullID, String.Empty)), subs = ListAddList(Nothing, Subtitles.Select(Function(s, i) If(SubtitlesSelectedIndexes.Contains(i), s.FullID, String.Empty)),
LAP.NotContainsOnly, EDP.ReturnValue).ListToString(",") LAP.NotContainsOnly, EDP.ReturnValue).ListToString(",")
subs = $"--write-subs --write-auto-subs --sub-format {OutputSubtitlesFormat.StringToLower} --sub-langs ""{subs}"" --convert-subs {OutputSubtitlesFormat.StringToLower}" 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 End If
If Not cmd.IsEmptyString Then If Not cmd.IsEmptyString Then
'2023.3.4 -> 2023.7.6 '2023.3.4 -> 2023.7.6
@@ -950,7 +951,6 @@ Namespace API.YouTube.Objects
Return String.Format(m3u8DataRow, CInt(.Duration.TotalSeconds), fName, __f) Return String.Format(m3u8DataRow, CInt(.Duration.TotalSeconds), fName, __f)
End With End With
End Function End Function
Private ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue)
Public Property Progress As MyProgress Implements IYouTubeMediaContainer.Progress Public Property Progress As MyProgress Implements IYouTubeMediaContainer.Progress
Private Property IDownloadableMedia_Progress As Object Implements IDownloadableMedia.Progress Private Property IDownloadableMedia_Progress As Object Implements IDownloadableMedia.Progress
Get Get
@@ -1190,13 +1190,7 @@ Namespace API.YouTube.Objects
If MediaState = UMStates.Downloaded Or Not Checked Then Exit Sub If MediaState = UMStates.Downloaded Or Not Checked Then Exit Sub
RaiseEvent FileDownloadStarted(Me, Nothing) RaiseEvent FileDownloadStarted(Me, Nothing)
Using batch As New BatchExecutor(True) With {.Encoding = 65001} Using batch As New BatchExecutor(True) With {.Encoding = 65001}
Dim h As DataReceivedEventHandler = Sub(ByVal Sender As Object, ByVal e As DataReceivedEventArgs) Dim h As DataReceivedEventHandler = CreateYtdlpProgressHandler(Progress, Token, batch)
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
With batch With batch
Dim prExists As Boolean = Not Progress Is Nothing Dim prExists As Boolean = Not Progress Is Nothing
If prExists Then If prExists Then
@@ -1458,8 +1452,10 @@ Namespace API.YouTube.Objects
Const trimCommand$ = "ffmpeg -i ""{0}"" -ss {1} -to {2} -c:v copy -c:a copy ""{3}""" Const trimCommand$ = "ffmpeg -i ""{0}"" -ss {1} -to {2} -c:v copy -c:a copy ""{3}"""
Dim trimFirstFile As SFile = Nothing Dim trimFirstFile As SFile = Nothing
Dim trimFirstAdded As Boolean = False Dim trimFirstAdded As Boolean = False
Dim processTrim As Action(Of TrimOption, SFile) = Dim trimSingleReplace As Boolean = TrimOptions.Count = 1 And TrimDeleteOriginalFile
Sub(ByVal opt As TrimOption, ByVal pFile As SFile) 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 Dim fNew As SFile = pFile
fNew.Name &= $"_{opt.Name}" fNew.Name &= $"_{opt.Name}"
If TrimSeparateFolder Then fNew = $"{fNew.PathNoSeparator}\{MyYouTubeSettings.TrimSeparateFolderName.Value.IfNullOrEmpty(YouTubeSettings.TrimSeparateFolderNameDefault)}\{fNew.File}" : fNew.Exists(SFO.Path) If TrimSeparateFolder Then fNew = $"{fNew.PathNoSeparator}\{MyYouTubeSettings.TrimSeparateFolderName.Value.IfNullOrEmpty(YouTubeSettings.TrimSeparateFolderNameDefault)}\{fNew.File}" : fNew.Exists(SFO.Path)
@@ -1471,22 +1467,46 @@ Namespace API.YouTube.Objects
fNew)) fNew))
If fNew.Exists Then If fNew.Exists Then
If trimFirstFile.IsEmptyString Then trimFirstFile = fNew If trimFirstFile.IsEmptyString Then trimFirstFile = fNew
AddFile(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 _ If format = mp3 And MyYouTubeSettings.DefaultAudioEmbedThumbnail_ExtractedFiles Then _
embedThumbTo.Invoke(fNew) : mp3ThumbEmbedded = True embedThumbTo.Invoke(fNew) : mp3ThumbEmbedded = True
If (TrimAddTrimmedFilesToM3U8 Or (TrimDeleteOriginalFile And Not trimFirstAdded)) AndAlso If Not trimSingleReplace AndAlso
(TrimAddTrimmedFilesToM3U8 Or (TrimDeleteOriginalFile And Not trimFirstAdded)) AndAlso
(M3U8_PlaylistFiles.ListExists OrElse (M3U8_PlaylistFiles.ListExists OrElse
(format = mp3 AndAlso MyYouTubeSettings.VideoPlaylist_AddExtractedMP3.Value)) Then _ (format = mp3 AndAlso MyYouTubeSettings.VideoPlaylist_AddExtractedMP3.Value)) Then _
M3U8_Append(fNew) : trimFirstAdded = True M3U8_Append(fNew) : trimFirstAdded = True
End If End If
End Sub End Sub
For Each tr As TrimOption In TrimOptions For Each tr As TrimOption In TrimOptions
processTrim(tr, File) processTrim(tr, File, False)
If audioFiles.Count > 0 Then If audioFiles.Count > 0 Then
For Each f In audioFiles : processTrim(tr, f) : Next For Each f In audioFiles : processTrim(tr, f, True) : Next
End If End If
Next Next
If TrimDeleteOriginalFile Then File.Delete() : File = trimFirstFile 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 If
@@ -1671,6 +1691,7 @@ Namespace API.YouTube.Objects
#End Region #End Region
#Region "Parse" #Region "Parse"
Friend Const DRC As String = "drc" 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, 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 Optional ByVal Token As CancellationToken = Nothing, Optional ByVal Progress As IMyProgress = Nothing) As Boolean Implements IYouTubeMediaContainer.Parse
Try Try
@@ -1716,12 +1737,20 @@ Namespace API.YouTube.Objects
If Not tmpPls.IsEmptyString Then PlaylistTitle = tmpPls If Not tmpPls.IsEmptyString Then PlaylistTitle = tmpPls
End If End If
Dim tmpTitle$
UserID = .Value("uploader_id") UserID = .Value("uploader_id")
UserTitle = TitleHtmlConverter.Invoke(.Value("uploader")) UserTitle = TitleHtmlConverter.Invoke(.Value("uploader"))
If Not UserTitle.IsEmptyString Then 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 If Not tmpTitle.IsEmptyString Then UserTitle = tmpTitle
End If 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, Dim ext$ = IIf(IsMusic,
MyYouTubeSettings.DefaultAudioCodecMusic.Value.StringToLower, MyYouTubeSettings.DefaultAudioCodecMusic.Value.StringToLower,
@@ -1815,7 +1844,6 @@ Namespace API.YouTube.Objects
Return _Exists Return _Exists
End Function End Function
Protected Sub ParseFormats(ByVal e As EContainer) Protected Sub ParseFormats(ByVal e As EContainer)
Const av As UMTypes = UMTypes.Audio + UMTypes.Video
If If(e({"formats"})?.Count, 0) > 0 Then If If(e({"formats"})?.Count, 0) > 0 Then
Dim obj As MediaObject Dim obj As MediaObject
Dim nValue# Dim nValue#
@@ -1838,6 +1866,12 @@ Namespace API.YouTube.Objects
obj.FPS = AConvert(Of Double)(ee.Value("fps"), NumberProvider, -1) obj.FPS = AConvert(Of Double)(ee.Value("fps"), NumberProvider, -1)
obj.Bitrate = AConvert(Of Double)(ee.Value("tbr"), NumberProvider, -1) obj.Bitrate = AConvert(Of Double)(ee.Value("tbr"), NumberProvider, -1)
obj.Protocol = ee.Value("protocol") 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 If Not obj.Protocol.IsEmptyString Then obj.Protocol = obj.Protocol.Split("_").FirstOrDefault
nValue = AConvert(Of Double)(ee.Value("filesize"), NumberProvider, -1) nValue = AConvert(Of Double)(ee.Value("filesize"), NumberProvider, -1)
If nValue > 0 Then obj.Size = (nValue / 1024).RoundVal(2) If nValue > 0 Then obj.Size = (nValue / 1024).RoundVal(2)
@@ -1852,30 +1886,36 @@ Namespace API.YouTube.Objects
If validCodecValue(ee.Value("vcodec")) Then If validCodecValue(ee.Value("vcodec")) Then
obj.Type = UMTypes.Video obj.Type = UMTypes.Video
obj.Codec = sValue.Split(".").First obj.Codec = sValue.Split(".").First
If validCodecValue(ee.Value("acodec")) Then obj.Type = av If validCodecValue(ee.Value("acodec")) Then obj.Type = TypeAudioVideo
ElseIf validCodecValue(ee.Value("acodec")) Then ElseIf validCodecValue(ee.Value("acodec")) Then
obj.Type = UMTypes.Audio obj.Type = UMTypes.Audio
obj.Codec = sValue.Split(".").First obj.Codec = sValue.Split(".").First
Else Else
Dim fd As Boolean = False Dim fd As Boolean = False
sValue = ee.Value("format_note") If Not obj.FormatQuality.IsEmptyString Or ee.Value("resolution") = "audio only" Then
If Not sValue.IsEmptyString Then
With ListAddList(Nothing, sValue.Split(","), CType(Function(v) CStr(v).StringToLower.StringTrim, Func(Of Object, Object)), EDP.ReturnValue)
If .ListContains({"high", "low"}) Then
obj.Type = UMTypes.Audio obj.Type = UMTypes.Audio
obj.Codec = ee.Value("ext") obj.Codec = ee.Value("ext")
If obj.Protocol.StringToLower.StartsWith("m3u8") Then obj.Protocol = "m3u8" If obj.Protocol.StringToLower.StartsWith("m3u8") Then obj.Protocol = "m3u8"
If obj.Bitrate <= 0 Then obj.Bitrate = IIf(.Contains("high"), 129, 53) If obj.Bitrate <= 0 Then obj.Bitrate = IIf(obj.FormatQuality = "high", 129, 53)
If obj.Size <= 0 Then obj.Size = 1 If obj.Size <= 0 Then obj.Size = 1
fd = True fd = True
End If End If
End With
End If
If Not fd Then Continue For If Not fd Then Continue For
End If End If
MediaObjects.Add(obj) MediaObjects.Add(obj)
Next Next
MediaObjects.RemoveAll(Function(m) (m.Type = UMTypes.Video And (m.Width <= 0 Or m.Height <= 0)) Or m.URL.IsEmptyString) 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) = Dim DupRemover As Action(Of UMTypes) =
Sub(ByVal t As UMTypes) Sub(ByVal t As UMTypes)
Const webm$ = "webm" Const webm$ = "webm"

View File

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

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_kinds = field
dotnet_naming_symbols.constant_fields.applicable_accessibilities = * dotnet_naming_symbols.constant_fields.applicable_accessibilities = *
dotnet_naming_symbols.constant_fields.required_modifiers = const 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 # # C# Coding Conventions #
############################### ###############################

View File

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

View File

@@ -11,6 +11,10 @@ Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Base Namespace API.Base
Friend Class EditorExchangeOptionsBase Friend Class EditorExchangeOptionsBase
Friend Overridable Property SiteKey As String 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)> <PSetting(Address:=SettingAddress.User, Caption:=DN.UserNameChangeCaption, ToolTip:=DN.UserNameChangeToolTip)>
Friend Overridable Property UserName As String = String.Empty Friend Overridable Property UserName As String = String.Empty
<PSetting(Address:=SettingAddress.User, Caption:=DN.DownloadTextCaption, ToolTip:=DN.DownloadTextTip)> <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)> <PSetting(Address:=SettingAddress.User, Caption:=DN.DownloadTextSpecialFolderCaption, ToolTip:=DN.DownloadTextSpecialFolderTip)>
Friend Overridable Property DownloadTextSpecialFolder As Boolean = False Friend Overridable Property DownloadTextSpecialFolder As Boolean = False
Friend Sub New(ByVal u As UserDataBase) Friend Sub New(ByVal u As UserDataBase)
UserExists = u.UserExists
UserSuspended = u.UserSuspended
UserName = u.NameTrue(True) UserName = u.NameTrue(True)
DownloadText = u.DownloadText DownloadText = u.DownloadText
DownloadTextPosts = u.DownloadTextPosts DownloadTextPosts = u.DownloadTextPosts
@@ -35,6 +41,8 @@ Namespace API.Base
Protected _ApplyBase_Name As Boolean = True Protected _ApplyBase_Name As Boolean = True
Protected _ApplyBase_Text As Boolean = True Protected _ApplyBase_Text As Boolean = True
Friend Sub ApplyBase(ByRef u As UserDataBase) Friend Sub ApplyBase(ByRef u As UserDataBase)
u.UserExists = UserExists
u.UserSuspended = UserSuspended
If _ApplyBase_Name Then u.NameTrue = UserName If _ApplyBase_Name Then u.NameTrue = UserName
If _ApplyBase_Text Then If _ApplyBase_Text Then
u.DownloadText = DownloadText u.DownloadText = DownloadText
@@ -42,5 +50,9 @@ Namespace API.Base
u.DownloadTextSpecialFolder = DownloadTextSpecialFolder u.DownloadTextSpecialFolder = DownloadTextSpecialFolder
End If End If
End Sub 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 Class
End Namespace End Namespace

View File

@@ -31,10 +31,6 @@ Namespace API.Base
MyBase.New(s) MyBase.New(s)
DisableBase() DisableBase()
End Sub End Sub
Friend Overridable Sub Apply(ByRef u As IPSite)
ApplyBase(u)
u.QueryString = QueryString
End Sub
Protected Overridable Sub DisableBase() Protected Overridable Sub DisableBase()
_ApplyBase_Name = False _ApplyBase_Name = False
_ApplyBase_Text = False _ApplyBase_Text = False

View File

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

View File

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

View File

@@ -58,6 +58,11 @@ Namespace API.Base
Return Type = Types.Audio Or Type = Types.AudioPre Return Type = Types.Audio Or Type = Types.AudioPre
End Get End Get
End Property 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_BASE As String
Friend URL As String Friend URL As String
Friend MD5 As String Friend MD5 As String

View File

@@ -13,10 +13,21 @@ Namespace API.Base
Friend Property TempPostsList As List(Of String) Friend Property TempPostsList As List(Of String)
Protected ReadOnly Token As CancellationToken Protected ReadOnly Token As CancellationToken
Friend Property DebugMode As Boolean = False Friend 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) MyBase.New(True)
Token = _Token Token = _Token
MainProcessName = _MainProcessName
If Not WorkingDir.IsEmptyString Then ChangeDirectory(WorkingDir)
End Sub 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() Public Overrides Sub Create()
If TempPostsList Is Nothing Then TempPostsList = New List(Of String) If TempPostsList Is Nothing Then TempPostsList = New List(Of String)
MyBase.Create() MyBase.Create()

View File

@@ -28,6 +28,7 @@ Namespace API.Base
Friend MustInherit Class UserDataBase : Implements IUserData, IPluginContentProvider, IThrower Friend MustInherit Class UserDataBase : Implements IUserData, IPluginContentProvider, IThrower
Friend Const UserFileAppender As String = "User" Friend Const UserFileAppender As String = "User"
Friend Const PostTextSpecialFolderDefault As String = "txt" Friend Const PostTextSpecialFolderDefault As String = "txt"
Friend Const PostTextTEXTSpecialFolderDefault As String = "Text"
#Region "Events" #Region "Events"
Private ReadOnly UserUpdatedEventHandlers As List(Of IUserData.UserUpdatedEventHandler) Private ReadOnly UserUpdatedEventHandlers As List(Of IUserData.UserUpdatedEventHandler)
Friend Custom Event UserUpdated As IUserData.UserUpdatedEventHandler Implements IUserData.UserUpdated Friend Custom Event UserUpdated As IUserData.UserUpdatedEventHandler Implements IUserData.UserUpdated
@@ -183,8 +184,6 @@ Namespace API.Base
#Region "Additional names" #Region "Additional names"
Protected Const Name_SiteMode As String = "SiteMode" Protected Const Name_SiteMode As String = "SiteMode"
Protected Const Name_TrueName As String = "TrueName" 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" Protected Const Name_Arguments As String = "Arguments"
#End Region #End Region
#End Region #End Region
@@ -360,8 +359,8 @@ Namespace API.Base
Me._UserSiteName = _UserSiteName Me._UserSiteName = _UserSiteName
End Set End Set
End Property End Property
Protected Sub UserSiteNameUpdate(ByVal NewName As String) Protected Sub UserSiteNameUpdate(ByVal NewName As String, Optional ByVal Force As Boolean = False)
If Not NewName.IsEmptyString And (UserSiteName.IsEmptyString Or Settings.UpdateUserSiteNameEveryTime) Then UserSiteName = NewName If Not NewName.IsEmptyString And (UserSiteName.IsEmptyString Or Settings.UpdateUserSiteNameEveryTime Or Force) Then UserSiteName = NewName
End Sub End Sub
Friend ReadOnly Property UserModel As UsageModel Implements IUserData.UserModel Friend ReadOnly Property UserModel As UsageModel Implements IUserData.UserModel
Get Get
@@ -977,9 +976,6 @@ BlockNullPicture:
Using x As New XmlFile(MyFileSettings) With {.XmlReadOnly = True} Using x As New XmlFile(MyFileSettings) With {.XmlReadOnly = True}
If User.Name.IsEmptyString Then User.Name = x.Value(Name_UserName) If User.Name.IsEmptyString Then User.Name = x.Value(Name_UserName)
_NameTrue = x.Value(Name_TrueName) _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) UserExists = x.Value(Name_UserExists).FromXML(Of Boolean)(True)
UserSuspended = x.Value(Name_UserSuspended).FromXML(Of Boolean)(False) UserSuspended = x.Value(Name_UserSuspended).FromXML(Of Boolean)(False)
ID = x.Value(Name_UserID) ID = x.Value(Name_UserID)
@@ -1030,7 +1026,7 @@ BlockNullPicture:
End Try End Try
End Sub End Sub
Private Sub UpdateUserInformation_Ex() Private Sub UpdateUserInformation_Ex()
If _ForceSaveUserInfoOnException Then UpdateUserInformation() If _ForceSaveUserInfo Then UpdateUserInformation()
End Sub End Sub
Friend Overridable Overloads Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation Friend Overridable Overloads Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation
UpdateUserInformation(False) UpdateUserInformation(False)
@@ -1207,7 +1203,6 @@ BlockNullPicture:
Protected UseClientTokens As Boolean = False Protected UseClientTokens As Boolean = False
Protected _ForceSaveUserData As Boolean = False Protected _ForceSaveUserData As Boolean = False
Protected _ForceSaveUserInfo As Boolean = False Protected _ForceSaveUserInfo As Boolean = False
Protected _ForceSaveUserInfoOnException As Boolean = False
Private _DownloadInProgress As Boolean = False Private _DownloadInProgress As Boolean = False
Private _EnvirUserExists As Boolean Private _EnvirUserExists As Boolean
Private _EnvirUserSuspended As Boolean Private _EnvirUserSuspended As Boolean
@@ -1225,16 +1220,15 @@ BlockNullPicture:
_DownloadInProgress = True _DownloadInProgress = True
_DescriptionChecked = False _DescriptionChecked = False
_DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime _DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime
_ForceSaveUserData = False
_ForceSaveUserInfo = False
_ForceSaveUserInfoOnException = False
_EnvirUserExists = UserExists _EnvirUserExists = UserExists
_EnvirUserSuspended = UserSuspended _EnvirUserSuspended = UserSuspended
_EnvirCreatedByChannel = CreatedByChannel
_EnvirChanged = False
_EnvirInvokeUserUpdated = False
UserExists = True UserExists = True
UserSuspended = False UserSuspended = False
_EnvirCreatedByChannel = CreatedByChannel
_ForceSaveUserData = False
_ForceSaveUserInfo = False
_EnvirChanged = False
_EnvirInvokeUserUpdated = False
DownloadedPictures(False) = 0 DownloadedPictures(False) = 0
DownloadedVideos(False) = 0 DownloadedVideos(False) = 0
_PictureExists = Settings.ViewModeIsPicture AndAlso Not GetPicture(Of Image)(False) Is Nothing _PictureExists = Settings.ViewModeIsPicture AndAlso Not GetPicture(Of Image)(False) Is Nothing
@@ -1242,10 +1236,10 @@ BlockNullPicture:
Private Sub EnvirChanged(ByVal NewValue As Object, <CallerMemberName> Optional ByVal Caller As String = Nothing) Private Sub EnvirChanged(ByVal NewValue As Object, <CallerMemberName> Optional ByVal Caller As String = Nothing)
If _DownloadInProgress Then If _DownloadInProgress Then
Select Case Caller Select Case Caller
Case NameOf(UserExists) : If Not _EnvirUserExists = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = 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 Case NameOf(UserSuspended) : If Not _EnvirUserSuspended = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True : _ForceSaveUserInfo = True
Case NameOf(NameTrue) : _EnvirChanged = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True Case NameOf(NameTrue) : _EnvirChanged = True : _ForceSaveUserInfo = True
Case NameOf(ID) : _EnvirChanged = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True Case NameOf(ID) : _EnvirChanged = True : _ForceSaveUserInfo = True
Case Else : _EnvirChanged = True Case Else : _EnvirChanged = True
End Select End Select
End If End If
@@ -1439,6 +1433,18 @@ BlockNullPicture:
Cache.Validate() Cache.Validate()
Return Cache Return Cache
End Function 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" #Region "DownloadSingleObject"
Protected IsSingleObjectDownload As Boolean = False Protected IsSingleObjectDownload As Boolean = False
Friend Overridable Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken) Implements IUserData.DownloadSingleObject Friend Overridable Sub DownloadSingleObject(ByVal Data As YouTube.Objects.IYouTubeMediaContainer, ByVal Token As CancellationToken) Implements IUserData.DownloadSingleObject
@@ -1542,6 +1548,12 @@ BlockNullPicture:
''' </summary> ''' </summary>
Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken) Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken)
End Sub 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 #End Region
#Region "MD5 support" #Region "MD5 support"
Private Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR" Private Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR"
@@ -1718,7 +1730,7 @@ BlockNullPicture:
If _ContentNew.Count > 0 Then If _ContentNew.Count > 0 Then
If UseMD5Comparison Then LoadMD5() If UseMD5Comparison Then LoadMD5()
MyFile.Exists(SFO.Path) MyFile.Exists(SFO.Path)
Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog Dim MissingErrorsAdd As Boolean = Settings.AddMissingToLog And Settings.AddMissingErrorsToLog
Dim MyDir$ = DownloadContentDefault_GetRootDir() Dim MyDir$ = DownloadContentDefault_GetRootDir()
Dim vsf As Boolean = SeparateVideoFolderF Dim vsf As Boolean = SeparateVideoFolderF
Dim __isVideo As Boolean Dim __isVideo As Boolean
@@ -1833,7 +1845,8 @@ BlockNullPicture:
updateDownCount(False) updateDownCount(False)
v.File = DownloadContentDefault_ConvertWebp(ChangeFileNameByProvider(f, v), postProcessWebp) v.File = ChangeFileNameByProvider(f, v)
v.File = DownloadContentDefault_ConvertWebp(v, postProcessWebp)
v.State = UStates.Downloaded v.State = UStates.Downloaded
DownloadContentDefault_PostProcessing(v, f, Token) DownloadContentDefault_PostProcessing(v, f, Token)
If UseMD5Comparison And (v.Type = UTypes.GIF Or v.Type = UTypes.Picture) Then If UseMD5Comparison And (v.Type = UTypes.GIF Or v.Type = UTypes.Picture) Then
@@ -1864,8 +1877,13 @@ stxt:
Continue For Continue For
End If End If
End If End If
If Not fTxt.Path.StartsWith(MyDir) Then fTxt.Path = MyDir
v.PostTextFileSpecialFolder = DownloadTextSpecialFolder 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" fTxt.Extension = "txt"
v.PostTextFile = TextSaver.SaveTextToFile(v.PostText, fTxt,,, Settings.FeedShowTextPosts_LogErrors_E) 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} If Not v.PostTextFile.Exists Then Throw New ArgumentNullException("Text", "Error downloading text") With {.HelpLink = 10}
@@ -1933,7 +1951,11 @@ stxt:
End Function End Function
Protected Overridable Sub DownloadContentDefault_PostProcessing(ByRef m As UserMedia, ByVal File As SFile, ByVal Token As CancellationToken) Protected Overridable Sub DownloadContentDefault_PostProcessing(ByRef m As UserMedia, ByVal File As SFile, ByVal Token As CancellationToken)
End Sub End Sub
Protected Overridable Function DownloadContentDefault_ConvertWebp(ByVal WebpFile As SFile, ByVal Process As Boolean) As SFile 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 Dim f As SFile = WebpFile
If Process AndAlso f.Exists Then If Process AndAlso f.Exists Then
f.Path = $"{f.PathWithSeparator}Sources" f.Path = $"{f.PathWithSeparator}Sources"
@@ -1941,7 +1963,7 @@ stxt:
If WebpFile.Copy(f) Then If WebpFile.Copy(f) Then
Dim newFile As SFile = WebpFile Dim newFile As SFile = WebpFile
newFile.Extension = UserImage.ExtJpg newFile.Extension = UserImage.ExtJpg
f = UserImage.ConvertWebp(f, newFile) f = UserImage.ConvertWebp(f, newFile, ConvertWebpForce)
If f.Exists Then WebpFile.Delete(SFO.File, SFODelete.DeletePermanently, EDP.ReturnValue) If f.Exists Then WebpFile.Delete(SFO.File, SFODelete.DeletePermanently, EDP.ReturnValue)
Else Else
f = WebpFile f = WebpFile
@@ -1949,6 +1971,24 @@ stxt:
End If End If
Return f Return f
End Function 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 Protected Overridable Function DownloadContentDefault_ProcessDownloadException() As Boolean
Return True Return True
End Function End Function
@@ -2312,7 +2352,7 @@ stxt:
ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}") ErrorsDescriber.Execute(If(e.Exists, e, New ErrorsDescriber(EDP.SendToLog)), ex, $"{ToStringForLog()}: {Message}")
End Sub End Sub
Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String) Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String)
If Not f.Exists Then MyMainLOG = $"Error downloading from [{URL}] to [{f}]" If Not f.Exists Then LogError(Nothing, $"error downloading{vbCr}{URL}{vbCr}{f}")
End Sub End Sub
''' <exception cref="ObjectDisposedException"></exception> ''' <exception cref="ObjectDisposedException"></exception>
Protected Sub ThrowIfDisposed() Protected Sub ThrowIfDisposed()
@@ -2453,6 +2493,7 @@ stxt:
_TempPostsList.Clear() _TempPostsList.Clear()
_MD5List.Clear() _MD5List.Clear()
TokenPersonal = Nothing TokenPersonal = Nothing
GDLFileNameProvider = Nothing
If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose() If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose()
If Not Responser Is Nothing Then Responser.Dispose() If Not Responser Is Nothing Then Responser.Dispose()
If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose() If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose()

View File

@@ -6,13 +6,20 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API.YouTube
Namespace API.Base.YTDLP Namespace API.Base.YTDLP
Friend Class YTDLPBatch : Inherits GDL.GDLBatch Friend Class YTDLPBatch : Inherits GDL.GDLBatch
Friend Sub New(ByVal _Token As Threading.CancellationToken) Friend Sub New(ByVal _Token As Threading.CancellationToken, Optional ByVal __MainProcessName As String = Nothing, Optional ByVal WorkingDir As SFile = Nothing)
MyBase.New(_Token) MyBase.New(_Token, __MainProcessName.IfNullOrEmpty(Settings.YtdlpFile.File.Name), WorkingDir.IfNullOrEmpty(Settings.YtdlpFile.File))
Commands.Clear() End Sub
MainProcessName = Settings.YtdlpFile.File.Name '"yt-dlp" Friend Sub SetProgress(ByVal Progress As MyProgress, Optional ByVal ValCalc As Func(Of Double, Double) = Nothing)
ChangeDirectory(Settings.YtdlpFile.File) 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 Sub
End Class End Class
End Namespace 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.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Namespace API.Bluesky Namespace API.Bluesky
<Manifest(BlueskySiteKey), SpecialForm(False)> <Manifest(BlueskySiteKey), SpecialForm(False), SavedPosts>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
<PropertyOption(ControlText:="Cookies enabled", ControlToolTip:="If checked, cookies will be used in requests", IsAuth:=True), PXML, PClonable, HiddenControl> <PropertyOption(ControlText:="Cookies enabled", ControlToolTip:="If checked, cookies will be used in requests", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property CookiesEnabled As PropertyValue Friend ReadOnly Property CookiesEnabled As PropertyValue
@@ -26,6 +26,10 @@ Namespace API.Bluesky
<PXML> Friend ReadOnly Property TokenUpdateTime As PropertyValue <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> <PropertyOption(ControlText:="Token update", ControlToolTip:="Token refresh interval (in minutes)." & vbCr & "Default: 120.", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property TokenRefreshInterval As PropertyValue 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) 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) 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)) TokenUpdateTime = New PropertyValue(Now.AddYears(-1))
TokenRefreshInterval = New PropertyValue(120) TokenRefreshInterval = New PropertyValue(120)
DownloadModelMedia = New PropertyValue(True)
DownloadModelProfile = New PropertyValue(False)
_AllowUserAgentUpdate = False _AllowUserAgentUpdate = False
UrlPatternUser = "https://bsky.app/profile/{0}" UrlPatternUser = "https://bsky.app/profile/{0}"
ImageVideoContains = "bsky.app" ImageVideoContains = "bsky.app"
UserRegex = RParams.DMS("bsky.app/profile/([^/\?]+)", 1, EDP.ReturnValue) UserRegex = RParams.DMS("bsky.app/profile/([^/\?]+)", 1, EDP.ReturnValue)
UserOptionsType = GetType(EditorExchangeOptionsBase) UserOptionsType = GetType(EditorExchangeOptions)
End Sub End Sub
Protected Overrides Function UserOptionsValid(ByVal Options As Object) As Boolean Protected Overrides Function UserOptionsValid(ByVal Options As Object) As Boolean
Return DirectCast(Options, EditorExchangeOptionsBase).SiteKey = BlueskySiteKey Return DirectCast(Options, EditorExchangeOptionsBase).SiteKey = BlueskySiteKey
@@ -96,5 +103,10 @@ Namespace API.Bluesky
_TokenUpdating = False _TokenUpdating = False
End Try End Try
End Function 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 Class
End Namespace End Namespace

View File

@@ -7,15 +7,22 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Threading Imports System.Threading
Imports SCrawler.Plugin
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Bluesky Namespace API.Bluesky
Friend Class UserData : Inherits UserDataBase 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" #Region "Declarations"
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Get Get
@@ -28,16 +35,49 @@ Namespace API.Bluesky
End Get End Get
End Property End Property
Private ReadOnly _TmpPosts2 As List(Of String) 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 #End Region
#Region "Loader" #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) 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 End Sub
Friend Overrides Function ExchangeOptionsGet() As Object Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptionsBase(Me) With {.SiteKey = BlueskySiteKey} Return New EditorExchangeOptions(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptionsBase AndAlso If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then DirectCast(Obj, EditorExchangeOptions).Apply(Me)
DirectCast(Obj, EditorExchangeOptionsBase).SiteKey = BlueskySiteKey Then DirectCast(Obj, EditorExchangeOptionsBase).ApplyBase(Me)
End Sub End Sub
#End Region #End Region
#Region "Initializer" #Region "Initializer"
@@ -64,8 +104,16 @@ Namespace API.Bluesky
#Region "Download" #Region "Download"
Private _PostCount As Integer = 0 Private _PostCount As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_CurlProfileTried = False
_TmpPosts2.Clear() _TmpPosts2.Clear()
Try 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() If Not CBool(MySettings.CookiesEnabled.Value) Then Responser.Cookies.Clear()
UpdateToken(, True) UpdateToken(, True)
_TokenUpdateCount = 0 _TokenUpdateCount = 0
@@ -79,23 +127,36 @@ Namespace API.Bluesky
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken) Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
If ID.IsEmptyString Then GetProfileInfo(Token) If (Not IsSavedPosts And ID.IsEmptyString) Or ForceParseProfileInfo Then GetProfileInfo(Token)
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "ID is null") If Not IsSavedPosts And ID.IsEmptyString Then Throw New ArgumentNullException("ID", "ID is null")
If UpdateToken() Then If UpdateToken() Then
Dim nextCursor$ = String.Empty Dim nextCursor$ = String.Empty
Dim c% 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)}" If Not Cursor.IsEmptyString Then URL &= $"&cursor={SymbolsConverter.ASCII.EncodeSymbolsOnly(Cursor)}"
n = {"feed"}
p = {"post"}
End If
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
TokenUpdateCountReset() TokenUpdateCountReset()
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r) Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then If j.ListExists Then
With j("feed") nextCursor = j.Value("cursor")
With j(n)
If .ListExists Then If .ListExists Then
For Each post As EContainer In .Self For Each post As EContainer In .Self
With post({"post"}) With post(p)
c = DefaultParser(.Self,, nextCursor) c = DefaultParser(.Self) ',, nextCursor)
Select Case c Select Case c
Case CInt(DateResult.Skip) * -1 : Continue For Case CInt(DateResult.Skip) * -1 : Continue For
Case CInt(DateResult.Exit) * -1 : Exit Sub Case CInt(DateResult.Exit) * -1 : Exit Sub
@@ -104,6 +165,8 @@ Namespace API.Bluesky
If DownloadTopCount.HasValue AndAlso DownloadTopCount.Value <= _PostCount Then Exit Sub If DownloadTopCount.HasValue AndAlso DownloadTopCount.Value <= _PostCount Then Exit Sub
End With End With
Next Next
ElseIf IsSavedPosts Then
nextCursor = String.Empty
End If End If
End With End With
End If End If
@@ -113,7 +176,11 @@ Namespace API.Bluesky
End If End If
End If End If
Catch ex As Exception 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 Try
End Sub End Sub
#End Region #End Region
@@ -126,7 +193,7 @@ Namespace API.Bluesky
Optional ByVal CheckTempPosts As Boolean = True, Optional ByVal State As UStates = UStates.Unknown) As Integer Optional ByVal CheckTempPosts As Boolean = True, Optional ByVal State As UStates = UStates.Unknown) As Integer
Const exitReturn% = CInt(DateResult.Exit) * -1 Const exitReturn% = CInt(DateResult.Exit) * -1
Const skipReturn% = CInt(DateResult.Skip) * -1 Const skipReturn% = CInt(DateResult.Skip) * -1
Dim postID$, postDate$, __url$, __urlBase$, __txt$, __userId$ Dim postID$, postDate$, __url$, __urlBase$, __txt$, __userId$, __postAuthor$
Dim updateUrl As Boolean Dim updateUrl As Boolean
Dim c% = 0 Dim c% = 0
Dim m As UserMedia Dim m As UserMedia
@@ -138,11 +205,12 @@ Namespace API.Bluesky
__urlBase = String.Empty __urlBase = String.Empty
__txt = String.Empty __txt = String.Empty
__userId = .Value({"author"}, "did") __userId = .Value({"author"}, "did")
__postAuthor = String.Empty
With .Item({"record"}) With .Item({"record"})
If .ListExists Then If .ListExists Then
'2025-01-28T02:42:12.415Z '2025-01-28T02:42:12.415Z
postDate = .Value("createdAt") postDate = .Value("createdAt")
NextCursor = postDate If Not IsSavedPosts Then NextCursor = postDate
If CheckDateLimits Then If CheckDateLimits Then
Select Case CheckDatesLimit(postDate, DateProvider) Select Case CheckDatesLimit(postDate, DateProvider)
Case DateResult.Skip : Return skipReturn 'Continue For Case DateResult.Skip : Return skipReturn 'Continue For
@@ -155,9 +223,10 @@ Namespace API.Bluesky
If _TempPostsList.Contains(postID) Then Return exitReturn Else _TmpPosts2.Add(postID) If _TempPostsList.Contains(postID) Then Return exitReturn Else _TmpPosts2.Add(postID)
End If End If
If ParseUserMediaOnly And Not ID.IsEmptyString And Not __userId.IsEmptyString And Not ID = __userId Then Return skipReturn If ParseUserMediaOnly And Not IsSavedPosts And Not ID.IsEmptyString And Not __userId.IsEmptyString And Not ID = __userId Then Return skipReturn
__urlBase = $"https://bsky.app/profile/{NameTrue}/post/{postID}" __postAuthor = e.Value({"author"}, "did")
__urlBase = $"https://bsky.app/profile/{If(IsSavedPosts, __postAuthor, NameTrue)}/post/{postID}"
End If End If
End With End With
@@ -190,7 +259,11 @@ Namespace API.Bluesky
__url = d.Value("fullsize") __url = d.Value("fullsize")
If __url.IsEmptyString Then __url = d.Value({"image", "ref"}, "$link") : updateUrl = True 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 __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 Next
End With End With
End If End If
@@ -217,14 +290,33 @@ Namespace API.Bluesky
End Function End Function
#End Region #End Region
#Region "GetProfileInfo" #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 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)}") Dim r$ = Responser.GetResponse($"https://bsky.social/xrpc/app.bsky.actor.getProfile?actor={ID.IfNullOrEmpty(NameTrue)}")
TokenUpdateCountReset() TokenUpdateCountReset()
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r) Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then 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") ID = j.Value("did")
UserSiteNameUpdate(j.Value("displayName")) UserSiteNameUpdate(j.Value("displayName"))
UserDescriptionUpdate(j.Value("description")) UserDescriptionUpdate(j.Value("description"))
@@ -232,6 +324,7 @@ Namespace API.Bluesky
SimpleDownloadAvatar(j.Value("avatar")) SimpleDownloadAvatar(j.Value("avatar"))
SimpleDownloadAvatar(j.Value("banner")) SimpleDownloadAvatar(j.Value("banner"))
End If End If
End If
End Using End Using
End If End If
Else Else
@@ -239,6 +332,8 @@ Namespace API.Bluesky
End If End If
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, "GetProfileInfo") ProcessException(ex, Token, "GetProfileInfo")
Finally
If UseCurl Then Responser.Mode = Responser.Modes.Default
End Try End Try
End Sub End Sub
#End Region #End Region
@@ -325,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 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) Return M3U8.Download(URL, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function 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 #End Region
#Region "DownloadSingleObject" #Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken) Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
@@ -343,11 +441,17 @@ Namespace API.Bluesky
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = Net.HttpStatusCode.BadRequest Then '400 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 Return 1
Else Else
Return 0 Return 2
End If End If
ElseIf Responser.StatusCode = Net.HttpStatusCode.BadGateway Or Responser.StatusCode = Net.HttpStatusCode.GatewayTimeout Then '502, 504
Return 3
Else Else
Return 0 Return 0
End If End If

View File

@@ -68,14 +68,7 @@ Namespace API.Facebook
Return New UserExchangeOptions(Me) Return New UserExchangeOptions(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
With DirectCast(Obj, UserExchangeOptions)
ParsePhotoBlock = .ParsePhotoBlock
ParseVideoBlock = .ParseVideoBlock
ParseReelsBlock = .ParseReelsBlock
ParseStoriesBlock = .ParseStoriesBlock
End With
End If
End Sub End Sub
#End Region #End Region
#Region "Loader" #Region "Loader"

View File

@@ -6,9 +6,10 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.Facebook Namespace API.Facebook
Friend Class UserExchangeOptions Friend Class UserExchangeOptions : Inherits EditorExchangeOptionsBase
<PSetting(NameOf(SiteSettings.ParsePhotoBlock), NameOf(MySettings))> <PSetting(NameOf(SiteSettings.ParsePhotoBlock), NameOf(MySettings))>
Friend Property ParsePhotoBlock As Boolean = True Friend Property ParsePhotoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseVideoBlock), NameOf(MySettings))> <PSetting(NameOf(SiteSettings.ParseVideoBlock), NameOf(MySettings))>
@@ -19,6 +20,7 @@ Namespace API.Facebook
Friend Property ParseStoriesBlock As Boolean = True Friend Property ParseStoriesBlock As Boolean = True
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Friend Sub New(ByVal u As UserData) Friend Sub New(ByVal u As UserData)
MyBase.New(u)
MySettings = u.HostCollection.Default.Source MySettings = u.HostCollection.Default.Source
ParsePhotoBlock = u.ParsePhotoBlock ParsePhotoBlock = u.ParsePhotoBlock
ParseVideoBlock = u.ParseVideoBlock ParseVideoBlock = u.ParseVideoBlock
@@ -26,11 +28,21 @@ Namespace API.Facebook
ParseStoriesBlock = u.ParseStoriesBlock ParseStoriesBlock = u.ParseStoriesBlock
End Sub End Sub
Friend Sub New(ByVal s As SiteSettings) Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
MySettings = s MySettings = s
ParsePhotoBlock = s.ParsePhotoBlock.Value ParsePhotoBlock = s.ParsePhotoBlock.Value
ParseVideoBlock = s.ParseVideoBlock.Value ParseVideoBlock = s.ParseVideoBlock.Value
ParseReelsBlock = s.ParseReelsBlock.Value ParseReelsBlock = s.ParseReelsBlock.Value
ParseStoriesBlock = s.ParseStoriesBlock.Value ParseStoriesBlock = s.ParseStoriesBlock.Value
End Sub 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 Class
End Namespace 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 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_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_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) 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_wwwClaimName$ = "x-ig-set-www-claim"
Const r_tokenName$ = SiteSettings.Header_CSRF_TOKEN_COOKIE 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")> <PSetting(Caption:="Place the extracted image into the video folder")>
Friend Property PutImageVideoFolder As Boolean Friend Property PutImageVideoFolder As Boolean
Friend Overrides Property UserName As String 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")> <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 Friend Property ForceUpdateUserName As Boolean = False
<PSetting(Address:=SettingAddress.User, Caption:="Force update user information")> <PSetting(Address:=SettingAddress.User, Caption:="Force update user information")>
@@ -57,6 +59,8 @@ Namespace API.Instagram
PutImageVideoFolder = .PutImageVideoFolder PutImageVideoFolder = .PutImageVideoFolder
IsVerifiedProfile = .IsVerifiedProfile
ForceUpdateUserName = .ForceUpdateUserName ForceUpdateUserName = .ForceUpdateUserName
ForceUpdateUserInfo = .ForceUpdateUserInfo ForceUpdateUserInfo = .ForceUpdateUserInfo
End With End With

View File

@@ -70,7 +70,7 @@ Namespace API.Instagram
Friend Const Header_Browser As String = "Sec-Ch-Ua" Friend Const Header_Browser As String = "Sec-Ch-Ua"
Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List" Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
Friend Const Header_Platform_Verion As String = "Sec-Ch-Ua-Platform-Version" 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 Friend ReadOnly Property HH_CSRF_TOKEN As PropertyValue
<CookieValueExtractor(NameOf(HH_CSRF_TOKEN))> <CookieValueExtractor(NameOf(HH_CSRF_TOKEN))>
Private Function GetValueFromCookies(ByVal PropName As String, ByVal c As CookieKeeper) As String Private Function GetValueFromCookies(ByVal PropName As String, ByVal c As CookieKeeper) As String
@@ -78,7 +78,7 @@ Namespace API.Instagram
End Function End Function
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), PClonable(Clone:=False)> <PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), PClonable(Clone:=False)>
Friend ReadOnly Property HH_IG_APP_ID As PropertyValue 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 Friend ReadOnly Property HH_ASBD_ID As PropertyValue
'PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=True) 'PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=True)
<PClonable(Clone:=False)> <PClonable(Clone:=False)>
@@ -89,16 +89,16 @@ Namespace API.Instagram
Return Not v.IsEmptyString AndAlso v = "0" Return Not v.IsEmptyString AndAlso v = "0"
End Get End Get
End Property 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)> InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER As PropertyValue 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)> InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_full_version_list), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER_EXT As PropertyValue 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)> InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_platform_version), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_PLATFORM As PropertyValue 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)> InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_USER_AGENT As PropertyValue Private ReadOnly Property HH_USER_AGENT As PropertyValue
Friend Overrides Function BaseAuthExists() As Boolean Friend Overrides Function BaseAuthExists() As Boolean
@@ -146,8 +146,12 @@ Namespace API.Instagram
<Provider(NameOf(HH_IG_WWW_CLAIM_UPDATE_INTERVAL), FieldsChecker:=True)> <Provider(NameOf(HH_IG_WWW_CLAIM_UPDATE_INTERVAL), FieldsChecker:=True)>
Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider
#End Region #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 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 #End Region
#Region "Download data" #Region "Download data"
<PropertyOption(ControlText:="Download timeline", Category:=CAT_DOWN), PXML, PClonable> <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> <PropertyOption(ControlText:="Download tagged posts", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property DownloadTagged As PropertyValue Friend ReadOnly Property DownloadTagged As PropertyValue
<PXML> Private ReadOnly Property DownloadTagged_Def 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 #End Region
#Region "Timers" #Region "Timers"
Friend Const TimersUrgentTip As String = vbCr & "It is highly recommended not to change the default value." 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_UPDATE_INTERVAL = New PropertyValue(120)
HH_IG_WWW_CLAIM_ALWAYS_ZERO = New PropertyValue(False) 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_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 = New PropertyValue(True)
HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO = New PropertyValue(True) HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO = New PropertyValue(True)
TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider 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 = New PropertyValue(True)
DownloadTimeline_Def = New PropertyValue(DownloadTimeline.Value, GetType(Boolean)) DownloadTimeline_Def = New PropertyValue(DownloadTimeline.Value, GetType(Boolean))
@@ -496,8 +510,12 @@ Namespace API.Instagram
DownloadStoriesUser_Def = New PropertyValue(DownloadStoriesUser.Value, GetType(Boolean)) DownloadStoriesUser_Def = New PropertyValue(DownloadStoriesUser.Value, GetType(Boolean))
DownloadTagged = New PropertyValue(False) DownloadTagged = New PropertyValue(False)
DownloadTagged_Def = New PropertyValue(DownloadTagged.Value, GetType(Boolean)) 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_AnyProvider = New TimersChecker(0)
RequestsWaitTimer = New PropertyValue(1000) RequestsWaitTimer = New PropertyValue(1000)
RequestsWaitTimerProvider = New TimersChecker(100) RequestsWaitTimerProvider = New TimersChecker(100)
@@ -526,10 +544,10 @@ Namespace API.Instagram
SkipErrors_AddToLog_Silent = New PropertyValue(String.Empty, GetType(String)) SkipErrors_AddToLog_Silent = New PropertyValue(String.Empty, GetType(String))
IgnoreStoriesDownloadingErrors = New PropertyValue(False) IgnoreStoriesDownloadingErrors = New PropertyValue(False)
DownDetectorValue = New PropertyValue(20) DownDetectorValue = New PropertyValue(30)
DownDetectorValueProvider = New TimersChecker(-1) DownDetectorValueProvider = New TimersChecker(-1)
DownDetectorValueAddToLog = New PropertyValue(False) DownDetectorValueAddToLog = New PropertyValue(True)
TaggedNotifyLimit = New PropertyValue(200) TaggedNotifyLimit = New PropertyValue(50)
TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
DownloadingErrorDate = New PropertyValue(Now.AddYears(-10), GetType(Date)) DownloadingErrorDate = New PropertyValue(Now.AddYears(-10), GetType(Date))
@@ -545,18 +563,13 @@ Namespace API.Instagram
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "instagram.com/"), 1) UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "instagram.com/"), 1)
ImageVideoContains = "instagram.com" ImageVideoContains = "instagram.com"
End Sub End Sub
Private Const SettingsVersionCurrent As Integer = 2 Private Const SettingsVersionCurrent As Integer = 4
Friend Overrides Sub EndInit() Friend Overrides Sub EndInit()
Try : MyLastRequests.Add(LastDownloadDate.Value, LastRequestsCount.Value) : Catch : End Try 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 Not CBool(HH_IG_WWW_CLAIM_USE.Value) Then Responser.Headers.Remove(Header_IG_WWW_CLAIM)
If CInt(SettingsVersion.Value) < SettingsVersionCurrent Then If CInt(SettingsVersion.Value) < SettingsVersionCurrent Then
SettingsVersion.Value = SettingsVersionCurrent SettingsVersion.Value = SettingsVersionCurrent
HH_IG_WWW_CLAIM_UPDATE_INTERVAL.Value = 120 USE_GQL.Value = True
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
End If End If
MyBase.EndInit() MyBase.EndInit()
End Sub End Sub

View File

@@ -6,12 +6,13 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Security.Cryptography
Imports System.Threading Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.API.Base
Namespace API.Instagram Namespace API.Instagram
Partial Friend Class UserData Partial Friend Class UserData
#Region "Tokens" #Region "Tokens"
@@ -26,26 +27,30 @@ Namespace API.Instagram
Token_dtsg = String.Empty Token_dtsg = String.Empty
Token_lsd = String.Empty Token_lsd = String.Empty
End Sub End Sub
Protected Property BlockVersionID As String = String.Empty
#End Region #End Region
#Region "Headers" #Region "Headers"
Friend Const GQL_HEADER_FB_FRINDLY_NAME As String = "x-fb-friendly-name" 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_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 #End Region
#Region "Data constants" #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_UserData_FbFriendlyName As String = "PolarisProfilePageContentQuery"
Private Const GQL_Highlights_DocId As String = "8298007123561120" Private Const GQL_Highlights_DocId As String = "36997000523232338" '"8298007123561120"
Private Const GQL_Highlights_DocId_Second As String = "7559771384111300" Private Const GQL_Highlights_DocId_Second As String = "27618287167780519" '"7559771384111300"
Private Const GQL_Highlights_FbFriendlyName As String = "PolarisProfileStoryHighlightsTrayContentQuery" Private Const GQL_Highlights_FbFriendlyName As String = "PolarisProfileStoryHighlightsTrayContentQuery"
Private Const GQL_Highlights_FbFriendlyName_Second As String = "PolarisStoriesV3HighlightsPageQuery" Private Const GQL_Highlights_FbFriendlyName_Second As String = "PolarisStoriesV3HighlightsPageQuery"
Private Const GQL_UserStories_DocId As String = "25231722019806941" Private Const GQL_UserStories_DocId As String = "25231722019806941"
Private Const GQL_UserStories_FbFriendlyName As String = "PolarisStoriesV3ReelPageStandaloneQuery" 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_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_Timeline_FbFriendlyName_Second As String = "PolarisProfilePostsTabContentQuery_connection"
Private Const GQL_Reels_DocId As String = "7191572580905225" 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" Private Const GQL_URL_Q As String = "https://www.instagram.com/graphql/query"
#End Region #End Region
#Region "Download functions" #Region "Download functions"
Protected Sub UpdateHeadersGQL(ByVal HeaderValue As String) Protected Sub UpdateHeadersGQL(ByVal HeaderValue As String, Optional ByVal Add As Boolean = True)
Responser.Headers.Add(GQL_HEADER_FB_FRINDLY_NAME, HeaderValue) With Responser.Headers
Responser.Headers.Add(GQL_HEADER_FB_LSD, Token_lsd) 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 End Sub
<Obsolete("Use 'GET' function: 'GetUserData'", False)> '<Obsolete("Use 'GET' function: 'GetUserData'", False)>
Private Sub GetUserDataGQL(ByVal Token As CancellationToken) 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, 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() UpdateRequestNumber()
ChangeResponserMode(True) ChangeResponserMode(True)
UpdateHeadersGQL(GQL_UserData_FbFriendlyName) UpdateHeadersGQL(GQL_UserData_FbFriendlyName)
Dim r$ = Responser.GetResponse(GQL_URL, vars) Dim r$ = Responser.GetResponse(GQL_URL_Q, vars)
If Not r.IsEmptyString Then Return r
Using j As EContainer = JsonDocument.Parse(r) 'If Not r.IsEmptyString Then
If j.ListExists Then ' Using j As EContainer = JsonDocument.Parse(r)
With j({"data", "user"}) ' If j.ListExists Then
If .ListExists Then ' With j({"data", "user"})
UserSiteName = .Value("full_name").IfNullOrEmpty(UserSiteName) ' If .ListExists Then
Dim f As New SFile With {.Path = DownloadContentDefault_GetRootDir(), .Name = "ProfilePicture", .Extension = "jpg"} ' UserSiteName = .Value("full_name").IfNullOrEmpty(UserSiteName)
Dim pic$ = .Value({"hd_profile_pic_url_info"}, "url").IfNullOrEmpty(.Value("profile_pic_url")) ' IsVerifiedProfile = .Value("is_verified").FromXML(Of Boolean)(False)
If Not pic.IsEmptyString Then GetWebFile(pic, f, EDP.ReturnValue) ' IsVerifiedProfile_Checked = True
UserDescriptionUpdate(.Value("biography")) ' Dim descr$ = .Value("biography")
End If ' If If(.Item("bio_links")?.Count, 0) > 0 Then descr.StringAppend(.Item("bio_links").Select(Function(bl) bl.Value("url")).ListToString(vbNewLine), vbNewLine)
End With ' Dim eUrl$ = .Value("external_url")
End If ' If Not eUrl.IsEmptyString AndAlso (descr.IsEmptyString OrElse Not descr.Contains(eUrl)) Then descr.StringAppendLine(eUrl)
End Using ' UserDescriptionUpdate(descr)
End If
End Sub ' 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 Private Function GetTimelineGQL(ByVal Cursor As String, ByVal Token As CancellationToken) As String
Const none_cursor$ = "none" Const none_cursor$ = "none"
Dim nextCursor$ = String.Empty, hasNextPage$ = String.Empty Dim nextCursor$ = String.Empty
Dim hasNextPage As Boolean = False
Dim vars$ Dim vars$
ThrowAny(Token) ThrowAny(Token)
UpdateTokens(Not ValidateBaseTokens())
UpdateRequestNumber() UpdateRequestNumber()
ChangeResponserMode(True) ChangeResponserMode(True)
If Cursor.IsEmptyString Then 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}" 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, vars = String.Format(GQL_URL_PATTERN_VARS, GQL_Timeline_DocId, Token_lsd, Token_dtsg_Var, GQL_Timeline_FbFriendlyName,
SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)) SymbolsConverter.ASCII.EncodeSymbolsOnly(vars))
UpdateHeadersGQL(GQL_Timeline_FbFriendlyName) UpdateHeadersGQL(GQL_Timeline_FbFriendlyName)
Else 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}" 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, vars = String.Format(GQL_URL_PATTERN_VARS, GQL_Timeline_DocId_Second, Token_lsd, Token_dtsg_Var, GQL_Timeline_FbFriendlyName_Second,
SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)) SymbolsConverter.ASCII.EncodeSymbolsOnly(vars))
UpdateHeadersGQL(GQL_Timeline_FbFriendlyName_Second) 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) Return If(hasNextPage And (Not nextCursor.IsEmptyString AndAlso Not nextCursor.StringToLower = none_cursor), nextCursor, String.Empty)
End Function End Function
Private Function GetHighlightsGQL_List() As List(Of String) Private Function GetHighlightsGQL_List() As List(Of String)
UpdateTokens(Not ValidateBaseTokens())
Dim nextCursor$ = String.Empty, hasNextPage$ = String.Empty Dim nextCursor$ = String.Empty
Dim hasNextPage As Boolean = False
Dim i% = -1 Dim i% = -1
Dim hList As New List(Of String) Dim hList As New List(Of String)
Dim tmpList As New List(Of String) Dim tmpList As New List(Of String)
@@ -174,12 +208,15 @@ Namespace API.Instagram
Return hList Return hList
End Function End Function
Private Sub GetHighlightsGQL(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken) 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 tmpList As New List(Of String)
Dim i% = -1 Dim i% = -1
If StoriesList.ListExists Then 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) 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, 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(",")) & "}")) SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(highlightData, tmpList(0), tmpList.Select(Function(hl) $"""{hl}""").ListToString(",")) & "}"))
@@ -206,6 +243,7 @@ Namespace API.Instagram
tmpList.Clear() tmpList.Clear()
End Sub End Sub
Private Sub GetUserStoriesGQL(ByVal Token As CancellationToken) Private Sub GetUserStoriesGQL(ByVal Token As CancellationToken)
UpdateTokens(Not ValidateBaseTokens())
'"{" & $"""user_id"":""{ID}""" & "}" '"{" & $"""user_id"":""{ID}""" & "}"
Dim vars$ = String.Format(GQL_URL_PATTERN_VARS, GQL_UserStories_DocId, Token_lsd, Token_dtsg_Var, GQL_UserStories_FbFriendlyName, 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}""]" & "}"))
@@ -238,11 +276,9 @@ Namespace API.Instagram
Private Function GetReelsGQL(ByVal Cursor As String) As String Private Function GetReelsGQL(ByVal Cursor As String) As String
GetReelsGQL_SetEnvir = True GetReelsGQL_SetEnvir = True
Dim errData$ = String.Empty UpdateTokens(Cursor.IsEmptyString Or Not ValidateBaseTokens())
If Cursor.IsEmptyString And Not ValidateBaseTokens() Then GetPageTokens()
If Cursor.IsEmptyString And Not ValidateBaseTokens(errData) Then ValidateBaseTokens_Error(errData)
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" 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, vars = String.Format(GQL_URL_PATTERN_VARS, GQL_Reels_DocId, Token_lsd, Token_dtsg_Var, GQL_Reels_FbFriendlyName,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & vars & "}")) SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & vars & "}"))
@@ -253,15 +289,16 @@ Namespace API.Instagram
End Function End Function
''' <summary>Response</summary> ''' <summary>Response</summary>
Private Function GetTaggedGQL(ByVal Cursor As String) As String Private Function GetTaggedGQL(ByVal Cursor As String) As String
UpdateTokens(Not ValidateBaseTokens())
'default count = 12 'default count = 12
'max count = 21 'max count = 21
Dim vars$ Dim vars$
If Cursor.IsEmptyString Then If Cursor.IsEmptyString Then
vars = String.Format(GQL_URL_PATTERN_VARS, GQL_Tagged_DocId, Token_lsd, Token_dtsg_Var, GQL_Tagged_FbFriendlyName, 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 Else
vars = String.Format(GQL_URL_PATTERN_VARS, GQL_Tagged_DocId, Token_lsd, Token_dtsg_Var, GQL_Tagged_FbFriendlyName, 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 End If
UpdateRequestNumber() UpdateRequestNumber()
ChangeResponserMode(True) ChangeResponserMode(True)
@@ -270,6 +307,13 @@ Namespace API.Instagram
End Function End Function
#End Region #End Region
#Region "ValidateBaseTokens" #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 Protected Overridable Overloads Function ValidateBaseTokens() As Boolean
Return ValidateBaseTokens(Nothing) Return ValidateBaseTokens(Nothing)
End Function End Function
@@ -296,7 +340,12 @@ Namespace API.Instagram
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "navigate")) .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "navigate"))
End With End With
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) ParseTokens(r, 0)
Catch ex As Exception Catch ex As Exception
Finally Finally
@@ -307,6 +356,10 @@ Namespace API.Instagram
Try Try
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
ResetBaseTokens() 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 Select Case Attempt
Case 0 Case 0
Dim rr As RParams = RParams.DM(PageTokenRegexPatternDefault, 0, RegexReturn.List, EDP.ReturnValue) Dim rr As RParams = RParams.DM(PageTokenRegexPatternDefault, 0, RegexReturn.List, EDP.ReturnValue)
@@ -318,6 +371,7 @@ Namespace API.Instagram
.MatchSub = 1 .MatchSub = 1
.WhatGet = RegexReturn.Value .WhatGet = RegexReturn.Value
End With End With
BlockVersionID = RegexReplace(r, Regex_BlockVersionID)
For Each tt In tokens For Each tt In tokens
If Not Token_lsd.IsEmptyString And Not Token_dtsg.IsEmptyString Then If Not Token_lsd.IsEmptyString And Not Token_dtsg.IsEmptyString Then
Exit For Exit For
@@ -336,6 +390,7 @@ Namespace API.Instagram
Case 1 Case 1
Token_dtsg = RegexReplace(r, Regex_UserToken_dtsg) Token_dtsg = RegexReplace(r, Regex_UserToken_dtsg)
Token_lsd = RegexReplace(r, Regex_UserToken_lsd) Token_lsd = RegexReplace(r, Regex_UserToken_lsd)
BlockVersionID = RegexReplace(r, Regex_BlockVersionID)
End Select End Select
If Not ValidateBaseTokens() And Attempt = 0 Then ParseTokens(r, Attempt + 1) If Not ValidateBaseTokens() And Attempt = 0 Then ParseTokens(r, Attempt + 1)
End If End If

View File

@@ -39,6 +39,8 @@ Namespace API.Instagram
Private Const Name_TaggedChecked As String = "TaggedChecked" Private Const Name_TaggedChecked As String = "TaggedChecked"
Private Const Name_ForceUpdateUserName As String = "ForceUpdateUserName" Private Const Name_ForceUpdateUserName As String = "ForceUpdateUserName"
Private Const Name_ForceUpdateUserInfo As String = "ForceUpdateUserInfo" 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 #End Region
#Region "Declarations" #Region "Declarations"
Friend Structure PostKV : Implements IEContainerProvider Friend Structure PostKV : Implements IEContainerProvider
@@ -115,6 +117,13 @@ Namespace API.Instagram
Private UserNameRequested As Boolean = False Private UserNameRequested As Boolean = False
Friend Property ForceUpdateUserName As Boolean = False Friend Property ForceUpdateUserName As Boolean = False
Friend Property ForceUpdateUserInfo 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 #End Region
#Region "Loader" #Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) 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) TaggedChecked = .Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
ForceUpdateUserName = .Value(Name_ForceUpdateUserName).FromXML(Of Boolean)(False) ForceUpdateUserName = .Value(Name_ForceUpdateUserName).FromXML(Of Boolean)(False)
ForceUpdateUserInfo = .Value(Name_ForceUpdateUserInfo).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 Else
.Add(Name_LastCursor, LastCursor) .Add(Name_LastCursor, LastCursor)
.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger) .Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
@@ -153,6 +164,8 @@ Namespace API.Instagram
.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger) .Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
.Add(Name_ForceUpdateUserName, ForceUpdateUserName.BoolToInteger) .Add(Name_ForceUpdateUserName, ForceUpdateUserName.BoolToInteger)
.Add(Name_ForceUpdateUserInfo, ForceUpdateUserInfo.BoolToInteger) .Add(Name_ForceUpdateUserInfo, ForceUpdateUserInfo.BoolToInteger)
.Add(Name_IsVerifiedProfile, IsVerifiedProfile.BoolToInteger)
.Add(Name_IsVerifiedProfile_Checked, IsVerifiedProfile_Checked.BoolToInteger)
End If End If
End With End With
End Sub End Sub
@@ -164,7 +177,7 @@ Namespace API.Instagram
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions) With DirectCast(Obj, EditorExchangeOptions)
.ApplyBase(Me) .Apply(Me)
GetTimeline = .GetTimeline GetTimeline = .GetTimeline
GetReels = .GetReels GetReels = .GetReels
GetStories = .GetStories GetStories = .GetStories
@@ -179,6 +192,9 @@ Namespace API.Instagram
PutImageVideoFolder = .PutImageVideoFolder PutImageVideoFolder = .PutImageVideoFolder
IsVerifiedProfile = .IsVerifiedProfile
If IsVerifiedProfile Then IsVerifiedProfile_Checked = True
ForceUpdateUserName = .ForceUpdateUserName ForceUpdateUserName = .ForceUpdateUserName
ForceUpdateUserInfo = .ForceUpdateUserInfo ForceUpdateUserInfo = .ForceUpdateUserInfo
End With End With
@@ -317,6 +333,7 @@ Namespace API.Instagram
Private _LastWwwClaim As String = String.Empty Private _LastWwwClaim As String = String.Empty
Private _ResponserGQLMode As Boolean = False Private _ResponserGQLMode As Boolean = False
Private _UseGQL 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) Private Sub ChangeResponserMode(ByVal GQL As Boolean, Optional ByVal Force As Boolean = False)
If Not _ResponserGQLMode = GQL Or Force Then If Not _ResponserGQLMode = GQL Or Force Then
_ResponserGQLMode = GQL _ResponserGQLMode = GQL
@@ -346,8 +363,7 @@ Namespace API.Instagram
With .Headers With .Headers
.Remove("origin") .Remove("origin")
.Remove("authority") .Remove("authority")
.Remove(GQL_HEADER_FB_FRINDLY_NAME) UpdateHeadersGQL(String.Empty, False)
.Remove(GQL_HEADER_FB_LSD)
Dim hv$ = MySiteSettings.Responser.Headers.Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest)).IfNullOrEmpty("empty") Dim hv$ = MySiteSettings.Responser.Headers.Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest)).IfNullOrEmpty("empty")
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest, hv)) .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest, hv))
hv = MySiteSettings.Responser.Headers.Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode)).IfNullOrEmpty("cors") hv = MySiteSettings.Responser.Headers.Value(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode)).IfNullOrEmpty("cors")
@@ -491,26 +507,26 @@ Namespace API.Instagram
If Not errorFound Then LoadSavePostsKV(False) If Not errorFound Then LoadSavePostsKV(False)
End Try End Try
End Sub End Sub
'TODELETE: ValidateExtension
Protected Sub ValidateExtension() Protected Sub ValidateExtension()
Dim tmpList As List(Of UserMedia) = Nothing 'Dim tmpList As List(Of UserMedia) = Nothing
Try 'Try
Const heic$ = "heic" ' If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = ImgHeic) Then
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = heic) Then ' Dim m As UserMedia
Dim m As UserMedia ' tmpList = New List(Of UserMedia)
tmpList = New List(Of UserMedia) ' tmpList.ListAddList(_TempMediaList)
tmpList.ListAddList(_TempMediaList) ' _TempMediaList.Clear()
_TempMediaList.Clear() ' For i% = 0 To tmpList.Count - 1
For i% = 0 To tmpList.Count - 1 ' m = tmpList(i)
m = tmpList(i) ' _TempMediaList.Add(m)
_TempMediaList.Add(m) ' If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = ImgHeic Then _
If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = heic Then _ ' m.File.Extension = "jpg" : _TempMediaList.Add(m)
m.File.Extension = "jpg" : _TempMediaList.Add(m) ' Next
Next ' tmpList.Clear()
tmpList.Clear() ' End If
End If 'Catch ex As Exception
Catch ex As Exception ' If tmpList.ListExists Then _TempMediaList.Clear() : _TempMediaList.ListAddList(tmpList) : tmpList.Clear()
If tmpList.ListExists Then _TempMediaList.Clear() : _TempMediaList.ListAddList(tmpList) : tmpList.Clear() 'End Try
End Try
End Sub End Sub
Protected Overridable Sub UpdateResponser() Protected Overridable Sub UpdateResponser()
Try Try
@@ -525,7 +541,7 @@ Namespace API.Instagram
Protected Overrides Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse) Protected Overrides Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
Declarations.UpdateResponser(e, Responser, WwwClaimUpdate) Declarations.UpdateResponser(e, Responser, WwwClaimUpdate)
End Sub 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" Protected Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged" Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass" #Region "429 bypass"
@@ -663,6 +679,7 @@ Namespace API.Instagram
Dim StoriesList As List(Of String) = Nothing Dim StoriesList As List(Of String) = Nothing
Dim StoriesRequested As Boolean = False Dim StoriesRequested As Boolean = False
Dim dValue% = 1 Dim dValue% = 1
Dim __idIsEmpty As Boolean = ID.IsEmptyString
LastCursor = Cursor LastCursor = Cursor
Try Try
Do While dValue = 1 Do While dValue = 1
@@ -676,7 +693,6 @@ Namespace API.Instagram
Dim HasNextPage As Boolean = False Dim HasNextPage As Boolean = False
Dim EndCursor$ = String.Empty Dim EndCursor$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty
Dim TokensErrData$ = String.Empty
Dim PostIDKV As PostKV Dim PostIDKV As PostKV
Dim ENode() As Object = Nothing Dim ENode() As Object = Nothing
Dim processGetResponse As Boolean = True Dim processGetResponse As Boolean = True
@@ -684,14 +700,11 @@ Namespace API.Instagram
'Check environment 'Check environment
If Not IsSavedPosts Then If Not IsSavedPosts Then
If ID.IsEmptyString Then GetUserData() If _UseGQL And Cursor.IsEmptyString And Not Section = Sections.SavedPosts Then UpdateTokens(True)
If ID.IsEmptyString Then UserExists = False : _ForceSaveUserInfoOnException = True : Throw New Plugin.ExitException("can't get user ID") If ID.IsEmptyString Or __idIsEmpty Or Not IsVerifiedProfile_Checked Then GetUserData(Token)
If _UseGQL And Cursor.IsEmptyString And Not Section = Sections.SavedPosts Then If ID.IsEmptyString Then UserExists = False : _ForceSaveUserInfo = True : Throw New Plugin.ExitException("can't get user ID")
If Not ValidateBaseTokens() Then GetPageTokens() If ForceUpdateUserName Then GetUserNameById(Token)
If Not ValidateBaseTokens(TokensErrData) Then ValidateBaseTokens_Error(TokensErrData) If ForceUpdateUserInfo Then GetUserData(Token)
End If
If ForceUpdateUserName Then GetUserNameById()
If ForceUpdateUserInfo Then GetUserData()
End If End If
'Create query 'Create query
@@ -703,7 +716,7 @@ Namespace API.Instagram
MySiteSettings.TooManyRequests(False) MySiteSettings.TooManyRequests(False)
GoTo NextPageBlock GoTo NextPageBlock
Else 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}") If(Cursor.IsEmptyString, String.Empty, $"&max_id={Cursor}")
ENode = Nothing ENode = Nothing
End If End If
@@ -714,7 +727,7 @@ Namespace API.Instagram
processGetResponse = False processGetResponse = False
Case Sections.SavedPosts Case Sections.SavedPosts
ChangeResponserMode(False) ChangeResponserMode(False)
EndCursor = SavedPostsDownload(String.Empty, Token) EndCursor = DownloadSavedPosts(Cursor, Token)
HasNextPage = Not EndCursor.IsEmptyString HasNextPage = Not EndCursor.IsEmptyString
MySiteSettings.TooManyRequests(False) MySiteSettings.TooManyRequests(False)
ThrowAny(Token) ThrowAny(Token)
@@ -726,7 +739,7 @@ Namespace API.Instagram
ENode = {"data", "xdt_api__v1__usertags__user_id__feed_connection"} ENode = {"data", "xdt_api__v1__usertags__user_id__feed_connection"}
processGetResponse = False processGetResponse = False
Else Else
Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}" Dim vars$ = "{""id"":" & ID & $",""first"":{PostNumberPerRequest},""after"":""" & Cursor & """}"
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars) vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)
URL = $"https://www.instagram.com/graphql/query/?doc_id=17946422347485809&variables={vars}" URL = $"https://www.instagram.com/graphql/query/?doc_id=17946422347485809&variables={vars}"
ENode = {"data", "user", "edge_user_to_photos_of_you"} ENode = {"data", "user", "edge_user_to_photos_of_you"}
@@ -952,7 +965,7 @@ NextPageBlock:
End Try End Try
End Sub End Sub
''' <summary>Cursor</summary> ''' <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 URL$ = $"https://www.instagram.com/api/v1/feed/saved/posts/?max_id={Cursor}"
Dim HasNextPage As Boolean = False Dim HasNextPage As Boolean = False
Dim NextCursor$ = String.Empty Dim NextCursor$ = String.Empty
@@ -1241,25 +1254,38 @@ NextPageBlock:
End Sub End Sub
#End Region #End Region
#Region "GetUserId, GetUserName" #Region "GetUserId, GetUserName"
Private Sub GetUserData() Private Sub GetUserData(ByVal Token As CancellationToken)
Dim __idFound As Boolean = False Dim __idFound As Boolean = False
If ForceUpdateUserInfo Then ForceUpdateUserInfo = False : _ForceSaveUserInfo = True If ForceUpdateUserInfo Then ForceUpdateUserInfo = False : _ForceSaveUserInfo = True
Try 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) ChangeResponserMode(False)
UpdateRequestNumber() 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 If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r) Using j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing AndAlso j.Contains({"data", "user"}) Then If Not j Is Nothing AndAlso j.Contains({"data", "user"}) Then
With j({"data", "user"}) With j({"data", "user"})
ID = .Value("id") If Not ____dataGql Or ID.IsEmptyString Then ID = .Value("id")
__idFound = True __idFound = True
If Not .Value("username").IsEmptyString Then NameTrue = .Value("username")
UserSiteNameUpdate(.Value("full_name")) UserSiteNameUpdate(.Value("full_name"))
IsVerifiedProfile = .Value("is_verified").FromXML(Of Boolean)(False)
IsVerifiedProfile_Checked = True
Dim descr$ = .Value("biography") 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) 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") Dim eUrl$ = .Value("external_url")
If Not eUrl.IsEmptyString AndAlso (descr.IsEmptyString OrElse Not descr.Contains(eUrl)) Then descr.StringAppendLine(eUrl) If Not eUrl.IsEmptyString AndAlso (descr.IsEmptyString OrElse Not descr.Contains(eUrl)) Then descr.StringAppendLine(eUrl)
UserDescriptionUpdate(descr) UserDescriptionUpdate(descr)
Dim f As New SFile With {.Path = DownloadContentDefault_GetRootDir(), .Name = "ProfilePicture", .Extension = "jpg"} Dim f As New SFile With {.Path = DownloadContentDefault_GetRootDir(), .Name = "ProfilePicture", .Extension = "jpg"}
f = SFile.IndexReindex(f) f = SFile.IndexReindex(f)
If Not f.Exists Then If Not f.Exists Then
@@ -1283,9 +1309,17 @@ NextPageBlock:
ChangeResponserMode(_UseGQL) ChangeResponserMode(_UseGQL)
End Try End Try
End Sub End Sub
Private Function GetUserNameById() As Boolean Private Function GetUserNameById(ByVal Token As CancellationToken) As Boolean
UserNameRequested = True UserNameRequested = True
If ForceUpdateUserName Then ForceUpdateUserName = False : _ForceSaveUserInfo = 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 Try
If Not ID.IsEmptyString Then If Not ID.IsEmptyString Then
UpdateRequestNumber() UpdateRequestNumber()
@@ -1319,6 +1353,7 @@ NextPageBlock:
#Region "Pinned stories" #Region "Pinned stories"
Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal GetUserStory As Boolean, ByVal Token As CancellationToken) Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal GetUserStory As Boolean, ByVal Token As CancellationToken)
Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}" Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}"
Const hPattern$ = "highlight:"
Dim tmpList As IEnumerable(Of String) = Nothing Dim tmpList As IEnumerable(Of String) = Nothing
Dim qStr$, r$ Dim qStr$, r$
Dim i% = -1 Dim i% = -1
@@ -1331,7 +1366,7 @@ NextPageBlock:
If GetUserStory Then If GetUserStory Then
qStr = $"https://www.instagram.com/api/v1/feed/reels_media/?reel_ids={ID}" qStr = $"https://www.instagram.com/api/v1/feed/reels_media/?reel_ids={ID}"
Else 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 End If
UpdateRequestNumber() UpdateRequestNumber()
r = Responser.GetResponse(qStr,, EDP.ThrowException) r = Responser.GetResponse(qStr,, EDP.ThrowException)
@@ -1380,6 +1415,11 @@ NextPageBlock:
End If End If
End Sub End Sub
Private Function GetStoriesList() As List(Of String) 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() UpdateRequestNumber()
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/highlights/{ID}/highlights_tray/",, EDP.ThrowException) Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/highlights/{ID}/highlights_tray/",, EDP.ThrowException)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -1389,12 +1429,20 @@ NextPageBlock:
End Using End Using
End If End If
Return Nothing Return Nothing
End If
End Function End Function
#End Region #End Region
#Region "Download content" #Region "Download content"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
Protected Overrides 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 #End Region
#Region "Erase" #Region "Erase"
Protected Overrides Sub EraseData_AdditionalDataFiles() Protected Overrides Sub EraseData_AdditionalDataFiles()
@@ -1417,7 +1465,7 @@ NextPageBlock:
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal s As Object = Nothing) As Integer Optional ByVal s As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then '404 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 ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Or Responser.StatusCode = HttpStatusCode.Unauthorized Then '400, 401
HasError = True HasError = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]" MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
@@ -1434,7 +1482,7 @@ NextPageBlock:
MyMainLOG = $"Number of requests before error 429: {RequestsCount}" MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1 Return 1
ElseIf Responser.StatusCode = 560 Or Responser.StatusCode = HttpStatusCode.InternalServerError Then '560, 500 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)" MyMainLOG = $"{ToStringForLog()}: Stories downloading skipped (560)"
Return ErrHandlingValueStories Return ErrHandlingValueStories
Else 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"}} {{"files", "full", "url"}}
} }
Friend Property Rules As DynamicRulesEnv 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 Module
End Namespace End Namespace

View File

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

View File

@@ -99,6 +99,19 @@ Namespace API.OnlyFans
End Get End Get
End Property End Property
#End Region #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" #Region "OFScraper"
<PClonable, PXML("OFScraperPath")> Private ReadOnly Property OFScraperPath_XML As PropertyValue <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)> <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 .CookiesUpdateMode = CookieKeeper.UpdateModes.Disabled
.Cookies.ChangedAllowInternalDrop = False .Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False .Cookies.Changed = False
.Cookies.DateProvider = New CookieDateProvider
With .Headers With .Headers
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform)) .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile)) .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile))
@@ -285,6 +299,8 @@ Namespace API.OnlyFans
UpdateRules401_XML = New PropertyValue(False) UpdateRules401_XML = New PropertyValue(False)
OpenPostsUsingID_XML = New PropertyValue(True)
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "onlyfans.com/"), 1, EDP.ReturnValue) UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "onlyfans.com/"), 1, EDP.ReturnValue)
UrlPatternUser = "https://onlyfans.com/{0}" UrlPatternUser = "https://onlyfans.com/{0}"
ImageVideoContains = "onlyfans.com" ImageVideoContains = "onlyfans.com"
@@ -363,8 +379,9 @@ Namespace API.OnlyFans
End If End If
If p.IsEmptyString Then If p.IsEmptyString Then
Return GetUserUrl(User) Return GetUserUrl(User)
ElseIf CBool(OpenPostsUsingID.Value) Then
Return String.Format(UserPostPattern, p, If(User.ID.IsEmptyString, User.NameTrue, $"u{User.ID}"))
Else Else
'Return String.Format(UserPostPattern, p, If(User.ID.IsEmptyString, User.Name, $"u{User.ID}"))
Return String.Format(UserPostPattern, p, User.NameTrue) Return String.Format(UserPostPattern, p, User.NameTrue)
End If End If
Else Else

View File

@@ -31,6 +31,7 @@ Namespace API.OnlyFans
Friend Property CCookie As CookieKeeper = Nothing Friend Property CCookie As CookieKeeper = Nothing
Private Const HeaderSign As String = "Sign" Private Const HeaderSign As String = "Sign"
Private Const HeaderTime As String = "Time" Private Const HeaderTime As String = "Time"
Private Const LabelDRM As String = "DRM"
Private ReadOnly HighlightsList As List(Of String) Private ReadOnly HighlightsList As List(Of String)
Friend Property MediaDownloadTimeline As Boolean = True Friend Property MediaDownloadTimeline As Boolean = True
Friend Property MediaDownloadStories As Boolean = True Friend Property MediaDownloadStories As Boolean = True
@@ -41,6 +42,11 @@ Namespace API.OnlyFans
Return HOST.Source Return HOST.Source
End Get End Get
End Property End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {LabelDRM}
End Get
End Property
#End Region #End Region
#Region "Load" #Region "Load"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) 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) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions) With DirectCast(Obj, UserExchangeOptions)
.ApplyBase(Me) .Apply(Me)
MediaDownloadTimeline = .DownloadTimeline MediaDownloadTimeline = .DownloadTimeline
MediaDownloadStories = .DownloadStories MediaDownloadStories = .DownloadStories
MediaDownloadHighlights = .DownloadHighlights MediaDownloadHighlights = .DownloadHighlights
@@ -88,6 +94,7 @@ Namespace API.OnlyFans
Private _DownloadedPostsSession As Integer = 0 Private _DownloadedPostsSession As Integer = 0
Private FunctionErr As Integer = FunctionErrDef Private FunctionErr As Integer = FunctionErrDef
Private Const FunctionErrDef As Integer = -100 Private Const FunctionErrDef As Integer = -100
Private _TimelineDownloading As Boolean = False
Private Sub ValidateOFScraper() Private Sub ValidateOFScraper()
_OFScraperExists = ACheck(MySettings.OFScraperPath.Value) AndAlso CStr(MySettings.OFScraperPath.Value).CSFile.Exists _OFScraperExists = ACheck(MySettings.OFScraperPath.Value) AndAlso CStr(MySettings.OFScraperPath.Value).CSFile.Exists
End Sub End Sub
@@ -110,7 +117,9 @@ Namespace API.OnlyFans
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "Unable to get user ID") If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "Unable to get user ID")
End If End If
_TimelineDownloading = True
If MediaDownloadTimeline Then DownloadTimeline(IIf(IsSavedPosts, 0, String.Empty), Token) If MediaDownloadTimeline Then DownloadTimeline(IIf(IsSavedPosts, 0, String.Empty), Token)
_TimelineDownloading = False
If Not IsSavedPosts Then If Not IsSavedPosts Then
If MediaDownloadStories And FunctionErr = FunctionErrDef Then DownloadStories(Token) If MediaDownloadStories And FunctionErr = FunctionErrDef Then DownloadStories(Token)
If MediaDownloadHighlights And FunctionErr = FunctionErrDef Then DownloadHighlights(Token) If MediaDownloadHighlights And FunctionErr = FunctionErrDef Then DownloadHighlights(Token)
@@ -155,8 +164,12 @@ Namespace API.OnlyFans
If IsSavedPosts Then If IsSavedPosts Then
path = $"/api2/v2/posts/bookmarks/all/?format=infinite&limit=10&offset={Cursor}" 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 Else
path = $"/api2/v2/users/{ID}/posts/medias?limit=50&order=publish_date_desc&skip_users=all&format=infinite&counters=1" 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" If Not Cursor.IsEmptyString Then path &= $"&counters=0&beforePublishTime={Cursor}" Else path &= "&counters=1"
End If End If
@@ -491,7 +504,7 @@ Namespace API.OnlyFans
ID = j.Value("id") ID = j.Value("id")
UserSiteNameUpdate(j.Value("name")) UserSiteNameUpdate(j.Value("name"))
Dim descr$ = j.Value("about") 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) UserDescriptionUpdate(descr)
SimpleDownloadAvatar(j.Value("avatar")) SimpleDownloadAvatar(j.Value("avatar"))
SimpleDownloadAvatar(j.Value("header")) SimpleDownloadAvatar(j.Value("header"))
@@ -623,6 +636,7 @@ Namespace API.OnlyFans
#Region "OFScraper support" #Region "OFScraper support"
Private Function OFS_DownloadFile(ByVal URL As String, ByVal Token As CancellationToken) As List(Of SFile) Private Function OFS_DownloadFile(ByVal URL As String, ByVal Token As CancellationToken) As List(Of SFile)
Try Try
If Labels.Count = 0 OrElse Not Labels.Contains(LabelDRM) Then Labels.Add(LabelDRM) : _ForceSaveUserInfo = True
Const requestPattern$ = """{0}"" manual --config ""{1}"" --url {2}" Const requestPattern$ = """{0}"" manual --config ""{1}"" --url {2}"
Dim conf As SFile = OFS_CreateConfig() Dim conf As SFile = OFS_CreateConfig()
If conf.Exists Then If conf.Exists Then
@@ -787,6 +801,7 @@ Namespace API.OnlyFans
End If End If
End If End If
End If End If
If Not f.Exists Then f = Nothing
Return f Return f
End If End If
Return Nothing Return Nothing
@@ -827,6 +842,8 @@ Namespace API.OnlyFans
Return 3 Return 3
ElseIf Responser.StatusCode = Net.HttpStatusCode.InternalServerError Then '500 ElseIf Responser.StatusCode = Net.HttpStatusCode.InternalServerError Then '500
Return 3 Return 3
ElseIf Not _TimelineDownloading And Responser.StatusCode = Net.HttpStatusCode.BadGateway Then '502
Return 3
Else Else
Return 0 Return 0
End If End If

View File

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

View File

@@ -97,7 +97,7 @@ Namespace API.Pinterest
Return New EditorExchangeOptions(Me) Return New EditorExchangeOptions(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is 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 Sub
#End Region #End Region
#Region "Download overrides" #Region "Download overrides"

View File

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

View File

@@ -22,7 +22,7 @@ Namespace API.PornHub
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim files As List(Of Sizes) = RegexFields(Of Sizes)(r, {Regex_M3U8_FilesList}, {1, 2}, EDP.ReturnValue) Dim files As List(Of Sizes) = RegexFields(Of Sizes)(r, {Regex_M3U8_FilesList}, {1, 2}, EDP.ReturnValue)
Dim file$ 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 If files.ListExists Then
files.Sort() files.Sort()
file = files(0).Data file = files(0).Data

View File

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

View File

@@ -6,13 +6,17 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.IO
Imports System.Security.Policy
Imports System.Threading Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON 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 Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.PornHub Namespace API.PornHub
Friend Class UserData : Inherits UserDataBase : Implements IPSite Friend Class UserData : Inherits UserDataBase : Implements IPSite
@@ -52,11 +56,12 @@ Namespace API.PornHub
Friend Title As String Friend Title As String
Friend UserRef As String Friend UserRef As String
Friend Type As VideoTypes Friend Type As VideoTypes
Friend Function ToUserMedia(Optional ByVal SpecialFolder As String = Nothing) As UserMedia Friend Function ToUserMedia(Optional ByVal SpecialFolder As String = Nothing, Optional ByVal UseYTDLP As Boolean = False) As UserMedia
Return New UserMedia(URL, UTypes.VideoPre) With { Return New UserMedia(URL, If(UseYTDLP, UTypes.Video, UTypes.VideoPre)) With {
.File = If(Title.IsEmptyString, .File, New SFile($"{Title}.mp4")), .File = If(Title.IsEmptyString, .File, New SFile($"{TitleHtmlConverter(Title)}.mp4")),
.Post = ID, .Post = ID,
.SpecialFolder = SpecialFolder .SpecialFolder = SpecialFolder,
.Type = If(UseYTDLP And Not Title.IsEmptyString, UTypes.Video, UTypes.VideoPre)
} }
End Function End Function
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
@@ -96,6 +101,9 @@ Namespace API.PornHub
Return Me Return Me
End Function End Function
End Structure End Structure
Private Structure PHObj : Implements IThumbList
Friend Property Thumbs As List(Of String) Implements IThumbList.Thumbs
End Structure
#End Region #End Region
#Region "Enums" #Region "Enums"
Private Enum VideoTypes Private Enum VideoTypes
@@ -174,6 +182,7 @@ Namespace API.PornHub
Return DirectCast(HOST.Source, SiteSettings) Return DirectCast(HOST.Source, SiteSettings)
End Get End Get
End Property End Property
Private MyCache As CacheKeeper = Nothing
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
@@ -258,11 +267,12 @@ Namespace API.PornHub
Private _PageVideosRepeat As Integer = 0 Private _PageVideosRepeat As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try Try
UpdateM3U8URLS = False
PlaylistToken = String.Empty PlaylistToken = String.Empty
Responser.ResetStatus() Responser.ResetStatus()
If Not CBool(MySettings.CookiesUse.Value) Then Responser.Cookies.Clear()
_PageVideosRepeat = 0 _PageVideosRepeat = 0
SessionPosts.Clear() SessionPosts.Clear()
UseInternalDownloadFileFunction = MySettings.YTDLP_Use.Value
If IsSavedPosts Then If IsSavedPosts Then
PersonType = PersonTypeUser PersonType = PersonTypeUser
@@ -301,7 +311,7 @@ Namespace API.PornHub
End If End If
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) _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) If limit > 0 And _TempMediaList.Count > limit Then _TempMediaList.ListAddList(_TempMediaList.ListTake(-1, limit), LAP.ClearBeforeAdd)
End If End If
@@ -338,6 +348,7 @@ Namespace API.PornHub
ProgressPre.ChangeMax(1) ProgressPre.ChangeMax(1)
Try Try
Dim specFolder$ = String.Empty Dim specFolder$ = String.Empty
Dim useYtdlp As Boolean = MySettings.YTDLP_Use.Value
Dim tryNextPage As Boolean = False Dim tryNextPage As Boolean = False
Dim limit% = If(DownloadTopCount, -1) Dim limit% = If(DownloadTopCount, -1)
Dim cBefore% = _TempMediaList.Count Dim cBefore% = _TempMediaList.Count
@@ -385,7 +396,7 @@ Namespace API.PornHub
If PersonType = PersonTypeCannel Then If PersonType = PersonTypeCannel Then
l = l.ListTake(4, l.Count) l = l.ListTake(4, l.Count)
Else Else
l.RemoveAll(Function(uv) uv.UserRef.IsEmptyString OrElse Not uv.UserRef = usrRef) l.RemoveAll(Function(uv) Not uv.UserRef.IsEmptyString AndAlso Not uv.UserRef = usrRef)
End If End If
ElseIf Type = VideoTypes.Favorite Then ElseIf Type = VideoTypes.Favorite Then
l.RemoveAll(Function(uv) uv.Type = VideoTypes.Private) l.RemoveAll(Function(uv) uv.Type = VideoTypes.Private)
@@ -405,7 +416,7 @@ Namespace API.PornHub
_TempPostsList.Add(uv.ID) _TempPostsList.Add(uv.ID)
newPostsFound = True newPostsFound = True
Return False Return False
ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(uv.id) Then ElseIf SessionPosts.Count > 0 AndAlso SessionPosts.Contains(uv.ID) Then
prevPostsFound = True prevPostsFound = True
Return True Return True
Else Else
@@ -417,7 +428,7 @@ Namespace API.PornHub
'Debug.WriteLineIf(l.Count > 0, l.Select(Function(ll) ll.Title).ListToString(vbNewLine)) 'Debug.WriteLineIf(l.Count > 0, l.Select(Function(ll) ll.Title).ListToString(vbNewLine))
If prevPostsFound And Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : _PageVideosRepeat += 1 If prevPostsFound And Not pageRepeatSet And Not newPostsFound Then pageRepeatSet = True : _PageVideosRepeat += 1
If prevPostsFound And newPostsFound And pageRepeatSet Then _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) SessionPosts.ListAddList(newLastPageIDs, LNC)
newLastPageIDs.Clear() newLastPageIDs.Clear()
@@ -557,6 +568,7 @@ Namespace API.PornHub
If .ListExists(3) Then url = .Item(2).IfNullOrEmpty(.Item(1)).StringTrim If .ListExists(3) Then url = .Item(2).IfNullOrEmpty(.Item(1)).StringTrim
End With End With
If url.IsEmptyString Then url = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto2) If url.IsEmptyString Then url = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto2)
If url.IsEmptyString Then url = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto3)
Return url Return url
End Function End Function
Private Overloads Function DownloadUserPhotos_PornHub(ByVal Page As Integer, ByVal AlbumID As String, ByVal AlbumName As String, Private Overloads Function DownloadUserPhotos_PornHub(ByVal Page As Integer, ByVal AlbumID As String, ByVal AlbumName As String,
@@ -648,6 +660,21 @@ Namespace API.PornHub
#End Region #End Region
#End Region #End Region
#Region "ReparseVideo" #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) Protected Overloads Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
If IsSubscription Then If IsSubscription Then
ReparseVideoSubscriptions(Token) ReparseVideoSubscriptions(Token)
@@ -659,10 +686,12 @@ Namespace API.PornHub
Optional ByRef Data As IYouTubeMediaContainer = Nothing) Optional ByRef Data As IYouTubeMediaContainer = Nothing)
Const ERR_NEW_URL$ = "ERR_NEW_URL" Const ERR_NEW_URL$ = "ERR_NEW_URL"
Dim URL$ = String.Empty Dim URL$ = String.Empty
Dim useYtdlp As Boolean = MySettings.YTDLP_Use.Value
Try Try
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
Dim m As UserMedia Dim m As UserMedia
Dim r$, NewUrl$, tmpName$ Dim r$, NewUrl$, tmpName$
Dim isCurl%
ProgressPre.ChangeMax(_TempMediaList.Count) ProgressPre.ChangeMax(_TempMediaList.Count)
For i% = _TempMediaList.Count - 1 To 0 Step -1 For i% = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform() ProgressPre.Perform()
@@ -671,16 +700,22 @@ Namespace API.PornHub
ThrowAny(Token) ThrowAny(Token)
Try Try
URL = m.URL 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 If Not r.IsEmptyString Then
NewUrl = CreateVideoURL(r) NewUrl = String.Empty
If NewUrl.IsEmptyString Then If Not useYtdlp Then NewUrl = CreateVideoURL(r)
If Not useYtdlp And NewUrl.IsEmptyString Then
Throw New Exception With {.HelpLink = ERR_NEW_URL} Throw New Exception With {.HelpLink = ERR_NEW_URL}
Else
If useYtdlp Then
m.Type = UTypes.Video
Else Else
m.URL = NewUrl m.URL = NewUrl
m.Type = UTypes.m3u8 m.Type = UTypes.m3u8
If CreateFileName Then End If
tmpName = RegexReplace(r, RegexVideoPageTitle) If CreateFileName Or useYtdlp Then
tmpName = GetVideoTitle(r, URL)
If Not tmpName.IsEmptyString Then If Not tmpName.IsEmptyString Then
If Not Data Is Nothing Then Data.Title = tmpName If Not Data Is Nothing Then Data.Title = tmpName
m.File.Name = TitleHtmlConverter(tmpName) m.File.Name = TitleHtmlConverter(tmpName)
@@ -689,9 +724,11 @@ Namespace API.PornHub
End If End If
_TempMediaList(i) = m _TempMediaList(i) = m
End If End If
Else Exit For
ElseIf Not CBool(isCurl) Then
_TempMediaList.RemoveAt(i) _TempMediaList.RemoveAt(i)
End If End If
Next
Catch mid_ex As Exception Catch mid_ex As Exception
If mid_ex.HelpLink = ERR_NEW_URL OrElse DownloadingException(mid_ex, "") = 1 Then If mid_ex.HelpLink = ERR_NEW_URL OrElse DownloadingException(mid_ex, "") = 1 Then
m.State = UserMedia.States.Missing m.State = UserMedia.States.Missing
@@ -713,6 +750,10 @@ Namespace API.PornHub
Dim m As UserMedia Dim m As UserMedia
Dim r$, URL$, tmpName$, thumb$ Dim r$, URL$, tmpName$, thumb$
Dim c% = 0 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) Dim rErr As New ErrorsDescriber(EDP.ReturnValue)
Progress.Maximum += _TempMediaList.Count Progress.Maximum += _TempMediaList.Count
For i% = _TempMediaList.Count - 1 To 0 Step -1 For i% = _TempMediaList.Count - 1 To 0 Step -1
@@ -727,10 +768,24 @@ Namespace API.PornHub
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
m.Type = UTypes.m3u8 m.Type = UTypes.m3u8
thumbObj = New PHObj With {.Thumbs = New List(Of String)}
thumbAdded = False
thumb = RegexReplace(r, Regex_VideosThumb_OG_IMAGE) 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 If Not tmpName.IsEmptyString Then
m.File.Name = TitleHtmlConverter(tmpName) m.File.Name = TitleHtmlConverter(tmpName)
m.File.Extension = "mp4" m.File.Extension = "mp4"
@@ -759,6 +814,7 @@ Namespace API.PornHub
#Region "ReparseMissing" #Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken) Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer) Dim rList As New List(Of Integer)
If CBool(MySettings.YTDLP_Use.Value) Then UseInternalDownloadFileFunction = True
Try Try
If ContentMissingExists Then If ContentMissingExists Then
Dim m As UserMedia Dim m As UserMedia
@@ -770,6 +826,12 @@ Namespace API.PornHub
m = _ContentList(i) m = _ContentList(i)
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token) 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) r = Responser.Curl(m.URL_BASE,, eCurl)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim NewUrl$ = CreateVideoURL(r) Dim NewUrl$ = CreateVideoURL(r)
@@ -780,48 +842,72 @@ Namespace API.PornHub
End If End If
End If End If
End If End If
End If
Next Next
End If End If
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, "missing data downloading error") ProcessException(ex, Token, "missing data downloading error")
Finally Finally
If rList.Count > 0 Then ReparseMissing_ClearList(rList)
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try End Try
End Sub End Sub
#End Region #End Region
#Region "Download content" #Region "Download content"
Private UpdateM3U8URLS As Boolean = False
Private UpdateM3U8URLS_Error As Boolean = False
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
Try : DownloadContentDefault(Token) : Finally : UpdateM3U8URLS = False : End Try DownloadContentDefault(Token)
End Sub End Sub
Protected Overloads Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, Protected Overloads Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken) As SFile ByVal Token As CancellationToken) As SFile
UpdateM3U8URLS_Error = False Return DownloadM3U8(URL, Media, DestinationFile, Token, 0)
Return DownloadM3U8(URL, Media, DestinationFile, Token, UpdateM3U8URLS)
End Function End Function
Private Overloads Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, 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 Try
If Second Then If Round > 0 Then
Dim r$ = Responser.Curl(Media.URL_BASE,, EDP.ReturnValue) Dim r$ = Responser.Curl(Media.URL_BASE,, EDP.ReturnValue)
If Not r.IsEmptyString Then Media.URL = CreateVideoURL(r).IfNullOrEmpty(URL) : URL = Media.URL If Not r.IsEmptyString Then Media.URL = CreateVideoURL(r).IfNullOrEmpty(URL) : URL = Media.URL
End If End If
Dim f As SFile = M3U8.Download(URL, Responser, DestinationFile, DownloadUHD, Token, Progress, Not IsSingleObjectDownload) 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 Return f
Catch ex As Exception Catch ex As Exception
If Not UpdateM3U8URLS_Error Then If Round < MaxRound Then
UpdateM3U8URLS_Error = True
Thread.Sleep(1000) Thread.Sleep(1000)
Return DownloadM3U8(URL, Media, DestinationFile, Token, True) Return DownloadM3U8(URL, Media, DestinationFile, Token, Round + 1)
End If End If
Return Nothing Return Nothing
End Try End Try
End Function 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 #End Region
#Region "CreateVideoURL" #Region "CreateVideoURL"
Private Function CreateVideoURL(ByVal r As String) As String Private Function CreateVideoURL(ByVal r As String) As String
@@ -915,9 +1001,43 @@ Namespace API.PornHub
End Try End Try
End Function End Function
#End Region #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" #Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken) Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
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)) _TempMediaList.Add(New UserMedia(Data.URL, UTypes.VideoPre))
ReparseVideo(Token, True, Data) ReparseVideo(Token, True, Data)
End Sub End Sub
@@ -939,7 +1059,7 @@ Namespace API.PornHub
#End Region #End Region
#Region "IDisposable Support" #Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then SessionPosts.Clear() If Not disposedValue And disposing Then SessionPosts.Clear() : MyCache.DisposeIfReady
MyBase.Dispose(disposing) MyBase.Dispose(disposing)
End Sub End Sub
#End Region #End Region

View File

@@ -44,7 +44,7 @@ Namespace API.PornHub
DownloadGifs = Not v = CheckState.Unchecked DownloadGifs = Not v = CheckState.Unchecked
MySettings = s MySettings = s
End Sub End Sub
Friend Overrides Sub Apply(ByRef u As IPSite) Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u) MyBase.Apply(u)
With DirectCast(u, UserData) With DirectCast(u, UserData)
.DownloadUHD = DownloadUHD .DownloadUHD = DownloadUHD

View File

@@ -23,24 +23,14 @@ Namespace API.Reddit
Friend Class SiteSettings : Inherits SiteSettingsBase : Implements DownDetector.IDownDetector Friend Class SiteSettings : Inherits SiteSettingsBase : Implements DownDetector.IDownDetector
#Region "Declarations" #Region "Declarations"
#Region "Authorization" #Region "Authorization"
Private Const ApiClientID_Default As String = "dYctRA-SIJxyykHe27lGZg"
Private Const ApiClientSecret_Default As String = "_5D6KzplRPDga-es1YlpzDIe9hiFlg"
<PropertyOption(ControlText:="Login", ControlToolTip:="Your authorization username", IsAuth:=True), PXML, PClonable(Clone:=False)> <PropertyOption(ControlText:="Login", ControlToolTip:="Your authorization username", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property AuthUserName As PropertyValue Friend ReadOnly Property AuthUserName As PropertyValue
<PropertyOption(ControlText:="Password", ControlToolTip:="Your authorization password", IsAuth:=True), PXML, PClonable(Clone:=False)> <PropertyOption(ControlText:="Password", ControlToolTip:="Your authorization password", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property AuthPassword As PropertyValue Friend ReadOnly Property AuthPassword As PropertyValue
<PropertyOption(ControlText:="Client ID", ControlToolTip:="Your registered app client ID", IsAuth:=True), PXML, PClonable(Clone:=False)> <PropertyOption(ControlText:="Client ID", ControlToolTip:="Your registered app client ID", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property ApiClientID As PropertyValue Friend ReadOnly Property ApiClientID As PropertyValue
<PropertyUpdater(NameOf(ApiClientID))> Private Function ApiClientID_SetDefault() As Boolean
ApiClientID.Value = ApiClientID_Default
Return True
End Function
<PropertyOption(ControlText:="Client Secret", ControlToolTip:="Your registered app client secret", IsAuth:=True), PXML, PClonable(Clone:=False)> <PropertyOption(ControlText:="Client Secret", ControlToolTip:="Your registered app client secret", IsAuth:=True), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property ApiClientSecret As PropertyValue Friend ReadOnly Property ApiClientSecret As PropertyValue
<PropertyUpdater(NameOf(ApiClientSecret))> Private Function ApiClientSecret_SetDefault() As Boolean
ApiClientSecret.Value = ApiClientSecret_Default
Return True
End Function
<PropertyOption(ControlText:="Bearer token", <PropertyOption(ControlText:="Bearer token",
ControlToolTip:="Bearer token (can be null)." & vbCr & ControlToolTip:="Bearer token (can be null)." & vbCr &
"If you are using cookies to download the timeline, it is highly recommended that you add a token." & vbCr & "If you are using cookies to download the timeline, it is highly recommended that you add a token." & vbCr &
@@ -238,7 +228,14 @@ Namespace API.Reddit
Return AvailableTrueValue(What) AndAlso UpdateTokenIfRequired() Return AvailableTrueValue(What) AndAlso UpdateTokenIfRequired()
End Function End Function
Private Function AvailableTrueValue(ByVal What As Download) As Boolean 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 End Function
Friend Overrides Sub DownloadDone(ByVal What As Download) Friend Overrides Sub DownloadDone(ByVal What As Download)
SessionInterrupted = False SessionInterrupted = False

View File

@@ -136,7 +136,7 @@ Namespace API.Reddit
DownloadTextSpecialFolder = .DownloadTextSpecialFolder DownloadTextSpecialFolder = .DownloadTextSpecialFolder
RedGifsAccount = .RedGifsAccount RedGifsAccount = .RedGifsAccount
RedditAccount = .RedditAccount RedditAccount = .RedditAccount
If TypeOf Options Is RedditViewExchange Then DirectCast(Options, RedditViewExchange).ApplyBase(Me) If TypeOf Options Is RedditViewExchange Then DirectCast(Options, RedditViewExchange).Apply(Me)
End With End With
End If End If
End Sub End Sub
@@ -355,7 +355,11 @@ Namespace API.Reddit
Dim _PostID As Func(Of String) = Function() PostTmp.IfNullOrEmpty(PostID) 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" '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" 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) ThrowAny(Token)
Wait429() Wait429()
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
@@ -583,8 +587,6 @@ Namespace API.Reddit
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, PostID, PostDate, UserID,, PostText), LNC) _TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, PostID, PostDate, UserID,, PostText), LNC)
_TotalPostsDownloaded += 1 _TotalPostsDownloaded += 1
End If End If
ElseIf CreateImgurMedia(tmpUrl, PostID, PostDate, UserID, IsChannel, PostText) Then
_TotalPostsDownloaded += 1
ElseIf DownloadGallery(e, PostID, PostDate, UserID, SaveToCache, PostText) Then ElseIf DownloadGallery(e, PostID, PostDate, UserID, SaveToCache, PostText) Then
_TotalPostsDownloaded += 1 _TotalPostsDownloaded += 1
ElseIf Not If(e({"media"}, "type")?.Value, String.Empty).IsEmptyString Then ElseIf Not If(e({"media"}, "type")?.Value, String.Empty).IsEmptyString Then
@@ -778,62 +780,15 @@ Namespace API.Reddit
End Function End Function
#End Region #End Region
#Region "Download Base Functions" #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, 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 _UserID As String = Nothing, Optional ByVal FirstOnly As Boolean = False,
Optional ByVal PostText As String = Nothing) As Boolean Optional ByVal PostText As String = Nothing) As Boolean
Try Try
Dim added As Boolean = False Dim added As Boolean = False
Dim node As EContainer = Nothing Dim node As EContainer = Nothing
Dim m As UserMedia
Dim isGif As Boolean
Dim i%
If e.Contains("media_metadata") Then If e.Contains("media_metadata") Then
node = e("media_metadata") node = e("media_metadata")
ElseIf e.Contains("mediaMetadata") Then ElseIf e.Contains("mediaMetadata") Then
@@ -842,13 +797,26 @@ Namespace API.Reddit
If If(node?.Count, 0) > 0 Then If If(node?.Count, 0) > 0 Then
Dim t As EContainer Dim t As EContainer
For Each n As EContainer In node 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 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 added = True
If FirstOnly Then Exit For If FirstOnly Then Exit For
End If End If
Next Next
Next
End If End If
Return added Return added
Catch ex As Exception Catch ex As Exception
@@ -1022,11 +990,11 @@ Namespace API.Reddit
If .ListExists AndAlso ParseContainer(.Self, m.Post.ID, String.Empty,,, GetTextDocument(.Self)) Then If .ListExists AndAlso ParseContainer(.Self, m.Post.ID, String.Empty,,, GetTextDocument(.Self)) Then
If lastCount <> _TempMediaList.Count Then If lastCount <> _TempMediaList.Count Then
For li = IIf(lastCount < 0, 0, lastCount) To _TempMediaList.Count - 1 For li = IIf(lastCount < 0, 0, lastCount) To _TempMediaList.Count - 1
m2 = _TempMediaList(i) m2 = _TempMediaList(li)
m2.Post.Date = m.Post.Date m2.Post.Date = m.Post.Date
m2.State = UStates.Missing m2.State = UStates.Missing
m2.Attempts = m.Attempts m2.Attempts = m.Attempts
_TempMediaList(i) = m2 _TempMediaList(li) = m2
Next Next
End If End If
rList.Add(i) rList.Add(i)

View File

@@ -7,6 +7,8 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Tools.Web.Clients
Namespace API.ThisVid Namespace API.ThisVid
Friend Module Declarations Friend Module Declarations
Friend Const ThisVidSiteKey As String = "AndyProgram_ThisVid" 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 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 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 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 Module
End Namespace End Namespace

View File

@@ -50,6 +50,14 @@ Namespace API.ThisVid
UrlPatternUser = "https://thisvid.com/members/{0}/" UrlPatternUser = "https://thisvid.com/members/{0}/"
ImageVideoContains = "https://thisvid.com/videos/" ImageVideoContains = "https://thisvid.com/videos/"
End Sub 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 #End Region
#Region "GetInstance" #Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider

View File

@@ -179,7 +179,7 @@ Namespace API.ThisVid
If Not IsSavedPosts Then If Not IsSavedPosts Then
Dim r$ = Responser.GetResponse($"https://thisvid.com/members/{ID}/") Dim r$ = Responser.GetResponse($"https://thisvid.com/members/{ID}/")
If Not r.IsEmptyString Then 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 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) rr.Pattern = String.Format(ProfileDataPattern, member)
Dim v$ = CStr(RegexReplace(r, rr)).StringTrim Dim v$ = CStr(RegexReplace(r, rr)).StringTrim
@@ -190,13 +190,14 @@ Namespace API.ThisVid
If Not UserSiteName.IsEmptyString And FriendlyName.IsEmptyString Then FriendlyName = UserSiteName : _ForceSaveUserData = True If Not UserSiteName.IsEmptyString And FriendlyName.IsEmptyString Then FriendlyName = UserSiteName : _ForceSaveUserData = True
Dim descr$ = String.Empty Dim descr$ = String.Empty
descr.StringAppendLine(__getValue("Birth date", True)) descr.StringAppendLine(__getValue("Birth date", True))
descr.StringAppendLine(__getValue("Country", True)) descr.StringAppendLine(__getValue("Location", True))
descr.StringAppendLine(__getValue("City", True)) 'descr.StringAppendLine(__getValue("City", True))
descr.StringAppendLine(__getValue("Gender", True)) descr.StringAppendLine(__getValue("Gender", True))
descr.StringAppendLine(__getValue("Orientation", True)) descr.StringAppendLine(__getValue("Orientation", True))
descr.StringAppendLine(__getValue("Relationship status", True)) descr.StringAppendLine(__getValue("Relationship status", True))
descr.StringAppendLine(__getValue("Favourite category", True)) descr.StringAppendLine(__getValue("Favourite category", True))
descr.StringAppendLine(__getValue("My interests", True)) descr.StringAppendLine(__getValue("My interests", True))
descr.StringAppendLine(__getValue("Favorite niche", True))
rr.Pattern = DescriptionPattern rr.Pattern = DescriptionPattern
descr.StringAppendLine(CStr(RegexReplace(r, rr)).StringTrim) descr.StringAppendLine(CStr(RegexReplace(r, rr)).StringTrim)
UserDescriptionUpdate(descr) UserDescriptionUpdate(descr)
@@ -403,6 +404,30 @@ Namespace API.ThisVid
End Sub End Sub
#End Region #End Region
#Region "ReparseVideo" #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) Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
If IsSubscription Then If IsSubscription Then
ReparseVideoSubscriptions(Token) ReparseVideoSubscriptions(Token)
@@ -440,11 +465,12 @@ Namespace API.ThisVid
If n.IsEmptyString Then n = u.Post.ID If n.IsEmptyString Then n = u.Post.ID
If n.IsEmptyString Then n = "VideoFile" If n.IsEmptyString Then n = "VideoFile"
u.File = $"{n}.mp4" 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) _TempMediaList.RemoveAt(i)
Else Else
u.Type = UserMedia.Types.Video u.Type = UserMedia.Types.Video
_TempPostsList.Add(u.Post.ID) _TempPostsList.ListAddValue(u.Post.ID, LNC)
_TempMediaList(i) = u _TempMediaList(i) = u
End If End If
e.Dispose() e.Dispose()

View File

@@ -35,7 +35,7 @@ Namespace API.ThisVid
DifferentFolders = u.DifferentFolders DifferentFolders = u.DifferentFolders
MySettings = u.HOST.Source MySettings = u.HOST.Source
End Sub End Sub
Friend Overrides Sub Apply(ByRef u As IPSite) Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u) MyBase.Apply(u)
With DirectCast(u, UserData) With DirectCast(u, UserData)
.DownloadPublic = DownloadPublic .DownloadPublic = DownloadPublic

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) Return New EditorExchangeOptionsBase(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is 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 Sub
#End Region #End Region
#Region "Initializer" #Region "Initializer"
@@ -184,7 +184,6 @@ Namespace API.ThreadsNet
If uex.UserNotFound Then If uex.UserNotFound Then
UserExists = False UserExists = False
_ForceSaveUserInfo = True _ForceSaveUserInfo = True
_ForceSaveUserInfoOnException = True
ElseIf ThrowEx Then ElseIf ThrowEx Then
Throw New ExitException(uex.ErrMessage) With {.SimpleLogLine = True} Throw New ExitException(uex.ErrMessage) With {.SimpleLogLine = True}
Else Else
@@ -388,8 +387,10 @@ Namespace API.ThreadsNet
Dim newID$ Dim newID$
Dim idStr$ = String.Empty Dim idStr$ = String.Empty
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
UserSiteNameUpdate(RegexReplace(r, RegexUserName))
UserDescriptionUpdate(RegexReplace(r, RegexUserDescr))
ParseTokens(r, 0) 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 If ID.IsEmptyString OrElse ID = newID Then
_IdChanged = ID.IsEmptyString _IdChanged = ID.IsEmptyString
ID = newID ID = newID
@@ -402,7 +403,6 @@ Namespace API.ThreadsNet
If _IdChanged Then If _IdChanged Then
If Not idStr.IsEmptyString Then UserDescriptionUpdate(idStr, True, True, True) If Not idStr.IsEmptyString Then UserDescriptionUpdate(idStr, True, True, True)
_ForceSaveUserInfo = True _ForceSaveUserInfo = True
_ForceSaveUserInfoOnException = True
End If End If
End If End If
Return Valid Return Valid

View File

@@ -11,6 +11,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.TikTok Namespace API.TikTok
Friend Module Declarations Friend Module Declarations
Friend ReadOnly SimpleDateConverter As New ADateTime("yyyyMMdd") 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, Friend ReadOnly RegexTagsReplacer As RParams = RParams.DM("#\w+\s?", -1, RegexReturn.Replace,
CType(Function(input$) String.Empty, Func(Of String, String)), EDP.ReturnValue) 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, 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
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.TikTok Namespace API.TikTok
<Manifest("AndyProgram_TikTok"), SpecialForm(False), SeparatedTasks(1)> <Manifest("AndyProgram_TikTok"), SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Categories" #Region "Categories"
Private Const CAT_DOWN As String = "Download" Private Const CAT_DOWN As String = "Download"
Private Const CAT_UserDefs_Title As String = DN.CAT_UserDefs & " (Title)"
#End Region #End Region
#Region "Download" #Region "Download"
<PropertyOption(ControlText:="Download videos", Category:=CAT_DOWN), PXML, PClonable> <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> <PropertyOption(ControlText:="Download photos", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property DownloadTTPhotos As PropertyValue Friend ReadOnly Property DownloadTTPhotos As PropertyValue
#End Region #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 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 Friend ReadOnly Property TitleUseNative As PropertyValue
<PropertyOption(ControlText:="Use native title (standalone downloader)", <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 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 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 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 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 Friend ReadOnly Property TitleUseRegexForTitle_Value As PropertyValue
#End Region
#End Region
<PropertyOption(ControlText:="Use video date as file date", <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> ControlToolTip:="Set the file date to the date the video was added (website) (if available)."), PXML, PClonable>
Friend ReadOnly Property UseParsedVideoDate As PropertyValue Friend ReadOnly Property UseParsedVideoDate As PropertyValue
<PropertyOption(ControlText:="Use video date as file date (standalone downloader)", <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> ControlToolTip:="Set the file date to the date the video was added (website) (if available)."), PXML, PClonable>
Friend ReadOnly Property UseParsedVideoDateSTD As PropertyValue 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) 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) 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) DownloadTTVideos = New PropertyValue(True)
DownloadTTPhotos = 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 Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If End If
End Sub 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 Class
End Namespace End Namespace

View File

@@ -7,16 +7,21 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Threading Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Documents.JSON 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 Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.TikTok Namespace API.TikTok
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
#Region "XML names" #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_RemoveTagsFromTitle As String = "RemoveTagsFromTitle"
Private Const Name_TitleUseNative As String = "TitleUseNative" Private Const Name_TitleUseNative As String = "TitleUseNative"
Private Const Name_TitleAddVideoID As String = "TitleAddVideoID" Private Const Name_TitleAddVideoID As String = "TitleAddVideoID"
@@ -27,6 +32,7 @@ Namespace API.TikTok
Private Const Name_PhotosDownloaded As String = "PhotosDownloaded" Private Const Name_PhotosDownloaded As String = "PhotosDownloaded"
#End Region #End Region
#Region "Declarations" #Region "Declarations"
Friend Const GDL_POSTFIX As String = "--GDL"
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Get Get
Return HOST.Source Return HOST.Source
@@ -57,6 +63,9 @@ Namespace API.TikTok
End If End If
End Get End Get
End Property 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 RemoveTagsFromTitle As Boolean = False
Friend Property TitleUseNative As Boolean = True Friend Property TitleUseNative As Boolean = True
Friend Property TitleAddVideoID As Boolean = True Friend Property TitleAddVideoID As Boolean = True
@@ -71,22 +80,16 @@ Namespace API.TikTok
Return New UserExchangeOptions(Me) Return New UserExchangeOptions(Me)
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
With DirectCast(Obj, UserExchangeOptions)
RemoveTagsFromTitle = .RemoveTagsFromTitle
TitleUseNative = .TitleUseNative
TitleAddVideoID = .TitleAddVideoID
TitleUseRegexForTitle = .TitleUseRegexForTitle
TitleUseRegexForTitle_Value = .TitleUseRegexForTitle_Value
TitleUseGlobalRegexOptions = .TitleUseGlobalRegexOptions
End With
End If
End Sub End Sub
#End Region #End Region
#Region "Loader" #Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container With Container
If Loading Then 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) RemoveTagsFromTitle = .Value(Name_RemoveTagsFromTitle).FromXML(Of Boolean)(False)
TitleUseNative = .Value(Name_TitleUseNative).FromXML(Of Boolean)(True) TitleUseNative = .Value(Name_TitleUseNative).FromXML(Of Boolean)(True)
TitleAddVideoID = .Value(Name_TitleAddVideoID).FromXML(Of Boolean)(True) TitleAddVideoID = .Value(Name_TitleAddVideoID).FromXML(Of Boolean)(True)
@@ -97,6 +100,9 @@ Namespace API.TikTok
TitleUseGlobalRegexOptions = .Value(Name_TitleUseGlobalRegexOptions).FromXML(Of Boolean)(True) TitleUseGlobalRegexOptions = .Value(Name_TitleUseGlobalRegexOptions).FromXML(Of Boolean)(True)
PhotosDownloaded = .Value(Name_PhotosDownloaded).FromXML(Of Boolean)(False) PhotosDownloaded = .Value(Name_PhotosDownloaded).FromXML(Of Boolean)(False)
Else Else
.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
.Add(Name_GetStoriesUser, GetStoriesUser.BoolToInteger)
.Add(Name_GetReposts, GetReposts.BoolToInteger)
.Add(Name_RemoveTagsFromTitle, RemoveTagsFromTitle.BoolToInteger) .Add(Name_RemoveTagsFromTitle, RemoveTagsFromTitle.BoolToInteger)
.Add(Name_TitleUseNative, TitleUseNative.BoolToInteger) .Add(Name_TitleUseNative, TitleUseNative.BoolToInteger)
.Add(Name_TitleAddVideoID, TitleAddVideoID.BoolToInteger) .Add(Name_TitleAddVideoID, TitleAddVideoID.BoolToInteger)
@@ -165,17 +171,29 @@ Namespace API.TikTok
Private Function GetPhotoNode() As Object() Private Function GetPhotoNode() As Object()
Return {"imageURL", "urlList", 0, 0} Return {"imageURL", "urlList", 0, 0}
End Function End Function
Private Sub ValidateCache()
If If(UserCache?.Disposed, True) Then UserCache = CreateCache()
End Sub
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken) Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
MyBase.DownloadData(Token) MyBase.DownloadData(Token)
UserCache.DisposeIfReady(False) UserCache.DisposeIfReady(False)
UserCache = Nothing UserCache = Nothing
End Sub 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}" Dim URL$ = $"https://www.tiktok.com/@{NameTrue}"
UserCache = CreateCache()
Try Try
Const photoPrefix$ = "photo_" 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 postDate As Date?
Dim dateAfterC As Date? = Nothing Dim dateAfterC As Date? = Nothing
Dim dateBefore As Date? = DownloadDateTo Dim dateBefore As Date? = DownloadDateTo
@@ -184,12 +202,24 @@ Namespace API.TikTok
Dim titleRegex As RParams = GetTitleRegex() Dim titleRegex As RParams = GetTitleRegex()
Dim vPath As SFile = Nothing, pPath As SFile = Nothing Dim vPath As SFile = Nothing, pPath As SFile = Nothing
Dim file As SFile 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 photoNode As Object() = GetPhotoNode()
Dim c%, cc%, i% Dim c%, cc%, i%
Dim errDef As New ErrorsDescriber(EDP.ReturnValue) Dim errDef As New ErrorsDescriber(EDP.ReturnValue)
Dim infoParsed As Boolean = False 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 If _ContentList.Count > 0 Then
With (From d In _ContentList Where d.Post.Date.HasValue Select d.Post.Date.Value) With (From d In _ContentList Where d.Post.Date.HasValue Select d.Post.Date.Value)
If .ListExists Then dateAfterC = .Min If .ListExists Then dateAfterC = .Min
@@ -214,19 +244,16 @@ Namespace API.TikTok
End If End If
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 With UserCache.NewInstance : .Validate() : vPath = .RootDirectory : End With
Using b As New YTDLP.YTDLPBatch(Token) With {.TempPostsList = _TempPostsList} Using b As New YTDLP.YTDLPBatch(Token,, vPath) With {.TempPostsList = _TempPostsList}
b.Commands.Clear()
b.ChangeDirectory(vPath)
b.Encoding = BatchExecutor.UnicodeEncoding
b.Execute(CreateYTCommand(vPath, URL, False, dateBefore, dateAfter)) b.Execute(CreateYTCommand(vPath, URL, False, dateBefore, dateAfter))
End Using End Using
End If End If
If DownloadImages And Settings.GalleryDLFile.Exists And CBool(MySettings.DownloadTTPhotos.Value) Then If DownloadImages And Settings.GalleryDLFile.Exists And CBool(MySettings.DownloadTTPhotos.Value) Then
With UserCache.NewInstance : .Validate() : pPath = .RootDirectory : End With 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 With b
If PhotosDownloaded And _TempPostsList.Count > 0 Then If PhotosDownloaded And _TempPostsList.Count > 0 Then
.TempPostsList = (From p As String In _TempPostsList .TempPostsList = (From p As String In _TempPostsList
@@ -235,10 +262,8 @@ Namespace API.TikTok
Else Else
.TempPostsList = New List(Of String) .TempPostsList = New List(Of String)
End If End If
.ChangeDirectory(pPath) .Execute(CreateGDLCommand(URL, gdlCmd,,,, CObj(IIf(Section = Sections.Timeline, dateAfter, Nothing))))
.Encoding = BatchExecutor.UnicodeEncoding If Not PhotosDownloaded Then _ForceSaveUserInfo = True
.Execute(CreateGDLCommand(URL))
If Not PhotosDownloaded Then _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True
PhotosDownloaded = True PhotosDownloaded = True
End With End With
End Using End Using
@@ -247,6 +272,7 @@ Namespace API.TikTok
ThrowAny(Token) ThrowAny(Token)
Dim files As List(Of SFile) Dim files As List(Of SFile)
'YTDLP
If Not vPath.IsEmptyString AndAlso vPath.Exists(SFO.Path, False) Then If Not vPath.IsEmptyString AndAlso vPath.Exists(SFO.Path, False) Then
files = SFile.GetFiles(vPath, "*.json",, errDef) files = SFile.GetFiles(vPath, "*.json",, errDef)
If files.ListExists Then If files.ListExists Then
@@ -254,7 +280,7 @@ Namespace API.TikTok
j = JsonDocument.Parse(file.GetText, errDef) j = JsonDocument.Parse(file.GetText, errDef)
If j.ListExists Then If j.ListExists Then
If j.Value("_type").StringToLower = "video" Then If j.Value("_type").StringToLower = "video" Then
If Not baseDataObtained Then If Not baseDataObtained And Section = Sections.Timeline Then
baseDataObtained = True baseDataObtained = True
If ID.IsEmptyString Then ID = j.Value("uploader_id") If ID.IsEmptyString Then ID = j.Value("uploader_id")
newName = j.Value("uploader") newName = j.Value("uploader")
@@ -266,10 +292,13 @@ Namespace API.TikTok
If Not _TempPostsList.Contains(postID) Then If Not _TempPostsList.Contains(postID) Then
_TempPostsList.ListAddValue(postID, LNC) _TempPostsList.ListAddValue(postID, LNC)
Else Else
Exit For 'Exit Sub 'Exit For 'Exit Sub
Continue For
End If End If
title = GetNewFileName(j.Value("title").StringRemoveWinForbiddenSymbols, title = GetNewFileName(j.Value("title").StringRemoveWinForbiddenSymbols,
TitleUseNative, RemoveTagsFromTitle, TitleAddVideoID, postID, titleRegex) 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) postDate = AConvert(Of Date)(j.Value("timestamp"), UnixDate32Provider, Nothing)
If Not postDate.HasValue Then postDate = AConvert(Of Date)(j.Value("upload_date"), SimpleDateConverter, Nothing) If Not postDate.HasValue Then postDate = AConvert(Of Date)(j.Value("upload_date"), SimpleDateConverter, Nothing)
Select Case CheckDatesLimit(postDate, SimpleDateConverter) Select Case CheckDatesLimit(postDate, SimpleDateConverter)
@@ -280,7 +309,13 @@ Namespace API.TikTok
postUrl = j.Value("webpage_url") postUrl = j.Value("webpage_url")
If postUrl.IsEmptyString Then postUrl = $"https://www.tiktok.com/@{Name}/video/{postID}" If postUrl.IsEmptyString Then postUrl = $"https://www.tiktok.com/@{Name}/video/{postID}"
_TempMediaList.Add(New UserMedia(postUrl, UTypes.Video) With { _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 End If
j.Dispose() j.Dispose()
End If End If
@@ -288,25 +323,126 @@ Namespace API.TikTok
End If End If
End If End If
j.DisposeIfReady
'GDL
If Not pPath.IsEmptyString AndAlso pPath.Exists(SFO.Path, False) Then If Not pPath.IsEmptyString AndAlso pPath.Exists(SFO.Path, False) Then
files = SFile.GetFiles(pPath, "*.txt",, errDef) files = SFile.GetFiles(pPath, "*.txt",, errDef)
If files.ListExists Then 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 For Each file In files
t = file.GetText(errDef) 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 If Not t.IsEmptyString Then
j = JsonDocument.Parse(t, errDef) j = JsonDocument.Parse(t, errDef)
If j.ListExists Then If j.ListExists Then
With j.ItemF({0, "webapp.video-detail", "itemInfo", "itemStruct"}) If Section = Sections.UserStories Then
With j("itemList")
If .ListExists Then 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") postID = .Value("id")
postID2 = $"{photoPrefix}{postID}" 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) postDate = AConvert(Of Date)(j.Value("createTime"), UnixDate32Provider, Nothing)
If postDate.HasValue Then
Select Case CheckDatesLimit(postDate, SimpleDateConverter) Select Case CheckDatesLimit(postDate, SimpleDateConverter)
Case DateResult.Skip : Continue For Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit For 'Exit Sub Case DateResult.Exit : Exit For 'Exit Sub
End Select 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 If Not infoParsed Then
With .Item("author") With .Item("author")
@@ -330,11 +466,22 @@ Namespace API.TikTok
End With End With
End If End If
title = GetNewFileName(j.Value({"imagePost"}, "title").StringRemoveWinForbiddenSymbols, title = GetNewFileName(.Value({"imagePost"}, "title").StringRemoveWinForbiddenSymbols,
TitleUseNative, RemoveTagsFromTitle, TitleAddVideoID, postID, titleRegex) 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}" postUrl = $"https://www.tiktok.com/@{Name}/photo/{postID}"
With .Item({"imagePost", "images"}) With .Item({"imagePost", "images"})
If .ListExists Then 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 i = 0
c = .Count c = .Count
cc = Math.Max(c.ToString.Length, 3) cc = Math.Max(c.ToString.Length, 3)
@@ -344,14 +491,19 @@ Namespace API.TikTok
If Not imgUrl.IsEmptyString Then _ If Not imgUrl.IsEmptyString Then _
_TempMediaList.Add(New UserMedia(imgUrl, UTypes.Picture) With { _TempMediaList.Add(New UserMedia(imgUrl, UTypes.Picture) With {
.URL_BASE = postUrl, .URL_BASE = postUrl,
.SpecialFolder = "Photo", .SpecialFolder = __specFolder_Cr("Photo"),
.File = $"{title}{IIf(c > 1, $"_{i.NumToString(ANumbers.Formats.NumberGroup, cc)}", String.Empty)}.jpg", .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 Next
End If End If
End With End With
End If End If
End With End With
End If
j.Dispose() j.Dispose()
End If End If
End If End If
@@ -359,6 +511,9 @@ Namespace API.TikTok
End If End If
End If End If
j.DisposeIfReady
_TempPostsList.ListAddList(gdlTmpIDs.Keys)
gdlTmpIDs.Clear()
If _TempMediaList.Count > 0 Then LastDownloadDate = Now If _TempMediaList.Count > 0 Then LastDownloadDate = Now
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]") ProcessException(ex, Token, $"data downloading error [{URL}]")
@@ -443,8 +598,21 @@ Namespace API.TikTok
End Function End Function
#End Region #End Region
#Region "GDL Support" #Region "GDL Support"
Private Function CreateGDLCommand(ByVal URL As String) As String Private Function CreateGDLCommand(ByVal URL As String, Optional ByVal SectionCommand As String = Nothing,
Return $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip --write-pages {URL}" 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 Function
#End Region #End Region
#Region "DownloadContent, DownloadFile" #Region "DownloadContent, DownloadFile"
@@ -456,8 +624,16 @@ Namespace API.TikTok
End Function End Function
Protected Overrides Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile 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} 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)) b.Execute(CreateYTCommand(DestinationFile, URL, True))
End If
End Using End Using
If DestinationFile.Exists Then Return DestinationFile Else Return Nothing If DestinationFile.Exists Then Return DestinationFile Else Return Nothing
End Function End Function
@@ -477,7 +653,6 @@ Namespace API.TikTok
t = UTypes.Video t = UTypes.Video
If CBool(MySettings.TitleUseNativeSTD.Value) Then If CBool(MySettings.TitleUseNativeSTD.Value) Then
Using b As New BatchExecutor(True) With { Using b As New BatchExecutor(True) With {
.Encoding = BatchExecutor.UnicodeEncoding,
.CleanAutomaticallyViaRegEx = True, .CleanAutomaticallyViaRegEx = True,
.CleanAutomaticallyViaRegExRemoveAllCommands = True .CleanAutomaticallyViaRegExRemoveAllCommands = True
} }
@@ -498,11 +673,7 @@ Namespace API.TikTok
Data.Title = defName Data.Title = defName
Dim dir As SFile Dim dir As SFile
With If(Cache, Settings.Cache).NewInstance() : .Validate() : dir = .RootDirectory : End With With If(Cache, Settings.Cache).NewInstance() : .Validate() : dir = .RootDirectory : End With
Using b As New GDL.GDLBatch(Token) Using b As New GDL.GDLBatch(Token,, dir) : b.Execute(CreateGDLCommand(Data.URL)) : End Using
b.ChangeDirectory(dir)
b.Encoding = BatchExecutor.UnicodeEncoding
b.Execute(CreateGDLCommand(Data.URL))
End Using
Dim file As SFile = SFile.GetFiles(dir, "*.txt",, EDP.ReturnValue).FirstOrDefault Dim file As SFile = SFile.GetFiles(dir, "*.txt",, EDP.ReturnValue).FirstOrDefault
If file.Exists Then If file.Exists Then
Dim r$ = file.GetText(EDP.ReturnValue) Dim r$ = file.GetText(EDP.ReturnValue)

View File

@@ -6,9 +6,17 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.TikTok 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))> <PSetting(NameOf(SiteSettings.RemoveTagsFromTitle), NameOf(MySettings))>
Friend Property RemoveTagsFromTitle As Boolean Friend Property RemoveTagsFromTitle As Boolean
<PSetting(NameOf(SiteSettings.TitleUseNative), NameOf(MySettings))> <PSetting(NameOf(SiteSettings.TitleUseNative), NameOf(MySettings))>
@@ -21,9 +29,15 @@ Namespace API.TikTok
Friend Property TitleUseRegexForTitle_Value As String 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")> <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 Friend Property TitleUseGlobalRegexOptions As Boolean = True
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property UserName As String
Private ReadOnly MySettings As SiteSettings Private ReadOnly MySettings As SiteSettings
Friend Sub New(ByVal u As UserData) Friend Sub New(ByVal u As UserData)
MyBase.New(u)
_ApplyBase_Name = False
MySettings = u.HOST.Source MySettings = u.HOST.Source
GetTimeline = u.GetTimeline
GetStoriesUser = u.GetStoriesUser
GetReposts = u.GetReposts
RemoveTagsFromTitle = u.RemoveTagsFromTitle RemoveTagsFromTitle = u.RemoveTagsFromTitle
TitleUseNative = u.TitleUseNative TitleUseNative = u.TitleUseNative
TitleAddVideoID = u.TitleAddVideoID TitleAddVideoID = u.TitleAddVideoID
@@ -32,12 +46,31 @@ Namespace API.TikTok
TitleUseGlobalRegexOptions = u.TitleUseGlobalRegexOptions TitleUseGlobalRegexOptions = u.TitleUseGlobalRegexOptions
End Sub End Sub
Friend Sub New(ByVal s As SiteSettings) Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
_ApplyBase_Name = False
MySettings = s MySettings = s
GetTimeline = s.GetTimeline.Value
GetStoriesUser = s.GetStoriesUser.Value
GetReposts = s.GetReposts.Value
RemoveTagsFromTitle = s.RemoveTagsFromTitle.Value RemoveTagsFromTitle = s.RemoveTagsFromTitle.Value
TitleUseNative = s.TitleUseNative.Value TitleUseNative = s.TitleUseNative.Value
TitleAddVideoID = s.TitleAddVideoID.Value TitleAddVideoID = s.TitleAddVideoID.Value
TitleUseRegexForTitle = s.TitleUseRegexForTitle.Value TitleUseRegexForTitle = s.TitleUseRegexForTitle.Value
TitleUseRegexForTitle_Value = s.TitleUseRegexForTitle_Value.Value TitleUseRegexForTitle_Value = s.TitleUseRegexForTitle_Value.Value
End Sub 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 Class
End Namespace 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 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 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 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 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"} Friend ReadOnly GdlPostCoutNumberNodes As String() = {"data", "user", "result", "legacy", "statuses_count"}
Private Function GetDateProvider() As ADateTime Private Function GetDateProvider() As ADateTime

View File

@@ -65,13 +65,6 @@ Namespace API.Twitter
MediaModelAllowNonUserTweets = s.MediaModelAllowNonUserTweets.Value MediaModelAllowNonUserTweets = s.MediaModelAllowNonUserTweets.Value
MySettings = s MySettings = s
End Sub 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) Friend Sub New(ByVal u As UserData)
MyBase.New(u) MyBase.New(u)
GifsDownload = u.GifsDownload GifsDownload = u.GifsDownload
@@ -81,7 +74,6 @@ Namespace API.Twitter
RemoveExistingDuplicates = u.RemoveExistingDuplicates RemoveExistingDuplicates = u.RemoveExistingDuplicates
MediaModelAllowNonUserTweets = u.MediaModelAllowNonUserTweets MediaModelAllowNonUserTweets = u.MediaModelAllowNonUserTweets
LargeProfile = u.LargeProfile LargeProfile = u.LargeProfile
If Not TypeOf u Is Mastodon.UserData Then
DownloadModelForceApply = u.DownloadModelForceApply DownloadModelForceApply = u.DownloadModelForceApply
DownloadBroadcasts = u.DownloadBroadcasts DownloadBroadcasts = u.DownloadBroadcasts
Dim dm As DModels() = EnumExtract(Of DModels)(u.DownloadModel) Dim dm As DModels() = EnumExtract(Of DModels)(u.DownloadModel)
@@ -91,7 +83,6 @@ Namespace API.Twitter
DownloadModelSearch = dm.Contains(DModels.Search) DownloadModelSearch = dm.Contains(DModels.Search)
DownloadModelLikes = dm.Contains(DModels.Likes) DownloadModelLikes = dm.Contains(DModels.Likes)
End If End If
End If
MySettings = u.HOST.Source MySettings = u.HOST.Source
End Sub End Sub
End Class End Class

View File

@@ -112,14 +112,6 @@ Namespace API.Twitter
Return HOST.Source Return HOST.Source
End Get End Get
End Property 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 Friend Function GetUserUrl() As String
Return $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/{NameTrue}" Return $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/{NameTrue}"
End Function End Function
@@ -131,7 +123,7 @@ Namespace API.Twitter
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions) With DirectCast(Obj, EditorExchangeOptions)
.ApplyBase(Me) .Apply(Me)
GifsDownload = .GifsDownload GifsDownload = .GifsDownload
GifsSpecialFolder = .GifsSpecialFolder GifsSpecialFolder = .GifsSpecialFolder
GifsPrefix = .GifsPrefix GifsPrefix = .GifsPrefix
@@ -305,10 +297,17 @@ Namespace API.Twitter
Private Const DEBUG_PROFILE As Boolean = False Private Const DEBUG_PROFILE As Boolean = False
Private Const DEBUG_LEAVE_CACHE As Boolean = False Private Const DEBUG_LEAVE_CACHE As Boolean = False
Private JsonNullErr 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) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try Try
GDL_REQUESTS_COUNT = 0 GDL_REQUESTS_COUNT = 0
JsonNullErr = False JsonNullErr = False
NotUserExistsAttempts = 0
If MySettings.LIMIT_ABORT Then If MySettings.LIMIT_ABORT Then
Throw New TwitterLimitException(Me) Throw New TwitterLimitException(Me)
Else Else
@@ -325,6 +324,14 @@ Namespace API.Twitter
End If End If
LikesPosts.Clear() LikesPosts.Clear()
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly) 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) DownloadData_Timeline(Token)
If _TempMediaList.Count = 0 And LikesPosts.Count = 0 And JsonNullErr Then Throw New Plugin.ExitException("No deserialized data found") If _TempMediaList.Count = 0 And LikesPosts.Count = 0 And JsonNullErr Then Throw New Plugin.ExitException("No deserialized data found")
LoadSavePostsKV(False) LoadSavePostsKV(False)
@@ -374,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 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 multiMode As Boolean = IsMultiMode
Dim currentModel As DownloadModels = DownloadModels.Undefined Dim currentModel As DownloadModels = DownloadModels.Undefined
Dim onlyUpdateUser As Boolean = Not ____UserExists
Dim __parseContainer As Func(Of EContainer, Boolean) = Dim __parseContainer As Func(Of EContainer, Boolean) =
Function(ByVal ee As EContainer) As Boolean Function(ByVal ee As EContainer) As Boolean
@@ -434,7 +442,7 @@ Namespace API.Twitter
End If End If
End If End If
Else Else
ObtainMedia(nn, PostID, PostDate) ObtainMedia(nn, PostID, PostDate,,,, ee)
End If End If
End If End If
End If End If
@@ -479,13 +487,14 @@ Namespace API.Twitter
ThrowAny(Token) ThrowAny(Token)
Dim timelineFiles As List(Of SFile) = SFile.GetFiles(dir, "*.txt",, EDP.ReturnValue) Dim timelineFiles As List(Of SFile) = SFile.GetFiles(dir, "*.txt",, EDP.ReturnValue)
If timelineFiles.ListExists Then If timelineFiles.ListExists Then
ResetFileNameProvider(Math.Max(timelineFiles.Count.ToString.Length, 2)) GDLResetFileNameProvider(Math.Max(timelineFiles.Count.ToString.Length, 2))
'rename files 'rename files
If Not DEBUG_PROFILE Then 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 End If
'parse files 'parse files
For i = 0 To timelineFiles.Count - 1 For i = 0 To timelineFiles.Count - 1
If userInfoParsed And onlyUpdateUser Then Exit Sub
j = JsonDocument.Parse(timelineFiles(i).GetText, jsonArgs) j = JsonDocument.Parse(timelineFiles(i).GetText, jsonArgs)
If jsonArgs.State = WebDocumentEventArgs.States.Error Then If jsonArgs.State = WebDocumentEventArgs.States.Error Then
jsonArgs.Reset(Token) jsonArgs.Reset(Token)
@@ -514,7 +523,7 @@ Namespace API.Twitter
With .ItemF({0, "content", "items", 0, "item", "itemContent", "tweet_results", "result", "tweet", "community_results", "result"}) With .ItemF({0, "content", "items", 0, "item", "itemContent", "tweet_results", "result", "tweet", "community_results", "result"})
If .ListExists Then If .ListExists Then
If ID = .Value("id_str") Then If ID = .Value("id_str") Then
UserSiteNameUpdate(.Value("name")) UserSiteNameUpdate(.Value("name"), True)
UserDescriptionUpdate(.Value("description")) UserDescriptionUpdate(.Value("description"))
icon = .Value({"custom_banner_media", "media_info"}, "original_img_url"). icon = .Value({"custom_banner_media", "media_info"}, "original_img_url").
@@ -533,16 +542,27 @@ Namespace API.Twitter
With j({"data", "user", "result"}) With j({"data", "user", "result"})
If .ListExists Then If .ListExists Then
If ID.IsEmptyString Then ID = .Value("rest_id") 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"}) With .Item({"legacy"})
If .ListExists Then If .ListExists Then
If .Value("screen_name").StringToLower = NameTrue.ToLower Then If onlyUpdateUser Then
UserSiteNameUpdate(.Value("name")) 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")) 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 Not icon.IsEmptyString Then icon = icon.Replace("_normal", String.Empty)
If DownloadIconBanner Then If DownloadIconBanner Then
SimpleDownloadAvatar(.Value("profile_banner_url"), fileCrFunc) SimpleDownloadAvatar(.Value("profile_banner_url").IfNullOrEmpty(.Value({"legacy"}, "profile_banner_url")), fileCrFunc)
SimpleDownloadAvatar(icon, fileCrFunc) SimpleDownloadAvatar(icon, fileCrFunc)
End If End If
End If End If
@@ -675,17 +695,17 @@ nextpIndx:
End Sub End Sub
Private Sub DownloadData_SavedPosts(ByVal Token As CancellationToken) Private Sub DownloadData_SavedPosts(ByVal Token As CancellationToken)
Try 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") Dim files As List(Of SFile) = SFile.GetFiles(f, "*.txt")
If files.ListExists Then If files.ListExists Then
ResetFileNameProvider(Math.Max(files.Count.ToString.Length, 3)) GDLResetFileNameProvider(Math.Max(files.Count.ToString.Length, 3))
Dim id$ Dim id$
Dim nodes As List(Of String()) = GetContainerSubnodes() Dim nodes As List(Of String()) = GetContainerSubnodes()
Dim node$() Dim node$()
Dim j As EContainer, jj As EContainer Dim j As EContainer, jj As EContainer
Dim jErr As New ErrorsDescriber(EDP.ReturnValue) Dim jErr As New ErrorsDescriber(EDP.ReturnValue)
For i% = 0 To files.Count - 1 For i% = 0 To files.Count - 1
f = RenameGdlFile(files(i), i) f = GDLRenameFile(files(i), i)
j = JsonDocument.Parse(f.GetText, jErr) j = JsonDocument.Parse(f.GetText, jErr)
If Not j Is Nothing Then If Not j Is Nothing Then
With j.ItemF({"data", 0, "timeline", "instructions", 0, "entries"}) With j.ItemF({"data", 0, "timeline", "instructions", 0, "entries"})
@@ -697,7 +717,7 @@ nextpIndx:
With jj(node) With jj(node)
If .ListExists Then If .ListExists Then
id = .Value("id_str") 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 Exit For
End If End If
End With End With
@@ -718,11 +738,27 @@ nextpIndx:
#End Region #End Region
#Region "Obtain media" #Region "Obtain media"
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown, Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0, 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"}) Dim s As EContainer = e({"extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status", "extended_entities", "media"}) If If(s?.Count, 0) = 0 Then s = e({"retweeted_status", "extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"}) If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"})
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 mUrl$
Dim media As UserMedia Dim media As UserMedia
@@ -851,10 +887,25 @@ nextpIndx:
Private Class TwitterGDL : Inherits GDL.GDLBatch Private Class TwitterGDL : Inherits GDL.GDLBatch
Private ReadOnly KillOnLimit As Boolean Private ReadOnly KillOnLimit As Boolean
Friend LimitReached As Boolean = False 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) Friend Sub New(ByVal Dir As SFile, ByVal _Token As CancellationToken, ByVal _KillOnLimit As Boolean)
MyBase.New(_Token) MyBase.New(_Token,, Dir)
Commands.Clear()
If Not Dir.IsEmptyString Then ChangeDirectory(Dir)
KillOnLimit = _KillOnLimit KillOnLimit = _KillOnLimit
End Sub End Sub
Protected Overrides Async Function Validate(ByVal Value As String) As Task Protected Overrides Async Function Validate(ByVal Value As String) As Task
@@ -862,11 +913,15 @@ nextpIndx:
End Function End Function
Private Function IdExists(ByVal Value As String) As Boolean Private Function IdExists(ByVal Value As String) As Boolean
Try Try
If GetOnlyUserInfo Then
Return CheckForData()
Else
Value = Value.StringTrim Value = Value.StringTrim
If Not Value.IsEmptyString AndAlso (Value.StartsWith("*") Or Value.StartsWith(".\gallery-dl\")) Then If Not Value.IsEmptyString AndAlso (Value.StartsWith("*") Or Value.StartsWith(".\gallery-dl\")) Then
Dim id$ = Value.Split("\").Last.Split(".").First.Split("_").First Dim id$ = Value.Split("\").Last.Split(".").First.Split("_").First
If Not id.IsEmptyString Then Return TempPostsList.Contains(id) If Not id.IsEmptyString Then Return TempPostsList.Contains(id)
End If End If
End If
Catch ex As Exception Catch ex As Exception
End Try End Try
Return False Return False
@@ -874,8 +929,14 @@ nextpIndx:
Protected Overrides Async Sub ErrorDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs) Protected Overrides Async Sub ErrorDataReceiver(ByVal Sender As Object, ByVal e As DataReceivedEventArgs)
Await Task.Run(Sub() CheckForLimit(e.Data)) Await Task.Run(Sub() CheckForLimit(e.Data))
End Sub 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) 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 Value.IsEmptyString AndAlso (Value.ToLower.Contains("for rate limit reset") OrElse
Not CStr(RegexReplace(Value, GdlLimitRegEx)).IsEmptyString)) Then Not CStr(RegexReplace(Value, GdlLimitRegEx)).IsEmptyString)) Then
LimitReached = True LimitReached = True
@@ -1024,11 +1085,12 @@ nextpIndx:
.AutoClear = True, .AutoClear = True,
.AutoReset = True, .AutoReset = True,
.CommandPermanent = $"chcp {BatchExecutor.UnicodeEncoding}", .CommandPermanent = $"chcp {BatchExecutor.UnicodeEncoding}",
.FileExchanger = confCache .FileExchanger = confCache,
.GetOnlyUserInfo = NotUserExistsAttempts > 0
} }
tgdl.FileExchanger.DeleteCacheOnDispose = False tgdl.FileExchanger.DeleteCacheOnDispose = False
tgdl.FileExchanger.DeleteRootOnDispose = 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 = rootDir.NewPath
dir.Exists(SFO.Path, True, EDP.ThrowException) dir.Exists(SFO.Path, True, EDP.ThrowException)
outList.Add(dir) outList.Add(dir)
@@ -1039,6 +1101,20 @@ nextpIndx:
Else Else
command &= GdlGetIdFilterString() command &= GdlGetIdFilterString()
End If 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 Select Case i
Case 0 : command &= $"{urlPrePattern}{NameTrue}/media" : currentModel = DownloadModels.Media : process = dm.Contains(currentModel) Or IsCommunity 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) Case 1 : command &= $"{urlPrePattern}{NameTrue}" : currentModel = DownloadModels.Profile : process = dm.Contains(currentModel)
@@ -1046,6 +1122,7 @@ nextpIndx:
Case 3 : command &= $"{urlPrePattern}{NameTrue}/likes" : currentModel = DownloadModels.Likes : process = dm.Contains(currentModel) Case 3 : command &= $"{urlPrePattern}{NameTrue}/likes" : currentModel = DownloadModels.Likes : process = dm.Contains(currentModel)
Case Else : process = False Case Else : process = False
End Select End Select
End If
'#If DEBUG Then '#If DEBUG Then
'Debug.WriteLine(command) 'Debug.WriteLine(command)
'#End If '#End If
@@ -1129,17 +1206,19 @@ nextpIndx:
Dim cache As CacheKeeper = Nothing Dim cache As CacheKeeper = Nothing
Try Try
If ContentMissingExists Or (_ReparseLikes And LikesPosts.Count > 0) Then If ContentMissingExists Or (_ReparseLikes And LikesPosts.Count > 0) Then
Const __entries$ = "entries"
Dim m As UserMedia, mTmp As UserMedia Dim m As UserMedia, mTmp As UserMedia
Dim PostDate$ Dim PostDate$
Dim nodes As List(Of String()) = GetContainerSubnodes() Dim nodes As List(Of String()) = GetContainerSubnodes()
Dim node$() Dim node$()
Dim entriesNode As Predicate(Of EContainer) = Function(ee) ee.Contains(__entries)
Dim j As EContainer, n As EContainer Dim j As EContainer, n As EContainer
Dim f As SFile Dim f As SFile
Dim i%, ii% Dim i%, ii%
Dim files As List(Of SFile) Dim files As List(Of SFile)
Dim lim% Dim lim%
Dim specFolder$ = IIf(_ReparseLikes, "Likes", String.Empty) Dim specFolder$ = IIf(_ReparseLikes, "Likes", String.Empty)
ResetFileNameProvider() GDLResetFileNameProvider()
cache = If(IsSingleObjectDownload, Settings.Cache, CreateCache()) cache = If(IsSingleObjectDownload, Settings.Cache, CreateCache())
If _ReparseLikes Then lim = LikesPosts.Count Else lim = _ContentList.Count If _ReparseLikes Then lim = LikesPosts.Count Else lim = _ContentList.Count
ProgressPre.ChangeMax(lim) ProgressPre.ChangeMax(lim)
@@ -1165,10 +1244,10 @@ nextpIndx:
files = SFile.GetFiles(f, "*.txt") files = SFile.GetFiles(f, "*.txt")
If files.ListExists Then If files.ListExists Then
For ii = 0 To files.Count - 1 For ii = 0 To files.Count - 1
f = RenameGdlFile(files(ii), ii) f = GDLRenameFile(files(ii), ii)
j = JsonDocument.Parse(f.GetText) j = JsonDocument.Parse(f.GetText)
If Not j Is Nothing Then 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 .ListExists Then
If IsSingleObjectDownload Or DownloadBroadcasts Then If IsSingleObjectDownload Or DownloadBroadcasts Then
mTmp = ExtractBroadcast(.Self, m.Post.ID, String.Empty, nodes) mTmp = ExtractBroadcast(.Self, m.Post.ID, String.Empty, nodes)
@@ -1183,7 +1262,7 @@ nextpIndx:
If .ListExists Then If .ListExists Then
PostDate = String.Empty PostDate = String.Empty
If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts, specFolder) ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts, specFolder, n)
rList.ListAddValue(i, LNC) rList.ListAddValue(i, LNC)
End If End If
End With End With

View File

@@ -14,7 +14,11 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Xhamster Namespace API.Xhamster
<Manifest(XhamsterSiteKey), SavedPosts, SpecialForm(True), SpecialForm(False), TaskGroup(SettingsCLS.TaskStackNamePornSite)> <Manifest(XhamsterSiteKey), SavedPosts, SpecialForm(True), SpecialForm(False), TaskGroup(SettingsCLS.TaskStackNamePornSite)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Consts"
Friend Const GetMomentsCaption As String = "Get moments (short videos)"
#End Region
#Region "Declarations" #Region "Declarations"
Private Const CAT_YTDLP As String = "yt-dlp support"
<PXML("Domains"), PClonable> Private ReadOnly Property SiteDomains As PropertyValue <PXML("Domains"), PClonable> Private ReadOnly Property SiteDomains As PropertyValue
Private Shadows ReadOnly Property DefaultInstance As SiteSettings Private Shadows ReadOnly Property DefaultInstance As SiteSettings
Get Get
@@ -33,6 +37,19 @@ Namespace API.Xhamster
ControlToolTip:="If enabled and the video is downloaded in a non-native format, the video will be re-encoded." & vbCr & ControlToolTip:="If enabled and the video is downloaded in a non-native format, the video will be re-encoded." & vbCr &
"Attention! Enabling this setting results in maximum CPU usage."), PXML, PClonable> "Attention! Enabling this setting results in maximum CPU usage."), PXML, PClonable>
Friend ReadOnly Property ReencodeVideos As PropertyValue Friend ReadOnly Property ReencodeVideos As PropertyValue
<PropertyOption(ControlText:="Use yt-dlp to get file info", ControlToolTip:="If checked, yt-dlp will be used to get information about the file", Category:=CAT_YTDLP), PXML, PClonable, HiddenControl>
Friend ReadOnly Property UseYTDLPJSON As PropertyValue
<PropertyOption(ControlText:="Use yt-dlp to download the file", ControlToolTip:="If checked, yt-dlp will be used to download the file instead of the internal algorithm", Category:=CAT_YTDLP), PXML, PClonable, HiddenControl>
Friend ReadOnly Property UseYTDLPDownload As PropertyValue
Private ReadOnly Property UseYtDlp As Boolean
Get
Return CBool(UseYTDLPJSON.Value) Or CBool(UseYTDLPDownload.Value)
End Get
End Property
<PropertyOption(ControlText:="Disable internal algorithm", ControlToolTip:="If checked, the internal algorithm will be forcibly disabled and replaced with yt-dlp", Category:=CAT_YTDLP), PXML, PClonable, HiddenControl>
Friend ReadOnly Property UseYTDLPForceDisableInternal As PropertyValue
<PropertyOption(ControlText:=GetMomentsCaption, Category:=DeclaredNames.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetMoments As PropertyValue
<DoNotUse> Friend Overrides Property DownloadText As PropertyValue <DoNotUse> Friend Overrides Property DownloadText As PropertyValue
<DoNotUse> Friend Overrides Property DownloadTextPosts As PropertyValue <DoNotUse> Friend Overrides Property DownloadTextPosts As PropertyValue
<DoNotUse> Friend Overrides Property DownloadTextSpecialFolder As PropertyValue <DoNotUse> Friend Overrides Property DownloadTextSpecialFolder As PropertyValue
@@ -46,12 +63,17 @@ Namespace API.Xhamster
Domains.DestinationProp = SiteDomains Domains.DestinationProp = SiteDomains
DownloadUHD = New PropertyValue(False) DownloadUHD = New PropertyValue(False)
ReencodeVideos = New PropertyValue(False) ReencodeVideos = New PropertyValue(False)
UseYTDLPJSON = New PropertyValue(True)
UseYTDLPDownload = New PropertyValue(True)
UseYTDLPForceDisableInternal = New PropertyValue(False)
GetMoments = New PropertyValue(True)
_SubscriptionsAllowed = True _SubscriptionsAllowed = True
UrlPatternUser = "https://xhamster.com/{0}/{1}" UrlPatternUser = "https://xhamster.com/{0}/{1}"
UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption}|{P_Creators})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch) UserRegex = RParams.DMS($"/({UserOption}|{UserOption2}|{ChannelOption}|{P_Creators})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch)
ImageVideoContains = "xhamster" ImageVideoContains = "xhamster"
UserOptionsType = GetType(UserExchangeOptions) UserOptionsType = GetType(UserExchangeOptions)
UseNetscapeCookies = True
End Sub End Sub
Friend Overrides Sub EndInit() Friend Overrides Sub EndInit()
Domains.PopulateInitialDomains(SiteDomains.Value) Domains.PopulateInitialDomains(SiteDomains.Value)
@@ -75,7 +97,7 @@ Namespace API.Xhamster
Return New UserData Return New UserData
End Function End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
If Settings.UseM3U8 AndAlso MyBase.Available(What, Silent) Then If (Not UseYtDlp Or (UseYtDlp And Settings.YtdlpFile.Exists)) AndAlso Settings.UseM3U8 AndAlso MyBase.Available(What, Silent) Then
If What = ISiteSettings.Download.SavedPosts Then If What = ISiteSettings.Download.SavedPosts Then
Return Responser.CookiesExists Return Responser.CookiesExists
Else Else
@@ -87,7 +109,7 @@ Namespace API.Xhamster
End Function End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
With DirectCast(User, UserData) With DirectCast(User, UserData)
If Not .SiteMode = SiteModes.User Then If Not .SiteMode = SiteModes.User OrElse .IsCreator Then
Return .GetNonUserUrl(0) Return .GetNonUserUrl(0)
Else Else
Return String.Format(UrlPatternUser, IIf(.IsChannel, ChannelOption, UserOption), .NameTrue) Return String.Format(UrlPatternUser, IIf(.IsChannel, ChannelOption, UserOption), .NameTrue)
@@ -96,7 +118,8 @@ Namespace API.Xhamster
End Function End Function
#Region "IsMyUser, IsMyImageVideo" #Region "IsMyUser, IsMyImageVideo"
Friend Const ChannelOption As String = "channels" Friend Const ChannelOption As String = "channels"
Private Const UserOption As String = "users" Friend Const UserOption As String = "users/profiles"
Private Const UserOption2 As String = "users"
Friend Const P_Search As String = "search" Friend Const P_Search As String = "search"
Friend Const P_Tags As String = "tags" Friend Const P_Tags As String = "tags"
Friend Const P_Categories As String = "categories" Friend Const P_Categories As String = "categories"

View File

@@ -6,14 +6,16 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Text
Imports System.Threading Imports System.Threading
Imports SCrawler.API.Base Imports PersonalUtilities.Functions.RegularExpressions
Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.API.Base
Imports SCrawler.API.YouTube.Objects
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Xhamster Namespace API.Xhamster
Friend Class UserData : Inherits UserDataBase : Implements IPSite Friend Class UserData : Inherits UserDataBase : Implements IPSite
@@ -51,7 +53,7 @@ Namespace API.Xhamster
End Property End Property
Friend Property QueryString As String Implements IPSite.QueryString Friend Property QueryString As String Implements IPSite.QueryString
Get Get
If SiteMode = SiteModes.User Then If SiteMode = SiteModes.User And Not IsCreator Then
Return String.Empty Return String.Empty
Else Else
Return GetNonUserUrl(0) Return GetNonUserUrl(0)
@@ -71,7 +73,7 @@ Namespace API.Xhamster
End Structure End Structure
Private ReadOnly _TempPhotoData As List(Of UserMedia) Private ReadOnly _TempPhotoData As List(Of UserMedia)
Private Function UpdateUserOptions(Optional ByVal Force As Boolean = False, Optional ByVal NewUrl As String = Nothing) As Boolean Private Function UpdateUserOptions(Optional ByVal Force As Boolean = False, Optional ByVal NewUrl As String = Nothing) As Boolean
If Not Force OrElse (Not SiteMode = SiteModes.User AndAlso Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then If Not Force OrElse (Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then
Dim eObj As Plugin.ExchangeOptions = Nothing Dim eObj As Plugin.ExchangeOptions = Nothing
If Force Then eObj = MySettings.IsMyUser(NewUrl) If Force Then eObj = MySettings.IsMyUser(NewUrl)
If (Force And Not eObj.UserName.IsEmptyString) Or (Not Force And NameTrue(True).IsEmptyString) Then If (Force And Not eObj.UserName.IsEmptyString) Or (Not Force And NameTrue(True).IsEmptyString) Then
@@ -175,17 +177,31 @@ Namespace API.Xhamster
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me) If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then DirectCast(Obj, UserExchangeOptions).Apply(Me)
End Sub End Sub
Private MyCache As CacheKeeper = Nothing
Private Sub ResetCache()
MyCache.DisposeIfReady(False)
MyCache = Nothing
End Sub
Private Function GetCache() As CacheKeeper
If IsSingleObjectDownload Then
Return Settings.Cache
Else
If MyCache Is Nothing Then MyCache = CreateCache()
Return MyCache
End If
End Function
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
UseInternalM3U8Function = True UseInternalM3U8Function = True
UseInternalDownloadFileFunction = True
UseClientTokens = True UseClientTokens = True
_TempPhotoData = New List(Of UserMedia) _TempPhotoData = New List(Of UserMedia)
SessionPosts = New List(Of String) SessionPosts = New List(Of String)
End Sub End Sub
#End Region #End Region
#Region "Download functions" #Region "Download functions"
Friend Function GetNonUserUrl(ByVal Page As Integer) As String Friend Function GetNonUserUrl(ByVal Page As Integer, Optional ByVal GetShorts As Boolean = False) As String
Const newest$ = "/newest" Const newest$ = "/newest"
If SiteMode = SiteModes.User And Not IsCreator Then If SiteMode = SiteModes.User And Not IsCreator Then
Return String.Empty Return String.Empty
@@ -202,8 +218,10 @@ Namespace API.Xhamster
End Select End Select
url &= $"/{NameTrue}" url &= $"/{NameTrue}"
If GetShorts And (SiteMode = SiteModes.User Or IsCreator) Then url &= "/shorts"
Dim args$ = Arguments Dim args$ = Arguments
If (args.IsEmptyString OrElse Not args.Contains(newest)) And Not SiteMode = SiteModes.Search Then url &= newest If (args.IsEmptyString OrElse Not args.Contains(newest)) And Not SiteMode = SiteModes.Search And Not IsCreator Then url &= newest
If Page > 1 Then If Page > 1 Then
If args.IsEmptyString Then If args.IsEmptyString Then
If SiteMode = SiteModes.Search Then If SiteMode = SiteModes.Search Then
@@ -234,6 +252,9 @@ Namespace API.Xhamster
Private SearchPostsCount As Integer = 0 Private SearchPostsCount As Integer = 0
Private ReadOnly SessionPosts As List(Of String) Private ReadOnly SessionPosts As List(Of String)
Private _PageVideosRepeat As Integer = 0 Private _PageVideosRepeat As Integer = 0
Friend Overrides Sub DownloadData(Token As CancellationToken)
Try : MyBase.DownloadData(Token) : Finally : ResetCache() : End Try
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try Try
_TempPhotoData.Clear() _TempPhotoData.Clear()
@@ -242,7 +263,7 @@ Namespace API.Xhamster
SessionPosts.Clear() SessionPosts.Clear()
Responser.CookiesAsHeader = True Responser.CookiesAsHeader = True
If DownloadVideos Then DownloadData(1, True, False, Token) If DownloadVideos Then DownloadData(1, True, False, Token)
If GetMoments Then DownloadData(1, True, True, Token) If DownloadVideos And GetMoments Then DownloadData(1, True, True, Token)
If Not IsChannel And Not IsCreator And DownloadImages And Not IsSubscription Then If Not IsChannel And Not IsCreator And DownloadImages And Not IsSubscription Then
DownloadData(1, False, False, Token) DownloadData(1, False, False, Token)
ReparsePhoto(Token) ReparsePhoto(Token)
@@ -277,7 +298,10 @@ Namespace API.Xhamster
End If End If
ElseIf Not SiteMode = SiteModes.Search Then ElseIf Not SiteMode = SiteModes.Search Then
If IsVideo Then If IsVideo Then
If GetMoments Then containerNodes.Add({"momentListComponent", "videoThumbProps"}) If GetMoments Then
containerNodes.Add({"momentListComponent", "videoThumbProps"})
containerNodes.Add({"momentsComponent", "videoListProps", "videoThumbProps"})
End If
containerNodes.Add({"trendingVideoListComponent", "models"}) containerNodes.Add({"trendingVideoListComponent", "models"})
containerNodes.Add({"pagesCategoryComponent", "trendingVideoListProps", "models"}) containerNodes.Add({"pagesCategoryComponent", "trendingVideoListProps", "models"})
containerNodes.Add({"trendingVideoSectionComponent", "videoModels"}) containerNodes.Add({"trendingVideoSectionComponent", "videoModels"})
@@ -287,6 +311,7 @@ Namespace API.Xhamster
containerNodes.Add({"videoListComponent", "videoThumbProps"}) containerNodes.Add({"videoListComponent", "videoThumbProps"})
Else Else
containerNodes.Add({"userGalleriesCollection"}) containerNodes.Add({"userGalleriesCollection"})
containerNodes.Add({"contentComponent", "items"})
End If End If
End If End If
@@ -299,9 +324,9 @@ Namespace API.Xhamster
URL = GetNonUserUrl(Page) URL = GetNonUserUrl(Page)
containerNodes.Add({"searchResult", "models"}) containerNodes.Add({"searchResult", "models"})
ElseIf IsCreator Or SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories Or SiteMode = SiteModes.Pornstars Then ElseIf IsCreator Or SiteMode = SiteModes.Tags Or SiteMode = SiteModes.Categories Or SiteMode = SiteModes.Pornstars Then
URL = GetNonUserUrl(Page) URL = GetNonUserUrl(Page, IsCreator And GetMoments)
Else Else
URL = $"https://xhamster.com/users/{NameTrue}/{If(GetMoments, "moments", IIf(IsVideo, "videos", "photos"))}{IIf(Page = 1, String.Empty, $"/{Page}")}" URL = $"https://xhamster.com/{SiteSettings.UserOption}/{NameTrue}/{If(GetMoments, "moments", IIf(IsVideo, "videos", "photos"))}{IIf(Page = 1, String.Empty, $"/{Page}")}"
End If End If
ThrowAny(Token) ThrowAny(Token)
@@ -401,9 +426,9 @@ Namespace API.Xhamster
If _TempMediaList(i).Type = UTypes.VideoPre Then If _TempMediaList(i).Type = UTypes.VideoPre Then
m = _TempMediaList(i) m = _TempMediaList(i)
If Not m.URL_BASE.IsEmptyString Then If Not m.URL_BASE.IsEmptyString Then
m2 = Nothing m2 = m
ThrowAny(Token) ThrowAny(Token)
If GetM3U8(m2, m.URL_BASE, m.SpecialFolder) Then If GetM3U8_Init(m2, m.URL_BASE, m.SpecialFolder, i) Then
m2.URL_BASE = m.URL_BASE m2.URL_BASE = m.URL_BASE
_TempMediaList(i) = m2 _TempMediaList(i) = m2
Else Else
@@ -431,9 +456,9 @@ Namespace API.Xhamster
If Not DownloadTopCount.HasValue OrElse c <= DownloadTopCount.Value Then If Not DownloadTopCount.HasValue OrElse c <= DownloadTopCount.Value Then
m = _TempMediaList(i) m = _TempMediaList(i)
If Not m.URL_BASE.IsEmptyString Then If Not m.URL_BASE.IsEmptyString Then
m2 = Nothing m2 = m
ThrowAny(Token) ThrowAny(Token)
If GetM3U8(m2, m.URL_BASE, String.Empty) Then If GetM3U8_Init(m2, m.URL_BASE, String.Empty, i) Then
m2.URL_BASE = m.URL_BASE m2.URL_BASE = m.URL_BASE
_TempMediaList(i) = m2 _TempMediaList(i) = m2
c += 1 c += 1
@@ -472,7 +497,7 @@ Namespace API.Xhamster
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Count > 0 Then If j.Count > 0 Then
MaxPage = j.Value({"pagination"}, "maxPage").FromXML(Of Integer)(-1) MaxPage = j.Value({"pagination"}, "maxPage").IfNullOrEmpty(j.Value({"galleryPage", "paginationProps"}, "lastPageNumber")).FromXML(Of Integer)(-1)
With j({"photosGalleryModel"}, "photos") With j({"photosGalleryModel"}, "photos")
If .ListExists Then If .ListExists Then
For Each e In .Self For Each e In .Self
@@ -514,7 +539,7 @@ Namespace API.Xhamster
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token) ThrowAny(Token)
m2 = Nothing m2 = Nothing
If GetM3U8(m2, m.URL_BASE, m.SpecialFolder) Then If GetM3U8_Init(m2, m.URL_BASE, m.SpecialFolder, i) Then
m2.URL_BASE = m.URL_BASE m2.URL_BASE = m.URL_BASE
m2.State = UserMedia.States.Missing m2.State = UserMedia.States.Missing
m2.Attempts = m.Attempts m2.Attempts = m.Attempts
@@ -535,25 +560,85 @@ Namespace API.Xhamster
End Sub End Sub
#End Region #End Region
#Region "GetM3U8" #Region "GetM3U8"
Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal URL As String, ByVal SpecFolder As String) As Boolean Private Structure XMMediaInfo : Implements IComparable(Of XMMediaInfo)
Friend URL As String
Friend Type As UTypes
Friend IsInternal As Boolean
Friend Thumb As String
Friend FormatID As String
Friend Width As Integer
Friend Height As Integer
Friend Title As String
Private Function CompareTo(ByVal Other As XMMediaInfo) As Integer Implements IComparable(Of XMMediaInfo).CompareTo
Return Width.CompareTo(Other.Width) * -1
End Function
End Structure
Private Function GetM3U8_Init(ByRef m As UserMedia, ByVal URL As String, ByVal SpecFolder As String, ByVal n As Integer) As Boolean
Try Try
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
Dim r$ = Responser.GetResponse(URL) Dim IsInternal As Boolean = False
If Not r.IsEmptyString Then r = RegexReplace(r, HtmlScript) Dim r$ = GetMediaInfo(URL, n, IsInternal)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r) Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then If j.ListExists Then
m = ExtractMedia(j("videoModel"), UTypes.VideoPre,,,, SpecFolder) If IsInternal AndAlso GetM3U8_Internal(m, URL, j, SpecFolder) Then
m.URL_BASE = URL Return True
If IsSubscription Then Else
With j("videoModel") Dim xmm As New XMMediaInfo
Dim __checkURL As Func(Of EContainer, XMMediaInfo, XMMediaInfo) =
Function(ByVal jj As EContainer, ByVal __xmm As XMMediaInfo) As XMMediaInfo
With jj.Value("url").StringToLower
If Not .IsEmptyString AndAlso .EndsWith(".m3u8") Or .EndsWith(".mp4") Then __xmm.URL = .Self
End With
Return __xmm
End Function
Dim __applyXMM As Func(Of EContainer, XMMediaInfo, XMMediaInfo) =
Function(ByVal jj As EContainer, ByVal __xmm As XMMediaInfo) As XMMediaInfo
With jj
__xmm.Type = IIf(__xmm.URL.ToLower.EndsWith(".m3u8"), UTypes.m3u8, UTypes.Video)
__xmm.Width = AConvert(Of Integer)(.Value("width"), 1, EDP.ReturnValue)
__xmm.Height = AConvert(Of Integer)(.Value("height"), 1, EDP.ReturnValue)
__xmm.FormatID = .Value("format_id")
End With
Return __xmm
End Function
xmm = __checkURL(j, xmm)
If Not xmm.URL.IsEmptyString Then
xmm = __applyXMM(j, xmm)
Else
With j("formats")
If .ListExists Then If .ListExists Then
m.URL = .Value("thumbURL").IfNullOrEmpty(.Value("previewThumbURL")) Dim l As New List(Of XMMediaInfo)
Return Not m.URL.IsEmptyString Dim tmpXMM As XMMediaInfo
For Each format As EContainer In .Self
tmpXMM = New XMMediaInfo
tmpXMM = __checkURL(format, tmpXMM)
If Not tmpXMM.URL.IsEmptyString Then
tmpXMM = __applyXMM(format, tmpXMM)
l.Add(tmpXMM)
End If
Next
If l.Count > 0 Then
If Not CBool(MySettings.DownloadUHD.Value) AndAlso l.LongCount(Function(v) v.Height <= 1080) > 0 Then _
l.RemoveAll(Function(v) v.Height > 1080)
l.Sort()
xmm = l.First
l.Clear()
End If
End If End If
End With End With
Else End If
Return GetM3U8(m, j, SpecFolder) If Not xmm.URL.IsEmptyString Then
xmm.IsInternal = False
xmm.Thumb = j.Value("thumbnail")
xmm.Title = TitleHtmlConverter(j.Value("title").IfNullOrEmpty(j.Value("fulltitle")))
If Not xmm.Title.IsEmptyString Then m.File.Name = xmm.Title
m.Type = xmm.Type
m.URL = IIf(IsSubscription, xmm.Thumb, xmm.URL)
m.Object = xmm
m.SpecialFolder = SpecFolder
Return True
End If
End If End If
End If End If
End Using End Using
@@ -561,16 +646,127 @@ Namespace API.Xhamster
End If End If
Return False Return False
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.ReturnValue, ex, $"[{ToStringForLog()}]: API.Xhamster.GetM3U8({URL})", False) Return ErrorsDescriber.Execute(EDP.ReturnValue, ex, $"[{ToStringForLog()}]: API.Xhamster.GetM3U8_Init({URL})", False)
End Try End Try
End Function End Function
Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal j As EContainer, ByVal SpecFolder As String) As Boolean Private Function GetMediaInfo(ByVal URL As String, ByVal n As Integer, ByRef IsInternal As Boolean) As String
Dim node As EContainer = j({"xplayerSettings", "sources", "hls"}) Try
If node.ListExists Then If Not URL.IsEmptyString Then
Dim url$ = node.GetNode({New NodeParams("url", True, True, True, True, 2)}).XmlIfNothingValue Dim r$ = String.Empty
If Not url.IsEmptyString Then m.URL = url : m.Type = UTypes.m3u8 : Return True Dim f As SFile
If IsSubscription Then
Try
If Not CBool(MySettings.UseYTDLPForceDisableInternal.Value) Then r = Responser.GetResponse(URL)
Catch exr As Exception
ErrorsDescriber.Execute(EDP.SendToLog, exr, $"[{ToStringForLog()}]: API.Xhamster.GetMediaInfo({URL})", False)
End Try
If Not r.IsEmptyString Then r = RegexReplace(r, HtmlScript)
If Not r.IsEmptyString Then
IsInternal = True
Return r
Else
f = YTDLPGetInfo(URL, n)
If f.Exists Then IsInternal = False : Return f.GetText
End If
Else
f = YTDLPGetInfo(URL, n)
If f.Exists Then IsInternal = False : Return f.GetText
End If
End If
Return String.Empty
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"[{ToStringForLog()}]: API.Xhamster.GetMediaInfo({URL})", String.Empty)
End Try
End Function
Private Function GetM3U8_Internal(ByRef m As UserMedia, ByVal URL As String, ByVal j As EContainer, ByVal SpecFolder As String) As Boolean
Try
If j.ListExists Then
m = ExtractMedia(j("videoModel"), UTypes.VideoPre,,,, SpecFolder)
m.URL_BASE = URL
m.SpecialFolder = SpecFolder
If IsSubscription Then
With j("videoModel")
If .ListExists Then
m.URL = .Value("thumbURL").IfNullOrEmpty(.Value("previewThumbURL"))
m.Object = New XMMediaInfo With {
.IsInternal = True,
.Thumb = m.URL,
.URL = URL,
.Type = UTypes.VideoPre
}
Return Not m.URL.IsEmptyString
End If
End With
Else
Return GetM3U8_Internal_GetURL(m, j)
End If
End If End If
Return False Return False
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.ReturnValue, ex, $"[{ToStringForLog()}]: API.Xhamster.GetM3U8_Internal({URL})", False)
End Try
End Function
Private Function GetM3U8_Internal_GetURL(ByRef m As UserMedia, ByVal j As EContainer, Optional ByVal r As Integer = 0) As Boolean
Const urlNode$ = "url"
Dim node As EContainer = j({"xplayerSettings", "sources", If(r = 0, "hls", "standard")})
Dim t As UTypes = UTypes.Undefined
If node.ListExists Then
Dim url$ 'node.GetNode({New NodeParams("url", True, True, True, True, 2)}).XmlIfNothingValue
Dim jn As EContainer, jn2 As EContainer
Dim __getUrl As Func(Of EContainer, String) = Function(jj) If(jj.Contains(urlNode), jj.Value(urlNode), String.Empty)
url = __getUrl(node)
If url.IsEmptyString Then
For Each jn In node
If jn.Contains(urlNode) Then
url = __getUrl(jn)
ElseIf jn.Count > 0 Then
For Each jn2 In jn
url = __getUrl(jn2)
If Not url.IsEmptyString Then Exit For
Next
End If
If Not url.IsEmptyString Then Exit For
Next
End If
If Not url.IsEmptyString Then
If url.ToLower.EndsWith(".m3u8") Then
t = UTypes.m3u8
ElseIf url.ToLower.EndsWith(".mp4") Then
t = UTypes.Video
End If
If Not t = UTypes.Undefined Then
m.URL = url
m.Type = t
m.Object = New XMMediaInfo With {
.IsInternal = True,
.Type = t,
.URL = url,
.Thumb = j.Value({"videoModel"}, "thumbURL").IfNullOrEmpty(j.Value({"videoModel"}, "previewThumbURL"))
}
Return True
End If
End If
End If
If r = 0 Then Return GetM3U8_Internal_GetURL(m, j, r + 1)
Return False
End Function
#End Region
#Region "yt-dlp support"
#Disable Warning IDE0060
Private Function YTDLPGetInfo(ByVal URL As String, ByVal n As Integer) As SFile
#Enable Warning
Try
Dim cc As CacheKeeper = GetCache()
cc.Validate()
Dim path As SFile = cc.NewPath
Dim c$ = If(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 YTDLP.YTDLPBatch(TokenPersonal,, path) : ytdlp.Encoding = Settings.CMDEncoding : ytdlp.Execute(cmd) : End Using
Return SFile.GetFiles(path, "*.json",, EDP.ReturnValue).FirstOrDefault
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"API.Xhamster.UserData.YTDLPGetInfo({URL})", New SFile)
End Try
End Function End Function
#End Region #End Region
#Region "DownloadSingleObject" #Region "DownloadSingleObject"
@@ -583,9 +779,43 @@ Namespace API.Xhamster
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
Private Function XMMObjectExists(ByVal Media As UserMedia) As Boolean
Return Not IsNothing(Media.Object) AndAlso TypeOf Media.Object Is XMMediaInfo
End Function
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
If CBool(MySettings.UseYTDLPDownload.Value) Then
If XMMObjectExists(Media) Then Return YTDLPDownload(Media, DestinationFile, Token)
Return Nothing
Else
Media.File = DestinationFile Media.File = DestinationFile
Return M3U8.Download(Media, Responser, MySettings.DownloadUHD.Value, Token, Progress, Not IsSingleObjectDownload, MySettings.ReencodeVideos.Value) Return M3U8.Download(Media, Responser, MySettings.DownloadUHD.Value, Token, Progress, Not IsSingleObjectDownload, MySettings.ReencodeVideos.Value)
End If
End Function
Protected Overrides Function ValidateDownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByRef Interrupt As Boolean) As Boolean
If Not Media.IsPhotoType AndAlso CBool(MySettings.UseYTDLPDownload.Value) Then
If Not Media.URL_BASE.IsEmptyString And XMMObjectExists(Media) AndAlso
Not DirectCast(Media.Object, XMMediaInfo).FormatID.IsEmptyString Then Return True
Interrupt = True
End If
Return False
End Function
Protected Overrides Function DownloadFile(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return YTDLPDownload(Media, DestinationFile, Token)
End Function
Private Function YTDLPDownload(ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
DestinationFile.Extension = "mp4"
Dim c$ = If(MySettings.CookiesNetscapeFile.Exists, $" --no-cookies-from-browser --cookies ""{MySettings.CookiesNetscapeFile}""", String.Empty)
Dim cmd$ = $"""{Settings.YtdlpFile}"" --format {DirectCast(Media.Object, XMMediaInfo).FormatID}{c} {Media.URL_BASE} -o ""{DestinationFile}"""
Using ytdlp As New YTDLP.YTDLPBatch(Token,, DestinationFile)
ytdlp.Encoding = Settings.CMDEncoding
ytdlp.CreateFileExchanger(GetCache)
If IsSingleObjectDownload Then ytdlp.SetProgress(Progress, Function(v) v / 100)
ytdlp.Execute(cmd)
End Using
Return DestinationFile
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 Function
#End Region #End Region
#Region "Create media" #Region "Create media"
@@ -651,7 +881,7 @@ Namespace API.Xhamster
#End Region #End Region
#Region "IDisposable support" #Region "IDisposable support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _TempPhotoData.Clear() : SessionPosts.Clear() If Not disposedValue And disposing Then _TempPhotoData.Clear() : SessionPosts.Clear() : ResetCache()
MyBase.Dispose(disposing) MyBase.Dispose(disposing)
End Sub End Sub
#End Region #End Region

View File

@@ -10,16 +10,19 @@ Imports SCrawler.API.Base
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.Xhamster Namespace API.Xhamster
Friend NotInheritable Class UserExchangeOptions : Inherits API.Base.EditorExchangeOptionsBase_P Friend NotInheritable Class UserExchangeOptions : Inherits API.Base.EditorExchangeOptionsBase_P
<PSetting(Address:=SettingAddress.User, Caption:="Get moments")> <PSetting(Address:=SettingAddress.User, Caption:=SiteSettings.GetMomentsCaption)>
Friend Property GetMoments As Boolean = False Friend Property GetMoments As Boolean = False
Friend Sub New() Friend Sub New()
MyBase.New
End Sub End Sub
Friend Sub New(ByVal u As IPSite) Friend Sub New(ByVal u As IPSite)
MyBase.New(DirectCast(u, UserData)) MyBase.New(DirectCast(u, UserData))
GetMoments = DirectCast(u, UserData).GetMoments GetMoments = DirectCast(u, UserData).GetMoments
End Sub End Sub
Friend Overrides Sub Apply(ByRef u As IPSite) Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
GetMoments = s.GetMoments.Value
End Sub
Friend Overrides Sub Apply(ByRef u As UserDataBase)
MyBase.Apply(u) MyBase.Apply(u)
DirectCast(u, UserData).GetMoments = GetMoments DirectCast(u, UserData).GetMoments = GetMoments
End Sub End Sub

View File

@@ -121,6 +121,7 @@ Namespace API.YouTube
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions) With DirectCast(Obj, UserExchangeOptions)
.Apply(Me)
DownloadYTVideos = .DownloadVideos DownloadYTVideos = .DownloadVideos
DownloadYTShorts = .DownloadShorts DownloadYTShorts = .DownloadShorts
DownloadYTPlaylists = .DownloadPlaylists DownloadYTPlaylists = .DownloadPlaylists

View File

@@ -8,7 +8,7 @@
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.YouTube Namespace API.YouTube
Friend Class UserExchangeOptions Friend Class UserExchangeOptions : Inherits SCrawler.API.Base.EditorExchangeOptionsBase
<PSetting(Caption:="Download videos")> <PSetting(Caption:="Download videos")>
Friend Property DownloadVideos As Boolean Friend Property DownloadVideos As Boolean
<PSetting(Caption:="Download shorts")> <PSetting(Caption:="Download shorts")>
@@ -23,7 +23,14 @@ Namespace API.YouTube
Friend Property UseCookies As Boolean Friend Property UseCookies As Boolean
<PSetting(Caption:="Channel ID", Address:=SettingAddress.User)> <PSetting(Caption:="Channel ID", Address:=SettingAddress.User)>
Friend Property ChannelID As String Friend Property ChannelID As String
<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
Friend Sub New(ByVal u As UserData) Friend Sub New(ByVal u As UserData)
MyBase.New(u)
_ApplyBase_Name = False
_ApplyBase_Text = False
DownloadVideos = u.DownloadYTVideos DownloadVideos = u.DownloadYTVideos
DownloadShorts = u.DownloadYTShorts DownloadShorts = u.DownloadYTShorts
DownloadPlaylists = u.DownloadYTPlaylists DownloadPlaylists = u.DownloadYTPlaylists
@@ -33,6 +40,9 @@ Namespace API.YouTube
ChannelID = u.ChannelID ChannelID = u.ChannelID
End Sub End Sub
Friend Sub New(ByVal s As SiteSettings) Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
_ApplyBase_Name = False
_ApplyBase_Text = False
DownloadVideos = s.DownloadVideos.Value DownloadVideos = s.DownloadVideos.Value
DownloadShorts = s.DownloadShorts.Value DownloadShorts = s.DownloadShorts.Value
DownloadPlaylists = s.DownloadPlaylists.Value DownloadPlaylists = s.DownloadPlaylists.Value

Binary file not shown.

Before

Width:  |  Height:  |  Size: 15 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.6 KiB

View File

@@ -17,11 +17,6 @@ Namespace DownloadObjects
Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider, IComparable(Of AutoDownloader) Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider, IComparable(Of AutoDownloader)
Friend Event PauseChanged(ByVal Value As PauseModes) Friend Event PauseChanged(ByVal Value As PauseModes)
Friend Event PlanChanged As Scheduler.PlanChangedEventHandler Friend Event PlanChanged As Scheduler.PlanChangedEventHandler
Friend Enum Modes As Integer
None = 0
Specified = 3
Groups = 4
End Enum
Friend Const NoPauseMode As Integer = -100 Friend Const NoPauseMode As Integer = -100
Friend Enum PauseModes As Integer Friend Enum PauseModes As Integer
Disabled = -2 Disabled = -2
@@ -188,8 +183,7 @@ Namespace DownloadObjects
End Class End Class
#End Region #End Region
#Region "XML Names" #Region "XML Names"
Private Const Name_Mode As String = "Mode" Private Const Name_Enabled As String = "Enabled"
Private Const Name_Groups As String = "Groups"
Private Const Name_IsManual As String = "IsManual" Private Const Name_IsManual As String = "IsManual"
Private Const Name_Timer As String = "Timer" Private Const Name_Timer As String = "Timer"
Private Const Name_StartupDelay As String = "StartupDelay" Private Const Name_StartupDelay As String = "StartupDelay"
@@ -247,17 +241,16 @@ Namespace DownloadObjects
End Get End Get
End Property End Property
Friend Property Source As Scheduler Friend Property Source As Scheduler
Private _Mode As Modes = Modes.None Private _Enabled As Boolean = False
Friend Property Mode As Modes Friend Property Enabled As Boolean
Get Get
Return _Mode Return _Enabled
End Get End Get
Set(ByVal m As Modes) Set(ByVal e As Boolean)
_Mode = m _Enabled = e
If _Mode = Modes.None Then [Stop]() If Not _Enabled Then [Stop]()
End Set End Set
End Property End Property
Friend ReadOnly Property Groups As List(Of String)
Friend Property IsManual As Boolean = False Friend Property IsManual As Boolean = False
Friend Property Timer As Integer = DefaultTimer Friend Property Timer As Integer = DefaultTimer
Friend Property StartupDelay As Integer = 1 Friend Property StartupDelay As Integer = 1
@@ -371,7 +364,6 @@ Namespace DownloadObjects
End Get End Get
End Property End Property
Friend Sub New(Optional ByVal IsNewPlan As Boolean = False) Friend Sub New(Optional ByVal IsNewPlan As Boolean = False)
Groups = New List(Of String)
UserKeys = New List(Of NotifiedUser) UserKeys = New List(Of NotifiedUser)
_IsNewPlan = IsNewPlan _IsNewPlan = IsNewPlan
Initialization = False Initialization = False
@@ -379,10 +371,9 @@ Namespace DownloadObjects
Friend Sub New(ByVal x As EContainer) Friend Sub New(ByVal x As EContainer)
Me.New Me.New
Initialization = True Initialization = True
Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
Import(x) Import(x)
Enabled = x.Value(Name_Enabled).FromXML(Of Boolean)(False)
If Name.IsEmptyString Then Name = "Default" If Name.IsEmptyString Then Name = "Default"
Groups.ListAddList(x.Value(Name_Groups).StringToList(Of String)("|"), LAP.NotContainsOnly)
IsManual = x.Value(Name_IsManual).FromXML(Of Boolean)(False) IsManual = x.Value(Name_IsManual).FromXML(Of Boolean)(False)
Timer = x.Value(Name_Timer).FromXML(Of Integer)(DefaultTimer) Timer = x.Value(Name_Timer).FromXML(Of Integer)(DefaultTimer)
@@ -408,8 +399,7 @@ Namespace DownloadObjects
newObj.Copy(Me) newObj.Copy(Me)
With newObj With newObj
.Name = String.Empty .Name = String.Empty
._Mode = _Mode .Enabled = Enabled
.Groups.ListAddList(Groups, LAP.ClearBeforeAdd)
.IsManual = IsManual .IsManual = IsManual
.Timer = Timer .Timer = Timer
.StartupDelay = StartupDelay .StartupDelay = StartupDelay
@@ -441,8 +431,7 @@ Namespace DownloadObjects
End Sub End Sub
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return Export(New EContainer(Scheduler.Name_Plan, String.Empty) From { Return Export(New EContainer(Scheduler.Name_Plan, String.Empty) From {
New EContainer(Name_Mode, CInt(Mode)), New EContainer(Name_Enabled, Enabled.BoolToInteger),
New EContainer(Name_Groups, Groups.ListToString("|")),
New EContainer(Name_IsManual, IsManual.BoolToInteger), New EContainer(Name_IsManual, IsManual.BoolToInteger),
New EContainer(Name_Timer, Timer), New EContainer(Name_Timer, Timer),
New EContainer(Name_StartupDelay, StartupDelay), New EContainer(Name_StartupDelay, StartupDelay),
@@ -467,7 +456,7 @@ Namespace DownloadObjects
If Not IsManual Or Force Then If Not IsManual Or Force Then
If Init Then _StartTime = Now If Init Then _StartTime = Now
_IsNewPlan = False _IsNewPlan = False
If Not Working And Not Mode = Modes.None Then _Working = True If Not Working And Enabled Then _Working = True
RaiseEvent PlanChanged(Me) RaiseEvent PlanChanged(Me)
End If End If
End Sub End Sub
@@ -556,12 +545,12 @@ Namespace DownloadObjects
Get Get
If _StopRequested Then _Working = False If _StopRequested Then _Working = False
Return (Working Or IsManual) And ((IsManual And _ForceStartRequested) Or (Not IsManual And NextExecutionDate < Now And (Not IsPaused Or IgnorePause)) Or _ForceStartRequested) And Return (Working Or IsManual) And ((IsManual And _ForceStartRequested) Or (Not IsManual And NextExecutionDate < Now And (Not IsPaused Or IgnorePause)) Or _ForceStartRequested) And
Not _StopRequested And Not Mode = Modes.None And (Not Downloader.Working Or IgnoreDownloaderWorking) Not _StopRequested And Enabled And (Not Downloader.Working Or IgnoreDownloaderWorking)
End Get End Get
End Property End Property
Friend ReadOnly Property NextDate As Date? Friend ReadOnly Property NextDate As Date?
Get Get
If Not _StopRequested And Not Mode = Modes.None Then If Not _StopRequested And Enabled Then
If IsManual Or _ForceStartRequested Then If IsManual Or _ForceStartRequested Then
Return Now.AddYears(-10) Return Now.AddYears(-10)
ElseIf Not IsPaused And Not IsManual And Working Then ElseIf Not IsPaused And Not IsManual And Working Then
@@ -583,8 +572,6 @@ Namespace DownloadObjects
Dim Keys As New List(Of String) Dim Keys As New List(Of String)
Try Try
Dim users As New List(Of IUserData) Dim users As New List(Of IUserData)
Dim GName$
Dim i%
Dim doRound% = -1, doLim% = Settings.Plugins.Count Dim doRound% = -1, doLim% = Settings.Plugins.Count
Dim DownloadedUsersCount% = 0 Dim DownloadedUsersCount% = 0
Dim DownloadedSubscriptionsCount% = 0 Dim DownloadedSubscriptionsCount% = 0
@@ -614,16 +601,9 @@ Namespace DownloadObjects
Catch n_ex As Exception Catch n_ex As Exception
End Try End Try
End Sub End Sub
Select Case Mode
Case Modes.Specified : users.ListAddList(DownloadGroup.GetUsers(Me)) If Enabled Then users.ListAddList(DownloadGroup.GetUsers(Me))
Case Modes.Groups
If Groups.Count > 0 And Settings.Groups.Count > 0 Then
For Each GName In Groups
i = Settings.Groups.IndexOf(GName)
If i >= 0 Then users.ListAddList(Settings.Groups(i).GetUsers, LAP.IgnoreICopier, LAP.NotContainsOnly)
Next
End If
End Select
If users.Count > 0 Then If users.Count > 0 Then
Keys.ListAddList(users.Select(Function(u) u.Key)) Keys.ListAddList(users.Select(Function(u) u.Key))
With Downloader With Downloader
@@ -699,7 +679,6 @@ Namespace DownloadObjects
If Not disposedValue And disposing Then If Not disposedValue And disposing Then
[Stop]() [Stop]()
UserKeys.ListClearDispose() UserKeys.ListClearDispose()
Groups.Clear()
End If End If
MyBase.Dispose(disposing) MyBase.Dispose(disposing)
End Sub End Sub

View File

@@ -25,19 +25,14 @@ Namespace DownloadObjects
Me.components = New System.ComponentModel.Container() Me.components = New System.ComponentModel.Container()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MODE As System.Windows.Forms.TableLayoutPanel Dim TP_MODE 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(AutoDownloaderEditorForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_NOTIFY As System.Windows.Forms.TableLayoutPanel Dim TP_NOTIFY As System.Windows.Forms.TableLayoutPanel
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(AutoDownloaderEditorForm))
Dim ActionButton5 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TT_MAIN As System.Windows.Forms.ToolTip Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.DEF_GROUP = New SCrawler.DownloadObjects.Groups.GroupDefaults() Me.DEF_GROUP = New SCrawler.DownloadObjects.Groups.GroupDefaults()
Me.OPT_SPEC = New System.Windows.Forms.RadioButton() Me.OPT_ENABLED = New System.Windows.Forms.RadioButton()
Me.OPT_DISABLED = New System.Windows.Forms.RadioButton() Me.OPT_DISABLED = New System.Windows.Forms.RadioButton()
Me.OPT_GROUP = New System.Windows.Forms.RadioButton()
Me.TXT_GROUPS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_NOTIFY = New System.Windows.Forms.CheckBox() Me.CH_NOTIFY = New System.Windows.Forms.CheckBox()
Me.CH_SHOW_PIC = New System.Windows.Forms.CheckBox() Me.CH_SHOW_PIC = New System.Windows.Forms.CheckBox()
Me.CH_SHOW_PIC_USER = New System.Windows.Forms.CheckBox() Me.CH_SHOW_PIC_USER = New System.Windows.Forms.CheckBox()
@@ -54,7 +49,6 @@ Namespace DownloadObjects
CONTAINER_MAIN.SuspendLayout() CONTAINER_MAIN.SuspendLayout()
Me.DEF_GROUP.SuspendLayout() Me.DEF_GROUP.SuspendLayout()
TP_MODE.SuspendLayout() TP_MODE.SuspendLayout()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).BeginInit()
TP_NOTIFY.SuspendLayout() TP_NOTIFY.SuspendLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.NUM_DELAY, System.ComponentModel.ISupportInitialize).BeginInit()
@@ -66,7 +60,7 @@ Namespace DownloadObjects
'CONTAINER_MAIN.ContentPanel 'CONTAINER_MAIN.ContentPanel
' '
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DEF_GROUP) CONTAINER_MAIN.ContentPanel.Controls.Add(Me.DEF_GROUP)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 519) CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(476, 494)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0) CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -82,7 +76,6 @@ Namespace DownloadObjects
Me.DEF_GROUP.ColumnCount = 1 Me.DEF_GROUP.ColumnCount = 1
Me.DEF_GROUP.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) Me.DEF_GROUP.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEF_GROUP.Controls.Add(TP_MODE, 0, 0) Me.DEF_GROUP.Controls.Add(TP_MODE, 0, 0)
Me.DEF_GROUP.Controls.Add(Me.TXT_GROUPS, 0, 12)
Me.DEF_GROUP.Controls.Add(TP_NOTIFY, 0, 13) Me.DEF_GROUP.Controls.Add(TP_NOTIFY, 0, 13)
Me.DEF_GROUP.Controls.Add(Me.TXT_TIMER, 0, 15) Me.DEF_GROUP.Controls.Add(Me.TXT_TIMER, 0, 15)
Me.DEF_GROUP.Controls.Add(Me.NUM_DELAY, 0, 16) Me.DEF_GROUP.Controls.Add(Me.NUM_DELAY, 0, 16)
@@ -111,21 +104,18 @@ Namespace DownloadObjects
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!)) Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) Me.DEF_GROUP.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.DEF_GROUP.Size = New System.Drawing.Size(476, 519) Me.DEF_GROUP.Size = New System.Drawing.Size(476, 494)
Me.DEF_GROUP.TabIndex = 0 Me.DEF_GROUP.TabIndex = 0
' '
'TP_MODE 'TP_MODE
' '
TP_MODE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single] TP_MODE.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MODE.ColumnCount = 3 TP_MODE.ColumnCount = 2
TP_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33333!)) TP_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33333!)) TP_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
TP_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 33.33333!))
TP_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!)) TP_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!)) TP_MODE.Controls.Add(Me.OPT_ENABLED, 1, 0)
TP_MODE.Controls.Add(Me.OPT_SPEC, 1, 0)
TP_MODE.Controls.Add(Me.OPT_DISABLED, 0, 0) TP_MODE.Controls.Add(Me.OPT_DISABLED, 0, 0)
TP_MODE.Controls.Add(Me.OPT_GROUP, 2, 0)
TP_MODE.Dock = System.Windows.Forms.DockStyle.Fill TP_MODE.Dock = System.Windows.Forms.DockStyle.Fill
TP_MODE.Location = New System.Drawing.Point(1, 1) TP_MODE.Location = New System.Drawing.Point(1, 1)
TP_MODE.Margin = New System.Windows.Forms.Padding(0) TP_MODE.Margin = New System.Windows.Forms.Padding(0)
@@ -135,18 +125,18 @@ Namespace DownloadObjects
TP_MODE.Size = New System.Drawing.Size(474, 25) TP_MODE.Size = New System.Drawing.Size(474, 25)
TP_MODE.TabIndex = 0 TP_MODE.TabIndex = 0
' '
'OPT_SPEC 'OPT_ENABLED
' '
Me.OPT_SPEC.AutoSize = True Me.OPT_ENABLED.AutoSize = True
Me.OPT_SPEC.Dock = System.Windows.Forms.DockStyle.Fill Me.OPT_ENABLED.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_SPEC.Location = New System.Drawing.Point(161, 4) Me.OPT_ENABLED.Location = New System.Drawing.Point(240, 4)
Me.OPT_SPEC.Name = "OPT_SPEC" Me.OPT_ENABLED.Name = "OPT_ENABLED"
Me.OPT_SPEC.Size = New System.Drawing.Size(150, 17) Me.OPT_ENABLED.Size = New System.Drawing.Size(230, 17)
Me.OPT_SPEC.TabIndex = 3 Me.OPT_ENABLED.TabIndex = 3
Me.OPT_SPEC.TabStop = True Me.OPT_ENABLED.TabStop = True
Me.OPT_SPEC.Text = "Specified" Me.OPT_ENABLED.Text = "Enabled"
TT_MAIN.SetToolTip(Me.OPT_SPEC, "Select parameters") TT_MAIN.SetToolTip(Me.OPT_ENABLED, "Select parameters")
Me.OPT_SPEC.UseVisualStyleBackColor = True Me.OPT_ENABLED.UseVisualStyleBackColor = True
' '
'OPT_DISABLED 'OPT_DISABLED
' '
@@ -154,48 +144,13 @@ Namespace DownloadObjects
Me.OPT_DISABLED.Dock = System.Windows.Forms.DockStyle.Fill Me.OPT_DISABLED.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_DISABLED.Location = New System.Drawing.Point(4, 4) Me.OPT_DISABLED.Location = New System.Drawing.Point(4, 4)
Me.OPT_DISABLED.Name = "OPT_DISABLED" Me.OPT_DISABLED.Name = "OPT_DISABLED"
Me.OPT_DISABLED.Size = New System.Drawing.Size(150, 17) Me.OPT_DISABLED.Size = New System.Drawing.Size(229, 17)
Me.OPT_DISABLED.TabIndex = 0 Me.OPT_DISABLED.TabIndex = 0
Me.OPT_DISABLED.TabStop = True Me.OPT_DISABLED.TabStop = True
Me.OPT_DISABLED.Text = "Disabled" Me.OPT_DISABLED.Text = "Disabled"
TT_MAIN.SetToolTip(Me.OPT_DISABLED, "Automation disabled") TT_MAIN.SetToolTip(Me.OPT_DISABLED, "Automation disabled")
Me.OPT_DISABLED.UseVisualStyleBackColor = True Me.OPT_DISABLED.UseVisualStyleBackColor = True
' '
'OPT_GROUP
'
Me.OPT_GROUP.AutoSize = True
Me.OPT_GROUP.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_GROUP.Location = New System.Drawing.Point(318, 4)
Me.OPT_GROUP.Name = "OPT_GROUP"
Me.OPT_GROUP.Size = New System.Drawing.Size(152, 17)
Me.OPT_GROUP.TabIndex = 4
Me.OPT_GROUP.TabStop = True
Me.OPT_GROUP.Text = "Groups"
TT_MAIN.SetToolTip(Me.OPT_GROUP, "Download groups")
Me.OPT_GROUP.UseVisualStyleBackColor = True
'
'TXT_GROUPS
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Edit"
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Info"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Info
ActionButton2.ToolTipText = "Open group"
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Clear"
Me.TXT_GROUPS.Buttons.Add(ActionButton1)
Me.TXT_GROUPS.Buttons.Add(ActionButton2)
Me.TXT_GROUPS.Buttons.Add(ActionButton3)
Me.TXT_GROUPS.CaptionText = "Groups"
Me.TXT_GROUPS.CaptionWidth = 50.0R
Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_GROUPS.Location = New System.Drawing.Point(4, 331)
Me.TXT_GROUPS.Name = "TXT_GROUPS"
Me.TXT_GROUPS.Size = New System.Drawing.Size(468, 22)
Me.TXT_GROUPS.TabIndex = 1
Me.TXT_GROUPS.TextBoxReadOnly = True
'
'TP_NOTIFY 'TP_NOTIFY
' '
TP_NOTIFY.ColumnCount = 4 TP_NOTIFY.ColumnCount = 4
@@ -266,9 +221,9 @@ Namespace DownloadObjects
' '
'TXT_TIMER 'TXT_TIMER
' '
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image) ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Refresh" ActionButton1.Name = "Refresh"
Me.TXT_TIMER.Buttons.Add(ActionButton4) Me.TXT_TIMER.Buttons.Add(ActionButton1)
Me.TXT_TIMER.CaptionText = "Timer" Me.TXT_TIMER.CaptionText = "Timer"
Me.TXT_TIMER.CaptionToolTipEnabled = True Me.TXT_TIMER.CaptionToolTipEnabled = True
Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)" Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)"
@@ -281,9 +236,9 @@ Namespace DownloadObjects
' '
'NUM_DELAY 'NUM_DELAY
' '
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image) ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton5.Name = "Refresh" ActionButton2.Name = "Refresh"
Me.NUM_DELAY.Buttons.Add(ActionButton5) Me.NUM_DELAY.Buttons.Add(ActionButton2)
Me.NUM_DELAY.CaptionText = "Delay" Me.NUM_DELAY.CaptionText = "Delay"
Me.NUM_DELAY.CaptionToolTipEnabled = True Me.NUM_DELAY.CaptionToolTipEnabled = True
Me.NUM_DELAY.CaptionToolTipText = "Startup delay" Me.NUM_DELAY.CaptionToolTipText = "Startup delay"
@@ -348,7 +303,6 @@ Namespace DownloadObjects
Me.DEF_GROUP.PerformLayout() Me.DEF_GROUP.PerformLayout()
TP_MODE.ResumeLayout(False) TP_MODE.ResumeLayout(False)
TP_MODE.PerformLayout() TP_MODE.PerformLayout()
CType(Me.TXT_GROUPS, System.ComponentModel.ISupportInitialize).EndInit()
TP_NOTIFY.ResumeLayout(False) TP_NOTIFY.ResumeLayout(False)
TP_NOTIFY.PerformLayout() TP_NOTIFY.PerformLayout()
CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).EndInit() CType(Me.TXT_TIMER, System.ComponentModel.ISupportInitialize).EndInit()
@@ -357,12 +311,10 @@ Namespace DownloadObjects
End Sub End Sub
Private WithEvents DEF_GROUP As DownloadObjects.Groups.GroupDefaults Private WithEvents DEF_GROUP As DownloadObjects.Groups.GroupDefaults
Private WithEvents TXT_GROUPS As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents OPT_ENABLED As RadioButton
Private WithEvents OPT_SPEC As RadioButton
Private WithEvents OPT_DISABLED As RadioButton Private WithEvents OPT_DISABLED As RadioButton
Private WithEvents CH_NOTIFY As CheckBox Private WithEvents CH_NOTIFY As CheckBox
Private WithEvents TXT_TIMER As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents TXT_TIMER As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents OPT_GROUP As RadioButton
Private WithEvents LBL_LAST_TIME_UP As Label Private WithEvents LBL_LAST_TIME_UP As Label
Private WithEvents NUM_DELAY As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents NUM_DELAY As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_SHOW_PIC As CheckBox Private WithEvents CH_SHOW_PIC As CheckBox

View File

@@ -129,85 +129,6 @@
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> <metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value> <value>17, 17</value>
</metadata> </metadata>
<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/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAACH
DwAAjA8AAP1SAACBQAAAfXkAAOmLAAA85QAAGcxzPIV3AAAKOWlDQ1BQaG90b3Nob3AgSUNDIHByb2Zp
bGUAAEjHnZZ3VFTXFofPvXd6oc0w0hl6ky4wgPQuIB0EURhmBhjKAMMMTWyIqEBEEREBRZCggAGjoUis
iGIhKKhgD0gQUGIwiqioZEbWSnx5ee/l5ffHvd/aZ+9z99l7n7UuACRPHy4vBZYCIJkn4Ad6ONNXhUfQ
sf0ABniAAaYAMFnpqb5B7sFAJC83F3q6yAn8i94MAUj8vmXo6U+ng/9P0qxUvgAAyF/E5mxOOkvE+SJO
yhSkiu0zIqbGJIoZRomZL0pQxHJijlvkpZ99FtlRzOxkHlvE4pxT2clsMfeIeHuGkCNixEfEBRlcTqaI
b4tYM0mYzBXxW3FsMoeZDgCKJLYLOKx4EZuImMQPDnQR8XIAcKS4LzjmCxZwsgTiQ7mkpGbzuXHxArou
S49uam3NoHtyMpM4AoGhP5OVyOSz6S4pyalMXjYAi2f+LBlxbemiIluaWltaGpoZmX5RqP+6+Dcl7u0i
vQr43DOI1veH7a/8UuoAYMyKarPrD1vMfgA6tgIgd/8Pm+YhACRFfWu/8cV5aOJ5iRcIUm2MjTMzM424
HJaRuKC/6386/A198T0j8Xa/l4fuyollCpMEdHHdWClJKUI+PT2VyeLQDf88xP848K/zWBrIieXwOTxR
RKhoyri8OFG7eWyugJvCo3N5/6mJ/zDsT1qca5Eo9Z8ANcoISN2gAuTnPoCiEAESeVDc9d/75oMPBeKb
F6Y6sTj3nwX9+65wifiRzo37HOcSGExnCfkZi2viawnQgAAkARXIAxWgAXSBITADVsAWOAI3sAL4gWAQ
DtYCFogHyYAPMkEu2AwKQBHYBfaCSlAD6kEjaAEnQAc4DS6Ay+A6uAnugAdgBIyD52AGvAHzEARhITJE
geQhVUgLMoDMIAZkD7lBPlAgFA5FQ3EQDxJCudAWqAgqhSqhWqgR+hY6BV2ArkID0D1oFJqCfoXewwhM
gqmwMqwNG8MM2An2hoPhNXAcnAbnwPnwTrgCroOPwe3wBfg6fAcegZ/DswhAiAgNUUMMEQbigvghEUgs
wkc2IIVIOVKHtCBdSC9yCxlBppF3KAyKgqKjDFG2KE9UCIqFSkNtQBWjKlFHUe2oHtQt1ChqBvUJTUYr
oQ3QNmgv9Cp0HDoTXYAuRzeg29CX0HfQ4+g3GAyGhtHBWGE8MeGYBMw6TDHmAKYVcx4zgBnDzGKxWHms
AdYO64dlYgXYAux+7DHsOewgdhz7FkfEqeLMcO64CBwPl4crxzXhzuIGcRO4ebwUXgtvg/fDs/HZ+BJ8
Pb4LfwM/jp8nSBN0CHaEYEICYTOhgtBCuER4SHhFJBLVidbEACKXuIlYQTxOvEIcJb4jyZD0SS6kSJKQ
tJN0hHSedI/0ikwma5MdyRFkAXknuZF8kfyY/FaCImEk4SXBltgoUSXRLjEo8UISL6kl6SS5VjJHslzy
pOQNyWkpvJS2lIsUU2qDVJXUKalhqVlpirSptJ90snSxdJP0VelJGayMtoybDFsmX+awzEWZMQpC0aC4
UFiULZR6yiXKOBVD1aF6UROoRdRvqP3UGVkZ2WWyobJZslWyZ2RHaAhNm+ZFS6KV0E7QhmjvlygvcVrC
WbJjScuSwSVzcopyjnIcuUK5Vrk7cu/l6fJu8onyu+U75B8poBT0FQIUMhUOKlxSmFakKtoqshQLFU8o
3leClfSVApXWKR1W6lOaVVZR9lBOVd6vfFF5WoWm4qiSoFKmclZlSpWiaq/KVS1TPaf6jC5Ld6In0Svo
PfQZNSU1TzWhWq1av9q8uo56iHqeeqv6Iw2CBkMjVqNMo1tjRlNV01czV7NZ874WXouhFa+1T6tXa05b
RztMe5t2h/akjpyOl06OTrPOQ12yroNumm6d7m09jB5DL1HvgN5NfVjfQj9ev0r/hgFsYGnANThgMLAU
vdR6KW9p3dJhQ5Khk2GGYbPhqBHNyMcoz6jD6IWxpnGE8W7jXuNPJhYmSSb1Jg9MZUxXmOaZdpn+aqZv
xjKrMrttTjZ3N99o3mn+cpnBMs6yg8vuWlAsfC22WXRbfLS0suRbtlhOWWlaRVtVWw0zqAx/RjHjijXa
2tl6o/Vp63c2ljYCmxM2v9ga2ibaNtlOLtdZzllev3zMTt2OaVdrN2JPt4+2P2Q/4qDmwHSoc3jiqOHI
dmxwnHDSc0pwOub0wtnEme/c5jznYuOy3uW8K+Lq4Vro2u8m4xbiVun22F3dPc692X3Gw8Jjncd5T7Sn
t+duz2EvZS+WV6PXzAqrFetX9HiTvIO8K72f+Oj78H26fGHfFb57fB+u1FrJW9nhB/y8/Pb4PfLX8U/z
/z4AE+AfUBXwNNA0MDewN4gSFBXUFPQm2Dm4JPhBiG6IMKQ7VDI0MrQxdC7MNaw0bGSV8ar1q66HK4Rz
wzsjsBGhEQ0Rs6vdVu9dPR5pEVkQObRGZ03WmqtrFdYmrT0TJRnFjDoZjY4Oi26K/sD0Y9YxZ2O8Yqpj
ZlgurH2s52xHdhl7imPHKeVMxNrFlsZOxtnF7YmbineIL4+f5rpwK7kvEzwTahLmEv0SjyQuJIUltSbj
kqOTT/FkeIm8nhSVlKyUgVSD1ILUkTSbtL1pM3xvfkM6lL4mvVNAFf1M9Ql1hVuFoxn2GVUZbzNDM09m
SWfxsvqy9bN3ZE/kuOd8vQ61jrWuO1ctd3Pu6Hqn9bUboA0xG7o3amzM3zi+yWPT0c2EzYmbf8gzySvN
e70lbEtXvnL+pvyxrR5bmwskCvgFw9tst9VsR23nbu/fYb5j/45PhezCa0UmReVFH4pZxde+Mv2q4quF
nbE7+0ssSw7uwuzi7Rra7bD7aKl0aU7p2B7fPe1l9LLCstd7o/ZeLV9WXrOPsE+4b6TCp6Jzv+b+Xfs/
VMZX3qlyrmqtVqreUT13gH1g8KDjwZYa5ZqimveHuIfu1nrUttdp15UfxhzOOPy0PrS+92vG140NCg1F
DR+P8I6MHA082tNo1djYpNRU0gw3C5unjkUeu/mN6zedLYYtta201qLj4Ljw+LNvo78dOuF9ovsk42TL
d1rfVbdR2grbofbs9pmO+I6RzvDOgVMrTnV32Xa1fW/0/ZHTaqerzsieKTlLOJt/duFczrnZ86nnpy/E
XRjrjup+cHHVxds9AT39l7wvXbnsfvlir1PvuSt2V05ftbl66hrjWsd1y+vtfRZ9bT9Y/NDWb9nffsPq
RudN65tdA8sHzg46DF645Xrr8m2v29fvrLwzMBQydHc4cnjkLvvu5L2key/vZ9yff7DpIfph4SOpR+WP
lR7X/aj3Y+uI5ciZUdfRvidBTx6Mscae/5T+04fx/Kfkp+UTqhONk2aTp6fcp24+W/1s/Hnq8/npgp+l
f65+ofviu18cf+mbWTUz/pL/cuHX4lfyr468Xva6e9Z/9vGb5Dfzc4Vv5d8efcd41/s+7P3EfOYH7IeK
j3ofuz55f3q4kLyw8Bv3hPP74uYdwgAAAAlwSFlzAAALEwAACxMBAJqcGAAAAahJREFUOE9j+P//P8l4
vaOjPYyNIYkPO1lZsa1wdNy42sHh3Hxb22KQGFaF2LC4qjjroUP7n97s6vx/Ny/3/ypn54+LbGwisSpG
x+aaouwZren/u5f2/3/18tX/qzNn/l/i4XGSgYFBFasGZKwjzcJ6YVnU152blvw3LHH53zCl/ufatWu+
T+1vDALJY9UEwxrijExHZgd+/Xy1Hcg98BNkCMglMM0gjKEJhuX5GVh2TvD+/O5c0///P9b///qo819P
lgmKZhBG0QTDMjwMzJs7XT+9OVHz///XFf+/PWj7j00zCKNwQFiah4FtXbPjp8d78////7bo/4/79Tg1
gzAKR1mUg3lOocXbe9uz/v9/M/H/1zuVeDWDMJwhJcDBvK4p4tb1DQn//r/u+f/zRh5BzSAMZyyrdVh9
c33B9//32159vZr2hxjNIAwm1GUE3e+ur/n9/+Ls/592Nf9fUun3khjNIMzAysTAv6g6+OT/E33/j09N
+zWpMuImsZpBmMHIQK9x19T8/03x1ufE+TkqsCnChxmUlFWuyEpJtAHTtT42BfjxfwYAtlm0ShMkSB4A
AAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAAIGNIUk0AAHolAACAgwAA+f8AAIDpAAB1
MAAA6mAAADqYAAAXb5JfxUYAAAAJcEhZcwAADsQAAA7EAZUrDhsAAAFQSURBVFhH7ZfNDcIwFIMZoXcm
YBtGYRHECIgTR1ZhBsS9YoJgQ1Poi5sfqhIOWPqkqvV7dWlI0oVzriry5Dd5HSS0PFwasAEn0AJn4Dle
o6fpykaVHYDNwB7YG6ZgzWiQrABosAbqaXNh7bprN1AyAAp3b42msuva9ooGYIFpELA931D2FI+VxzAI
gTIdAEb+7KpBz+p4RclQyifoXwdKwgAwcMAl3/mEAOz9GJgokQGyR/sHr8CzlwFwgU+vCuagUQE4gSjz
HGxUAM5iyiyxUp4IJ5QEAYomHCvlidCiJAigjKNYKU8M6B/g9wJUH4TV/4ZFE5GV8kSQE1HRVGylPBHC
qbh0MbJSnhH0YtQFyFqOiZXyCOLLMQVDckNCrJRHEN+QeMGY3JJZKY8hb0vmxQLTYAplm1IvFNbblnuh
Qb0Pk3exGZjv06wW8uT3cIs7jQnSONrSxH0AAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="TP_NOTIFY.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> <metadata name="TP_NOTIFY.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </metadata>
@@ -216,36 +137,37 @@
This means that if any user data has been downloaded with the plan, a simple notification will be shown with the number of users downloaded. This means that if any user data has been downloaded with the plan, a simple notification will be shown with the number of users downloaded.
The 'Image' and 'User icon' parameters will be ignored.</value> The 'Image' and 'User icon' parameters will be ignored.</value>
</data> </data>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <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> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6 iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsPAAALDwGS+QOlAAACM0lE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb QVQ4T2P4//8/AyHMzicsqh6c34guDsIYAshYQFadhZmZhU1c18Yp8NCP/7LWvjHoajA0gbCwpqW7YeGs
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb FXYTD15xnHnihuuiiw98D//6777kynNuAREpnAYwMjIyqQQX9zkvffDfZce3//b7//23PPD/v/HWr//1
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv Vr74b7jm3X/VpI7FTIyMjFgNUAku6nRd//6/0ZTT31QbNlxXbthwQa3/6CO1ZS/+K8y+91968u3/qr1X
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN /gsq6jliGCCoYmRp23/4u4R9eCczF782AwMDFwMDA7OYhV+C2ooP/5UnXf+vkDXnioi+cz4LG6cIhgGK
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA zlE1/PLakcguArsquXuOSvmqayLatmnMjAx86PJwBhMzM4YkCPNKKpkxMTAIootjGIANswtKSKKLoWMM
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ ARAW0LS20S2at1POM20quhyvspGFqLlfJoYBTCzsnEI6Dl6a6ZO32c66+t91/dv/Akq6wTB5IQVdfgnP
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY jGSlpr1vuKTVPDAM4FczD7Ceeum/w6J7/y2XP/2vt/rNf9mGTUekC+eulKtYuUW+5+Qj2TlP/4u4psxD
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74 dhGSC9h4dUoWntZf9e6/0qr3/5V3/Puvuu//f6Xt///Lrvr8X3ryzf8SfsWbmNBiAsV/bJIqpkpLX/xU
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG 2/n3v+qcmx9VZl77oth97L1U2pQTgtq2WUwMDGzI6jEMAGFR/7wGzS3f//PIagawcvIqsLJzKTAyMLCi
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg== q8NpABMLK4dCfOsSZlYOUXQ5bBgArRReBMoH61gAAAAASUVORK5CYII=
</value> </value>
</data> </data>
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6 iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsPAAALDwGS+QOlAAACM0lE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb QVQ4T2P4//8/AyHMzicsqh6c34guDsIYAshYQFadhZmZhU1c18Yp8NCP/7LWvjHoajA0gbCwpqW7YeGs
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb FXYTD15xnHnihuuiiw98D//6777kynNuAREpnAYwMjIyqQQX9zkvffDfZce3//b7//23PPD/v/HWr//1
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv Vr74b7jm3X/VpI7FTIyMjFgNUAku6nRd//6/0ZTT31QbNlxXbthwQa3/6CO1ZS/+K8y+91968u3/qr1X
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN /gsq6jliGCCoYmRp23/4u4R9eCczF782AwMDFwMDA7OYhV+C2ooP/5UnXf+vkDXnioi+cz4LG6cIhgGK
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA zlE1/PLakcguArsquXuOSvmqayLatmnMjAx86PJwBhMzM4YkCPNKKpkxMTAIootjGIANswtKSKKLoWMM
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ ARAW0LS20S2at1POM20quhyvspGFqLlfJoYBTCzsnEI6Dl6a6ZO32c66+t91/dv/Akq6wTB5IQVdfgnP
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY jGSlpr1vuKTVPDAM4FczD7Ceeum/w6J7/y2XP/2vt/rNf9mGTUekC+eulKtYuUW+5+Qj2TlP/4u4psxD
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74 dhGSC9h4dUoWntZf9e6/0qr3/5V3/Puvuu//f6Xt///Lrvr8X3ryzf8SfsWbmNBiAsV/bJIqpkpLX/xU
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG 2/n3v+qcmx9VZl77oth97L1U2pQTgtq2WUwMDGzI6jEMAGFR/7wGzS3f//PIagawcvIqsLJzKTAyMLCi
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg== q8NpABMLK4dCfOsSZlYOUXQ5bBgArRReBMoH61gAAAAASUVORK5CYII=
</value> </value>
</data> </data>
</root> </root>

View File

@@ -9,17 +9,14 @@
Imports SCrawler.DownloadObjects.Groups Imports SCrawler.DownloadObjects.Groups
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls.Base Imports PersonalUtilities.Forms.Controls.Base
Imports DModes = SCrawler.DownloadObjects.AutoDownloader.Modes
Namespace DownloadObjects Namespace DownloadObjects
Friend Class AutoDownloaderEditorForm Friend Class AutoDownloaderEditorForm
Private WithEvents MyDefs As DefaultFormOptions Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly MyGroups As List(Of String)
Private ReadOnly Property Plan As AutoDownloader Private ReadOnly Property Plan As AutoDownloader
Friend Sub New(ByRef _Plan As AutoDownloader) Friend Sub New(ByRef _Plan As AutoDownloader)
InitializeComponent() InitializeComponent()
Plan = _Plan Plan = _Plan
MyDefs = New DefaultFormOptions(Me, Settings.Design) MyDefs = New DefaultFormOptions(Me, Settings.Design)
MyGroups.ListAddList(Plan.Groups, LAP.NotContainsOnly)
End Sub End Sub
Private Class AutomationTimerChecker : Inherits FieldsCheckerProviderBase Private Class AutomationTimerChecker : Inherits FieldsCheckerProviderBase
Public Overrides Property ErrorMessage As String Public Overrides Property ErrorMessage As String
@@ -45,19 +42,12 @@ Namespace DownloadObjects
.MyViewInitialize(True) .MyViewInitialize(True)
.AddOkCancelToolbar() .AddOkCancelToolbar()
With Plan With Plan
Select Case .Mode If Enabled Then OPT_ENABLED.Checked = True Else OPT_DISABLED.Checked = True
Case DModes.None : OPT_DISABLED.Checked = True
Case DModes.Specified : OPT_SPEC.Checked = True
Case DModes.Groups : OPT_GROUP.Checked = True
End Select
TXT_GROUPS.CaptionWidth = GroupDefaults.CaptionWidthDefault
TXT_TIMER.CaptionWidth = GroupDefaults.CaptionWidthDefault TXT_TIMER.CaptionWidth = GroupDefaults.CaptionWidthDefault
NUM_DELAY.CaptionWidth = GroupDefaults.CaptionWidthDefault NUM_DELAY.CaptionWidth = GroupDefaults.CaptionWidthDefault
DEF_GROUP.Set(Plan) DEF_GROUP.Set(Plan)
If MyGroups.Count > 0 Then TXT_GROUPS.Text = MyGroups.ListToString
If Settings.Groups.Count = 0 Then TXT_GROUPS.Clear() : TXT_GROUPS.Enabled = False
CH_NOTIFY.Checked = .ShowNotifications CH_NOTIFY.Checked = .ShowNotifications
CH_NOTIFY_SIMPLE.Checked = .ShowSimpleNotification CH_NOTIFY_SIMPLE.Checked = .ShowSimpleNotification
CH_SHOW_PIC.Checked = .ShowPictureDownloaded CH_SHOW_PIC.Checked = .ShowPictureDownloaded
@@ -79,27 +69,14 @@ Namespace DownloadObjects
If DEF_GROUP.TXT_NAME.IsEmptyString And Settings.Automation.Count = 0 Then DEF_GROUP.TXT_NAME.Text = "Default" If DEF_GROUP.TXT_NAME.IsEmptyString And Settings.Automation.Count = 0 Then DEF_GROUP.TXT_NAME.Text = "Default"
End With End With
End Sub End Sub
Private Sub AutoDownloaderEditorForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
MyGroups.Clear()
End Sub
Private Sub AutoDownloaderEditorForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown Private Sub AutoDownloaderEditorForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
Try Try
If e = ShowUsersButtonKey AndAlso Not OPT_DISABLED.Checked Then If e = ShowUsersButtonKey AndAlso Not OPT_DISABLED.Checked Then
Dim users As New List(Of API.Base.IUserData) Dim users As New List(Of API.Base.IUserData)
If OPT_GROUP.Checked Then
If MyGroups.Count > 0 Then
Dim i%
For Each groupName$ In MyGroups
i = Settings.Groups.IndexOf(groupName)
If i >= 0 Then users.ListAddList(DownloadGroup.GetUsers(Settings.Groups(i)), LAP.NotContainsOnly, LAP.IgnoreICopier)
Next
End If
Else
Using g As New GroupParameters Using g As New GroupParameters
DEF_GROUP.Get(g) DEF_GROUP.Get(g)
users.ListAddList(DownloadGroup.GetUsers(g)) users.ListAddList(DownloadGroup.GetUsers(g), LAP.IgnoreICopier)
End Using End Using
End If
GroupUsersViewer.Show(users, $"S {DEF_GROUP.TXT_NAME.Text}") GroupUsersViewer.Show(users, $"S {DEF_GROUP.TXT_NAME.Text}")
users.Clear() users.Clear()
End If End If
@@ -110,14 +87,8 @@ Namespace DownloadObjects
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
If MyDefs.MyFieldsChecker.AllParamsOK Then If MyDefs.MyFieldsChecker.AllParamsOK Then
With Plan With Plan
Select Case True .Enabled = OPT_ENABLED.Checked
Case OPT_DISABLED.Checked : .Mode = DModes.None
Case OPT_SPEC.Checked : .Mode = DModes.Specified
Case OPT_GROUP.Checked : .Mode = DModes.Groups
End Select
DEF_GROUP.Get(Plan) DEF_GROUP.Get(Plan)
.Groups.Clear()
.Groups.ListAddList(MyGroups)
.ShowNotifications = CH_NOTIFY.Checked .ShowNotifications = CH_NOTIFY.Checked
.ShowSimpleNotification = CH_NOTIFY_SIMPLE.Checked .ShowSimpleNotification = CH_NOTIFY_SIMPLE.Checked
.ShowPictureDownloaded = CH_SHOW_PIC.Checked .ShowPictureDownloaded = CH_SHOW_PIC.Checked
@@ -131,42 +102,20 @@ Namespace DownloadObjects
MyDefs.CloseForm() MyDefs.CloseForm()
End If End If
End Sub End Sub
Private Sub TXT_GROUPS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_GROUPS.ActionOnButtonClick
Select Case Sender.DefaultButton
Case ActionButton.DefaultButtons.Edit
Using f As New LabelsForm(MyGroups, (From g As DownloadGroup In Settings.Groups Where Not g.IsViewFilter Select g.Name)) With {
.Text = "Groups (F3 to edit)",
.Icon = My.Resources.GroupByIcon_16,
.IsGroups = True
}
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then MyGroups.ListAddList(f.LabelsList, LAP.ClearBeforeAdd) : TXT_GROUPS.Text = MyGroups.ListToString
End Using
Case ActionButton.DefaultButtons.Clear : MyGroups.Clear()
Case ActionButton.DefaultButtons.Info
Try
If MyGroups.Count > 0 Then
Dim i% = Settings.Groups.IndexOf(MyGroups(0))
If i >= 0 Then
Using gf As New GroupEditorForm(Settings.Groups(i)) : gf.ShowDialog() : End Using
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Show group")
End Try
End Select
End Sub
Private Sub ChangeEnabled() Handles OPT_DISABLED.CheckedChanged, Private Sub ChangeEnabled() Handles OPT_DISABLED.CheckedChanged,
OPT_SPEC.CheckedChanged, OPT_GROUP.CheckedChanged, OPT_ENABLED.CheckedChanged,
CH_NOTIFY.CheckedChanged, CH_NOTIFY_SIMPLE.CheckedChanged CH_NOTIFY.CheckedChanged, CH_NOTIFY_SIMPLE.CheckedChanged
DEF_GROUP.Enabled = OPT_SPEC.Checked Dim __enabled As Boolean = Not OPT_DISABLED.Checked
TXT_GROUPS.Enabled = OPT_GROUP.Checked DEF_GROUP.Enabled = __enabled
TXT_TIMER.Enabled = Not OPT_DISABLED.Checked TXT_TIMER.Enabled = __enabled
NUM_DELAY.Enabled = Not OPT_DISABLED.Checked NUM_DELAY.Enabled = __enabled
CH_NOTIFY.Enabled = Not OPT_DISABLED.Checked CH_NOTIFY.Enabled = __enabled
CH_NOTIFY_SIMPLE.Enabled = CH_NOTIFY.Enabled And CH_NOTIFY.Checked CH_NOTIFY_SIMPLE.Enabled = CH_NOTIFY.Enabled And CH_NOTIFY.Checked
CH_SHOW_PIC.Enabled = CH_NOTIFY.Checked And Not OPT_DISABLED.Checked And Not CH_NOTIFY_SIMPLE.Checked CH_SHOW_PIC.Enabled = CH_NOTIFY.Checked And Not OPT_DISABLED.Checked And Not CH_NOTIFY_SIMPLE.Checked
CH_SHOW_PIC_USER.Enabled = CH_NOTIFY.Checked And Not OPT_DISABLED.Checked And Not CH_NOTIFY_SIMPLE.Checked CH_SHOW_PIC_USER.Enabled = CH_NOTIFY.Checked And Not OPT_DISABLED.Checked And Not CH_NOTIFY_SIMPLE.Checked
If Settings.Labels.Count = 0 Then DEF_GROUP.LabelsEnabled = False
If Settings.Groups.Count = 0 Then DEF_GROUP.GroupsEnabled = False
End Sub End Sub
Private Sub NUM_DELAY_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles NUM_DELAY.ActionOnButtonClick Private Sub NUM_DELAY_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles NUM_DELAY.ActionOnButtonClick
If Sender.DefaultButton = ActionButton.DefaultButtons.Clear Then NUM_DELAY.Value = 0 If Sender.DefaultButton = ActionButton.DefaultButtons.Clear Then NUM_DELAY.Value = 0

View File

@@ -144,7 +144,7 @@ Namespace DownloadObjects
If UpdateBase Then UpdateBaseButton(Not p = PauseModes.Disabled) If UpdateBase Then UpdateBaseButton(Not p = PauseModes.Disabled)
If Not VerifyAll OrElse Settings.Automation.All(Function(ByVal plan As AutoDownloader) As Boolean If Not VerifyAll OrElse Settings.Automation.All(Function(ByVal plan As AutoDownloader) As Boolean
If plan.Mode = AutoDownloader.Modes.None Then If Not plan.Enabled Then
Return True Return True
Else Else
Return plan.Pause = p Return plan.Pause = p

View File

@@ -507,24 +507,7 @@ Namespace DownloadObjects
Private Sub ShowPlanUsers() Private Sub ShowPlanUsers()
Try Try
If _LatestSelected.ValueBetween(0, Settings.Automation.Count - 1) Then If _LatestSelected.ValueBetween(0, Settings.Automation.Count - 1) Then
With Settings.Automation(_LatestSelected) With Settings.Automation(_LatestSelected) : Groups.GroupUsersViewer.Show(Groups.DownloadGroup.GetUsers(.Self), $"S { .Name}") : End With
Dim users As New List(Of API.Base.IUserData)
If Not .Mode = AutoDownloader.Modes.None Then
If .Mode = AutoDownloader.Modes.Groups Then
If .Groups.Count > 0 Then
Dim i%
For Each groupName$ In .Groups
i = Settings.Groups.IndexOf(groupName)
If i >= 0 Then users.ListAddList(Groups.DownloadGroup.GetUsers(Settings.Groups(i)), LAP.NotContainsOnly, LAP.IgnoreICopier)
Next
End If
Else
users.ListAddList(Groups.DownloadGroup.GetUsers(.Self))
End If
End If
Groups.GroupUsersViewer.Show(users, $"S { .Name}")
users.Clear()
End With
End If End If
Catch ex As Exception Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Show plan users") ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Show plan users")

View File

@@ -16,6 +16,7 @@ Namespace DownloadObjects
Friend Event DownloadDone As NotificationEventHandler Friend Event DownloadDone As NotificationEventHandler
Friend Event ProgressChanged(ByVal Main As Boolean, ByVal IsMaxValue As Boolean, ByVal IsDone As Boolean) Friend Event ProgressChanged(ByVal Main As Boolean, ByVal IsMaxValue As Boolean, ByVal IsDone As Boolean)
Friend Event FeedFilesChanged As TDownloader.FeedFilesChangedEventHandler Friend Event FeedFilesChanged As TDownloader.FeedFilesChangedEventHandler
Friend Event KeyDown As KeyEventHandler
#End Region #End Region
#Region "Declarations" #Region "Declarations"
#Region "Controls" #Region "Controls"
@@ -126,6 +127,10 @@ Namespace DownloadObjects
TP_MAIN.Controls.Add(LBL_INFO, 0, 1) TP_MAIN.Controls.Add(LBL_INFO, 0, 1)
End If End If
For Each btt As Button In {BTT_OPEN, BTT_START, BTT_STOP}
If Not btt Is Nothing Then AddHandler btt.KeyDown, AddressOf BTT_KeyDown
Next
With Job With Job
.Progress = New MyProgressExt(PR_MAIN, PR_PRE, LBL_INFO) With {.ResetProgressOnMaximumChanges = False} .Progress = New MyProgressExt(PR_MAIN, PR_PRE, LBL_INFO) With {.ResetProgressOnMaximumChanges = False}
With DirectCast(.Progress, MyProgressExt) With DirectCast(.Progress, MyProgressExt)
@@ -149,6 +154,9 @@ Namespace DownloadObjects
.Dock = DockStyle.Fill .Dock = DockStyle.Fill
} }
End Sub End Sub
Private Sub BTT_KeyDown(ByVal Sender As Object, ByVal e As KeyEventArgs)
RaiseEvent KeyDown(Sender, e)
End Sub
#End Region #End Region
Friend Function [Get]() As TableLayoutPanel Friend Function [Get]() As TableLayoutPanel
Return TP_MAIN Return TP_MAIN

View File

@@ -43,6 +43,7 @@ Friend Class DownloadSavedPostsForm
For Each j As DownloadProgress In JobsList For Each j As DownloadProgress In JobsList
AddHandler j.DownloadDone, AddressOf Jobs_DownloadDone AddHandler j.DownloadDone, AddressOf Jobs_DownloadDone
AddHandler j.FeedFilesChanged, AddressOf Jobs_FeedFilesChanged AddHandler j.FeedFilesChanged, AddressOf Jobs_FeedFilesChanged
AddHandler j.KeyDown, AddressOf DownloadSavedPostsForm_KeyDown
TP_MAIN.RowStyles.Add(New RowStyle(SizeType.Absolute, 60)) TP_MAIN.RowStyles.Add(New RowStyle(SizeType.Absolute, 60))
TP_MAIN.RowCount += 1 TP_MAIN.RowCount += 1
TP_MAIN.Controls.Add(j.Get, 0, TP_MAIN.RowStyles.Count - 1) TP_MAIN.Controls.Add(j.Get, 0, TP_MAIN.RowStyles.Count - 1)
@@ -54,6 +55,9 @@ Friend Class DownloadSavedPostsForm
MaximumSize = s MaximumSize = s
End If End If
End Sub End Sub
Private Sub DownloadSavedPostsForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown, BTT_DOWN_ALL.KeyDown, BTT_STOP_ALL.KeyDown
If e.KeyCode = Keys.Escape Then Close()
End Sub
Private Sub DownloadSavedPostsForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing Private Sub DownloadSavedPostsForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
e.Cancel = True e.Cancel = True
Hide() Hide()

View File

@@ -26,7 +26,19 @@ Namespace DownloadObjects
Friend WithEvents MyDefs As DefaultFormOptions Friend WithEvents MyDefs As DefaultFormOptions
Private WithEvents MyRange As RangeSwitcherToolbar(Of UserMediaD) Private WithEvents MyRange As RangeSwitcherToolbar(Of UserMediaD)
Private ReadOnly DataList As List(Of UserMediaD) Private ReadOnly DataList As List(Of UserMediaD)
#Region "Buttons"
Private WithEvents BTT_DELETE_SELECTED As ToolStripButton Private WithEvents BTT_DELETE_SELECTED As ToolStripButton
Private WithEvents BTT_COPY_SELECTED_T As ToolStripButton
Private WithEvents BTT_MOVE_SELECTED_T As ToolStripButton
Private WithEvents BTT_FAV_T As ToolStripButton
Private WithEvents BTT_FEED_ADD_T As ToolStripDropDownButton
Private WithEvents BTT_SELECT_ALL_T As ToolStripButton
Private WithEvents BTT_SELECT_NONE_T As ToolStripButton
Private WithEvents BTT_INVERT_T As ToolStripButton
Private WithEvents BTT_LOAD_CURRENT_T As ToolStripButton
Private WithEvents BTT_LOAD_FAV_T As ToolStripButton
Private WithEvents BTT_LOAD_T As ToolStripDropDownButton
#End Region
Private DataRows As Integer = 10 Private DataRows As Integer = 10
Private DataColumns As Integer = 1 Private DataColumns As Integer = 1
Private FeedEndless As Boolean = False Private FeedEndless As Boolean = False
@@ -65,8 +77,10 @@ Namespace DownloadObjects
If Not CurrentFilter Is Nothing Then If Not CurrentFilter Is Nothing Then
With CurrentFilter With CurrentFilter
If .Types.Count > 0 AndAlso Not .Types.Any(Function(t) FilterTypesConversion(t, d)) Then Return False If .Types.Count > 0 AndAlso Not .Types.Any(Function(t) FilterTypesConversion(t, d)) Then Return False
#Disable Warning BC42109 #Disable Warning BC42109, BC42104
If .Sites.Count > 0 AndAlso Not .Sites.Contains(d.UserInfo.Site) Then Return False
If .Users.Count > 0 AndAlso Not .Users.Contains(d.UserInfo) Then Return False If .Users.Count > 0 AndAlso Not .Users.Contains(d.UserInfo) Then Return False
If .Labels.Count > 0 AndAlso d.User.Labels.Count > 0 AndAlso Not d.User.Labels.ListContains(.Labels) Then Return False
#Enable Warning #Enable Warning
End With End With
End If End If
@@ -99,15 +113,15 @@ Namespace DownloadObjects
End Sub End Sub
Private Sub FeedRemoveCheckedMedia(ByVal MediaList As IEnumerable(Of UserMediaD), Optional ByVal OverriddenNames As List(Of String) = Nothing, Private Sub FeedRemoveCheckedMedia(ByVal MediaList As IEnumerable(Of UserMediaD), Optional ByVal OverriddenNames As List(Of String) = Nothing,
Optional ByVal RemoveChecked As Boolean = True, Optional ByVal ExcludingNames As IEnumerable(Of String) = Nothing, Optional ByVal RemoveChecked As Boolean = True, Optional ByVal ExcludingNames As IEnumerable(Of String) = Nothing,
Optional ByVal RemoveFromDataListOnly As Boolean = False) Optional ByVal IsAddAndRemove As Boolean = False)
Try Try
If FeedMode = FeedModes.Special Then If FeedMode = FeedModes.Saved Then Exit Sub
If LoadedFeedNames.Count > 0 Then
Dim dataRemoved As Boolean = False Dim dataRemoved As Boolean = False
If OverriddenNames.ListExists And Not LoadedFeedNames.ListContains(OverriddenNames) Then Exit Sub If FeedMode = FeedModes.Special And OverriddenNames.ListExists And Not LoadedFeedNames.ListContains(OverriddenNames) Then Exit Sub
If Not RemoveFromDataListOnly Then
Dim eNames As IEnumerable(Of String) = If(ExcludingNames, New String() {}) Dim eNames As IEnumerable(Of String) = If(ExcludingNames, New String() {})
With If(OverriddenNames, LoadedFeedNames) With If(OverriddenNames, LoadedFeedNames)
If FeedMode = FeedModes.Special And .ListExists Then
.ForEach(Sub(ByVal feedName As String) .ForEach(Sub(ByVal feedName As String)
If Not eNames.Contains(feedName) Then If Not eNames.Contains(feedName) Then
Dim indx% = Settings.Feeds.IndexOf(feedName) Dim indx% = Settings.Feeds.IndexOf(feedName)
@@ -116,25 +130,33 @@ Namespace DownloadObjects
End If End If
End If End If
End Sub) End Sub)
End With ElseIf FeedMode = FeedModes.Current And Not OverriddenNames.ListExists And IsAddAndRemove Then
dataRemoved = Downloader.Files.ListDisposeRemove(MediaList) > 0
'Downloader.FilesSave()
Else
Exit Sub
End If End If
If RemoveFromDataListOnly Then End With
RefillSpecialFeedsData()
ElseIf dataRemoved Then If dataRemoved Then DataList.ListDisposeRemove(MediaList)
DataList.ListDisposeRemove(MediaList)
If RemoveChecked Then Select Case FeedMode
Case FeedModes.Special
If RemoveChecked And IsAddAndRemove Then
If RemoveCheckedMedia(False) Then RefillAfterDelete() If RemoveCheckedMedia(False) Then RefillAfterDelete()
Else Else
RefillSpecialFeedsData() RefillSpecialFeedsData()
End If End If
End If Case FeedModes.Current
End If If dataRemoved Then
ElseIf FeedMode = FeedModes.Current Then If RemoveChecked Then
If OverriddenNames Is Nothing AndAlso Downloader.Files.ListDisposeRemove(MediaList) > 0 AndAlso RemoveCheckedMedia(False) Then RemoveCheckedMedia(False)
DataList.ListDisposeRemove(MediaList)
RefillAfterDelete() RefillAfterDelete()
Else
RefillList()
End If End If
End If End If
End Select
Catch ex As Exception Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadFeedForm.FeedRemoveCheckedMedia]") ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadFeedForm.FeedRemoveCheckedMedia]")
End Try End Try
@@ -149,13 +171,84 @@ Namespace DownloadObjects
MyRange = New RangeSwitcherToolbar(Of UserMediaD)(ToolbarTOP) MyRange = New RangeSwitcherToolbar(Of UserMediaD)(ToolbarTOP)
DataList = New List(Of UserMediaD) DataList = New List(Of UserMediaD)
LoadedFeedNames = New List(Of String) LoadedFeedNames = New List(Of String)
BTT_DELETE_SELECTED = New ToolStripButton With { BTT_DELETE_SELECTED = New ToolStripButton With {
.Text = "Delete selected", .Text = "Delete",
.AutoToolTip = True, .AutoToolTip = True,
.ToolTipText = "Delete marked files", .ToolTipText = "Delete selected files",
.Image = My.Resources.DeletePic_24, .Image = My.Resources.DeletePic_24,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText .DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
} }
BTT_COPY_SELECTED_T = New ToolStripButton With {
.Text = "Copy",
.AutoToolTip = True,
.ToolTipText = "Copy selected files",
.Image = My.Resources.PastePic_32,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_MOVE_SELECTED_T = New ToolStripButton With {
.Text = "Move",
.AutoToolTip = True,
.ToolTipText = "Move selected files",
.Image = My.Resources.CutPic_48,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_FAV_T = New ToolStripButton With {
.Text = "Favorite",
.AutoToolTip = True,
.ToolTipText = "Add checked to Favorite",
.Image = My.Resources.HeartPic_32,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_FEED_ADD_T = New ToolStripDropDownButton With {
.Text = "Add",
.AutoToolTip = True,
.ToolTipText = "Add checked to special feed..." & vbCr & "Right click to add to multiple feeds",
.Image = My.Resources.RSSPic_512,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_LOAD_CURRENT_T = New ToolStripButton With {
.Text = "Current",
.AutoToolTip = True,
.ToolTipText = "Load current feed",
.Image = My.Resources.ArrowDownPic_Blue_24,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_LOAD_FAV_T = New ToolStripButton With {
.Text = "Favorite",
.AutoToolTip = True,
.ToolTipText = "Load Favorite",
.Image = My.Resources.HeartPic_32,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_LOAD_T = New ToolStripDropDownButton With {
.Text = "Load",
.AutoToolTip = True,
.ToolTipText = "Load special feed..." & vbCr & "Right click to load multiple feeds",
.Image = My.Resources.RSSPic_512,
.DisplayStyle = ToolStripItemDisplayStyle.ImageAndText
}
BTT_SELECT_ALL_T = New ToolStripButton With {
.Text = "All",
.AutoToolTip = True,
.ToolTipText = "Select all",
.DisplayStyle = ToolStripItemDisplayStyle.Text
}
BTT_SELECT_NONE_T = New ToolStripButton With {
.Text = "None",
.AutoToolTip = True,
.ToolTipText = "Select none",
.DisplayStyle = ToolStripItemDisplayStyle.Text
}
BTT_INVERT_T = New ToolStripButton With {
.Text = "Invert",
.AutoToolTip = True,
.ToolTipText = "Invert selection",
.DisplayStyle = ToolStripItemDisplayStyle.Text
}
FILTERS = New FeedFilterCollection FILTERS = New FeedFilterCollection
BTT_FILTER.Image = My.Resources.FilterPic BTT_FILTER.Image = My.Resources.FilterPic
BTT_FILTER_SIMPLE.Image = My.Resources.FilterPic BTT_FILTER_SIMPLE.Image = My.Resources.FilterPic
@@ -181,17 +274,29 @@ Namespace DownloadObjects
.ToolTip(RCI.GoTo) = "GoTo (Ctrl+G)" .ToolTip(RCI.GoTo) = "GoTo (Ctrl+G)"
.AddThisToolbar() .AddThisToolbar()
End With End With
ToolbarTOP.Items.AddRange({New ToolStripSeparator, BTT_DELETE_SELECTED}) ToolbarTOP.Items.AddRange({New ToolStripSeparator, BTT_DELETE_SELECTED,
New ToolStripSeparator, BTT_COPY_SELECTED_T, BTT_MOVE_SELECTED_T,
New ToolStripSeparator, BTT_FAV_T, BTT_FEED_ADD_T,
New ToolStripSeparator, BTT_LOAD_CURRENT_T, BTT_LOAD_FAV_T, BTT_LOAD_T,
New ToolStripSeparator, BTT_SELECT_ALL_T, BTT_SELECT_NONE_T, BTT_INVERT_T})
With Settings With Settings
With .Feeds With .Feeds
.Load() .Load()
AddHandler .FeedAdded, AddressOf Feed_FeedAdded AddHandler .FeedAdded, AddressOf Feed_FeedAdded
AddHandler .FeedRemoved, AddressOf Feed_FeedRemoved AddHandler .FeedRemoved, AddressOf Feed_FeedRemoved
If .Count = 0 OrElse (.Count = 1 AndAlso .Item(0).IsFavorite) Then
BTT_FEED_ADD_T.Enabled = False
BTT_FEED_ADD_T.Visible = False
BTT_LOAD_T.Enabled = False
BTT_LOAD_T.Visible = False
End If
If .Count > 0 Then If .Count > 0 Then
For Each feed As FeedSpecial In .Self For Each feed As FeedSpecial In .Self
If Not feed.IsFavorite Then If Not feed.IsFavorite Then
AddNewFeedItem(BTT_LOAD_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD) AddNewFeedItem(BTT_LOAD_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD)
AddNewFeedItem(BTT_LOAD_T, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD)
AddNewFeedItem(BTT_FEED_ADD_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD) AddNewFeedItem(BTT_FEED_ADD_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD)
AddNewFeedItem(BTT_FEED_ADD_T, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD)
AddNewFeedItem(BTT_FEED_ADD_SPEC_REMOVE, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD_REMOVE) AddNewFeedItem(BTT_FEED_ADD_SPEC_REMOVE, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD_REMOVE)
AddNewFeedItem(BTT_FEED_REMOVE_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_REMOVE) AddNewFeedItem(BTT_FEED_REMOVE_SPEC, feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_REMOVE)
AddNewFeedItem(BTT_FEED_DELETE_SPEC, feed, My.Resources.DeletePic_24, AddressOf Feed_SPEC_DELETE) AddNewFeedItem(BTT_FEED_DELETE_SPEC, feed, My.Resources.DeletePic_24, AddressOf Feed_SPEC_DELETE)
@@ -260,11 +365,11 @@ Namespace DownloadObjects
End Sub End Sub
#End Region #End Region
#Region "Feeds handlers" #Region "Feeds handlers"
Private Overloads Sub AddNewFeedItem(ByVal Destination As ToolStripMenuItem, ByVal Feed As FeedSpecial, ByVal Image As Image, Private Overloads Sub AddNewFeedItem(Of T As ToolStripDropDownItem)(ByVal Destination As T, ByVal Feed As FeedSpecial, ByVal Image As Image,
ByVal Handler As EventHandler, Optional ByVal Insert As Boolean = False) ByVal Handler As EventHandler, Optional ByVal Insert As Boolean = False)
AddNewFeedItem(Destination, ToolbarTOP, Feed, Image, Handler, Insert) AddNewFeedItem(Destination, ToolbarTOP, Feed, Image, Handler, Insert)
End Sub End Sub
Friend Overloads Shared Function AddNewFeedItem(ByVal Destination As ToolStripMenuItem, ByVal Toolbar As ToolStrip, Friend Overloads Shared Function AddNewFeedItem(ByVal Destination As ToolStripDropDownItem, ByVal Toolbar As ToolStrip,
ByVal Feed As FeedSpecial, ByVal Image As Image, ByVal Feed As FeedSpecial, ByVal Image As Image,
ByVal Handler As EventHandler, Optional ByVal Insert As Boolean = False) As ToolStripMenuItem ByVal Handler As EventHandler, Optional ByVal Insert As Boolean = False) As ToolStripMenuItem
Dim item As New ToolStripMenuItem(Feed.Name, Image) With {.Tag = Feed} Dim item As New ToolStripMenuItem(Feed.Name, Image) With {.Tag = Feed}
@@ -280,7 +385,9 @@ Namespace DownloadObjects
End Function End Function
Private Sub Feed_FeedAdded(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial) Private Sub Feed_FeedAdded(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial)
AddNewFeedItem(BTT_LOAD_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD, True) AddNewFeedItem(BTT_LOAD_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD, True)
AddNewFeedItem(BTT_LOAD_T, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_LOAD, True)
AddNewFeedItem(BTT_FEED_ADD_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD, True) AddNewFeedItem(BTT_FEED_ADD_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD, True)
AddNewFeedItem(BTT_FEED_ADD_T, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD, True)
AddNewFeedItem(BTT_FEED_ADD_SPEC_REMOVE, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD_REMOVE, True) AddNewFeedItem(BTT_FEED_ADD_SPEC_REMOVE, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_ADD_REMOVE, True)
AddNewFeedItem(BTT_FEED_REMOVE_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_REMOVE, True) AddNewFeedItem(BTT_FEED_REMOVE_SPEC, Feed, My.Resources.RSSPic_512, AddressOf Feed_SPEC_REMOVE, True)
AddNewFeedItem(BTT_FEED_DELETE_SPEC, Feed, My.Resources.DeletePic_24, AddressOf Feed_SPEC_DELETE, True) AddNewFeedItem(BTT_FEED_DELETE_SPEC, Feed, My.Resources.DeletePic_24, AddressOf Feed_SPEC_DELETE, True)
@@ -288,15 +395,17 @@ Namespace DownloadObjects
End Sub End Sub
Private Overloads Sub Feed_FeedRemoved(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial) Private Overloads Sub Feed_FeedRemoved(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial)
Feed_FeedRemoved(BTT_LOAD_SPEC, Feed) Feed_FeedRemoved(BTT_LOAD_SPEC, Feed)
Feed_FeedRemoved(BTT_LOAD_T, Feed)
Feed_FeedRemoved(BTT_FEED_ADD_SPEC, Feed) Feed_FeedRemoved(BTT_FEED_ADD_SPEC, Feed)
Feed_FeedRemoved(BTT_FEED_ADD_T, Feed)
Feed_FeedRemoved(BTT_FEED_REMOVE_SPEC, Feed) Feed_FeedRemoved(BTT_FEED_REMOVE_SPEC, Feed)
Feed_FeedRemoved(BTT_FEED_DELETE_SPEC, Feed) Feed_FeedRemoved(BTT_FEED_DELETE_SPEC, Feed)
Feed_FeedRemoved(BTT_FEED_CLEAR_SPEC, Feed) Feed_FeedRemoved(BTT_FEED_CLEAR_SPEC, Feed)
End Sub End Sub
Private Overloads Sub Feed_FeedRemoved(ByVal Destination As ToolStripMenuItem, ByVal Feed As FeedSpecial) Private Overloads Sub Feed_FeedRemoved(ByVal Destination As ToolStripDropDownItem, ByVal Feed As FeedSpecial)
Feed_FeedRemoved(Destination, ToolbarTOP, Feed) Feed_FeedRemoved(Destination, ToolbarTOP, Feed)
End Sub End Sub
Friend Overloads Shared Sub Feed_FeedRemoved(ByVal Destination As ToolStripMenuItem, ByVal Toolbar As ToolStrip, ByVal Feed As FeedSpecial) Friend Overloads Shared Sub Feed_FeedRemoved(ByVal Destination As ToolStripDropDownItem, ByVal Toolbar As ToolStrip, ByVal Feed As FeedSpecial)
Try Try
With Destination With Destination
ControlInvokeFast(Toolbar, .Self, ControlInvokeFast(Toolbar, .Self,
@@ -333,7 +442,7 @@ Namespace DownloadObjects
Dim c As IEnumerable(Of UserMediaD) = GetCheckedMedia() Dim c As IEnumerable(Of UserMediaD) = GetCheckedMedia()
If c.ListExists Then If c.ListExists Then
f.Add(c) f.Add(c)
FeedRemoveCheckedMedia(c,,, {f.Name}) FeedRemoveCheckedMedia(c,,, {f.Name}, True)
End If End If
End If End If
End Sub End Sub
@@ -352,7 +461,7 @@ Namespace DownloadObjects
Dim m As IEnumerable(Of UserMediaD) = GetCheckedMedia() Dim m As IEnumerable(Of UserMediaD) = GetCheckedMedia()
If m.ListExists Then If m.ListExists Then
f.Remove(m) f.Remove(m)
FeedRemoveCheckedMedia(m, {f.Name}.ToList) FeedRemoveCheckedMedia(m, {f.Name}.ToList,,, False)
End If End If
End If End If
End Sub End Sub
@@ -471,7 +580,7 @@ Namespace DownloadObjects
#Region "Toolbar controls" #Region "Toolbar controls"
#Region "Feed" #Region "Feed"
#Region "Load" #Region "Load"
Private Sub BTT_LOAD_SESSION_CURRENT_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CURRENT.Click Private Sub BTT_LOAD_SESSION_CURRENT_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SESSION_CURRENT.Click, BTT_LOAD_CURRENT_T.Click
FeedChangeMode(FeedModes.Current) FeedChangeMode(FeedModes.Current)
RefillList(True, False) RefillList(True, False)
End Sub End Sub
@@ -586,7 +695,7 @@ Namespace DownloadObjects
End Sub End Sub
#End Region #End Region
#Region "Move/Copy" #Region "Move/Copy"
Private Sub BTT_COPY_MOVE_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_TO.Click, BTT_MOVE_TO.Click Private Sub BTT_COPY_MOVE_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_TO.Click, BTT_MOVE_TO.Click, BTT_COPY_SELECTED_T.Click, BTT_MOVE_SELECTED_T.Click
MoveCopyFiles(True, sender, Nothing, Nothing) MoveCopyFiles(True, sender, Nothing, Nothing)
End Sub End Sub
Private Sub BTT_COPY_MOVE_SPEC_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_SPEC_TO.Click, BTT_MOVE_SPEC_TO.Click Private Sub BTT_COPY_MOVE_SPEC_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_SPEC_TO.Click, BTT_MOVE_SPEC_TO.Click
@@ -596,7 +705,7 @@ Namespace DownloadObjects
ByVal FeedMediaData As FeedMedia, Optional ByVal GetChecked As Boolean = True) As Boolean ByVal FeedMediaData As FeedMedia, Optional ByVal GetChecked As Boolean = True) As Boolean
Dim MsgTitle$ = "Copy/Move checked files" Dim MsgTitle$ = "Copy/Move checked files"
Try Try
Dim isCopy As Boolean = Not Sender Is Nothing AndAlso (Sender Is BTT_COPY_TO OrElse Sender Is BTT_COPY_SPEC_TO) Dim isCopy As Boolean = Not Sender Is Nothing AndAlso (Sender Is BTT_COPY_TO OrElse Sender Is BTT_COPY_SPEC_TO OrElse Sender Is BTT_COPY_SELECTED_T)
Dim moveOptions As FeedMoveCopyTo = Nothing Dim moveOptions As FeedMoveCopyTo = Nothing
Dim ff As SFile = Nothing, ffInit As SFile = Nothing, df As SFile = Nothing Dim ff As SFile = Nothing, ffInit As SFile = Nothing, df As SFile = Nothing
Dim data As IEnumerable(Of UserMediaD) = Nothing Dim data As IEnumerable(Of UserMediaD) = Nothing
@@ -959,10 +1068,13 @@ Namespace DownloadObjects
End Sub End Sub
#End Region #End Region
#Region "Load fav, spec" #Region "Load fav, spec"
Private Sub BTT_LOAD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_FAV.Click Private Sub BTT_LOAD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_FAV.Click, BTT_LOAD_FAV_T.Click
FeedChangeMode(FeedModes.Special, {FeedSpecial.FavoriteName}) FeedChangeMode(FeedModes.Special, {FeedSpecial.FavoriteName})
RefillSpecialFeedsData(False) RefillSpecialFeedsData(False)
End Sub End Sub
Private Sub BTT_LOAD_T_MouseDown(sender As Object, e As MouseEventArgs) Handles BTT_LOAD_T.MouseDown
If e.Button = MouseButtons.Right Then BTT_LOAD_SPEC_Click(sender, e)
End Sub
Private Sub BTT_LOAD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SPEC.Click Private Sub BTT_LOAD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_SPEC.Click
With FeedSpecialCollection.ChooseFeeds(False) With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then If .ListExists Then
@@ -996,20 +1108,23 @@ Namespace DownloadObjects
End Sub End Sub
#End Region #End Region
#Region "Add remove fav spec" #Region "Add remove fav spec"
Private Sub BTT_FEED_ADD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_FAV.Click, BTT_FEED_ADD_FAV_REMOVE.Click Private Sub BTT_FEED_ADD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_FAV.Click, BTT_FEED_ADD_FAV_REMOVE.Click, BTT_FAV_T.Click
Dim m As IEnumerable(Of UserMediaD) = GetCheckedMedia() Dim m As IEnumerable(Of UserMediaD) = GetCheckedMedia()
If m.ListExists Then If m.ListExists Then
Settings.Feeds.Favorite.Add(m) Settings.Feeds.Favorite.Add(m)
If sender Is BTT_FEED_ADD_FAV_REMOVE Then FeedRemoveCheckedMedia(m,,, {FeedSpecial.FavoriteName}) If sender Is BTT_FEED_ADD_FAV_REMOVE Then FeedRemoveCheckedMedia(m,,, {FeedSpecial.FavoriteName}, True)
End If End If
End Sub End Sub
Private Sub BTT_FEED_REMOVE_FAV_Click(sender As Object, e As EventArgs) Handles BTT_FEED_REMOVE_FAV.Click Private Sub BTT_FEED_REMOVE_FAV_Click(sender As Object, e As EventArgs) Handles BTT_FEED_REMOVE_FAV.Click
Dim m As IEnumerable(Of UserMediaD) = GetCheckedMedia() Dim m As IEnumerable(Of UserMediaD) = GetCheckedMedia()
If m.ListExists Then If m.ListExists Then
Settings.Feeds.Favorite.Remove(m) Settings.Feeds.Favorite.Remove(m)
If FeedMode = FeedModes.Special Then FeedRemoveCheckedMedia(m, {FeedSpecial.FavoriteName}.ToList) If FeedMode = FeedModes.Special Then FeedRemoveCheckedMedia(m, {FeedSpecial.FavoriteName}.ToList,,, False)
End If End If
End Sub End Sub
Private Sub BTT_FEED_ADD_T_MouseDown(sender As Object, e As MouseEventArgs) Handles BTT_FEED_ADD_T.MouseDown
If e.Button = MouseButtons.Right Then BTT_FEED_ADD_SPEC_Click(sender, e)
End Sub
Private Sub BTT_FEED_ADD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_SPEC.Click, BTT_FEED_ADD_SPEC_REMOVE.Click Private Sub BTT_FEED_ADD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_SPEC.Click, BTT_FEED_ADD_SPEC_REMOVE.Click
Dim c As IEnumerable(Of UserMediaD) = GetCheckedMedia() Dim c As IEnumerable(Of UserMediaD) = GetCheckedMedia()
If c.ListExists Then If c.ListExists Then
@@ -1020,7 +1135,7 @@ Namespace DownloadObjects
f.Add(c) f.Add(c)
End Sub) End Sub)
End With End With
If sender Is BTT_FEED_ADD_SPEC_REMOVE Then FeedRemoveCheckedMedia(c,,, names) If sender Is BTT_FEED_ADD_SPEC_REMOVE Then FeedRemoveCheckedMedia(c,,, names, True)
names.Clear() names.Clear()
Else Else
MsgBoxE({"You haven't selected media to add to your feed(s)", "Add to feed(s)"}, vbExclamation) MsgBoxE({"You haven't selected media to add to your feed(s)", "Add to feed(s)"}, vbExclamation)
@@ -1036,7 +1151,7 @@ Namespace DownloadObjects
f.Remove(c) f.Remove(c)
End Sub) End Sub)
End With End With
If FeedMode = FeedModes.Special Then FeedRemoveCheckedMedia(c, names) If FeedMode = FeedModes.Special Then FeedRemoveCheckedMedia(c, names,,, False)
Else Else
MsgBoxE({"You haven't selected media to remove from your feed(s)", "Remove from feed(s)"}, vbExclamation) MsgBoxE({"You haven't selected media to remove from your feed(s)", "Remove from feed(s)"}, vbExclamation)
End If End If
@@ -1268,10 +1383,10 @@ Namespace DownloadObjects
End Try End Try
End Sub End Sub
#End Region #End Region
Private Sub BTT_CHECK_ALL_NONE_Click(sender As Object, e As EventArgs) Handles BTT_CHECK_ALL.Click, BTT_CHECK_NONE.Click, BTT_CHECK_INVERT.Click Private Sub BTT_CHECK_ALL_NONE_Click(sender As Object, e As EventArgs) Handles BTT_CHECK_ALL.Click, BTT_CHECK_NONE.Click, BTT_CHECK_INVERT.Click, BTT_SELECT_ALL_T.Click, BTT_SELECT_NONE_T.Click, BTT_INVERT_T.Click
Try Try
Dim checked As Boolean = sender Is BTT_CHECK_ALL Dim checked As Boolean = sender Is BTT_CHECK_ALL Or sender Is BTT_SELECT_ALL_T
Dim isInvert As Boolean = sender Is BTT_CHECK_INVERT Dim isInvert As Boolean = sender Is BTT_CHECK_INVERT Or sender Is BTT_INVERT_T
ControlInvokeFast(TP_DATA, Sub() ControlInvokeFast(TP_DATA, Sub()
With TP_DATA With TP_DATA
If .Controls.Count > 0 Then If .Controls.Count > 0 Then
@@ -1408,8 +1523,10 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Download subscription media") ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Download subscription media")
End Try End Try
End Sub End Sub
Private Sub FeedMedia_FeedAddWithRemove(ByVal Sender As FeedMedia, ByVal Feeds As IEnumerable(Of String), ByVal Media As UserMediaD, ByVal RemoveOperation As Boolean) Private Sub FeedMedia_FeedRemoveCheckedMedia(ByVal Sender As FeedMedia, ByVal Media As UserMediaD, ByVal Names As IEnumerable(Of String),
FeedRemoveCheckedMedia({Media},, False, Feeds, RemoveOperation) ByVal IsOverriddenNames As Boolean, ByVal IsAddAndRemove As Boolean)
FeedRemoveCheckedMedia({Media}, CObj(If(IsOverriddenNames, Names.ListIfNothing, Nothing)), False,
CObj(If(IsOverriddenNames, Nothing, Names)), IsAddAndRemove)
End Sub End Sub
#End Region #End Region
#Region "Delete / Remove" #Region "Delete / Remove"
@@ -1616,7 +1733,7 @@ Namespace DownloadObjects
AddHandler .MediaDownload, AddressOf FeedMedia_Download AddHandler .MediaDownload, AddressOf FeedMedia_Download
AddHandler .MediaMove, AddressOf FeedMedia_MediaMove AddHandler .MediaMove, AddressOf FeedMedia_MediaMove
AddHandler .MediaCopy, AddressOf FeedMedia_MediaCopy AddHandler .MediaCopy, AddressOf FeedMedia_MediaCopy
AddHandler .FeedAddWithRemove, AddressOf FeedMedia_FeedAddWithRemove AddHandler .FeedRemoveCheckedMedia, AddressOf FeedMedia_FeedRemoveCheckedMedia
End With End With
If de.Data.Type = UTypes.Text OrElse de.Data.PostTextFile.IsEmptyString Then Exit For If de.Data.Type = UTypes.Text OrElse de.Data.PostTextFile.IsEmptyString Then Exit For
Next Next

View File

@@ -18,24 +18,28 @@ Namespace DownloadObjects
Private Const Name_Types As String = "Types" Private Const Name_Types As String = "Types"
Private Const Name_Users As String = "Users" Private Const Name_Users As String = "Users"
Private Const Name_Sites As String = "Sites" Private Const Name_Sites As String = "Sites"
Private Const Name_Labels As String = "Labels"
#End Region #End Region
#Region "Properties" #Region "Properties"
Friend Property Name As String Friend Property Name As String
Friend ReadOnly Property Types As List(Of UTypes) Friend ReadOnly Property Types As List(Of UTypes)
Friend ReadOnly Property Users As List(Of UserInfo) Friend ReadOnly Property Users As List(Of UserInfo)
Friend ReadOnly Property Sites As List(Of String) Friend ReadOnly Property Sites As List(Of String)
Friend ReadOnly Property Labels As List(Of String)
#End Region #End Region
#Region "Initializers" #Region "Initializers"
Friend Sub New() Friend Sub New()
Types = New List(Of UTypes) Types = New List(Of UTypes)
Users = New List(Of UserInfo) Users = New List(Of UserInfo)
Sites = New List(Of String) Sites = New List(Of String)
Labels = New List(Of String)
End Sub End Sub
Friend Sub New(ByVal e As EContainer) Friend Sub New(ByVal e As EContainer)
Me.New Me.New
Name = e.Value(Name_Name) Name = e.Value(Name_Name)
Types.ListAddList(e.Value(Name_Types).StringToList(Of Integer)(",")) Types.ListAddList(e.Value(Name_Types).StringToList(Of Integer)(","))
Sites.ListAddList(e.Value(Name_Sites).StringToList(Of String)("|")) Sites.ListAddList(e.Value(Name_Sites).StringToList(Of String)("|"))
Labels.ListAddList(e.Value(Name_Labels).StringToList(Of String)("|"))
If If(e(Name_Users)?.Count, 0) > 0 Then If If(e(Name_Users)?.Count, 0) > 0 Then
Users.ListAddList(e(Name_Users), LAP.IgnoreICopier) Users.ListAddList(e(Name_Users), LAP.IgnoreICopier)
Users.RemoveAll(Function(u) Not u.File.Exists) Users.RemoveAll(Function(u) Not u.File.Exists)
@@ -75,8 +79,9 @@ Namespace DownloadObjects
ee.Add(New EContainer(Name_Name, Name)) ee.Add(New EContainer(Name_Name, Name))
ee.Add(New EContainer(Name_Types, Types.ListToString(","))) ee.Add(New EContainer(Name_Types, Types.ListToString(",")))
ee.Add(New EContainer(Name_Sites, Sites.ListToString("|"))) ee.Add(New EContainer(Name_Sites, Sites.ListToString("|")))
ee.Add(New EContainer(Name_Labels, Labels.ListToString("|")))
If Users.Count > 0 Then If Users.Count > 0 Then
ee.Add(New EContainer(Name_Users, String.Empty)) ee.Add(New EContainer(Name_Users, String.Empty) With {.AllowSameNames = True})
ee(Name_Users).AddRange(Users) ee(Name_Users).AddRange(Users)
End If End If
Return ee Return ee
@@ -95,6 +100,8 @@ Namespace DownloadObjects
Users.ListAddList(.Users, LAP.NotContainsOnly) Users.ListAddList(.Users, LAP.NotContainsOnly)
Sites.Clear() Sites.Clear()
Sites.ListAddList(.Sites, LAP.NotContainsOnly) Sites.ListAddList(.Sites, LAP.NotContainsOnly)
Labels.Clear()
Labels.ListAddList(.Labels, LAP.NotContainsOnly)
End With End With
Return Me Return Me
End Function End Function
@@ -126,8 +133,15 @@ Namespace DownloadObjects
End Get End Get
Set(ByVal f As FeedFilter) Set(ByVal f As FeedFilter)
_TEMP = f _TEMP = f
If _TEMP Is Nothing And _CurrentFilterName.IsEmptyString And Not _CurrentFilterNameLast.IsEmptyString Then _ If _TEMP Is Nothing Then
If Not _CurrentFilterNameLast.IsEmptyString Then
_CurrentFilterName = _CurrentFilterNameLast _CurrentFilterName = _CurrentFilterNameLast
Else
_CurrentFilterName = String.Empty
End If
Else
_CurrentFilterName = String.Empty
End If
End Set End Set
End Property End Property
Friend ReadOnly Property Current(Optional ByVal Any As Boolean = True, Optional ByVal GetTemp As Boolean = True) As FeedFilter Friend ReadOnly Property Current(Optional ByVal Any As Boolean = True, Optional ByVal GetTemp As Boolean = True) As FeedFilter

View File

@@ -30,6 +30,8 @@ Namespace DownloadObjects
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(FeedFilterForm)) Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(FeedFilterForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton() Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton5 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel() Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
Me.CH_T_ALL = New System.Windows.Forms.CheckBox() Me.CH_T_ALL = New System.Windows.Forms.CheckBox()
Me.CH_T_IMG = New System.Windows.Forms.CheckBox() Me.CH_T_IMG = New System.Windows.Forms.CheckBox()
@@ -43,6 +45,7 @@ Namespace DownloadObjects
Me.LIST_USERS = New System.Windows.Forms.CheckedListBox() Me.LIST_USERS = New System.Windows.Forms.CheckedListBox()
Me.TXT_NAME = New PersonalUtilities.Forms.Controls.TextBoxExtended() Me.TXT_NAME = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_SITE = New PersonalUtilities.Forms.Controls.TextBoxExtended() Me.TXT_SITE = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_LABELS = New PersonalUtilities.Forms.Controls.TextBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer() CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_TYPES = New System.Windows.Forms.TableLayoutPanel() TP_TYPES = New System.Windows.Forms.TableLayoutPanel()
TP_USERS = New System.Windows.Forms.TableLayoutPanel() TP_USERS = New System.Windows.Forms.TableLayoutPanel()
@@ -55,6 +58,7 @@ Namespace DownloadObjects
TP_USERS_2.SuspendLayout() TP_USERS_2.SuspendLayout()
CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_SITE, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.TXT_SITE, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_LABELS, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout() Me.SuspendLayout()
' '
'CONTAINER_MAIN 'CONTAINER_MAIN
@@ -78,16 +82,18 @@ Namespace DownloadObjects
Me.TP_MAIN.ColumnCount = 1 Me.TP_MAIN.ColumnCount = 1
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.Percent, 100.0!))
Me.TP_MAIN.Controls.Add(TP_TYPES, 0, 1) Me.TP_MAIN.Controls.Add(TP_TYPES, 0, 1)
Me.TP_MAIN.Controls.Add(TP_USERS, 0, 3) Me.TP_MAIN.Controls.Add(TP_USERS, 0, 4)
Me.TP_MAIN.Controls.Add(Me.TXT_NAME, 0, 0) Me.TP_MAIN.Controls.Add(Me.TXT_NAME, 0, 0)
Me.TP_MAIN.Controls.Add(Me.TXT_SITE, 0, 2) Me.TP_MAIN.Controls.Add(Me.TXT_SITE, 0, 2)
Me.TP_MAIN.Controls.Add(Me.TXT_LABELS, 0, 3)
Me.TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill Me.TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_MAIN.Location = New System.Drawing.Point(0, 0) Me.TP_MAIN.Location = New System.Drawing.Point(0, 0)
Me.TP_MAIN.Name = "TP_MAIN" Me.TP_MAIN.Name = "TP_MAIN"
Me.TP_MAIN.RowCount = 4 Me.TP_MAIN.RowCount = 5
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(522, 336) Me.TP_MAIN.Size = New System.Drawing.Size(522, 336)
Me.TP_MAIN.TabIndex = 0 Me.TP_MAIN.TabIndex = 0
@@ -178,13 +184,13 @@ Namespace DownloadObjects
TP_USERS.Controls.Add(TP_USERS_2, 0, 0) TP_USERS.Controls.Add(TP_USERS_2, 0, 0)
TP_USERS.Controls.Add(Me.LIST_USERS, 0, 1) TP_USERS.Controls.Add(Me.LIST_USERS, 0, 1)
TP_USERS.Dock = System.Windows.Forms.DockStyle.Fill TP_USERS.Dock = System.Windows.Forms.DockStyle.Fill
TP_USERS.Location = New System.Drawing.Point(0, 81) TP_USERS.Location = New System.Drawing.Point(0, 109)
TP_USERS.Margin = New System.Windows.Forms.Padding(0) TP_USERS.Margin = New System.Windows.Forms.Padding(0)
TP_USERS.Name = "TP_USERS" TP_USERS.Name = "TP_USERS"
TP_USERS.RowCount = 2 TP_USERS.RowCount = 2
TP_USERS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) TP_USERS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_USERS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) TP_USERS.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_USERS.Size = New System.Drawing.Size(522, 255) TP_USERS.Size = New System.Drawing.Size(522, 227)
TP_USERS.TabIndex = 3 TP_USERS.TabIndex = 3
' '
'TP_USERS_2 'TP_USERS_2
@@ -206,7 +212,7 @@ Namespace DownloadObjects
TP_USERS_2.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) TP_USERS_2.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_USERS_2.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) TP_USERS_2.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_USERS_2.Size = New System.Drawing.Size(522, 25) TP_USERS_2.Size = New System.Drawing.Size(522, 25)
TP_USERS_2.TabIndex = 0 TP_USERS_2.TabIndex = 4
' '
'CH_U_USE 'CH_U_USE
' '
@@ -258,8 +264,8 @@ Namespace DownloadObjects
Me.LIST_USERS.FormattingEnabled = True Me.LIST_USERS.FormattingEnabled = True
Me.LIST_USERS.Location = New System.Drawing.Point(3, 28) Me.LIST_USERS.Location = New System.Drawing.Point(3, 28)
Me.LIST_USERS.Name = "LIST_USERS" Me.LIST_USERS.Name = "LIST_USERS"
Me.LIST_USERS.Size = New System.Drawing.Size(516, 224) Me.LIST_USERS.Size = New System.Drawing.Size(516, 196)
Me.LIST_USERS.TabIndex = 1 Me.LIST_USERS.TabIndex = 5
' '
'TXT_NAME 'TXT_NAME
' '
@@ -298,6 +304,25 @@ Namespace DownloadObjects
Me.TXT_SITE.TabIndex = 2 Me.TXT_SITE.TabIndex = 2
Me.TXT_SITE.TextBoxReadOnly = True Me.TXT_SITE.TextBoxReadOnly = True
' '
'TXT_LABELS
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Edit"
ActionButton4.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Edit
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Name = "Clear"
ActionButton5.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_LABELS.Buttons.Add(ActionButton4)
Me.TXT_LABELS.Buttons.Add(ActionButton5)
Me.TXT_LABELS.CaptionText = "Labels"
Me.TXT_LABELS.CaptionWidth = 40.0R
Me.TXT_LABELS.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_LABELS.Location = New System.Drawing.Point(3, 84)
Me.TXT_LABELS.Name = "TXT_LABELS"
Me.TXT_LABELS.Size = New System.Drawing.Size(516, 22)
Me.TXT_LABELS.TabIndex = 3
Me.TXT_LABELS.TextBoxReadOnly = True
'
'FeedFilterForm 'FeedFilterForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -317,6 +342,7 @@ Namespace DownloadObjects
TP_USERS_2.PerformLayout() TP_USERS_2.PerformLayout()
CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).EndInit() CType(Me.TXT_NAME, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_SITE, System.ComponentModel.ISupportInitialize).EndInit() CType(Me.TXT_SITE, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_LABELS, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False) Me.ResumeLayout(False)
End Sub End Sub
@@ -333,5 +359,6 @@ Namespace DownloadObjects
Private WithEvents TXT_NAME As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents TXT_NAME As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TP_MAIN As TableLayoutPanel Private WithEvents TP_MAIN As TableLayoutPanel
Private WithEvents TXT_SITE As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents TXT_SITE As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_LABELS As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class End Class
End Namespace End Namespace

View File

@@ -133,7 +133,7 @@
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25 wgAADsIBFShKgAAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2 DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value> </value>
@@ -185,7 +185,7 @@
RudN65tdA8sHzg46DF645Xrr8m2v29fvrLwzMBQydHc4cnjkLvvu5L2key/vZ9yff7DpIfph4SOpR+WP RudN65tdA8sHzg46DF645Xrr8m2v29fvrLwzMBQydHc4cnjkLvvu5L2key/vZ9yff7DpIfph4SOpR+WP
lR7X/aj3Y+uI5ciZUdfRvidBTx6Mscae/5T+04fx/Kfkp+UTqhONk2aTp6fcp24+W/1s/Hnq8/npgp+l lR7X/aj3Y+uI5ciZUdfRvidBTx6Mscae/5T+04fx/Kfkp+UTqhONk2aTp6fcp24+W/1s/Hnq8/npgp+l
f65+ofviu18cf+mbWTUz/pL/cuHX4lfyr468Xva6e9Z/9vGb5Dfzc4Vv5d8efcd41/s+7P3EfOYH7IeK f65+ofviu18cf+mbWTUz/pL/cuHX4lfyr468Xva6e9Z/9vGb5Dfzc4Vv5d8efcd41/s+7P3EfOYH7IeK
j3ofuz55f3q4kLyw8Bv3hPP74uYdwgAAAAlwSFlzAAALEwAACxMBAJqcGAAAAZlJREFUOE9j+P//PwOp j3ofuz55f3q4kLyw8Bv3hPP74uYdwgAAAAlwSFlzAAALEQAACxEBf2RfkQAAAZlJREFUOE9j+P//PwOp
eL2joz2MjSGJDztZWbGtcHTcuNrB4dx8W9tikgwQVxVnPXRo/9ObXZ3/7+bl/l/l7PxxkY1NJIZCbNhc eL2joz2MjSGJDztZWbGtcHTcuNrB4dx8W9tikgwQVxVnPXRo/9ObXZ3/7+bl/l/l7PxxkY1NJIZCbNhc
U5Q9ozX9f/fS/v+vXr76f3XmzP9LPDxOMjAwqGIoRsc60iysF5ZFfd25acl/wxKX/w1T6n+uXbvm+9T+ U5Q9ozX9f/fS/v+vXr76f3XmzP9LPDxOMjAwqGIoRsc60iysF5ZFfd25acl/wxKX/w1T6n+uXbvm+9T+
xiCQPIYGZKwhzsh0ZHbg189X2////3/gJ8gQkEtgmvEaIM/PwLJzgvfnd+ea/v//sf7/10ed/3qyTFA0 xiCQPIYGZKwhzsh0ZHbg189X2////3/gJ8gQkEtgmvEaIM/PwLJzgvfnd+ea/v//sf7/10ed/3qyTFA0
@@ -198,7 +198,72 @@
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25 wgAADsIBFShKgAAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAACH
DwAAjA8AAP1SAACBQAAAfXkAAOmLAAA85QAAGcxzPIV3AAAKOWlDQ1BQaG90b3Nob3AgSUNDIHByb2Zp
bGUAAEjHnZZ3VFTXFofPvXd6oc0w0hl6ky4wgPQuIB0EURhmBhjKAMMMTWyIqEBEEREBRZCggAGjoUis
iGIhKKhgD0gQUGIwiqioZEbWSnx5ee/l5ffHvd/aZ+9z99l7n7UuACRPHy4vBZYCIJkn4Ad6ONNXhUfQ
sf0ABniAAaYAMFnpqb5B7sFAJC83F3q6yAn8i94MAUj8vmXo6U+ng/9P0qxUvgAAyF/E5mxOOkvE+SJO
yhSkiu0zIqbGJIoZRomZL0pQxHJijlvkpZ99FtlRzOxkHlvE4pxT2clsMfeIeHuGkCNixEfEBRlcTqaI
b4tYM0mYzBXxW3FsMoeZDgCKJLYLOKx4EZuImMQPDnQR8XIAcKS4LzjmCxZwsgTiQ7mkpGbzuXHxArou
S49uam3NoHtyMpM4AoGhP5OVyOSz6S4pyalMXjYAi2f+LBlxbemiIluaWltaGpoZmX5RqP+6+Dcl7u0i
vQr43DOI1veH7a/8UuoAYMyKarPrD1vMfgA6tgIgd/8Pm+YhACRFfWu/8cV5aOJ5iRcIUm2MjTMzM424
HJaRuKC/6386/A198T0j8Xa/l4fuyollCpMEdHHdWClJKUI+PT2VyeLQDf88xP848K/zWBrIieXwOTxR
RKhoyri8OFG7eWyugJvCo3N5/6mJ/zDsT1qca5Eo9Z8ANcoISN2gAuTnPoCiEAESeVDc9d/75oMPBeKb
F6Y6sTj3nwX9+65wifiRzo37HOcSGExnCfkZi2viawnQgAAkARXIAxWgAXSBITADVsAWOAI3sAL4gWAQ
DtYCFogHyYAPMkEu2AwKQBHYBfaCSlAD6kEjaAEnQAc4DS6Ay+A6uAnugAdgBIyD52AGvAHzEARhITJE
geQhVUgLMoDMIAZkD7lBPlAgFA5FQ3EQDxJCudAWqAgqhSqhWqgR+hY6BV2ArkID0D1oFJqCfoXewwhM
gqmwMqwNG8MM2An2hoPhNXAcnAbnwPnwTrgCroOPwe3wBfg6fAcegZ/DswhAiAgNUUMMEQbigvghEUgs
wkc2IIVIOVKHtCBdSC9yCxlBppF3KAyKgqKjDFG2KE9UCIqFSkNtQBWjKlFHUe2oHtQt1ChqBvUJTUYr
oQ3QNmgv9Cp0HDoTXYAuRzeg29CX0HfQ4+g3GAyGhtHBWGE8MeGYBMw6TDHmAKYVcx4zgBnDzGKxWHms
AdYO64dlYgXYAux+7DHsOewgdhz7FkfEqeLMcO64CBwPl4crxzXhzuIGcRO4ebwUXgtvg/fDs/HZ+BJ8
Pb4LfwM/jp8nSBN0CHaEYEICYTOhgtBCuER4SHhFJBLVidbEACKXuIlYQTxOvEIcJb4jyZD0SS6kSJKQ
tJN0hHSedI/0ikwma5MdyRFkAXknuZF8kfyY/FaCImEk4SXBltgoUSXRLjEo8UISL6kl6SS5VjJHslzy
pOQNyWkpvJS2lIsUU2qDVJXUKalhqVlpirSptJ90snSxdJP0VelJGayMtoybDFsmX+awzEWZMQpC0aC4
UFiULZR6yiXKOBVD1aF6UROoRdRvqP3UGVkZ2WWyobJZslWyZ2RHaAhNm+ZFS6KV0E7QhmjvlygvcVrC
WbJjScuSwSVzcopyjnIcuUK5Vrk7cu/l6fJu8onyu+U75B8poBT0FQIUMhUOKlxSmFakKtoqshQLFU8o
3leClfSVApXWKR1W6lOaVVZR9lBOVd6vfFF5WoWm4qiSoFKmclZlSpWiaq/KVS1TPaf6jC5Ld6In0Svo
PfQZNSU1TzWhWq1av9q8uo56iHqeeqv6Iw2CBkMjVqNMo1tjRlNV01czV7NZ874WXouhFa+1T6tXa05b
RztMe5t2h/akjpyOl06OTrPOQ12yroNumm6d7m09jB5DL1HvgN5NfVjfQj9ev0r/hgFsYGnANThgMLAU
vdR6KW9p3dJhQ5Khk2GGYbPhqBHNyMcoz6jD6IWxpnGE8W7jXuNPJhYmSSb1Jg9MZUxXmOaZdpn+aqZv
xjKrMrttTjZ3N99o3mn+cpnBMs6yg8vuWlAsfC22WXRbfLS0suRbtlhOWWlaRVtVWw0zqAx/RjHjijXa
2tl6o/Vp63c2ljYCmxM2v9ga2ibaNtlOLtdZzllev3zMTt2OaVdrN2JPt4+2P2Q/4qDmwHSoc3jiqOHI
dmxwnHDSc0pwOub0wtnEme/c5jznYuOy3uW8K+Lq4Vro2u8m4xbiVun22F3dPc692X3Gw8Jjncd5T7Sn
t+duz2EvZS+WV6PXzAqrFetX9HiTvIO8K72f+Oj78H26fGHfFb57fB+u1FrJW9nhB/y8/Pb4PfLX8U/z
/z4AE+AfUBXwNNA0MDewN4gSFBXUFPQm2Dm4JPhBiG6IMKQ7VDI0MrQxdC7MNaw0bGSV8ar1q66HK4Rz
wzsjsBGhEQ0Rs6vdVu9dPR5pEVkQObRGZ03WmqtrFdYmrT0TJRnFjDoZjY4Oi26K/sD0Y9YxZ2O8Yqpj
ZlgurH2s52xHdhl7imPHKeVMxNrFlsZOxtnF7YmbineIL4+f5rpwK7kvEzwTahLmEv0SjyQuJIUltSbj
kqOTT/FkeIm8nhSVlKyUgVSD1ILUkTSbtL1pM3xvfkM6lL4mvVNAFf1M9Ql1hVuFoxn2GVUZbzNDM09m
SWfxsvqy9bN3ZE/kuOd8vQ61jrWuO1ctd3Pu6Hqn9bUboA0xG7o3amzM3zi+yWPT0c2EzYmbf8gzySvN
e70lbEtXvnL+pvyxrR5bmwskCvgFw9tst9VsR23nbu/fYb5j/45PhezCa0UmReVFH4pZxde+Mv2q4quF
nbE7+0ssSw7uwuzi7Rra7bD7aKl0aU7p2B7fPe1l9LLCstd7o/ZeLV9WXrOPsE+4b6TCp6Jzv+b+Xfs/
VMZX3qlyrmqtVqreUT13gH1g8KDjwZYa5ZqimveHuIfu1nrUttdp15UfxhzOOPy0PrS+92vG140NCg1F
DR+P8I6MHA082tNo1djYpNRU0gw3C5unjkUeu/mN6zedLYYtta201qLj4Ljw+LNvo78dOuF9ovsk42TL
d1rfVbdR2grbofbs9pmO+I6RzvDOgVMrTnV32Xa1fW/0/ZHTaqerzsieKTlLOJt/duFczrnZ86nnpy/E
XRjrjup+cHHVxds9AT39l7wvXbnsfvlir1PvuSt2V05ftbl66hrjWsd1y+vtfRZ9bT9Y/NDWb9nffsPq
RudN65tdA8sHzg46DF645Xrr8m2v29fvrLwzMBQydHc4cnjkLvvu5L2key/vZ9yff7DpIfph4SOpR+WP
lR7X/aj3Y+uI5ciZUdfRvidBTx6Mscae/5T+04fx/Kfkp+UTqhONk2aTp6fcp24+W/1s/Hnq8/npgp+l
f65+ofviu18cf+mbWTUz/pL/cuHX4lfyr468Xva6e9Z/9vGb5Dfzc4Vv5d8efcd41/s+7P3EfOYH7IeK
j3ofuz55f3q4kLyw8Bv3hPP74uYdwgAAAAlwSFlzAAALEAAACxABrSO9dQAAAZlJREFUOE9j+P//PwOp
eL2joz2MjSGJDztZWbGtcHTcuNrB4dx8W9tikgwQVxVnPXRo/9ObXZ3/7+bl/l/l7PxxkY1NJIZCbNhc
U5Q9ozX9f/fS/v+vXr76f3XmzP9LPDxOMjAwqGIoRsc60iysF5ZFfd25acl/wxKX/w1T6n+uXbvm+9T+
xiCQPIYGZKwhzsh0ZHbg189X2////3/gJ8gQkEtgmvEaIM/PwLJzgvfnd+ea/v//sf7/10ed/3qyTFA0
4zRAhoeBeXOn66c3J2r+//+64v+3B23/sWnGaoA0DwPbumbHT4/35v///23R/x/363FqxjBAWZSDeU6h
xdt727P+/38z8f/XO5V4NaMYICXAwbyuKeLW9Q0J//6/7vn/80YeQc0oBiyrdVh9c33B9//32159vZr2
hxjNcAPUZQTd766v+f3/4uz/n3Y1/19S6feSGM1gA1iZGPgXVQef/H+i7//xqWm/JlVG3CRWM9gAIwO9
xl1T8/83xVufE+fnqEBXQAgzKCmrXJGVkmhjYGDQR5ckBgMAtlm0SiCu/g8AAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton5.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wQAADsEBuJFr7QAAAHpJREFUOE+1kVEKgDAMQ3e2/e+MXqpn6W/HxM7SpkIVB4HxSMKiTUTaFwVQ1X25
DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2 DjMfSxskHBYsAxHJkjUjHgrUNMY4peaMPxb03rcZMVhgn2oDKAwn+L0aROH/Cny4NAGFSx8x+10ZDwV2
gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC gt+LOCxQsw1nPBS8VQBVTTzyhrdZSUm7AAAAAElFTkSuQmCC
</value> </value>

View File

@@ -6,6 +6,7 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls.Base Imports PersonalUtilities.Forms.Controls.Base
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
@@ -105,6 +106,7 @@ Namespace DownloadObjects
End If End If
UpdateSitesText() UpdateSitesText()
UpdateLabelsText()
.EndLoaderOperations() .EndLoaderOperations()
RefillList(True) RefillList(True)
@@ -143,21 +145,29 @@ Namespace DownloadObjects
Return DirectCast(Obj, DataUserTmp).UserInfo Return DirectCast(Obj, DataUserTmp).UserInfo
End Function End Function
End Structure End Structure
Private SitePredicate As Predicate(Of IUserData) = Function(d) MyFilter.Sites.Count = 0 OrElse MyFilter.Sites.Contains(d.Site)
Private LabelPredicate As Predicate(Of IUserData) = Function(d) MyFilter.Labels.Count = 0 OrElse MyFilter.Labels.ListContains(d.Labels)
Private Sub RefillList(Optional ByVal Init As Boolean = False) Private Sub RefillList(Optional ByVal Init As Boolean = False)
If Not MyDefs.Initializing Then If Not MyDefs.Initializing Then
If Not Init Then ApplyFilter() If Not Init Then ApplyFilter()
LIST_USERS.Items.Clear() LIST_USERS.Items.Clear()
Dim dataUsers As New List(Of DataUserTmp) Dim dataUsers As New List(Of DataUserTmp)
If CH_U_SHOW_ALL.Checked Or MyData.Count = 0 Then If CH_U_SHOW_ALL.Checked Or MyData.Count = 0 Then
dataUsers.ListAddList(Settings.UsersList) 'dataUsers.ListAddList(Settings.UsersList)
Else If Settings.Users.Count > 0 Then dataUsers.ListAddList(From __d As IUserData In Settings.GetUsers(Function(____d) True)
dataUsers.ListAddList(MyData.Select(Function(d) d.UserInfo), LAP.NotContainsOnly) Where SitePredicate(__d) And LabelPredicate(__d)
Select DirectCast(__d, UserDataBase).User)
ElseIf MyData.Count > 0 Then
'dataUsers.ListAddList(MyData.Select(Function(d) d.UserInfo), LAP.NotContainsOnly)
dataUsers.ListAddList((From __d As IUserData In MyData.Select(Function(____d) ____d.User)
Where SitePredicate(__d) And LabelPredicate(__d)
Select DirectCast(__d, UserDataBase).User), LAP.NotContainsOnly)
End If End If
Dim i% Dim i%
If dataUsers.Count > 0 Then If dataUsers.Count > 0 Then
dataUsers.Sort() dataUsers.Sort()
With MyFilter With MyFilter
If .Sites.Count > 0 Then dataUsers.RemoveAll(Function(d) Not .Sites.Contains(d.UserInfo.Site)) 'If .Sites.Count > 0 Then dataUsers.RemoveAll(Function(d) Not .Sites.Contains(d.UserInfo.Site))
If dataUsers.Count > 0 Then If dataUsers.Count > 0 Then
dataUsers.ForEach(Sub(d) LIST_USERS.Items.Add(d, True)) dataUsers.ForEach(Sub(d) LIST_USERS.Items.Add(d, True))
If .Users.Count > 0 Then If .Users.Count > 0 Then
@@ -243,10 +253,30 @@ Namespace DownloadObjects
End Select End Select
If refill Then RefillList() If refill Then RefillList()
End Sub End Sub
Private Sub TXT_LABELS_ActionOnButtonClick(ByVal Sender As Object, ByVal e As ActionButtonEventArgs) Handles TXT_LABELS.ActionOnButtonClick
Dim refill As Boolean = False
Select Case e.DefaultButton
Case ActionButton.DefaultButtons.Edit
Using f As New LabelsForm(MyFilter.Labels, False)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
refill = Not MyFilter.Labels.ListEquals(f.LabelsList)
MyFilter.Labels.ListAddList(f.LabelsList, LAP.NotContainsOnly, LAP.ClearBeforeAdd)
UpdateLabelsText()
End If
End Using
Case ActionButton.DefaultButtons.Clear : refill = MyFilter.Labels.Count > 0 : MyFilter.Labels.Clear() : UpdateLabelsText()
End Select
If refill Then RefillList()
End Sub
Private Sub UpdateSitesText() Private Sub UpdateSitesText()
TXT_SITE.Clear() TXT_SITE.Clear()
TXT_SITE.Text = MyFilter.Sites.ListToString TXT_SITE.Text = MyFilter.Sites.ListToString
End Sub End Sub
Private Sub UpdateLabelsText()
TXT_LABELS.Clear()
TXT_LABELS.Text = MyFilter.Labels.ListToString
End Sub
#End Region #End Region
End Class End Class
End Namespace End Namespace

View File

@@ -12,6 +12,7 @@ Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports UserMediaD = SCrawler.DownloadObjects.TDownloader.UserMediaD Imports UserMediaD = SCrawler.DownloadObjects.TDownloader.UserMediaD
Imports ImageRenderer2 = SCrawler.UserImage.ImageRenderer2
Namespace DownloadObjects Namespace DownloadObjects
<ToolboxItem(False), DesignTimeVisible(False)> <ToolboxItem(False), DesignTimeVisible(False)>
Public Class FeedMedia Public Class FeedMedia
@@ -20,7 +21,8 @@ Namespace DownloadObjects
Friend Event MediaDeleted(ByVal Sender As Object) Friend Event MediaDeleted(ByVal Sender As Object)
Friend Event MediaDeletedText(ByVal Sender As Object) Friend Event MediaDeletedText(ByVal Sender As Object)
Friend Event MediaDownload As EventHandler Friend Event MediaDownload As EventHandler
Friend Event FeedAddWithRemove(ByVal Sender As FeedMedia, ByVal Feeds As IEnumerable(Of String), ByVal Media As UserMediaD, ByVal RemoveOperation As Boolean) Friend Event FeedRemoveCheckedMedia(ByVal Sender As FeedMedia, ByVal Media As UserMediaD, ByVal Names As IEnumerable(Of String),
ByVal IsOverriddenNames As Boolean, ByVal IsAddAndRemove As Boolean)
Friend Event MediaMove As MediaMoveCopyEventHandler Friend Event MediaMove As MediaMoveCopyEventHandler
Friend Event MediaCopy As MediaMoveCopyEventHandler Friend Event MediaCopy As MediaMoveCopyEventHandler
#End Region #End Region
@@ -153,10 +155,12 @@ Namespace DownloadObjects
End Function End Function
#End Region #End Region
#Region "Initializers" #Region "Initializers"
Private Sub FileCheckSpecialFolders(ByRef f As SFile, ByVal ExtractText As Boolean) Private Sub FileCheckSpecialFolders(ByRef f As SFile, ByVal ExtractText As Boolean, ByVal OrigFile As SFile)
If Not File.Exists Then If Not File.Exists Then
If ExtractText Then If ExtractText Then
f.Path = $"{File.Path.CSFilePS}{UserDataBase.PostTextSpecialFolderDefault}" f.Path = $"{File.Path.CSFilePS}{UserDataBase.PostTextSpecialFolderDefault}"
If Not f.Exists Then f.Path = OrigFile.Path
If Not f.Exists Then f.Path = $"{OrigFile.Path.CSFilePS}{UserDataBase.PostTextSpecialFolderDefault}"
ElseIf Media.Data.Type = UserMedia.Types.Video Then ElseIf Media.Data.Type = UserMedia.Types.Video Then
f.Path = $"{File.Path.CSFilePS}Video" f.Path = $"{File.Path.CSFilePS}Video"
End If End If
@@ -165,42 +169,6 @@ Namespace DownloadObjects
Public Sub New() Public Sub New()
InitializeComponent() InitializeComponent()
End Sub End Sub
Private Class ImageRenderer2 : Inherits ImageRenderer
Friend NativeFormat As String = Nothing
Friend ImgErr As Exception = Nothing
Friend Sub New(ByVal ImgPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing)
MyBase.New()
Try
If ImgPath.Exists(SFO.File, False) Then
OriginalImageBytes = SFile.GetBytes(ImgPath, EDP.ThrowException)
Try
OriginalImage = GetImage(OriginalImageBytes)
Catch exInternal As Exception
HasError = True
ImgErr = exInternal
NativeFormat = GetTrueFormat(OriginalImageBytes, EDP.ReturnValue)
End Try
End If
Address = ImgPath
Catch ex As Exception
HasError = True
NativeFormat = GetTrueFormat(OriginalImageBytes, EDP.ReturnValue)
If Not e.Exists Then e = EDP.ThrowException
ErrorsDescriber.Execute(e, ex, $"ImageRenderer2.New({ImgPath})")
End Try
End Sub
Friend Shared Function GetTrueFormat(ByVal Img() As Byte, Optional ByVal e As ErrorsDescriber = Nothing) As String
Try
Using ms As New MemoryStream(Img, 0, Img.Length)
Return System.Windows.Media.Imaging.BitmapDecoder.Create(ms, Windows.Media.Imaging.BitmapCreateOptions.PreservePixelFormat,
Windows.Media.Imaging.BitmapCacheOption.OnLoad).Metadata.Format
End Using
Catch ex As Exception
If Not e.Exists Then e = EDP.ThrowException
Return ErrorsDescriber.Execute(e, ex, "[ImageRenderer2.GetTrueFormat()]")
End Try
End Function
End Class
Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Height As Integer, ByVal IsSession As Boolean, ByVal ExtractText As Boolean) Friend Sub New(ByVal Media As UserMediaD, ByVal Width As Integer, ByVal Height As Integer, ByVal IsSession As Boolean, ByVal ExtractText As Boolean)
Try Try
InitializeComponent() InitializeComponent()
@@ -238,7 +206,17 @@ Namespace DownloadObjects
End With End With
If Not imgFile.Exists Then If Not imgFile.Exists Then
Settings.Cache.Validate() Settings.Cache.Validate()
If GetWebFile(Media.Data.URL, imgFile, EDP.None) AndAlso imgFile.Exists Then File = UserImage.ConvertWebp(imgFile, Nothing) If GetWebFile(Media.Data.URL, imgFile, EDP.None) AndAlso imgFile.Exists Then
File = UserImage.ConvertWebp(imgFile, Nothing)
ElseIf Not IsNothing(Media.Data.Object) AndAlso TypeOf Media.Data.Object Is IThumbList AndAlso
DirectCast(Media.Data.Object, IThumbList).Thumbs.ListExists Then
With DirectCast(Media.Data.Object, IThumbList).Thumbs
For Each __tmpUrl$ In .Self
If GetWebFile(__tmpUrl, imgFile, EDP.None) AndAlso imgFile.Exists Then _
File = UserImage.ConvertWebp(imgFile, Nothing) : Exit For
Next
End With
End If
Else Else
File = imgFile File = imgFile
End If End If
@@ -248,18 +226,18 @@ Namespace DownloadObjects
LBL_TITLE.Dispose() LBL_TITLE.Dispose()
TP_MAIN.RowStyles(1).Height = 0 TP_MAIN.RowStyles(1).Height = 0
File = If(ExtractText, Media.Data.PostTextFile, Media.Data.File) File = If(ExtractText, Media.Data.PostTextFile, Media.Data.File)
FileCheckSpecialFolders(File, ExtractText) FileCheckSpecialFolders(File, ExtractText, Media.Data.File)
End If End If
If Not File.Exists And Not IsSubscription Then If Not File.Exists And Not IsSubscription Then
If Not Media.Data.SpecialFolder.IsEmptyString Then If Not Media.Data.SpecialFolder.IsEmptyString Then
File = If(ExtractText, Media.Data.PostTextFile, Media.Data.File) File = If(ExtractText, Media.Data.PostTextFile, Media.Data.File)
File.Path = $"{File.Path.CSFilePS}{Media.Data.SpecialFolder}".CSFileP File.Path = $"{File.Path.CSFilePS}{Media.Data.SpecialFolder}".CSFileP
FileCheckSpecialFolders(File, ExtractText) FileCheckSpecialFolders(File, ExtractText, Media.Data.File)
End If End If
End If End If
If File.Exists Then If File.Exists Or IsSubscription Then
Information = $"Type: {IIf(ExtractText, UserMedia.Types.Text.ToString, Media.Data.Type.ToString)}" Information = $"Type: {IIf(ExtractText, UserMedia.Types.Text.ToString, Media.Data.Type.ToString)}"
Information.StringAppendLine($"File: {File.File}") Information.StringAppendLine($"File: {File.File}")
Information.StringAppendLine($"Address: {File}") Information.StringAppendLine($"Address: {File}")
@@ -290,7 +268,7 @@ Namespace DownloadObjects
Dim webpConverted As Boolean = False Dim webpConverted As Boolean = False
Dim isWebp As Boolean = False Dim isWebp As Boolean = False
tmpMediaFile = UserImage.ConvertWebp(tmpMediaFile, Nothing,,, webpConverted) tmpMediaFile = UserImage.ConvertWebp(tmpMediaFile, Nothing,,, webpConverted)
If tmpMediaFile.IsEmptyString Then Throw New ArgumentNullException With {.HelpLink = 1} If tmpMediaFile.IsEmptyString And Not IsSubscription Then Throw New ArgumentNullException With {.HelpLink = 1}
Try Try
For kConv As Byte = 0 To 1 For kConv As Byte = 0 To 1
If kConv = 1 Then tmpMediaFile = UserImage.ConvertWebp(tmpMediaFile, Nothing, True, isWebp, webpConverted) If kConv = 1 Then tmpMediaFile = UserImage.ConvertWebp(tmpMediaFile, Nothing, True, isWebp, webpConverted)
@@ -435,11 +413,11 @@ Namespace DownloadObjects
End Function End Function
Private Sub Feed_SPEC_ADD_REMOVE(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs) Private Sub Feed_SPEC_ADD_REMOVE(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
Dim f As FeedSpecial = Feed_SPEC_ADD_Impl(Source) Dim f As FeedSpecial = Feed_SPEC_ADD_Impl(Source)
If Not f Is Nothing Then RaiseEvent FeedAddWithRemove(Me, {f.Name}, Media, False) If Not f Is Nothing Then RaiseEvent FeedRemoveCheckedMedia(Me, Media, {f.Name}, False, True)
End Sub End Sub
Private Sub Feed_SPEC_REMOVE(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs) Private Sub Feed_SPEC_REMOVE(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
Dim f As FeedSpecial = Source.Tag Dim f As FeedSpecial = Source.Tag
If Not f Is Nothing AndAlso Not f.Disposed Then f.Remove(Media) : RaiseEvent FeedAddWithRemove(Me, {f.Name}, Media, True) If Not f Is Nothing AndAlso Not f.Disposed Then f.Remove(Media) : RaiseEvent FeedRemoveCheckedMedia(Me, Media, {f.Name}, True, False)
End Sub End Sub
#End Region #End Region
#Region "Dispose" #Region "Dispose"
@@ -598,14 +576,14 @@ Namespace DownloadObjects
With Settings.Feeds.Favorite With Settings.Feeds.Favorite
If Not .Contains(Media) Then .Add(Media) If Not .Contains(Media) Then .Add(Media)
BTT_FEED_ADD_FAV.ControlChangeColor(True, False) BTT_FEED_ADD_FAV.ControlChangeColor(True, False)
If sender Is BTT_FEED_ADD_FAV_REMOVE Then RaiseEvent FeedAddWithRemove(Me, {FeedSpecial.FavoriteName}, Media, False) If sender Is BTT_FEED_ADD_FAV_REMOVE Then RaiseEvent FeedRemoveCheckedMedia(Me, Media, {FeedSpecial.FavoriteName}, False, True)
End With End With
End Sub End Sub
Private Sub BTT_FEED_ADD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_SPEC.Click, BTT_FEED_ADD_SPEC_REMOVE.Click Private Sub BTT_FEED_ADD_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_ADD_SPEC.Click, BTT_FEED_ADD_SPEC_REMOVE.Click
With FeedSpecialCollection.ChooseFeeds(True) With FeedSpecialCollection.ChooseFeeds(True)
If .ListExists Then If .ListExists Then
.ForEach(Sub(f) f.Add(Media)) .ForEach(Sub(f) f.Add(Media))
If sender Is BTT_FEED_ADD_SPEC_REMOVE Then RaiseEvent FeedAddWithRemove(Me, .Select(Function(f) f.Name), Media, False) If sender Is BTT_FEED_ADD_SPEC_REMOVE Then RaiseEvent FeedRemoveCheckedMedia(Me, Media, .Select(Function(f) f.Name), False, True)
End If End If
End With End With
End Sub End Sub
@@ -613,14 +591,14 @@ Namespace DownloadObjects
With Settings.Feeds.Favorite With Settings.Feeds.Favorite
If .Contains(Media) Then .Remove(Media) If .Contains(Media) Then .Remove(Media)
BTT_FEED_ADD_FAV.ControlChangeColor(True) BTT_FEED_ADD_FAV.ControlChangeColor(True)
RaiseEvent FeedAddWithRemove(Me, {FeedSpecial.FavoriteName}, Media, True) RaiseEvent FeedRemoveCheckedMedia(Me, Media, {FeedSpecial.FavoriteName}, True, False)
End With End With
End Sub End Sub
Private Sub BTT_FEED_REMOVE_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_REMOVE_SPEC.Click Private Sub BTT_FEED_REMOVE_SPEC_Click(sender As Object, e As EventArgs) Handles BTT_FEED_REMOVE_SPEC.Click
With FeedSpecialCollection.ChooseFeeds(False) With FeedSpecialCollection.ChooseFeeds(False)
If .ListExists Then If .ListExists Then
.ForEach(Sub(f) f.Remove(Media)) .ForEach(Sub(f) f.Remove(Media))
RaiseEvent FeedAddWithRemove(Me, .Select(Function(f) f.Name), Media, True) RaiseEvent FeedRemoveCheckedMedia(Me, Media, .Select(Function(f) f.Name), True, False)
End If End If
End With End With
End Sub End Sub

View File

@@ -245,7 +245,7 @@ Namespace DownloadObjects.Groups
If Not Settings.Automation Is Nothing AndAlso Settings.Automation.Count > 0 Then If Not Settings.Automation Is Nothing AndAlso Settings.Automation.Count > 0 Then
Dim aIncl As New List(Of String) Dim aIncl As New List(Of String)
For Each plan As AutoDownloader In Settings.Automation For Each plan As AutoDownloader In Settings.Automation
If plan.Mode = AutoDownloader.Modes.Groups AndAlso plan.Groups.Count > 0 AndAlso plan.Groups.Contains(Name) Then aIncl.Add(plan.Name) If plan.Groups.Count > 0 AndAlso plan.Groups.Contains(Name) Then aIncl.Add(plan.Name)
Next Next
If aIncl.Count > 0 Then If aIncl.Count > 0 Then
MsgBoxE({$"The '{Name}' group cannot be deleted because it is included in the following scheduler plans:{vbCr}{vbCr}" & MsgBoxE({$"The '{Name}' group cannot be deleted because it is included in the following scheduler plans:{vbCr}{vbCr}" &
@@ -285,6 +285,7 @@ Namespace DownloadObjects.Groups
Try Try
If Settings.Users.Count > 0 Then If Settings.Users.Count > 0 Then
With Instance With Instance
If TypeOf .Self Is AutoDownloader AndAlso Not DirectCast(.Self, AutoDownloader).Enabled Then Return Nothing
Dim downDate As Date? = Nothing Dim downDate As Date? = Nothing
If .DaysNumber > 0 Then If .DaysNumber > 0 Then
With Now.AddDays(- .DaysNumber) : downDate = New Date(.Year, .Month, .Day, 0, 0, 0) : End With With Now.AddDays(- .DaysNumber) : downDate = New Date(.Year, .Month, .Day, 0, 0, 0) : End With
@@ -363,10 +364,32 @@ Namespace DownloadObjects.Groups
Dim CheckSites As Predicate(Of IUserData) = Function(user) _ Dim CheckSites As Predicate(Of IUserData) = Function(user) _
(.Sites.Count = 0 OrElse .Sites.Contains(user.Site)) AndAlso (.Sites.Count = 0 OrElse .Sites.Contains(user.Site)) AndAlso
(.SitesExcluded.Count = 0 OrElse Not .SitesExcluded.Contains(user.Site)) (.SitesExcluded.Count = 0 OrElse Not .SitesExcluded.Contains(user.Site))
Dim users As IEnumerable(Of IUserData) = Dim users As New List(Of IUserData)
Settings.GetUsers(Function(user) CheckLabels.Invoke(user) AndAlso CheckSites.Invoke(user) AndAlso Dim l As New ListAddParams(LAP.IgnoreICopier)
If Not .GroupsOnly Or (.GroupsOnly And .Groups.Count = 0) Then
users.ListAddList(Settings.GetUsers(Function(user) CheckLabels.Invoke(user) AndAlso CheckSites.Invoke(user) AndAlso
CheckParams.Invoke(user) AndAlso CheckSubscription.Invoke(user) AndAlso CheckParams.Invoke(user) AndAlso CheckSubscription.Invoke(user) AndAlso
CheckDays.Invoke(user) AndAlso CheckDateRange.Invoke(user)) CheckDays.Invoke(user) AndAlso CheckDateRange.Invoke(user)), l)
End If
If Settings.Groups.Count > 0 Then
Dim i%
Dim groupName$
l.NotContainsOnly = True
If .Groups.Count > 0 Then
For Each groupName In .Groups
i = Settings.Groups.IndexOf(groupName)
If i >= 0 Then users.ListAddList(Settings.Groups(i).GetUsers, l)
Next
End If
l.DisableDispose = True
If .GroupsExcluded.Count > 0 Then
For Each groupName In .GroupsExcluded
i = Settings.Groups.IndexOf(groupName)
If i >= 0 Then users.ListDisposeRemove(Settings.Groups(i).GetUsers, l)
Next
End If
End If
If .UsersCount <> 0 And users.ListExists Then If .UsersCount <> 0 And users.ListExists Then
users = users.ListTake(If(.UsersCount > 0, -1, -2), Math.Abs(.UsersCount)) users = users.ListTake(If(.UsersCount > 0, -1, -2), Math.Abs(.UsersCount))
If .UsersCount < 0 Then users = users.ListReverse If .UsersCount < 0 Then users = users.ListReverse

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