Compare commits

...

22 Commits

Author SHA1 Message Date
Andy
2f838929cc 2025.2.25.0
PluginProvider
IPluginContentProvider: add 'NameTrue' property

YT
YouTubeSettings: remove the 'CreateDescriptionFiles_AddUploadDate' property
PlayListParserForm: add 'RDAMP' as default value when initializing form
YouTubeMediaContainerBase: fix line breaks

SCrawler
API.Base: add 'EditorExchangeOptionsBase' class
API.Base.GDL: move functions to Pinterest.UserData
API.Base.IUserData: add 'NameTrue' property
API.Base.SiteSettingsBase: update the 'GetUserUrl' function to use the 'NameTrue' property; update 'UserOptions' function
API.Base.UserDataBase: add 'NameTrue' property; add 'SimpleDownloadAvatar' function to get rid of the  same functions of other classes; Update 'UserDescriptionUpdate' function
API.Base.InternalSettingsForm: calculate max offset

ADD API.Bluesky

API.Facebook: add 'Reels' downloads; fix video downloading
API.Instagram: add inheritance 'EditorExchangeOptionsBase'; remove 'GetUserUrl' function from 'SiteSettings'; update 'UserData' class to new environment; add saving 'heic' file along with 'jpg'
API.LPSG.UserData: simplify 403 error
API.Mastodon: update classes to new environment
API.OnlyFans: add 'AppTokenDefault'; disable cookies update; update 'UserData' class to new environment
API.Pinterest: add sub-boards downloading; update download functions
API.PornHub: fix photo & video downloading; remove 'ModelHub' support
API.Reddit: fix token update; update 'UserData' class to new environment
API.ThisVid: update 'UserData' class to new environment
API.ThreadsNet: fix data download; update classes to new environment; fix 'UserID' extraction; add the ability to manually change the UserName
API.TikTok: update classes to new environment
API.Twitter: update classes to new environment; add sleep timers to fully download large profiles; add 'CookiesUpdate' hidden property
API.Xhamster: update classes to new environment
API.XVIDEOS: update classes to new environment

Feed: add the ability to invert selection; open post URL when double-clicking on subscription image
FeedSpecialCollection: update 'FeedsComparer'
GlobalSettingsForm: remove 'UserAgent' from the 'Basis' tab
UserDataHost: update class to new environment
SettingsCLS: set the 'UserSiteNameAsFriendly' property to 'True' by default; disable 'DownDetector'; add 'UsersListProtected' property
2025-02-25 19:47:33 +03:00
Andy
4d74f5204b 2025.1.12.0
YT
YouTubeSettings: add 'FileAddChannelToFileName' property
YouTubeMediaContainerBase: add channel name and video URL to info file; add channel name to file name

SCrawler
DownDetector: fix 403 error; add 'IDownDetector' interface and 'Checker' class; create an isolated environment
API.Instagram: update 'SiteSettings' to the new 'DownDetector' environment; make 'PostKV' public; add static function 'LoadSavePostsKV'
API.OnlyFans: add 'EnableCookiesUpdate' hidden property; add support for DRM keys; add the ability to disable cookie updates
API.Pinterest: add 'x-pinterest-pws-handler' header
API.Reddit: update 'SiteSettings' to the new 'DownDetector' environment
API.ThisVid: fix subscription videos images
API.Threads: change 'heic' extension to 'jpg'
API.Twitter: add broadcasts download
API.Xhamster: fix absolute M3U8 URLs
API.YouTube: add support of personal API instances ('YouTube-operational-API') for download communities
SiteEditorForm: add 'Ctrl+Enter' hotkey to force save settings, ignoring  requirements
PluginsEnvironment.Attributes: add 'UseDownDetectorAttribute' attribute
SettingsHost: update to the new 'DownDetector' environment; add 'AvailableDownDetector' property
SettingsHostCollection: update to the new 'DownDetector' environment; minor bugs in multiprofile
SettingsCLS: add 'DownDetectorEnabled' property
2025-01-12 23:16:57 +03:00
Andy
b42832719f 2024.11.21.0
API.Instagram: code refactoring (settings); add setting to skip errors; add 'ForceUpdateUserName' and 'ForceUpdateUserInfo' properties; add 'IgnoreStoriesDownloadingErrors' to the settings; improve username update algorithm
API.OnlyFans: add 'UpdateRules401' property; update the code to handle error 401
API.YouTube: 404 error handling (community)
UserDataBase: raise event to update user in exceptions; add extra buttons for special download (limited and dated)
UserDataBind: extra buttons (UserDataBase)
UserCreatorForm: fix network paths
GlobalSettingsForm, MainFrame, SettingsCLS: add ability to change the feed opening shortcut
MainFrame: update button captions, update 'DownloadSelectedUser' function
2024-11-21 17:50:19 +03:00
Andy
aedcebc781 2024.10.24.0
YT
YouTubeSettings: add 'DefaultVideoAllowWebm' and 'DefaultAudioEmbedThumbnail_Cover' settings
YouTubeMediaContainerBase: change cover selection for music download; fix adding incorrect playlist lines; allow 'webm' formats is there are no 'mp4' formats via http protocol

SCrawler
DeclaredNames: add new names
UserDataBase: add '_ForceSaveUserInfoOnException' field  and 'UpdateUserInformation_Ex' function to update user info on exception; clear '_MD5List' when clearing data and/or history
API.Instagram: add manual 'UserName' changing; mark user as non-existent if user ID cannot be obtained
API.Twitter: add manual 'UserName' changing
API.Mastodon: bypass inherited property
API.Reddit: fix incorrect UNIX date parsing
DownloadFeedForm: add exception handling to the 'RefillAfterDelete' function
MainFrame: add 'MENU_INFO_USER_SEARCH' to the 'Info' menu
SettingsHostCollection: fix a bug when changing data paths
2024-10-24 19:18:29 +03:00
Andy
00a06d3e9a 2024.9.2.0
Instagram: add options to enable/disable image extraction from video
OnlyFans: update to the changed API
YouTube: videos are parsed from the 'featured', not from the 'videos' page
Feed: add prompt before moving entire feed/session
MainFrame: add 'Alt+U' and 'Ctrl+U' to open the user search form
UserImage: user image creation update
2024-09-02 18:22:11 +03:00
Andy
2055461829 Update FAQ.md 2024-08-14 13:12:25 +03:00
Andy
723155e20c Update FAQ.md 2024-08-14 12:27:05 +03:00
Andy
effaa3b65b Update FAQ 2024-08-14 11:45:00 +03:00
Andy
e285de10f6 2024.8.10.0
YT
Fix bug when video is parsed using cookies but not downloaded

SCrawler
Feed: add a button to open file folder
2024-08-10 13:36:31 +03:00
Andy
26db0e3e24 2024.8.1.0
Feed: add the ability to set PostUrl for data when moving a file and/or adding to a feed
TDownloader: add 'PostUrl' property to 'UserMediaD'
2024-08-01 20:41:51 +03:00
Andy
0b0933b6f0 2024.7.24.0
YT
YouTubeSettings: add 'DefaultVideoConvertNonAVC' property; fix 'OpenFolderInOtherProgram' property serialize and reset; add 'MusicPlaylistCreate_CreationMode' property
Update the 'CleanFileName' function to remove line breaks
Add the ability to convert non-avc codecs to avc
Add 'M3U8CreationMode' enum

SCrawler
API.OnlyFans: fix incorrect delimiter (rules parsing)
API.Threads: add saved posts downloading
Feed: add the hotkeys 'Esc' and 'Ctrl+W' to close the form; add the ability to search for missing files in special feeds
Scheduler: add the ability to execute a script after the scheduler plan is executed
Settings: add enable/disable the use of the 'Esc' to close the feed; add 'AutomationScript' and 'AutomationScript_ExcludeManual' properties
MainFrame: add the hotkey 'Ctrl+F' to show the feed; change the hotkey from 'Ctrl+F' to 'Alt+F' to show the search form
2024-07-24 23:40:53 +03:00
Andy
3ce9c55575 Update OF DynamicRules 2024-07-08 22:35:28 +03:00
Andy
ef36a11566 Update OF DynamicRules 2024-07-07 09:36:10 +03:00
Andy
dea14d35af 2024.6.25.0
API.OnlyFans: new dynamic rules updating algo
API.Instagram: update settings
Feed: add ability to set the last session as the current one; wrong marking data as saved posts when moving a file
2024-06-25 11:46:33 +03:00
Andy
744698c99e 2024.6.13.0
Remove compatibility of settings of older versions
2024-06-13 12:16:38 +03:00
Andy
aef4ce1c8f 2024.6.10.0
YT
YouTubeSettings: add 'VideoPlaylist_AddExtractedMP3' property
MediaItem: improve visualization of height and bitrate
YouTubeMediaContainerBase: fix bugs on default post-processing formats; add 'HeightBase' and 'BitrateBase' properties; add extracted MP3 to playlist
VideoListForm: add 'UpdateLogButton' handlers

SCrawler
Feed: add settings to show/hide site name and file type from media title; add move/copy files of a loaded feed/session to another location; add the ability to reset current session
DownloadFeedForm: when moving saved posts files without replacing the profile, some data is lost
FeedVideo: add double-click handler to open video in external player
API.Instagram: update settings
2024-06-10 08:40:40 +03:00
Andy
93ea2a55ac 2024.6.6.0
YT
VideoOptionsForm: file path is cleared when the cancel button is clicked (browse button); remove the context menu when the right clicking on browse button; add 'ButtonRC' class

SCrawler
API.OnlyFans: add check config to the SiteSettings; update config; add 'Keydb_Api' property; reset 'LastDateUpdated' when rules change; add support 'prefix/suffix' and 'start/end' to support other rules formats
DownloadFeedForm: update 'BTT_CURR_SESSION_SET_Click' function
TDownloader: update 'FilesLoadLastSession' function
2024-06-06 05:49:50 +03:00
Andy
2ae8c3acfc 2024.6.4.0
API.Twitter: add communities downloading, change post opening URL
Feed: add the ability to select one of the download sessions and set it as the current session
2024-06-04 03:28:05 +03:00
Andy
53dcb3e2c6 2024.6.2.0
YT
Add 'FileAddDateToFileName', 'FileAddDateToFileName_VideoForm' and 'FileAddDateToFileName_VideoList' properties
Update 'YouTubeMediaContainerBase', 'VideoOptionsForm' and 'MediaItem' (new options)

SCrawler
API.Instagram: update settings values
API.Reddit: fix 'ReparseMissing' function (remove bearer token)
2024-06-02 01:19:41 +03:00
Andy
ca384e54d6 2024.5.29.0
YT
Trim urls to get rid of 'cr' & 'lf'
Get the correct 'music' url for 'url' files

SCrawler
Remove the no longer needed 'MainFrameObj.UpdateLogButton' from the classes
ProfileSaved: swap the 'ReadyToDownload' and 'Available' checks; remove the 'DownloadStarted' and 'DownloadDone' calls because they are called in the root function
API.Instagram: improve availability checking
API.Twitter: fix deleting user directory when redownloading missing posts
AutoDownloader: improve statuses; move the check thread to the scheduler; add highlighting of scheduler plans (working, stopped, pending, etc.); replace 'ListBox' with 'ListView'; highlight undownloaded plans in gray
2024-05-29 02:45:37 +03:00
Andy
5a1b5c828a 2024.5.25.0
Move files to another directory
2024-05-25 10:06:50 +03:00
Andy
22c59b41f0 2024.5.19.0
YT
YouTubeSettings: add 'CreateDescriptionFiles_AddUploadDate' and 'CreateDescriptionFiles_CreateWithNoDescription' properties
YouTubeMediaContainerBase: add upload date to description

SCrawler
API.YouTube: 'YTSettings_Internal' is not saved when changed
2024-05-19 22:29:16 +03:00
154 changed files with 6905 additions and 2306 deletions

View File

@@ -1,17 +1,14 @@
# Contributor's Guide # Contributor's Guide
I welcome requests! Follow these steps to contribute: Follow these steps to contribute:
1. Find an [issue](https://github.com/AAndyProgram/SCrawler/issues) that needs assistance. 1. Find an [issue](https://github.com/AAndyProgram/SCrawler/issues) that needs assistance.
1. Let me know you are working on it by posting a comment on the issue. 1. Let me know you're working on this by posting a comment on this issue.
1. If you find an error in the code, please provide a link to the file and the line number. 1. If you find a bug in the code, please provide a link to the file and line number.
1. If you have a code change suggestion, you can post a replacement code block.<!-- I also accept pull requests.--> 1. If you have a code change suggestion, you can post a replacement code block.<!-- I also accept pull requests.-->
# How to report a problem # How to report a problem
1. Attach the **profile URLs or links** that you cannot download.
1. Attach the **LOG** if it exists. **[Read here](https://github.com/AAndyProgram/SCrawler/blob/main/FAQ.md#how-to-report-a-problem)**
1. **Attach the environment information copied from SCrawler (click the top right info button in the main window, then the `Environment` button, then the `Copy` button, and paste the copied text into the issue).**
1. *Add screenshots to illustrate the problem (**optional**)*
# How to build from source # How to build from source
1. Delete the `PersonalUtilities` project from the solution. 1. Delete the `PersonalUtilities` project from the solution.
@@ -30,7 +27,7 @@ I welcome requests! Follow these steps to contribute:
**I'm currently not accepting requests to develop new sites.** **I'm currently not accepting requests to develop new sites.**
1. Check [issues](https://github.com/AAndyProgram/SCrawler/issues) (open and [closed](https://github.com/AAndyProgram/SCrawler/issues?q=is%3Aissue+is%3Aclosed)) and [discussions](https://github.com/AAndyProgram/SCrawler/discussions) to find your issue. Perhaps I have already answered your request. 1. Check [issues](https://github.com/AAndyProgram/SCrawler/issues) (open and [closed](https://github.com/AAndyProgram/SCrawler/issues?q=is%3Aissue+is%3Aclosed)) and [discussions](https://github.com/AAndyProgram/SCrawler/discussions) to find your issue. Perhaps I have already answered your request.
1. If you don't find anything, create a new issue with your request. I usually reply as soon as possible (within the next few hours). 1. If you don't find anything, create a new issue with your request.
# Requirements for new site requests # Requirements for new site requests

View File

@@ -1,3 +1,239 @@
# 2025.2.25.0
*2025-02-25*
- Added
- Sites:
- **Bluesky**
- Facebook: **`Reels` downloads**
- OnlyFans: default value for `App-Token`
- Pinterest: **sub-boards downloading**
- Threads: ability to manually change `UserName`
- Twitter:
- new icon support
- **sleep timers to fully download large profiles**
- Feed:
- ability to invert selection
- open post URL when double-clicking on subscription image
- Minor improvements
- Updated
- yt-dlp up to version **2025.02.19**
- gallery-dl up to version **1.28.5**
- PluginProvider
- `IPluginContentProvider`: added property `NameTrue`
- Fixed
- Sites:
- Facebook: videos are not downloading
- LPSG: simplified 403 error
- PornHub: photos & videos are not downloading
- Reddit: **token does not update automatically**
- Threads: **data is not downloading**
- Minor bugs
# 2025.1.12.0
*2025-01-12*
- Added
- Sites:
- YouTube (standalone app):
- ability to add channel name to file name (`Add channel to file name`)
- adding channel name and video URL to info file
- OnlyFans: **built-in usage of DRM keys**
- Threads: automatically change `heic` extension to `jpg`
- Twitter: download broadcasts *(user option)*
- Minor improvements
- Updated
- yt-dlp up to version **2024.12.23**
- gallery-dl up to version **1.28.3**
- **OF-Scraper** up to version **3.12.9** *(you must update it personally)*
- Fixed
- Sites:
- DownDetector: fixed 403 error
- OnlyFans: **DRM videos not downloading**
- xHamster: some videos are not downloading
- YouTube: **communities are not downloading** *(see settings in wiki)*
- Minor bugs
# 2024.11.21.0
*2024-11-21*
- Added
- Sites:
- Instagram:
- setting to skip errors without disabling download *(site settings)*
- settings to force update of username and/or user information *(user settings)*
- setting to continue downloading profile if error 560 occurs while downloading user stories *(site settings)*
- improve username update algorithm
- YouTube: 404 error handling (community)
- Main window: add extra buttons for special download (limited and dated) in collection
- Global settings: ability to change the feed opening shortcut (`Ctrl+F`/`Alt+F` *(Settings - Behavior)*)
- Minor improvements
- Updated
- yt-dlp up to version **2024.11.18**
- gallery-dl up to version **1.27.7**
- Fixed
- Users: network paths aren't working
- Main window: in some cases users are not updated in the list
- Minor bugs
# 2024.10.24.0
*2024-10-24*
- Added
- YouTube (standalone app):
- settings `Embed thumbnail (cover)` and `Allow webm formats`
- changed cover selection for music downloads
- allow `webm` formats if there are no `mp4` formats via http protocol (issue #211)
- Sites:
- Instagram:
- **ability to manually change username**
- **mark user as non-existent if user `ID` cannot be obtained**
- Twitter: **ability to manually change username**
- Main window: add users search button to 'Info' menu
- Minor improvements
- Updated
- yt-dlp up to version **2024.10.22**
- gallery-dl up to version **1.27.6**
- Fixed
- YouTube (standalone app): adding incorrect playlist lines
- Reddit: incorrect UNIX date parsing
- Can't change data path (issue #206)
- Minor bugs
# 2024.9.2.0
*2024-09-02*
- Added
- Instagram: options to enable/disable image extraction from video
- Feed: **prompt before moving entire feed/session**
- Main window: hotkeys `Alt+U` and `Ctrl+U` to open the user search form
- Minor improvements
- Updated
- gallery-dl up to version **1.27.3**
- Fixed
- **OnlyFans**: data is not downloading
- YouTube (SCrawler): incorrect parsing of video page
- Minor bugs
# 2024.8.10.0
*2024-08-10*
- Added
- Feed: button to open file folder
- Updated
- yt-dlp up to version **2024.08.06**
- gallery-dl up to version **1.27.2**
- Fixed
- YouTube (standalone app): **video is being parsed using cookies but is not downloading** *(Issue #205)*
# 2024.8.1.0
*2024-08-01*
- Added
- Minor improvements
- Updated
- yt-dlp up to version **2024.08.01**
# 2024.7.24.0
*2024-07-24*
- Added
- YouTube (standalone app)
- ability to convert non-`AVC` codecs (eg `VP9`) to `AVC` (`Settings` - `Defaults Video` - `Convert non-AVC codecs to AVC`)
- add the ability to set the playlist creation mode: absolute links, relative links, or both (`Settings` - `Music` - `Create M3U8: creation mode`)
- Threads: **saved posts downloading**
- Feed
- hotkeys `Esc` and `Ctrl+W` to close the form
- the ability to search for missing files in *special feeds*
- Scheduler: the ability to execute a script after the scheduler plan is executed *(`Settings` - `Behavior`)*
- Main window:
- added hotkey `Ctrl+F` to show the feed
- changed the hotkey from `Ctrl+F` to `Alt+F` to show the search form
- Updated
- yt-dlp up to version **2024.07.16**
- Fixed
- YouTube (standalone app): video files with line breaks in the name do not download correctly
- OnlyFans: rules parsing bug
- Minor bugs
# 2024.6.25.0
*2024-06-25*
**ATTENTION! To support downloading of DRM protected videos (OnlyFans), please update OF-Scraper to version [3.10.7](https://github.com/datawhores/OF-Scraper/releases/tag/3.10.7) (download `zip`, not `exe`).**
- Added
- OnlyFans: **new dynamic rules updating algorithm**
- Feed: ability to set the last session as the current one
- Updated
- gallery-dl up to version **1.27.1**
- Fixed
- Minor bugs
# 2024.6.10.0
*2024-06-10*
- Added
- YouTube (standalone app): add option to add extracted MP3 to playlist (`Settings` - `Defaults Video` - `Add extracted MP3 to playlist`)
- Feed
- settings to show/hide site name and file type from media title
- ability to move/copy files of a loaded feed/session to another location
- ability to reset current session
- Fixed
- Minor bugs
# 2024.6.6.0
*2024-06-06*
**ATTENTION!**
1. **To support downloading of DRM protected videos (OnlyFans), please update OF-Scraper to version [3.10](https://github.com/datawhores/OF-Scraper/releases/tag/3.10) (download `zip`, not `exe`).**
2. **If there is a `OFScraperConfigPattern.json` file in the SCrawler settings folder, replace the text of the file with [this text](https://github.com/AAndyProgram/SCrawler/blob/main/SCrawler/API/OnlyFans/OFScraperConfigPattern.json).**
3. **Set the value to `Dynamic rules` (in the site settings) = `https://raw.githubusercontent.com/Growik/onlyfans-dynamic-rules/main/rules.json`.**
- Added
- OnlyFans: new OF-Scraper option (`keydb_api`)
- Minor improvements
- Fixed
- OnlyFans: **data is not downloading**
- Minor bugs
# 2024.6.4.0
*2024-06-04*
**If you were using the [`yt-dlp-TTUser`](https://github.com/bashonly/yt-dlp-TTUser) plugin, you should remove it because this plugin was added to yt-dlp itself! Read more [here](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-requirements).**
- Added
- Added highlighting of scheduler plans (working, stopped, pending, etc.)
- YouTube (standalone app): add option to add the video upload date before/after the file name (`Settings` - `Defaults` - `Add date to file name`)
- Twitter: **`Communities` downloading**
- Feed: ability to select one of the download sessions and set it as the current session
- Minor improvements
- Updated
- yt-dlp up to version **2024.05.27**
- gallery-dl up to version **1.27.0**
- Fixed
- Twitter: deleting user directory when redownloading missing posts
- Minor bugs
# 2024.5.19.0
*2024-05-19*
- Added
- YouTube (standalone app): add upload date to description (request #192) (`Settings` - `Info` - `Create description files: add upload date`, `Create description files: create without description`).
- Fixed
- YouTube (SCrawler): advanced settings are not saved when changed
# 2024.5.18.0 # 2024.5.18.0
*2024-05-18* *2024-05-18*

163
FAQ.md
View File

@@ -1,120 +1,99 @@
# Frequently asked questions
**Please read the [GUIDE](https://github.com/AAndyProgram/SCrawler/wiki/) Before asking a question!** **Join our Discord server**: https://discord.gg/uFNUXvFFmg
<br/>*You can get help faster there!*
**Also read [here](README.md) for basic information.** # Docs
- Basic info: https://github.com/AAndyProgram/SCrawler/blob/main/README.md
- **GUIDE**: https://github.com/AAndyProgram/SCrawler/wiki/
- Settings: https://github.com/AAndyProgram/SCrawler/wiki/Settings
- Discord: https://discord.gg/uFNUXvFFmg
Most of your questions are already answered. All settings, functions, buttons and everything else described in the guide. Most of your questions are already answered. All settings, functions, buttons and everything else described in the guide.
Any other questions I will keep in this file. # Backup
I strongly recommend you to **regularly** create backup copies of the settings files. **An [example script](https://github.com/AAndyProgram/SCrawler/blob/main/Tools/ArchiveSCrawlerUsersDataFiles.bat) for this** on GitHub (you **should adapt** it to your environment, and you can use it when [SCrawler is closed](https://github.com/AAndyProgram/SCrawler/wiki/Settings#behavior)).
---- **This way you'll always have the latest backup of your settings files and can restore it if something goes wrong!**
#### Q: **HOW TO SETUP COOKIES** # How to report a problem
1. **Post your problem [here](https://github.com/AAndyProgram/SCrawler/issues) or in the [help channel](https://discord.com/channels/1124032649682493462/1124281838056259614) on our Discord server**
A: https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies 2. Attach the **profile URLs or links** that you cannot download.
3. Attach the **LOG** if it exists.
---- 4. Attach **the environment information** copied from SCrawler (click the top right info button in the main window, then the `Environment` button, then the `Copy` button, and paste the copied text into the message).
5. *Add screenshots to illustrate the problem (**optional**)*
#### Q: **Does this program have GUI or CLI.**
A: This is a GUI program.
----
#### Q: **Will CLI be added in the future?**
A: NO.
----
#### Q: **I want to add "...." site. How to request.**
<!---A: How to request a new site you can read [here](CONTRIBUTING.md#how-to-request-a-new-site)--->
**I'm currently not accepting requests to develop new sites.**
----
#### Q: **Site download failed.**
A: Check your credentials and **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**. If all settings are set, but nothing works, go to [create a new issue](https://github.com/AAndyProgram/SCrawler/issues). Don't forget to attach the LOG.
**You also can join our Discord server**: https://discord.gg/uFNUXvFFmg
<br/>*You can get help faster there!*
**ATTENTION! Issues without URLs will be closed without a response!** **ATTENTION! Issues without URLs will be closed without a response!**
---- # Most frequently questions about SCrawler
#### Q: **I have set credentials but still nothing is downloading** **If something doesn't download, always check the [SITE'S REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements) before asking questions!**
A: Click the `Start downloading` button or press `F5` *How to use: find your problem in the list and read the answer.*
---- ## General questions
- **PROFILES**
- I added a profile but **nothing downloaded** :arrow_forward: check your cookies and [site requirements](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements). If there are any optional fields that you don't fill in, do so. Still nothing works - [report it](#how-to-report-a-problem)!
- User downloading failed :arrow_forward: check your credentials and **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**. If all settings are set and nothing works, [report it](#how-to-report-a-problem). **Don't forget to attach the LOG.**
- [How to redownload user](https://github.com/AAndyProgram/SCrawler/wiki#redownload-user)
- How to **add profile** to download :arrow_forward: copy the **[profile URL](https://github.com/AAndyProgram/SCrawler/wiki#add-user)** and press `Insert` or `Ctrl+Insert`. **ALWAYS PASTE THE USER PROFILE URL**. After that select this user and press `F5` or click the `Download selected` button.
- How to download **[saved posts](https://github.com/AAndyProgram/SCrawler/wiki#saved-posts)**
- **[HOW TO ADD COOKIES](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies)**
- [How to report a problem](#how-to-report-a-problem)
- I want you to **add the site** to SCrawler :arrow_forward: **I'm not currently accepting requests to add new sites**, but you can [create a plugin](https://github.com/AAndyProgram/SCrawler/wiki/Plugins) (for your site) for SCrawler.
- What language is SCrawler written in :arrow_forward: `vb.net`
- I don't know `vb.net` and I can't write a plugin :arrow_forward: you can write a plugin in `C#`
- I have a suggestion, will it be added :arrow_forward: maybe if it interested me.
- How to name files using a pattern (e.g. `Site_PostID_Name.jpg`) :arrow_forward: **there is no such functionality and there are no such plans**.
- **DON'T CHANGE THE DEFAULT SITE SETTINGS UNLESS YOU KNOW EXACTLY WHAT YOU'RE DOING!** SCrawler already has all the default settings to work. You only need to add credentials (where [required](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)).
- My computer shut down while SCrawler was running and now **SCrawler won't start or some users are missing** :arrow_forward: restore user settings from [backup](#backup).
- Installation, update and configuration
- How to install: https://github.com/AAndyProgram/SCrawler#installation
- How to update: https://github.com/AAndyProgram/SCrawler#updating
- What file executes the program: **`SCrawler.exe`**
- Where to find binaries: https://github.com/AAndyProgram/SCrawler/releases/latest
- [How to build from source](https://github.com/AAndyProgram/SCrawler/blob/main/CONTRIBUTING.md#how-to-build-from-source)
- [Video how to configure](#video-how-to-configure)
- **Antivirus**
- **Antivirus detects SCrawler as a virus** :arrow_forward: SCrawler doesn't contain any viruses at all. All code is posted on GitHub. You can review it. I have nothing to hide. SCrawler just downloads pictures and videos. That's all. If you trust SCrawler, you should just add it to the antivirus exceptions, as I did. Sometimes antiviruses identify SCawler as a virus. This is usually related to the number of files being edited (users' settings files) and the number of files being downloaded. In this case, the antivirus can also remove these files, which will damage users' settings. **If you don't trust SCrawler, just delete it.**
- **Antivirus detects gallery-dl as a virus** :arrow_forward: it's a trustworthy program that is trusted by thousands of people around the world. Antiviruses identify some builds as containing viruses, but this is not true. **If you don't trust gallery-dl, you can simply delete it. But if you delete it, you won't be able to download [Twitter & Pinterest](https://github.com/AAndyProgram/SCrawler/wiki/Settings#gallery-dl).** You should decide for yourself.
#### Q: **Where can I find the release?** ## Sites questions
A: https://github.com/AAndyProgram/SCrawler/releases/latest *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).
- **META** (**Instagram**, Threads, Facebook): you need **cookies** and fill in **all fields**
- **Instagram [TIPS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram-tips)**
- **Instagram saved posts**: I don't consider questions like "I have 10k saved posts and only 1000 were downloaded". Download posts, remove them from saved posts, delete the `Saved posts` **settings folder**, repeat.
- TikTok: works via yt-dlp. If something doesn't download, we need to wait until yt-dlp fixes it. TikTok doesn't require cookies to download.
- Porn sites: **COOKIES**!
- ThisVid: https://github.com/AAndyProgram/SCrawler/wiki/Settings#thisvid-faq
- **OnlyFans**: cookies + **all fields** + [OF-Scraper (download the correct version that I pointed)](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper) & [mp4decrypt](https://www.bento4.com/downloads/) & **DRM keys** to download DRM protected videos. [OF-Scraper support](https://github.com/AAndyProgram/SCrawler/wiki/Settings#of-scraper-support). Also read [this](https://github.com/AAndyProgram/SCrawler/wiki/Settings#onlyfans-faq)
- **JustForFans**: **THE VIDEO ISN'T DOWNLOADING AT THE MOMENT** ([Issue](https://discord.com/channels/1124032649682493462/1205547615199039551/1231349555132366870))
#### Q: **How to run the program?** ## Other questions
A: Double-click `SCrawler.exe` ### Does the program remember the last download and check for new posts, downloading only new posts, or does the program download the entire profile every time
The program stored posts IDs in users' folders. For the first time, the program downloads the entire profile. All subsequent times the program will check for new posts and download **only new posts**!
---- ### Does this program have a GUI or CLI, and will a CLI be added in the future
This is a GUI program and **NO**, <u>CLI will not be added</u>
#### Q: **Where to find binaries?** ### How to remove the label
There is no functionality to remove an individual label. You can open the `Labels.txt` file in the program settings folder and delete any label you want. You also can delete this file (`Labels.txt`). In this case, when SCrawler is launched, the list of labels will be populated only with existing labels (from the user data files).
A: https://github.com/AAndyProgram/SCrawler/releases/latest ### How to remove a user from the blacklist
Just add that user back to the program. In the dialog box that opens, click the `Add and remove from blacklist` button.
---- ### You lost me. Your program is too complicated.
**I'm fine with that**. If the program is too complicated for you or you can't configure it, I can only suggest you find another (easier) program. I really don't mind! The program is free. I develop SCrawler for myself and publish it on GitHub because people found my program useful. If someone can't use it or doesn't like it, I'm okay with it.
#### Q: **Does the program remember the last download and check for new posts, downloading only new posts? Or does the program download the entire profile every time?** ### Add a step-by-step guide or video on how to use the program
**NO!** The guide fully covers all the functionality of SCrawler! If you don't respect my work, I don't waste my time. If you want, you can create a video tutorial and send it to me. Then I'll add it. All options and their purposes are described on the wiki. The wiki also contains a description of all the settings and how to configure them. For complex settings there is a step-by-step guide. Read the [main](README.md) information and [GUIDE](https://github.com/AAndyProgram/SCrawler/wiki/) and you won't have any problems. I've developed a program with an intuitive interface. There is a `Settings` button, download buttons, a context menu that appears when you right-click on a user, and other controls. Anyone can use it.
A: The program stored posts IDs in users' folders. For the first time, the program downloads the entire profile. All subsequent times the program will check for new posts and download **only new posts**! **There is already a [video](#video-how-to-configure) example of how to configure a site.**
---- # Video how to configure
#### Q: **How to redownload all data**
A: https://github.com/AAndyProgram/SCrawler/wiki#redownload-user
----
#### Q: **How to remove the label**
A: There is no functionality to remove an individual label. You can open the `Labels.txt` file in the program settings folder and delete any label you want. You also can delete this file (`Labels.txt`). In this case, when the program starts, the list of labels list will be updated with only existing labels (from the user data files).
----
#### Q: **How to remove a user from the blacklist**
A: Just add that user back to the program. In the dialog box that opens, click on the `Add and remove from blacklist` button.
----
#### Q: **Why don't you answer how it works**
A: Because **I don't want to**. I don't want to waste my time explaining things that are already covered in the **[GUIDE](https://github.com/AAndyProgram/SCrawler/wiki)**! If you didn't bother to read the guide, why would I waste my time?! ALL FUNCTIONALITY IS DESCRIBED IN THE GUIDE. Before publishing a new release, I update the guide. If you don't respect my work, I don't waste my time.
----
#### Q: **You lost me. Your program is too complicated.**
A: **I'm fine with that**. If the program is difficult for you or you can't configure it, I can only suggest you find another (easier) program. I really don't mind! The program is free. I am develop SCrawler for myself and publish on GitHub because people found my program useful. If someone can't use it or doesn't like it, I'm fine.
----
#### Q: **I can't configure something**
A: I can only [suggest](#q-you-lost-me-your-program-is-too-complicated) you find another (easier) program.
----
#### Q: **Can you add a step-by-step guide or video on how to use the program?**
A: **NO!** The guide fully covers all the functionality of SCrawler! If you don't respect my work, I don't waste my time. If you want, you can create a video tutorial and send it to me. Then I add it. All options and what each option does described on the wiki. The wiki also contains a description of all settings and how-to configure them. For complex settings, there is a steep-by-steep guide. Read the [main](README.md) information and [GUIDE](https://github.com/AAndyProgram/SCrawler/wiki/) and you won't have any problems. I have developed a program with an intuitive interface. There is a Settings button, download buttons, a context menu that drops down when a user is clicked, and other controls. Anyone can use it.
**The following video was recorded by a user who loves SCrawler and demonstrates how to add credentials using Instagram as an example:** **The following video was recorded by a user who loves SCrawler and demonstrates how to add credentials using Instagram as an example:**

Binary file not shown.

Before

Width:  |  Height:  |  Size: 20 KiB

After

Width:  |  Height:  |  Size: 19 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 19 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 20 KiB

After

Width:  |  Height:  |  Size: 22 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 20 KiB

After

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 26 KiB

After

Width:  |  Height:  |  Size: 27 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 40 KiB

After

Width:  |  Height:  |  Size: 46 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 30 KiB

After

Width:  |  Height:  |  Size: 31 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 25 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 20 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 25 KiB

After

Width:  |  Height:  |  Size: 31 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 21 KiB

After

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 14 KiB

View File

@@ -1,5 +1,5 @@
<!-- # :rainbow_flag: Happy LGBT Pride Month :tada: # 🏳️‍🌈 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)
@@ -33,16 +33,17 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
![YouTube application](ProgramScreenshots/AppYouTube.png) ![YouTube application](ProgramScreenshots/AppYouTube.png)
# What can program do: # What can program do:
- Download pictures and videos from users' profiles and subreddits: - Download pictures and videos from user profiles:
- YouTube videos, shorts, community feeds, users, artists, playlists, music, tracks; - YouTube videos, shorts, community feeds, users, artists, playlists, music, tracks;
- Reddit images, galleries of images, videos, saved posts; - Reddit images, galleries of images, videos, saved posts;
- Redgifs videos (https://www.redgifs.com/); - Redgifs images and videos (https://www.redgifs.com/);
- Twitter images and videos, saved (bookmarked) posts; - Twitter images and videos, saved (bookmarked) posts, likes, communities;
- OnlyFans images and videos, saved (bookmarked) posts; - Bluesky images and videos;
- OnlyFans images and videos, 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; - Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories, saved posts; - Instagram images and videos, tagged posts, stories, saved posts;
- Threads images and videos; - Threads images and videos, saved posts;
- Facebook images and videos, stories, saved posts; - Facebook images and videos, stories, saved posts;
- TikTok videos; - TikTok videos;
- Pinterest boards, users, saved posts; - Pinterest boards, users, saved posts;
@@ -57,7 +58,7 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- Download [saved posts](https://github.com/AAndyProgram/SCrawler/wiki/Home#saved-posts) - Download [saved posts](https://github.com/AAndyProgram/SCrawler/wiki/Home#saved-posts)
- Add users from parsed channel - Add users from parsed channel
- **Advanced user management** - **Advanced user management**
- **Automation** ([downloading data automatically](https://github.com/AAndyProgram/SCrawler/wiki/Settings#automation) every ```X``` minutes) - **Automation** ([downloading data automatically](https://github.com/AAndyProgram/SCrawler/wiki/Settings#automation) every `X` minutes)
- **Feed** ([feed](https://github.com/AAndyProgram/SCrawler/wiki#feed) of downloaded media files and subscriptions posts) - **Feed** ([feed](https://github.com/AAndyProgram/SCrawler/wiki#feed) of downloaded media files and subscriptions posts)
- Multiple accounts support - Multiple accounts support
- Labeling users - Labeling users
@@ -78,16 +79,17 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **YouTube Music** - **YouTube Music**
- **Reddit** - **Reddit**
- **Twitter** - **Twitter**
- **Bluesky**
- **OnlyFans** *(partial support)*[^1] - **OnlyFans** *(partial support)*[^1]
- **Mastodon**
- **Instagram** - **Instagram**
- **Threads** - **Threads**
- **Facebook** - **Facebook**
- JustForFans *(partial support)*[^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 - Imgur *(out of support)*
- Gfycat - Gfycat
- LPSG - LPSG
- **PornHub** - **PornHub**
@@ -109,7 +111,7 @@ First, the program downloads the full profile. After the program downloads only
# Requirements # Requirements
- Windows 10, 11 with NET Framework 4.6.1 or higher (v4.6.1 must be installed). You can check version compatibility with this [tool](Tools/NET.FrameworkVersion.ps1). - **Windows 10, 11** with NET Framework 4.6.1 or higher (v4.6.1 must be installed). You can check version compatibility with this [tool](Tools/NET.FrameworkVersion.ps1).
- **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)** - **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
# Guide # Guide
@@ -131,6 +133,7 @@ First, the program downloads the full profile. After the program downloads only
- **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)** - **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
- [Reddit](https://github.com/AAndyProgram/SCrawler/wiki/Settings#reddit) - [Reddit](https://github.com/AAndyProgram/SCrawler/wiki/Settings#reddit)
- [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)
- [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) - [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)
@@ -157,7 +160,7 @@ First, the program downloads the full profile. After the program downloads only
**Just download the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest), unzip the program archive to any folder and enjoy.** :blush: **Just download the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest), unzip the program archive to any folder and enjoy.** :blush:
**Don't put program in the ```Program Files``` system folder (this is portable program and program settings are stored in the program folder)** **Don't put program in the `Program Files` system folder (this is portable program and program settings are stored in the program folder)**
**I highly doubt you can run SCrawler on Linux or Mac. SCrawler is a program that is heavily dependent on Windows.** **I highly doubt you can run SCrawler on Linux or Mac. SCrawler is a program that is heavily dependent on Windows.**
@@ -183,7 +186,7 @@ The program has an intuitive interface.
[![How to configure](https://img.youtube.com/vi/XDn7zG4I700/0.jpg)](https://www.youtube.com/watch?v=XDn7zG4I700) [![How to configure](https://img.youtube.com/vi/XDn7zG4I700/0.jpg)](https://www.youtube.com/watch?v=XDn7zG4I700)
Just add a user profile and **click the ```Download``` button**. Just add a user profile and **click the `Download` button**.
```mermaid ```mermaid
stateDiagram stateDiagram
@@ -215,16 +218,4 @@ F5-->[*]
Discord server: https://discord.gg/uFNUXvFFmg Discord server: https://discord.gg/uFNUXvFFmg
<!--
[e-mail](mailto:andyprogram@proton.me): andyprogram@proton.me
Matrix (Element): https://matrix.to/#/@andyprogram:matrix.org
Discord (contact the developer): andyprogram
Discord server: https://discord.gg/uFNUXvFFmg
[Wire](https://account.wire.com/user-profile/?id=93985052-cf2c-4b72-ac75-bbe3231cf544): @andyprogram
-->
[^1]: Partial support means that I don't have personal accounts on paid porn sites because I don't pay for porn. If this site has stopped downloading and you want me to fix it, please be ready to give me access to an account with at least one active subscription. Otherwise, the download from this site will not be fixed. [^1]: Partial support means that I don't have personal accounts on paid porn sites because I don't pay for porn. If this site has stopped downloading and you want me to fix it, please be ready to give me access to an account with at least one active subscription. Otherwise, the download from this site will not be fixed.

View File

@@ -17,6 +17,7 @@ Namespace Plugin
Property Settings As ISiteSettings Property Settings As ISiteSettings
Property AccountName As String Property AccountName As String
Property Name As String Property Name As String
Property NameTrue As String
Property ID As String Property ID As String
Property Options As String Property Options As String
Property ParseUserMediaOnly As Boolean Property ParseUserMediaOnly As Boolean

View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("Plugin provider for SCrawler")> <Assembly: AssemblyDescription("Plugin provider for SCrawler")>
<Assembly: AssemblyCompany("AndyProgram")> <Assembly: AssemblyCompany("AndyProgram")>
<Assembly: AssemblyProduct("SCrawler.PluginProvider")> <Assembly: AssemblyProduct("SCrawler.PluginProvider")>
<Assembly: AssemblyCopyright("Copyright © 2024")> <Assembly: AssemblyCopyright("Copyright © 2025")>
<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("2024.5.18.0")> <Assembly: AssemblyVersion("2025.2.25.0")>
<Assembly: AssemblyFileVersion("2024.5.18.0")> <Assembly: AssemblyFileVersion("2025.2.25.0")>
<Assembly: NeutralResourcesLanguage("en")> <Assembly: NeutralResourcesLanguage("en")>

View File

@@ -78,6 +78,17 @@ Namespace API.YouTube.Base
https = 1 https = 1
m3u8 = 2 m3u8 = 2
End Enum End Enum
<Editor(GetType(EnumDropDownEditor), GetType(UITypeEditor))>
Public Enum FileDateMode As Integer
None = 0
Before = 1
After = 2
End Enum
Public Enum M3U8CreationMode As Integer
Relative = 0
Absolute = 1
Both = 2
End Enum
Public Structure MediaObject : Implements IIndexable, IComparable(Of MediaObject) Public Structure MediaObject : Implements IIndexable, IComparable(Of MediaObject)
Public Type As Plugin.UserMediaTypes Public Type As Plugin.UserMediaTypes
Public ID As String Public ID As String

View File

@@ -22,6 +22,7 @@ Namespace API.YouTube.Base
End Sub End Sub
Public Shared Function StandardizeURL(ByVal URL As String) As String Public Shared Function StandardizeURL(ByVal URL As String) As String
Try Try
URL = URL.StringTrim
Dim isMusic As Boolean = False, isShorts As Boolean = False Dim isMusic As Boolean = False, isShorts As Boolean = False
If Info_GetUrlType(URL, isMusic, isShorts) = YouTubeMediaType.Single Then If Info_GetUrlType(URL, isMusic, isShorts) = YouTubeMediaType.Single Then
If Not isMusic And Not isShorts Then If Not isMusic And Not isShorts Then
@@ -45,6 +46,7 @@ Namespace API.YouTube.Base
End Function End Function
Public Shared Function StandardizeURL_Channel(ByVal URL As String, Optional ByVal Process As Boolean = True) As String Public Shared Function StandardizeURL_Channel(ByVal URL As String, Optional ByVal Process As Boolean = True) As String
Try Try
URL = URL.StringTrim
Dim ct As YouTubeChannelTab = YouTubeChannelTab.All Dim ct As YouTubeChannelTab = YouTubeChannelTab.All
Dim isMusic As Boolean = False Dim isMusic As Boolean = False
If Process AndAlso Info_GetUrlType(URL, isMusic,,,, ct) = YouTubeMediaType.Channel AndAlso Not isMusic Then If Process AndAlso Info_GetUrlType(URL, isMusic,,,, ct) = YouTubeMediaType.Channel AndAlso Not isMusic Then
@@ -72,6 +74,7 @@ Namespace API.YouTube.Base
Public Shared Function Info_GetUrlType(ByVal URL As String, Optional ByRef IsMusic As Boolean = False, Optional ByRef IsShorts As Boolean = False, Public Shared Function Info_GetUrlType(ByVal URL As String, Optional ByRef IsMusic As Boolean = False, Optional ByRef IsShorts As Boolean = False,
Optional ByRef IsChannelUser As Boolean = False, Optional ByRef Id As String = Nothing, Optional ByRef IsChannelUser As Boolean = False, Optional ByRef Id As String = Nothing,
Optional ByRef ChannelOptions As YouTubeChannelTab = YouTubeChannelTab.All) As YouTubeMediaType Optional ByRef ChannelOptions As YouTubeChannelTab = YouTubeChannelTab.All) As YouTubeMediaType
URL = URL.StringTrim
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
IsMusic = URL.Contains("music.youtube.com") IsMusic = URL.Contains("music.youtube.com")
IsChannelUser = False IsChannelUser = False
@@ -118,6 +121,7 @@ Namespace API.YouTube.Base
Optional ByVal Token As Threading.CancellationToken = Nothing, Optional ByVal Progress As IMyProgress = Nothing, Optional ByVal Token As Threading.CancellationToken = Nothing, Optional ByVal Progress As IMyProgress = Nothing,
Optional ByVal DateAfter As Date? = Nothing, Optional ByVal DateBefore As Date? = Nothing, Optional ByVal DateAfter As Date? = Nothing, Optional ByVal DateBefore As Date? = Nothing,
Optional ByVal ChannelOption As YouTubeChannelTab? = Nothing, Optional ByVal UrlAsIs As Boolean = False) As IYouTubeMediaContainer Optional ByVal ChannelOption As YouTubeChannelTab? = Nothing, Optional ByVal UrlAsIs As Boolean = False) As IYouTubeMediaContainer
URL = URL.StringTrim
If URL.IsEmptyString Then Throw New ArgumentNullException("URL", "URL cannot be null") If URL.IsEmptyString Then Throw New ArgumentNullException("URL", "URL cannot be null")
If Not MyYouTubeSettings.YTDLP.Value.Exists Then Throw New IO.FileNotFoundException("Path to 'yt-dlp.exe' not set or program not found at destination", MyYouTubeSettings.YTDLP.Value.ToString) If Not MyYouTubeSettings.YTDLP.Value.Exists Then Throw New IO.FileNotFoundException("Path to 'yt-dlp.exe' not set or program not found at destination", MyYouTubeSettings.YTDLP.Value.ToString)
Dim urlOrig$ = URL Dim urlOrig$ = URL
@@ -162,7 +166,7 @@ Namespace API.YouTube.Base
If result Then If result Then
container.Parse(Nothing, _CachePathDefault, isMusic, Token, Progress) container.Parse(Nothing, _CachePathDefault, isMusic, Token, Progress)
If Not container.HasError Then container.URL = URL : container.IsShorts = isShorts : Return container If Not container.HasError Then container.URL = URL.ToMusicUrl(isMusic) : container.IsShorts = isShorts : Return container
End If End If
container.Dispose() container.Dispose()
End If End If

View File

@@ -131,22 +131,28 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible(False), Category("EnvironmentFolder"), DisplayName("Open folders in another program"), DefaultValue(False)> <Browsable(True), GridVisible(False), Category("EnvironmentFolder"), DisplayName("Open folders in another program"), DefaultValue(False)>
Private Property IDownloaderSettings_OpenFolderInOtherProgram As Boolean Implements IDownloaderSettings.OpenFolderInOtherProgram Private Property IDownloaderSettings_OpenFolderInOtherProgram As Boolean Implements IDownloaderSettings.OpenFolderInOtherProgram
Get Get
Return OpenFolderInOtherProgram.Use Return OpenFolderInOtherProgram.Attribute.ValueTemp
End Get End Get
Set(ByVal use As Boolean) Set(ByVal use As Boolean)
OpenFolderInOtherProgram.Use = use OpenFolderInOtherProgram.Attribute.ValueTemp = use
End Set End Set
End Property End Property
Private Function ShouldSerializeIDownloaderSettings_OpenFolderInOtherProgram() As Boolean
Return DirectCast(OpenFolderInOtherProgram.Attribute, IGridValue).ShouldSerializeValue
End Function
<Browsable(True), GridVisible(False), Category("EnvironmentFolder"), DisplayName("Open folders in another program (command)"), <Browsable(True), GridVisible(False), Category("EnvironmentFolder"), DisplayName("Open folders in another program (command)"),
Description("The command to open a folder."), DefaultValue("")> Description("The command to open a folder."), DefaultValue("")>
Private Property IDownloaderSettings_OpenFolderInOtherProgram_Command As String Implements IDownloaderSettings.OpenFolderInOtherProgram_Command Private Property IDownloaderSettings_OpenFolderInOtherProgram_Command As String Implements IDownloaderSettings.OpenFolderInOtherProgram_Command
Get Get
Return OpenFolderInOtherProgram Return OpenFolderInOtherProgram.ValueTemp
End Get End Get
Set(ByVal command As String) Set(ByVal command As String)
OpenFolderInOtherProgram.Value = command OpenFolderInOtherProgram.ValueTemp = command
End Set End Set
End Property End Property
Private Function ShouldSerializeIDownloaderSettings_OpenFolderInOtherProgram_Command() As Boolean
Return DirectCast(OpenFolderInOtherProgram, IGridValue).ShouldSerializeValue
End Function
<Browsable(True), GridVisible(False), XMLVN({"Environment"}, True), Category("Environment"), DisplayName("Check new version at start")> <Browsable(True), GridVisible(False), XMLVN({"Environment"}, True), Category("Environment"), DisplayName("Check new version at start")>
Friend ReadOnly Property CheckUpdatesAtStart As XMLValue(Of Boolean) Friend ReadOnly Property CheckUpdatesAtStart As XMLValue(Of Boolean)
#End Region #End Region
@@ -162,6 +168,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"Info"}), Category("Info"), DisplayName("Create description files"), <Browsable(True), GridVisible, XMLVN({"Info"}), Category("Info"), DisplayName("Create description files"),
Description("Create video description files. Default: false.")> Description("Create video description files. Default: false.")>
Public ReadOnly Property CreateDescriptionFiles As XMLValue(Of Boolean) Public ReadOnly Property CreateDescriptionFiles As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Info"}, True), Category("Info"), DisplayName("Create description files: create without description"),
Description("Create a description file with the upload date, even if the description does not exist. Default: true.")>
Public ReadOnly Property CreateDescriptionFiles_CreateWithNoDescription As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Info"}, True), Category("Info"), DisplayName("Create thumbnail files (video)"), <Browsable(True), GridVisible, XMLVN({"Info"}, True), Category("Info"), DisplayName("Create thumbnail files (video)"),
Description("Create video thumbnail files. Default: true.")> Description("Create video thumbnail files. Default: true.")>
Public ReadOnly Property CreateThumbnails_Video As XMLValue(Of Boolean) Public ReadOnly Property CreateThumbnails_Video As XMLValue(Of Boolean)
@@ -179,7 +188,7 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Use cookies"), <Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Use cookies"),
Description("By default, use cookies when downloading from YouTube.")> Description("By default, use cookies when downloading from YouTube.")>
Public ReadOnly Property DefaultUseCookies As XMLValue(Of Boolean) Public ReadOnly Property DefaultUseCookies As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Defaults"}, Protocols.Any), Category("Defaults"), DisplayName("Protocol"), <Browsable(True), GridVisible, XMLVN({"Defaults"}, Protocols.https), Category("Defaults"), DisplayName("Protocol"),
Description("Priority download protocol. Default: 'Any'")> Description("Priority download protocol. Default: 'Any'")>
Public ReadOnly Property DefaultProtocol As XMLValue(Of Protocols) Public ReadOnly Property DefaultProtocol As XMLValue(Of Protocols)
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"), <Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"),
@@ -243,9 +252,21 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Program description"), <Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Program description"),
Description("Add some additional info to the program info if you need")> Description("Add some additional info to the program info if you need")>
Friend ReadOnly Property ProgramDescription As XMLValue(Of String) Friend ReadOnly Property ProgramDescription As XMLValue(Of String)
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}, "%"""), Category("Defaults"), DisplayName("Remove characters"), <Browsable(True), GridVisible, XMLVN({"Defaults"}, "%"""), Category("Defaults"), DisplayName("Remove characters"),
Description("Remove specific characters from a file name")> Description("Remove specific characters from a file name")>
Friend ReadOnly Property FileRemoveCharacters As XMLValue(Of String) Public ReadOnly Property FileRemoveCharacters As XMLValue(Of String)
<Browsable(True), GridVisible, XMLVN({"Defaults"}, FileDateMode.None), Category("Defaults"), DisplayName("Add date to file name"),
Description("Add the video upload date before/after the file name")>
Public ReadOnly Property FileAddDateToFileName As XMLValue(Of FileDateMode)
<Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Add date to title: video form"),
Description("Add video upload date before video title (visual only) in the video form")>
Public ReadOnly Property FileAddDateToFileName_VideoForm As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Add date to title: video list"),
Description("Add video upload date before video title (visual only) in the video list")>
Public ReadOnly Property FileAddDateToFileName_VideoList As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Defaults"}, FileDateMode.None), Category("Defaults"), DisplayName("Add channel to file name"),
Description("Add channel name before/after the file name")>
Public ReadOnly Property FileAddChannelToFileName As XMLValue(Of FileDateMode)
#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"),
@@ -290,6 +311,12 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, 1080), Category("Defaults Video"), DisplayName("Default definition"), <Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, 1080), Category("Defaults Video"), DisplayName("Default definition"),
Description("The default maximum video resolution. -1 for max definition")> Description("The default maximum video resolution. -1 for max definition")>
Public ReadOnly Property DefaultVideoDefinition As XMLValue(Of Integer) Public ReadOnly Property DefaultVideoDefinition As XMLValue(Of Integer)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, True), Category("Defaults Video"), DisplayName("Allow webm formats"),
Description("Allow webm formats over http if mp4 formats are not available. Default: true.")>
Public ReadOnly Property DefaultVideoAllowWebm As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}), Category("Defaults Video"), DisplayName("Convert non-AVC codecs to AVC"),
Description("Convert non-AVC codecs (eg 'VP9') to AVC. Not recommended due to high CPU usage!")>
Public ReadOnly Property DefaultVideoConvertNonAVC As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, False), Category("Defaults Video"), DisplayName("Embed thumbnail (video)"), <Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, False), Category("Defaults Video"), DisplayName("Embed thumbnail (video)"),
Description("Embed thumbnail in the video as cover art. Default: true.")> Description("Embed thumbnail in the video as cover art. Default: true.")>
Public ReadOnly Property DefaultVideoEmbedThumbnail As XMLValue(Of Boolean) Public ReadOnly Property DefaultVideoEmbedThumbnail As XMLValue(Of Boolean)
@@ -367,6 +394,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, -1), Category("Defaults Video"), DisplayName("Highlight FPS (lower)"), <Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, -1), Category("Defaults Video"), DisplayName("Highlight FPS (lower)"),
Description("Highlight frame rates lower than this value." & vbCr & "Default: -1" & vbCr & "-1 to disable")> Description("Highlight frame rates lower than this value." & vbCr & "Default: -1" & vbCr & "-1 to disable")>
Public ReadOnly Property DefaultVideoHighlightFPS_L As XMLValue(Of Integer) Public ReadOnly Property DefaultVideoHighlightFPS_L As XMLValue(Of Integer)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}), Category("Defaults Video"), DisplayName("Add extracted MP3 to playlist"),
Description("If you also extract MP3 when download the video, add the extracted MP3 to the playlist. Default: false.")>
Public ReadOnly Property VideoPlaylist_AddExtractedMP3 As XMLValue(Of Boolean)
#End Region #End Region
#Region "Defaults Audio" #Region "Defaults Audio"
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, "AAC"), Category("Defaults Audio"), DisplayName("Default codec"), <Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, "AAC"), Category("Defaults Audio"), DisplayName("Default codec"),
@@ -389,6 +419,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, True), Category("Defaults Audio"), DisplayName("Embed thumbnail"), <Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, True), Category("Defaults Audio"), DisplayName("Embed thumbnail"),
Description("Embed thumbnail in the audio as cover art. Default: true.")> Description("Embed thumbnail in the audio as cover art. Default: true.")>
Public ReadOnly Property DefaultAudioEmbedThumbnail As XMLValue(Of Boolean) Public ReadOnly Property DefaultAudioEmbedThumbnail As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, True), Category("Defaults Audio"), DisplayName("Embed thumbnail (cover)"),
Description("Try embedding the playlist cover (if it exists) as cover art. Default: true.")>
Public ReadOnly Property DefaultAudioEmbedThumbnail_Cover As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, True), Category("Defaults Audio"), DisplayName("Embed thumbnail (extracted files)"), <Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, True), Category("Defaults Audio"), DisplayName("Embed thumbnail (extracted files)"),
Description("Embed thumbnail in the extracted (additional file ('mp3' only)) audio as cover art. Default: true.")> Description("Embed thumbnail in the extracted (additional file ('mp3' only)) audio as cover art. Default: true.")>
Public ReadOnly Property DefaultAudioEmbedThumbnail_ExtractedFiles As XMLValue(Of Boolean) Public ReadOnly Property DefaultAudioEmbedThumbnail_ExtractedFiles As XMLValue(Of Boolean)
@@ -414,6 +447,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"Playlists"}), Category("Music"), DisplayName("M3U8 Append file number"), <Browsable(True), GridVisible, XMLVN({"Playlists"}), Category("Music"), DisplayName("M3U8 Append file number"),
Description("Add file number to file name. Default: false.")> Description("Add file number to file name. Default: false.")>
Public ReadOnly Property MusicPlaylistCreate_M3U8_AppendNumber As XMLValue(Of Boolean) Public ReadOnly Property MusicPlaylistCreate_M3U8_AppendNumber As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Playlists"}, M3U8CreationMode.Relative), Category("Music"), DisplayName("Create M3U8: creation mode"),
Description("Set the playlist creation mode: absolute links, relative links, or both. If 'Both' is selected, two playlists will be created. Default: 'Relative'.")>
Public ReadOnly Property MusicPlaylistCreate_CreationMode As XMLValue(Of M3U8CreationMode)
#End Region #End Region
#End Region #End Region
#Region "Defaults Subtitles" #Region "Defaults Subtitles"

View File

@@ -0,0 +1,23 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.YouTube.Controls
Public Class ButtonRC : Inherits Button
Private Const WM_CONTEXTMENU As Integer = 123 '&H7B
Private Const WM_CANCELMODE As Integer = 31 '&H1F
Private Const WM_INITMENUPOPUP As Integer = 279 '&H117
Private Const SMTO_NOTIMEOUTIFNOTHUNG As Integer = 8
Protected Overrides Sub WndProc(ByRef m As Message)
If m.Msg = WM_CONTEXTMENU Or m.Msg = WM_CANCELMODE Or m.Msg = WM_INITMENUPOPUP Or m.Msg = SMTO_NOTIMEOUTIFNOTHUNG Then
m.Result = IntPtr.Zero
Else
MyBase.WndProc(m)
End If
End Sub
End Class
End Namespace

View File

@@ -121,9 +121,10 @@ Namespace API.YouTube.Controls
Me.TXT_LIMIT.Location = New System.Drawing.Point(3, 3) Me.TXT_LIMIT.Location = New System.Drawing.Point(3, 3)
Me.TXT_LIMIT.Name = "TXT_LIMIT" Me.TXT_LIMIT.Name = "TXT_LIMIT"
Me.TXT_LIMIT.PlaceholderEnabled = True Me.TXT_LIMIT.PlaceholderEnabled = True
Me.TXT_LIMIT.PlaceholderText = "e.g. ABCDE" Me.TXT_LIMIT.PlaceholderText = "e.g. RDAMP"
Me.TXT_LIMIT.Size = New System.Drawing.Size(378, 22) Me.TXT_LIMIT.Size = New System.Drawing.Size(378, 22)
Me.TXT_LIMIT.TabIndex = 2 Me.TXT_LIMIT.TabIndex = 2
Me.TXT_LIMIT.Text = "RDAMP"
' '
'CONTAINER_MAIN 'CONTAINER_MAIN
' '

View File

@@ -65,11 +65,11 @@ Namespace API.YouTube.Controls
Me.LBL_TIME = New System.Windows.Forms.Label() Me.LBL_TIME = New System.Windows.Forms.Label()
Me.LBL_URL = New System.Windows.Forms.LinkLabel() Me.LBL_URL = New System.Windows.Forms.LinkLabel()
Me.TXT_FILE = New PersonalUtilities.Forms.Controls.ComboBoxExtended() Me.TXT_FILE = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.BTT_BROWSE = New System.Windows.Forms.Button() Me.BTT_BROWSE = New SCrawler.API.YouTube.Controls.ButtonRC()
Me.BTT_DOWN = New System.Windows.Forms.Button() Me.BTT_DOWN = New System.Windows.Forms.Button()
Me.BTT_CANCEL = New System.Windows.Forms.Button() Me.BTT_CANCEL = New System.Windows.Forms.Button()
Me.CMB_PLS = New PersonalUtilities.Forms.Controls.ComboBoxExtended() Me.CMB_PLS = New PersonalUtilities.Forms.Controls.ComboBoxExtended()
Me.BTT_PLS_BROWSE = New System.Windows.Forms.Button() Me.BTT_PLS_BROWSE = New SCrawler.API.YouTube.Controls.ButtonRC()
Me.OPT_VIDEO = New System.Windows.Forms.RadioButton() Me.OPT_VIDEO = New System.Windows.Forms.RadioButton()
Me.OPT_AUDIO = New System.Windows.Forms.RadioButton() Me.OPT_AUDIO = New System.Windows.Forms.RadioButton()
Me.LBL_AUDIO_CODEC = New System.Windows.Forms.Label() Me.LBL_AUDIO_CODEC = New System.Windows.Forms.Label()
@@ -912,13 +912,13 @@ Namespace API.YouTube.Controls
Private WithEvents TXT_SUBS_ADDIT As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents TXT_SUBS_ADDIT As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_EXTRA_AUDIO_FORMATS As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents TXT_EXTRA_AUDIO_FORMATS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_FILE As PersonalUtilities.Forms.Controls.ComboBoxExtended Private WithEvents TXT_FILE As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents BTT_BROWSE As Button Private WithEvents BTT_BROWSE As SCrawler.API.YouTube.Controls.ButtonRC
Private WithEvents BTT_DOWN As Button Private WithEvents BTT_DOWN As Button
Private WithEvents BTT_CANCEL As Button Private WithEvents BTT_CANCEL As Button
Private WithEvents TP_HEADER_INFO_2 As TableLayoutPanel Private WithEvents TP_HEADER_INFO_2 As TableLayoutPanel
Private WithEvents TXT_FPS As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents TXT_FPS As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CMB_PLS As PersonalUtilities.Forms.Controls.ComboBoxExtended Private WithEvents CMB_PLS As PersonalUtilities.Forms.Controls.ComboBoxExtended
Private WithEvents BTT_PLS_BROWSE As Button Private WithEvents BTT_PLS_BROWSE As SCrawler.API.YouTube.Controls.ButtonRC
Private WithEvents TXT_AUDIO_BITRATE As PersonalUtilities.Forms.Controls.TextBoxExtended Private WithEvents TXT_AUDIO_BITRATE As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class End Class
End Namespace End Namespace

View File

@@ -32,6 +32,7 @@ Namespace API.YouTube.Controls
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)
Friend Property UseCookies As Boolean = False
Private ReadOnly Property M3U8FilesFull As List(Of SFile) Private ReadOnly Property M3U8FilesFull As List(Of SFile)
Get Get
Return ListAddList(Nothing, M3U8Files, LAP.NotContainsOnly).ListAddValue(CMB_PLS.Text, LAP.NotContainsOnly) Return ListAddList(Nothing, M3U8Files, LAP.NotContainsOnly).ListAddValue(CMB_PLS.Text, LAP.NotContainsOnly)
@@ -65,6 +66,7 @@ Namespace API.YouTube.Controls
CNT_PROCESSOR = New TableControlsProcessor(TP_CONTROLS) CNT_PROCESSOR = New TableControlsProcessor(TP_CONTROLS)
Me.InheritsFromContainer = InheritsFromContainer Me.InheritsFromContainer = InheritsFromContainer
MyFieldsChecker = New FieldsChecker MyFieldsChecker = New FieldsChecker
UseCookies = MyYouTubeSettings.DefaultUseCookies
End Sub End Sub
#End Region #End Region
#Region "Form handlers" #Region "Form handlers"
@@ -121,7 +123,7 @@ Namespace API.YouTube.Controls
img = ImageRenderer.GetImage(SFile.GetBytesFromNet(imgUrl, EDP.ReturnValue), EDP.ReturnValue) img = ImageRenderer.GetImage(SFile.GetBytesFromNet(imgUrl, EDP.ReturnValue), EDP.ReturnValue)
If Not img Is Nothing Then ICON_VIDEO.Image = img : ICON_VIDEO.InitialImage = img If Not img Is Nothing Then ICON_VIDEO.Image = img : ICON_VIDEO.InitialImage = img
End If End If
LBL_TITLE.Text = .Title LBL_TITLE.Text = $"{If(MyYouTubeSettings.FileAddDateToFileName_VideoForm.Value, $"[{ .DateAdded:yyyy-MM-dd}] ", String.Empty)}{ .Title}"
LBL_TIME.Text = AConvert(Of String)(.Duration, TimeToStringProvider, String.Empty) LBL_TIME.Text = AConvert(Of String)(.Duration, TimeToStringProvider, String.Empty)
TP_HEADER_INFO_2.ColumnStyles(1).Width = MeasureTextDefault(LBL_TIME.Text, LBL_TIME.Font).Width + PaddingE.GetOf({LBL_TIME}).Horizontal TP_HEADER_INFO_2.ColumnStyles(1).Width = MeasureTextDefault(LBL_TIME.Text, LBL_TIME.Font).Width + PaddingE.GetOf({LBL_TIME}).Horizontal
TP_HEADER_INFO_2.Refresh() TP_HEADER_INFO_2.Refresh()
@@ -227,7 +229,7 @@ Namespace API.YouTube.Controls
Dim data As IEnumerable(Of Control) Dim data As IEnumerable(Of Control)
If .HasElements Then If .HasElements Then
data = .Elements.Select(Function(ee) New MediaItem(ee, True) With {.Dock = DockStyle.Fill, .Checked = ee.Checked}) 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 data = (From m As MediaObject In .Self.MediaObjects
Where m.Type = __contentType Where m.Type = __contentType
@@ -610,7 +612,7 @@ Namespace API.YouTube.Controls
$"Video|{AvailableVideoFormats.Select(Function(vf) $"*.{vf.ToLower}").ListToString(";")}" & $"Video|{AvailableVideoFormats.Select(Function(vf) $"*.{vf.ToLower}").ListToString(";")}" &
$"|Audio|{AvailableAudioFormats.Select(Function(af) $"*.{af.ToLower}").ListToString(";")}" $"|Audio|{AvailableAudioFormats.Select(Function(af) $"*.{af.ToLower}").ListToString(";")}"
f = SFile.SaveAs(f, "Select the destination of the video file",, ext, sPattern, EDP.ReturnValue) f = SFile.SaveAs(f, "Select the destination of the video file",, ext, sPattern, EDP.ReturnValue)
f.Extension = ext If Not f.IsEmptyString Then f.Extension = ext
End If End If
#Enable Warning #Enable Warning
f = CleanFileName(f) f = CleanFileName(f)

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 System.Runtime.CompilerServices
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports PersonalUtilities.Forms.Toolbars Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
@@ -56,10 +57,17 @@ Namespace API.YouTube
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 ProgressProvider As IMyProgressNumberProvider = MyProgressNumberProvider.Percentage Friend ReadOnly ProgressProvider As IMyProgressNumberProvider = MyProgressNumberProvider.Percentage
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,
CType(Function(input$) "music.", Func(Of String, String)), String.Empty)
Friend ReadOnly M3U8ExcludedSymbols As String() = {".", ",", ":", "/", "\", "(", ")", "[", "]"}
<Extension> Friend Function ToMusicUrl(ByVal URL As String, ByVal IsMusic As Boolean) As String
Try : Return If(IsMusic And Not URL.IsEmptyString, CStr(RegexReplace(URL, MusicUrlApply)).IfNullOrEmpty(URL), URL) : Catch : Return URL : End Try
End Function
Friend Function CleanFileName(ByVal f As SFile) As SFile Friend Function CleanFileName(ByVal f As SFile) As SFile
If Not f.IsEmptyString And Not f.Name.IsEmptyString Then If Not f.IsEmptyString And Not f.Name.IsEmptyString Then
Dim ff As SFile = f Dim ff As SFile = f
ff.Name = ff.Name.StringRemoveWinForbiddenSymbols.StringTrim ff.Name = ff.Name.StringRemoveWinForbiddenSymbols.StringTrim
ff.Name = ff.Name.StringReplaceSymbols({vbLf, vbCr, vbCrLf}, String.Empty, EDP.ReturnValue)
ff.Name = ff.Name.StringTrimEnd(".") ff.Name = ff.Name.StringTrimEnd(".")
If Not ff.Name.IsEmptyString And Not MyYouTubeSettings.FileRemoveCharacters.IsEmptyString Then _ If Not ff.Name.IsEmptyString And Not MyYouTubeSettings.FileRemoveCharacters.IsEmptyString Then _
ff.Name = ff.Name.StringReplaceSymbols(MyYouTubeSettings.FileRemoveCharacters.Value.AsList.ListCast(Of String).ToArray, String.Empty, EDP.ReturnValue) ff.Name = ff.Name.StringReplaceSymbols(MyYouTubeSettings.FileRemoveCharacters.Value.AsList.ListCast(Of String).ToArray, String.Empty, EDP.ReturnValue)

View File

@@ -133,18 +133,25 @@ Namespace DownloadObjects.STDownloader
ICON_SITE.Image = .SiteIcon ICON_SITE.Image = .SiteIcon
LBL_TIME.Text = AConvert(Of String)(.Duration, TimeToStringProvider, String.Empty) LBL_TIME.Text = AConvert(Of String)(.Duration, TimeToStringProvider, String.Empty)
LBL_TITLE.Text = .ToString(True) LBL_TITLE.Text = $"{If(MyYouTubeSettings.FileAddDateToFileName_VideoList.Value, $"[{ .DateAdded:yyyy-MM-dd}] ", String.Empty)}{ .ToString(True)}"
Dim h%, b%
If .Self.GetType Is GetType(YouTubeMediaContainerBase) OrElse (Not .Self.GetType.BaseType Is Nothing AndAlso .Self.GetType.BaseType Is GetType(YouTubeMediaContainerBase)) Then
With DirectCast(.Self, YouTubeMediaContainerBase) : h = .HeightBase : b = .BitrateBase : End With
Else
h = .Height
b = .Bitrate
End If
If Not .SiteKey = YouTubeSiteKey And .ContentType = Plugin.UserMediaTypes.Picture Then If Not .SiteKey = YouTubeSiteKey And .ContentType = Plugin.UserMediaTypes.Picture Then
LBL_INFO.Text = .File.Extension.StringToUpper LBL_INFO.Text = .File.Extension.StringToUpper
ElseIf Not .IsMusic And Not (.MediaType = Plugin.UserMediaTypes.Audio Or .MediaType = Plugin.UserMediaTypes.AudioPre) Then ElseIf Not .IsMusic And Not (.MediaType = Plugin.UserMediaTypes.Audio Or .MediaType = Plugin.UserMediaTypes.AudioPre) Then
If .Height > 0 Then If h > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{ .Height}p" LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{h}p"
Else Else
LBL_INFO.Text = .File.Extension.StringToUpper LBL_INFO.Text = .File.Extension.StringToUpper
End If End If
Else Else
If .Bitrate > 0 Then If b > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{ .Bitrate}k" LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{b}k"
Else Else
LBL_INFO.Text = .File.Extension.StringToUpper LBL_INFO.Text = .File.Extension.StringToUpper
End If End If
@@ -221,7 +228,7 @@ Namespace DownloadObjects.STDownloader
t = 0 t = 0
End If End If
LBL_TITLE.Text = MyContainer.ToString(True) LBL_TITLE.Text = $"{If(MyYouTubeSettings.FileAddDateToFileName_VideoList.Value, $"[{ .DateAdded:yyyy-MM-dd}] ", String.Empty)}{ .ToString(True)}"
If Not .SiteKey = YouTubeSiteKey Then BTT_VIEW_SETTINGS.Visible = False If Not .SiteKey = YouTubeSiteKey Then BTT_VIEW_SETTINGS.Visible = False
@@ -430,7 +437,7 @@ Namespace DownloadObjects.STDownloader
Else Else
RaiseEvent BeforeOpenEditor(Me, MyContainer) RaiseEvent BeforeOpenEditor(Me, MyContainer)
End If End If
Using f As New VideoOptionsForm(MyContainer, initProtected Or isFull) Using f As New VideoOptionsForm(MyContainer, initProtected Or isFull) With {.UseCookies = UseCookies}
f.ShowDialog() f.ShowDialog()
.Protected = IIf(f.DialogResult = DialogResult.OK, True, initProtected) .Protected = IIf(f.DialogResult = DialogResult.OK, True, initProtected)
End Using End Using
@@ -458,12 +465,12 @@ Namespace DownloadObjects.STDownloader
If Not MyContainer Is Nothing Then If Not MyContainer Is Nothing Then
Dim f As Form = Nothing Dim f As Form = Nothing
Select Case MyContainer.ObjectType Select Case MyContainer.ObjectType
Case Base.YouTubeMediaType.Single : f = New VideoOptionsForm(MyContainer, True) Case Base.YouTubeMediaType.Single : f = New VideoOptionsForm(MyContainer, True) With {.UseCookies = UseCookies}
Case Base.YouTubeMediaType.Channel, Base.YouTubeMediaType.PlayList Case Base.YouTubeMediaType.Channel, Base.YouTubeMediaType.PlayList
If MyContainer.IsMusic Then If MyContainer.IsMusic Then
f = New MusicPlaylistsForm(MyContainer) f = New MusicPlaylistsForm(MyContainer)
Else Else
f = New VideoOptionsForm(MyContainer, True) f = New VideoOptionsForm(MyContainer, True) With {.UseCookies = UseCookies}
End If End If
End Select End Select
If Not f Is Nothing Then If Not f Is Nothing Then

View File

@@ -57,6 +57,12 @@ Namespace DownloadObjects.STDownloader
End If End If
MyNotificator = New YTNotificator(Me) MyNotificator = New YTNotificator(Me)
MyDownloaderSettings = MyYouTubeSettings MyDownloaderSettings = MyYouTubeSettings
ProgramLogInitialize()
With ProgramLog
AddHandler .TextAdded, AddressOf ProgramLog_TextAdded
AddHandler .TextCleared, AddressOf ProgramLog_TextCleared
End With
UpdateLogButton()
End If End If
With MyView : .Import() : .SetFormSize() : End With With MyView : .Import() : .SetFormSize() : End With
@@ -126,7 +132,8 @@ Namespace DownloadObjects.STDownloader
#End Region #End Region
#Region "Controls" #Region "Controls"
Protected Sub ControlCreateAndAdd(ByVal Container As IYouTubeMediaContainer, Optional ByVal DisableDownload As Boolean = False, Protected Sub ControlCreateAndAdd(ByVal Container As IYouTubeMediaContainer, Optional ByVal DisableDownload As Boolean = False,
Optional ByVal PerformClick As Boolean = True, Optional ByVal IsLoading As Boolean = False) Optional ByVal PerformClick As Boolean = True, Optional ByVal IsLoading As Boolean = False,
Optional ByVal UseCookies As Boolean = False)
ControlInvokeFast(TP_CONTROLS, Sub() ControlInvokeFast(TP_CONTROLS, Sub()
With TP_CONTROLS With TP_CONTROLS
.SuspendLayout() .SuspendLayout()
@@ -136,7 +143,7 @@ Namespace DownloadObjects.STDownloader
.RowStyles.Insert(0, New RowStyle(SizeType.Absolute, 60)) .RowStyles.Insert(0, New RowStyle(SizeType.Absolute, 60))
.RowCount = .RowStyles.Count .RowCount = .RowStyles.Count
OffsetControls(0, True) OffsetControls(0, True)
Dim cnt As New MediaItem(Container) With {.Dock = DockStyle.Fill, .Margin = New Padding(0)} Dim cnt As New MediaItem(Container) With {.Dock = DockStyle.Fill, .Margin = New Padding(0), .UseCookies = UseCookies}
AddHandler cnt.FileDownloaded, AddressOf MediaControl_FileDownloaded AddHandler cnt.FileDownloaded, AddressOf MediaControl_FileDownloaded
AddHandler cnt.Removal, AddressOf MediaControl_Removal AddHandler cnt.Removal, AddressOf MediaControl_Removal
AddHandler cnt.DownloadAgain, AddressOf MediaControl_DownloadAgain AddHandler cnt.DownloadAgain, AddressOf MediaControl_DownloadAgain
@@ -157,7 +164,7 @@ Namespace DownloadObjects.STDownloader
If PerformClick Then cnt.PerformClick() If PerformClick Then cnt.PerformClick()
If Not DisableDownload And MyDownloaderSettings.DownloadAutomatically Then AddToDownload(cnt, True) If Not DisableDownload And MyDownloaderSettings.DownloadAutomatically Then AddToDownload(cnt, True)
End With End With
End Sub, EDP.None) End Sub, EDP.SendToLog)
End Sub End Sub
#Region "Controls rendering" #Region "Controls rendering"
Private Overloads Sub OffsetControls() Private Overloads Sub OffsetControls()
@@ -247,7 +254,7 @@ Namespace DownloadObjects.STDownloader
Dim useCookiesParse As Boolean? = Nothing Dim useCookiesParse As Boolean? = Nothing
If useCookies Then useCookiesParse = True If useCookies Then useCookiesParse = True
Dim standardizeUrls As Boolean = MyYouTubeSettings.StandardizeURLs Dim standardizeUrls As Boolean = MyYouTubeSettings.StandardizeURLs
Dim standardize As Func(Of String, String) = Function(input) If(standardizeUrls, YouTubeFunctions.StandardizeURL(input), input) Dim standardize As Func(Of String, String) = Function(input) If(standardizeUrls, YouTubeFunctions.StandardizeURL(input), input.StringTrim)
Dim c As IYouTubeMediaContainer = Nothing Dim c As IYouTubeMediaContainer = Nothing
Dim url$ = String.Empty Dim url$ = String.Empty
@@ -327,19 +334,19 @@ Namespace DownloadObjects.STDownloader
If Not c Is Nothing Then If Not c Is Nothing Then
Dim f As Form Dim f As Form
Select Case c.ObjectType Select Case c.ObjectType
Case YouTubeMediaType.Single : f = New VideoOptionsForm(c) Case YouTubeMediaType.Single : f = New VideoOptionsForm(c) With {.UseCookies = useCookies}
Case YouTubeMediaType.Channel, YouTubeMediaType.PlayList Case YouTubeMediaType.Channel, YouTubeMediaType.PlayList
If c.IsMusic Then If c.IsMusic Then
f = New MusicPlaylistsForm(c) f = New MusicPlaylistsForm(c)
Else Else
f = New VideoOptionsForm(c) f = New VideoOptionsForm(c) With {.UseCookies = useCookies}
End If End If
Case Else : c.Dispose() : Throw New ArgumentException($"Object type {c.ObjectType} not implemented", "IYouTubeMediaContainer.ObjectType") Case Else : c.Dispose() : Throw New ArgumentException($"Object type {c.ObjectType} not implemented", "IYouTubeMediaContainer.ObjectType")
End Select End Select
If Not f Is Nothing Then If Not f Is Nothing Then
If TypeOf f Is IDesignXMLContainer Then DirectCast(f, IDesignXMLContainer).DesignXML = DesignXML If TypeOf f Is IDesignXMLContainer Then DirectCast(f, IDesignXMLContainer).DesignXML = DesignXML
f.ShowDialog() f.ShowDialog()
If f.DialogResult = DialogResult.OK AndAlso ValidateContainerURL(c) Then ControlCreateAndAdd(c, disableDown) If f.DialogResult = DialogResult.OK AndAlso ValidateContainerURL(c) Then ControlCreateAndAdd(c, disableDown,,, useCookies)
f.Dispose() f.Dispose()
End If End If
End If End If
@@ -449,12 +456,26 @@ Namespace DownloadObjects.STDownloader
End Try End Try
End Sub End Sub
#End Region #End Region
#Region "LOG"
Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click
MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton) MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton)
End Sub End Sub
Friend Sub UpdateLogButton() Private Sub UpdateLogButton()
If AppMode Then MyMainLOG_UpdateLogButton(BTT_LOG, TOOLBAR_TOP) If AppMode Then
Try : MyMainLOG_UpdateLogButton(BTT_LOG, TOOLBAR_TOP) : Catch : End Try
End If
End Sub End Sub
Private _LogUpdateButtonSuspended As Boolean = False
Private Sub ProgramLog_TextAdded(ByVal Sender As Object, ByVal e As EventArgs)
If Not _LogUpdateButtonSuspended Then
_LogUpdateButtonSuspended = True
Try : ControlInvokeFast(TOOLBAR_TOP, BTT_LOG, AddressOf UpdateLogButton, EDP.None) : Catch : End Try
End If
End Sub
Private Sub ProgramLog_TextCleared(ByVal Sender As Object, ByVal e As EventArgs)
_LogUpdateButtonSuspended = False
End Sub
#End Region
Private Sub BTT_BUG_REPORT_Click(sender As Object, e As EventArgs) Handles BTT_BUG_REPORT.Click Private Sub BTT_BUG_REPORT_Click(sender As Object, e As EventArgs) Handles BTT_BUG_REPORT.Click
Try Try
With MyYouTubeSettings With MyYouTubeSettings

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 © 2024")> <Assembly: AssemblyCopyright("Copyright © 2025")>
<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("2024.5.18.0")> <Assembly: AssemblyVersion("2025.2.25.0")>
<Assembly: AssemblyFileVersion("2024.5.18.0")> <Assembly: AssemblyFileVersion("2025.2.25.0")>
<Assembly: NeutralResourcesLanguage("en")> <Assembly: NeutralResourcesLanguage("en")>

View File

@@ -175,7 +175,9 @@ Namespace API.YouTube.Objects
Protected _ThumbnailUrl As String = String.Empty Protected _ThumbnailUrl As String = String.Empty
<XMLEC> Public Overridable Property ThumbnailUrl As String Implements IDownloadableMedia.ThumbnailUrl <XMLEC> Public Overridable Property ThumbnailUrl As String Implements IDownloadableMedia.ThumbnailUrl
Get Get
If _ThumbnailUrl.IsEmptyString And Thumbnails.Count > 0 Then If Not CoverURL.IsEmptyString Then
Return CoverURL
ElseIf _ThumbnailUrl.IsEmptyString And Thumbnails.Count > 0 Then
Return Thumbnails.FirstOrDefault.URL Return Thumbnails.FirstOrDefault.URL
Else Else
Return _ThumbnailUrl Return _ThumbnailUrl
@@ -267,12 +269,11 @@ Namespace API.YouTube.Objects
<XMLEC(CollectionMode:=CollectionModes.String)> <XMLEC(CollectionMode:=CollectionModes.String)>
Friend ReadOnly Property PostProcessing_OutputAudioFormats As List(Of String) Friend ReadOnly Property PostProcessing_OutputAudioFormats As List(Of String)
Friend Sub PostProcessing_OutputAudioFormats_Reset() Friend Sub PostProcessing_OutputAudioFormats_Reset()
PostProcessing_OutputAudioFormats.Clear() With PostProcessing_OutputAudioFormats
PostProcessing_OutputAudioFormats.ListAddList(MyYouTubeSettings.DefaultAudioCodecAddit) .Clear()
If PostProcessing_OutputAudioFormats.Count > 0 Then .ListAddList(MyYouTubeSettings.DefaultAudioCodecAddit)
PostProcessing_OutputAudioFormats.Sort() If .Count > 0 Then .Sort()
PostProcessing_OutputAudioFormats.RemoveAll(Function(s) s = -1) End With
End If
End Sub End Sub
<XMLEC("OutputAudioBitrate")> Protected _OutputAudioBitrate As Integer = -1 <XMLEC("OutputAudioBitrate")> Protected _OutputAudioBitrate As Integer = -1
Friend Property OutputAudioBitrate As Integer Friend Property OutputAudioBitrate As Integer
@@ -322,21 +323,19 @@ Namespace API.YouTube.Objects
<XMLEC(CollectionMode:=CollectionModes.String)> <XMLEC(CollectionMode:=CollectionModes.String)>
Friend ReadOnly Property PostProcessing_OutputSubtitlesFormats As List(Of String) Friend ReadOnly Property PostProcessing_OutputSubtitlesFormats As List(Of String)
Friend Sub PostProcessing_OutputSubtitlesFormats_Reset() Friend Sub PostProcessing_OutputSubtitlesFormats_Reset()
PostProcessing_OutputSubtitlesFormats.Clear() With PostProcessing_OutputSubtitlesFormats
PostProcessing_OutputSubtitlesFormats.ListAddList(MyYouTubeSettings.DefaultSubtitlesFormatAddit) .Clear()
If PostProcessing_OutputSubtitlesFormats.Count > 0 Then .ListAddList(MyYouTubeSettings.DefaultSubtitlesFormatAddit)
PostProcessing_OutputSubtitlesFormats.Sort() If .Count > 0 Then .Sort()
PostProcessing_OutputSubtitlesFormats.RemoveAll(Function(s) s = -1) End With
End If
End Sub End Sub
Friend Sub SubtitlesSelectedIndexesReset() Friend Sub SubtitlesSelectedIndexesReset()
SubtitlesSelectedIndexes.Clear() With SubtitlesSelectedIndexes
Dim subs As List(Of Subtitles) = Subtitles .Clear()
SubtitlesSelectedIndexes.ListAddList(MyYouTubeSettings.DefaultSubtitles.Select(Function(s) subs.FindIndex(Function(ss) ss.ID = s))) Dim subs As List(Of Subtitles) = Subtitles
If SubtitlesSelectedIndexes.Count > 0 Then .ListAddList(MyYouTubeSettings.DefaultSubtitles.Select(Function(s) subs.FindIndex(Function(ss) ss.ID = s)))
SubtitlesSelectedIndexes.Sort() If .Count > 0 Then .Sort() : .RemoveAll(Function(s) s = -1)
SubtitlesSelectedIndexes.RemoveAll(Function(s) s = -1) End With
End If
End Sub End Sub
Private Sub SetElementsSubtitles(ByVal Source As YouTubeMediaContainerBase) Private Sub SetElementsSubtitles(ByVal Source As YouTubeMediaContainerBase)
If Not Source Is Nothing And HasElements Then If Not Source Is Nothing And HasElements Then
@@ -442,6 +441,19 @@ Namespace API.YouTube.Objects
End Get End Get
End Property End Property
<XMLEC> Public Property Height As Integer Implements IYouTubeMediaContainer.Height <XMLEC> Public Property Height As Integer Implements IYouTubeMediaContainer.Height
Friend ReadOnly Property HeightBase As Integer
Get
If Height > 0 Then
Return Height
ElseIf SelectedVideoIndex.ValueBetween(0, MediaObjects.Count - 1) Then
Return SelectedVideo.Height
ElseIf SelectedAudioIndex.ValueBetween(0, MediaObjects.Count - 1) Then
Return SelectedAudio.Height
Else
Return 0
End If
End Get
End Property
Protected _Bitrate As Integer = 0 Protected _Bitrate As Integer = 0
<XMLEC> Public Overridable Property Bitrate As Integer Implements IYouTubeMediaContainer.Bitrate <XMLEC> Public Overridable Property Bitrate As Integer Implements IYouTubeMediaContainer.Bitrate
Get Get
@@ -459,6 +471,20 @@ Namespace API.YouTube.Objects
Me._Bitrate = _Bitrate Me._Bitrate = _Bitrate
End Set End Set
End Property End Property
Friend ReadOnly Property BitrateBase As Integer
Get
If Bitrate > 0 Then
Return Bitrate
ElseIf OutputAudioBitrate > 0 Then
Return OutputAudioBitrate
ElseIf HasElements Then
Try : Return Elements.Average(Function(e) DirectCast(e, YouTubeMediaContainerBase).BitrateBase) : Catch : End Try
ElseIf SelectedAudioIndex.ValueBetween(0, MediaObjects.Count - 1) Then
Return SelectedAudio.Bitrate
End If
Return 0
End Get
End Property
<XMLEC> Public Property DateCreated As Date = Now Implements IYouTubeMediaContainer.DateCreated <XMLEC> Public Property DateCreated As Date = Now Implements IYouTubeMediaContainer.DateCreated
<XMLEC> Public Property DateAdded As Date Implements IYouTubeMediaContainer.DateAdded <XMLEC> Public Property DateAdded As Date Implements IYouTubeMediaContainer.DateAdded
Private Property IUserMedia_PostDate As Date? Implements IUserMedia.PostDate Private Property IUserMedia_PostDate As Date? Implements IUserMedia.PostDate
@@ -656,6 +682,22 @@ Namespace API.YouTube.Objects
End If End If
End Set End Set
End Property End Property
Friend Sub FileDateUpdate()
Dim n$ = _File.Name.StringTrim
Dim s$ = IIf(n.IsEmptyString, String.Empty, " ")
Dim c$ = AccountName.IfNullOrEmpty(UserID)
Select Case MyYouTubeSettings.FileAddDateToFileName.Value
Case FileDateMode.Before : n = $"[{DateAdded:yyyy-MM-dd}]{s}{n}"
Case FileDateMode.After : n = $"{n}{s}[{DateAdded:yyyy-MM-dd}]"
End Select
If Not c.IsEmptyString Then
Select Case MyYouTubeSettings.FileAddChannelToFileName.Value
Case FileDateMode.Before : n = $"[{c}] {n}"
Case FileDateMode.After : n = $"{n} [{c}]"
End Select
End If
_File.Name = n
End Sub
Public Property FileSettings As SFile Public Property FileSettings As SFile
Private Property IUserMedia_File As String Implements IUserMedia.File Private Property IUserMedia_File As String Implements IUserMedia.File
Get Get
@@ -866,10 +908,14 @@ Namespace API.YouTube.Objects
Return Nothing Return Nothing
End Try End Try
End Function End Function
Private Function GetPlaylistRow(ByVal Element As YouTubeMediaContainerBase, Optional ByVal __file As SFile = Nothing) As String Private Function GetPlaylistRow(ByVal Element As YouTubeMediaContainerBase, Optional ByVal __file As SFile = Nothing,
Optional ByVal Mode As M3U8CreationMode = M3U8CreationMode.Absolute) As String
Const m3u8DataRow$ = "#EXTINF:{0},{1}" & vbCrLf & "{2}" Const m3u8DataRow$ = "#EXTINF:{0},{1}" & vbCrLf & "{2}"
With Element With Element
Dim f As SFile = __file.IfNullOrEmpty(.File) Dim f As SFile = __file.IfNullOrEmpty(.File)
Dim fStr$ = f.ToString.StringReplaceSymbols({"\"}, "/", EDP.ReturnValue)
Dim __f$ = SymbolsConverter.ASCII.Extended.EncodeSymbolsOnly(If(Mode = M3U8CreationMode.Absolute, fStr, f.File), M3U8ExcludedSymbols)
If Mode = M3U8CreationMode.Absolute Then __f = $"file:///{__f}"
Dim fName$ = .Title.IfNullOrEmpty(f.Name) Dim fName$ = .Title.IfNullOrEmpty(f.Name)
If MyYouTubeSettings.MusicPlaylistCreate_M3U8_AppendNumber And .PlaylistIndex > 0 Then fName = $"{ .PlaylistIndex}. {fName}" If MyYouTubeSettings.MusicPlaylistCreate_M3U8_AppendNumber And .PlaylistIndex > 0 Then fName = $"{ .PlaylistIndex}. {fName}"
If Not .UserTitle.IsEmptyString Then If Not .UserTitle.IsEmptyString Then
@@ -877,10 +923,7 @@ Namespace API.YouTube.Objects
If MyYouTubeSettings.MusicPlaylistCreate_M3U8_AppendArtist Then fName = $"{ .UserTitle} - {fName}" If MyYouTubeSettings.MusicPlaylistCreate_M3U8_AppendArtist Then fName = $"{ .UserTitle} - {fName}"
End If End If
If MyYouTubeSettings.MusicPlaylistCreate_M3U8_AppendExt Then fName &= $".{f.Extension}" If MyYouTubeSettings.MusicPlaylistCreate_M3U8_AppendExt Then fName &= $".{f.Extension}"
Return String.Format(m3u8DataRow, Return String.Format(m3u8DataRow, CInt(.Duration.TotalSeconds), fName, __f)
CInt(.Duration.TotalSeconds),
fName,
$"file:///{SymbolsConverter.ASCII.EncodeSymbolsOnly(f)}")
End With End With
End Function End Function
Private ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue) Private ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue)
@@ -921,23 +964,41 @@ Namespace API.YouTube.Objects
Dim t As TextSaver = Nothing Dim t As TextSaver = Nothing
Try Try
Dim f As SFile Dim f As SFile
If MyYouTubeSettings.MusicPlaylistCreate_M3U8 Then Dim arr As M3U8CreationMode() = If(MyYouTubeSettings.MusicPlaylistCreate_CreationMode.Value = M3U8CreationMode.Both,
t = New TextSaver {M3U8CreationMode.Relative, M3U8CreationMode.Absolute},
t.AppendLine("#EXTM3U") {MyYouTubeSettings.MusicPlaylistCreate_CreationMode.Value})
Elements.ForEach(Sub(e) t.AppendLine(GetPlaylistRow(e))) Dim postfix$
f = $"{Elements(0).File.PathWithSeparator}Playlist.m3u8" Dim added As Boolean
t.SaveAs(f, EDP.SendToLog) Dim checkFile As Func(Of IYouTubeMediaContainer, Boolean) = Function(ByVal e As IYouTubeMediaContainer) As Boolean
If f.Exists Then AddFile(f) If e.File.Exists Then
t.Dispose() added = True
End If Return True
If MyYouTubeSettings.MusicPlaylistCreate_M3U Then Else
t = New TextSaver Return False
Elements.ForEach(Sub(e) t.AppendLine(e.File)) End If
f = $"{Elements(0).File.PathWithSeparator}Playlist.m3u" End Function
t.SaveAs(f, EDP.SendToLog) For Each cm As M3U8CreationMode In arr
If f.Exists Then AddFile(f) If arr.Length > 1 AndAlso cm = M3U8CreationMode.Absolute Then postfix = "Abs" Else postfix = String.Empty
t.Dispose() added = False
End If If MyYouTubeSettings.MusicPlaylistCreate_M3U8 Then
t = New TextSaver
t.AppendLine("#EXTM3U")
Elements.ForEach(Sub(e) If checkFile(e) Then t.AppendLine(GetPlaylistRow(e,, cm)))
f = $"{Elements(0).File.PathWithSeparator}Playlist{postfix}.m3u8"
If added Then t.SaveAs(f, EDP.SendToLog)
If f.Exists Then AddFile(f)
t.Dispose()
End If
added = False
If MyYouTubeSettings.MusicPlaylistCreate_M3U Then
t = New TextSaver
Elements.ForEach(Sub(e) If checkFile(e) Then t.AppendLine(If(cm = M3U8CreationMode.Relative, e.File.File, e.File.ToString)))
f = $"{Elements(0).File.PathWithSeparator}Playlist{postfix}.m3u"
If added Then t.SaveAs(f, EDP.SendToLog)
If f.Exists Then AddFile(f)
t.Dispose()
End If
Next
Catch ex As Exception Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[YouTubeMediaContainerBase.Download.CreatePlaylist]") ErrorsDescriber.Execute(EDP.SendToLog, ex, "[YouTubeMediaContainerBase.Download.CreatePlaylist]")
End Try End Try
@@ -966,17 +1027,24 @@ Namespace API.YouTube.Objects
.Visible = True .Visible = True
.Value = 0 .Value = 0
.Maximum = DownloadGetElemCountSingle() .Maximum = DownloadGetElemCountSingle()
.Information = $"Download {ObjectType}" .Information = "Downloading"
End With End With
End If End If
Dim cDown As Boolean = False Dim cDown As Boolean = False
Dim fCover As SFile = Nothing
Dim cUrl$ = String.Empty
For Each elem In Elements For Each elem In Elements
With DirectCast(elem, YouTubeMediaContainerBase) With DirectCast(elem, YouTubeMediaContainerBase)
If Not .CoverDownloaded Then .CoverDownloaded = cDown 'If Not .CoverDownloaded Then .CoverDownloaded = cDown
.CoverDownloaded = cDown
.CoverFile = fCover
.CoverURL = cUrl
AddHandler .FileDownloadStarted, fDown AddHandler .FileDownloadStarted, fDown
.Download(UseCookies, Token) .Download(UseCookies, Token)
cDown = .CoverDownloaded cDown = .CoverDownloaded
fCover = .CoverFile
cUrl = .CoverURL
RemoveHandler .FileDownloadStarted, fDown RemoveHandler .FileDownloadStarted, fDown
End With End With
If Token.IsCancellationRequested Or disposedValue Then Exit For If Token.IsCancellationRequested Or disposedValue Then Exit For
@@ -1003,6 +1071,8 @@ Namespace API.YouTube.Objects
End Try End Try
End Sub End Sub
Protected CoverDownloaded As Boolean = False Protected CoverDownloaded As Boolean = False
Protected CoverFile As SFile = Nothing
Protected CoverURL As String = String.Empty
Private Sub DownloadPlaylistCover(ByVal PlsId As String, ByVal f As SFile, ByVal UseCookies As Boolean) Private Sub DownloadPlaylistCover(ByVal PlsId As String, ByVal f As SFile, ByVal UseCookies As Boolean)
Try Try
Dim url$ = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={PlsId}" Dim url$ = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={PlsId}"
@@ -1038,7 +1108,8 @@ Namespace API.YouTube.Objects
url = LinkFormatterSecure(u) url = LinkFormatterSecure(u)
f.Name = "cover" f.Name = "cover"
f.Extension = "jpg" f.Extension = "jpg"
If resp.DownloadFile(url, f, EDP.ReturnValue) And f.Exists Then CoverDownloaded = True : AddFile(f) If resp.DownloadFile(url, f, EDP.ReturnValue) And f.Exists Then _
CoverFile = f : CoverURL = url : CoverDownloaded = True : AddFile(f)
End If End If
End If End If
End Using End Using
@@ -1111,7 +1182,7 @@ Namespace API.YouTube.Objects
.Value = 0 .Value = 0
.Maximum = 100 .Maximum = 100
.Provider = ProgressProvider .Provider = ProgressProvider
.Information = $"Download {MediaType}" .Information = "Downloading"
End With End With
End If End If
.MainProcessName = MyYouTubeSettings.YTDLP.Name '"yt-dlp" .MainProcessName = MyYouTubeSettings.YTDLP.Name '"yt-dlp"
@@ -1143,15 +1214,28 @@ Namespace API.YouTube.Objects
If fileUrl.Exists Then AddFile(fileUrl) If fileUrl.Exists Then AddFile(fileUrl)
End If End If
If MyYouTubeSettings.CreateDescriptionFiles And Not Description.IsEmptyString Then With MyYouTubeSettings
Dim fileDesr As SFile = File If .CreateDescriptionFiles And (Not Description.IsEmptyString Or .CreateDescriptionFiles_CreateWithNoDescription) Then
fileDesr.Extension = "txt" Dim fileDesr As SFile = File
TextSaver.SaveTextToFile(Description, fileDesr,,, EDP.None) fileDesr.Extension = "txt"
If fileDesr.Exists Then AddFile(fileDesr) Using fileDesrText As New TextSaver(fileDesr)
End If fileDesrText.Append($"Uploaded: {DateAdded:yyyy-MM-dd HH:mm:ss}")
fileDesrText.AppendLine()
fileDesrText.AppendLine($"URL: {URL}")
fileDesrText.AppendLine($"Channel name: {AccountName}")
fileDesrText.AppendLine($"Channel ID: {UserID}")
If Not Description.IsEmptyString Then
If Not fileDesrText.IsEmptyString Then fileDesrText.AppendLine.AppendLine()
fileDesrText.Append(Description)
End If
fileDesrText.Save(EDP.None)
End Using
If fileDesr.Exists Then AddFile(fileDesr)
End If
End With
If PlaylistCount > 0 And Not CoverDownloaded And Not PlaylistID.IsEmptyString Then DownloadPlaylistCover(PlaylistID, File, UseCookies) If PlaylistCount > 0 And Not CoverDownloaded And Not PlaylistID.IsEmptyString Then DownloadPlaylistCover(PlaylistID, File, UseCookies)
If prExists Then Progress.InformationTemporary = $"Download {MediaType}: post processing" If prExists Then Progress.InformationTemporary = "Downloading: post processing"
_ThumbnailFile = File _ThumbnailFile = File
_ThumbnailFile.Name &= "_thumb" _ThumbnailFile.Name &= "_thumb"
_ThumbnailFile.Extension = "jpg" _ThumbnailFile.Extension = "jpg"
@@ -1209,10 +1293,10 @@ Namespace API.YouTube.Objects
End Sub End Sub
Dim embedThumbTo As Action(Of SFile) = Dim embedThumbTo As Action(Of SFile) =
Sub(ByVal dFile As SFile) Sub(ByVal dFile As SFile)
If dFile.Exists And ThumbnailFile.Exists Then If dFile.Exists And CoverFile.IfNullOrEmpty(ThumbnailFile).Exists Then
Dim dFileNew As SFile = dFile Dim dFileNew As SFile = dFile
dFileNew.Name &= "_NEW" dFileNew.Name &= "_NEW"
.Execute($"ffmpeg -i ""{dFile}"" -i ""{ThumbnailFile}"" -map 0:0 -map 1:0 -c copy -id3v2_version 3 -metadata:s:v title=""Cover"" -metadata:s:v comment=""Cover"" ""{dFileNew}""") .Execute($"ffmpeg -i ""{dFile}"" -i ""{CoverFile.IfNullOrEmpty(ThumbnailFile)}"" -map 0:0 -map 1:0 -c copy -id3v2_version 3 -metadata:s:v title=""Cover"" -metadata:s:v comment=""Cover"" ""{dFileNew}""")
If dFileNew.Exists AndAlso dFile.Delete(,, EDP.ReturnValue) Then SFile.Rename(dFileNew, dFile) If dFileNew.Exists AndAlso dFile.Delete(,, EDP.ReturnValue) Then SFile.Rename(dFileNew, dFile)
End If End If
End Sub End Sub
@@ -1286,11 +1370,16 @@ Namespace API.YouTube.Objects
If format = mp3 And Not mp3ThumbEmbedded And MyYouTubeSettings.DefaultAudioEmbedThumbnail_ExtractedFiles Then _ If format = mp3 And Not mp3ThumbEmbedded And MyYouTubeSettings.DefaultAudioEmbedThumbnail_ExtractedFiles Then _
embedThumbTo.Invoke(f) : mp3ThumbEmbedded = True embedThumbTo.Invoke(f) : mp3ThumbEmbedded = True
If Not M3U8_PlaylistFiles.ListExists AndAlso f.Exists Then M3U8_Append(f) If Not M3U8_PlaylistFiles.ListExists AndAlso f.Exists Then M3U8_Append(f)
If format = mp3 AndAlso f.Exists AndAlso MyYouTubeSettings.VideoPlaylist_AddExtractedMP3.Value Then M3U8_Append(f)
End If End If
Next Next
End If End If
End If End If
'mp3
If IsMusic And ObjectType = YouTubeMediaType.Single And File.Extension = mp3 And
Not mp3ThumbEmbedded And CoverFile.Exists And MyYouTubeSettings.DefaultAudioEmbedThumbnail_Cover Then embedThumbTo.Invoke(File)
'Update video 'Update video
ThrowAny(Token) ThrowAny(Token)
If SelectedVideoIndex >= 0 AndAlso tempFilesList.Count > 0 AndAlso tempFilesList.Exists(Function(tf) tf.ToReplace) Then If SelectedVideoIndex >= 0 AndAlso tempFilesList.Count > 0 AndAlso tempFilesList.Exists(Function(tf) tf.ToReplace) Then
@@ -1310,15 +1399,29 @@ Namespace API.YouTube.Objects
'Delete unrequsted files 'Delete unrequsted files
If tempFilesList.Count > 0 Then tempFilesList.ForEach(Sub(tfr) If Not tfr.Requested Then tfr.File.Delete(,, EDP.None)) : tempFilesList.Clear() If tempFilesList.Count > 0 Then tempFilesList.ForEach(Sub(tfr) If Not tfr.Requested Then tfr.File.Delete(,, EDP.None)) : tempFilesList.Clear()
'Update video FPS If SelectedVideoIndex >= 0 Then
If SelectedVideoIndex >= 0 AndAlso OutputVideoFPS > 0 AndAlso SelectedVideo.Bitrate <> OutputVideoFPS Then Dim reencodeFile As Action(Of String) =
f = File Sub(ByVal ffmpegCommand As String)
f.Name &= "tmp00" f = File
.Execute($"ffmpeg -i ""{File}"" -filter:v fps={OutputVideoFPS.ToString.Replace(",", ".")} -c:a copy ""{f}""") f.Name &= "tmp00"
If f.Exists Then .Execute(String.Format(ffmpegCommand, File.ToString, f.ToString))
File.Delete() If f.Exists Then
SFile.Rename(f, File,, EDP.LogMessageValue) If f.Size > 0 Then
End If File.Delete()
SFile.Rename(f, File,, EDP.LogMessageValue)
Else
f.Delete(, SFODelete.DeletePermanently, EDP.None)
End If
End If
End Sub
'Change video codec to AVC
If MyYouTubeSettings.DefaultVideoConvertNonAVC.Value AndAlso
Not SelectedVideo.Codec.IsEmptyString AndAlso Not SelectedVideo.Codec.Trim.ToLower.StartsWith("avc") Then _
reencodeFile("ffmpeg -i ""{0}"" -c:a copy -c:v libx264 ""{1}""")
'Update video FPS
If OutputVideoFPS > 0 AndAlso SelectedVideo.Bitrate <> OutputVideoFPS Then _
reencodeFile("ffmpeg -i ""{0}"" -filter:v fps=" & OutputVideoFPS.ToString.Replace(", ", ".") & " -c:a copy ""{1}""")
End If End If
End If End If
End If End If
@@ -1534,7 +1637,7 @@ Namespace API.YouTube.Objects
ID = .Value("id") ID = .Value("id")
Title = TitleHtmlConverter.Invoke(.Value("title")) Title = TitleHtmlConverter.Invoke(.Value("title"))
Description = .Value("description") Description = .Value("description")
URL = .Value("webpage_url") URL = .Value("webpage_url").ToMusicUrl(IsMusic)
PlaylistID = .Value("playlist_id") PlaylistID = .Value("playlist_id")
PlaylistCount = .Value("n_entries").IfNullOrEmpty(.Value("playlist_count")).FromXML(Of Integer)(0) PlaylistCount = .Value("n_entries").IfNullOrEmpty(.Value("playlist_count")).FromXML(Of Integer)(0)
@@ -1572,6 +1675,7 @@ Namespace API.YouTube.Objects
If tValue.HasValue Then Duration = TimeSpan.FromSeconds(tValue.Value) If tValue.HasValue Then Duration = TimeSpan.FromSeconds(tValue.Value)
End If End If
DateAdded = AConvert(Of Date)(.Value("release_date").IfNullOrEmpty(.Value("upload_date")), DateAddedProvider, New Date) DateAdded = AConvert(Of Date)(.Value("release_date").IfNullOrEmpty(.Value("upload_date")), DateAddedProvider, New Date)
If Not IsMusic Then FileDateUpdate()
ParseFormats(.Self) ParseFormats(.Self)
@@ -1648,6 +1752,7 @@ Namespace API.YouTube.Objects
Dim obj As MediaObject Dim obj As MediaObject
Dim nValue# Dim nValue#
Dim sValue$ Dim sValue$
Dim allowWebm As Boolean = MyYouTubeSettings.DefaultVideoAllowWebm
Dim validCodecValue As Func(Of String, Boolean) = Function(codec) Not codec.IsEmptyString AndAlso Not codec = "none" Dim validCodecValue As Func(Of String, Boolean) = Function(codec) Not codec.IsEmptyString AndAlso Not codec = "none"
For Each ee In e({"formats"}) For Each ee In e({"formats"})
@@ -1698,12 +1803,13 @@ Namespace API.YouTube.Objects
Dim d As MediaObject = Nothing Dim d As MediaObject = Nothing
Dim expWebm As Predicate(Of MediaObject) = Function(mo) mo.Extension = webm Dim expWebm As Predicate(Of MediaObject) = Function(mo) mo.Extension = webm
Dim expAVC As Predicate(Of MediaObject) = Function(mo) mo.Codec.IfNullOrEmpty("/").ToLower.StartsWith(avc) Dim expAVC As Predicate(Of MediaObject) = Function(mo) mo.Codec.IfNullOrEmpty("/").ToLower.StartsWith(avc)
Dim comp As Func(Of MediaObject, Predicate(Of MediaObject), Boolean, Boolean) = Dim comp As Func(Of MediaObject, Predicate(Of MediaObject), Boolean, Boolean, Boolean) =
Function(mo, exp, isTrue) mo.Type = t And exp.Invoke(mo) = isTrue And mo.Width = d.Width Function(mo, exp, isTrue, checkHttp) mo.Type = t And exp.Invoke(mo) = isTrue And mo.Width = d.Width And
Dim CountWebm As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expWebm, False) (Not checkHttp OrElse mo.ProtocolType = Protocols.https)
Dim RemoveWebm As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expWebm, True) Dim CountWebm As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expWebm, False, allowWebm)
Dim CountAVC As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expAVC, True) Dim RemoveWebm As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expWebm, True, allowWebm)
Dim RemoveAVC As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expAVC, False) Dim CountAVC As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expAVC, True, False)
Dim RemoveAVC As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expAVC, False, False)
For Each d In data For Each d In data
If MediaObjects.Count = 0 Then Exit For If MediaObjects.Count = 0 Then Exit For
If MediaObjects.LongCount(CountWebm) > 0 Then MediaObjects.RemoveAll(RemoveWebm) If MediaObjects.LongCount(CountWebm) > 0 Then MediaObjects.RemoveAll(RemoveWebm)

View File

@@ -115,6 +115,9 @@
<ItemGroup> <ItemGroup>
<Compile Include="Attributes\GridVisibleAttribute.vb" /> <Compile Include="Attributes\GridVisibleAttribute.vb" />
<Compile Include="Base\TableControlsProcessor.vb" /> <Compile Include="Base\TableControlsProcessor.vb" />
<Compile Include="Controls\ButtonRC.vb">
<SubType>Component</SubType>
</Compile>
<Compile Include="Controls\ChannelTabsChooserForm.Designer.vb"> <Compile Include="Controls\ChannelTabsChooserForm.Designer.vb">
<DependentUpon>ChannelTabsChooserForm.vb</DependentUpon> <DependentUpon>ChannelTabsChooserForm.vb</DependentUpon>
</Compile> </Compile>

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 © 2024")> <Assembly: AssemblyCopyright("Copyright © 2025")>
<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("2024.5.18.0")> <Assembly: AssemblyVersion("2025.2.25.0")>
<Assembly: AssemblyFileVersion("2024.5.18.0")> <Assembly: AssemblyFileVersion("2025.2.25.0")>
<Assembly: NeutralResourcesLanguage("en")> <Assembly: NeutralResourcesLanguage("en")>

View File

@@ -28,6 +28,8 @@ Namespace API.Base
Friend Const GifsDownloadCaption As String = "Download GIFs" Friend Const GifsDownloadCaption As String = "Download GIFs"
Friend Const UseMD5ComparisonCaption As String = "Use MD5 comparison" Friend Const UseMD5ComparisonCaption As String = "Use MD5 comparison"
Friend Const UseMD5ComparisonToolTip As String = "Each image will be checked for existence using MD5" Friend Const UseMD5ComparisonToolTip As String = "Each image will be checked for existence using MD5"
Friend Const UserNameChangeCaption As String = "UserName"
Friend Const UserNameChangeToolTip As String = "If the user has changed their UserName, you can set a new name here. Not required for new users."
Private Sub New() Private Sub New()
End Sub End Sub
End Class End Class

View File

@@ -6,8 +6,9 @@
' '
' 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.Net Imports SCrawler.Plugin
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Base Namespace API.Base
Friend NotInheritable Class DownDetector Friend NotInheritable Class DownDetector
Private Shared ReadOnly Property Params As New RParams("x:.'([\S]+?)',.y:.(\d+)", -1, Nothing, RegexReturn.List) Private Shared ReadOnly Property Params As New RParams("x:.'([\S]+?)',.y:.(\d+)", -1, Nothing, RegexReturn.List)
@@ -34,34 +35,106 @@ Namespace API.Base
Try Try
Dim l As List(Of Data) = Nothing Dim l As List(Of Data) = Nothing
Dim l2 As List(Of Data) = Nothing Dim l2 As List(Of Data) = Nothing
Using w As New WebClient Dim r$ = GetWebString($"https://downdetector.co.uk/status/{Site}/",, EDP.ThrowException)
Dim r$ = w.DownloadString($"https://downdetector.co.uk/status/{Site}/") If Not r.IsEmptyString Then
If Not r.IsEmptyString Then l = RegexFields(Of Data)(r, {Params}, {1, 2})
l = RegexFields(Of Data)(r, {Params}, {1, 2}) If l.ListExists(2) Then
If l.ListExists(2) Then l.Sort()
l.Sort() l2 = New List(Of Data)
l2 = New List(Of Data) Dim d As Data
Dim d As Data Dim eDates As New List(Of Date)
Dim eDates As New List(Of Date) Dim MaxValue As Func(Of Date, Integer) = Function(dd) (From ddd As Data In l Where ddd.Date = dd Select ddd.Value).DefaultIfEmpty(0).Max
Dim MaxValue As Func(Of Date, Integer) = Function(dd) (From ddd In l Where ddd.Date = dd Select ddd.Value).DefaultIfEmpty(0).Max For i% = 0 To l.Count - 1
For i% = 0 To l.Count - 1 If Not eDates.Contains(l(i).Date) Then
If Not eDates.Contains(l(i).Date) Then d = l(i)
d = l(i) d.Value = MaxValue(d.Date)
d.Value = MaxValue(d.Date) l2.Add(d)
l2.Add(d) eDates.Add(d.Date)
eDates.Add(d.Date) End If
End If Next
Next eDates.Clear()
eDates.Clear() l.Clear()
l.Clear() l2.Sort()
l2.Sort()
End If
End If End If
End Using End If
Return l2 Return l2
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"[DownDetector.GetData({Site})]") Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"[DownDetector.GetData({Site})]")
End Try End Try
End Function End Function
Friend Interface IDownDetector
ReadOnly Property Value As Integer
ReadOnly Property AddToLog As Boolean
ReadOnly Property CheckSite As String
Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
End Interface
Friend Class Checker(Of T As {ISiteSettings, IDownDetector})
Protected ReadOnly Property Source As T
Private ReadOnly NP As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
Friend Sub New(ByRef _Source As T)
Source = _Source
End Sub
Private ____AvailableChecked As Boolean = False
Private ____AvailableResult As Boolean = False
Friend Overridable Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
If Settings.DownDetectorEnabled And Source.Value >= 0 Then
If Not ____AvailableChecked Then
____AvailableResult = AvailableImpl(What, Silent)
____AvailableChecked = True
End If
Return ____AvailableResult
Else
Return True
End If
End Function
Protected Overridable Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean
Try
Source.AvailableText = String.Empty
If Source.Value < 0 Then
Return True
Else
Dim dl As List(Of Data) = GetData(Source.CheckSite)
If dl.ListExists Then
dl = dl.Take(4).ToList
Dim avg% = dl.Average(Function(d) d.Value)
If avg > Source.Value Then
Source.AvailableText = $"Over the past hour, {Source.Site} has received an average of {avg.NumToString(NP)} outage reports:{vbCr}{dl.ListToString(vbCr)}"
If Source.AddToLog Then MyMainLOG = Source.AvailableText
If Silent Then
Return AvailableImpl_FALSE_SILENT()
Else
If MsgBoxE({$"{Source.AvailableText}{vbCr}{vbCr}Do you want to continue parsing {Source.Site} data?",
$"There are outage reports on {Source.Site}"}, vbYesNo) = vbYes Then
Return AvailableImpl_FALSE_SILENT_NOT_MSG_YES()
Else
Return AvailableImpl_FALSE_SILENT_NOT_MSG_NO()
End If
End If
End If
End If
Return AvailableImpl_TRUE()
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"[API.{Source.Site}.SiteSettings.Available([DownDetector])]", True)
End Try
End Function
Protected Overridable Function AvailableImpl_TRUE() As Boolean
Return True
End Function
Protected Overridable Function AvailableImpl_FALSE_SILENT() As Boolean
Return False
End Function
Protected Overridable Function AvailableImpl_FALSE_SILENT_NOT_MSG_YES() As Boolean
Return True
End Function
Protected Overridable Function AvailableImpl_FALSE_SILENT_NOT_MSG_NO() As Boolean
Return False
End Function
Friend Overridable Sub Reset()
____AvailableChecked = False
____AvailableResult = False
Source.AvailableText = String.Empty
End Sub
End Class
End Class End Class
End Namespace End Namespace

View File

@@ -0,0 +1,22 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Base
Friend Class EditorExchangeOptionsBase
Friend Overridable Property SiteKey As String
<PSetting(Address:=SettingAddress.User, Caption:=DN.UserNameChangeCaption, ToolTip:=DN.UserNameChangeToolTip)>
Friend Overridable Property UserName As String = String.Empty
Friend Sub New(ByVal u As UserDataBase)
UserName = u.NameTrue(True)
End Sub
Friend Sub New()
End Sub
End Class
End Namespace

View File

@@ -6,66 +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 PersonalUtilities.Tools
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Base.GDL Namespace API.Base.GDL
Friend Module Declarations
Private Structure GDLURL : Implements IRegExCreator
Private _URL As String
Friend ReadOnly Property URL As String
Get
Return _URL
End Get
End Property
Public Shared Widening Operator CType(ByVal u As String) As GDLURL
Return New GDLURL With {._URL = u}
End Operator
Public Shared Widening Operator CType(ByVal u As GDLURL) As String
Return u.URL
End Operator
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists(2) Then
Dim u$ = ParamsArray(0).StringTrim.StringTrimEnd("/"), u2$
If Not u.IsEmptyString Then
u2 = ParamsArray(1).StringTrim
If Not u2.IsEmptyString AndAlso u2.StartsWith("GET", StringComparison.OrdinalIgnoreCase) Then
u2 = u2.Remove(0, 3).StringTrim.StringTrimStart("/")
If Not u2.IsEmptyString Then _URL = $"{u}/{u2}"
End If
End If
End If
Return Me
End Function
Public Shared Operator =(ByVal x As GDLURL, ByVal y As GDLURL) As Boolean
Return x.URL = y.URL
End Operator
Public Shared Operator <>(ByVal x As GDLURL, ByVal y As GDLURL) As Boolean
Return Not x.URL = y.URL
End Operator
Public Overrides Function ToString() As String
Return URL
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
Return URL = CType(Obj, String)
End Function
End Structure
Private ReadOnly Property GdlUrlPattern As RParams = RParams.DM(GDLBatch.UrlLibStart.Replace("[", "\[").Replace("]", "\]") &
"([^""]+?)""(GET [^""]+)""", 0, EDP.ReturnValue)
Friend Function GetUrlsFromGalleryDl(ByVal Batch As BatchExecutor, ByVal Command As String) As List(Of String)
Dim urls As New List(Of String)
Dim u As GDLURL
With Batch
.Execute(Command)
If .ErrorOutputData.Count > 0 Then
For Each eValue$ In .ErrorOutputData
u = RegexFields(Of GDLURL)(eValue, {GdlUrlPattern}, {1, 2}, EDP.ReturnValue).ListIfNothing.FirstOrDefault
If Not u.URL.IsEmptyString Then urls.ListAddValue(u, LNC)
Next
End If
End With
Return urls
End Function
End Module
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"

View File

@@ -18,6 +18,7 @@ Namespace API.Base
End Enum End Enum
ReadOnly Property Site As String ReadOnly Property Site As String
ReadOnly Property Name As String ReadOnly Property Name As String
Property NameTrue As String
Property ID As String Property ID As String
Property Options As String Property Options As String
Property FriendlyName As String Property FriendlyName As String

View File

@@ -54,9 +54,8 @@ Namespace API.Base
Dim aStr$ = String.Empty Dim aStr$ = String.Empty
If Count > 1 Then aStr = $" ({Number}/{Count})" If Count > 1 Then aStr = $" ({Number}/{Count})"
Try Try
If Host.Source.ReadyToDownload(PDownload.SavedPosts) Then If Host.Available(PDownload.SavedPosts, Multiple Or Count > 1) Then
If Host.Available(PDownload.SavedPosts, Multiple Or Count > 1) Then If Host.Source.ReadyToDownload(PDownload.SavedPosts) Then
Host.DownloadStarted(PDownload.SavedPosts)
If Count > 1 Then Progress.Information = $"{Host.Name} - {Host.AccountName.IfNullOrEmpty(SettingsHost.NameAccountNameDefault)}" If Count > 1 Then Progress.Information = $"{Host.Name} - {Host.AccountName.IfNullOrEmpty(SettingsHost.NameAccountNameDefault)}"
Using user As IUserData = Host.GetInstance(PDownload.SavedPosts, Nothing, False, False) Using user As IUserData = Host.GetInstance(PDownload.SavedPosts, Nothing, False, False)
If Not user Is Nothing Then If Not user Is Nothing Then
@@ -83,11 +82,11 @@ Namespace API.Base
End Using End Using
Else Else
_Unavailable += 1 _Unavailable += 1
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is unavailable" Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is not ready"
End If End If
Else Else
_NotReady += 1 _NotReady += 1
Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is not ready" Progress.InformationTemporary = $"Host [{Host.Name}{aStr}] is unavailable"
End If End If
Catch oex As OperationCanceledException When Token.IsCancellationRequested Catch oex As OperationCanceledException When Token.IsCancellationRequested
_ErrorCount += 1 _ErrorCount += 1
@@ -96,9 +95,6 @@ Namespace API.Base
_ErrorCount += 1 _ErrorCount += 1
Progress.InformationTemporary = $"{Host.Name}{aStr} downloading error" Progress.InformationTemporary = $"{Host.Name}{aStr} downloading error"
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"[API.Base.ProfileSaved.Download({Host.Key}{aStr})]") ErrorsDescriber.Execute(EDP.SendToLog, ex, $"[API.Base.ProfileSaved.Download({Host.Key}{aStr})]")
Finally
Host.DownloadDone(PDownload.SavedPosts)
MainFrameObj.UpdateLogButton()
End Try End Try
End Sub End Sub
End Class End Class

View File

@@ -33,7 +33,7 @@ Namespace API.Base
End Property End Property
Friend Property AccountName As String Implements ISiteSettings.AccountName Friend Property AccountName As String Implements ISiteSettings.AccountName
Friend Property Temporary As Boolean = False Implements ISiteSettings.Temporary Friend Property Temporary As Boolean = False Implements ISiteSettings.Temporary
Friend Property DefaultInstance As ISiteSettings = Nothing Implements ISiteSettings.DefaultInstance Friend Overridable Property DefaultInstance As ISiteSettings = Nothing Implements ISiteSettings.DefaultInstance
Protected _UserAgentDefault As String = String.Empty Protected _UserAgentDefault As String = String.Empty
Friend Overridable Property UserAgentDefault As String Implements ISiteSettings.UserAgentDefault Friend Overridable Property UserAgentDefault As String Implements ISiteSettings.UserAgentDefault
Get Get
@@ -55,6 +55,11 @@ Namespace API.Base
Friend Overridable ReadOnly Property Responser As Responser Friend Overridable ReadOnly Property Responser As Responser
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
Return True
End Function
Protected Overridable Sub UserOptionsSetParameters(ByRef Options As Object)
End Sub
Protected Property UserOptionsType As Type Protected Property UserOptionsType As Type
Get Get
Return _UserOptionsType Return _UserOptionsType
@@ -243,7 +248,7 @@ Namespace API.Base
#Region "User info" #Region "User info"
Protected UrlPatternUser As String = String.Empty Protected UrlPatternUser As String = String.Empty
Friend Overridable Function GetUserUrl(ByVal User As IPluginContentProvider) As String Implements ISiteSettings.GetUserUrl Friend Overridable Function GetUserUrl(ByVal User As IPluginContentProvider) As String Implements ISiteSettings.GetUserUrl
If Not UrlPatternUser.IsEmptyString Then Return String.Format(UrlPatternUser, User.Name) If Not UrlPatternUser.IsEmptyString Then Return String.Format(UrlPatternUser, User.NameTrue.IfNullOrEmpty(User.Name))
Return String.Empty Return String.Empty
End Function End Function
Private Function ISiteSettings_GetUserPostUrl(ByVal User As IPluginContentProvider, ByVal Media As IUserMedia) As String Implements ISiteSettings.GetUserPostUrl Private Function ISiteSettings_GetUserPostUrl(ByVal User As IPluginContentProvider, ByVal Media As IUserMedia) As String Implements ISiteSettings.GetUserPostUrl
@@ -380,11 +385,40 @@ Namespace API.Base
End Sub End Sub
Friend Overridable Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Implements ISiteSettings.UserOptions Friend Overridable Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Implements ISiteSettings.UserOptions
If _UserOptionsExists Then If _UserOptionsExists Then
If Options Is Nothing OrElse Not Options.GetType Is _UserOptionsType Then If Options Is Nothing OrElse (Not Options.GetType Is _UserOptionsType OrElse Not UserOptionsValid(Options)) Then
Options = AConvert(Me, AModes.Var, _UserOptionsType,, True, Nothing) Dim args% = 0
Dim constructor As ConstructorInfo = Nothing
With _UserOptionsType.GetTypeInfo.DeclaredConstructors
If .ListExists Then
With .Where(Function(ByVal c As ConstructorInfo) As Boolean
With c.GetParameters
If .ListExists Then
If .Count = 1 Then
Return .Self()(0).ParameterType.GetInterfaces.ListIfNothing.Where(Function(i) i Is Me.GetType).Count = 1
Else
Return False
End If
Else
Return True
End If
End With
Return If(c.GetParameters?.Count, 0).ValueBetween(0, 1)
End Function)
If .ListExists Then
args = .Max(Of Integer)(Function(c) If(c.GetParameters?.Count, 0))
constructor = .First(Function(c) If(c.GetParameters?.Count, 0) = args)
End If
End With
End If
End With
If Not constructor Is Nothing Then
If args > 0 AndAlso Not constructor.GetParameters()(0).ParameterType Is GetType(ISiteSettings) Then Throw New Exception
If args = 0 Then Options = constructor.Invoke(Nothing) Else Options = constructor.Invoke({Me})
End If
If Options Is Nothing Then Options = Activator.CreateInstance(_UserOptionsType) If Options Is Nothing Then Options = Activator.CreateInstance(_UserOptionsType)
If Not Options Is Nothing Then UserOptionsSetParameters(Options)
End If End If
If OpenForm Then If Not Options Is Nothing And OpenForm Then
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
Else Else

View File

@@ -80,6 +80,8 @@ Namespace API.Base
Private _CollectionButtonsExists As Boolean = False Private _CollectionButtonsExists As Boolean = False
Private _CollectionButtonsColorsSet As Boolean = False Private _CollectionButtonsColorsSet As Boolean = False
Friend WithEvents BTT_CONTEXT_DOWN As ToolStripKeyMenuItem Friend WithEvents BTT_CONTEXT_DOWN As ToolStripKeyMenuItem
Friend WithEvents BTT_CONTEXT_DOWN_LIMIT As ToolStripKeyMenuItem
Friend WithEvents BTT_CONTEXT_DOWN_DATE As ToolStripKeyMenuItem
Friend WithEvents BTT_CONTEXT_EDIT As ToolStripMenuItem Friend WithEvents BTT_CONTEXT_EDIT As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_DELETE As ToolStripMenuItem Friend WithEvents BTT_CONTEXT_DELETE As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_ERASE As ToolStripMenuItem Friend WithEvents BTT_CONTEXT_ERASE As ToolStripMenuItem
@@ -98,6 +100,8 @@ Namespace API.Base
End If End If
End With End With
BTT_CONTEXT_DOWN = New ToolStripKeyMenuItem(tn, i) With {.Name = tnn("DOWN"), .Tag = Me} BTT_CONTEXT_DOWN = New ToolStripKeyMenuItem(tn, i) With {.Name = tnn("DOWN"), .Tag = Me}
BTT_CONTEXT_DOWN_LIMIT = New ToolStripKeyMenuItem(tn, i) With {.Name = tnn("DOWN_LIMIT"), .Tag = Me}
BTT_CONTEXT_DOWN_DATE = New ToolStripKeyMenuItem(tn, i) With {.Name = tnn("DOWN_DATE"), .Tag = Me}
BTT_CONTEXT_EDIT = New ToolStripMenuItem(tn, i) With {.Name = tnn("EDIT"), .Tag = Me} BTT_CONTEXT_EDIT = New ToolStripMenuItem(tn, i) With {.Name = tnn("EDIT"), .Tag = Me}
BTT_CONTEXT_DELETE = New ToolStripMenuItem(tn, i) With {.Name = tnn("DELETE"), .Tag = Me} BTT_CONTEXT_DELETE = New ToolStripMenuItem(tn, i) With {.Name = tnn("DELETE"), .Tag = Me}
BTT_CONTEXT_ERASE = New ToolStripMenuItem(tn, i) With {.Name = tnn("ERASE"), .Tag = Me} BTT_CONTEXT_ERASE = New ToolStripMenuItem(tn, i) With {.Name = tnn("ERASE"), .Tag = Me}
@@ -117,7 +121,8 @@ Namespace API.Base
cb = MyColor.EditBack cb = MyColor.EditBack
cf = MyColor.EditFore cf = MyColor.EditFore
End If End If
For Each b As ToolStripMenuItem In {BTT_CONTEXT_DOWN, BTT_CONTEXT_EDIT, BTT_CONTEXT_DELETE, BTT_CONTEXT_ERASE, For Each b As ToolStripMenuItem In {BTT_CONTEXT_DOWN, BTT_CONTEXT_DOWN_LIMIT, BTT_CONTEXT_DOWN_DATE,
BTT_CONTEXT_EDIT, BTT_CONTEXT_DELETE, BTT_CONTEXT_ERASE,
BTT_CONTEXT_OPEN_PATH, BTT_CONTEXT_OPEN_SITE} BTT_CONTEXT_OPEN_PATH, BTT_CONTEXT_OPEN_SITE}
If Not b Is Nothing Then b.BackColor = cb : b.ForeColor = cf If Not b Is Nothing Then b.BackColor = cb : b.ForeColor = cf
Next Next
@@ -143,7 +148,7 @@ Namespace API.Base
Protected Const Name_UserID As String = "UserID" Protected Const Name_UserID As String = "UserID"
Protected Const Name_Options As String = "Options" Protected Const Name_Options As String = "Options"
Protected Const Name_Description As String = "Description" Protected Const Name_Description As String = "Description"
Private Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly" Protected Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly"
Private Const Name_IsSubscription As String = UserInfo.Name_IsSubscription Private Const Name_IsSubscription As String = UserInfo.Name_IsSubscription
Private Const Name_Temporary As String = "Temporary" Private Const Name_Temporary As String = "Temporary"
Private Const Name_Favorite As String = "Favorite" Private Const Name_Favorite As String = "Favorite"
@@ -173,6 +178,8 @@ 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
@@ -273,6 +280,21 @@ Namespace API.Base
Return User.Name Return User.Name
End Get End Get
End Property End Property
Private _NameTrue As String = String.Empty
Friend Overridable Overloads Property NameTrue As String Implements IUserData.NameTrue, IPluginContentProvider.NameTrue
Get
Return NameTrue(False)
End Get
Set(ByVal NewName As String)
If Not _NameTrue = NewName Then EnvirChanged(NewName)
_NameTrue = NewName
End Set
End Property
Friend Overloads ReadOnly Property NameTrue(ByVal Exact As Boolean) As String
Get
Return If(Exact, _NameTrue, _NameTrue.IfNullOrEmpty(Name))
End Get
End Property
Friend Overridable Property ID As String = String.Empty Implements IUserData.ID, IPluginContentProvider.ID Friend Overridable Property ID As String = String.Empty Implements IUserData.ID, IPluginContentProvider.ID
Protected _FriendlyName As String = String.Empty Protected _FriendlyName As String = String.Empty
Friend Overridable Property FriendlyName As String Implements IUserData.FriendlyName Friend Overridable Property FriendlyName As String Implements IUserData.FriendlyName
@@ -343,12 +365,20 @@ Namespace API.Base
Protected Function UserDescriptionNeedToUpdate() As Boolean Protected Function UserDescriptionNeedToUpdate() As Boolean
Return (UserDescription.IsEmptyString Or _DescriptionEveryTime) And Not _DescriptionChecked Return (UserDescription.IsEmptyString Or _DescriptionEveryTime) And Not _DescriptionChecked
End Function End Function
Protected Sub UserDescriptionUpdate(ByVal Descr As String) Protected Sub UserDescriptionUpdate(ByVal Descr As String, Optional ByVal Force As Boolean = False,
If UserDescriptionNeedToUpdate() Then Optional ByVal InsertFirst As Boolean = False, Optional ByVal AppendDate As Boolean = False)
If UserDescriptionNeedToUpdate() Or Force Then
If AppendDate Then Descr = $"{Now.ToStringDateDef}: {Descr}"
If UserDescription.IsEmptyString Then If UserDescription.IsEmptyString Then
UserDescription = Descr UserDescription = Descr
_ForceSaveUserInfo = True
ElseIf Not UserDescription.Contains(Descr) Then ElseIf Not UserDescription.Contains(Descr) Then
UserDescription &= $"{vbNewLine}----{vbNewLine}{Descr}" If InsertFirst Then
UserDescription = $"{Descr}{vbNewLine}{UserDescription}"
Else
UserDescription &= $"{vbNewLine}----{vbNewLine}{Descr}"
End If
_ForceSaveUserInfo = True
End If End If
_DescriptionChecked = True _DescriptionChecked = True
End If End If
@@ -410,9 +440,7 @@ Namespace API.Base
End Function End Function
Friend Overridable Sub SetPicture(ByVal f As SFile) Implements IUserData.SetPicture Friend Overridable Sub SetPicture(ByVal f As SFile) Implements IUserData.SetPicture
Try Try
If f.Exists Then If f.Exists Then UserImage.NewUserPicture(f, MyFile)
Using p As New UserImage(f, MyFile) : p.Save() : End Using
End If
Catch Catch
End Try End Try
End Sub End Sub
@@ -451,11 +479,7 @@ BlockPictureScan:
New ErrorsDescriber(EDP.ReturnValue) With { New ErrorsDescriber(EDP.ReturnValue) With {
.ReturnValue = New List(Of SFile), .ReturnValue = New List(Of SFile),
.ReturnValueExists = True}).FirstOrDefault .ReturnValueExists = True}).FirstOrDefault
If NewPicFile.Exists Then If NewPicFile.Exists Then p = UserImage.NewUserPicture(NewPicFile, MyFile,, True) : GoTo BlockReturn
p = New UserImage(NewPicFile, MyFile)
p.Save()
GoTo BlockReturn
End If
BlockDeletePictureFolder: BlockDeletePictureFolder:
On Error GoTo BlockReturn On Error GoTo BlockReturn
If DelPath Then If DelPath Then
@@ -654,6 +678,7 @@ BlockNullPicture:
End Sub End Sub
Protected ReadOnly _TempMediaList As List(Of UserMedia) Protected ReadOnly _TempMediaList As List(Of UserMedia)
Protected ReadOnly _TempPostsList As List(Of String) Protected ReadOnly _TempPostsList As List(Of String)
Private ReadOnly _MD5List As List(Of String)
Friend Function GetLastImageAddress() As SFile Friend Function GetLastImageAddress() As SFile
If _ContentList.Count > 0 Then If _ContentList.Count > 0 Then
Return _ContentList.LastOrDefault(Function(c) c.Type = UTypes.Picture And Not c.File.IsEmptyString And Not c.File.Extension = "gif").File Return _ContentList.LastOrDefault(Function(c) c.Type = UTypes.Picture And Not c.File.IsEmptyString And Not c.File.Extension = "gif").File
@@ -679,6 +704,7 @@ BlockNullPicture:
Protected MyFileSettings As SFile Protected MyFileSettings As SFile
Protected MyFileData As SFile Protected MyFileData As SFile
Protected MyFilePosts As SFile Protected MyFilePosts As SFile
Private MyMD5File As SFile
Friend Overridable Property FileExists As Boolean = False Implements IUserData.FileExists Friend Overridable Property FileExists As Boolean = False Implements IUserData.FileExists
Friend Overridable Property DataMerging As Boolean Friend Overridable Property DataMerging As Boolean
Get Get
@@ -856,6 +882,7 @@ BlockNullPicture:
LatestData = New List(Of UserMedia) LatestData = New List(Of UserMedia)
_TempMediaList = New List(Of UserMedia) _TempMediaList = New List(Of UserMedia)
_TempPostsList = New List(Of String) _TempPostsList = New List(Of String)
_MD5List = New List(Of String)
Labels = New List(Of String) Labels = New List(Of String)
UserUpdatedEventHandlers = New List(Of IUserData.UserUpdatedEventHandler) UserUpdatedEventHandlers = New List(Of IUserData.UserUpdatedEventHandler)
UserDownloadStateChangedEventHandlers = New List(Of UserDownloadStateChangedEventHandler) UserDownloadStateChangedEventHandlers = New List(Of UserDownloadStateChangedEventHandler)
@@ -905,6 +932,10 @@ BlockNullPicture:
FileExists = True FileExists = True
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)
#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)
@@ -950,6 +981,9 @@ BlockNullPicture:
LogError(ex, "user information loading error") LogError(ex, "user information loading error")
End Try End Try
End Sub End Sub
Private Sub UpdateUserInformation_Ex()
If _ForceSaveUserInfoOnException Then UpdateUserInformation()
End Sub
Friend Overridable Overloads Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation Friend Overridable Overloads Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation
UpdateUserInformation(False) UpdateUserInformation(False)
End Sub End Sub
@@ -962,6 +996,7 @@ BlockNullPicture:
x.Add(Name_Plugin, HOST.Key) x.Add(Name_Plugin, HOST.Key)
x.Add(Name_AccountName, AccountName) x.Add(Name_AccountName, AccountName)
x.Add(Name_UserName, User.Name) x.Add(Name_UserName, User.Name)
x.Add(Name_TrueName, _NameTrue)
x.Add(Name_Model_User, CInt(UserModel)) x.Add(Name_Model_User, CInt(UserModel))
x.Add(Name_Model_Collection, CInt(CollectionModel)) x.Add(Name_Model_Collection, CInt(CollectionModel))
x.Add(Name_SpecialPath, User.SpecialPath) x.Add(Name_SpecialPath, User.SpecialPath)
@@ -1037,6 +1072,8 @@ BlockNullPicture:
If _ContentList.Count > 0 Then x.AddRange(_ContentList) If _ContentList.Count > 0 Then x.AddRange(_ContentList)
x.Save(MyFileData) x.Save(MyFileData)
End Using End Using
If Not MyMD5File.IsEmptyString And _MD5List.Count > 0 Then _
TextSaver.SaveTextToFile(_MD5List.ListToString(Environment.NewLine), MyMD5File, True,, EDP.None)
Catch ex As Exception Catch ex As Exception
LogError(ex, "history saving error") LogError(ex, "history saving error")
End Try End Try
@@ -1118,6 +1155,7 @@ 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
@@ -1131,11 +1169,13 @@ BlockNullPicture:
TokenPersonal = Nothing TokenPersonal = Nothing
ProgressPre.Reset() ProgressPre.Reset()
UpdateDataFiles() UpdateDataFiles()
_MD5Loaded = False
_DownloadInProgress = True _DownloadInProgress = True
_DescriptionChecked = False _DescriptionChecked = False
_DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime _DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime
_ForceSaveUserData = False _ForceSaveUserData = False
_ForceSaveUserInfo = False _ForceSaveUserInfo = False
_ForceSaveUserInfoOnException = False
_EnvirUserExists = UserExists _EnvirUserExists = UserExists
_EnvirUserSuspended = UserSuspended _EnvirUserSuspended = UserSuspended
_EnvirCreatedByChannel = CreatedByChannel _EnvirCreatedByChannel = CreatedByChannel
@@ -1152,6 +1192,7 @@ BlockNullPicture:
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
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
Case NameOf(NameTrue) : _EnvirChanged = True : _EnvirInvokeUserUpdated = True : _ForceSaveUserInfo = True : _ForceSaveUserInfoOnException = True
Case Else : _EnvirChanged = True Case Else : _EnvirChanged = True
End Select End Select
End If End If
@@ -1212,7 +1253,7 @@ BlockNullPicture:
ProgressPre.Done() ProgressPre.Done()
ThrowAny(Token) ThrowAny(Token)
If UseMD5Comparison And Not IsSubscription Then ValidateMD5(Token) : ProgressPre.Done() : ThrowAny(Token) If RemoveExistingDuplicates And Not IsSubscription Then ValidateMD5(Token) : ProgressPre.Done() : ThrowAny(Token)
If _TempPostsList.Count > 0 And Not DownloadMissingOnly And Not __isChannelsSupport Then If _TempPostsList.Count > 0 And Not DownloadMissingOnly And Not __isChannelsSupport Then
If _TempPostsList.Count > 1000 Then _TempPostsList.ListAddList(_TempPostsList.ListTake(-2, 1000, EDP.ReturnValue).ListReverse, LAP.ClearBeforeAdd) If _TempPostsList.Count > 1000 Then _TempPostsList.ListAddList(_TempPostsList.ListTake(-2, 1000, EDP.ReturnValue).ListReverse, LAP.ClearBeforeAdd)
@@ -1265,21 +1306,26 @@ BlockNullPicture:
ThrowIfDisposed() ThrowIfDisposed()
If Not _PictureExists Or _EnvirInvokeUserUpdated Then OnUserUpdated() If Not _PictureExists Or _EnvirInvokeUserUpdated Then OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested Or TokenQueue.IsCancellationRequested Catch oex As OperationCanceledException When Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested Or TokenQueue.IsCancellationRequested
UpdateUserInformation_Ex()
MyMainLOG = $"{ToStringForLog()}: downloading canceled" MyMainLOG = $"{ToStringForLog()}: downloading canceled"
Canceled = True Canceled = True
Catch exit_ex As ExitException Catch exit_ex As ExitException
UpdateUserInformation_Ex()
If Not exit_ex.Silent Then If Not exit_ex.Silent Then
If exit_ex.SimpleLogLine Then If exit_ex.SimpleLogLine Then
MyMainLOG = $"{ToStringForLog()}: downloading interrupted (exit) ({exit_ex.Message})" LogError(Nothing, $"downloading interrupted (exit) ({exit_ex.Message})")
Else Else
ErrorsDescriber.Execute(EDP.SendToLog, exit_ex, $"{ToStringForLog()}: downloading interrupted (exit)") LogError(exit_ex, "downloading interrupted (exit)")
End If End If
End If End If
If _EnvirInvokeUserUpdated Then OnUserUpdated()
Canceled = True Canceled = True
Catch dex As ObjectDisposedException When Disposed Catch dex As ObjectDisposedException When Disposed
Canceled = True Canceled = True
Catch ex As Exception Catch ex As Exception
UpdateUserInformation_Ex()
LogError(ex, "downloading data error") LogError(ex, "downloading data error")
If _EnvirInvokeUserUpdated Then OnUserUpdated()
HasError = True HasError = True
Finally Finally
If Not UserExists Then AddNonExistingUserToLog($"User '{ToStringForLog()}' not found on the site") If Not UserExists Then AddNonExistingUserToLog($"User '{ToStringForLog()}' not found on the site")
@@ -1315,6 +1361,11 @@ BlockNullPicture:
MyFilePosts = MyFileSettings MyFilePosts = MyFileSettings
MyFilePosts.Name &= "_Posts" MyFilePosts.Name &= "_Posts"
MyFilePosts.Extension = "txt" MyFilePosts.Extension = "txt"
If Not IsSavedPosts Then
MyMD5File = MyFileSettings
MyMD5File.Name &= "_MD5"
MyMD5File.Extension = "txt"
End If
Else Else
Throw New ArgumentNullException("User.File", "User file not detected") Throw New ArgumentNullException("User.File", "User file not detected")
End If End If
@@ -1438,81 +1489,94 @@ BlockNullPicture:
End Sub End Sub
#End Region #End Region
#Region "MD5 support" #Region "MD5 support"
Protected Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR" Private Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR"
Friend Property UseMD5Comparison As Boolean = False Friend Property UseMD5Comparison As Boolean = False
Protected Property StartMD5Checked As Boolean = False Protected Property StartMD5Checked As Boolean = False
Friend Property RemoveExistingDuplicates As Boolean = False Friend Property RemoveExistingDuplicates As Boolean = False
Protected Overridable Sub ValidateMD5(ByVal Token As CancellationToken) Private ReadOnly ErrMD5 As New ErrorsDescriber(EDP.ReturnValue)
Private _MD5Loaded As Boolean = False
Private Sub LoadMD5()
Try
If Not _MD5Loaded Then
_MD5Loaded = True
_MD5List.Clear()
If _ContentList.Count > 0 Then _MD5List.ListAddList(_ContentList.Select(Function(c) c.MD5), LAP.NotContainsOnly, EDP.ReturnValue)
If MyMD5File.Exists Then _MD5List.ListAddList(MyMD5File.GetLines, LAP.NotContainsOnly, EDP.ThrowException)
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "LoadMD5")
End Try
End Sub
Private Function ValidateMD5_GetMD5(ByVal __data As UserMedia, ByVal IsUrl As Boolean) As String
Try
Dim ImgFormat As Imaging.ImageFormat = Nothing
Dim hash$ = String.Empty
Dim __isGif As Boolean = False
If __data.Type = UTypes.GIF Then
ImgFormat = Imaging.ImageFormat.Gif
__isGif = True
ElseIf Not __data.File.IsEmptyString Then
ImgFormat = GetImageFormat(__data.File)
End If
If ImgFormat Is Nothing Then ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl And Not __isGif Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ImgFormat, ErrMD5))
ElseIf IsUrl And __isGif Then
hash = ByteArrayToString(GetMD5FromBytes(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ErrMD5))
Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If
If hash.IsEmptyString And Not __isGif Then
If ImgFormat Is Imaging.ImageFormat.Jpeg Then ImgFormat = Imaging.ImageFormat.Png Else ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ImgFormat, ErrMD5))
Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If
End If
Return hash
Catch
Return String.Empty
End Try
End Function
Private Sub ValidateMD5(ByVal Token As CancellationToken)
Try Try
Dim missingMD5 As Predicate(Of UserMedia) = Function(d) (d.Type = UTypes.GIF Or d.Type = UTypes.Picture) And d.MD5.IsEmptyString Dim missingMD5 As Predicate(Of UserMedia) = Function(d) (d.Type = UTypes.GIF Or d.Type = UTypes.Picture) And d.MD5.IsEmptyString
If UseMD5Comparison And _TempMediaList.Exists(missingMD5) Then If RemoveExistingDuplicates Then
RemoveExistingDuplicates = False
_ForceSaveUserInfo = True
LoadMD5()
Dim i% Dim i%
Dim itemsCount% = 0 Dim itemsCount% = 0
Dim limit% = If(DownloadTopCount, 0) Dim limit% = If(DownloadTopCount, 0)
Dim data As UserMedia = Nothing Dim data As UserMedia = Nothing
Dim hashList As New Dictionary(Of String, SFile)
Dim f As SFile Dim f As SFile
Dim ErrMD5 As New ErrorsDescriber(EDP.ReturnValue)
Dim __getMD5 As Func(Of UserMedia, Boolean, String) =
Function(ByVal __data As UserMedia, ByVal IsUrl As Boolean) As String
Try
Dim ImgFormat As Imaging.ImageFormat = Nothing
Dim hash$ = String.Empty
Dim __isGif As Boolean = False
If __data.Type = UTypes.GIF Then
ImgFormat = Imaging.ImageFormat.Gif
__isGif = True
ElseIf Not __data.File.IsEmptyString Then
ImgFormat = GetImageFormat(__data.File)
End If
If ImgFormat Is Nothing Then ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl And Not __isGif Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ImgFormat, ErrMD5))
ElseIf IsUrl And __isGif Then
hash = ByteArrayToString(GetMD5FromBytes(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ErrMD5))
Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If
If hash.IsEmptyString And Not __isGif Then
If ImgFormat Is Imaging.ImageFormat.Jpeg Then ImgFormat = Imaging.ImageFormat.Png Else ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL.IfNullOrEmpty(__data.URL_BASE), ErrMD5), ImgFormat, ErrMD5))
Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If
End If
Return hash
Catch
Return String.Empty
End Try
End Function
If Not StartMD5Checked Then If Not StartMD5Checked Then
StartMD5Checked = True StartMD5Checked = True
If _ContentList.Exists(missingMD5) Then Dim existingFiles As List(Of SFile) = SFile.GetFiles(MyFileSettings.CutPath, "*.jpg|*.jpeg|*.png|*.gif",, EDP.ReturnValue).ListIfNothing
Dim existingFiles As List(Of SFile) = SFile.GetFiles(MyFileSettings.CutPath, "*.jpg|*.jpeg|*.png|*.gif",, EDP.ReturnValue).ListIfNothing Dim eIndx%
Dim eIndx% Dim eFinder As Predicate(Of SFile) = Function(ff) ff.File = data.File.File
Dim eFinder As Predicate(Of SFile) = Function(ff) ff.File = data.File.File
If RemoveExistingDuplicates Then If existingFiles.Count > 0 Then
RemoveExistingDuplicates = False Dim h$
_ForceSaveUserInfo = True ProgressPre.ChangeMax(existingFiles.Count)
If existingFiles.Count > 0 Then For i = existingFiles.Count - 1 To 0 Step -1
Dim h$ ProgressPre.Perform()
ProgressPre.ChangeMax(existingFiles.Count) h = ValidateMD5_GetMD5(New UserMedia With {.File = existingFiles(i)}, False)
For i = existingFiles.Count - 1 To 0 Step -1 If Not h.IsEmptyString Then
ProgressPre.Perform() If _MD5List.Contains(h) Then
h = __getMD5(New UserMedia With {.File = existingFiles(i)}, False) MyMainLOG = $"{ToStringForLog()}: Removed image [{existingFiles(i).File}] (duplicate)"
If Not h.IsEmptyString Then existingFiles(i).Delete(SFO.File, SFODelete.DeleteToRecycleBin, ErrMD5)
If hashList.ContainsKey(h) Then existingFiles.RemoveAt(i)
MyMainLOG = $"{ToStringForLog()}: Removed image [{existingFiles(i).File}] (duplicate of [{hashList(h).File}])" Else
existingFiles(i).Delete(SFO.File, SFODelete.DeleteToRecycleBin, ErrMD5) _MD5List.Add(h)
existingFiles.RemoveAt(i) End If
Else
hashList.Add(h, existingFiles(i))
End If
End If
Next
End If End If
End If Next
End If
If _ContentList.Count > 0 AndAlso _ContentList.Exists(missingMD5) Then
ProgressPre.ChangeMax(_ContentList.Count) ProgressPre.ChangeMax(_ContentList.Count)
For i = 0 To _ContentList.Count - 1 For i = 0 To _ContentList.Count - 1
data = _ContentList(i) data = _ContentList(i)
@@ -1522,61 +1586,34 @@ BlockNullPicture:
ThrowAny(Token) ThrowAny(Token)
eIndx = existingFiles.FindIndex(eFinder) eIndx = existingFiles.FindIndex(eFinder)
If eIndx >= 0 Then If eIndx >= 0 Then
data.MD5 = __getMD5(New UserMedia With {.File = existingFiles(eIndx)}, False) data.MD5 = ValidateMD5_GetMD5(New UserMedia With {.File = existingFiles(eIndx)}, False)
If Not data.MD5.IsEmptyString Then _ContentList(i) = data : _ForceSaveUserData = True If Not data.MD5.IsEmptyString Then _ContentList(i) = data : _ForceSaveUserData = True
End If End If
End If End If
existingFiles.RemoveAll(eFinder) existingFiles.RemoveAll(eFinder)
End If End If
Next Next
If existingFiles.Count > 0 Then
ProgressPre.ChangeMax(existingFiles.Count)
For i = 0 To existingFiles.Count - 1
f = existingFiles(i)
ProgressPre.Perform()
data = New UserMedia(f.File) With {
.State = UStates.Downloaded,
.Type = IIf(f.Extension = "gif", UTypes.GIF, UTypes.Picture),
.File = f
}
ThrowAny(Token)
data.MD5 = __getMD5(data, False)
If Not data.MD5.IsEmptyString Then _ContentList.Add(data) : _ForceSaveUserData = True
Next
existingFiles.Clear()
End If
End If End If
End If
If _ContentList.Count > 0 Then If existingFiles.Count > 0 Then
With _ContentList.Select(Function(d) d.MD5) ProgressPre.ChangeMax(existingFiles.Count)
If .ListExists Then .ToList.ForEach(Sub(md5value) _ For i = 0 To existingFiles.Count - 1
If Not md5value.IsEmptyString AndAlso Not hashList.ContainsKey(md5value) Then hashList.Add(md5value, New SFile)) f = existingFiles(i)
End With ProgressPre.Perform()
End If data = New UserMedia(f.File) With {
.State = UStates.Downloaded,
ProgressPre.ChangeMax(_TempMediaList.Count) .Type = IIf(f.Extension = "gif", UTypes.GIF, UTypes.Picture),
For i = _TempMediaList.Count - 1 To 0 Step -1 .File = f
ProgressPre.Perform() }
If limit > 0 And itemsCount >= limit Then
_TempMediaList.RemoveAt(i)
Else
data = _TempMediaList(i)
If missingMD5(data) Then
ThrowAny(Token) ThrowAny(Token)
data.MD5 = __getMD5(data, True) data.MD5 = ValidateMD5_GetMD5(data, False)
If Not data.MD5.IsEmptyString Then If Not data.MD5.IsEmptyString Then _ContentList.Add(data) : _ForceSaveUserData = True
If hashList.ContainsKey(data.MD5) Then Next
_TempMediaList.RemoveAt(i) existingFiles.Clear()
Else
hashList.Add(data.MD5, New SFile)
_TempMediaList(i) = data
itemsCount += 1
End If
End If
End If
End If End If
Next End If
If _ContentList.Count > 0 Then _MD5List.ListAddList(_ContentList.Select(Function(d) d.MD5), LAP.NotContainsOnly, EDP.ReturnValue)
End If End If
Catch iex As ArgumentOutOfRangeException When Disposed Catch iex As ArgumentOutOfRangeException When Disposed
Catch ex As Exception Catch ex As Exception
@@ -1614,6 +1651,7 @@ BlockNullPicture:
Source.Progress.Done() Source.Progress.Done()
End Sub End Sub
End Class End Class
Protected Const VideoFolderName As String = "Video"
Protected Sub DownloadContentDefault(ByVal Token As CancellationToken) Protected Sub DownloadContentDefault(ByVal Token As CancellationToken)
Try Try
Dim i% Dim i%
@@ -1622,6 +1660,7 @@ BlockNullPicture:
If _ContentNew.Count > 0 Then If _ContentNew.Count > 0 Then
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString) _ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
If _ContentNew.Count > 0 Then If _ContentNew.Count > 0 Then
If UseMD5Comparison Then LoadMD5()
MyFile.Exists(SFO.Path) MyFile.Exists(SFO.Path)
Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog
Dim MyDir$ = DownloadContentDefault_GetRootDir() Dim MyDir$ = DownloadContentDefault_GetRootDir()
@@ -1630,6 +1669,7 @@ BlockNullPicture:
Dim __interrupt As Boolean Dim __interrupt As Boolean
Dim f As SFile Dim f As SFile
Dim v As UserMedia Dim v As UserMedia
Dim __fileDeleted As Boolean
Dim fileNumProvider As SFileNumbers = SFileNumbers.Default Dim fileNumProvider As SFileNumbers = SFileNumbers.Default
Dim __deleteFile As Action(Of SFile, String) = Sub(ByVal FileToDelete As SFile, ByVal FileUrl As String) Dim __deleteFile As Action(Of SFile, String) = Sub(ByVal FileToDelete As SFile, ByVal FileUrl As String)
Try Try
@@ -1641,9 +1681,21 @@ BlockNullPicture:
ErrorsDescriber.Execute(EDP.SendToLog, file_del_ex) ErrorsDescriber.Execute(EDP.SendToLog, file_del_ex)
End Try End Try
End Sub End Sub
Dim updateDownCount As Action = Sub()
Dim __n% = IIf(__fileDeleted, -1, 1)
If __isVideo Then
v.Type = UTypes.Video
DownloadedVideos(False) += __n
ElseIf v.Type = UTypes.GIF Then
DownloadedPictures(False) += __n
Else
v.Type = UTypes.Picture
DownloadedPictures(False) += __n
End If
End Sub
Using w As New OptionalWebClient(Me) Using w As New OptionalWebClient(Me)
If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path) If vsf Then CSFileP($"{MyDir}\{VideoFolderName}\").Exists(SFO.Path)
Progress.Maximum += _ContentNew.Count Progress.Maximum += _ContentNew.Count
If IsSingleObjectDownload Then If IsSingleObjectDownload Then
If _ContentNew.Count = 1 And _ContentNew(0).Type = UTypes.Video Then If _ContentNew.Count = 1 And _ContentNew(0).Type = UTypes.Video Then
@@ -1671,6 +1723,8 @@ BlockNullPicture:
If v.URL_BASE.IsEmptyString Then v.URL_BASE = v.URL If v.URL_BASE.IsEmptyString Then v.URL_BASE = v.URL
__fileDeleted = False
If Not f.IsEmptyString And Not v.URL.IsEmptyString Then If Not f.IsEmptyString And Not v.URL.IsEmptyString Then
Try Try
__isVideo = v.Type = UTypes.Video Or f.Extension = "mp4" Or v.Type = UTypes.m3u8 __isVideo = v.Type = UTypes.Video Or f.Extension = "mp4" Or v.Type = UTypes.m3u8
@@ -1691,7 +1745,7 @@ BlockNullPicture:
End If End If
If __isVideo And vsf Then If __isVideo And vsf Then
If v.SpecialFolder.IsEmptyString OrElse Not v.SpecialFolder.EndsWith("*") Then If v.SpecialFolder.IsEmptyString OrElse Not v.SpecialFolder.EndsWith("*") Then
f.Path = $"{f.PathWithSeparator}Video" f.Path = $"{f.PathWithSeparator}{VideoFolderName}"
If Not v.SpecialFolder.IsEmptyString Then f.Exists(SFO.Path) If Not v.SpecialFolder.IsEmptyString Then f.Exists(SFO.Path)
End If End If
End If End If
@@ -1715,19 +1769,26 @@ BlockNullPicture:
End If End If
End If End If
If __isVideo Then updateDownCount()
v.Type = UTypes.Video
DownloadedVideos(False) += 1
ElseIf v.Type = UTypes.GIF Then
DownloadedPictures(False) += 1
Else
v.Type = UTypes.Picture
DownloadedPictures(False) += 1
End If
v.File = ChangeFileNameByProvider(f, v) v.File = ChangeFileNameByProvider(f, v)
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 v.File.Exists Then
v.MD5 = ValidateMD5_GetMD5(v, False)
If Not v.MD5.IsEmptyString Then
If _MD5List.Contains(v.MD5) Then
__fileDeleted = v.File.Delete(SFO.File, SFODelete.DeletePermanently, EDP.ReturnValue)
If __fileDeleted Then dCount -= 1 : updateDownCount()
Else
_MD5List.Add(v.MD5)
End If
End If
Else
dCount -= 1
End If
End If
dCount += 1 dCount += 1
Catch woex As OperationCanceledException When Token.IsCancellationRequested Catch woex As OperationCanceledException When Token.IsCancellationRequested
__deleteFile.Invoke(f, v.URL_BASE) __deleteFile.Invoke(f, v.URL_BASE)
@@ -1745,7 +1806,7 @@ BlockNullPicture:
Else Else
v.State = UStates.Skipped v.State = UStates.Skipped
End If End If
_ContentNew(i) = v If Not __fileDeleted Then _ContentNew(i) = v
If DownloadTopCount.HasValue AndAlso dCount >= DownloadTopCount.Value Then If DownloadTopCount.HasValue AndAlso dCount >= DownloadTopCount.Value Then
Progress.Perform(_ContentNew.Count - dTotal) Progress.Perform(_ContentNew.Count - dTotal)
Exit Sub Exit Sub
@@ -1816,6 +1877,31 @@ BlockNullPicture:
Protected Overridable Function CreateFileFromUrl(ByVal URL As String) As SFile Protected Overridable Function CreateFileFromUrl(ByVal URL As String) As SFile
Return New SFile(URL) Return New SFile(URL)
End Function End Function
Protected Overridable Function SimpleDownloadAvatar(ByVal ImageAddress As String, Optional ByVal FileCreateFunc As Func(Of String, SFile) = Nothing,
Optional ByVal e As ErrorsDescriber = Nothing) As SFile
Try
If Not ImageAddress.IsEmptyString Then
Dim f As SFile
If FileCreateFunc Is Nothing Then
f = CreateFileFromUrl(ImageAddress)
Else
f = FileCreateFunc.Invoke(ImageAddress)
End If
If Not f.Name.IsEmptyString Then f.Name = f.Name.StringRemoveWinForbiddenSymbols.StringTrim
If Not f.Name.IsEmptyString Then
f.Path = DownloadContentDefault_GetRootDir()
f.Separator = "\"
If f.Extension.IsEmptyString Then f.Extension = "jpg"
If Not f.Exists Then GetWebFile(ImageAddress, f, EDP.ReturnValue)
If f.Exists Then IconBannerDownloaded = True : Return f
End If
End If
Return Nothing
Catch ex As Exception
If Not e.Exists Then e = New ErrorsDescriber(EDP.ReturnValue)
Return ErrorsDescriber.Execute(e, ex, $"SimpleDownloadAvatar({ImageAddress})", New SFile)
End Try
End Function
Protected Overridable Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile Protected Overridable Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
Dim ff As SFile = Nothing Dim ff As SFile = Nothing
Try Try
@@ -1897,6 +1983,7 @@ BlockNullPicture:
If m.Contains(IUserData.EraseMode.History) Then If m.Contains(IUserData.EraseMode.History) Then
If MyFilePosts.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True If MyFilePosts.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
If MyFileData.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True If MyFileData.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
If MyMD5File.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
LastUpdated = Nothing LastUpdated = Nothing
EraseData_AdditionalDataFiles() EraseData_AdditionalDataFiles()
UpdateUserInformation() UpdateUserInformation()
@@ -1913,6 +2000,8 @@ BlockNullPicture:
_TempMediaList.Clear() _TempMediaList.Clear()
_ContentNew.Clear() _ContentNew.Clear()
_ContentList.Clear() _ContentList.Clear()
_MD5List.Clear()
_MD5Loaded = False
End If End If
End If End If
End If End If
@@ -2165,6 +2254,12 @@ BlockNullPicture:
Private Sub BTT_CONTEXT_DOWN_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_CONTEXT_DOWN.KeyClick Private Sub BTT_CONTEXT_DOWN_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_CONTEXT_DOWN.KeyClick
Downloader.Add(Me, e.IncludeInTheFeed) Downloader.Add(Me, e.IncludeInTheFeed)
End Sub End Sub
Private Sub BTT_CONTEXT_DOWN_LIMIT_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_CONTEXT_DOWN_LIMIT.KeyClick
ControlInvokeFast(MainFrameObj.MF, Sub() MainFrameObj.MF.DownloadSelectedUser(MainFrame.DownUserLimits.Number, e.IncludeInTheFeed, Me), EDP.SendToLog)
End Sub
Private Sub BTT_CONTEXT_DOWN_DATE_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_CONTEXT_DOWN_DATE.KeyClick
ControlInvokeFast(MainFrameObj.MF, Sub() MainFrameObj.MF.DownloadSelectedUser(MainFrame.DownUserLimits.Date, e.IncludeInTheFeed, Me), EDP.SendToLog)
End Sub
Private Sub BTT_CONTEXT_EDIT_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_EDIT.Click Private Sub BTT_CONTEXT_EDIT_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_EDIT.Click
Using f As New Editors.UserCreatorForm(Me) Using f As New Editors.UserCreatorForm(Me)
f.ShowDialog() f.ShowDialog()
@@ -2240,10 +2335,13 @@ BlockNullPicture:
LatestData.Clear() LatestData.Clear()
_TempMediaList.Clear() _TempMediaList.Clear()
_TempPostsList.Clear() _TempPostsList.Clear()
_MD5List.Clear()
TokenPersonal = Nothing TokenPersonal = 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()
If Not BTT_CONTEXT_DOWN_LIMIT Is Nothing Then BTT_CONTEXT_DOWN_LIMIT.Dispose()
If Not BTT_CONTEXT_DOWN_DATE Is Nothing Then BTT_CONTEXT_DOWN_DATE.Dispose()
If Not BTT_CONTEXT_EDIT Is Nothing Then BTT_CONTEXT_EDIT.Dispose() If Not BTT_CONTEXT_EDIT Is Nothing Then BTT_CONTEXT_EDIT.Dispose()
If Not BTT_CONTEXT_DELETE Is Nothing Then BTT_CONTEXT_DELETE.Dispose() If Not BTT_CONTEXT_DELETE Is Nothing Then BTT_CONTEXT_DELETE.Dispose()
If Not BTT_CONTEXT_ERASE Is Nothing Then BTT_CONTEXT_ERASE.Dispose() If Not BTT_CONTEXT_ERASE Is Nothing Then BTT_CONTEXT_ERASE.Dispose()

View File

@@ -134,6 +134,7 @@ Namespace API.Base
m.GetMemberCustomAttributes(Of Provider).ListExists m.GetMemberCustomAttributes(Of Provider).ListExists
Dim m1 As MemberInfo, m2 As MemberInfo Dim m1 As MemberInfo, m2 As MemberInfo
Dim tmpObj As Object Dim tmpObj As Object
Dim maxOffset%
members = GetObjectMembers(MyObject, Function(m) (m.MemberType = MemberTypes.Field Or m.MemberType = MemberTypes.Property) AndAlso members = GetObjectMembers(MyObject, Function(m) (m.MemberType = MemberTypes.Field Or m.MemberType = MemberTypes.Property) AndAlso
Not m.GetCustomAttribute(Of PSettingAttribute) Is Nothing,, True, Not m.GetCustomAttribute(Of PSettingAttribute) Is Nothing,, True,
@@ -175,6 +176,9 @@ Namespace API.Base
If MyMembers.Count > 0 Then If MyMembers.Count > 0 Then
maxOffset = MyMembers.Max(Function(mm) mm.LeftOffset)
If maxOffset > 0 Then MyMembers.ForEach(Sub(mm) mm.LeftOffset = maxOffset)
Dim prov As IEnumerable(Of Provider) Dim prov As IEnumerable(Of Provider)
Dim _prov As Provider Dim _prov As Provider
Dim si% = -1 Dim si% = -1

View File

@@ -0,0 +1,18 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Bluesky
Friend Module Declarations
Friend Const BlueskySiteKey As String = "AndyProgram_Bluesky"
Friend ReadOnly DateProvider As New ADateTime("yyyy-MM-ddTHH:mm:ss.FFF%K")
Friend ReadOnly RegEx_PlayLists As RParams = RParams.DM("RESOLUTION=\d+x(\d+)\s*(\S+)", 0, RegexReturn.List, EDP.ReturnValue)
Friend ReadOnly RegEx_FilePattern As RParams = RParams.DM("(.+?)(\.|@)(gif|m3u8|[^/\?\&]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
Friend ReadOnly RegEx_SinglePostPattern As RParams = RParams.DM("profile/([^/]+)/post/([^/\?\&]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
End Module
End Namespace

View File

@@ -0,0 +1,51 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Bluesky
Friend NotInheritable Class M3U8
Private Sub New()
End Sub
Private Shared Function GetUrlsList(ByVal URL As String) As List(Of String)
Using resp As New Responser With {.AllowAutoRedirect = False}
Dim r$ = resp.GetResponse(URL)
If Not r.IsEmptyString Then
Dim file$ = String.Empty, appender$
Dim files As List(Of Sizes) = RegexFields(Of Sizes)(r, {RegEx_PlayLists}, {1, 2})
If files.ListExists Then files.RemoveAll(Function(ff) ff.Value = 0 Or ff.Data.IsEmptyString)
If files.ListExists Then
files.Sort()
file = files(0).Data
appender = URL.Replace(URL.Split("/").Last, String.Empty)
file = M3U8Base.CreateUrl(appender, file)
If Not file.IsEmptyString Then
r = resp.GetResponse(file)
If Not r.IsEmptyString Then
Dim l As List(Of String) = RegexReplace(r, M3U8Declarations.TsFilesRegEx)
If l.ListExists Then
appender = file.Replace(file.Split("/").Last, String.Empty)
For i% = 0 To l.Count - 1 : l(i) = M3U8Base.CreateUrl(appender, l(i)) : Next
Return l
End If
End If
End If
End If
End If
End Using
Return Nothing
End Function
Friend Shared Function Download(ByVal URL As String, ByVal Destination As SFile, ByVal Token As CancellationToken,
ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Return M3U8Base.Download(GetUrlsList(URL), Destination,, Token, Progress, UsePreProgress)
End Function
End Class
End Namespace

View File

@@ -0,0 +1,100 @@
' 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
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Namespace API.Bluesky
<Manifest(BlueskySiteKey), SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
<PropertyOption(ControlText:="Cookies enabled", ControlToolTip:="If checked, cookies will be used in requests", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property CookiesEnabled As PropertyValue
<PropertyOption(ControlText:="User name", IsAuth:=True, AllowNull:=False), PXML>
Friend ReadOnly Property UserHandle As PropertyValue
<PropertyOption(ControlText:="Password", IsAuth:=True, AllowNull:=False), PXML>
Friend ReadOnly Property UserPassword As PropertyValue
<PXML> Friend ReadOnly Property Token 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>
Friend ReadOnly Property TokenRefreshInterval As PropertyValue
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New("Bluesky", "bsky.app", AccName, Temp, My.Resources.SiteResources.BlueskyIcon_32, My.Resources.SiteResources.BlueskyPic_32)
Responser.ContentType = "application/json"
CookiesEnabled = New PropertyValue(False)
UserHandle = New PropertyValue(String.Empty, GetType(String))
UserPassword = New PropertyValue(String.Empty, GetType(String))
Token = New PropertyValue(String.Empty, GetType(String))
TokenUpdateTime = New PropertyValue(Now.AddYears(-1))
TokenRefreshInterval = New PropertyValue(120)
_AllowUserAgentUpdate = False
UrlPatternUser = "https://bsky.app/profile/{0}"
ImageVideoContains = "bsky.app"
UserRegex = RParams.DMS("bsky.app/profile/([^/\?]+)", 1, EDP.ReturnValue)
UserOptionsType = GetType(EditorExchangeOptionsBase)
End Sub
Protected Overrides Function UserOptionsValid(ByVal Options As Object) As Boolean
Return DirectCast(Options, EditorExchangeOptionsBase).SiteKey = BlueskySiteKey
End Function
Protected Overrides Sub UserOptionsSetParameters(ByRef Options As Object)
DirectCast(Options, EditorExchangeOptionsBase).SiteKey = BlueskySiteKey
End Sub
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Overrides Function BaseAuthExists() As Boolean
Return Not CStr(UserHandle.Value).IsEmptyString And Not CStr(UserPassword.Value).IsEmptyString
End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return MyBase.Available(What, Silent) AndAlso UpdateToken()
End Function
Private _TokenUpdating As Boolean = False
Friend Function UpdateToken(Optional ByVal Force As Boolean = False) As Boolean
Try
While _TokenUpdating : Threading.Thread.Sleep(100) : End While
_TokenUpdating = True
If BaseAuthExists() Then
If CDate(TokenUpdateTime.Value).AddMinutes(TokenRefreshInterval.Value) < Now Or Force Then
Using resp As Responser = Responser.Copy
With resp
.Mode = Responser.Modes.Curl
.Method = "POST"
.CurlSslNoRevoke = True
.CurlInsecure = True
.CurlArgumentsLeft = "-d ""{\" & $"""identifier\"": \""{UserHandle.Value}\"", \""password\"": \""{UserPassword.Value}\""" & "}"""
Dim r$ = .GetResponse("https://bsky.social/xrpc/com.atproto.server.createSession")
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If j.ListExists Then
Dim t$ = j.Value("accessJwt")
If Not t.IsEmptyString Then Token.Value = $"Bearer {t}" : TokenUpdateTime.Value = Now : Return True
End If
End Using
End If
End With
End Using
Else
Return True
End If
End If
Return False
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "Bluesky.SiteSettings.UpdateToken", False)
Finally
_TokenUpdating = False
End Try
End Function
End Class
End Namespace

View File

@@ -0,0 +1,330 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.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.Bluesky
Friend Class UserData : Inherits UserDataBase
#Region "Declarations"
Private ReadOnly Property MySettings As SiteSettings
Get
Return HOST.Source
End Get
End Property
Private ReadOnly Property ID_Encoded As String
Get
Return If(ID.IsEmptyString, String.Empty, SymbolsConverter.ASCII.EncodeSymbolsOnly(ID))
End Get
End Property
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptionsBase(Me) With {.SiteKey = BlueskySiteKey}
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptionsBase AndAlso
DirectCast(Obj, EditorExchangeOptionsBase).SiteKey = BlueskySiteKey Then NameTrue = DirectCast(Obj, EditorExchangeOptionsBase).UserName
End Sub
#End Region
#Region "Initializer"
Friend Sub New()
UseInternalM3U8Function = True
End Sub
#End Region
#Region "Token"
Private Function UpdateToken(Optional ByVal Force As Boolean = False, Optional ByVal OnlyAddHeader As Boolean = False) As Boolean
Dim process As Boolean = True
If CDate(MySettings.TokenUpdateTime.Value).AddHours(2) <= Now Or Force Then
process = MySettings.UpdateToken(Force)
If process Then _TokenUpdateCount += 1
End If
If process Or OnlyAddHeader Then Responser.Headers.Add("authorization", MySettings.Token.Value)
Return Not Responser.Headers.Value("authorization").IsEmptyString
End Function
Private _TokenUpdateCount As Integer = 0
Private Sub TokenUpdateCountReset()
_TokenUpdateCount = 0
End Sub
#End Region
#Region "Download"
Private _PostCount As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not CBool(MySettings.CookiesEnabled.Value) Then Responser.Cookies.Clear()
UpdateToken(, True)
_TokenUpdateCount = 0
_PostCount = 0
DownloadData(String.Empty, Token)
End Sub
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
If ID.IsEmptyString Then GetProfileInfo(Token)
If ID.IsEmptyString Then Throw New ArgumentNullException("ID", "ID is null")
If UpdateToken() Then
Dim nextCursor$ = String.Empty
Dim c%
URL = $"https://bsky.social/xrpc/app.bsky.feed.getAuthorFeed?actor={ID_Encoded}&filter=posts_and_author_threads&includePins=false&limit=99"
If Not Cursor.IsEmptyString Then URL &= $"&cursor={SymbolsConverter.ASCII.EncodeSymbolsOnly(Cursor)}"
Dim r$ = Responser.GetResponse(URL)
TokenUpdateCountReset()
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
With j("feed")
If .ListExists Then
For Each post As EContainer In .Self
With post({"post"})
c = DefaultParser(.Self,, nextCursor)
Select Case c
Case CInt(DateResult.Skip) * -1 : Continue For
Case CInt(DateResult.Exit) * -1 : Exit Sub
Case Is > 0 : _PostCount += c
End Select
If DownloadTopCount.HasValue AndAlso DownloadTopCount.Value <= _PostCount Then Exit Sub
End With
Next
End If
End With
End If
End Using
If Not nextCursor.IsEmptyString Then DownloadData(nextCursor, Token)
End If
End If
Catch ex As Exception
ProcessException(ex, Token, $"DownloadData({URL})")
End Try
End Sub
#End Region
#Region "DefaultParser"
Private Const Down_ImageAddress As String = "https://cdn.bsky.app/img/feed_fullsize/plain/{0}/{1}"
Private Function GetPostID(ByVal PostUri As String) As String
Return If(PostUri.IsEmptyString, String.Empty, PostUri.Split("/").LastOrDefault)
End Function
Private Function DefaultParser(ByVal e As EContainer, Optional ByVal CheckDateLimits As Boolean = True, Optional ByRef NextCursor As String = Nothing,
Optional ByVal CheckTempPosts As Boolean = True, Optional ByVal State As UStates = UStates.Unknown) As Integer
Const exitReturn% = CInt(DateResult.Exit) * -1
Dim postID$, postDate$, __url$, __urlBase$
Dim updateUrl As Boolean
Dim c% = 0
Dim m As UserMedia
Dim d As EContainer
With e
If .ListExists Then
postID = GetPostID(.Value("uri"))
postDate = String.Empty
__urlBase = String.Empty
With .Item({"record"})
If .ListExists Then
'2025-01-28T02:42:12.415Z
postDate = .Value("createdAt")
NextCursor = postDate
If CheckDateLimits Then
Select Case CheckDatesLimit(postDate, DateProvider)
Case DateResult.Skip : Return CInt(DateResult.Skip) * -1 'Continue For
Case DateResult.Exit : Return exitReturn 'Exit Sub
End Select
End If
If CheckTempPosts Then
If _TempPostsList.Contains(postID) Then Return exitReturn Else _TempPostsList.Add(postID)
End If
__urlBase = $"https://bsky.app/profile/{NameTrue}/post/{postID}"
End If
End With
Dim createMedia As Func(Of String, UTypes, UserMedia) =
Function(ByVal url As String, ByVal type As UTypes) As UserMedia
m = New UserMedia(url, type) With {
.URL_BASE = __urlBase,
.File = CreateFileFromUrl(url, type),
.Post = New UserPost(postID, If(AConvert(Of Date)(postDate, DateProvider, Nothing, EDP.ReturnValue), Nothing)),
.State = State
}
_TempMediaList.ListAddValue(m, LNC)
c += 1
Return m
End Function
For Each SecondExtraction As Boolean In {False, True}
With If(SecondExtraction, .Item({"record", "embed"}), .Item("embed"))
If .ListExists Then
If If(.Item("images")?.Count, 0) > 0 Then
With .Item("images")
For Each d In .Self
updateUrl = False
__url = d.Value("fullsize")
If __url.IsEmptyString Then __url = d.Value({"image", "ref"}, "$link") : updateUrl = True
If __url.IsEmptyString And SecondExtraction Then updateUrl = False : __url = e.Value({"embed"}, "thumb")
If Not __url.IsEmptyString Then createMedia(__url, UTypes.Picture)
Next
End With
End If
If Not .Value("playlist").IsEmptyString Then createMedia(.Value("playlist"), UTypes.m3u8)
If If(.Item("external")?.Count, 0) > 0 Then createMedia(.Value({"external"}, "uri"), UTypes.GIF)
End If
End With
If c > 0 Then Exit For
Next
End If
End With
Return c
End Function
#End Region
#Region "GetProfileInfo"
Private Sub GetProfileInfo(ByVal Token As CancellationToken)
Try
If UpdateToken() Then
Dim r$ = Responser.GetResponse($"https://bsky.social/xrpc/app.bsky.actor.getProfile?actor={ID.IfNullOrEmpty(NameTrue)}")
TokenUpdateCountReset()
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
ID = j.Value("did")
UserSiteNameUpdate(j.Value("displayName"))
UserDescriptionUpdate(j.Value("description"))
NameTrue = j.Value("handle")
SimpleDownloadAvatar(j.Value("avatar"))
SimpleDownloadAvatar(j.Value("banner"))
End If
End Using
End If
Else
Throw New ArgumentException("Token is null", "Token")
End If
Catch ex As Exception
ProcessException(ex, Token, "GetProfileInfo")
End Try
End Sub
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Const uriPattern$ = "at://{0}/app.bsky.feed.post/{1}"
Dim rList As New List(Of Integer)
Try
If ContentMissingExists AndAlso UpdateToken() Then
Dim r$, url$, uri$
Dim tu As Byte
Dim m As UserMedia
Dim j As EContainer
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
If m.State = UStates.Missing Then
uri = SymbolsConverter.ASCII.EncodeSymbolsOnly(String.Format(uriPattern, NameTrue, m.Post.ID))
url = $"https://bsky.social/xrpc/app.bsky.feed.getPostThread?uri={uri}&depth=10"
For tu = 0 To 1
Try
Responser.ResetStatus()
r = Responser.GetResponse(url)
TokenUpdateCountReset()
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If j.ListExists Then
If DefaultParser(j({"thread", "post"}), False,, False, UStates.Missing) > 0 Then rList.Add(i)
j.Dispose()
End If
End If
Exit For
Catch eex As Exception
If ProcessException(eex, Token, $"ReparseMissing({url})",,, False) <> 1 Then Throw eex
End Try
Next
End If
Next
Else
Throw New ArgumentException("Token is null", "Token")
End If
Catch ex As Exception
ProcessException(ex, Token, "ReparseMissing error")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try
End Sub
#End Region
#Region "CreateFileFromUrl"
Protected Overloads Overrides Function CreateFileFromUrl(ByVal URL As String) As SFile
Return CreateFileFromUrl(URL, UTypes.Undefined)
End Function
Protected Overloads Function CreateFileFromUrl(ByVal URL As String, ByVal Type As UTypes) As SFile
Dim f As SFile = MyBase.CreateFileFromUrl(URL)
Dim force As Boolean = False
f.Separator = "\"
With URL.Split("/")
If .ListExists Then
With DirectCast(RegexReplace(.Last, RegEx_FilePattern), List(Of String))
If .ListExists(4) Then
f.Name = .Item(1).IfNullOrEmpty(f.Name)
f.Extension = .Item(3)
End If
End With
End If
End With
If Not f.Extension.IsEmptyString AndAlso f.Extension.ToLower = "m3u8" Then force = True : Type = UTypes.m3u8
If f.Extension.IsEmptyString Or force Then
Select Case Type
Case UTypes.Picture : f.Extension = "jpg"
Case UTypes.GIF : f.Extension = "gif"
Case UTypes.m3u8 : f.Name = "Video" : f.Extension = "mp4"
End Select
End If
Return f
End Function
#End Region
#Region "DownloadContent"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(URL, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function
#End Region
#Region "DownloadSingleObject"
Protected Overrides Sub DownloadSingleObject_GetPosts(ByVal Data As IYouTubeMediaContainer, ByVal Token As CancellationToken)
_TokenUpdateCount = 0
UpdateToken()
Dim l As List(Of String) = RegexReplace(Data.URL, RegEx_SinglePostPattern)
If l.ListExists(3) Then
NameTrue = l(1)
_ContentList.Add(New UserMedia(Data.URL) With {.State = UStates.Missing, .Post = l(2)})
ReparseMissing(Token)
End If
MyBase.DownloadSingleObject_GetPosts(Data, Token)
End Sub
#End Region
#Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = Net.HttpStatusCode.BadRequest Then '400
If _TokenUpdateCount = 0 AndAlso UpdateToken(True) Then
Return 1
Else
Return 0
End If
Else
Return 0
End If
End Function
#End Region
End Class
End Namespace

View File

@@ -18,6 +18,8 @@ Namespace API.Facebook
Friend ReadOnly Regex_FileName As RParams = RParams.DM("([^/\?]+\..{3,4})(?=(\?|\Z))", 0, EDP.ReturnValue) Friend ReadOnly Regex_FileName As RParams = RParams.DM("([^/\?]+\..{3,4})(?=(\?|\Z))", 0, EDP.ReturnValue)
Friend ReadOnly Regex_ProfileUrlID As RParams = RParams.DMS("profile.php\?id=(\d+)", 1, EDP.ReturnValue) Friend ReadOnly Regex_ProfileUrlID As RParams = RParams.DMS("profile.php\?id=(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_VideoPageID As RParams = RParams.DMS("pageid.:.(\d+)", 1, RegexOptions.IgnoreCase, EDP.ReturnValue) Friend ReadOnly Regex_VideoPageID As RParams = RParams.DMS("pageid.:.(\d+)", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly Regex_ReelsPageID As RParams = RParams.DMS("\{[^\}]*""tab_key"":""owner_reels"",?[^\}]*""id"":""([^\}""]+)""", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly Regex_ReelsFilePattern As RParams = RParams.DM("[^/]+\.mp4", 0, EDP.ReturnValue)
Friend ReadOnly Regex_StoryBucket As RParams = RParams.DMS("story_bucket[^\>]*?(\d+)", 1, EDP.ReturnValue) Friend ReadOnly Regex_StoryBucket As RParams = RParams.DMS("story_bucket[^\>]*?(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly Regex_VideoIDFromURL As RParams = RParams.DMS("facebook.com/([^/]+/videos/|watch/\D*[\?&]{1}v=)(\d+)", 2, EDP.ReturnValue) Friend ReadOnly Regex_VideoIDFromURL As RParams = RParams.DMS("facebook.com/([^/]+/videos/|watch/\D*[\?&]{1}v=)(\d+)", 2, EDP.ReturnValue)

View File

@@ -36,6 +36,8 @@ Namespace API.Facebook
Friend ReadOnly Property ParsePhotoBlock As PropertyValue Friend ReadOnly Property ParsePhotoBlock As PropertyValue
<PropertyOption(ControlText:="Download videos", IsAuth:=False, Category:=DN.CAT_UserDefs), PXML, PClonable> <PropertyOption(ControlText:="Download videos", IsAuth:=False, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property ParseVideoBlock As PropertyValue Friend ReadOnly Property ParseVideoBlock As PropertyValue
<PropertyOption(ControlText:="Download reels", IsAuth:=False, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property ParseReelsBlock As PropertyValue
<PropertyOption(ControlText:="Download stories", IsAuth:=False, Category:=DN.CAT_UserDefs), PXML, PClonable> <PropertyOption(ControlText:="Download stories", IsAuth:=False, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property ParseStoriesBlock As PropertyValue Friend ReadOnly Property ParseStoriesBlock As PropertyValue
#End Region #End Region
@@ -52,6 +54,7 @@ Namespace API.Facebook
Header_Accept = New PropertyValue(String.Empty, GetType(String)) Header_Accept = New PropertyValue(String.Empty, GetType(String))
ParsePhotoBlock = New PropertyValue(True) ParsePhotoBlock = New PropertyValue(True)
ParseVideoBlock = New PropertyValue(True) ParseVideoBlock = New PropertyValue(True)
ParseReelsBlock = New PropertyValue(False)
ParseStoriesBlock = New PropertyValue(True) ParseStoriesBlock = New PropertyValue(True)
UrlPatternUser = "https://www.facebook.com/{0}" UrlPatternUser = "https://www.facebook.com/{0}"

View File

@@ -23,9 +23,11 @@ Namespace API.Facebook
Private Const Name_IsNoNameProfile As String = "IsNoNameProfile" Private Const Name_IsNoNameProfile As String = "IsNoNameProfile"
Private Const Name_OptionsParsed As String = "OptionsParsed" Private Const Name_OptionsParsed As String = "OptionsParsed"
Private Const Name_VideoPageID As String = "VideoPageID" Private Const Name_VideoPageID As String = "VideoPageID"
Private Const Name_ReelsPageID As String = "ReelsPageID"
Private Const Name_StoryBucket As String = "StoryBucket" Private Const Name_StoryBucket As String = "StoryBucket"
Private Const Name_ParsePhotoBlock As String = "ParsePhotoBlock" Private Const Name_ParsePhotoBlock As String = "ParsePhotoBlock"
Private Const Name_ParseVideoBlock As String = "ParseVideoBlock" Private Const Name_ParseVideoBlock As String = "ParseVideoBlock"
Private Const Name_ParseReelsBlock As String = "ParseReelsBlock"
Private Const Name_ParseStoriesBlock As String = "ParseStoriesBlock" Private Const Name_ParseStoriesBlock As String = "ParseStoriesBlock"
#End Region #End Region
#Region "Declarations" #Region "Declarations"
@@ -37,15 +39,18 @@ Namespace API.Facebook
Private IsNoNameProfile As Boolean = False Private IsNoNameProfile As Boolean = False
Private OptionsParsed As Boolean = False Private OptionsParsed As Boolean = False
Private Property VideoPageID As String = String.Empty Private Property VideoPageID As String = String.Empty
Private Property ReelsPageID As String = String.Empty
Private Property StoryBucket As String = String.Empty Private Property StoryBucket As String = String.Empty
Friend Property ParsePhotoBlock As Boolean = True Friend Property ParsePhotoBlock As Boolean = True
Friend Property ParseVideoBlock As Boolean = True Friend Property ParseVideoBlock As Boolean = True
Friend Property ParseReelsBlock As Boolean = False
Friend Property ParseStoriesBlock As Boolean = True Friend Property ParseStoriesBlock As Boolean = True
Private Enum PageBlock As Integer Private Enum PageBlock As Integer
Timeline = Sections.Timeline Timeline = Sections.Timeline
Stories = Sections.Stories Stories = Sections.Stories
Photos = 100 Photos = 100
Videos = 101 Videos = 101
Reels = Sections.Reels
Undefined = -1 Undefined = -1
End Enum End Enum
#End Region #End Region
@@ -67,6 +72,7 @@ Namespace API.Facebook
With DirectCast(Obj, UserExchangeOptions) With DirectCast(Obj, UserExchangeOptions)
ParsePhotoBlock = .ParsePhotoBlock ParsePhotoBlock = .ParsePhotoBlock
ParseVideoBlock = .ParseVideoBlock ParseVideoBlock = .ParseVideoBlock
ParseReelsBlock = .ParseReelsBlock
ParseStoriesBlock = .ParseStoriesBlock ParseStoriesBlock = .ParseStoriesBlock
End With End With
End If End If
@@ -90,18 +96,22 @@ Namespace API.Facebook
End If End If
OptionsParsed = .Value(Name_OptionsParsed).FromXML(Of Boolean)(False) OptionsParsed = .Value(Name_OptionsParsed).FromXML(Of Boolean)(False)
VideoPageID = .Value(Name_VideoPageID) VideoPageID = .Value(Name_VideoPageID)
ReelsPageID = .Value(Name_ReelsPageID)
StoryBucket = .Value(Name_StoryBucket) StoryBucket = .Value(Name_StoryBucket)
ParsePhotoBlock = .Value(Name_ParsePhotoBlock).FromXML(Of Boolean)(True) ParsePhotoBlock = .Value(Name_ParsePhotoBlock).FromXML(Of Boolean)(True)
ParseVideoBlock = .Value(Name_ParseVideoBlock).FromXML(Of Boolean)(True) ParseVideoBlock = .Value(Name_ParseVideoBlock).FromXML(Of Boolean)(True)
ParseReelsBlock = .Value(Name_ParseReelsBlock).FromXML(Of Boolean)(False)
ParseStoriesBlock = .Value(Name_ParseStoriesBlock).FromXML(Of Boolean)(True) ParseStoriesBlock = .Value(Name_ParseStoriesBlock).FromXML(Of Boolean)(True)
Else Else
updateNames.Invoke updateNames.Invoke
.Add(Name_IsNoNameProfile, IsNoNameProfile.BoolToInteger) .Add(Name_IsNoNameProfile, IsNoNameProfile.BoolToInteger)
.Add(Name_OptionsParsed, OptionsParsed.BoolToInteger) .Add(Name_OptionsParsed, OptionsParsed.BoolToInteger)
.Add(Name_VideoPageID, VideoPageID) .Add(Name_VideoPageID, VideoPageID)
.Add(Name_ReelsPageID, ReelsPageID)
.Add(Name_StoryBucket, StoryBucket) .Add(Name_StoryBucket, StoryBucket)
.Add(Name_ParsePhotoBlock, ParsePhotoBlock.BoolToInteger) .Add(Name_ParsePhotoBlock, ParsePhotoBlock.BoolToInteger)
.Add(Name_ParseVideoBlock, ParseVideoBlock.BoolToInteger) .Add(Name_ParseVideoBlock, ParseVideoBlock.BoolToInteger)
.Add(Name_ParseReelsBlock, ParseReelsBlock.BoolToInteger)
.Add(Name_ParseStoriesBlock, ParseStoriesBlock.BoolToInteger) .Add(Name_ParseStoriesBlock, ParseStoriesBlock.BoolToInteger)
End If End If
End With End With
@@ -146,6 +156,7 @@ Namespace API.Facebook
Else Else
If DownloadImages And ParsePhotoBlock Then DownloadData_Photo(String.Empty, Token) If DownloadImages And ParsePhotoBlock Then DownloadData_Photo(String.Empty, Token)
If DownloadVideos And ParseVideoBlock Then DownloadData_Video(String.Empty, Token) If DownloadVideos And ParseVideoBlock Then DownloadData_Video(String.Empty, Token)
If DownloadVideos And ParseReelsBlock Then DownloadData_Reels(String.Empty, Token)
If (DownloadImages Or DownloadVideos) And ParseStoriesBlock Then DownloadData_Stories(Token) If (DownloadImages Or DownloadVideos) And ParseStoriesBlock Then DownloadData_Stories(Token)
End If End If
LoadSavePostsKV(False) LoadSavePostsKV(False)
@@ -158,10 +169,12 @@ Namespace API.Facebook
Private Const Header_fb_fr_name_Video As String = "PagesCometChannelTabAllVideosCardImplPaginationQuery" Private Const Header_fb_fr_name_Video As String = "PagesCometChannelTabAllVideosCardImplPaginationQuery"
Private Const Header_fb_fr_name_Stories As String = "StoriesSuspenseContentPaneRootWithEntryPointQuery" Private Const Header_fb_fr_name_Stories As String = "StoriesSuspenseContentPaneRootWithEntryPointQuery"
Private Const Header_fb_fr_name_SavedPosts As String = "CometSaveDashboardAllItemsPaginationQuery" Private Const Header_fb_fr_name_SavedPosts As String = "CometSaveDashboardAllItemsPaginationQuery"
Private Const Header_fb_fr_name_Reels As String = "ProfileCometAppCollectionReelsRendererPaginationQuery"
Private Const DocID_Photo As String = "6684543058255697" Private Const DocID_Photo As String = "6684543058255697"
Private Const DocID_Video As String = "24545934291687581" Private Const DocID_Video As String = "24545934291687581"
Private Const DocID_Stories As String = "6771064226315961" Private Const DocID_Stories As String = "6771064226315961"
Private Const DocID_SavedPosts As String = "7112228098805003" Private Const DocID_SavedPosts As String = "7112228098805003"
Private Const DocID_Reels As String = "28517740954539304"
Private Const Graphql_UrlPattern As String = "https://www.facebook.com/api/graphql?lsd={0}&doc_id={1}&server_timestamps=true&fb_dtsg={3}&fb_api_req_friendly_name={2}&variables={4}" Private Const Graphql_UrlPattern As String = "https://www.facebook.com/api/graphql?lsd={0}&doc_id={1}&server_timestamps=true&fb_dtsg={3}&fb_api_req_friendly_name={2}&variables={4}"
Private Const VideoHtmlUrlPattern As String = "https://www.facebook.com/watch/?v={0}" Private Const VideoHtmlUrlPattern As String = "https://www.facebook.com/watch/?v={0}"
Private Sub DownloadData_Photo(ByVal Cursor As String, ByVal Token As CancellationToken) Private Sub DownloadData_Photo(ByVal Cursor As String, ByVal Token As CancellationToken)
@@ -238,7 +251,7 @@ Namespace API.Facebook
Dim newPostsDetected As Boolean = False Dim newPostsDetected As Boolean = False
Dim pid As PostKV Dim pid As PostKV
If VideoPageID.IsEmptyString Then GetVideoPageID(Token) If VideoPageID.IsEmptyString Then GetVideoPageID(False, Token)
If VideoPageID.IsEmptyString Then Throw New TokensException("Unable to obtain 'VideoPageID'", False) If VideoPageID.IsEmptyString Then Throw New TokensException("Unable to obtain 'VideoPageID'", False)
ValidateBaseTokens() ValidateBaseTokens()
@@ -355,6 +368,123 @@ Namespace API.Facebook
ProcessException(ex, Token, $"data (stories) downloading error [{URL}]",, Responser) ProcessException(ex, Token, $"data (stories) downloading error [{URL}]",, Responser)
End Try End Try
End Sub End Sub
Private Sub DownloadData_Reels(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Const VarPattern$ = """count"":10,""cursor"":{0},""feedLocation"":""COMET_MEDIA_VIEWER"",""feedbackSource"":65,""focusCommentID"":null,""renderLocation"":null,""scale"":1,""useDefaultActor"":true,""id"":""{1}"",""__relay_internal__pv__FBReelsMediaFooter_comet_enable_reels_ads_gkrelayprovider"":true,""__relay_internal__pv__IsWorkUserrelayprovider"":false"
Try
Dim nextCursor$ = String.Empty
Dim newPostsDetected As Boolean = False
Dim nodeFound As Boolean = False
Dim pid As PostKV = Nothing
Dim __urlBase$ = String.Empty
Dim lines As List(Of String)
Dim j As EContainer, rr As EContainer
Dim jDataRoot As EContainer = Nothing
Dim indx% = -1
Dim s As New List(Of Sizes)
Dim videoIdNode$() = {"profile_reel_node", "node", "video", "id"}
Dim obtainBasePostData As Action = Sub()
If indx.ValueBetween(0, jDataRoot.Count - 1) Then
With jDataRoot(indx)
pid = New PostKV(String.Empty, .Item(videoIdNode).XmlIfNothingValue.
IfNullOrEmpty(.Value({"node"}, "id")), PageBlock.Reels)
pid.Code = $"Reels:{pid.ID}"
nextCursor = .Value("cursor")
If Not .Item(videoIdNode).XmlIfNothing.IsEmptyString Then
__urlBase = $"https://www.facebook.com/reel/{pid.ID}"
Else
__urlBase = String.Empty
End If
End With
Else
pid = Nothing
nextCursor = String.Empty
__urlBase = String.Empty
End If
End Sub
Dim createFile As Func(Of String, SFile, SFile) = Function(ByVal __url As String, ByVal cFile As SFile) As SFile
Dim f As New SFile(RegexReplace(__url, Regex_ReelsFilePattern))
If Not f.IsEmptyString Then Return f Else Return cFile
End Function
If ReelsPageID.IsEmptyString Then GetVideoPageID(True, Token)
If ReelsPageID.IsEmptyString Then Throw New TokensException("Unable to obtain 'ReelsPageID'", False)
ValidateBaseTokens()
URL = String.Format(Graphql_UrlPattern, Token_lsd, DocID_Reels, Header_fb_fr_name_Reels, Token_dtsg_Var,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(VarPattern, If(Cursor.IsEmptyString, "null", $"""{Cursor}"""), ReelsPageID) & "}"))
ResponserApplyDefs(Header_fb_fr_name_Reels)
ThrowAny(Token)
WaitTimer()
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
lines = r.StringToList(Of String)(vbCrLf).ListIfNothing
If lines.ListExists Then
For Each line$ In lines
j = JsonDocument.Parse(line, EDP.ReturnValue)
If j.ListExists Then
jDataRoot = j({"data", "node", "aggregated_fb_shorts", "edges"})
If jDataRoot.ListExists Then
With j({"extensions", "all_video_dash_prefetch_representations"})
If .ListExists Then
ProgressPre.ChangeMax(.Count)
For indx = 0 To .Count - 1
ProgressPre.Perform()
obtainBasePostData()
If Not pid.ID.IsEmptyString AndAlso Not PostKvExists(pid) Then
newPostsDetected = True
PostsKVIDs.ListAddValue(pid, LNC)
_TempPostsList.Add(pid.Code)
With .ItemF({indx, "representations"})
If .ListExists Then
s.Clear()
For Each rr In .Self : s.Add(New Sizes(rr.Value("width"), rr.Value("base_url"))) : Next
If s.Count > 0 Then s.RemoveAll(Function(ss) ss.Value = 0 Or ss.Data.IsEmptyString)
If s.Count > 0 Then
s.Sort()
_TempMediaList.ListAddValue(New UserMedia(s(0).Data, UTypes.Video) With {
.URL_BASE = __urlBase.IfNullOrEmpty(.URL_BASE),
.Post = pid.ID,
.File = createFile(s(0).Data, .File),
.SpecialFolder = "Reels*"
}, LNC)
s.Clear()
End If
End If
End With
If Limit > 0 And _TempMediaList.Count >= Limit Then j.Dispose() : Exit Sub
Else
j.Dispose()
Exit Sub
End If
Next
End If
End With
End If
j.Dispose()
End If
Next
End If
End If
If newPostsDetected And Not nextCursor.IsEmptyString Then DownloadData_Reels(nextCursor, Token)
Catch tex As TokensException When Not tex.BasicTokens
TokensException.SendToLog(Me, tex, "data (reels)")
Catch ex As Exception
ProcessException(ex, Token, $"data (reels) downloading error [{URL}]",, Responser)
End Try
End Sub
Private Sub DownloadData_SavedPosts(ByVal Cursor As String, ByVal Token As CancellationToken) Private Sub DownloadData_SavedPosts(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Const VarPattern$ = """content_filter"":[],""count"":10,""cursor"":{0},""scale"":1,""use_case"":""SAVE_DEFAULT""" Const VarPattern$ = """content_filter"":[],""count"":10,""cursor"":{0},""scale"":1,""use_case"":""SAVE_DEFAULT"""
@@ -507,13 +637,19 @@ Namespace API.Facebook
Return True Return True
End If End If
End Function End Function
Private Sub GetVideoPageID(ByVal Token As CancellationToken) Private Sub GetVideoPageID(ByVal GetReels As Boolean, ByVal Token As CancellationToken)
Dim URL$ = $"{GetProfileUrl()}\videos" Dim URL$ = $"{GetProfileUrl()}\{IIf(GetReels, "reels", "videos")}"
Dim resp As Responser = HtmlResponserCreate() Dim resp As Responser = HtmlResponserCreate()
Try Try
WaitTimer() WaitTimer()
Dim r$ = resp.GetResponse(URL) Dim r$ = resp.GetResponse(URL)
If Not r.IsEmptyString Then VideoPageID = RegexReplace(r, Regex_VideoPageID) If Not r.IsEmptyString Then
If GetReels Then
ReelsPageID = RegexReplace(r, Regex_ReelsPageID)
Else
VideoPageID = RegexReplace(r, Regex_VideoPageID)
End If
End If
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, "get video page ID",, resp) ProcessException(ex, Token, "get video page ID",, resp)
Finally Finally
@@ -658,17 +794,39 @@ Namespace API.Facebook
HtmlResponserDispose(resp) HtmlResponserDispose(resp)
End Try End Try
End Sub End Sub
Private Structure VideoResolution : Implements IComparable(Of VideoResolution)
Friend W As Integer
Friend H As Integer
Friend B As Integer
Friend U As String
Friend ReadOnly Property Wrong As Boolean
Get
Return W = 0 Or H = 0 Or B = 0 Or U.IsEmptyString
End Get
End Property
Private Function CompareTo(ByVal Other As VideoResolution) As Integer Implements IComparable(Of VideoResolution).CompareTo
Return CLng(Math.Max(W, H) * B).CompareTo(CLng(Math.Max(Other.W, Other.H) * Other.B)) * -1
End Function
End Structure
Protected Function ReparseSingleVideo(ByVal m As UserMedia, ByVal resp As Responser, ByRef result As Boolean) As UserMedia Protected Function ReparseSingleVideo(ByVal m As UserMedia, ByVal resp As Responser, ByRef result As Boolean) As UserMedia
Const nameSD$ = "browser_native_sd_url" Const nameSD$ = "browser_native_sd_url"
Const nameHD$ = "browser_native_hd_url" Const nameHD$ = "browser_native_hd_url"
Const nameDPR$ = "all_video_dash_prefetch_representations"
Const pattern$ = "<script type=""application/json""[^\>]*data-sjs>([^<]+?{0}[^<]+)<" Const pattern$ = "<script type=""application/json""[^\>]*data-sjs>([^<]+?{0}[^<]+)<"
Dim URL$ = String.Empty Dim URL$ = String.Empty
Dim j As EContainer = Nothing Dim j As EContainer = Nothing
Try Try
Dim r$, script$, __url$ Dim r$ = String.Empty, script$ = String.Empty, __url$ = String.Empty
Dim isNewNodes As Boolean = False
Dim __date As Date? = Nothing
Dim jNode As EContainer Dim jNode As EContainer
Dim jf As Predicate(Of EContainer) = Function(ee) Not ee.Name.IsEmptyString AndAlso (ee.Name.ToLower = nameSD Or ee.Name.ToLower = nameHD) Dim jf As Predicate(Of EContainer) = Function(ee) Not ee.Name.IsEmptyString AndAlso (ee.Name.ToLower = nameSD Or ee.Name.ToLower = nameHD)
Dim re As RParams = RParams.DMS("", 1, RegexOptions.IgnoreCase, EDP.ReturnValue) Dim re As RParams = RParams.DMS("", 1, RegexOptions.IgnoreCase, EDP.ReturnValue)
Dim nf As New XML.Base.NodeParams(nameDPR, True, True, True, True, 20)
Dim __extractScript As Action(Of String) = Sub(ByVal inputName As String)
re.Pattern = String.Format(pattern, inputName)
script = RegexReplace(r, re)
End Sub
If m.Post.ID.IsEmptyString Then If m.Post.ID.IsEmptyString Then
URL = m.URL_BASE URL = m.URL_BASE
Else Else
@@ -677,30 +835,47 @@ Namespace API.Facebook
WaitTimer() WaitTimer()
r = resp.GetResponse(URL) r = resp.GetResponse(URL)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
re.Pattern = String.Format(pattern, nameHD) __extractScript(nameHD)
script = RegexReplace(r, re) If script.IsEmptyString Then __extractScript(nameSD)
If script.IsEmptyString Then If script.IsEmptyString Then __extractScript(nameDPR) : isNewNodes = True
re.Pattern = String.Format(pattern, nameSD)
script = RegexReplace(r, re)
End If
If Not script.IsEmptyString Then If Not script.IsEmptyString Then
j = JsonDocument.Parse(script) j = JsonDocument.Parse(script)
If j.ListExists Then If j.ListExists Then
j.SetSourceReferences() j.SetSourceReferences()
jNode = j.Find(jf, True) If isNewNodes Then
If Not jNode Is Nothing Then jNode = j.GetNode({nf})
With DirectCast(jNode.Source, EContainer) If Not jNode Is Nothing Then
__url = .Value(nameHD).IfNullOrEmpty(.Value(nameSD)) With jNode.ItemF({0, "representations"})
If Not __url.IsEmptyString Then If .ListExists Then
m.URL = __url Dim intE As New ErrorsDescriber(False, False, False, 0)
m.URL_BASE = URL Dim intC As Func(Of String, Integer) = Function(__input) AConvert(Of Integer)(__input, intE)
m.Type = UTypes.Video Dim dataV As List(Of VideoResolution) = .Select(Function(jj) New VideoResolution With {
m.File = CreateFileFromUrl(__url) .W = intC(jj.Value("width")),
m.Post.Date = AConvert(Of Date)(.Value("publish_time"), UnixDate32Provider, Nothing) .H = intC(jj.Value("height")),
result = True .B = intC(jj.Value("bandwidth")),
Return m .U = jj.Value("base_url")}).ListIfNothing
End If If dataV.ListExists Then dataV.RemoveAll(Function(dd) dd.Wrong)
End With If dataV.ListExists Then dataV.Sort() : __url = dataV(0).U : dataV.Clear() : __date = m.Post.Date
End If
End With
End If
Else
jNode = j.Find(jf, True)
If Not jNode Is Nothing Then
With DirectCast(jNode.Source, EContainer)
__url = .Value(nameHD).IfNullOrEmpty(.Value(nameSD))
If Not __url.IsEmptyString Then __date = AConvert(Of Date)(.Value("publish_time"), UnixDate32Provider, Nothing)
End With
End If
End If
If Not __url.IsEmptyString Then
m.URL = __url
m.URL_BASE = URL
m.Type = UTypes.Video
m.File = CreateFileFromUrl(__url)
m.Post.Date = __date
result = True
Return m
End If End If
End If End If
End If End If
@@ -738,7 +913,10 @@ Namespace API.Facebook
#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)
_ContentList.Add(New UserMedia(Data.URL, UTypes.VideoPre) With {.Post = CStr(AConvert(Of String)(Data.URL, Regex_VideoIDFromURL, String.Empty))}) _ContentList.Add(New UserMedia(Data.URL, UTypes.VideoPre) With {
.Post = CStr(AConvert(Of String)(Data.URL, Regex_VideoIDFromURL, String.Empty)),
.State = UStates.Missing
})
ReparseMissing(Token) ReparseMissing(Token)
End Sub End Sub
#End Region #End Region

View File

@@ -13,6 +13,8 @@ Namespace API.Facebook
Friend Property ParsePhotoBlock As Boolean = True Friend Property ParsePhotoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseVideoBlock), NameOf(MySettings))> <PSetting(NameOf(SiteSettings.ParseVideoBlock), NameOf(MySettings))>
Friend Property ParseVideoBlock As Boolean = True Friend Property ParseVideoBlock As Boolean = True
<PSetting(NameOf(SiteSettings.ParseReelsBlock), NameOf(MySettings))>
Friend Property ParseReelsBlock As Boolean = False
<PSetting(NameOf(SiteSettings.ParseStoriesBlock), NameOf(MySettings))> <PSetting(NameOf(SiteSettings.ParseStoriesBlock), NameOf(MySettings))>
Friend Property ParseStoriesBlock As Boolean = True Friend Property ParseStoriesBlock As Boolean = True
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
@@ -20,12 +22,14 @@ Namespace API.Facebook
MySettings = u.HostCollection.Default.Source MySettings = u.HostCollection.Default.Source
ParsePhotoBlock = u.ParsePhotoBlock ParsePhotoBlock = u.ParsePhotoBlock
ParseVideoBlock = u.ParseVideoBlock ParseVideoBlock = u.ParseVideoBlock
ParseReelsBlock = u.ParseReelsBlock
ParseStoriesBlock = u.ParseStoriesBlock ParseStoriesBlock = u.ParseStoriesBlock
End Sub End Sub
Friend Sub New(ByVal s As SiteSettings) Friend Sub New(ByVal s As SiteSettings)
MySettings = s MySettings = s
ParsePhotoBlock = s.ParsePhotoBlock.Value ParsePhotoBlock = s.ParsePhotoBlock.Value
ParseVideoBlock = s.ParseVideoBlock.Value ParseVideoBlock = s.ParseVideoBlock.Value
ParseReelsBlock = s.ParseReelsBlock.Value
ParseStoriesBlock = s.ParseStoriesBlock.Value ParseStoriesBlock = s.ParseStoriesBlock.Value
End Sub End Sub
End Class End Class

View File

@@ -8,7 +8,8 @@
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Namespace API.Instagram Namespace API.Instagram
Friend Class EditorExchangeOptions Friend NotInheritable Class EditorExchangeOptions : Inherits Base.EditorExchangeOptionsBase
#Region "Download"
<PSetting(Caption:="Get timeline", ToolTip:="Download user timeline")> <PSetting(Caption:="Get timeline", ToolTip:="Download user timeline")>
Friend Property GetTimeline As Boolean Friend Property GetTimeline As Boolean
<PSetting(Caption:="Get reels", ToolTip:="Download user reels")> <PSetting(Caption:="Get reels", ToolTip:="Download user reels")>
@@ -19,13 +20,45 @@ Namespace API.Instagram
Friend Property GetStoriesUser As Boolean Friend Property GetStoriesUser As Boolean
<PSetting(Caption:="Get tagged posts", ToolTip:="Download user tagged posts")> <PSetting(Caption:="Get tagged posts", ToolTip:="Download user tagged posts")>
Friend Property GetTagged As Boolean Friend Property GetTagged As Boolean
#End Region
#Region "Extract image"
<PSetting(Caption:="Extract image from video: timeline")>
Friend Property GetTimeline_VideoPic As Boolean
<PSetting(Caption:="Extract image from video: reels")>
Friend Property GetReels_VideoPic As Boolean
<PSetting(Caption:="Extract image from video: stories")>
Friend Property GetStories_VideoPic As Boolean
<PSetting(Caption:="Extract image from video: stories: user")>
Friend Property GetStoriesUser_VideoPic As Boolean
<PSetting(Caption:="Extract image from video: tagged posts")>
Friend Property GetTagged_VideoPic As Boolean
#End Region
<PSetting(Caption:="Place the extracted image into the video folder")>
Friend Property PutImageVideoFolder As Boolean
Friend Overrides Property UserName As String
<PSetting(Address:=SettingAddress.User, Caption:="Force update UserName", ToolTip:="Try to force update UserName if it is not found on the site")>
Friend Property ForceUpdateUserName As Boolean = False
<PSetting(Address:=SettingAddress.User, Caption:="Force update user information")>
Friend Property ForceUpdateUserInfo As Boolean = False
Friend Sub New(ByVal u As UserData) Friend Sub New(ByVal u As UserData)
MyBase.New(u)
With u With u
GetTimeline = .GetTimeline GetTimeline = .GetTimeline
GetReels = .GetReels GetReels = .GetReels
GetStories = .GetStories GetStories = .GetStories
GetStoriesUser = .GetStoriesUser GetStoriesUser = .GetStoriesUser
GetTagged = .GetTaggedData GetTagged = .GetTaggedData
GetTimeline_VideoPic = .GetTimeline_VideoPic
GetReels_VideoPic = .GetReels_VideoPic
GetStories_VideoPic = .GetStories_VideoPic
GetStoriesUser_VideoPic = .GetStoriesUser_VideoPic
GetTagged_VideoPic = .GetTaggedData_VideoPic
PutImageVideoFolder = .PutImageVideoFolder
ForceUpdateUserName = .ForceUpdateUserName
ForceUpdateUserInfo = .ForceUpdateUserInfo
End With End With
End Sub End Sub
Friend Sub New(ByVal s As SiteSettings) Friend Sub New(ByVal s As SiteSettings)
@@ -35,6 +68,14 @@ Namespace API.Instagram
GetStories = CBool(.GetStories.Value) GetStories = CBool(.GetStories.Value)
GetStoriesUser = CBool(.GetStoriesUser.Value) GetStoriesUser = CBool(.GetStoriesUser.Value)
GetTagged = CBool(.GetTagged.Value) GetTagged = CBool(.GetTagged.Value)
GetTimeline_VideoPic = CBool(.GetTimeline_VideoPic.Value)
GetReels_VideoPic = CBool(.GetReels_VideoPic.Value)
GetStories_VideoPic = CBool(.GetStories_VideoPic.Value)
GetStoriesUser_VideoPic = CBool(.GetStoriesUser_VideoPic.Value)
GetTagged_VideoPic = CBool(.GetTagged_VideoPic.Value)
PutImageVideoFolder = CBool(.PutImageVideoFolder.Value)
End With End With
End Sub End Sub
End Class End Class

View File

@@ -16,8 +16,8 @@ Imports PersonalUtilities.Tools.Web.Cookies
Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports Download = SCrawler.Plugin.ISiteSettings.Download
Imports DN = SCrawler.API.Base.DeclaredNames Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Instagram Namespace API.Instagram
<Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False)> <Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False), UseDownDetector>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase : Implements DownDetector.IDownDetector
#Region "Declarations" #Region "Declarations"
#Region "Providers" #Region "Providers"
Friend Class TimersChecker : Inherits FieldsCheckerProviderBase Friend Class TimersChecker : Inherits FieldsCheckerProviderBase
@@ -57,8 +57,11 @@ Namespace API.Instagram
#End Region #End Region
#Region "Categories" #Region "Categories"
Private Const CAT_DOWN As String = "Download data" Private Const CAT_DOWN As String = "Download data"
Private Const CAT_UserDefs_VIDEO As String = DN.CAT_UserDefs & ": extract image from video"
Private Const CAT_ERRORS As String = "Errors"
#End Region #End Region
#Region "Authorization properties" #Region "Properties"
#Region "Authorization"
Friend Const Header_IG_APP_ID As String = "x-ig-app-id" Friend Const Header_IG_APP_ID As String = "x-ig-app-id"
Friend Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim" Friend Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Friend Const Header_CSRF_TOKEN As String = "x-csrftoken" Friend Const Header_CSRF_TOKEN As String = "x-csrftoken"
@@ -67,18 +70,18 @@ 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), ControlNumber(2), PClonable(Clone:=False)> <PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Can be automatically extracted from cookies", IsAuth:=True, AllowNull:=True), 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
Return c.GetCookieValue(Header_CSRF_TOKEN_COOKIE, PropName, NameOf(HH_CSRF_TOKEN)) Return c.GetCookieValue(Header_CSRF_TOKEN_COOKIE, PropName, NameOf(HH_CSRF_TOKEN))
End Function End Function
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3), 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), ControlNumber(4), PClonable(Clone:=False)> <PropertyOption(ControlText:="x-asbd-id", IsAuth:=True, AllowNull:=True), 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)
<ControlNumber(5), PClonable(Clone:=False)> <PClonable(Clone:=False)>
Friend ReadOnly Property HH_IG_WWW_CLAIM As PropertyValue Friend ReadOnly Property HH_IG_WWW_CLAIM As PropertyValue
Private ReadOnly Property HH_IG_WWW_CLAIM_IS_ZERO As Boolean Private ReadOnly Property HH_IG_WWW_CLAIM_IS_ZERO As Boolean
Get Get
@@ -87,16 +90,16 @@ Namespace API.Instagram
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:=True,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua), ControlNumber(6), 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:=True,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_full_version_list), ControlNumber(7), 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:=True, LeftOffset:=135,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_platform_version), ControlNumber(8), 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:=True,
InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent), ControlNumber(9), 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
Return Responser.CookiesExists And ACheck(HH_IG_APP_ID.Value) And ACheck(HH_CSRF_TOKEN.Value) Return Responser.CookiesExists And ACheck(HH_IG_APP_ID.Value) And ACheck(HH_CSRF_TOKEN.Value)
@@ -125,99 +128,167 @@ Namespace API.Instagram
End If End If
End Sub End Sub
#Region "HH_IG_WWW_CLAIM" #Region "HH_IG_WWW_CLAIM"
<PropertyOption(ControlText:="ig-www-claim update interval", IsAuth:=True, LeftOffset:=150), PXML, ControlNumber(10), PClonable, HiddenControl> <PropertyOption(ControlText:="ig-www-claim update interval", IsAuth:=True, LeftOffset:=150), PXML, PClonable, HiddenControl>
Private ReadOnly Property HH_IG_WWW_CLAIM_UPDATE_INTERVAL As PropertyValue Private ReadOnly Property HH_IG_WWW_CLAIM_UPDATE_INTERVAL As PropertyValue
<PropertyOption(ControlText:="ig-www-claim: always 0", ControlToolTip:="Keep token value always = 0", IsAuth:=True), <PropertyOption(ControlText:="ig-www-claim: always 0", ControlToolTip:="Keep token value always = 0", IsAuth:=True),
PXML, ControlNumber(11), PClonable, HiddenControl> PXML, PClonable, HiddenControl>
Friend ReadOnly Property HH_IG_WWW_CLAIM_ALWAYS_ZERO As PropertyValue Friend ReadOnly Property HH_IG_WWW_CLAIM_ALWAYS_ZERO As PropertyValue
<PropertyOption(ControlText:="ig-www-claim: reset each session", ControlToolTip:="Set 'x-ig-www-claim' to '0' before each session", IsAuth:=True), <PropertyOption(ControlText:="ig-www-claim: reset each session", ControlToolTip:="Set 'x-ig-www-claim' to '0' before each session", IsAuth:=True),
PXML, ControlNumber(12), PClonable, HiddenControl> PXML, PClonable, HiddenControl>
Friend ReadOnly Property HH_IG_WWW_CLAIM_RESET_EACH_SESSION As PropertyValue Friend ReadOnly Property HH_IG_WWW_CLAIM_RESET_EACH_SESSION As PropertyValue
<PropertyOption(ControlText:="ig-www-claim: reset each target", ControlToolTip:="Set 'x-ig-www-claim' to '0' before each target", IsAuth:=True), <PropertyOption(ControlText:="ig-www-claim: reset each target", ControlToolTip:="Set 'x-ig-www-claim' to '0' before each target", IsAuth:=True),
PXML, ControlNumber(13), PClonable, HiddenControl> PXML, PClonable, HiddenControl>
Friend ReadOnly Property HH_IG_WWW_CLAIM_RESET_EACH_TARGET As PropertyValue Friend ReadOnly Property HH_IG_WWW_CLAIM_RESET_EACH_TARGET As PropertyValue
<PropertyOption(ControlText:="ig-www-claim: use in requests", IsAuth:=True), PXML, ControlNumber(14), PClonable, HiddenControl> <PropertyOption(ControlText:="ig-www-claim: use in requests", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property HH_IG_WWW_CLAIM_USE As PropertyValue Friend ReadOnly Property HH_IG_WWW_CLAIM_USE As PropertyValue
<PropertyOption(ControlText:="ig-www-claim: use default algorithm to update", IsAuth:=True), PXML, ControlNumber(15), PClonable, HiddenControl> <PropertyOption(ControlText:="ig-www-claim: use default algorithm to update", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO As PropertyValue Friend ReadOnly Property HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO As PropertyValue
<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, ControlNumber(16), PClonable> <PropertyOption(ControlText:="Use GraphQL to download", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property USE_GQL As PropertyValue Friend ReadOnly Property USE_GQL As PropertyValue
#End Region #End Region
#Region "Download properties" #Region "Download data"
<PropertyOption(ControlText:="DownDetector", <PropertyOption(ControlText:="Download timeline", Category:=CAT_DOWN), PXML, PClonable>
ControlToolTip:="Use 'DownDetector' to determine if the site is accessible. -1 to disable." & vbCr & Friend ReadOnly Property DownloadTimeline As PropertyValue
"The value represents the average number of error reports over the last 4 hours"), <PXML> Private ReadOnly Property DownloadTimeline_Def As PropertyValue
PClonable, PXML, ControlNumber(17)> <PropertyOption(ControlText:="Download reels", Category:=CAT_DOWN), PXML, PClonable>
Private ReadOnly Property DownDetectorValue As PropertyValue Friend ReadOnly Property DownloadReels As PropertyValue
<Provider(NameOf(DownDetectorValue), FieldsChecker:=True)> <PXML> Private ReadOnly Property DownloadReels_Def As PropertyValue
Private ReadOnly Property DownDetectorValueProvider As IFormatProvider <PropertyOption(ControlText:="Download stories", Category:=CAT_DOWN), PXML, PClonable>
<PropertyOption(ControlText:="Add 'DownDetector' information to the log."), PClonable, PXML, ControlNumber(18), HiddenControl> Friend ReadOnly Property DownloadStories As PropertyValue
Private ReadOnly Property DownDetectorValueAddToLog As PropertyValue <PXML> Private ReadOnly Property DownloadStories_Def As PropertyValue
<PropertyOption(ControlText:="Download stories: user", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property DownloadStoriesUser As PropertyValue
<PXML> Private ReadOnly Property DownloadStoriesUser_Def As PropertyValue
<PropertyOption(ControlText:="Download tagged posts", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property DownloadTagged As PropertyValue
<PXML> Private ReadOnly Property DownloadTagged_Def As PropertyValue
#End Region
#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."
<PropertyOption(ControlText:="Request timer (any)", <PropertyOption(ControlText:="Request timer (any)",
ControlToolTip:="The timer (in milliseconds) that SCrawler should wait before executing the next request." & ControlToolTip:="The timer (in milliseconds) that SCrawler should wait before executing the next request." &
vbCr & "The default value is 1'000." & vbCr & "The minimum value is 0." & TimersUrgentTip, AllowNull:=False, Category:=DN.CAT_Timers), vbCr & "The default value is 1'000." & vbCr & "The minimum value is 0." & TimersUrgentTip, AllowNull:=False, Category:=DN.CAT_Timers),
PXML, ControlNumber(19), PClonable> PXML, PClonable>
Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue
<Provider(NameOf(RequestsWaitTimer_Any), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimer_Any), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimer_AnyProvider As IFormatProvider Private ReadOnly Property RequestsWaitTimer_AnyProvider As IFormatProvider
<PropertyOption(ControlText:="Request timer", <PropertyOption(ControlText:="Request timer",
ControlToolTip:="The time value (in milliseconds) that the program will wait before processing the next 'Request time counter' request." & ControlToolTip:="The time value (in milliseconds) that the program will wait before processing the next 'Request time counter' request." &
vbCr & "The default value is 1'000." & vbCr & "The minimum value is 100." & TimersUrgentTip, vbCr & "The default value is 1'000." & vbCr & "The minimum value is 100." & TimersUrgentTip,
AllowNull:=False, Category:=DN.CAT_Timers), PXML, ControlNumber(20), PClonable> AllowNull:=False, Category:=DN.CAT_Timers), PXML, PClonable>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider
<PropertyOption(ControlText:="Request timer counter", <PropertyOption(ControlText:="Request timer counter",
ControlToolTip:="How many requests will be sent to Instagram before the program waits 'Request timer'." & ControlToolTip:="How many requests will be sent to Instagram before the program waits 'Request timer'." &
vbCr & "The default value is 1." & vbCr & "The minimum value is 1." & TimersUrgentTip, vbCr & "The default value is 1." & vbCr & "The minimum value is 1." & TimersUrgentTip,
AllowNull:=False, LeftOffset:=120, Category:=DN.CAT_Timers), PXML, ControlNumber(21), PClonable> AllowNull:=False, LeftOffset:=120, Category:=DN.CAT_Timers), PXML, PClonable>
Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue
<Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider
<PropertyOption(ControlText:="Posts limit timer", <PropertyOption(ControlText:="Posts limit timer",
ControlToolTip:="The time value (in milliseconds) the program will wait before processing the next request after 195 requests." & ControlToolTip:="The time value (in milliseconds) the program will wait before processing the next request after 195 requests." &
vbCr & "The default value is 60'000." & vbCr & "The minimum value is 10'000." & TimersUrgentTip, vbCr & "The default value is 60'000." & vbCr & "The minimum value is 10'000." & TimersUrgentTip,
AllowNull:=False, Category:=DN.CAT_Timers), PXML, ControlNumber(22), PClonable> AllowNull:=False, Category:=DN.CAT_Timers), PXML, PClonable>
Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue
<Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)> <Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider
<PropertyOption(ControlText:="Get timeline", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, ControlNumber(23), PClonable> #End Region
#Region "New user defaults"
<PropertyOption(ControlText:="Get timeline", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetTimeline As PropertyValue Friend ReadOnly Property GetTimeline As PropertyValue
<PropertyOption(ControlText:="Get reels", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, ControlNumber(24), PClonable> <PropertyOption(ControlText:="From timeline", ControlToolTip:="Default value for new users", Category:=CAT_UserDefs_VIDEO), PXML, PClonable>
Friend ReadOnly Property GetTimeline_VideoPic As PropertyValue
<PropertyOption(ControlText:="Get reels", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetReels As PropertyValue Friend ReadOnly Property GetReels As PropertyValue
<PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, ControlNumber(25), PClonable> <PropertyOption(ControlText:="From reels", ControlToolTip:="Default value for new users", Category:=CAT_UserDefs_VIDEO), PXML, PClonable>
Friend ReadOnly Property GetReels_VideoPic As PropertyValue
<PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetStories As PropertyValue Friend ReadOnly Property GetStories As PropertyValue
<PropertyOption(ControlText:="Get stories: user", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, ControlNumber(26), PClonable> <PropertyOption(ControlText:="From stories", ControlToolTip:="Default value for new users", Category:=CAT_UserDefs_VIDEO), PXML, PClonable>
Friend ReadOnly Property GetStories_VideoPic As PropertyValue
<PropertyOption(ControlText:="Get stories: user", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetStoriesUser As PropertyValue Friend ReadOnly Property GetStoriesUser As PropertyValue
<PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, ControlNumber(27), PClonable> <PropertyOption(ControlText:="From stories: user", ControlToolTip:="Default value for new users", Category:=CAT_UserDefs_VIDEO), PXML, PClonable>
Friend ReadOnly Property GetStoriesUser_VideoPic As PropertyValue
<PropertyOption(ControlText:="Get tagged posts", ControlToolTip:="Default value for new users", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GetTagged As PropertyValue Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="From tagged posts", ControlToolTip:="Default value for new users", Category:=CAT_UserDefs_VIDEO), PXML, PClonable>
Friend ReadOnly Property GetTagged_VideoPic As PropertyValue
<PropertyOption(ControlText:="From saved posts", ControlToolTip:="Default value for new users", Category:=CAT_UserDefs_VIDEO), PXML, PClonable>
Friend ReadOnly Property GetSavedPosts_VideoPic As PropertyValue
<PropertyOption(ControlText:="Place the extracted image into the video folder", ControlToolTip:="Default value for new users", Category:=CAT_UserDefs_VIDEO), PXML, PClonable>
Friend ReadOnly Property PutImageVideoFolder As PropertyValue
#End Region
#Region "Errors"
Private Const ErrorsDefault As String = "572"
<PropertyOption(ControlText:="Skip errors",
ControlToolTip:="Skip the following errors (comma separated)." & vbCr &
"Facing these errors will not disable the download, but will add a simple line to the log.", Category:=CAT_ERRORS),
PClonable, PXML>
Private ReadOnly Property SkipErrors As PropertyValue
<PropertyOption(ControlText:="Add skipped errors to the log", Category:=CAT_ERRORS), PClonable, PXML>
Private ReadOnly Property SkipErrors_AddToLog As PropertyValue
<PropertyOption(ControlText:="Skip errors (exclude)",
ControlToolTip:="Exclude the following errors from being added to the log (comma separated)", Category:=CAT_ERRORS), PClonable, PXML>
Private ReadOnly Property SkipErrors_AddToLog_Silent As PropertyValue
Friend ReadOnly Property ErrorSpecialHandling(ByVal ErrCode As Integer) As Boolean
Get
With CStr(SkipErrors.Value) : Return Not .IsEmptyString AndAlso .Contains(ErrCode) : End With
End Get
End Property
Friend ReadOnly Property ErrorSpecialHandling_AddToLog(ByVal ErrCode As Integer) As Boolean
Get
With CStr(SkipErrors_AddToLog_Silent.Value)
Return CBool(SkipErrors_AddToLog.Value) AndAlso (.IsEmptyString OrElse Not .Contains(ErrCode))
End With
End Get
End Property
<PropertyOption(ControlText:="Ignore stories downloading errors (560)",
ControlToolTip:="If checked, error 560 will be skipped and the download will continue. Otherwise, the download will be interrupted.",
Category:=CAT_ERRORS), PClonable, PXML>
Friend ReadOnly Property IgnoreStoriesDownloadingErrors As PropertyValue
#End Region
#Region "Other params"
<PropertyOption(ControlText:="DownDetector",
ControlToolTip:="Use 'DownDetector' to determine if the site is accessible. -1 to disable." & vbCr &
"The value represents the average number of error reports over the last 4 hours"),
PClonable, PXML>
Private ReadOnly Property DownDetectorValue As PropertyValue
<Provider(NameOf(DownDetectorValue), FieldsChecker:=True)>
Private ReadOnly Property DownDetectorValueProvider As IFormatProvider
<PropertyOption(ControlText:="Add 'DownDetector' information to the log."), PClonable, PXML, HiddenControl>
Private ReadOnly Property DownDetectorValueAddToLog As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit", <PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr & ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr &
"-1 to disable"), PXML, ControlNumber(27), PClonable> "-1 to disable"), PXML, PClonable>
Friend ReadOnly Property TaggedNotifyLimit As PropertyValue Friend ReadOnly Property TaggedNotifyLimit As PropertyValue
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)> <Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region #End Region
#Region "Download ready" #End Region
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline", Category:=CAT_DOWN), PXML, ControlNumber(10), PClonable> #Region "IDownDetector Support"
Friend ReadOnly Property DownloadTimeline As PropertyValue Private ReadOnly Property IDownDetector_Value As Integer Implements DownDetector.IDownDetector.Value
<PXML> Private ReadOnly Property DownloadTimeline_Def As PropertyValue Get
<PropertyOption(ControlText:="Download reels", ControlToolTip:="Download reels", Category:=CAT_DOWN), PXML, ControlNumber(11), PClonable> Return DownDetectorValue.Value
Friend ReadOnly Property DownloadReels As PropertyValue End Get
<PXML> Private ReadOnly Property DownloadReels_Def As PropertyValue End Property
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories", Category:=CAT_DOWN), PXML, ControlNumber(12), PClonable> Private ReadOnly Property IDownDetector_AddToLog As Boolean Implements DownDetector.IDownDetector.AddToLog
Friend ReadOnly Property DownloadStories As PropertyValue Get
<PXML> Private ReadOnly Property DownloadStories_Def As PropertyValue Return DownDetectorValueAddToLog.Value
<PropertyOption(ControlText:="Download stories: user", ControlToolTip:="Download stories (user)", Category:=CAT_DOWN), PXML, ControlNumber(13), PClonable> End Get
Friend ReadOnly Property DownloadStoriesUser As PropertyValue End Property
<PXML> Private ReadOnly Property DownloadStoriesUser_Def As PropertyValue Private ReadOnly Property IDownDetector_CheckSite As String Implements DownDetector.IDownDetector.CheckSite
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts", Category:=CAT_DOWN), PXML, ControlNumber(14), PClonable> Get
Friend ReadOnly Property DownloadTagged As PropertyValue Return "instagram"
<PXML> Private ReadOnly Property DownloadTagged_Def As PropertyValue End Get
End Property
Private Function IDownDetector_Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean Implements DownDetector.IDownDetector.Available
Return MDD.Available(What, Silent)
End Function
#End Region #End Region
#Region "429 bypass" #Region "429 bypass"
<PXML("InstagramDownloadingErrorDate")> <PXML("InstagramDownloadingErrorDate")>
@@ -251,8 +322,40 @@ Namespace API.Instagram
End Get End Get
End Property End Property
Private Const LastDownloadDateResetInterval As Integer = 60 Private Const LastDownloadDateResetInterval As Integer = 60
Private TooManyRequestsReadyForCatch As Boolean = True
Friend Function GetWaitDate() As Date
With DownloadingErrorDate
If ACheck(Of Date)(.Value) Then
Return CDate(.Value).AddMinutes(If(LastApplyingValue, 10))
Else
Return Now
End If
End With
End Function
Friend Sub TooManyRequests(ByVal Catched As Boolean)
With DownloadingErrorDate
If Catched Then
If Not ACheck(Of Date)(.Value) Then
.Value = Now
If TooManyRequestsReadyForCatch Then
LastApplyingValue = If(LastApplyingValue, 0) + 10
TooManyRequestsReadyForCatch = False
MyMainLOG = $"Instagram downloading error: too many requests. Try again after {If(LastApplyingValue, 10)} minutes..."
End If
End If
Else
.Value = Nothing
LastApplyingValue = Nothing
TooManyRequestsReadyForCatch = True
End If
End With
End Sub
#End Region
#Region "LastRequestsCount, Label"
<PXML> Private ReadOnly Property LastDownloadDate As PropertyValue <PXML> Private ReadOnly Property LastDownloadDate As PropertyValue
<PXML> Private ReadOnly Property LastRequestsCount As PropertyValue <PXML> Private ReadOnly Property LastRequestsCount As PropertyValue
<PropertyOption(IsInformationLabel:=True)>
Private ReadOnly Property LastRequestsCountLabel As PropertyValue
Private ReadOnly MyLastRequests As Dictionary(Of Date, Integer) Private ReadOnly MyLastRequests As Dictionary(Of Date, Integer)
Private ReadOnly Property MyLastRequestsDate As Date Private ReadOnly Property MyLastRequestsDate As Date
Get Get
@@ -306,36 +409,6 @@ Namespace API.Instagram
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[SiteSettings.Instagram.RefreshMyLastRequests]") ErrorsDescriber.Execute(EDP.SendToLog, ex, "[SiteSettings.Instagram.RefreshMyLastRequests]")
End Try End Try
End Sub End Sub
<PropertyOption(IsInformationLabel:=True), ControlNumber(100)>
Private ReadOnly Property LastRequestsCountLabel As PropertyValue
Private TooManyRequestsReadyForCatch As Boolean = True
Friend Function GetWaitDate() As Date
With DownloadingErrorDate
If ACheck(Of Date)(.Value) Then
Return CDate(.Value).AddMinutes(If(LastApplyingValue, 10))
Else
Return Now
End If
End With
End Function
Friend Sub TooManyRequests(ByVal Catched As Boolean)
With DownloadingErrorDate
If Catched Then
If Not ACheck(Of Date)(.Value) Then
.Value = Now
If TooManyRequestsReadyForCatch Then
LastApplyingValue = If(LastApplyingValue, 0) + 10
TooManyRequestsReadyForCatch = False
MyMainLOG = $"Instagram downloading error: too many requests. Try again after {If(LastApplyingValue, 10)} minutes..."
End If
End If
Else
.Value = Nothing
LastApplyingValue = Nothing
TooManyRequestsReadyForCatch = True
End If
End With
End Sub
#End Region #End Region
#End Region #End Region
#Region "Initializer" #Region "Initializer"
@@ -412,9 +485,6 @@ Namespace API.Instagram
DownloadTagged = New PropertyValue(False) DownloadTagged = New PropertyValue(False)
DownloadTagged_Def = New PropertyValue(DownloadTagged.Value, GetType(Boolean)) DownloadTagged_Def = New PropertyValue(DownloadTagged.Value, GetType(Boolean))
DownDetectorValue = New PropertyValue(20)
DownDetectorValueProvider = New TimersChecker(-1)
DownDetectorValueAddToLog = New PropertyValue(False)
RequestsWaitTimer_Any = New PropertyValue(1000) RequestsWaitTimer_Any = New PropertyValue(1000)
RequestsWaitTimer_AnyProvider = New TimersChecker(0) RequestsWaitTimer_AnyProvider = New TimersChecker(0)
RequestsWaitTimer = New PropertyValue(1000) RequestsWaitTimer = New PropertyValue(1000)
@@ -425,10 +495,26 @@ Namespace API.Instagram
SleepTimerOnPostsLimitProvider = New TimersChecker(10000) SleepTimerOnPostsLimitProvider = New TimersChecker(10000)
GetTimeline = New PropertyValue(True) GetTimeline = New PropertyValue(True)
GetTimeline_VideoPic = New PropertyValue(True)
GetReels = New PropertyValue(False) GetReels = New PropertyValue(False)
GetReels_VideoPic = New PropertyValue(True)
GetStories = New PropertyValue(False) GetStories = New PropertyValue(False)
GetStories_VideoPic = New PropertyValue(True)
GetStoriesUser = New PropertyValue(False) GetStoriesUser = New PropertyValue(False)
GetStoriesUser_VideoPic = New PropertyValue(True)
GetTagged = New PropertyValue(False) GetTagged = New PropertyValue(False)
GetTagged_VideoPic = New PropertyValue(True)
GetSavedPosts_VideoPic = New PropertyValue(True)
PutImageVideoFolder = New PropertyValue(False)
SkipErrors = New PropertyValue(ErrorsDefault)
SkipErrors_AddToLog = New PropertyValue(True)
SkipErrors_AddToLog_Silent = New PropertyValue(String.Empty, GetType(String))
IgnoreStoriesDownloadingErrors = New PropertyValue(False)
DownDetectorValue = New PropertyValue(20)
DownDetectorValueProvider = New TimersChecker(-1)
DownDetectorValueAddToLog = New PropertyValue(False)
TaggedNotifyLimit = New PropertyValue(200) TaggedNotifyLimit = New PropertyValue(200)
TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
@@ -438,14 +524,26 @@ Namespace API.Instagram
LastRequestsCountLabel = New PropertyValue(String.Empty, GetType(String)) LastRequestsCountLabel = New PropertyValue(String.Empty, GetType(String))
MyLastRequests = New Dictionary(Of Date, Integer) MyLastRequests = New Dictionary(Of Date, Integer)
MDD = New DownDetector.Checker(Of SiteSettings)(Me)
_AllowUserAgentUpdate = False _AllowUserAgentUpdate = False
UrlPatternUser = "https://www.instagram.com/{0}/" UrlPatternUser = "https://www.instagram.com/{0}/"
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
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
SettingsVersion.Value = SettingsVersionCurrent
HH_IG_WWW_CLAIM_UPDATE_INTERVAL.Value = 120
HH_IG_WWW_CLAIM_ALWAYS_ZERO.Value = False
HH_IG_WWW_CLAIM_RESET_EACH_SESSION.Value = True
HH_IG_WWW_CLAIM_RESET_EACH_TARGET.Value = True
HH_IG_WWW_CLAIM_USE.Value = True
HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO.Value = True
End If
MyBase.EndInit() MyBase.EndInit()
End Sub End Sub
#End Region #End Region
@@ -475,75 +573,25 @@ Namespace API.Instagram
End Function End Function
#End Region #End Region
#Region "Downloading" #Region "Downloading"
Private ____DownloadStarted As Boolean = False Private ReadOnly MDD As DownDetector.Checker(Of SiteSettings)
Private ____AvailableRequested As Boolean = False Private Sub ResetDownloadOptions()
Private ____AvailableSilent As Boolean = True If ActiveJobs < 1 Then
Private ____AvailableChecked As Boolean = False MDD.Reset()
Private ____AvailableResult As Boolean = False If ActiveSessionRequestsExists Then RefreshMyLastRequests(Now)
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean ActiveSessionRequestsExists = False
If MyBase.Available(What, Silent) Then _NextWNM = UserData.WNM.Notify
If CInt(DownDetectorValue.Value) >= 0 Then _NextTagged = True
If ____DownloadStarted Then SkipUntilNextSession = False
____AvailableRequested = True
____AvailableSilent = Silent
Return True
Else
Return AvailableImpl(What, Silent)
End If
Else
Return True
End If
Else
Return False
End If
End Function
#Disable Warning IDE0060
Private Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean
#Enable Warning
Try
AvailableText = String.Empty AvailableText = String.Empty
If CInt(DownDetectorValue.Value) = -1 Then ActiveJobs = 0
Return True End If
Else End Sub
Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("instagram") Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
If dl.ListExists Then Return MyBase.Available(What, Silent) And ActiveJobs < 2
dl = dl.Take(4).ToList
Dim avg% = dl.Average(Function(d) d.Value)
If avg > CInt(DownDetectorValue.Value) Then
AvailableText = "Over the past hour, Instagram has received an average of " &
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
dl.ListToString(vbCr)
If CBool(DownDetectorValueAddToLog.Value) Then MyMainLOG = AvailableText
If Silent Then
Return False
Else
Return MsgBoxE({$"{AvailableText}{vbCr}{vbCr}Do you want to continue parsing Instagram data?",
"There are outage reports on Instagram"}, vbYesNo) = vbYes
End If
End If
End If
Return True
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[API.Instagram.SiteSettings.Available]", True)
End Try
End Function End Function
Friend Property SkipUntilNextSession As Boolean = False Friend Property SkipUntilNextSession As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso CBool(DownloadTimeline.Value) Then Return ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso CBool(DownloadTimeline.Value)
If ____DownloadStarted And ____AvailableRequested Then
____AvailableResult = AvailableImpl(What, ____AvailableSilent)
____AvailableChecked = True
____AvailableRequested = False
Return ____AvailableResult
ElseIf ____AvailableChecked Then
Return ____AvailableResult
Else
Return True
End If
Else
Return False
End If
End Function End Function
Private ActiveJobs As Integer = 0 Private ActiveJobs As Integer = 0
Private ActiveSessionDate As Date Private ActiveSessionDate As Date
@@ -551,9 +599,8 @@ Namespace API.Instagram
Private _NextWNM As UserData.WNM = UserData.WNM.Notify Private _NextWNM As UserData.WNM = UserData.WNM.Notify
Private _NextTagged As Boolean = True Private _NextTagged As Boolean = True
Friend Overrides Sub DownloadStarted(ByVal What As Download) Friend Overrides Sub DownloadStarted(ByVal What As Download)
If ActiveJobs = 0 Then ActiveSessionRequestsExists = False ResetDownloadOptions()
ActiveJobs += 1 ActiveJobs += 1
If What = Download.Main Then ____DownloadStarted = True
If ActiveJobs = 1 Then ActiveSessionDate = Now If ActiveJobs = 1 Then ActiveSessionDate = Now
If Not HH_IG_WWW_CLAIM_IS_ZERO AndAlso If Not HH_IG_WWW_CLAIM_IS_ZERO AndAlso
( (
@@ -594,18 +641,8 @@ Namespace API.Instagram
End With End With
End Sub End Sub
Friend Overrides Sub DownloadDone(ByVal What As Download) Friend Overrides Sub DownloadDone(ByVal What As Download)
_NextWNM = UserData.WNM.Notify
_NextTagged = True
If ActiveSessionRequestsExists Then RefreshMyLastRequests(Now)
ActiveJobs -= 1 ActiveJobs -= 1
SkipUntilNextSession = False ResetDownloadOptions()
If What = Download.Main Then ____DownloadStarted = False
If ActiveJobs = 0 Then
____AvailableRequested = False
____AvailableChecked = False
____AvailableSilent = True
____AvailableResult = False
End If
End Sub End Sub
#End Region #End Region
#Region "Settings" #Region "Settings"
@@ -695,9 +732,6 @@ Namespace API.Instagram
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 GetUserUrl(ByVal User As IPluginContentProvider) As String
Return String.Format(UrlPatternUser, DirectCast(User, UserData).NameTrue)
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Try Try
Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID) Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID)

View File

@@ -194,7 +194,7 @@ Namespace API.Instagram
With j({"data", "xdt_api__v1__feed__reels_media__connection", "edges"}) With j({"data", "xdt_api__v1__feed__reels_media__connection", "edges"})
If .ListExists Then If .ListExists Then
ProgressPre.ChangeMax(.Count) ProgressPre.ChangeMax(.Count)
For Each n As EContainer In .Self : GetStoriesData_ParseSingleHighlight(n("node"), i, False, Token) : Next For Each n As EContainer In .Self : GetStoriesData_ParseSingleHighlight(n("node"), i, False, Token, Sections.Stories) : Next
End If End If
End With End With
End If End If
@@ -217,7 +217,7 @@ Namespace API.Instagram
Using j As EContainer = JsonDocument.Parse(r) Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then If j.ListExists Then
Dim i% = -1 Dim i% = -1
GetStoriesData_ParseSingleHighlight(j.ItemF({"data", "xdt_api__v1__feed__reels_media", "reels_media", 0}), i, True, Token) GetStoriesData_ParseSingleHighlight(j.ItemF({"data", "xdt_api__v1__feed__reels_media", "reels_media", 0}), i, True, Token, Sections.UserStories)
End If End If
End Using End Using
End If End If

View File

@@ -26,15 +26,22 @@ Namespace API.Instagram
Private Const Name_LastCursor As String = "LastCursor" Private Const Name_LastCursor As String = "LastCursor"
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone" Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
Private Const Name_GetTimeline As String = "GetTimeline" Private Const Name_GetTimeline As String = "GetTimeline"
Private Const Name_GetTimeline_VideoPic As String = "GetTimeline_VideoPic"
Private Const Name_GetReels As String = "GetReels" Private Const Name_GetReels As String = "GetReels"
Private Const Name_GetReels_VideoPic As String = "GetReels_VideoPic"
Private Const Name_GetStories As String = "GetStories" Private Const Name_GetStories As String = "GetStories"
Private Const Name_GetStories_VideoPic As String = "GetStories_VideoPic"
Private Const Name_GetStoriesUser As String = "GetStoriesUser" Private Const Name_GetStoriesUser As String = "GetStoriesUser"
Private Const Name_GetStoriesUser_VideoPic As String = "GetStoriesUser_VideoPic"
Private Const Name_GetTagged As String = "GetTaggedData" Private Const Name_GetTagged As String = "GetTaggedData"
Private Const Name_GetTagged_VideoPic As String = "GetTaggedData_VideoPic"
Private Const Name_PutImageVideoFolder As String = "PutImageVideoFolder"
Private Const Name_TaggedChecked As String = "TaggedChecked" Private Const Name_TaggedChecked As String = "TaggedChecked"
Private Const Name_NameTrue As String = "NameTrue" Private Const Name_ForceUpdateUserName As String = "ForceUpdateUserName"
Private Const Name_ForceUpdateUserInfo As String = "ForceUpdateUserInfo"
#End Region #End Region
#Region "Declarations" #Region "Declarations"
Protected Structure PostKV : Implements IEContainerProvider Friend Structure PostKV : Implements IEContainerProvider
Private Const Name_Code As String = "Code" Private Const Name_Code As String = "Code"
Private Const Name_Section As String = "Section" Private Const Name_Section As String = "Section"
Friend Code As String Friend Code As String
@@ -79,17 +86,35 @@ Namespace API.Instagram
Private LastCursor As String = String.Empty Private LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = False Private FirstLoadingDone As Boolean = False
Friend Property GetTimeline As Boolean = True Friend Property GetTimeline As Boolean = True
Friend Property GetTimeline_VideoPic As Boolean = True
Friend Property GetReels As Boolean = False Friend Property GetReels As Boolean = False
Friend Property GetReels_VideoPic As Boolean = True
Friend Property GetStories As Boolean Friend Property GetStories As Boolean
Friend Property GetStories_VideoPic As Boolean = True
Friend Property GetStoriesUser As Boolean Friend Property GetStoriesUser As Boolean
Friend Property GetStoriesUser_VideoPic As Boolean = True
Friend Property GetTaggedData As Boolean Friend Property GetTaggedData As Boolean
Protected _NameTrue As String = String.Empty Friend Property GetTaggedData_VideoPic As Boolean = True
Friend ReadOnly Property NameTrue As String Friend Property PutImageVideoFolder As Boolean = False
Get Private Function ExtractImageFrom(ByVal Section As Sections) As Boolean
Return _NameTrue.IfNullOrEmpty(Name) Select Case Section
End Get Case Sections.Timeline : Return GetTimeline_VideoPic
End Property Case Sections.Reels : Return GetReels_VideoPic
Case Sections.Tagged : Return GetTaggedData_VideoPic
Case Sections.Stories : Return GetStories_VideoPic
Case Sections.UserStories : Return GetStoriesUser_VideoPic
Case Sections.SavedPosts
Try
If Not HOST Is Nothing AndAlso HOST.Key = InstagramSiteKey Then Return MySiteSettings.GetSavedPosts_VideoPic.Value
Catch
End Try
Return True
Case Else : Return True
End Select
End Function
Private UserNameRequested As Boolean = False Private UserNameRequested As Boolean = False
Friend Property ForceUpdateUserName As Boolean = False
Friend Property ForceUpdateUserInfo As Boolean = False
#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)
@@ -98,22 +123,36 @@ Namespace API.Instagram
LastCursor = .Value(Name_LastCursor) LastCursor = .Value(Name_LastCursor)
FirstLoadingDone = .Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False) FirstLoadingDone = .Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
GetTimeline = .Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value)) GetTimeline = .Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value))
GetReels = .Value(Name_GetReels).FromXML(Of Boolean)(MySiteSettings.GetReels.Value) GetTimeline_VideoPic = .Value(Name_GetTimeline_VideoPic).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline_VideoPic.Value))
GetReels = .Value(Name_GetReels).FromXML(Of Boolean)(CBool(MySiteSettings.GetReels.Value))
GetReels_VideoPic = .Value(Name_GetReels_VideoPic).FromXML(Of Boolean)(CBool(MySiteSettings.GetReels_VideoPic.Value))
GetStories = .Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value)) GetStories = .Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
GetStoriesUser = .Value(Name_GetStoriesUser).FromXML(Of Boolean)(MySiteSettings.GetStoriesUser.Value) GetStories_VideoPic = .Value(Name_GetStories_VideoPic).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories_VideoPic.Value))
GetStoriesUser = .Value(Name_GetStoriesUser).FromXML(Of Boolean)(CBool(MySiteSettings.GetStoriesUser.Value))
GetStoriesUser_VideoPic = .Value(Name_GetStoriesUser_VideoPic).FromXML(Of Boolean)(CBool(MySiteSettings.GetStoriesUser_VideoPic.Value))
PutImageVideoFolder = .Value(Name_PutImageVideoFolder).FromXML(Of Boolean)(CBool(MySiteSettings.PutImageVideoFolder.Value))
GetTaggedData = .Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value)) GetTaggedData = .Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
GetTaggedData_VideoPic = .Value(Name_GetTagged_VideoPic).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged_VideoPic.Value))
TaggedChecked = .Value(Name_TaggedChecked).FromXML(Of Boolean)(False) TaggedChecked = .Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
_NameTrue = .Value(Name_NameTrue) ForceUpdateUserName = .Value(Name_ForceUpdateUserName).FromXML(Of Boolean)(False)
ForceUpdateUserInfo = .Value(Name_ForceUpdateUserInfo).FromXML(Of Boolean)(False)
Else Else
.Add(Name_LastCursor, LastCursor) .Add(Name_LastCursor, LastCursor)
.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger) .Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
.Add(Name_GetTimeline, GetTimeline.BoolToInteger) .Add(Name_GetTimeline, GetTimeline.BoolToInteger)
.Add(Name_GetTimeline_VideoPic, GetTimeline_VideoPic.BoolToInteger)
.Add(Name_GetReels, GetReels.BoolToInteger) .Add(Name_GetReels, GetReels.BoolToInteger)
.Add(Name_GetReels_VideoPic, GetReels_VideoPic.BoolToInteger)
.Add(Name_GetStories, GetStories.BoolToInteger) .Add(Name_GetStories, GetStories.BoolToInteger)
.Add(Name_GetStories_VideoPic, GetStories_VideoPic.BoolToInteger)
.Add(Name_GetStoriesUser, GetStoriesUser.BoolToInteger) .Add(Name_GetStoriesUser, GetStoriesUser.BoolToInteger)
.Add(Name_GetStoriesUser_VideoPic, GetStoriesUser_VideoPic.BoolToInteger)
.Add(Name_GetTagged, GetTaggedData.BoolToInteger) .Add(Name_GetTagged, GetTaggedData.BoolToInteger)
.Add(Name_GetTagged_VideoPic, GetTaggedData_VideoPic.BoolToInteger)
.Add(Name_PutImageVideoFolder, PutImageVideoFolder.BoolToInteger)
.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger) .Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
.Add(Name_NameTrue, _NameTrue) .Add(Name_ForceUpdateUserName, ForceUpdateUserName.BoolToInteger)
.Add(Name_ForceUpdateUserInfo, ForceUpdateUserInfo.BoolToInteger)
End If End If
End With End With
End Sub End Sub
@@ -130,6 +169,18 @@ Namespace API.Instagram
GetStories = .GetStories GetStories = .GetStories
GetStoriesUser = .GetStoriesUser GetStoriesUser = .GetStoriesUser
GetTaggedData = .GetTagged GetTaggedData = .GetTagged
GetTimeline_VideoPic = .GetTimeline_VideoPic
GetReels_VideoPic = .GetReels_VideoPic
GetStories_VideoPic = .GetStories_VideoPic
GetStoriesUser_VideoPic = .GetStoriesUser_VideoPic
GetTaggedData_VideoPic = .GetTagged_VideoPic
PutImageVideoFolder = .PutImageVideoFolder
NameTrue = .UserName
ForceUpdateUserName = .ForceUpdateUserName
ForceUpdateUserInfo = .ForceUpdateUserInfo
End With End With
End If End If
End Sub End Sub
@@ -147,15 +198,32 @@ Namespace API.Instagram
Private WwwClaimUse As Boolean = True Private WwwClaimUse As Boolean = True
Private E560Thrown As Boolean = False Private E560Thrown As Boolean = False
Friend Err5xx As Integer = -1 Friend Err5xx As Integer = -1
Private _ErrHandling As Integer = -1
Private Property ErrHandling As Integer
Get
Return _ErrHandling
End Get
Set(ByVal ErrCode As Integer)
_ErrHandling = ErrCode
Err5xx = ErrCode
End Set
End Property
Private ErrHandlingLog As Boolean = True
Private ErrHandlingSection As Sections = Sections.Timeline
Private Const ErrHandlingValue As Integer = 100
Private Const ErrHandlingValueStories As Integer = 150
Private Class ExitException : Inherits Exception Private Class ExitException : Inherits Exception
Friend Property Is560 As Boolean = False Friend Property Is560 As Boolean = False
Friend Property IsTokens As Boolean = False Friend Property IsTokens As Boolean = False
Friend Property TokensData As String = String.Empty Friend Property TokensData As String = String.Empty
Friend Shared Sub Throw560(ByRef Source As UserData) Friend Shared Sub Throw560(ByRef Source As UserData)
If Not Source.E560Thrown Then With Source
MyMainLOG = $"{Source.ToStringForLog}: ({IIf(Source.Err5xx > 0, Source.Err5xx, 560)}) Download skipped until next session" If Not .E560Thrown Then
Source.E560Thrown = True If .ErrHandling = -1 Or .ErrHandlingLog Then _
End If MyMainLOG = $"{ .ToStringForLog}: ({IIf(.Err5xx > 0, .Err5xx, 560)}) Download skipped {If(.ErrHandling = -1, "until next session", $"({ .ErrHandlingSection})")}"
.E560Thrown = True
End If
End With
Throw New ExitException With {.Is560 = True} Throw New ExitException With {.Is560 = True}
End Sub End Sub
Friend Shared Sub ThrowTokens(ByRef Source As UserData, ByVal Data As String) Friend Shared Sub ThrowTokens(ByRef Source As UserData, ByVal Data As String)
@@ -175,25 +243,28 @@ Namespace API.Instagram
End If End If
End Get End Get
End Property End Property
Protected Sub LoadSavePostsKV(ByVal Load As Boolean) Friend Overloads Shared Sub LoadSavePostsKV(ByVal Load As Boolean, ByVal fPosts As SFile, ByRef List As List(Of PostKV))
Dim x As XmlFile Dim x As XmlFile
Dim f As SFile = MyFilePostsKV Dim f As SFile = fPosts
If Not f.IsEmptyString Then If Not f.IsEmptyString Then
If Load Then If Load Then
PostsKVIDs.Clear() List.Clear()
x = New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True} x = New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData() x.LoadData()
If x.Count > 0 Then PostsKVIDs.ListAddList(x, LAP.IgnoreICopier) If x.Count > 0 Then List.ListAddList(x, LAP.IgnoreICopier)
x.Dispose() x.Dispose()
Else Else
x = New XmlFile With {.AllowSameNames = True} x = New XmlFile With {.AllowSameNames = True}
x.AddRange(PostsKVIDs) x.AddRange(List)
x.Name = "Posts" x.Name = "Posts"
x.Save(f, EDP.SendToLog) x.Save(f, EDP.SendToLog)
x.Dispose() x.Dispose()
End If End If
End If End If
End Sub End Sub
Protected Overloads Sub LoadSavePostsKV(ByVal Load As Boolean)
LoadSavePostsKV(Load, MyFilePostsKV, PostsKVIDs)
End Sub
Protected Overloads Function PostKvExists(ByVal pkv As PostKV) As Boolean Protected Overloads Function PostKvExists(ByVal pkv As PostKV) As Boolean
Return PostKvExists(pkv.ID, False, pkv.Section) OrElse PostKvExists(pkv.Code, True, pkv.Section) Return PostKvExists(pkv.ID, False, pkv.Section) OrElse PostKvExists(pkv.Code, True, pkv.Section)
End Function End Function
@@ -316,6 +387,9 @@ Namespace API.Instagram
Dim errorFound As Boolean = False Dim errorFound As Boolean = False
Try Try
Err5xx = -1 Err5xx = -1
ErrHandling = -1
ErrHandlingLog = True
ErrHandlingSection = Sections.Timeline
_Limit = If(DownloadTopCount, -1) _Limit = If(DownloadTopCount, -1)
_TotalPostsParsed = 0 _TotalPostsParsed = 0
LoadSavePostsKV(True) LoadSavePostsKV(True)
@@ -396,18 +470,25 @@ Namespace API.Instagram
If Not errorFound Then LoadSavePostsKV(False) If Not errorFound Then LoadSavePostsKV(False)
End Try End Try
End Sub End Sub
Private Sub ValidateExtension() Protected Sub ValidateExtension()
Dim tmpList As List(Of UserMedia) = Nothing
Try Try
Const heic$ = "heic" Const heic$ = "heic"
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = heic) Then If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(mm) mm.File.Extension = heic) Then
Dim m As UserMedia Dim m As UserMedia
For i% = 0 To _TempMediaList.Count - 1 tmpList = New List(Of UserMedia)
m = _TempMediaList(i) tmpList.ListAddList(_TempMediaList)
_TempMediaList.Clear()
For i% = 0 To tmpList.Count - 1
m = tmpList(i)
_TempMediaList.Add(m)
If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = heic Then _ If m.Type = UTypes.Picture AndAlso Not m.File.Extension.IsEmptyString AndAlso m.File.Extension = heic Then _
m.File.Extension = "jpg" : _TempMediaList(i) = m m.File.Extension = "jpg" : _TempMediaList.Add(m)
Next Next
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()
End Try End Try
End Sub End Sub
Protected Overridable Sub UpdateResponser() Protected Overridable Sub UpdateResponser()
@@ -423,7 +504,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
Protected Enum Sections : Timeline : Reels : Tagged : Stories : UserStories : SavedPosts : End Enum Friend Enum Sections : Timeline : Reels : Tagged : Stories : UserStories : SavedPosts : 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"
@@ -583,11 +664,13 @@ Namespace API.Instagram
'Check environment 'Check environment
If Not IsSavedPosts Then If Not IsSavedPosts Then
If ID.IsEmptyString Then GetUserData() If ID.IsEmptyString Then GetUserData()
If ID.IsEmptyString Then Throw New Plugin.ExitException("can't get user ID") If ID.IsEmptyString Then UserExists = False : _ForceSaveUserInfoOnException = True : Throw New Plugin.ExitException("can't get user ID")
If _UseGQL And Cursor.IsEmptyString And Not Section = Sections.SavedPosts Then If _UseGQL And Cursor.IsEmptyString And Not Section = Sections.SavedPosts Then
If Not ValidateBaseTokens() Then GetPageTokens() If Not ValidateBaseTokens() Then GetPageTokens()
If Not ValidateBaseTokens(TokensErrData) Then ValidateBaseTokens_Error(TokensErrData) If Not ValidateBaseTokens(TokensErrData) Then ValidateBaseTokens_Error(TokensErrData)
End If End If
If ForceUpdateUserName Then GetUserNameById()
If ForceUpdateUserInfo Then GetUserData()
End If End If
'Create query 'Create query
@@ -670,6 +753,14 @@ Namespace API.Instagram
Select Case Section Select Case Section
Case Sections.Timeline Case Sections.Timeline
With n With n
If If(n("user")?.Count, 0) = 0 And Cursor.IsEmptyString Then
If Not UserNameRequested Then
ForceUpdateUserName = True
Continue Do
Else
UserExists = False
End If
End If
HasNextPage = .Value("more_available").FromXML(Of Boolean)(False) HasNextPage = .Value("more_available").FromXML(Of Boolean)(False)
EndCursor = .Value("next_max_id") EndCursor = .Value("next_max_id")
If If(.Item("items")?.Count, 0) > 0 Then If If(.Item("items")?.Count, 0) > 0 Then
@@ -753,6 +844,11 @@ NextPageBlock:
Throw eex Throw eex
Catch ex As Exception Catch ex As Exception
dValue = ProcessException(ex, Token, $"data downloading error [{URL}]",, Section, False) dValue = ProcessException(ex, Token, $"data downloading error [{URL}]",, Section, False)
If dValue = ErrHandlingValue Then
ExitException.Throw560(Me)
ElseIf dValue = ErrHandlingValueStories Then
Exit Sub
End If
End Try End Try
Loop Loop
Catch jsonNull2 As JsonDocumentException When jsonNull2.State = WebDocumentEventArgs.States.Error And Catch jsonNull2 As JsonDocumentException When jsonNull2.State = WebDocumentEventArgs.States.Error And
@@ -809,7 +905,7 @@ NextPageBlock:
With j("items") With j("items")
For Each jj In .Self For Each jj In .Self
before = _TempMediaList.Count before = _TempMediaList.Count
ObtainMedia(jj, PostsToReparse(i).ID, specFolder) ObtainMedia(jj, PostsToReparse(i).ID, specFolder,,,,,,, IIf(IsTagged, Sections.Tagged, Sections.Timeline))
If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1 If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
If _Limit > 0 And _TotalPostsParsed >= _Limit Then Throw New ExitException If _Limit > 0 And _TotalPostsParsed >= _Limit Then Throw New ExitException
Next Next
@@ -911,7 +1007,7 @@ NextPageBlock:
End Select End Select
End If End If
before = _TempMediaList.Count before = _TempMediaList.Count
ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate,, PostOriginUrl, State, Attempts) ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate,, PostOriginUrl, State, Attempts,, Section)
If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1 If Not before = _TempMediaList.Count Then _TotalPostsParsed += 1
If _Limit > 0 And _TotalPostsParsed >= _Limit Then Return False If _Limit > 0 And _TotalPostsParsed >= _Limit Then Return False
End If End If
@@ -950,6 +1046,7 @@ NextPageBlock:
Protected ObtainMedia_SizeFuncVid As Func(Of EContainer, Sizes) = Nothing Protected ObtainMedia_SizeFuncVid As Func(Of EContainer, Sizes) = Nothing
Protected ObtainMedia_SizeFuncPic As Func(Of EContainer, Sizes) = Nothing Protected ObtainMedia_SizeFuncPic As Func(Of EContainer, Sizes) = Nothing
Protected ObtainMedia_AllowAbstract As Boolean = False Protected ObtainMedia_AllowAbstract As Boolean = False
Private Const ObtainMedia_NoSection As Integer = -10
Protected Sub ObtainMedia_SetReelsFunc() Protected Sub ObtainMedia_SetReelsFunc()
ObtainMedia_SizeFuncPic = Function(ByVal ss As EContainer) As Sizes ObtainMedia_SizeFuncPic = Function(ByVal ss As EContainer) As Sizes
If ss.Value("url").IsEmptyString Then If ss.Value("url").IsEmptyString Then
@@ -971,7 +1068,8 @@ NextPageBlock:
Optional ByVal DateObj As String = Nothing, Optional ByVal InitialType As Integer = -1, Optional ByVal DateObj As String = Nothing, Optional ByVal InitialType As Integer = -1,
Optional ByVal PostOriginUrl As String = Nothing, Optional ByVal PostOriginUrl As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0, Optional ByVal State As UStates = UStates.Unknown, Optional ByVal Attempts As Integer = 0,
Optional ByVal TryExtractImage As Boolean = False) Optional ByVal TryExtractImage As Boolean = False,
Optional ByVal Section As Sections = ObtainMedia_NoSection)
Try Try
Dim maxSize As Func(Of EContainer, Integer) = Function(ByVal _ss As EContainer) As Integer Dim maxSize As Func(Of EContainer, Integer) = Function(ByVal _ss As EContainer) As Integer
Dim w% = AConvert(Of Integer)(_ss.Value("width"), 0) Dim w% = AConvert(Of Integer)(_ss.Value("width"), 0)
@@ -1018,6 +1116,12 @@ NextPageBlock:
If TryExtractImage Then If TryExtractImage Then
t = 1 t = 1
abstractDecision = True abstractDecision = True
If Not SpecialFolder.IsEmptyString AndAlso PutImageVideoFolder Then
Dim endsAbs As Boolean = SpecialFolder.EndsWith("*")
If endsAbs Then SpecialFolder = SpecialFolder.TrimEnd("*")
If Not SpecialFolder.IsEmptyString Then SpecialFolder = $"{SpecialFolder.TrimEnd("\")}\{VideoFolderName}{IIf(Not endsAbs, "*", String.Empty)}"
If endsAbs Then SpecialFolder &= "*"
End If
ElseIf t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then ElseIf t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then
If n.Contains(vid) Then If n.Contains(vid) Then
t = 2 t = 2
@@ -1064,7 +1168,8 @@ NextPageBlock:
End If End If
End With End With
End If End If
If Not TryExtractImage Then ObtainMedia(n, PostID, SpecialFolder, DateObj, InitialType, PostOriginUrl, State, Attempts, True) If Not TryExtractImage And Not Section = ObtainMedia_NoSection And ExtractImageFrom(Section) Then _
ObtainMedia(n, PostID, SpecialFolder, DateObj, InitialType, PostOriginUrl, State, Attempts, True, Section)
Case 8 'gallery Case 8 'gallery
DateObj = mDate(n) DateObj = mDate(n)
With n("carousel_media").XmlIfNothing With n("carousel_media").XmlIfNothing
@@ -1084,6 +1189,7 @@ NextPageBlock:
#Region "GetUserId, GetUserName" #Region "GetUserId, GetUserName"
Private Sub GetUserData() Private Sub GetUserData()
Dim __idFound As Boolean = False Dim __idFound As Boolean = False
If ForceUpdateUserInfo Then ForceUpdateUserInfo = False : _ForceSaveUserInfo = True
Try Try
ChangeResponserMode(False) ChangeResponserMode(False)
UpdateRequestNumber() UpdateRequestNumber()
@@ -1102,18 +1208,17 @@ NextPageBlock:
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)
If Not f.Exists Then If Not f.Exists Then
Dim profilePicture$ = .Value("profile_pic_url_hd") If SimpleDownloadAvatar(.Value("profile_pic_url_hd"), Function(ff) f).IsEmptyString Then _
If profilePicture.IsEmptyString OrElse Not GetWebFile(profilePicture, f, EDP.ReturnValue) Then SimpleDownloadAvatar(.Value("profile_pic_url"), Function(ff) f)
profilePicture = .Value("profile_pic_url")
If Not profilePicture.IsEmptyString Then GetWebFile(profilePicture, f, EDP.ReturnValue)
End If
End If End If
End With End With
End If End If
End Using End Using
End If End If
Catch ex As Exception Catch ex As Exception
UserExists = False
If Not __idFound Then If Not __idFound Then
If Responser.StatusCode = HttpStatusCode.NotFound Or Responser.StatusCode = HttpStatusCode.BadRequest Then If Responser.StatusCode = HttpStatusCode.NotFound Or Responser.StatusCode = HttpStatusCode.BadRequest Then
Throw ex Throw ex
@@ -1127,6 +1232,7 @@ NextPageBlock:
End Sub End Sub
Private Function GetUserNameById() As Boolean Private Function GetUserNameById() As Boolean
UserNameRequested = True UserNameRequested = True
If ForceUpdateUserName Then ForceUpdateUserName = False : _ForceSaveUserInfo = True
Try Try
If Not ID.IsEmptyString Then If Not ID.IsEmptyString Then
UpdateRequestNumber() UpdateRequestNumber()
@@ -1138,12 +1244,11 @@ NextPageBlock:
If Not newName.IsEmptyString Then If Not newName.IsEmptyString Then
Dim oldName$ = NameTrue Dim oldName$ = NameTrue
If Not newName = oldName Then If Not newName = oldName Then
MyMainLOG = $"{ToStringForLog()}: username changed from '{oldName}' to '{newName}'" Dim uStr$ = $"username changed from '{oldName}' to '{newName}'"
_NameTrue = newName LogError(Nothing, uStr)
Dim descr$ = $"Username changed from '{oldName}' to '{newName}' ({Now.ToStringDate(ADateTime.Formats.BaseDateTime)})!" NameTrue = newName
descr.StringAppendLine(UserDescription) UserDescriptionUpdate(uStr, True, True, True)
UserDescription = descr _ForceSaveUserInfo = True
_ForceSaveUserData = True
End If End If
Return True Return True
End If End If
@@ -1165,6 +1270,7 @@ NextPageBlock:
Dim qStr$, r$ Dim qStr$, r$
Dim i% = -1 Dim i% = -1
Dim jj As EContainer Dim jj As EContainer
Dim section As Sections = IIf(GetUserStory, Sections.UserStories, Sections.Stories)
ThrowAny(Token) ThrowAny(Token)
If StoriesList.ListExists Or GetUserStory Then If StoriesList.ListExists Or GetUserStory Then
If Not GetUserStory Then tmpList = StoriesList.Take(5) If Not GetUserStory Then tmpList = StoriesList.Take(5)
@@ -1181,7 +1287,7 @@ NextPageBlock:
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Contains("reels") Then If j.Contains("reels") Then
ProgressPre.ChangeMax(j("reels").Count) ProgressPre.ChangeMax(j("reels").Count)
For Each jj In j("reels") : GetStoriesData_ParseSingleHighlight(jj, i, GetUserStory, Token) : Next For Each jj In j("reels") : GetStoriesData_ParseSingleHighlight(jj, i, GetUserStory, Token, section) : Next
End If End If
End Using End Using
End If End If
@@ -1189,7 +1295,8 @@ NextPageBlock:
End If End If
End If End If
End Sub End Sub
Private Sub GetStoriesData_ParseSingleHighlight(ByVal Node As EContainer, ByRef Index As Integer, ByVal GetUserStory As Boolean, ByVal Token As CancellationToken) Private Sub GetStoriesData_ParseSingleHighlight(ByVal Node As EContainer, ByRef Index As Integer, ByVal GetUserStory As Boolean,
ByVal Token As CancellationToken, Optional ByVal Section As Sections = Sections.Stories)
If Not Node Is Nothing Then If Not Node Is Nothing Then
With Node With Node
ProgressPre.Perform() ProgressPre.Perform()
@@ -1210,7 +1317,7 @@ NextPageBlock:
pid = storyID & s.Value("id") pid = storyID & s.Value("id")
If Not _TempPostsList.Contains(pid) Then If Not _TempPostsList.Contains(pid) Then
ThrowAny(Token) ThrowAny(Token)
ObtainMedia(s, pid, sFolder) ObtainMedia(s, pid, sFolder,,,,,,, Section)
_TempPostsList.Add(pid) _TempPostsList.Add(pid)
End If End If
Next Next
@@ -1220,20 +1327,15 @@ NextPageBlock:
End If End If
End Sub End Sub
Private Function GetStoriesList() As List(Of String) Private Function GetStoriesList() As List(Of String)
Try 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 Dim ee As New ErrorsDescriber(EDP.ReturnValue) With {.DeclaredMessage = New MMessage($"{ToStringForLog()}:")}
Dim ee As New ErrorsDescriber(EDP.ReturnValue) With {.DeclaredMessage = New MMessage($"{ToStringForLog()}:")} Using j As EContainer = JsonDocument.Parse(r, ee).XmlIfNothing()("tray").XmlIfNothing
Using j As EContainer = JsonDocument.Parse(r, ee).XmlIfNothing()("tray").XmlIfNothing If j.Count > 0 Then Return j.Select(Function(jj) jj.Value("id").Replace("highlight:", String.Empty)).ListIfNothing
If j.Count > 0 Then Return j.Select(Function(jj) jj.Value("id").Replace("highlight:", String.Empty)).ListIfNothing End Using
End Using End If
End If Return Nothing
Return Nothing
Catch ex As Exception
DownloadingException(ex, "API.Instagram.GetStoriesList", False, Sections.Stories)
Return Nothing
End Try
End Function End Function
#End Region #End Region
#Region "Download content" #Region "Download content"
@@ -1279,11 +1381,26 @@ 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
MySiteSettings.SkipUntilNextSession = True If Responser.StatusCode = 560 And s = Sections.Stories And MySiteSettings.IgnoreStoriesDownloadingErrors Then
Err5xx = Responser.StatusCode MyMainLOG = $"{ToStringForLog()}: Stories downloading skipped (560)"
Return ErrHandlingValueStories
Else
MySiteSettings.SkipUntilNextSession = True
Err5xx = Responser.StatusCode
End If
ElseIf Responser.StatusCode = -1 And Responser.Status = -1 Then ElseIf Responser.StatusCode = -1 And Responser.Status = -1 Then
MySiteSettings.SkipUntilNextSession = True MySiteSettings.SkipUntilNextSession = True
Err5xx = Responser.StatusCode Err5xx = Responser.StatusCode
ElseIf MySiteSettings.ErrorSpecialHandling(Responser.StatusCode) Then
ErrHandlingLog = MySiteSettings.ErrorSpecialHandling_AddToLog(Responser.StatusCode)
ErrHandling = Responser.StatusCode
ErrHandlingSection = s
Return ErrHandlingValue
ElseIf MySiteSettings.ErrorSpecialHandling(Responser.Status) Then
ErrHandlingLog = MySiteSettings.ErrorSpecialHandling_AddToLog(Responser.Status)
ErrHandling = Responser.Status
ErrHandlingSection = s
Return ErrHandlingValue
Else Else
MyMainLOG = $"Something is wrong. Your credentials may have expired [{CInt(Responser.StatusCode)}/{CInt(Responser.Status)}]: {ToString()} [{s}]" MyMainLOG = $"Something is wrong. Your credentials may have expired [{CInt(Responser.StatusCode)}/{CInt(Responser.Status)}]: {ToString()} [{s}]"
DisableSection(s) DisableSection(s)

View File

@@ -106,7 +106,8 @@ Namespace API.LPSG
End Sub End Sub
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.ServiceUnavailable Then '503 If Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Or
Responser.StatusCode = Net.HttpStatusCode.Forbidden Then '503, 403
MyMainLOG = $"{ToStringForLog()}: LPSG not available" MyMainLOG = $"{ToStringForLog()}: LPSG not available"
Return 1 Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then '404 ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then '404

View File

@@ -15,6 +15,8 @@ Namespace API.Mastodon
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelSearch 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 DownloadModelForceApply As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelLikes 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) Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s) MyBase.New(s)
End Sub End Sub

View File

@@ -171,12 +171,12 @@ Namespace API.Mastodon
With DirectCast(User, UserData) With DirectCast(User, UserData)
If UserRelatedToMyDomain.Value Then If UserRelatedToMyDomain.Value Then
If MyDomain.Value = .UserDomain Then If MyDomain.Value = .UserDomain Then
Return $"https://{ .UserDomain}/@{ .TrueName}" Return $"https://{ .UserDomain}/@{ .NameTrue}"
Else Else
Return $"https://{MyDomain.Value}/@{ .TrueName}@{ .UserDomain}" Return $"https://{MyDomain.Value}/@{ .NameTrue}@{ .UserDomain}"
End If End If
Else Else
Return $"https://{ .UserDomain}/@{ .TrueName}" Return $"https://{ .UserDomain}/@{ .NameTrue}"
End If End If
End With End With
End Function End Function

View File

@@ -29,7 +29,6 @@ Namespace API.Mastodon
_UserDomain = d _UserDomain = d
End Set End Set
End Property End Property
Friend Property TrueName As String = String.Empty
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Get Get
Return HOST.Source Return HOST.Source
@@ -52,22 +51,21 @@ Namespace API.Mastodon
Dim l$() = Name.Split("@") Dim l$() = Name.Split("@")
If l.ListExists(2) Then If l.ListExists(2) Then
_UserDomain = l(0) _UserDomain = l(0)
TrueName = l(1) NameTrue = l(1)
Else Else
_UserDomain = MySettings.MyDomain.Value _UserDomain = MySettings.MyDomain.Value
TrueName = Name NameTrue = Name
End If End If
If FriendlyName.IsEmptyString Then FriendlyName = TrueName If FriendlyName.IsEmptyString Then FriendlyName = NameTrue
End If End If
End Sub End Sub
If Loading Then If Loading Then
_UserDomain = Container.Value(Name_UserDomain) _UserDomain = Container.Value(Name_UserDomain)
TrueName = Container.Value(Name_TrueName)
obtainNames.Invoke obtainNames.Invoke
Else Else
obtainNames.Invoke obtainNames.Invoke
Container.Add(Name_UserDomain, _UserDomain) Container.Add(Name_UserDomain, _UserDomain)
Container.Add(Name_TrueName, TrueName) Container.Add(Name_TrueName, NameTrue(True))
Container.Value(Name_FriendlyName) = FriendlyName Container.Value(Name_FriendlyName) = FriendlyName
End If End If
End Sub End Sub
@@ -208,12 +206,12 @@ Namespace API.Mastodon
Dim url$ = $"https://{MyCredentials.Domain}/api/v1/accounts/lookup?acct=" Dim url$ = $"https://{MyCredentials.Domain}/api/v1/accounts/lookup?acct="
If Not UserDomain.IsEmptyString Then If Not UserDomain.IsEmptyString Then
If UserDomain = MyCredentials.Domain Then If UserDomain = MyCredentials.Domain Then
url &= $"@{TrueName}" url &= $"@{NameTrue}"
Else Else
url &= $"@{TrueName}@{UserDomain}" url &= $"@{NameTrue}@{UserDomain}"
End If End If
Else Else
url &= $"@{TrueName}" url &= $"@{NameTrue}"
End If End If
Dim r$ = Responser.GetResponse(url) Dim r$ = Responser.GetResponse(url)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then

View File

@@ -11,5 +11,11 @@ Namespace API.OnlyFans
Friend Module Declarations Friend Module Declarations
Friend ReadOnly DateProvider As New ADateTime("O") Friend ReadOnly DateProvider As New ADateTime("O")
Friend ReadOnly RegExPostID As RParams = RParams.DM("(?<=onlyfans\.com/)(\d+)", 0, EDP.ReturnValue) Friend ReadOnly RegExPostID As RParams = RParams.DM("(?<=onlyfans\.com/)(\d+)", 0, EDP.ReturnValue)
Friend ReadOnly FilesSources As New List(Of Object()) From {
{{"source", "source"}},
{{"files", "source", "url"}},
{{"files", "full", "url"}}
}
Friend Property Rules As DynamicRulesEnv
End Module End Module
End Namespace End Namespace

View File

@@ -0,0 +1,7 @@
https://github.com/datawhores/onlyfans-dynamic-rules/blob/main/dynamicRules.json
https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/main/dynamicRules.json
https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/patch-1/dynamicRules.json
https://github.com/DATAHOARDERS/dynamic-rules/blob/main/onlyfans.json
https://github.com/DIGITALCRIMINAL/dynamic-rules/blob/main/onlyfans.json
https://github.com/deviint/onlyfans-dynamic-rules/blob/main/dynamicRules.json
https://github.com/rafa-9/dynamic-rules/blob/main/rules.json

View File

@@ -0,0 +1,11 @@
https://github.com/datawhores/onlyfans-dynamic-rules/blob/main/dynamicRules.json
https://github.com/datawhores/onlyfans-dynamic-rules/blob/main/rules.json
https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/main/dynamicRules.json
https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/patch-1/dynamicRules.json
https://github.com/DATAHOARDERS/dynamic-rules/blob/main/onlyfans.json
https://github.com/DIGITALCRIMINAL/dynamic-rules/blob/main/onlyfans.json
https://github.com/deviint/onlyfans-dynamic-rules/blob/main/dynamicRules.json
https://github.com/rafa-9/dynamic-rules/blob/main/rules.json
https://github.com/SneakyOvis/onlyfans-dynamic-rules/blob/main/rules.json
https://github.com/Growik/onlyfans-dynamic-rules/blob/main/rules.json

View File

@@ -0,0 +1,753 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.Base
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports System.Text.RegularExpressions
Namespace API.OnlyFans
Friend Structure DynamicRulesValue : Implements IComparable(Of DynamicRulesValue), IEquatable(Of DynamicRulesValue), IEContainerProvider
#Region "XML names"
Private Const Name_UrlRepo As String = "UrlRepo"
Private Const Name_UrlRaw As String = "UrlRaw"
Private Const Name_UrlLatestCommit As String = "UrlLatestCommit"
Private Const Name_UpdatedAt As String = "UpdatedAt"
Private Const Name_Broken As String = "Broken"
Private Const Name_Exists As String = "Exists"
#End Region
#Region "Declarations"
Friend UrlRepo As String
Friend UrlRaw As String
Friend UrlLatestCommit As String
Friend UpdatedAt As Date
Friend Broken As Boolean
Friend Exists As Boolean
Friend ReadOnly Property Valid As Boolean
Get
Return Not UrlRepo.IsEmptyString And Not UrlRaw.IsEmptyString
End Get
End Property
#End Region
#Region "Initializers"
Friend Sub New(ByVal e As EContainer)
UrlRepo = e.Value(Name_UrlRepo)
UrlRaw = e.Value(Name_UrlRaw)
UrlLatestCommit = e.Value(Name_UrlLatestCommit)
UpdatedAt = e.Value(Name_UpdatedAt).ToDateDef(Now.AddYears(-10))
Broken = e.Value(Name_Broken).FromXML(Of Boolean)(False)
Exists = e.Value(Name_Exists).FromXML(Of Boolean)(True)
End Sub
Public Shared Widening Operator CType(ByVal e As EContainer) As DynamicRulesValue
Return New DynamicRulesValue(e)
End Operator
Public Shared Widening Operator CType(ByVal rule As DynamicRulesValue) As String
Return rule.ToString
End Operator
#End Region
#Region "Base functions"
Public Overrides Function GetHashCode() As Integer
Return ToString.GetHashCode
End Function
Public Overrides Function ToString() As String
Return UrlRaw
End Function
#End Region
#Region "IComparable Support"
Private Function CompareTo(ByVal Other As DynamicRulesValue) As Integer Implements IComparable(Of DynamicRulesValue).CompareTo
Return UpdatedAt.CompareTo(Other.UpdatedAt) * -1
End Function
#End Region
#Region "IEquatable Support"
Public Overloads Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not IsNothing(Obj) Then
If TypeOf Obj Is String Then
Dim _obj$ = CStr(Obj).StringTrim.StringToLower
Return UrlRepo = _obj Or UrlRaw = _obj
Else
Return Equals(DirectCast(Obj, DynamicRulesValue))
End If
Else
Return False
End If
End Function
Friend Overloads Function Equals(ByVal Other As DynamicRulesValue) As Boolean Implements IEquatable(Of DynamicRulesValue).Equals
Return UrlRepo = Other.UrlRepo Or UrlRaw = Other.UrlRaw
End Function
#End Region
#Region "IEContainerProvider Support"
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return New EContainer("Rule") From {
New EContainer(Name_UrlRepo, UrlRepo),
New EContainer(Name_UrlRaw, UrlRaw),
New EContainer(Name_UrlLatestCommit, UrlLatestCommit),
New EContainer(Name_UpdatedAt, UpdatedAt.ToStringDateDef),
New EContainer(Name_Broken, Broken.BoolToInteger),
New EContainer(Name_Exists, Exists.BoolToInteger)
}
End Function
#End Region
End Structure
Friend Class DynamicRulesEnv : Implements ICopier, IEnumerable(Of DynamicRulesValue), IMyEnumerator(Of DynamicRulesValue), IDisposable
Friend Enum Modes As Integer
List = 0
Personal = 1
End Enum
#Region "Constants"
Friend Const UpdateIntervalDefault As Integer = 1440 '60 * 24
Friend Const DynamicRulesConfigNodeName_URL As String = "DYNAMIC_GENERIC_URL"
Friend Const DynamicRulesConfigNodeName_RULES As String = "DYNAMIC_RULE"
Friend Const DynamicRulesConfig_Mode_NodeName As String = "dynamic-mode-default"
'Friend Const DynamicRulesConfig_Mode_NodeValue As String = "generic"
Friend Const DynamicRulesConfigNodeName_URL_CONST_NAME As String = "RULE_VALUE"
#End Region
#Region "XML names"
Private Const Name_LastUpdateTimeFile As String = "LastUpdateTimeFile"
Private Const Name_LastUpdateTimeRules As String = "LastUpdateTimeRules"
Private Const Name_ProtectFile As String = "ProtectFile"
Private Const Name_UpdateInterval As String = "UpdateInterval"
Private Const Name_Mode As String = "Mode"
Private Const Name_PersonalRule As String = "PersonalRule"
Private Const Name_RulesForceUpdateRequired As String = "RulesForceUpdateRequired"
Private Const Name_AddErrorsToLog As String = "AddErrorsToLog"
Private Const Name_ConfigLastDateUpdate As String = "ConfigLastDateUpdate"
Private Const Name_ConfigAutoUpdate As String = "ConfigAutoUpdate"
Private Const Name_RulesConfigManualMode As String = "RulesConfigManualMode"
Private Const Name_RulesUpdateConst As String = "RulesUpdateConst"
Private Const Name_RulesReplaceConfig As String = "RulesReplaceConfig"
#End Region
#Region "Declarations"
Private ReadOnly Rules As List(Of DynamicRulesValue)
Friend ReadOnly Property RulesConstants As Dictionary(Of String, String)
#Region "Regex patterns"
Private ReadOnly ReplacePattern_RepoToRaw As RParams
Private ReadOnly ReplacePattern_RawToRepo As RParams
Private ReadOnly ReplacePattern_JsonInfo As RParams
Private ReadOnly ConfigRulesExtract As RParams
#End Region
#Region "Dates"
Private LastUpdateTimeFile As Date = Now.AddYears(-1)
Private LastUpdateTimeRules As Date = Now.AddYears(-1)
#End Region
#Region "Files"
Friend ReadOnly OFScraperConfigPatternFile As SFile = $"{SettingsFolderName}\OFScraperConfigPattern.json"
Friend ReadOnly OFScraperConfigPatternFileConst As SFile = $"{SettingsFolderName}\OFScraperConfigPatternConstants.txt"
Friend ReadOnly Property AuthFile As New SFile($"{SettingsFolderName}\OnlyFans_Auth.json")
Private ReadOnly DynamicRulesFile As SFile
Private ReadOnly DynamicRulesXml As SFile
Private Shared ReadOnly Property DynamicRulesFileImpl As SFile
Get
Return $"{SettingsFolderName}\OnlyFansDynamicRules.txt"
End Get
End Property
Friend Shared Sub ValidateRulesFile()
Dim f As SFile = DynamicRulesFileImpl
If Not f.Exists Then TextSaver.SaveTextToFile(My.Resources.OFResources.DynamicRules, DynamicRulesFileImpl, True)
End Sub
Friend Property ProtectFile As Boolean = False
#End Region
Friend Property UpdateInterval As Integer = UpdateIntervalDefault
Friend Property Mode As Modes = Modes.List
Friend Property PersonalRule As String = String.Empty
Friend Property RulesForceUpdateRequired As Boolean = False
Friend Property RulesUpdateConst As Boolean = True
Friend Property RulesReplaceConfig As Boolean = True
Private ReadOnly Responser As New Responser With {.Accept = "application/json"}
Private ReadOnly RulesLinesComparer As New FComparer(Of String)(Function(x, y) x.StringToLower = y.StringToLower)
Private ReadOnly OFLOG As TextSaver
Private ReadOnly OFError As ErrorsDescriber
Friend Property AddErrorsToLog As Boolean = True
Friend Property NeedToSave As Boolean = False
Private ReadOnly Property ConfigAddress As DynamicRulesValue
Private ReadOnly Property ConfigConstAddress As DynamicRulesValue
Private Property ConfigLastDateUpdate As Date = Now.AddYears(-1)
Friend Property ConfigAutoUpdate As Boolean = True
Friend Property RulesConfigManualMode As Boolean = True
#End Region
#Region "Current, Item, Count"
Private _CurrentRule As DynamicRulesValue
Private _CurrentContainer As EContainer
Private _CurrentContainerRulesText As String = String.Empty
Friend ReadOnly Property CurrentRule As DynamicRulesValue
Get
Return _CurrentRule
End Get
End Property
Friend ReadOnly Property CurrentContainer As EContainer
Get
Return _CurrentContainer
End Get
End Property
Friend ReadOnly Property CurrentContainerRulesText As String
Get
If _CurrentContainerRulesText.IsEmptyString AndAlso AuthFile.Exists Then _
_CurrentContainerRulesText = AuthFile.GetText(OFError).StringTrim
Return _CurrentContainerRulesText
End Get
End Property
Friend ReadOnly Property Exists As Boolean
Get
Return CurrentContainer.ListExists
End Get
End Property
Default Friend ReadOnly Property Item(ByVal Index As Integer) As DynamicRulesValue Implements IMyEnumerator(Of DynamicRulesValue).MyEnumeratorObject
Get
Return Rules(Index)
End Get
End Property
Friend ReadOnly Property Count As Integer Implements IMyEnumerator(Of DynamicRulesValue).MyEnumeratorCount
Get
Return Rules.Count
End Get
End Property
#End Region
#Region "Initializer"
Friend Sub New()
Rules = New List(Of DynamicRulesValue)
DynamicRulesFile = DynamicRulesFileImpl
DynamicRulesXml = DynamicRulesFile
DynamicRulesXml.Extension = "xml"
ReplacePattern_RepoToRaw = New RParams("(.*github.com/([^/]+)/([^/]+)/blob/(.+))", Nothing, 0,
RegexReturn.ReplaceChangeListMatch, EDP.ReturnValue) With {
.PatternReplacement = "https://raw.githubusercontent.com/{2}/{3}/{4}"}
ReplacePattern_JsonInfo = ReplacePattern_RepoToRaw.Copy
ReplacePattern_JsonInfo.PatternReplacement = "https://github.com/{2}/{3}/latest-commit/{4}"
ReplacePattern_RawToRepo = ReplacePattern_RepoToRaw.Copy
ReplacePattern_RawToRepo.Pattern = "(.*raw.githubusercontent.com/([^/]+)/([^/]+)/([^/]+)/(.+))"
ReplacePattern_RawToRepo.PatternReplacement = "https://github.com/{2}/{3}/blob/{4}/{5}"
ConfigRulesExtract = RParams.DMS("DYNAMIC_RULE"":(\{.+?\}[\r\n]+)", 1, RegexOptions.Singleline, EDP.ReturnValue)
OFLOG = New TextSaver($"LOGs\OF_{Now:yyyyMMdd_HHmmss}.txt") With {.LogMode = True, .AutoSave = True, .AutoClear = True}
AddHandler OFLOG.TextSaved, AddressOf OFLOG_TextSaved
OFError = New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue) With {.DeclaredMessage = New MMessage With {.Loggers = {OFLOG}, .Exists = True}}
Responser.DeclaredError = OFError
Responser.ProcessExceptionDecision =
Function(ByVal Status As IResponserStatus, ByVal NullArg As Object, ByVal CurrentError As ErrorsDescriber) As ErrorsDescriber
If Status.StatusCode = Net.HttpStatusCode.NotFound Then
CurrentError.SendToLogOnlyMessage = True
Dim m As MMessage = CurrentError.DeclaredMessage.Clone
m.Text = $"Nothing found at URL: {Responser.LatestUrlString}"
CurrentError.DeclaredMessage = m
Status.ErrorException = New ErrorsDescriberException(m.Text,,, Status.ErrorException) With {.ReplaceMainMessage = True}
End If
Return CurrentError
End Function
ConfigAddress = ParseURL("https://github.com/AAndyProgram/SCrawler/blob/main/SCrawler/API/OnlyFans/OFScraperConfigPattern.json")
ConfigConstAddress = ParseURL("https://github.com/AAndyProgram/SCrawler/blob/main/SCrawler/API/OnlyFans/OFScraperConfigPatternConstants.txt")
RulesConstants = New Dictionary(Of String, String)
End Sub
#End Region
#Region "Log handlers"
Private _OFLOG_ProcessNotify As Boolean = True
Private Sub OFLOG_TextSaved(sender As Object, e As EventArgs)
If _OFLOG_ProcessNotify And AddErrorsToLog Then _OFLOG_ProcessNotify = False : MyMainLOG = $"The OnlyFans log contains errors: {OFLOG.File}"
End Sub
#End Region
#Region "ParseURL"
Private Const SiteGitHub As String = "github.com"
Private Const SiteGitHubRaw As String = "raw.githubusercontent.com"
Friend Function ParseURL(ByVal URL As String) As DynamicRulesValue
URL = URL.StringTrim
If Not URL.IsEmptyString Then
Dim r As New DynamicRulesValue
Dim rGet As Func(Of String, RParams, String) = Function(__url, pattern) DirectCast(RegexReplace(__url, pattern), IEnumerable(Of String)).FirstOrDefault
If URL.ToLower.Contains(SiteGitHubRaw) Then
r.UrlRaw = URL
r.UrlRepo = rGet(URL, ReplacePattern_RawToRepo)
ElseIf URL.ToLower.Contains(SiteGitHub) Then
r.UrlRepo = URL
r.UrlRaw = rGet(URL, ReplacePattern_RepoToRaw)
End If
If r.Valid Then
r.UpdatedAt = Now.AddYears(-1)
r.UrlLatestCommit = rGet(r.UrlRepo, ReplacePattern_JsonInfo)
r.Exists = True
Return r
End If
End If
Return Nothing
End Function
#End Region
#Region "GetFormat"
Private Shared ReadOnly Property ConfigNodes As String()
Get
Return {"advanced_options", "DYNAMIC_RULE"}
End Get
End Property
Private Const FormatMidPart As String = ":{0}:{1:x}:"
Private ReadOnly FormatExtract As RParams = RParams.DM("(\S+)\s*:\s*\{\s*\d?\s*\}\s*:\s*\{\s*\d?\s*:\s*x\s*\}\s*:\s*(\S+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
Private ReadOnly ContainerStrConv As New CustomProvider(Function(input) If(ACheck(Of Integer)(input), input, $"""{input}"""))
Private ReadOnly ContainerConv As New CustomProvider(Function(ByVal e As Object) As Object
With DirectCast(e, EContainer)
Dim value$ = String.Empty
If .ListExists Then
value = .Select(Function(ee) ee(0).Value).ListToStringE(",", ContainerStrConv, False, String.Empty, EDP.ReturnValue)
If Not value.IsEmptyString Then value = $"[{value}]"
Else
value = AConvert(Of String)(.Value, ContainerStrConv, String.Empty, EDP.SendToLog, EDP.ReturnValue)
End If
If Not value.IsEmptyString Then
value = $"""{ .Name}"": {value}"
Else
value = $"""{ .Name}"": """""
End If
Return value
End With
End Function)
Friend Shared Function GetFormat(ByVal j As EContainer, Optional ByVal Check As Boolean = False,
Optional ByRef CheckResult As Boolean = False,
Optional ByVal TryConfig As Boolean = False, Optional ByRef IsConfig As Boolean = False) As String
Dim pattern$ = String.Empty
With If(TryConfig, j(ConfigNodes), j)
If .ListExists Then
If Not .Value("format").IsEmptyString Then
pattern = .Value("format").Replace("{}", "{0}").Replace("{:x}", "{1:x}")
ElseIf Not .Value("prefix").IsEmptyString And Not .Value("suffix").IsEmptyString Then
pattern = .Value("prefix") & FormatMidPart & .Value("suffix")
ElseIf Not .Value("start").IsEmptyString And Not .Value("end").IsEmptyString Then
pattern = .Value("start") & FormatMidPart & .Value("end")
End If
Dim result As Boolean = Not pattern.IsEmptyString And .Item("checksum_indexes").ListExists And
Not .Value("static_param").IsEmptyString And Not .Value("checksum_constant").IsEmptyString
If Check Then CheckResult = result
If Not result And Not TryConfig Then Return GetFormat(j, Check, CheckResult, True, IsConfig)
End If
End With
Return pattern
End Function
Private Function ConvertAuthText() As String
Dim result$ = String.Empty
With CurrentContainer
If .ListExists Then
Dim f$ = GetFormat(.Self)
If Not f.IsEmptyString Then
Dim l As List(Of String) = RegexReplace(f, FormatExtract)
If l.ListExists(3) Then
Dim s$ = l(1), e$ = l(2)
.Value("format") = s & FormatMidPart & e
.Value("prefix") = s
.Value("suffix") = e
.Value("start") = s
.Value("end") = e
Dim t$ = .ListToStringE(",", ContainerConv, False)
If Not t.IsEmptyString Then t = "{" & t & "}"
Return t
End If
End If
End If
End With
Return String.Empty
End Function
#End Region
#Region "Load, Save"
Private Function GetTextLines(ByVal Input As String) As List(Of String)
If Not Input.IsEmptyString Then
Return ListAddList(Nothing, Input.StringTrim.Split(vbLf), LAP.NotContainsOnly, EDP.ReturnValue,
CType(Function(inp$) inp.StringTrim, Func(Of Object, Object)))
Else
Return New List(Of String)
End If
End Function
Private Sub ParseConsts(ByVal Source As String)
If Not Source.IsEmptyString Then
Dim l As List(Of String) = GetTextLines(Source)
Dim v$()
If l.ListExists Then
RulesConstants.Clear()
For Each value$ In l
If Not value.IsEmptyString Then
v = value.Split("=")
If v.ListExists(2) Then RulesConstants.Add(v(0), v(1))
End If
Next
End If
End If
End Sub
Private Const RulesNode As String = "Rules"
Private _InitialValuesLoaded As Boolean = False
Private Sub LoadInitialValues()
If Not _InitialValuesLoaded Then
_InitialValuesLoaded = True
If Not OFScraperConfigPatternFile.Exists Then
Dim t$ = Text.Encoding.UTF8.GetString(My.Resources.OFResources.OFScraperConfigPattern)
TextSaver.SaveTextToFile(t, OFScraperConfigPatternFile, True)
End If
If Not OFScraperConfigPatternFileConst.Exists Then _
TextSaver.SaveTextToFile(My.Resources.OFResources.OFScraperConfigPatternConstants, OFScraperConfigPatternFileConst, True)
If OFScraperConfigPatternFileConst.Exists Then ParseConsts(OFScraperConfigPatternFileConst.GetText(OFError))
If DynamicRulesXml.Exists Then
Rules.Clear()
Using x As New XmlFile(DynamicRulesXml, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
x.LoadData(OFError)
Dim dNull As Date = Now.AddYears(-1)
LastUpdateTimeFile = x.Value(Name_LastUpdateTimeFile).ToDateDef(dNull)
LastUpdateTimeRules = x.Value(Name_LastUpdateTimeRules).ToDateDef(dNull)
ProtectFile = x.Value(Name_ProtectFile).FromXML(Of Boolean)(False)
Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.List)
UpdateInterval = x.Value(Name_UpdateInterval).FromXML(Of Integer)(UpdateIntervalDefault)
PersonalRule = x.Value(Name_PersonalRule)
RulesForceUpdateRequired = x.Value(Name_RulesForceUpdateRequired).FromXML(Of Boolean)(False)
RulesUpdateConst = x.Value(Name_RulesUpdateConst).FromXML(Of Boolean)(True)
RulesReplaceConfig = x.Value(Name_RulesReplaceConfig).FromXML(Of Boolean)(True)
AddErrorsToLog = x.Value(Name_AddErrorsToLog).FromXML(Of Boolean)(False)
ConfigAutoUpdate = x.Value(Name_ConfigAutoUpdate).FromXML(Of Boolean)(True)
RulesConfigManualMode = x.Value(Name_RulesConfigManualMode).FromXML(Of Boolean)(True)
ConfigLastDateUpdate = x.Value(Name_ConfigLastDateUpdate).ToDateDef(Now.AddYears(-1))
If x.Contains(RulesNode) Then Rules.ListAddList(x({RulesNode}), LAP.IgnoreICopier, OFError)
End Using
End If
End If
End Sub
Friend Sub Save()
Using x As New XmlFile With {.AllowSameNames = True, .Name = "DynamicRules"}
x.Add(Name_LastUpdateTimeFile, LastUpdateTimeFile.ToStringDateDef)
x.Add(Name_LastUpdateTimeRules, LastUpdateTimeRules.ToStringDateDef)
x.Add(Name_ProtectFile, ProtectFile.BoolToInteger)
x.Add(Name_Mode, CInt(Mode))
x.Add(Name_UpdateInterval, UpdateInterval)
x.Add(Name_PersonalRule, PersonalRule)
x.Add(Name_RulesForceUpdateRequired, RulesForceUpdateRequired.BoolToInteger)
x.Add(Name_RulesUpdateConst, RulesUpdateConst.BoolToInteger)
x.Add(Name_RulesReplaceConfig, RulesReplaceConfig.BoolToInteger)
x.Add(Name_AddErrorsToLog, AddErrorsToLog.BoolToInteger)
x.Add(Name_ConfigAutoUpdate, ConfigAutoUpdate.BoolToInteger)
x.Add(Name_RulesConfigManualMode, RulesConfigManualMode.BoolToInteger)
x.Add(Name_ConfigLastDateUpdate, ConfigLastDateUpdate.ToStringDateDef)
If Count > 0 Then
Rules.Sort()
x.Add(New EContainer(RulesNode))
x.Last.AddRange(Rules)
End If
x.Save(DynamicRulesXml, OFError)
End Using
If Count > 0 Then
Using t As New TextSaver(DynamicRulesFile)
Rules.ForEach(Sub(r) If Not r.UrlRepo.IsEmptyString Then t.AppendLine(r.UrlRepo))
t.Save(OFError)
End Using
End If
End Sub
#End Region
#Region "Update"
Private _UpdateInProgress As Boolean = False
Private _ForcedUpdate As Boolean = False
Friend Function Update(ByVal Force As Boolean, Optional ByVal LoadListOnly As Boolean = False) As Boolean
Dim skip As Boolean = _UpdateInProgress
If skip And _ForcedUpdate Then Force = False
_ForcedUpdate = Force
While _UpdateInProgress : Threading.Thread.Sleep(200) : End While
If Not skip Or Force Then UpdateImpl(Force Or RulesForceUpdateRequired, LoadListOnly)
Return Exists
End Function
Private Sub UpdateImpl(ByVal Force As Boolean, Optional ByVal LoadListOnly As Boolean = False)
Try
If Not _UpdateInProgress Then
_UpdateInProgress = True
LoadInitialValues()
Dim r$
Dim process As Boolean = False, updated As Boolean = False
Dim forceSave As Boolean = RulesForceUpdateRequired Or Not DynamicRulesFile.Exists Or Not DynamicRulesXml.Exists
Dim textLocal As List(Of String)
Dim i%
Dim rule As DynamicRulesValue
Dim e As EContainer
Dim errDate As Date = Now.AddYears(-1)
Dim d As Date?
'2024-06-12T12:44:06.000-05:00
Dim dateProvider As New ADateTime("yyyy-MM-ddTHH:mm:ss.fff%K")
RulesForceUpdateRequired = False
If Not DynamicRulesFile.Exists Then process = True : ValidateRulesFile()
'update rules list
If Not LoadListOnly And (LastUpdateTimeFile.AddMinutes(UpdateInterval) < Now Or process Or Force) Then
LastUpdateTimeFile = Now
r = Responser.GetResponse("https://raw.githubusercontent.com/AAndyProgram/SCrawler/main/SCrawler/API/OnlyFans/DynamicRules.txt")
If Not r.IsEmptyString Then
Dim textWeb As List(Of String) = GetTextLines(r)
Dim fileText$
If textWeb.ListExists Then
Using t As New TextSaver(DynamicRulesFile)
If ProtectFile Then
fileText = DynamicRulesFile.GetText(OFError)
t.Append(fileText)
textLocal = GetTextLines(fileText)
If textLocal.ListExists Then _
textLocal.ForEach(Sub(tt) If Not tt.IsEmptyString AndAlso Not textWeb.Contains(tt, RulesLinesComparer) Then _
t.AppendLine(tt) : updated = True) : textLocal.Clear()
Else
t.Append(r)
updated = True
End If
t.Save(OFError)
End Using
textWeb.Clear()
End If
End If
End If
'update config and consts
If Not LoadListOnly AndAlso ConfigAutoUpdate AndAlso ConfigLastDateUpdate.AddMinutes(UpdateInterval) < Now Then
Dim __upConf As Boolean = False
Dim __dConf As Date = ConfigLastDateUpdate
Dim parseConfigFiles As Action(Of DynamicRulesValue, SFile, Boolean) =
Sub(ByVal __rule As DynamicRulesValue, ByVal __fileSave As SFile, ByVal isConstFile As Boolean)
r = Responser.GetResponse(__rule.UrlLatestCommit)
If Not r.IsEmptyString Then
e = JsonDocument.Parse(r, OFError)
If e.ListExists Then
d = AConvert(Of Date)(e.Value("date"), dateProvider, Nothing)
Dim dConf As Date = If(d, errDate)
If dConf > __dConf Then
__dConf = dConf
__upConf = True
updated = True
r = Responser.GetResponse(__rule.UrlRaw)
If Not r.IsEmptyString Then
TextSaver.SaveTextToFile(r, __fileSave, True, False, OFError)
If isConstFile Then ParseConsts(r)
End If
End If
e.Dispose()
End If
End If
End Sub
'Update consts
If RulesUpdateConst Then parseConfigFiles(ConfigConstAddress, OFScraperConfigPatternFileConst, True)
'Update config
parseConfigFiles(ConfigAddress, OFScraperConfigPatternFile, False)
If __upConf Then ConfigLastDateUpdate = Now
End If
'generate rules, update rules dates
If LastUpdateTimeRules.AddMinutes(UpdateInterval) < Now Or updated Or Force Or LoadListOnly Then
process = True
If Mode = Modes.Personal And Not PersonalRule.IsEmptyString Then
If Not LoadListOnly Then LastUpdateTimeRules = Now : updated = True
Else
If Not LoadListOnly Then LastUpdateTimeRules = Now : updated = True
textLocal = GetTextLines(DynamicRulesFile.GetText(OFError))
If textLocal.ListExists Then
If Not LoadListOnly And Count > 0 Then
For i = 0 To Count - 1
rule = Rules(i)
rule.Exists = False
Rules(i) = rule
Next
End If
For Each url$ In textLocal
url = url.StringTrim
If Not url.IsEmptyString Then
i = IndexOf(url)
If i >= 0 Then
rule = Rules(i)
Else
rule = ParseURL(url)
If rule.Valid Then
i = Add(rule, False, False)
Else
rule = Nothing
End If
End If
If Not LoadListOnly Then
If i >= 0 And rule.Valid And Not rule.UrlLatestCommit.IsEmptyString Then
rule.Exists = True
r = Responser.GetResponse(rule.UrlLatestCommit)
If Not r.IsEmptyString Then
e = JsonDocument.Parse(r, OFError)
If e.ListExists Then
d = AConvert(Of Date)(e.Value("date"), dateProvider, Nothing)
rule.UpdatedAt = If(d, errDate)
e.Dispose()
Else
rule.Broken = True
End If
Else
rule.Broken = True
End If
Rules(i) = rule
End If
If Rules.RemoveAll(Function(rr) Not rr.Exists) > 0 Then updated = True
End If
End If
Next
End If
End If
End If
If Count > 0 Then Rules.Sort()
'download and load the rule
If (LoadListOnly And AuthFile.Exists) Or (Not LoadListOnly And ((updated And Count > 0) Or Not AuthFile.Exists)) Then
_CurrentRule = Nothing
_CurrentContainer.DisposeIfReady
_CurrentContainer = Nothing
Dim processRule As Func(Of DynamicRulesValue, Boolean, DialogResult) =
Function(ByVal __rule As DynamicRulesValue, ByVal reparseAuth As Boolean) As DialogResult
Dim fromAuthFile As Boolean = (LoadListOnly Or reparseAuth) AndAlso AuthFile.Exists
If fromAuthFile Then
r = AuthFile.GetText(OFError)
Else
r = GetWebString(__rule.UrlRaw,, OFError)
End If
Dim j As EContainer = JsonDocument.Parse(r, OFError)
Dim checkResult As Boolean = False
Dim isConfig As Boolean = False
Dim textToSave As String = r
If j.ListExists AndAlso Not GetFormat(j, True, checkResult,, isConfig).IsEmptyString AndAlso checkResult Then
If isConfig Then textToSave = RegexReplace(r, ConfigRulesExtract)
If textToSave.IsEmptyString Then
Return DialogResult.Retry
Else
_CurrentRule = __rule
_CurrentContainer = If(isConfig, j(ConfigNodes), j)
textToSave = ConvertAuthText()
_CurrentContainerRulesText = textToSave
If (Not fromAuthFile Or Not textToSave.StringTrim = r.StringTrim) And Not textToSave.IsEmptyString Then
TextSaver.SaveTextToFile(textToSave, AuthFile, True, False, OFError)
If Not reparseAuth Then processRule(__rule, True)
End If
Return DialogResult.OK
End If
End If
Return DialogResult.No
End Function
If Mode = Modes.Personal And Not PersonalRule.IsEmptyString Then
processRule(New DynamicRulesValue With {.UrlRepo = PersonalRule, .UrlRaw = PersonalRule}, False)
Else
For Each rule In Rules
If rule.Valid And Not rule.Broken Then
Select Case processRule(rule, False)
Case DialogResult.Retry : Continue For
Case DialogResult.OK : Exit For
End Select
End If
Next
End If
End If
If updated Or forceSave Then Save()
_UpdateInProgress = False
End If
Catch ex As Exception
ErrorsDescriber.Execute(OFError, ex, "[OnlyFans.DynamicRulesEnv.UpdateImpl]")
_UpdateInProgress = False
End Try
End Sub
#End Region
#Region "Add, IndexOf"
Friend Function Add(ByVal Rule As DynamicRulesValue, Optional ByVal AutoSort As Boolean = True, Optional ByVal AutoSave As Boolean = False) As Integer
If Rule.Valid Then
Dim i% = IndexOf(Rule)
If i = -1 Then
Rules.Add(Rule)
i = Count - 1
If AutoSort Then Rules.Sort() : i = IndexOf(Rule)
If AutoSave Then Save()
End If
Return i
Else
Return -1
End If
End Function
Friend Function RemoveAt(ByVal Index As Integer) As Boolean
If Index.ValueBetween(0, Count - 1) Then
Rules.RemoveAt(Index)
Return True
Else
Return False
End If
End Function
Friend Function IndexOf(ByVal URL As String) As Integer
If Count > 0 Then
URL = URL.StringToLower.Trim
Return Rules.FindIndex(Function(r) r.UrlRepo.StringToLower = URL Or r.UrlRaw.StringToLower = URL Or r.UrlLatestCommit.StringToLower = URL)
Else
Return -1
End If
End Function
#End Region
#Region "ICopier Support"
Friend Overloads Function Copy() As Object Implements ICopier.Copy
Return (New DynamicRulesEnv).Copy(Me)
End Function
Friend Overloads Function Copy(ByVal Source As Object) As Object Implements ICopier.Copy
Return Copy(Source, False)
End Function
Friend Overloads Function Copy(ByVal Source As Object, ByVal UpdateForceProperty As Boolean) As Object
If Not Source Is Nothing Then
With DirectCast(Source, DynamicRulesEnv)
If Not RulesForceUpdateRequired And UpdateForceProperty Then _
RulesForceUpdateRequired = Not Rules.ListEquals(.Rules) Or Not Mode = .Mode Or
(.Mode = Modes.Personal And Not PersonalRule = .PersonalRule)
ProtectFile = .ProtectFile
Mode = .Mode
UpdateInterval = .UpdateInterval
PersonalRule = .PersonalRule
If Not RulesForceUpdateRequired Then RulesForceUpdateRequired = .RulesForceUpdateRequired
RulesUpdateConst = .RulesUpdateConst
RulesReplaceConfig = .RulesReplaceConfig
AddErrorsToLog = .AddErrorsToLog
ConfigAutoUpdate = .ConfigAutoUpdate
RulesConfigManualMode = .RulesConfigManualMode
Rules.Clear()
If .Count > 0 Then Rules.AddRange(.Rules)
End With
Return Me
Else
Return Nothing
End If
End Function
#End Region
#Region "IEnumerable Support"
Private Function GetEnumerator() As IEnumerator(Of DynamicRulesValue) Implements IEnumerable(Of DynamicRulesValue).GetEnumerator
Return New MyEnumerator(Of DynamicRulesValue)(Me)
End Function
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return GetEnumerator()
End Function
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Overridable Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
Rules.Clear()
_CurrentContainer.DisposeIfReady
Responser.DisposeIfReady
End If
_CurrentContainer = Nothing
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
End Namespace

View File

@@ -64,6 +64,20 @@ Namespace My.Resources
End Set End Set
End Property End Property
'''<summary>
''' Looks up a localized string similar to https://github.com/datawhores/onlyfans-dynamic-rules/blob/main/dynamicRules.json
'''https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/main/dynamicRules.json
'''https://github.com/riley-access-labs/onlyfans-dynamic-rules-1/blob/patch-1/dynamicRules.json
'''https://github.com/DATAHOARDERS/dynamic-rules/blob/main/onlyfans.json
'''https://github.com/DIGITALCRIMINAL/dynamic-rules/blob/main/onlyfans.json
'''https://github.com/deviint/onlyfans-dynamic-rules/blob/main/dynamicRules.json.
'''</summary>
Friend Shared ReadOnly Property DynamicRules() As String
Get
Return ResourceManager.GetString("DynamicRules", resourceCulture)
End Get
End Property
'''<summary> '''<summary>
''' Looks up a localized resource of type System.Byte[]. ''' Looks up a localized resource of type System.Byte[].
'''</summary> '''</summary>
@@ -73,5 +87,15 @@ Namespace My.Resources
Return CType(obj,Byte()) Return CType(obj,Byte())
End Get End Get
End Property End Property
'''<summary>
''' Looks up a localized string similar to dynamic-mode-default=generic
'''RULE_VALUE=DYNAMIC_GENERIC_URL.
'''</summary>
Friend Shared ReadOnly Property OFScraperConfigPatternConstants() As String
Get
Return ResourceManager.GetString("OFScraperConfigPatternConstants", resourceCulture)
End Get
End Property
End Class End Class
End Namespace End Namespace

View File

@@ -118,7 +118,13 @@
<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>
<assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" /> <assembly alias="System.Windows.Forms" name="System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" />
<data name="DynamicRules" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>DynamicRules.txt;System.String, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089;utf-8</value>
</data>
<data name="OFScraperConfigPattern" type="System.Resources.ResXFileRef, System.Windows.Forms"> <data name="OFScraperConfigPattern" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>OFScraperConfigPattern.json;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> <value>OFScraperConfigPattern.json;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</data> </data>
<data name="OFScraperConfigPatternConstants" type="System.Resources.ResXFileRef, System.Windows.Forms">
<value>OFScraperConfigPatternConstants.txt;System.String, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089;utf-8</value>
</data>
</root> </root>

View File

@@ -1,61 +1,63 @@
{ {
"config": { "main_profile": "main_profile",
"main_profile": "main_profile", "metadata": "{configpath}/{profile}/.data/{model_username}_{model_id}",
"metadata": "{configpath}/{profile}/.data/{model_username}_{model_id}", "discord": "",
"discord": "", "file_options": {
"file_options": { "save_location": "",
"save_location": "", "dir_format": "",
"dir_format": "", "file_format": "{filename}.{ext}",
"file_format": "{filename}.{ext}", "textlength": 0,
"textlength": 0, "space_replacer": " ",
"space-replacer": " ", "date": "YYYY-MM-DD"
"date": "YYYY-MM-DD" },
}, "download_options": {
"download_options": { "file_size_max": 0,
"file_size_limit": 0, "file_size_min": 0,
"file_size_min": 0, "filter": [
"filter": [ "Images",
"Images", "Audios",
"Audios", "Videos"
"Videos" ],
], "auto_resume": false
"auto_resume": false },
}, "binary_options": {
"binary_options": { "mp4decrypt": "",
"mp4decrypt": "", "ffmpeg": ""
"ffmpeg": "" },
}, "cdm_options": {
"cdm_options": { "private-key": null,
"private-key": null, "client-id": null,
"client-id": null, "key-mode-default": "cdrm",
"key-mode-default": "cdrm", "keydb_api": ""
"keydb_api": "" },
}, "performance_options": {
"performance_options": { "download-sems": 6,
"download-sems": 6, "maxfile-sem": 0,
"maxfile-sem": 0, "threads": 5
"threads": 5 },
}, "advanced_options": {
"advanced_options": { "code-execution": false,
"code-execution": false, "dynamic-mode-default": "generic",
"dynamic-mode-default": "deviint", "backend": "aio",
"backend": "aio", "downloadbars": false,
"downloadbars": false, "cache-mode": "sqlite",
"cache-mode": "sqlite", "appendlog": true,
"appendlog": true, "custom": null,
"custom": null, "sanitize_text": false,
"sanitize_text": false, "avatar": true,
"avatar": true "custom_values": {
}, "DYNAMIC_GENERIC_URL": "https://raw.githubusercontent.com/datawhores/onlyfans-dynamic-rules/main/dynamicRules.json",
"responsetype": { "CDRM": "https://old.cdrm-project.com/wv"
"timeline": "Posts",
"message": "Messages",
"archived": "Archived",
"paid": "Messages",
"stories": "Stories",
"highlights": "Stories",
"profile": "Profile",
"pinned": "Posts"
} }
},
"responsetype": {
"timeline": "Posts",
"message": "Messages",
"archived": "Archived",
"paid": "Messages",
"stories": "Stories",
"highlights": "Stories",
"profile": "Profile",
"pinned": "Posts"
} }
} }

View File

@@ -0,0 +1,2 @@
dynamic-mode-default=generic
RULE_VALUE=DYNAMIC_GENERIC_URL

View File

@@ -0,0 +1,361 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.OnlyFans
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class OnlyFansAdvancedSettingsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim ActionButton7 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(OnlyFansAdvancedSettingsForm))
Dim ActionButton8 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton9 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_RULES_LIST As System.Windows.Forms.TableLayoutPanel
Dim TP_RULES_LIST_LEFT As System.Windows.Forms.TableLayoutPanel
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.TXT_UP_INTERVAL = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_PERSONAL_RULE = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CONTAINER_LIST = New System.Windows.Forms.ToolStripContainer()
Me.LIST_RULES = New System.Windows.Forms.ListBox()
Me.OPT_RULES_LIST = New System.Windows.Forms.RadioButton()
Me.CH_PROTECTED = New System.Windows.Forms.CheckBox()
Me.CH_FORCE_UPDATE = New System.Windows.Forms.CheckBox()
Me.CH_LOG_ERR = New System.Windows.Forms.CheckBox()
Me.CH_RULES_REPLACE_CONFIG = New System.Windows.Forms.CheckBox()
Me.CH_UPDATE_CONF = New System.Windows.Forms.CheckBox()
Me.CH_UPDATE_RULES_CONST = New System.Windows.Forms.CheckBox()
Me.CH_CONFIG_MANUAL_MODE = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_RULES_LIST = New System.Windows.Forms.TableLayoutPanel()
TP_RULES_LIST_LEFT = New System.Windows.Forms.TableLayoutPanel()
TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
CType(Me.TXT_UP_INTERVAL, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_PERSONAL_RULE, System.ComponentModel.ISupportInitialize).BeginInit()
TP_RULES_LIST.SuspendLayout()
Me.CONTAINER_LIST.ContentPanel.SuspendLayout()
Me.CONTAINER_LIST.SuspendLayout()
TP_RULES_LIST_LEFT.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(464, 341)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(464, 341)
CONTAINER_MAIN.TabIndex = 1
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Controls.Add(Me.TXT_UP_INTERVAL, 0, 5)
TP_MAIN.Controls.Add(Me.TXT_PERSONAL_RULE, 0, 6)
TP_MAIN.Controls.Add(TP_RULES_LIST, 0, 7)
TP_MAIN.Controls.Add(Me.CH_LOG_ERR, 0, 0)
TP_MAIN.Controls.Add(Me.CH_RULES_REPLACE_CONFIG, 0, 1)
TP_MAIN.Controls.Add(Me.CH_UPDATE_CONF, 0, 4)
TP_MAIN.Controls.Add(Me.CH_UPDATE_RULES_CONST, 0, 2)
TP_MAIN.Controls.Add(Me.CH_CONFIG_MANUAL_MODE, 0, 3)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 8
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(464, 341)
TP_MAIN.TabIndex = 0
'
'TXT_UP_INTERVAL
'
ActionButton7.BackgroundImage = CType(resources.GetObject("ActionButton7.BackgroundImage"), System.Drawing.Image)
ActionButton7.Name = "Refresh"
ActionButton7.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Refresh
ActionButton8.BackgroundImage = CType(resources.GetObject("ActionButton8.BackgroundImage"), System.Drawing.Image)
ActionButton8.Name = "Clear"
ActionButton8.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_UP_INTERVAL.Buttons.Add(ActionButton7)
Me.TXT_UP_INTERVAL.Buttons.Add(ActionButton8)
Me.TXT_UP_INTERVAL.CaptionText = "Dynamic rules update"
Me.TXT_UP_INTERVAL.CaptionToolTipEnabled = True
Me.TXT_UP_INTERVAL.CaptionToolTipText = "'Dynamic rules' update interval (minutes). Default: 1440"
Me.TXT_UP_INTERVAL.CaptionWidth = 120.0R
Me.TXT_UP_INTERVAL.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_UP_INTERVAL.Location = New System.Drawing.Point(4, 134)
Me.TXT_UP_INTERVAL.Name = "TXT_UP_INTERVAL"
Me.TXT_UP_INTERVAL.Size = New System.Drawing.Size(456, 22)
Me.TXT_UP_INTERVAL.TabIndex = 5
'
'TXT_PERSONAL_RULE
'
Me.TXT_PERSONAL_RULE.AutoShowClearButton = True
ActionButton9.BackgroundImage = CType(resources.GetObject("ActionButton9.BackgroundImage"), System.Drawing.Image)
ActionButton9.Enabled = False
ActionButton9.Name = "Clear"
ActionButton9.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
ActionButton9.Visible = False
Me.TXT_PERSONAL_RULE.Buttons.Add(ActionButton9)
Me.TXT_PERSONAL_RULE.CaptionMode = PersonalUtilities.Forms.Controls.Base.ICaptionControl.Modes.RadioButton
Me.TXT_PERSONAL_RULE.CaptionText = "Dynamic rules URL"
Me.TXT_PERSONAL_RULE.CaptionToolTipEnabled = True
Me.TXT_PERSONAL_RULE.CaptionToolTipText = "Overwrite 'Dynamic rules' with this URL." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Change this value only if you know what" &
" you are doing."
Me.TXT_PERSONAL_RULE.CaptionWidth = 120.0R
Me.TXT_PERSONAL_RULE.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_PERSONAL_RULE.LeaveDefaultButtons = True
Me.TXT_PERSONAL_RULE.Location = New System.Drawing.Point(4, 163)
Me.TXT_PERSONAL_RULE.Name = "TXT_PERSONAL_RULE"
Me.TXT_PERSONAL_RULE.Size = New System.Drawing.Size(456, 22)
Me.TXT_PERSONAL_RULE.TabIndex = 6
'
'TP_RULES_LIST
'
TP_RULES_LIST.ColumnCount = 2
TP_RULES_LIST.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 120.0!))
TP_RULES_LIST.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_RULES_LIST.Controls.Add(Me.CONTAINER_LIST, 1, 0)
TP_RULES_LIST.Controls.Add(TP_RULES_LIST_LEFT, 0, 0)
TP_RULES_LIST.Dock = System.Windows.Forms.DockStyle.Fill
TP_RULES_LIST.Location = New System.Drawing.Point(4, 192)
TP_RULES_LIST.Name = "TP_RULES_LIST"
TP_RULES_LIST.RowCount = 1
TP_RULES_LIST.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_RULES_LIST.Size = New System.Drawing.Size(456, 145)
TP_RULES_LIST.TabIndex = 7
'
'CONTAINER_LIST
'
Me.CONTAINER_LIST.BottomToolStripPanelVisible = False
'
'CONTAINER_LIST.ContentPanel
'
Me.CONTAINER_LIST.ContentPanel.Controls.Add(Me.LIST_RULES)
Me.CONTAINER_LIST.ContentPanel.Size = New System.Drawing.Size(330, 114)
Me.CONTAINER_LIST.Dock = System.Windows.Forms.DockStyle.Fill
Me.CONTAINER_LIST.LeftToolStripPanelVisible = False
Me.CONTAINER_LIST.Location = New System.Drawing.Point(123, 3)
Me.CONTAINER_LIST.Name = "CONTAINER_LIST"
Me.CONTAINER_LIST.RightToolStripPanelVisible = False
Me.CONTAINER_LIST.Size = New System.Drawing.Size(330, 139)
Me.CONTAINER_LIST.TabIndex = 1
'
'LIST_RULES
'
Me.LIST_RULES.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_RULES.FormattingEnabled = True
Me.LIST_RULES.Location = New System.Drawing.Point(0, 0)
Me.LIST_RULES.Name = "LIST_RULES"
Me.LIST_RULES.Size = New System.Drawing.Size(330, 114)
Me.LIST_RULES.TabIndex = 0
'
'TP_RULES_LIST_LEFT
'
TP_RULES_LIST_LEFT.ColumnCount = 1
TP_RULES_LIST_LEFT.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_RULES_LIST_LEFT.Controls.Add(Me.OPT_RULES_LIST, 0, 0)
TP_RULES_LIST_LEFT.Controls.Add(Me.CH_PROTECTED, 0, 1)
TP_RULES_LIST_LEFT.Controls.Add(Me.CH_FORCE_UPDATE, 0, 2)
TP_RULES_LIST_LEFT.Dock = System.Windows.Forms.DockStyle.Fill
TP_RULES_LIST_LEFT.Location = New System.Drawing.Point(0, 0)
TP_RULES_LIST_LEFT.Margin = New System.Windows.Forms.Padding(0)
TP_RULES_LIST_LEFT.Name = "TP_RULES_LIST_LEFT"
TP_RULES_LIST_LEFT.RowCount = 4
TP_RULES_LIST_LEFT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_RULES_LIST_LEFT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_RULES_LIST_LEFT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_RULES_LIST_LEFT.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_RULES_LIST_LEFT.Size = New System.Drawing.Size(120, 145)
TP_RULES_LIST_LEFT.TabIndex = 0
'
'OPT_RULES_LIST
'
Me.OPT_RULES_LIST.AutoSize = True
Me.OPT_RULES_LIST.CheckAlign = System.Drawing.ContentAlignment.MiddleRight
Me.OPT_RULES_LIST.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_RULES_LIST.Location = New System.Drawing.Point(3, 3)
Me.OPT_RULES_LIST.Margin = New System.Windows.Forms.Padding(3, 3, 0, 3)
Me.OPT_RULES_LIST.Name = "OPT_RULES_LIST"
Me.OPT_RULES_LIST.Size = New System.Drawing.Size(117, 19)
Me.OPT_RULES_LIST.TabIndex = 0
Me.OPT_RULES_LIST.TabStop = True
Me.OPT_RULES_LIST.Text = "Dynamic rules list"
Me.OPT_RULES_LIST.TextAlign = System.Drawing.ContentAlignment.MiddleRight
TT_MAIN.SetToolTip(Me.OPT_RULES_LIST, "List of dynamic rules sources." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "If selected, the most recently updated source wil" &
"l be selected.")
Me.OPT_RULES_LIST.UseVisualStyleBackColor = True
'
'CH_PROTECTED
'
Me.CH_PROTECTED.AutoSize = True
Me.CH_PROTECTED.CheckAlign = System.Drawing.ContentAlignment.MiddleRight
Me.CH_PROTECTED.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_PROTECTED.Location = New System.Drawing.Point(3, 28)
Me.CH_PROTECTED.Margin = New System.Windows.Forms.Padding(3, 3, 0, 3)
Me.CH_PROTECTED.Name = "CH_PROTECTED"
Me.CH_PROTECTED.Size = New System.Drawing.Size(117, 19)
Me.CH_PROTECTED.TabIndex = 1
Me.CH_PROTECTED.Text = "Protected list"
Me.CH_PROTECTED.TextAlign = System.Drawing.ContentAlignment.MiddleRight
TT_MAIN.SetToolTip(Me.CH_PROTECTED, "If checked, the new source will be added, but the rules list will not be overwrit" &
"ten by the updated one.")
Me.CH_PROTECTED.UseVisualStyleBackColor = True
'
'CH_FORCE_UPDATE
'
Me.CH_FORCE_UPDATE.AutoSize = True
Me.CH_FORCE_UPDATE.CheckAlign = System.Drawing.ContentAlignment.MiddleRight
Me.CH_FORCE_UPDATE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_FORCE_UPDATE.Location = New System.Drawing.Point(3, 53)
Me.CH_FORCE_UPDATE.Margin = New System.Windows.Forms.Padding(3, 3, 0, 3)
Me.CH_FORCE_UPDATE.Name = "CH_FORCE_UPDATE"
Me.CH_FORCE_UPDATE.Size = New System.Drawing.Size(117, 19)
Me.CH_FORCE_UPDATE.TabIndex = 2
Me.CH_FORCE_UPDATE.Text = "Force update"
Me.CH_FORCE_UPDATE.TextAlign = System.Drawing.ContentAlignment.MiddleRight
TT_MAIN.SetToolTip(Me.CH_FORCE_UPDATE, "Check this if you want to force the rules to update.")
Me.CH_FORCE_UPDATE.UseVisualStyleBackColor = True
'
'CH_LOG_ERR
'
Me.CH_LOG_ERR.AutoSize = True
Me.CH_LOG_ERR.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_LOG_ERR.Location = New System.Drawing.Point(4, 4)
Me.CH_LOG_ERR.Name = "CH_LOG_ERR"
Me.CH_LOG_ERR.Size = New System.Drawing.Size(456, 19)
Me.CH_LOG_ERR.TabIndex = 0
Me.CH_LOG_ERR.Text = "Add dynamic rules errors to the log"
TT_MAIN.SetToolTip(Me.CH_LOG_ERR, "OnlyFans errors will be added to a separate log." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "A checked checkbox means that e" &
"rror notification will be added to the main log.")
Me.CH_LOG_ERR.UseVisualStyleBackColor = True
'
'CH_RULES_REPLACE_CONFIG
'
Me.CH_RULES_REPLACE_CONFIG.AutoSize = True
Me.CH_RULES_REPLACE_CONFIG.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_RULES_REPLACE_CONFIG.Location = New System.Drawing.Point(4, 30)
Me.CH_RULES_REPLACE_CONFIG.Name = "CH_RULES_REPLACE_CONFIG"
Me.CH_RULES_REPLACE_CONFIG.Size = New System.Drawing.Size(456, 19)
Me.CH_RULES_REPLACE_CONFIG.TabIndex = 1
Me.CH_RULES_REPLACE_CONFIG.Text = "Replace rules in OF-Scraper configuration file"
TT_MAIN.SetToolTip(Me.CH_RULES_REPLACE_CONFIG, "If checked, the dynamic rules (in the config) will be replaced with actual values" &
".")
Me.CH_RULES_REPLACE_CONFIG.UseVisualStyleBackColor = True
'
'CH_UPDATE_CONF
'
Me.CH_UPDATE_CONF.AutoSize = True
Me.CH_UPDATE_CONF.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_UPDATE_CONF.Location = New System.Drawing.Point(4, 108)
Me.CH_UPDATE_CONF.Name = "CH_UPDATE_CONF"
Me.CH_UPDATE_CONF.Size = New System.Drawing.Size(456, 19)
Me.CH_UPDATE_CONF.TabIndex = 4
Me.CH_UPDATE_CONF.Text = "Update configuration file during update"
TT_MAIN.SetToolTip(Me.CH_UPDATE_CONF, "Update the configuration pattern from the site during update.")
Me.CH_UPDATE_CONF.UseVisualStyleBackColor = True
'
'CH_UPDATE_RULES_CONST
'
Me.CH_UPDATE_RULES_CONST.AutoSize = True
Me.CH_UPDATE_RULES_CONST.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_UPDATE_RULES_CONST.Location = New System.Drawing.Point(4, 56)
Me.CH_UPDATE_RULES_CONST.Name = "CH_UPDATE_RULES_CONST"
Me.CH_UPDATE_RULES_CONST.Size = New System.Drawing.Size(456, 19)
Me.CH_UPDATE_RULES_CONST.TabIndex = 2
Me.CH_UPDATE_RULES_CONST.Text = "Update rules constants file during update"
TT_MAIN.SetToolTip(Me.CH_UPDATE_RULES_CONST, "Update rules constants from the site during update")
Me.CH_UPDATE_RULES_CONST.UseVisualStyleBackColor = True
'
'CH_CONFIG_MANUAL_MODE
'
Me.CH_CONFIG_MANUAL_MODE.AutoSize = True
Me.CH_CONFIG_MANUAL_MODE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_CONFIG_MANUAL_MODE.Location = New System.Drawing.Point(4, 82)
Me.CH_CONFIG_MANUAL_MODE.Name = "CH_CONFIG_MANUAL_MODE"
Me.CH_CONFIG_MANUAL_MODE.Size = New System.Drawing.Size(456, 19)
Me.CH_CONFIG_MANUAL_MODE.TabIndex = 3
Me.CH_CONFIG_MANUAL_MODE.Text = "Dynamic rules 'Manual' mode"
TT_MAIN.SetToolTip(Me.CH_CONFIG_MANUAL_MODE, "The rules will be added to the config as is, without using a link.")
Me.CH_CONFIG_MANUAL_MODE.UseVisualStyleBackColor = True
'
'OnlyFansAdvancedSettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(464, 341)
Me.Controls.Add(CONTAINER_MAIN)
Me.Icon = Global.SCrawler.My.Resources.SiteResources.OnlyFansIcon_32
Me.KeyPreview = True
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(480, 380)
Me.Name = "OnlyFansAdvancedSettingsForm"
Me.ShowInTaskbar = False
Me.Text = "Settings"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout()
CType(Me.TXT_UP_INTERVAL, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_PERSONAL_RULE, System.ComponentModel.ISupportInitialize).EndInit()
TP_RULES_LIST.ResumeLayout(False)
Me.CONTAINER_LIST.ContentPanel.ResumeLayout(False)
Me.CONTAINER_LIST.ResumeLayout(False)
Me.CONTAINER_LIST.PerformLayout()
TP_RULES_LIST_LEFT.ResumeLayout(False)
TP_RULES_LIST_LEFT.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents TXT_UP_INTERVAL As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_PERSONAL_RULE As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CONTAINER_LIST As ToolStripContainer
Private WithEvents LIST_RULES As ListBox
Private WithEvents OPT_RULES_LIST As RadioButton
Private WithEvents CH_PROTECTED As CheckBox
Private WithEvents CH_FORCE_UPDATE As CheckBox
Private WithEvents CH_LOG_ERR As CheckBox
Private WithEvents CH_RULES_REPLACE_CONFIG As CheckBox
Private WithEvents CH_UPDATE_CONF As CheckBox
Private WithEvents CH_UPDATE_RULES_CONST As CheckBox
Private WithEvents CH_CONFIG_MANUAL_MODE As CheckBox
End Class
End Namespace

View File

@@ -0,0 +1,186 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton7.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGOfPtRkwAAACBjSFJNAAB6
JQAAgIMAAPn/AACA6QAAdTAAAOpgAAA6mAAAF2+SX8VGAAAACXBIWXMAAAsTAAALEwEAmpwYAAACOElE
QVQ4T2P4//8/QczOJyyqHpzfiE0OQwAZC8iqszAzs7CJ69o4BR768V/W2jcGXQ0KB4aFNS3dDQtnrbCb
ePCK48wTN1wXXXzge/jXf/clV55zC4hIIatF0cjIyMikElzc57z0wX+XHd/+2+//99/ywP//xlu//tdb
+eK/4Zp3/1WTOhYzARViNUAluKjTdf37/0ZTTn9TbdhwXblhwwW1/qOP1Ja9+K8w+95/6cm3/6v2Xvkv
qKjniGGAoIqRpW3/4e8S9uGdzFz82gwMDFxAzCxm4ZegtuLDf+VJ1/8rZM25IqLvnM/CximCYYCic1QN
v7x2JIwPwyrJ3XNUylddE9G2TWNmZOBDl4czmJiZMSRBmFdSyYyJgUEQmxwIYxWEYXZBCUls4sgYq6CA
prWNbtG8nXKeaVPR5XiVjSxEzf0yYXy4BBMLO6eQjoOXZvrkbbazrv53Xf/2v4CSbjBMXkhBl1/CMyNZ
qWnvGy5pNQ+YONwAfjXzAOupl/47LLr333L50/96q9/8l23YdES6cO5KuYqVW+R7Tj6SnfP0v4hryjyY
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton8.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton9.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<metadata name="TP_RULES_LIST.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_RULES_LIST_LEFT.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<metadata name="TP_RULES_LIST_LEFT.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
</root>

View File

@@ -0,0 +1,165 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls.Base
Imports PersonalUtilities.Forms.Toolbars
Namespace API.OnlyFans
Friend Class OnlyFansAdvancedSettingsForm
#Region "Declarations"
Private WithEvents MyDefs As DefaultFormOptions
Friend Property CurrentRulesEnv As DynamicRulesEnv
Private ReadOnly Property CurrentRulesEnv_LIST As DynamicRulesEnv
#End Region
#Region "Initializer"
Friend Sub New(ByVal rules As DynamicRulesEnv)
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, Settings.Design)
CurrentRulesEnv = rules
CurrentRulesEnv_LIST = New DynamicRulesEnv
CurrentRulesEnv_LIST.Copy(rules, False)
End Sub
#End Region
#Region "Form handlers"
Private Sub OnlyFansAdvancedSettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
.AddOkCancelToolbar()
.MyEditToolbar = New EditToolbar(Me,, CONTAINER_LIST.TopToolStripPanel) With {.Buttons = Nothing}
.MyEditToolbar.AddThisToolbar()
With CurrentRulesEnv
Select Case .Mode
Case DynamicRulesEnv.Modes.List : OPT_RULES_LIST.Checked = True
Case DynamicRulesEnv.Modes.Personal : TXT_PERSONAL_RULE.Checked = True
End Select
CH_LOG_ERR.Checked = .AddErrorsToLog
CH_RULES_REPLACE_CONFIG.Checked = .RulesReplaceConfig
CH_UPDATE_RULES_CONST.Checked = .RulesUpdateConst
CH_CONFIG_MANUAL_MODE.Checked = .RulesConfigManualMode
CH_UPDATE_CONF.Checked = .ConfigAutoUpdate
TXT_UP_INTERVAL.Text = .UpdateInterval
If Not .PersonalRule.IsEmptyString Then TXT_PERSONAL_RULE.Text = .PersonalRule
Refill()
CH_PROTECTED.Checked = .ProtectFile
CH_FORCE_UPDATE.Checked = .RulesForceUpdateRequired
End With
.MyFieldsCheckerE = New FieldsChecker
.MyFieldsCheckerE.AddControl(Of Integer)(TXT_UP_INTERVAL, TXT_UP_INTERVAL.CaptionText,,
New FieldsCheckerProviderSimple(Function(v) IIf(AConvert(Of Integer)(v, 0, EDP.ReturnValue) > 0, v, Nothing),
"The value of [{0}] field must be greater than 0"))
.MyFieldsCheckerE.EndLoaderOperations()
.EndLoaderOperations()
End With
End Sub
Private Sub OnlyFansAdvancedSettingsForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
CurrentRulesEnv_LIST.Dispose()
End Sub
#End Region
#Region "Refill"
Private Sub Refill()
With CurrentRulesEnv_LIST
Dim ls% = _LatestSelected
LIST_RULES.Items.Clear()
If .Count > 0 Then LIST_RULES.Items.AddRange(.Select(Function(r) r.UrlRepo).Cast(Of Object).ToArray)
Dim lim% = LIST_RULES.Items.Count - 1
If (ls - 1).ValueBetween(0, lim) Then
ls -= 1
ElseIf (ls + 1).ValueBetween(0, lim) Then
ls += 1
End If
If ls.ValueBetween(0, lim) Then LIST_RULES.SelectedIndex = ls Else ls = -1
_LatestSelected = ls
End With
End Sub
#End Region
#Region "OK, Cancel"
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
If MyDefs.MyFieldsChecker.AllParamsOK Then
With CurrentRulesEnv
.Copy(CurrentRulesEnv_LIST, True)
.ProtectFile = CH_PROTECTED.Checked
.UpdateInterval = AConvert(Of Integer)(TXT_UP_INTERVAL.Text, DynamicRulesEnv.UpdateIntervalDefault)
.Mode = If(TXT_PERSONAL_RULE.Checked, DynamicRulesEnv.Modes.Personal, DynamicRulesEnv.Modes.List)
.PersonalRule = TXT_PERSONAL_RULE.Text
.RulesReplaceConfig = CH_RULES_REPLACE_CONFIG.Checked
.RulesUpdateConst = CH_UPDATE_RULES_CONST.Checked
.RulesConfigManualMode = CH_CONFIG_MANUAL_MODE.Checked
.ConfigAutoUpdate = CH_UPDATE_CONF.Checked
.AddErrorsToLog = CH_LOG_ERR.Checked
If CH_FORCE_UPDATE.Checked Then .RulesForceUpdateRequired = True
.NeedToSave = True
End With
MyDefs.CloseForm()
End If
End Sub
#End Region
#Region "Add, Delete"
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
Const msgTitle$ = "Add a rule"
Dim i%
Dim rule As DynamicRulesValue
Dim r$ = InputBoxE("Enter a valid rules URL:", msgTitle)
If Not r.IsEmptyString Then
rule = Rules.ParseURL(r)
If rule.Valid Then
i = CurrentRulesEnv_LIST.IndexOf(r)
If i >= 0 Then
MsgBoxE({$"The rule you entered already exists:{vbCr}{rule.UrlRepo}", msgTitle}, vbCritical)
Else
CurrentRulesEnv_LIST.Add(rule, False, False)
Refill()
End If
Else
MsgBoxE({$"The rule you entered has an incompatible format:{vbCr}{r}", msgTitle}, vbCritical)
End If
End If
End Sub
Private Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE
If _LatestSelected.ValueBetween(0, LIST_RULES.Items.Count - 1) Then
Dim r$ = LIST_RULES.Items(_LatestSelected)
If MsgBoxE({$"Are you sure you want to delete the following rule?{vbCr}{r}", "Delete a rule"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
If CurrentRulesEnv_LIST.RemoveAt(_LatestSelected) Then
LIST_RULES.Items.RemoveAt(_LatestSelected)
Refill()
Else
MsgBoxE({$"The following rule cannot be deleted:{vbCr}{r}", "Delete a rule"}, vbCritical)
End If
End If
End If
End Sub
#End Region
#Region "Options"
Private Sub TXT_UP_INTERVAL_ActionOnButtonClick(ByVal Sender As Object, ByVal e As ActionButtonEventArgs) Handles TXT_UP_INTERVAL.ActionOnButtonClick
If e.DefaultButton = ActionButton.DefaultButtons.Refresh Then TXT_UP_INTERVAL.Text = DynamicRulesEnv.UpdateIntervalDefault
End Sub
Private Sub TXT_PERSONAL_RULE_ActionOnCheckedChange(ByVal Sender As Object, ByVal e As EventArgs, ByVal Checked As Boolean) Handles TXT_PERSONAL_RULE.ActionOnCheckedChange
Mode_CheckedChanged()
End Sub
Private Sub OPT_RULES_LIST_CheckedChanged(sender As Object, e As EventArgs)
Mode_CheckedChanged()
End Sub
Private Sub Mode_CheckedChanged()
Dim e As Boolean = TXT_PERSONAL_RULE.Checked
TXT_PERSONAL_RULE.Enabled(False) = e
CONTAINER_LIST.Enabled = Not e
CH_PROTECTED.Enabled = Not e
CH_FORCE_UPDATE.Enabled = Not e
End Sub
#End Region
#Region "List handlers"
Private _LatestSelected As Integer = -1
Private Sub LIST_RULES_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_RULES.SelectedIndexChanged
_LatestSelected = LIST_RULES.SelectedIndex
End Sub
#End Region
End Class
End Namespace

View File

@@ -9,17 +9,17 @@
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.OnlyFans Namespace API.OnlyFans
<Manifest("AndyProgram_OnlyFans"), SavedPosts, SpecialForm(False), SeparatedTasks(1)> <Manifest("AndyProgram_OnlyFans"), SavedPosts, SpecialForm(False), SpecialForm(True), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
#Region "Categories" #Region "Categories"
Private Const CAT_OFS As String = "OF-Scraper support" Private Const CAT_OFS As String = "OF-Scraper support"
Private Const CAT_ERRORS As String = "Errors"
#End Region #End Region
#Region "Options" #Region "Options"
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download user timeline", Category:=DN.CAT_UserDefs), PXML, PClonable> <PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download user timeline", Category:=DN.CAT_UserDefs), PXML, PClonable>
@@ -36,12 +36,18 @@ Namespace API.OnlyFans
Private Const HeaderUserID As String = "User-Id" Private Const HeaderUserID As String = "User-Id"
Friend Const HeaderXBC As String = "X-Bc" Friend Const HeaderXBC As String = "X-Bc"
Friend Const HeaderAppToken As String = "App-Token" Friend Const HeaderAppToken As String = "App-Token"
Private Const AppTokenDefault As String = "33d57ade8c02dbc5a333db99ff9ae26a"
<PropertyOption(ControlText:=HeaderUserID, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)> <PropertyOption(ControlText:=HeaderUserID, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)>
Friend ReadOnly Property HH_USER_ID As PropertyValue Friend ReadOnly Property HH_USER_ID As PropertyValue
<PropertyOption(ControlText:=HeaderXBC, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)> <PropertyOption(ControlText:=HeaderXBC, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)>
Private ReadOnly Property HH_X_BC As PropertyValue Private ReadOnly Property HH_X_BC As PropertyValue
<PropertyOption(ControlText:=HeaderAppToken, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)> <PropertyOption(ControlText:=HeaderAppToken, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)>
Private ReadOnly Property HH_APP_TOKEN As PropertyValue Private ReadOnly Property HH_APP_TOKEN As PropertyValue
<PropertyUpdater(NameOf(HH_APP_TOKEN))>
Private Function UpdateAppToken() As Boolean
HH_APP_TOKEN.Value = AppTokenDefault
Return True
End Function
<PropertyOption(ControlText:=HeaderBrowser, ControlToolTip:="Can be null", AllowNull:=True, <PropertyOption(ControlText:=HeaderBrowser, ControlToolTip:="Can be null", AllowNull:=True,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua, IsAuth:=True), PClonable, PXML(OnlyForChecked:=True)> InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua, IsAuth:=True), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER As PropertyValue Private ReadOnly Property HH_BROWSER As PropertyValue
@@ -73,30 +79,23 @@ Namespace API.OnlyFans
End If End If
Return String.Empty Return String.Empty
End Function End Function
<PropertyOption(ControlText:="Update cookies during requests",
ControlToolTip:="If unchecked, cookies will not be updated during requests. Initial cookies will always be used.", IsAuth:=True),
PClonable, PXML, HiddenControl>
Friend ReadOnly Property EnableCookiesUpdate As PropertyValue
#End Region #End Region
#Region "Rules" #Region "Errors"
<PXML("LastDateUpdated")> Private ReadOnly Property LastDateUpdated_XML As PropertyValue <PClonable, PXML("UpdateRules401")> Private ReadOnly Property UpdateRules401_XML As PropertyValue
Friend Property LastDateUpdated As Date <PropertyOption(ControlText:="Try updating rules when you get a 401 error", Category:=CAT_ERRORS), HiddenControl>
Friend ReadOnly Property UpdateRules401 As PropertyValue
Get Get
Return LastDateUpdated_XML.Value If Not DefaultInstance Is Nothing Then
Return DirectCast(DefaultInstance, SiteSettings).UpdateRules401_XML
Else
Return UpdateRules401_XML
End If
End Get End Get
Set(ByVal d As Date)
LastDateUpdated_XML.Value = d
End Set
End Property End Property
<PropertyOption(ControlText:="Use old authorization rules",
ControlToolTip:="Use old dynamic rules (from 'DATAHOARDERS') or new ones (from 'DIGITALCRIMINALS')." & vbCr &
"Change this value only if you know what you are doing.", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property UseOldAuthRules As PropertyValue
<PropertyOption(ControlText:="Dynamic rules update", ControlToolTip:="'Dynamic rules' update interval (minutes). Default: 1440",
LeftOffset:=110, IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property DynamicRulesUpdateInterval As PropertyValue
<Provider(NameOf(DynamicRulesUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property DynamicRulesUpdateIntervalProvider As IFormatProvider
<PropertyOption(ControlText:="Dynamic rules",
ControlToolTip:="Overwrite 'Dynamic rules' with this URL" & vbCr &
"Change this value only if you know what you are doing.", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property DynamicRules As PropertyValue
#End Region #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
@@ -123,7 +122,7 @@ Namespace API.OnlyFans
End Property End Property
Friend Const KeyModeDefault_Default As String = "cdrm" Friend Const KeyModeDefault_Default As String = "cdrm"
<PClonable, PXML("KeyModeDefault")> Private ReadOnly Property KeyModeDefault_XML As PropertyValue <PClonable, PXML("KeyModeDefault")> Private ReadOnly Property KeyModeDefault_XML As PropertyValue
<PropertyOption(ControlText:="key-mode-default", Category:=CAT_OFS)> <PropertyOption(ControlText:="key-mode-default", ControlToolTip:="Examples: cdrm, cdrm2, keydb, manual", Category:=CAT_OFS)>
Friend ReadOnly Property KeyModeDefault As PropertyValue Friend ReadOnly Property KeyModeDefault As PropertyValue
Get Get
If Not DefaultInstance Is Nothing Then If Not DefaultInstance Is Nothing Then
@@ -133,12 +132,84 @@ Namespace API.OnlyFans
End If End If
End Get End Get
End Property End Property
<PClonable, PXML("keydb_api")> Private ReadOnly Property Keydb_Api_XML As PropertyValue
<PropertyOption(ControlText:="keydb_api", Category:=CAT_OFS)>
Friend ReadOnly Property Keydb_Api As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
Return DirectCast(DefaultInstance, SiteSettings).Keydb_Api_XML
Else
Return Keydb_Api_XML
End If
End Get
End Property
<PClonable, PXML("KEYS_Key")> Private ReadOnly Property OFS_KEYS_Key_XML As PropertyValue
<PropertyOption(ControlText:="Private key", ControlToolTip:="Path to the DRM key file 'private_key.pem'", Category:=CAT_OFS)>
Friend ReadOnly Property OFS_KEYS_Key As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
Return DirectCast(DefaultInstance, SiteSettings).OFS_KEYS_Key_XML
Else
Return OFS_KEYS_Key_XML
End If
End Get
End Property
<PClonable, PXML("KEYS_ClientID")> Private ReadOnly Property OFS_KEYS_ClientID_XML As PropertyValue
<PropertyOption(ControlText:="Client ID", ControlToolTip:="Path to the DRM key file 'client_id.bin'", Category:=CAT_OFS)>
Friend ReadOnly Property OFS_KEYS_ClientID As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
Return DirectCast(DefaultInstance, SiteSettings).OFS_KEYS_ClientID_XML
Else
Return OFS_KEYS_ClientID_XML
End If
End Get
End Property
<PropertiesDataChecker({NameOf(KeyModeDefault), NameOf(OFS_KEYS_Key), NameOf(OFS_KEYS_ClientID)})>
Private Function OFS_KEYS_CHECKER(ByVal p As IEnumerable(Of PropertyData)) As Boolean
Const manualMode$ = "manual"
If p.ListExists Then
Dim m$ = String.Empty, k$ = String.Empty, cid$ = String.Empty
For Each pp As PropertyData In p
Select Case pp.Name
Case NameOf(KeyModeDefault) : m = pp.Value
Case NameOf(OFS_KEYS_Key) : k = pp.Value
Case NameOf(OFS_KEYS_ClientID) : cid = pp.Value
Case Else : Throw New ArgumentException($"Property name '{pp.Name}' is not implemented", "Property Name")
End Select
Next
If k.IsEmptyString And cid.IsEmptyString Then
Return True
ElseIf Not k.IsEmptyString And Not cid.IsEmptyString Then
If m = manualMode Then
Return True
Else
Return MsgBoxE({$"You are using key files and have selected '{m}' mode." & vbCr &
$"To use key files, you should use the '{manualMode}' mode" & vbCr &
"Are you sure you want to use this mode?", "Incorrect mode"}, vbExclamation + vbYesNo) = vbYes
End If
End If
Dim t As New MMessage("", "Key missing",, vbCritical)
If k.IsEmptyString Then
t.Text = "'Private key' is missing"
ElseIf cid.IsEmptyString Then
t.Text = "'Client ID' is missing"
End If
If Not t.Text.IsEmptyString Then t.Show()
End If
Return False
End Function
#End Region #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("OnlyFans", ".onlyfans.com", AccName, Temp, My.Resources.SiteResources.OnlyFansIcon_32, My.Resources.SiteResources.OnlyFansPic_32) MyBase.New("OnlyFans", ".onlyfans.com", AccName, Temp, My.Resources.SiteResources.OnlyFansIcon_32, My.Resources.SiteResources.OnlyFansPic_32)
If Rules Is Nothing Then
Rules = New DynamicRulesEnv
Rules.Update(False, True)
End If
_AllowUserAgentUpdate = False _AllowUserAgentUpdate = False
With Responser With Responser
@@ -160,24 +231,19 @@ Namespace API.OnlyFans
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.AcceptEncoding)) .Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.AcceptEncoding))
HH_USER_ID = New PropertyValue(.Value(HeaderUserID), GetType(String), Sub(v) UpdateHeader(NameOf(HH_USER_ID), v)) HH_USER_ID = New PropertyValue(.Value(HeaderUserID), GetType(String), Sub(v) UpdateHeader(NameOf(HH_USER_ID), v))
HH_X_BC = New PropertyValue(.Value(HeaderXBC), GetType(String), Sub(v) UpdateHeader(NameOf(HH_X_BC), v)) HH_X_BC = New PropertyValue(.Value(HeaderXBC), GetType(String), Sub(v) UpdateHeader(NameOf(HH_X_BC), v))
HH_APP_TOKEN = New PropertyValue(.Value(HeaderAppToken), GetType(String), Sub(v) UpdateHeader(NameOf(HH_APP_TOKEN), v)) HH_APP_TOKEN = New PropertyValue(.Value(HeaderAppToken).IfNullOrEmpty(AppTokenDefault), GetType(String), Sub(v) UpdateHeader(NameOf(HH_APP_TOKEN), v))
HH_BROWSER = New PropertyValue(.Value(HeaderBrowser), GetType(String), Sub(v) UpdateHeader(NameOf(HH_BROWSER), v)) HH_BROWSER = New PropertyValue(.Value(HeaderBrowser), GetType(String), Sub(v) UpdateHeader(NameOf(HH_BROWSER), v))
End With End With
UserAgent = New PropertyValue(IIf(.UserAgentExists, .UserAgent, String.Empty), GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v)) UserAgent = New PropertyValue(IIf(.UserAgentExists, .UserAgent, String.Empty), GetType(String), Sub(v) UpdateHeader(NameOf(UserAgent), v))
End With End With
EnableCookiesUpdate = New PropertyValue(False)
DownloadTimeline = New PropertyValue(True) DownloadTimeline = New PropertyValue(True)
DownloadStories = New PropertyValue(True) DownloadStories = New PropertyValue(True)
DownloadHighlights = New PropertyValue(True) DownloadHighlights = New PropertyValue(True)
DownloadChatMedia = New PropertyValue(True) DownloadChatMedia = New PropertyValue(True)
LastDateUpdated_XML = New PropertyValue(Now.AddYears(-1), GetType(Date))
'URGENT: OF [UseOldAuthRules = True]
UseOldAuthRules = New PropertyValue(True)
DynamicRulesUpdateInterval = New PropertyValue(60 * 24)
DynamicRulesUpdateIntervalProvider = New FieldsCheckerProviderSimple(Function(v) IIf(AConvert(Of Integer)(v, 0) > 0, v, Nothing),
"The value of [{0}] field must be greater than 0")
DynamicRules = New PropertyValue(String.Empty, GetType(String))
OFScraperPath_XML = New PropertyValue(String.Empty, GetType(String)) OFScraperPath_XML = New PropertyValue(String.Empty, GetType(String))
If ACheck(OFScraperPath_XML.Value) Then If ACheck(OFScraperPath_XML.Value) Then
Dim f As SFile = OFScraperPath_XML.Value Dim f As SFile = OFScraperPath_XML.Value
@@ -192,11 +258,25 @@ Namespace API.OnlyFans
End If End If
OFScraperMP4decrypt_XML = New PropertyValue(String.Empty, GetType(String)) OFScraperMP4decrypt_XML = New PropertyValue(String.Empty, GetType(String))
KeyModeDefault_XML = New PropertyValue(KeyModeDefault_Default) KeyModeDefault_XML = New PropertyValue(KeyModeDefault_Default)
Keydb_Api_XML = New PropertyValue(String.Empty, GetType(String))
OFS_KEYS_Key_XML = New PropertyValue(String.Empty, GetType(String))
OFS_KEYS_ClientID_XML = New PropertyValue(String.Empty, GetType(String))
UpdateRules401_XML = New PropertyValue(False)
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"
End Sub End Sub
Private Const SettingsVersionCurrent As Integer = 1
Friend Overrides Sub EndInit()
If CInt(SettingsVersion.Value) < SettingsVersionCurrent Then
If CStr(HH_APP_TOKEN.Value).IsEmptyString Then HH_APP_TOKEN.Value = AppTokenDefault
EnableCookiesUpdate.Value = False
SettingsVersion.Value = SettingsVersionCurrent
End If
MyBase.EndInit()
End Sub
#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
@@ -204,10 +284,28 @@ Namespace API.OnlyFans
End Function End Function
#End Region #End Region
#Region "Update" #Region "Update"
Friend Overrides Sub BeginUpdate()
_TempSettingsEnv.DisposeIfReady
_TempSettingsEnv = Nothing
MyBase.BeginUpdate()
End Sub
Friend Overrides Sub Update() Friend Overrides Sub Update()
If _SiteEditorFormOpened Then Responser.Cookies.Changed = False If _SiteEditorFormOpened Then
Responser.Cookies.Changed = False
If If(_TempSettingsEnv?.NeedToSave, False) Then Rules.Copy(_TempSettingsEnv, True) : Rules.Save()
End If
MyBase.Update() MyBase.Update()
End Sub End Sub
Friend Overrides Sub EndUpdate()
_TempSettingsEnv.DisposeIfReady
_TempSettingsEnv = Nothing
MyBase.EndUpdate()
End Sub
Private _TempSettingsEnv As DynamicRulesEnv = Nothing
Friend Overrides Sub OpenSettingsForm()
If _TempSettingsEnv Is Nothing Then _TempSettingsEnv = New DynamicRulesEnv : _TempSettingsEnv.Copy(Rules, False)
Using f As New OnlyFansAdvancedSettingsForm(_TempSettingsEnv) : f.ShowDialog() : End Using
End Sub
#End Region #End Region
#Region "Download" #Region "Download"
Friend Overrides Function BaseAuthExists() As Boolean Friend Overrides Function BaseAuthExists() As Boolean
@@ -229,7 +327,7 @@ Namespace API.OnlyFans
#Region "GetUserUrl, GetUserPostUrl, UserOptions" #Region "GetUserUrl, GetUserPostUrl, UserOptions"
Friend Const UserPostPattern As String = "https://onlyfans.com/{0}/{1}" Friend Const UserPostPattern As String = "https://onlyfans.com/{0}/{1}"
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return String.Format(UrlPatternUser, If(User.ID.IsEmptyString, User.Name, $"u{User.ID}")) Return String.Format(UrlPatternUser, If(User.ID.IsEmptyString, User.NameTrue.IfNullOrEmpty(User.Name), $"u{User.ID}"))
End Function End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
If Not Media.Post.ID.IsEmptyString Then If Not Media.Post.ID.IsEmptyString Then

View File

@@ -91,6 +91,7 @@ Namespace API.OnlyFans
End Sub End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try Try
_DownloadingException_AuthFileUpdate = False
If Not MySettings.SessionAborted Then If Not MySettings.SessionAborted Then
ValidateOFScraper() ValidateOFScraper()
_AbsMediaIndex = 0 _AbsMediaIndex = 0
@@ -98,7 +99,7 @@ Namespace API.OnlyFans
If Not CCookie Is Nothing Then CCookie.Dispose() If Not CCookie Is Nothing Then CCookie.Dispose()
CCookie = Responser.Cookies.Copy CCookie = Responser.Cookies.Copy
Responser.Cookies.Clear() Responser.Cookies.Clear()
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived If MySettings.EnableCookiesUpdate.Value Then AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
UpdateCookieHeader() UpdateCookieHeader()
If Not IsSavedPosts Then If Not IsSavedPosts Then
@@ -118,7 +119,7 @@ Namespace API.OnlyFans
End Try End Try
End Sub End Sub
Protected Overrides Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As WebDataResponse) Protected Overrides Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As WebDataResponse)
If e.CookiesExists Then If e.CookiesExists And CBool(MySettings.EnableCookiesUpdate.Value) Then
CCookie.Update(e.Cookies, CookieKeeper.UpdateModes.ReplaceByNameAll,, EDP.ReturnValue) CCookie.Update(e.Cookies, CookieKeeper.UpdateModes.ReplaceByNameAll,, EDP.ReturnValue)
UpdateCookieHeader() UpdateCookieHeader()
End If End If
@@ -393,6 +394,14 @@ Namespace API.OnlyFans
Loop While Not _complete Loop While Not _complete
End Sub End Sub
#End Region #End Region
Private Function GetMediaURL(ByVal m As EContainer) As String
Dim v$
For Each node As Object() In FilesSources
v = If(m.ItemF(node)?.Value, String.Empty)
If Not v.IsEmptyString Then Return v
Next
Return String.Empty
End Function
Private Function TryCreateMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal PostDate As String = Nothing, Private Function TryCreateMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal PostDate As String = Nothing,
Optional ByRef Result As Boolean = False, Optional ByVal IsHL As Boolean = False, Optional ByRef Result As Boolean = False, Optional ByVal IsHL As Boolean = False,
Optional ByVal SpecFolder As String = Nothing, Optional ByVal PostUserID As String = Nothing, Optional ByVal SpecFolder As String = Nothing, Optional ByVal PostUserID As String = Nothing,
@@ -404,11 +413,14 @@ Namespace API.OnlyFans
With n("media") With n("media")
If .ListExists Then If .ListExists Then
For Each m In .Self For Each m In .Self
If IsHL Then postUrl = GetMediaURL(m)
postUrl = m.Value({"files", "source"}, "url") 'If IsHL Then
Else ' 'postUrl = m.Value({"files", "source"}, "url")
postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full")) ' postUrl = GetMediaURL(m)
End If 'Else
' 'postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
' postUrl = GetMediaURL(m)
'End If
postUrlBase = String.Empty postUrlBase = String.Empty
Select Case m.Value("type") Select Case m.Value("type")
Case "photo" : t = UTypes.Picture : ext = "jpg" Case "photo" : t = UTypes.Picture : ext = "jpg"
@@ -455,16 +467,8 @@ Namespace API.OnlyFans
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, String.Empty)
UserDescriptionUpdate(descr) UserDescriptionUpdate(descr)
Dim a As Action(Of String) = Sub(ByVal address As String) SimpleDownloadAvatar(j.Value("avatar"))
If Not address.IsEmptyString Then SimpleDownloadAvatar(j.Value("header"))
Dim f As SFile = address
f.Separator = "\"
f.Path = DownloadContentDefault_GetRootDir()
If Not f.Exists Then GetWebFile(address, f, EDP.None)
End If
End Sub
a.Invoke(j.Value("avatar"))
a.Invoke(j.Value("header"))
End If End If
End Using End Using
End If End If
@@ -537,36 +541,16 @@ Namespace API.OnlyFans
End Sub End Sub
#End Region #End Region
#Region "Auth" #Region "Auth"
Private ReadOnly Property AuthFile As SFile Private Function UpdateSignature(ByVal Path As String) As Boolean
Get
Dim f As SFile = MySettings.Responser.File
f.Name &= "_Auth"
f.Extension = "json"
Return f
End Get
End Property
Private Function UpdateSignature(ByVal Path As String, Optional ByVal ForceUpdateAuth As Boolean = False,
Optional ByVal Round As Integer = 0) As Boolean
Try Try
If UpdateAuthFile(ForceUpdateAuth) Then If Not Rules.Update(False) Then Rules.Update(True)
Const nullMsg$ = "The auth parameter is null" If Rules.Exists Then
Dim j As EContainer Const nullMsg$ = "The auth parameter(s) is null"
Try Dim j As EContainer = Rules.CurrentContainer
j = JsonDocument.Parse(AuthFile.GetText)
Catch jex As Exception
If Round = 0 Then
AuthFile.Delete()
UpdateAuthFile(True)
Return UpdateSignature(Path, ForceUpdateAuth, Round + 1)
Else
MySettings.SessionAborted = True
Return False
End If
End Try
If Not j Is Nothing Then If Not j Is Nothing Then
Dim pattern$ = j.Value("format") Dim pattern$ = DynamicRulesEnv.GetFormat(j)
If pattern.IsEmptyString Then Throw New ArgumentNullException("format", nullMsg) If pattern.IsEmptyString Then Throw New ArgumentNullException("format", nullMsg)
pattern = pattern.Replace("{}", "{0}").Replace("{:x}", "{1:x}")
Dim li%() = j("checksum_indexes").Select(Function(e) CInt(e(0).Value)).ToArray Dim li%() = j("checksum_indexes").Select(Function(e) CInt(e(0).Value)).ToArray
@@ -590,38 +574,16 @@ Namespace API.OnlyFans
Responser.Headers.Add(HeaderSign, sign) Responser.Headers.Add(HeaderSign, sign)
Responser.Headers.Add(HeaderTime, t) Responser.Headers.Add(HeaderTime, t)
j.Dispose()
Return True Return True
End If End If
Else
MySettings.SessionAborted = True
End If End If
Return False Return False
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"{ToStringForLog()}: UpdateSignature", False) Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"{ToStringForLog()}: UpdateSignature", False)
End Try End Try
End Function End Function
Private Function UpdateAuthFile(ByVal Force As Boolean) As Boolean
Const urlOld$ = "https://raw.githubusercontent.com/DATAHOARDERS/dynamic-rules/main/onlyfans.json"
Const urlNew$ = "https://raw.githubusercontent.com/DIGITALCRIMINALS/dynamic-rules/main/onlyfans.json"
Try
If MySettings.LastDateUpdated.AddMinutes(CInt(MySettings.DynamicRulesUpdateInterval.Value)) < Now Or Not AuthFile.Exists Or Force Then
Dim r$ = GetWebString(If(ACheck(Of String)(MySettings.DynamicRules.Value),
CStr(MySettings.DynamicRules.Value),
IIf(MySettings.UseOldAuthRules.Value, urlOld, urlNew)),, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r, EDP.ReturnValue)
If j.ListExists Then
If Not j.Value("format").IsEmptyString And j("checksum_indexes").ListExists And
Not j.Value("static_param").IsEmptyString And Not j.Value("checksum_constant").IsEmptyString Then _
TextSaver.SaveTextToFile(r, AuthFile, True, False, EDP.ThrowException) : MySettings.LastDateUpdated = Now
End If
End Using
End If
End If
Return AuthFile.Exists
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"{ToStringForLog()}: UpdateAuthFile", False)
End Try
End Function
Private Function GetHashSha1(ByVal Input As String) As String Private Function GetHashSha1(ByVal Input As String) As String
Dim s As New Security.Cryptography.SHA1CryptoServiceProvider Dim s As New Security.Cryptography.SHA1CryptoServiceProvider
Dim inputBytes() As Byte = System.Text.Encoding.UTF8.GetBytes(Input) Dim inputBytes() As Byte = System.Text.Encoding.UTF8.GetBytes(Input)
@@ -642,7 +604,7 @@ Namespace API.OnlyFans
'#If DEBUG Then '#If DEBUG Then
'Debug.WriteLine(command) 'Debug.WriteLine(command)
'#End If '#End If
Using b As New TokenBatch(Token) : b.Execute(command) : End Using Using b As New TokenBatch(Token) With {.DebugMode = False} : b.Execute(command) : End Using
Return SFile.GetFiles(conf, "*.mp4", IO.SearchOption.AllDirectories, EDP.ReturnValue) Return SFile.GetFiles(conf, "*.mp4", IO.SearchOption.AllDirectories, EDP.ReturnValue)
End If End If
Return Nothing Return Nothing
@@ -653,37 +615,69 @@ Namespace API.OnlyFans
Private Function OFS_CreateConfig() As SFile Private Function OFS_CreateConfig() As SFile
Try Try
Const confMainPattern$ = "{0}"": ""([^""]*)""" Const confMainPattern$ = "{0}"": ""([^""]*)"""
Const confMainPattern_Keys$ = "{0}"": ([^,]*)"
Const confMainPatternRulesManual$ = "DYNAMIC_RULE"": (""[^""]*"")"
Const m1 As Byte = 0 'not rules
Const m2 As Byte = 1 'rules
Const m3 As Byte = 2 'keys
If OFSCache Is Nothing Then OFSCache = If(IsSingleObjectDownload, Settings.Cache.NewInstance, CreateCache()) If OFSCache Is Nothing Then OFSCache = If(IsSingleObjectDownload, Settings.Cache.NewInstance, CreateCache())
Dim currentCache As CacheKeeper = OFSCache.NewInstance Dim currentCache As CacheKeeper = OFSCache.NewInstance
currentCache.Validate() currentCache.Validate()
Dim cacheRoot As SFile = currentCache.NewPath Dim cacheRoot As SFile = currentCache.NewPath
cacheRoot.Exists(SFO.Path, True, EDP.ThrowException) cacheRoot.Exists(SFO.Path, True, EDP.ThrowException)
Dim f As SFile = $"{SettingsFolderName}\OFScraperConfigPattern.json" Dim f As SFile = Rules.OFScraperConfigPatternFile
Dim configText$ Dim configText$
If Not f.Exists Then
configText = Text.Encoding.UTF8.GetString(My.Resources.OFResources.OFScraperConfigPattern)
TextSaver.SaveTextToFile(configText, f, True)
End If
If f.Exists Then If f.Exists Then
Dim replaceValue$ = String.Empty Dim replaceValue$ = String.Empty
Dim rp As RParams = RParams.DMS(String.Empty, 1, RegexReturn.Replace, RegexOptions.IgnoreCase, Dim rp As RParams = RParams.DMS(String.Empty, 1, RegexReturn.Replace, RegexOptions.IgnoreCase,
CType(Function(input) replaceValue, Func(Of String, String)), String.Empty, EDP.ReturnValue) CType(Function(input) replaceValue, Func(Of String, String)), String.Empty, EDP.ReturnValue)
Dim ff As SFile Dim ff As SFile
configText = f.GetText configText = f.GetText
Dim updateConf As Action(Of String, String) = Sub(ByVal patternValue As String, ByVal __replaceValue As String) Dim updateConf As Action(Of String, String, Byte) =
rp.Pattern = String.Format(confMainPattern, patternValue) Sub(ByVal patternValue As String, ByVal __replaceValue As String, ByVal mode As Byte)
rp.Nothing = configText Select Case mode
replaceValue = __replaceValue Case m1 : rp.Pattern = String.Format(confMainPattern, patternValue)
configText = RegexReplace(configText, rp) Case m2 : rp.Pattern = String.Format(confMainPatternRulesManual, patternValue)
End Sub Case m3 : rp.Pattern = String.Format(confMainPattern_Keys, patternValue) : __replaceValue = $"""{__replaceValue}"""
Case Else : Throw New ArgumentException($"Mode '{mode}' is not implemented", "mode")
End Select
rp.Nothing = configText
replaceValue = __replaceValue
configText = RegexReplace(configText, rp)
End Sub
If Not configText.IsEmptyString Then If Not configText.IsEmptyString Then
updateConf("save_location", cacheRoot.PathNoSeparator.Replace("\", "/")) updateConf("save_location", cacheRoot.PathNoSeparator.Replace("\", "/"), m1)
If ACheck(MySettings.OFScraperMP4decrypt.Value) Then If ACheck(MySettings.OFScraperMP4decrypt.Value) Then
ff = CStr(MySettings.OFScraperMP4decrypt.Value) ff = CStr(MySettings.OFScraperMP4decrypt.Value)
If ff.Exists Then updateConf("mp4decrypt", ff.ToString.Replace("\", "/")) If ff.Exists Then updateConf("mp4decrypt", ff.ToString.Replace("\", "/"), m1)
End If
If Settings.FfmpegFile.Exists Then updateConf("ffmpeg", Settings.FfmpegFile.File.ToString.Replace("\", "/"), m1)
updateConf("key-mode-default", CStr(MySettings.KeyModeDefault.Value).IfNullOrEmpty(SiteSettings.KeyModeDefault_Default), m1)
updateConf("keydb_api", CStr(MySettings.Keydb_Api.Value), m1)
If Not CStr(MySettings.OFS_KEYS_Key.Value).IsEmptyString And Not CStr(MySettings.OFS_KEYS_ClientID.Value).IsEmptyString Then
updateConf("private-key", CStr(MySettings.OFS_KEYS_Key.Value).Replace("\", "/"), m3)
updateConf("client-id", CStr(MySettings.OFS_KEYS_ClientID.Value).Replace("\", "/"), m3)
End If
If Rules.RulesReplaceConfig Then
If Rules.RulesConfigManualMode Then
updateConf(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName, "manual", m1)
configText = configText.Replace(DynamicRulesEnv.DynamicRulesConfigNodeName_URL, DynamicRulesEnv.DynamicRulesConfigNodeName_RULES)
updateConf(DynamicRulesEnv.DynamicRulesConfigNodeName_RULES, Rules.CurrentContainerRulesText, m2)
Else
Dim confUrlNode$ = If(Rules.RulesConstants.ContainsKey(DynamicRulesEnv.DynamicRulesConfigNodeName_URL_CONST_NAME),
Rules.RulesConstants(DynamicRulesEnv.DynamicRulesConfigNodeName_URL_CONST_NAME),
DynamicRulesEnv.DynamicRulesConfigNodeName_URL)
updateConf(DynamicRulesEnv.DynamicRulesConfigNodeName_URL, Rules.CurrentRule.UrlRaw, m1)
configText = configText.Replace(DynamicRulesEnv.DynamicRulesConfigNodeName_URL, confUrlNode)
If Rules.RulesConstants.ContainsKey(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName) Then _
updateConf(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName, Rules.RulesConstants(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName), m1)
End If
End If End If
If Settings.FfmpegFile.Exists Then updateConf("ffmpeg", Settings.FfmpegFile.File.ToString.Replace("\", "/"))
updateConf("key-mode-default", CStr(MySettings.KeyModeDefault.Value).IfNullOrEmpty(SiteSettings.KeyModeDefault_Default))
f = currentCache f = currentCache
f.Name = "config" f.Name = "config"
f.Extension = "json" f.Extension = "json"
@@ -776,14 +770,20 @@ Namespace API.OnlyFans
Private _DownloadingException_AuthFileUpdate As Boolean = False Private _DownloadingException_AuthFileUpdate As Boolean = False
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = Net.HttpStatusCode.BadRequest Then '400 If Responser.StatusCode = Net.HttpStatusCode.BadRequest Or
If Not _DownloadingException_AuthFileUpdate AndAlso UpdateAuthFile(True) Then (Responser.StatusCode = Net.HttpStatusCode.Unauthorized And CBool(MySettings.UpdateRules401.Value)) Then '400, [401]
If Not _DownloadingException_AuthFileUpdate AndAlso Rules.Update(True) Then
_DownloadingException_AuthFileUpdate = True _DownloadingException_AuthFileUpdate = True
Return 2 Return 2
Else Else
MySettings.SessionAborted = True MySettings.SessionAborted = True
MyMainLOG = $"{ToStringForLog()} [{CInt(Responser.StatusCode)}]: OnlyFans credentials expired" MyMainLOG = $"{ToStringForLog()} [{CInt(Responser.StatusCode)}]: OnlyFans credentials expired"
Return 1 If Responser.StatusCode = Net.HttpStatusCode.BadRequest Then
Return 1
Else
MyMainLOG = $"{ToStringForLog()}: Rules updated (401)"
Return 3
End If
End If End If
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then '404 ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then '404
UserExists = False UserExists = False

View File

@@ -7,9 +7,18 @@
' 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.Globalization Imports System.Globalization
Imports System.Text.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Pinterest Namespace API.Pinterest
Friend Module Declarations Friend Module Declarations
Friend ReadOnly DateProvider As ADateTime = GetDateProvider() Friend ReadOnly DateProvider As ADateTime = GetDateProvider()
Friend ReadOnly PwsHeader As New HttpHeader("x-pinterest-pws-handler", "www/[username]/pins.js")
Friend ReadOnly GdlUrlPattern As RParams = RParams.DM(Base.GDL.GDLBatch.UrlLibStart.Replace("[", "\[").Replace("]", "\]") &
"([^""]+?)""(GET [^""]+)""", 0, EDP.ReturnValue)
Friend ReadOnly SubBoardRegEx As RParams = RParams.DMS("\[pinterest\]\[debug\] Using PinterestSectionExtractor for '[^']+id:(\d+)'", 1,
RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly BoardInfoRootNode As String() = {"resource_response", "data"}
Private Function GetDateProvider() As ADateTime Private Function GetDateProvider() As ADateTime
Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone
n.FullDateTimePattern = "ddd dd MMM yyyy HH:mm:ss" n.FullDateTimePattern = "ddd dd MMM yyyy HH:mm:ss"

View File

@@ -0,0 +1,20 @@
' Copyright (C) Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes
Namespace API.Pinterest
Friend Class EditorExchangeOptions
<PSetting(Caption:="Get Sub-Boards", ToolTip:="Extract the Sub-Boards from the boards and download them")>
Friend Property ExtractSubBoards As Boolean = True
Friend Sub New(ByVal u As UserData)
ExtractSubBoards = u.ExtractSubBoards
End Sub
Friend Sub New()
End Sub
End Class
End Namespace

View File

@@ -11,7 +11,7 @@ Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Pinterest Namespace API.Pinterest
<Manifest("AndyProgram_Pinterest"), SavedPosts, SeparatedTasks> <Manifest("AndyProgram_Pinterest"), SavedPosts, SeparatedTasks, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
<PropertyOption(ControlText:=DeclaredNames.ConcurrentDownloadsCaption, <PropertyOption(ControlText:=DeclaredNames.ConcurrentDownloadsCaption,
@@ -30,7 +30,7 @@ Namespace API.Pinterest
MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider
CheckNetscapeCookiesOnEndInit = True CheckNetscapeCookiesOnEndInit = True
UseNetscapeCookies = True UseNetscapeCookies = True
UserRegex = RParams.DMS("https?://w{0,3}.?[^/]*?.?pinterest.com/([^/]+)/?(?(_)|([^/]*))", 0, RegexReturn.ListByMatch, EDP.ReturnValue) UserRegex = RParams.DMS("https?://w{0,3}.?[^/]*?.?pinterest.com/([^/]+)/?(?(_)|([^/]*))/?([^/\?]*)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
End Sub End Sub
#End Region #End Region
#Region "GetInstance, Available" #Region "GetInstance, Available"
@@ -41,13 +41,14 @@ Namespace API.Pinterest
Return Settings.GalleryDLFile.Exists And (Not What = ISiteSettings.Download.SavedPosts OrElse ACheck(SavedPostsUserName.Value)) Return Settings.GalleryDLFile.Exists And (Not What = ISiteSettings.Download.SavedPosts OrElse ACheck(SavedPostsUserName.Value))
End Function End Function
#End Region #End Region
#Region "IsMyUser, IsMyImageVideo, GetUserUrl, GetUserPostUrl" #Region "IsMyUser, IsMyImageVideo, GetUserUrl, GetUserPostUrl, UserOptions"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
If Not UserURL.IsEmptyString Then If Not UserURL.IsEmptyString Then
Dim l As List(Of String) = RegexReplace(UserURL, UserRegex) Dim l As List(Of String) = RegexReplace(UserURL, UserRegex)
If l.ListExists(3) Then If l.ListExists(3) Then
Dim n$ = l(1) Dim n$ = l(1)
If Not l(2).IsEmptyString Then n &= $"@{l(2)}" If Not l(2).IsEmptyString Then n &= $"@{l(2)}"
If l.Count > 3 AndAlso Not l(3).IsEmptyString Then n &= $"@{l(3)}"
Return New ExchangeOptions(Site, n) With {.Exists = True} Return New ExchangeOptions(Site, n) With {.Exists = True}
End If End If
End If End If
@@ -71,6 +72,12 @@ Namespace API.Pinterest
Return String.Empty Return String.Empty
End If End If
End Function End Function
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing Then Options = New EditorExchangeOptions
If OpenForm Then
Using f As New InternalSettingsForm(Options, Me, False) : f.ShowDialog() : End Using
End If
End Sub
#End Region #End Region
End Class End Class
End Namespace End Namespace

View File

@@ -7,10 +7,12 @@
' 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 System.Text.RegularExpressions
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.API.Base.GDL Imports SCrawler.API.Base.GDL
Imports SCrawler.API.YouTube.Objects Imports SCrawler.API.YouTube.Objects
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Namespace API.Pinterest Namespace API.Pinterest
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
@@ -18,6 +20,8 @@ Namespace API.Pinterest
Private Const Name_IsUser As String = "IsUser" Private Const Name_IsUser As String = "IsUser"
Private Const Name_TrueUserName As String = "TrueUserName" Private Const Name_TrueUserName As String = "TrueUserName"
Private Const Name_TrueBoardName As String = "TrueBoardName" Private Const Name_TrueBoardName As String = "TrueBoardName"
Private Const Name_ExtractSubBoards As String = "ExtractSubBoards"
Private Const Name_IsSubBoard As String = "IsSubBoard"
#End Region #End Region
#Region "Structures" #Region "Structures"
Private Structure BoardInfo Private Structure BoardInfo
@@ -38,6 +42,8 @@ Namespace API.Pinterest
Friend Property TrueUserName As String Friend Property TrueUserName As String
Friend Property TrueBoardName As String Friend Property TrueBoardName As String
Friend Property IsUser_NB As Boolean Friend Property IsUser_NB As Boolean
Private Property IsSubBoard As Boolean = False
Friend Property ExtractSubBoards As Boolean = True
Private Const BoardLabelName As String = "Board" Private Const BoardLabelName As String = "Board"
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String) Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get Get
@@ -45,14 +51,18 @@ Namespace API.Pinterest
End Get End Get
End Property End Property
#End Region #End Region
#Region "Load" #Region "Load, Exchange"
Private Function ReconfUserName() As Boolean Private Function ReconfUserName() As Boolean
If TrueUserName.IsEmptyString Then If TrueUserName.IsEmptyString Then
Dim n$() = Name.Split("@") Dim n$() = Name.Split("@")
If n.ListExists Then If n.ListExists Then
TrueUserName = n(0) TrueUserName = n(0)
IsUser_NB = True IsUser_NB = True
If n.Length > 1 Then TrueBoardName = n(1) : IsUser_NB = False If n.Length > 1 Then
TrueBoardName = n(1)
If n.Length > 2 AndAlso Not n(2).IsEmptyString Then TrueBoardName &= $"/{n(2)}" : IsSubBoard = True
IsUser_NB = False
End If
If Not IsSavedPosts And Not IsSingleObjectDownload Then If Not IsSavedPosts And Not IsSingleObjectDownload Then
Dim l$ = IIf(IsUser_NB, UserLabelName, BoardLabelName) Dim l$ = IIf(IsUser_NB, UserLabelName, BoardLabelName)
Settings.Labels.Add(l) Settings.Labels.Add(l)
@@ -70,15 +80,25 @@ Namespace API.Pinterest
TrueUserName = .Value(Name_TrueUserName) TrueUserName = .Value(Name_TrueUserName)
TrueBoardName = .Value(Name_TrueBoardName) TrueBoardName = .Value(Name_TrueBoardName)
IsUser_NB = .Value(Name_IsUser).FromXML(Of Boolean)(False) IsUser_NB = .Value(Name_IsUser).FromXML(Of Boolean)(False)
ExtractSubBoards = .Value(Name_ExtractSubBoards).FromXML(Of Boolean)(True)
IsSubBoard = .Value(Name_IsSubBoard).FromXML(Of Boolean)(False)
ReconfUserName() ReconfUserName()
Else Else
If ReconfUserName() Then .Value(Name_LabelsName) = LabelsString If ReconfUserName() Then .Value(Name_LabelsName) = LabelsString
.Add(Name_TrueUserName, TrueUserName) .Add(Name_TrueUserName, TrueUserName)
.Add(Name_TrueBoardName, TrueBoardName) .Add(Name_TrueBoardName, TrueBoardName)
.Add(Name_IsUser, IsUser_NB.BoolToInteger) .Add(Name_IsUser, IsUser_NB.BoolToInteger)
.Add(Name_ExtractSubBoards, ExtractSubBoards.BoolToInteger)
.Add(Name_IsSubBoard, IsSubBoard.BoolToInteger)
End If End If
End With End With
End Sub End Sub
Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptions(Me)
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then ExtractSubBoards = DirectCast(Obj, EditorExchangeOptions).ExtractSubBoards
End Sub
#End Region #End Region
#Region "Download overrides" #Region "Download overrides"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
@@ -125,6 +145,19 @@ Namespace API.Pinterest
End Sub End Sub
#End Region #End Region
#Region "Get boards, images" #Region "Get boards, images"
Private Function GetBoardInfo(ByVal e As EContainer) As BoardInfo
If Not e Is Nothing Then
Dim b As New BoardInfo With {
.URL = e.Value("url"),
.Title = TitleHtmlConverter(e.Value("name")).IfNullOrEmpty(TitleHtmlConverter(e.Value("title"))),
.ID = e.Value("id")
}
If Not b.URL.IsEmptyString Then b.URL = $"https://www.pinterest.com/{b.URL.StringTrimStart("/").StringTrimEnd("/")}/"
Return b
Else
Return Nothing
End If
End Function
Private Function GetBoards(ByVal Token As CancellationToken) As List(Of BoardInfo) Private Function GetBoards(ByVal Token As CancellationToken) As List(Of BoardInfo)
Dim URL$ = $"https://www.pinterest.com/{TrueUserName}/" Dim URL$ = $"https://www.pinterest.com/{TrueUserName}/"
Try Try
@@ -132,9 +165,9 @@ Namespace API.Pinterest
Dim b As BoardInfo Dim b As BoardInfo
Dim r$ Dim r$
Dim j As EContainer, jj As EContainer Dim j As EContainer, jj As EContainer
Dim rootNode$() = {"resource_response", "data"}
Dim jErr As New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue) Dim jErr As New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue)
Dim urls As List(Of String) = GetDataFromGalleryDL(URL, True, Token) Dim urls As New List(Of String)
urls.ListAddList(GetDataFromGalleryDL(URL, True, Token), LNC)
If urls.ListExists Then urls.RemoveAll(Function(__url) Not __url.Contains("BoardsResource/get/")) If urls.ListExists Then urls.RemoveAll(Function(__url) Not __url.Contains("BoardsResource/get/"))
If urls.ListExists Then If urls.ListExists Then
ProgressPre.ChangeMax(urls.Count) ProgressPre.ChangeMax(urls.Count)
@@ -145,17 +178,10 @@ Namespace API.Pinterest
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, jErr) j = JsonDocument.Parse(r, jErr)
If Not j Is Nothing Then If Not j Is Nothing Then
If If(j(rootNode)?.Count, 0) > 0 Then If If(j(BoardInfoRootNode)?.Count, 0) > 0 Then
For Each jj In j(rootNode) For Each jj In j(BoardInfoRootNode)
b = New BoardInfo With { b = GetBoardInfo(jj)
.URL = jj.Value("url"), If Not b.URL.IsEmptyString Then boards.Add(b)
.Title = TitleHtmlConverter(jj.Value("name")),
.ID = jj.Value("id")
}
If Not b.URL.IsEmptyString Then
b.URL = $"https://www.pinterest.com/{b.URL.StringTrimStart("/").StringTrimEnd("/")}/"
boards.Add(b)
End If
Next Next
End If End If
j.Dispose() j.Dispose()
@@ -170,92 +196,156 @@ Namespace API.Pinterest
End Try End Try
End Function End Function
Private Sub DownloadBoardImages(ByRef Board As BoardInfo, ByVal Token As CancellationToken) Private Sub DownloadBoardImages(ByRef Board As BoardInfo, ByVal Token As CancellationToken)
Dim bUrl$ = String.Empty Dim bUrl As GDLURL = Nothing
Try Try
Dim r$ Dim r$
Dim j As EContainer, jj As EContainer Dim j As EContainer, jj As EContainer
Dim u As UserMedia Dim u As UserMedia
Dim folder$ = If(IsUser_NB, Board.Title.IfNullOrEmpty(Board.ID), String.Empty) Dim __getBoardTitle As Func(Of BoardInfo, String) = Function(__board) __board.Title.IfNullOrEmpty(__board.ID)
Dim folderDef$ = If(IsUser_NB, __getBoardTitle(Board), String.Empty)
Dim titleExists As Boolean = Not Board.Title.IsEmptyString Dim titleExists As Boolean = Not Board.Title.IsEmptyString
Dim i% = -1 Dim i% = -1
Dim jErr As New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue) Dim jErr As New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue)
Dim rootNode$() = {"resource_response", "data"} Dim rErr As New ErrorsDescriber(EDP.ReturnValue)
Dim images As List(Of Sizes) Dim images As List(Of Sizes)
Dim imgSelector As Func(Of EContainer, Sizes) = Function(img) New Sizes(img.Value("width"), img.Value("url")) Dim imgSelector As Func(Of EContainer, Sizes) = Function(img) New Sizes(img.Value("width"), img.Value("url"))
Dim fullData As Predicate(Of EContainer) = Function(e) e.Count > 5 Dim fullData As Predicate(Of EContainer) = Function(e) e.Count > 5
Dim l As List(Of String) = GetDataFromGalleryDL(Board.URL, False, Token) Dim subBoard As BoardInfo = Nothing
If l.ListExists Then l.RemoveAll(Function(ll) Not ll.Contains("BoardFeedResource/get/")) Dim subBoardAppender As Func(Of String) = Function() _
If(Not __getBoardTitle(subBoard).IsEmptyString,
$"{IIf(folderDef.IsEmptyString, String.Empty, "\")}{__getBoardTitle(subBoard)}",
String.Empty)
Dim __getSubBoard As Func(Of Boolean) = Function() ExtractSubBoards Or (IsSubBoard And i = -1)
Dim sbCount% = 0
Dim __getBoardInfo As Action(Of GDLURL) = Sub(ByVal sb As GDLURL)
sbCount += 1
r = Responser.GetResponse(sb.URL,, rErr)
If Not r.IsEmptyString Then
Using jsb As EContainer = JsonDocument.Parse(r, jErr)
If jsb.ListExists Then subBoard = GetBoardInfo(jsb(BoardInfoRootNode)) : Exit Sub
End Using
End If
subBoard = Nothing
End Sub
Dim l As List(Of GDLURL) = GetDataFromGalleryDL(Board.URL, False, Token)
If l.ListExists Then l.RemoveAll(Function(ll) ll.URL.IsEmptyString)
If l.ListExists Then If l.ListExists Then
Responser.Headers.Add(PwsHeader)
ProgressPre.ChangeMax(l.Count) ProgressPre.ChangeMax(l.Count)
For Each bUrl In l For Each bUrl In l
ProgressPre.Perform() ProgressPre.Perform()
ThrowAny(Token) ThrowAny(Token)
r = Responser.GetResponse(bUrl,, EDP.ReturnValue)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, jErr)
If Not j Is Nothing Then
If If(j(rootNode)?.Count, 0) > 0 Then
ProgressPre.ChangeMax(j(rootNode).Count)
For Each jj In j(rootNode)
ProgressPre.Perform()
With jj
If .Contains("images") Then
images = .Item("images").Select(imgSelector).ToList
If images.Count > 0 Then
images.Sort()
i += 1
u = New UserMedia(images(0).Data) With {
.Post = New UserPost(jj.Value("id"), AConvert(Of Date)(jj.Value("created_at"), DateProvider, Nothing)),
.Type = UserMedia.Types.Picture,
.SpecialFolder = folder
}
If i = 0 Then
If Board.Title.IsEmptyString Or Board.ID.IsEmptyString Then
Board.Title = TitleHtmlConverter(.Value({"board"}, "name"))
Board.ID = .Value({"board"}, "id")
End If
Board.UserID = .Value({"board", "owner"}, "id")
Board.UserTitle = TitleHtmlConverter(.Value({"board", "owner"}, "full_name"))
If Not titleExists And IsUser_NB Then
If Not Board.Title.IsEmptyString Then
folder = Board.Title
ElseIf Not Board.ID.IsEmptyString Then
folder = Board.ID
End If
u.SpecialFolder = folder
End If
End If
If Not u.URL.IsEmptyString Then If bUrl.URL.Contains("BoardFeedResource/get/") Or (bUrl.URL.Contains("BoardSectionPinsResource/get/") And (ExtractSubBoards Or (IsSubBoard And sbCount = 1))) Then
If u.Post.Date.HasValue Then r = Responser.GetResponse(bUrl.URL,, rErr)
Select Case CheckDatesLimit(u.Post.Date.Value, Nothing) If Not r.IsEmptyString Then
Case DateResult.Skip : _TempPostsList.ListAddValue(u.Post.ID, LNC) : Continue For j = JsonDocument.Parse(r, jErr)
Case DateResult.Exit : Exit Sub If Not j Is Nothing Then
End Select If If(j(BoardInfoRootNode)?.Count, 0) > 0 Then
ProgressPre.ChangeMax(j(BoardInfoRootNode).Count)
For Each jj In j(BoardInfoRootNode)
ProgressPre.Perform()
With jj
If .Contains("images") Then
images = .Item("images").Select(imgSelector).ToList
If images.Count > 0 Then
images.Sort()
i += 1
u = New UserMedia(images(0).Data) With {
.Post = New UserPost(jj.Value("id"), AConvert(Of Date)(jj.Value("created_at"), DateProvider, Nothing)),
.Type = UserMedia.Types.Picture,
.SpecialFolder = folderDef & subBoardAppender.Invoke
}
If i = 0 Then
If Board.Title.IsEmptyString Or Board.ID.IsEmptyString Then
Board.Title = TitleHtmlConverter(.Value({"board"}, "name"))
Board.ID = .Value({"board"}, "id")
End If
Board.UserID = .Value({"board", "owner"}, "id")
Board.UserTitle = TitleHtmlConverter(.Value({"board", "owner"}, "full_name"))
If Not titleExists And IsUser_NB Then
folderDef = Board.Title.IfNullOrEmpty(Board.ID).IfNullOrEmpty(folderDef)
u.SpecialFolder = folderDef & subBoardAppender.Invoke
End If
End If End If
If Not _TempPostsList.Contains(u.Post.ID) Then
_TempPostsList.ListAddValue(u.Post.ID, LNC) If Not u.URL.IsEmptyString Then
_TempMediaList.ListAddValue(u, LNC) If u.Post.Date.HasValue Then
Else Select Case CheckDatesLimit(u.Post.Date.Value, Nothing)
Exit For Case DateResult.Skip : _TempPostsList.ListAddValue(u.Post.ID, LNC) : Continue For
Case DateResult.Exit : Exit Sub
End Select
End If
If Not _TempPostsList.Contains(u.Post.ID) Then
_TempPostsList.ListAddValue(u.Post.ID, LNC)
_TempMediaList.ListAddValue(u, LNC)
Else
Exit For
End If
End If End If
End If End If
End If End If
End If End With
End With Next
Next End If
j.Dispose()
End If End If
j.Dispose() End If
ElseIf bUrl.URL.Contains("BoardSectionResource/get/") And (ExtractSubBoards Or (IsSubBoard And i = -1)) Then
__getBoardInfo(bUrl)
If IsSubBoard And i = -1 And Board.Title.IsEmptyString Then
Board.Title = subBoard.Title
If Board.ID.IsEmptyString Then Board.ID = subBoard.ID
subBoard = Nothing
folderDef = String.Empty
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, $"data (gallery-dl images) downloading error [{bUrl}]") ProcessException(ex, Token, $"data (gallery-dl images) downloading error [{bUrl.URL}]")
Finally
Responser.Headers.Remove(PwsHeader)
End Try End Try
End Sub End Sub
#End Region #End Region
#Region "Gallery-DL Support" #Region "Gallery-DL Support"
Private Structure GDLURL : Implements IRegExCreator
Friend URL As String
Friend BoardId As String
Public Shared Widening Operator CType(ByVal u As String) As GDLURL
Return New GDLURL With {.URL = u}
End Operator
Public Shared Widening Operator CType(ByVal u As GDLURL) As String
Return u.URL
End Operator
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists(2) Then
Dim u$ = ParamsArray(0).StringTrim.StringTrimEnd("/"), u2$
If Not u.IsEmptyString Then
u2 = ParamsArray(1).StringTrim
If Not u2.IsEmptyString AndAlso u2.StartsWith("GET", StringComparison.OrdinalIgnoreCase) Then
u2 = u2.Remove(0, 3).StringTrim.StringTrimStart("/")
If Not u2.IsEmptyString Then URL = $"{u}/{u2}"
End If
End If
End If
Return Me
End Function
Public Shared Operator =(ByVal x As GDLURL, ByVal y As GDLURL) As Boolean
Return x.URL = y.URL
End Operator
Public Shared Operator <>(ByVal x As GDLURL, ByVal y As GDLURL) As Boolean
Return Not x.URL = y.URL
End Operator
Public Overrides Function ToString() As String
Return URL
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
Return URL = CType(Obj, String)
End Function
End Structure
Private Class GDLBatch : Inherits GDL.GDLBatch Private Class GDLBatch : Inherits GDL.GDLBatch
Private ReadOnly Property Source As UserData Private ReadOnly Property Source As UserData
Private ReadOnly IsBoardsRequested As Boolean Private ReadOnly IsBoardsRequested As Boolean
@@ -286,14 +376,30 @@ Namespace API.Pinterest
End If End If
End Function End Function
End Class End Class
Private Function GetDataFromGalleryDL(ByVal URL As String, ByVal IsBoardsRequested As Boolean, ByVal Token As CancellationToken) As List(Of String) Private Function GetDataFromGalleryDL(ByVal URL As String, ByVal IsBoardsRequested As Boolean, ByVal Token As CancellationToken) As List(Of GDLURL)
Dim command$ = $"""{Settings.GalleryDLFile.File}"" --verbose --simulate " Dim command$ = $"""{Settings.GalleryDLFile.File}"" --verbose --simulate "
Try Try
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
Dim urls As New List(Of GDLURL)
Dim u As GDLURL
Dim s$ = String.Empty
If MySettings.CookiesNetscapeFile.Exists Then command &= $"--cookies ""{MySettings.CookiesNetscapeFile}"" " If MySettings.CookiesNetscapeFile.Exists Then command &= $"--cookies ""{MySettings.CookiesNetscapeFile}"" "
command &= URL command &= URL
Using batch As New GDLBatch(Me, IsBoardsRequested, Token) Using batch As New GDLBatch(Me, IsBoardsRequested, Token)
Return GetUrlsFromGalleryDl(batch, command) With batch
.Execute(command)
If .ErrorOutputData.Count > 0 Then
For Each eValue$ In .ErrorOutputData
s = CStr(RegexReplace(eValue, SubBoardRegEx)).IfNullOrEmpty(s)
u = RegexFields(Of GDLURL)(eValue, {GdlUrlPattern}, {1, 2}, EDP.ReturnValue).ListIfNothing.FirstOrDefault
If Not u.URL.IsEmptyString Then
If Not s.IsEmptyString Then u.BoardId = s
urls.Add(u)
End If
Next
Return urls
End If
End With
End Using End Using
End If End If
Return Nothing Return Nothing

View File

@@ -36,11 +36,12 @@ Namespace API.PornHub
Friend ReadOnly Regex_Gif_UrlName As RParams = RParams.DMS("""name"":.*?""([^""]*)""[^\}]+?""contentUrl"":.*?""([^""]+)""", 0, RegexReturn.ListByMatch, EDP.ReturnValue) Friend ReadOnly Regex_Gif_UrlName As RParams = RParams.DMS("""name"":.*?""([^""]*)""[^\}]+?""contentUrl"":.*?""([^""]+)""", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
#End Region #End Region
#Region "Declarations photo" #Region "Declarations photo"
Friend ReadOnly Regex_Photo_ModelHub_PhotoBlocks As RParams = RParams.DM("var PHOTOS_ARRAY_(\d+) = \{[\r\n\s]*?(urls:.*?\[[^]]*\])", 0, RegexReturn.List, EDP.ReturnValue)
Friend ReadOnly Regex_Photo_PornHub_PhotoBlocks As RParams = RParams.DM("photoAlbumListContainer[\r\n\s\S]+?title=""([^""]+)""[\r\n\s\S]+?a href=""(/album/\d+)""", 0, RegexReturn.List) Friend ReadOnly Regex_Photo_PornHub_PhotoBlocks As RParams = RParams.DM("photoAlbumListContainer[\r\n\s\S]+?title=""([^""]+)""[\r\n\s\S]+?a href=""(/album/\d+)""", 0, RegexReturn.List)
Friend ReadOnly Regex_Photo_PornHub_AlbumPhotoArr As RParams = RParams.DMS("\<a href=""(/photo/\d+)""", 1, RegexReturn.List, EDP.ReturnValue, Friend ReadOnly Regex_Photo_PornHub_PhotoBlocks2 As RParams = RParams.DM("albumInfoTitle"" href=""([^""]+)""\>([^\<]+)", 0, RegexReturn.List)
Friend ReadOnly Regex_Photo_PornHub_AlbumPhotoArr As RParams = RParams.DMS("href=""(/photo/\d+)""", 1, RegexReturn.List, EDP.ReturnValue,
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.DMS("(?<!thumbImage.+?)<img src=""(https://[^""]+\d+[^""]+)""", 1, 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_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

@@ -29,10 +29,6 @@ Namespace API.PornHub
Friend ReadOnly Property DownloadGifs As PropertyValue Friend ReadOnly Property DownloadGifs As PropertyValue
<PropertyOption(ControlText:="Download GIFs as mp4", ControlToolTip:="Download gifs in 'mp4' format instead of native 'webm'"), PXML, PClonable> <PropertyOption(ControlText:="Download GIFs as mp4", ControlToolTip:="Download gifs in 'mp4' format instead of native 'webm'"), PXML, PClonable>
Friend ReadOnly Property DownloadGifsAsMp4 As PropertyValue Friend ReadOnly Property DownloadGifsAsMp4 As PropertyValue
<PropertyOption(ControlText:="Photo ModelHub only",
ControlToolTip:="Download photo only from ModelHub. Prornstar photos hosted on PornHub itself will not be downloaded." & vbCr &
"Attention! Downloading photos hosted on PornHub is a very heavy job."), PXML, PClonable>
Friend ReadOnly Property DownloadPhotoOnlyFromModelHub As PropertyValue
<PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip), PXML, PClonable(Clone:=False)> <PropertyOption(ControlText:=DeclaredNames.SavedPostsUserNameCaption, ControlToolTip:=DeclaredNames.SavedPostsUserNameToolTip), PXML, PClonable(Clone:=False)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue Friend ReadOnly Property SavedPostsUserName As PropertyValue
#End Region #End Region
@@ -48,7 +44,6 @@ Namespace API.PornHub
DownloadFavorite = New PropertyValue(False) DownloadFavorite = New PropertyValue(False)
DownloadGifsAsMp4 = New PropertyValue(True) DownloadGifsAsMp4 = New PropertyValue(True)
DownloadGifs = New PropertyValue(CInt(CheckState.Indeterminate), GetType(Integer)) DownloadGifs = New PropertyValue(CInt(CheckState.Indeterminate), GetType(Integer))
DownloadPhotoOnlyFromModelHub = New PropertyValue(True)
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String)) SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
_SubscriptionsAllowed = True _SubscriptionsAllowed = True

View File

@@ -20,15 +20,12 @@ Namespace API.PornHub
#Region "Declarations" #Region "Declarations"
#Region "XML names" #Region "XML names"
Private Const Name_PersonType As String = "PersonType" Private Const Name_PersonType As String = "PersonType"
Private Const Name_NameTrue As String = "NameTrue"
Private Const Name_PhotoPageModel As String = "PhotoPageModel"
Private Const Name_DownloadUHD As String = "DownloadUHD" Private Const Name_DownloadUHD As String = "DownloadUHD"
Private Const Name_DownloadUploaded As String = "DownloadUploaded" Private Const Name_DownloadUploaded As String = "DownloadUploaded"
Private Const Name_DownloadTagged As String = "DownloadTagged" Private Const Name_DownloadTagged As String = "DownloadTagged"
Private Const Name_DownloadPrivate As String = "DownloadPrivate" Private Const Name_DownloadPrivate As String = "DownloadPrivate"
Private Const Name_DownloadFavorite As String = "DownloadFavorite" Private Const Name_DownloadFavorite As String = "DownloadFavorite"
Private Const Name_DownloadGifs As String = "DownloadGifs" Private Const Name_DownloadGifs As String = "DownloadGifs"
Private Const Name_DownloadPhotoOnlyFromModelHub As String = "DownloadPhotoOnlyFromModelHub"
#End Region #End Region
#Region "Structures" #Region "Structures"
Private Structure FlashVar : Implements IRegExCreator Private Structure FlashVar : Implements IRegExCreator
@@ -98,11 +95,6 @@ Namespace API.PornHub
End Structure End Structure
#End Region #End Region
#Region "Enums" #Region "Enums"
Private Enum PhotoPageModels As Integer
Undefined = 0
PornHubPage = 1
ModelHubPage = 2
End Enum
Private Enum VideoTypes Private Enum VideoTypes
Undefined Undefined
Uploaded Uploaded
@@ -121,7 +113,6 @@ Namespace API.PornHub
#End Region #End Region
#Region "Person" #Region "Person"
Friend Property PersonType As String Friend Property PersonType As String
Friend Property NameTrue As String
Friend Overrides Property FriendlyName As String Friend Overrides Property FriendlyName As String
Get Get
If _FriendlyName.IsEmptyString Then Return NameTrue Else Return _FriendlyName If _FriendlyName.IsEmptyString Then Return NameTrue Else Return _FriendlyName
@@ -137,14 +128,12 @@ Namespace API.PornHub
Return IsUser Or SiteMode = SiteModes.Playlists Return IsUser Or SiteMode = SiteModes.Playlists
End Get End Get
End Property End Property
Private Property PhotoPageModel As PhotoPageModels = PhotoPageModels.Undefined
Friend Property DownloadUHD As Boolean = False Friend Property DownloadUHD As Boolean = False
Friend Property DownloadUploaded As Boolean = True Friend Property DownloadUploaded As Boolean = True
Friend Property DownloadTagged As Boolean = False Friend Property DownloadTagged As Boolean = False
Friend Property DownloadPrivate As Boolean = False Friend Property DownloadPrivate As Boolean = False
Friend Property DownloadFavorite As Boolean = False Friend Property DownloadFavorite As Boolean = False
Friend Property DownloadGifs As Boolean Friend Property DownloadGifs As Boolean
Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True
Friend Overrides ReadOnly Property IsUser As Boolean Friend Overrides ReadOnly Property IsUser As Boolean
Get Get
Return SiteMode = SiteModes.User Return SiteMode = SiteModes.User
@@ -182,7 +171,6 @@ Namespace API.PornHub
DownloadPrivate = .DownloadPrivate DownloadPrivate = .DownloadPrivate
DownloadFavorite = .DownloadFavorite DownloadFavorite = .DownloadFavorite
DownloadGifs = .DownloadGifs DownloadGifs = .DownloadGifs
DownloadPhotoOnlyFromModelHub = .DownloadPhotoOnlyFromModelHub
QueryString = .QueryString QueryString = .QueryString
End With End With
End If End If
@@ -244,29 +232,23 @@ Namespace API.PornHub
With Container With Container
If Loading Then If Loading Then
PersonType = .Value(Name_PersonType) PersonType = .Value(Name_PersonType)
NameTrue = .Value(Name_NameTrue)
PhotoPageModel = .Value(Name_PhotoPageModel).FromXML(Of Integer)(PhotoPageModels.Undefined)
DownloadUHD = .Value(Name_DownloadUHD).FromXML(Of Boolean)(False) DownloadUHD = .Value(Name_DownloadUHD).FromXML(Of Boolean)(False)
DownloadUploaded = .Value(Name_DownloadUploaded).FromXML(Of Boolean)(True) DownloadUploaded = .Value(Name_DownloadUploaded).FromXML(Of Boolean)(True)
DownloadTagged = .Value(Name_DownloadTagged).FromXML(Of Boolean)(False) DownloadTagged = .Value(Name_DownloadTagged).FromXML(Of Boolean)(False)
DownloadPrivate = .Value(Name_DownloadPrivate).FromXML(Of Boolean)(False) DownloadPrivate = .Value(Name_DownloadPrivate).FromXML(Of Boolean)(False)
DownloadFavorite = .Value(Name_DownloadFavorite).FromXML(Of Boolean)(False) DownloadFavorite = .Value(Name_DownloadFavorite).FromXML(Of Boolean)(False)
DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False) DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False)
DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True)
SiteMode = .Value(Name_SiteMode).FromXML(Of Integer)(SiteModes.User) SiteMode = .Value(Name_SiteMode).FromXML(Of Integer)(SiteModes.User)
UpdateUserOptions() UpdateUserOptions()
Else Else
If UpdateUserOptions() Then .Value(Name_LabelsName) = LabelsString If UpdateUserOptions() Then .Value(Name_LabelsName) = LabelsString
.Add(Name_PersonType, PersonType) .Add(Name_PersonType, PersonType)
.Add(Name_NameTrue, NameTrue)
.Add(Name_PhotoPageModel, CInt(PhotoPageModel))
.Add(Name_DownloadUHD, DownloadUHD.BoolToInteger) .Add(Name_DownloadUHD, DownloadUHD.BoolToInteger)
.Add(Name_DownloadUploaded, DownloadUploaded.BoolToInteger) .Add(Name_DownloadUploaded, DownloadUploaded.BoolToInteger)
.Add(Name_DownloadTagged, DownloadTagged.BoolToInteger) .Add(Name_DownloadTagged, DownloadTagged.BoolToInteger)
.Add(Name_DownloadPrivate, DownloadPrivate.BoolToInteger) .Add(Name_DownloadPrivate, DownloadPrivate.BoolToInteger)
.Add(Name_DownloadFavorite, DownloadFavorite.BoolToInteger) .Add(Name_DownloadFavorite, DownloadFavorite.BoolToInteger)
.Add(Name_DownloadGifs, DownloadGifs.BoolToInteger) .Add(Name_DownloadGifs, DownloadGifs.BoolToInteger)
.Add(Name_DownloadPhotoOnlyFromModelHub, DownloadPhotoOnlyFromModelHub.BoolToInteger)
.Add(Name_SiteMode, CInt(SiteMode)) .Add(Name_SiteMode, CInt(SiteMode))
'Debug.WriteLine(GetNonUserUrl(0)) 'Debug.WriteLine(GetNonUserUrl(0))
@@ -283,6 +265,7 @@ 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()
_PageVideosRepeat = 0 _PageVideosRepeat = 0
@@ -295,7 +278,6 @@ Namespace API.PornHub
Dim limit% = If(DownloadTopCount, -1) Dim limit% = If(DownloadTopCount, -1)
If DownloadVideos Then If DownloadVideos Then
If SiteMode = SiteModes.Playlists Then If SiteMode = SiteModes.Playlists Then
Responser.Mode = Responser.Modes.Default Responser.Mode = Responser.Modes.Default
GetPlaylistToken(Token) GetPlaylistToken(Token)
@@ -519,25 +501,12 @@ Namespace API.PornHub
Dim pFile$ = RegexReplace(URL, Regex_Photo_File) Dim pFile$ = RegexReplace(URL, Regex_Photo_File)
If Not pFile.IsEmptyString Then Return New SFile(pFile) Else Return File If Not pFile.IsEmptyString Then Return New SFile(pFile) Else Return File
End Function End Function
Private Const PhotoUrlPattern_ModelHub As String = "https://www.modelhub.com/{0}/photos"
Private Const PhotoUrlPattern_PornHub As String = "https://www.pornhub.com/{0}/{1}/photos" Private Const PhotoUrlPattern_PornHub As String = "https://www.pornhub.com/{0}/{1}/photos"
Private Sub DownloadUserPhotos(ByVal Token As CancellationToken) Private Sub DownloadUserPhotos(ByVal Token As CancellationToken)
Try Try
If IsSavedPosts Then If IsSavedPosts Then
DownloadUserPhotos_SavedPosts(Token) DownloadUserPhotos_SavedPosts(Token)
ElseIf PersonType = PersonTypeModel Then Else
If PhotoPageModel = PhotoPageModels.Undefined Then
If DownloadUserPhotos_ModelHub(Token) Then PhotoPageModel = PhotoPageModels.ModelHubPage
ThrowAny(Token)
If PhotoPageModel = PhotoPageModels.Undefined AndAlso Not DownloadPhotoOnlyFromModelHub AndAlso
DownloadUserPhotos_PornHub(Token) Then PhotoPageModel = PhotoPageModels.PornHubPage
Else
Select Case PhotoPageModel
Case PhotoPageModels.ModelHubPage : DownloadUserPhotos_ModelHub(Token)
Case PhotoPageModels.PornHubPage : If Not DownloadPhotoOnlyFromModelHub Then DownloadUserPhotos_PornHub(Token)
End Select
End If
ElseIf Not DownloadPhotoOnlyFromModelHub Then
DownloadUserPhotos_PornHub(Token) DownloadUserPhotos_PornHub(Token)
End If End If
ThrowAny(Token) ThrowAny(Token)
@@ -545,48 +514,6 @@ Namespace API.PornHub
ProcessException(ex, Token, "photos downloading error") ProcessException(ex, Token, "photos downloading error")
End Try End Try
End Sub End Sub
Private Function DownloadUserPhotos_ModelHub(ByVal Token As CancellationToken) As Boolean
Dim URL$ = String.Empty
Try
Dim j As EContainer
Dim jErr As New ErrorsDescriber(EDP.SendToLog + EDP.ReturnValue)
Dim albumName$
If PersonType = PersonTypeModel Then
URL = String.Format(PhotoUrlPattern_ModelHub, NameTrue)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_ModelHub_PhotoBlocks}, {1, 2}, EDP.ReturnValue)
If l.ListExists Then l.RemoveAll(Function(ll) ll.Data.IsEmptyString)
If l.ListExists Then
ProgressPre.ChangeMax(l.Count)
Dim albumRegex As RParams = RParams.DMS("", 1, EDP.ReturnValue)
For Each block As PhotoBlock In l
ProgressPre.Perform()
If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For
albumRegex.Pattern = "<li id=""" & block.AlbumID & """ class=""modelBox"">[\r\n\s]*?<div class=""modelPhoto"">[\r\n\s]*?\<[^\>]*?alt=""([^""]*)"""
albumName = StringTrim(RegexReplace(r, albumRegex))
If albumName.IsEmptyString Then albumName = block.AlbumID
j = JsonDocument.Parse("{" & block.Data & "}", jErr)
If Not j Is Nothing Then
If If(j("urls")?.Count, 0) > 0 Then
_TempMediaList.ListAddList(j("urls").Select(Function(jj) _
New UserMedia(jj.ItemF({0}).XmlIfNothingValue, UTypes.Picture) With {
.SpecialFolder = $"Albums\{albumName}\",
.File = CreatePhotoFile(.URL, .File)}), LNC)
End If
j.Dispose()
End If
Next
l.Clear()
End If
End If
End If
Return True
Catch ex As Exception
ThrowAny(Token)
Return False
End Try
End Function
Private Overloads Function DownloadUserPhotos_PornHub(ByVal Token As CancellationToken) As Boolean Private Overloads Function DownloadUserPhotos_PornHub(ByVal Token As CancellationToken) As Boolean
Try Try
Dim albumName$ Dim albumName$
@@ -594,6 +521,7 @@ Namespace API.PornHub
Dim r$ = Responser.GetResponse(String.Format(PhotoUrlPattern_PornHub, PersonType, NameTrue)) Dim r$ = Responser.GetResponse(String.Format(PhotoUrlPattern_PornHub, PersonType, NameTrue))
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_PornHub_PhotoBlocks}, {2, 1}, EDP.ReturnValue) Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_PornHub_PhotoBlocks}, {2, 1}, EDP.ReturnValue)
l.ListAddList(RegexFields(Of PhotoBlock)(r, {Regex_Photo_PornHub_PhotoBlocks2}, {1, 2}, EDP.ReturnValue))
If l.ListExists Then l.RemoveAll(Function(ll) ll.AlbumID.IsEmptyString) If l.ListExists Then l.RemoveAll(Function(ll) ll.AlbumID.IsEmptyString)
If l.ListExists Then If l.ListExists Then
ProgressPre.ChangeMax(l.Count) ProgressPre.ChangeMax(l.Count)
@@ -618,6 +546,14 @@ Namespace API.PornHub
Return False Return False
End Try End Try
End Function End Function
Private Function DownloadUserPhotos_PornHub_ParseSinglePhoto(ByVal r As String) As String
Dim url$ = String.Empty
With DirectCast(RegexReplace(r, Regex_Photo_PornHub_SinglePhoto), List(Of String))
If .ListExists(3) Then url = .Item(2).IfNullOrEmpty(.Item(1)).StringTrim
End With
If url.IsEmptyString Then url = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto2)
Return url
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,
ByVal Token As CancellationToken) As Boolean ByVal Token As CancellationToken) As Boolean
Try Try
@@ -633,7 +569,7 @@ Namespace API.PornHub
Try Try
r = Responser.GetResponse(url) r = Responser.GetResponse(url)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
url = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto) url = DownloadUserPhotos_PornHub_ParseSinglePhoto(r)
If Not url.IsEmptyString Then _ If Not url.IsEmptyString Then _
_TempMediaList.ListAddValue(New UserMedia(url, UTypes.Picture) With { _TempMediaList.ListAddValue(New UserMedia(url, UTypes.Picture) With {
.SpecialFolder = $"Albums\{AlbumName}\", .SpecialFolder = $"Albums\{AlbumName}\",
@@ -679,7 +615,7 @@ Namespace API.PornHub
Try Try
r = Responser.GetResponse(m.URL) r = Responser.GetResponse(m.URL)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
NewUrl = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto) NewUrl = DownloadUserPhotos_PornHub_ParseSinglePhoto(r)
If Not NewUrl.IsEmptyString Then If Not NewUrl.IsEmptyString Then
m.URL = NewUrl m.URL = NewUrl
pFile = RegexReplace(NewUrl, Regex_Photo_File) pFile = RegexReplace(NewUrl, Regex_Photo_File)
@@ -852,11 +788,34 @@ Namespace API.PornHub
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)
DownloadContentDefault(Token) Try : DownloadContentDefault(Token) : Finally : UpdateM3U8URLS = False : End Try
End Sub End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile Protected Overloads Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
Return M3U8.Download(URL, Responser, DestinationFile, DownloadUHD, Token, Progress, Not IsSingleObjectDownload) ByVal Token As CancellationToken) As SFile
UpdateM3U8URLS_Error = False
Return DownloadM3U8(URL, Media, DestinationFile, Token, UpdateM3U8URLS)
End Function
Private Overloads Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile,
ByVal Token As CancellationToken, ByVal Second As Boolean) As SFile
Try
If Second Then
Dim r$ = Responser.Curl(Media.URL_BASE,, EDP.ReturnValue)
If Not r.IsEmptyString Then Media.URL = CreateVideoURL(r).IfNullOrEmpty(URL) : URL = Media.URL
End If
Dim f As SFile = M3U8.Download(URL, Responser, DestinationFile, DownloadUHD, Token, Progress, Not IsSingleObjectDownload)
If Not f.Exists And Not Second Then UpdateM3U8URLS = True : f = DownloadM3U8(URL, Media, DestinationFile, Token, True)
Return f
Catch ex As Exception
If Not UpdateM3U8URLS_Error Then
UpdateM3U8URLS_Error = True
Thread.Sleep(1000)
Return DownloadM3U8(URL, Media, DestinationFile, Token, True)
End If
Return Nothing
End Try
End Function End Function
#End Region #End Region
#Region "CreateVideoURL" #Region "CreateVideoURL"
@@ -953,6 +912,7 @@ Namespace API.PornHub
#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)
UpdateM3U8URLS = False
_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

View File

@@ -21,8 +21,6 @@ Namespace API.PornHub
Friend Property DownloadFavorite As Boolean Friend Property DownloadFavorite As Boolean
<PSetting(Caption:="Download gifs")> <PSetting(Caption:="Download gifs")>
Friend Property DownloadGifs As Boolean Friend Property DownloadGifs As Boolean
<PSetting(NameOf(SiteSettings.DownloadPhotoOnlyFromModelHub), NameOf(MySettings), Caption:="Download photo only from ModelHub")>
Friend Property DownloadPhotoOnlyFromModelHub As Boolean
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)
DownloadUHD = u.DownloadUHD DownloadUHD = u.DownloadUHD
@@ -31,7 +29,6 @@ Namespace API.PornHub
DownloadPrivate = u.DownloadPrivate DownloadPrivate = u.DownloadPrivate
DownloadFavorite = u.DownloadFavorite DownloadFavorite = u.DownloadFavorite
DownloadGifs = u.DownloadGifs DownloadGifs = u.DownloadGifs
DownloadPhotoOnlyFromModelHub = u.DownloadPhotoOnlyFromModelHub
QueryString = u.QueryString QueryString = u.QueryString
MySettings = u.HOST.Source MySettings = u.HOST.Source
End Sub End Sub
@@ -43,7 +40,6 @@ Namespace API.PornHub
DownloadPrivate = s.DownloadPrivate.Value DownloadPrivate = s.DownloadPrivate.Value
DownloadFavorite = s.DownloadFavorite.Value DownloadFavorite = s.DownloadFavorite.Value
DownloadGifs = Not v = CheckState.Unchecked DownloadGifs = Not v = CheckState.Unchecked
DownloadPhotoOnlyFromModelHub = s.DownloadPhotoOnlyFromModelHub.Value
MySettings = s MySettings = s
End Sub End Sub
End Class End Class

View File

@@ -21,6 +21,6 @@ Namespace API.Reddit
Friend ReadOnly UrlBasePattern As RParams = RParams.DM("(?<=/)([^/]+?\.[\w]{3,4})(?=(\?|\Z))", 0) Friend ReadOnly UrlBasePattern As RParams = RParams.DM("(?<=/)([^/]+?\.[\w]{3,4})(?=(\?|\Z))", 0)
Friend ReadOnly VideoRegEx As RParams = RParams.DM("http.{0,1}://[^" & Chr(34) & "]+?mp4", 0) Friend ReadOnly VideoRegEx As RParams = RParams.DM("http.{0,1}://[^" & Chr(34) & "]+?mp4", 0)
Private ReadOnly EUR_PROVIDER As New ANumbers(ANumbers.Cultures.EUR) Private ReadOnly EUR_PROVIDER As New ANumbers(ANumbers.Cultures.EUR)
Friend ReadOnly UnixDate32ProviderReddit As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnix32(AConvert(Of Integer)(v, EUR_PROVIDER, v), n, e)) Friend ReadOnly UnixDate32ProviderReddit As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnix32(AConvert(Of Double)(v, EUR_PROVIDER, v), n, e))
End Module End Module
End Namespace End Namespace

View File

@@ -17,8 +17,8 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports DownDetector = SCrawler.API.Base.DownDetector Imports DownDetector = SCrawler.API.Base.DownDetector
Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Reddit Namespace API.Reddit
<Manifest(RedditSiteKey), SavedPosts, SpecialForm(False)> <Manifest(RedditSiteKey), SavedPosts, SpecialForm(False), UseDownDetector>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase : Implements DownDetector.IDownDetector
#Region "Declarations" #Region "Declarations"
#Region "Authorization" #Region "Authorization"
<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)>
@@ -67,6 +67,26 @@ Namespace API.Reddit
<PropertyOption(ControlText:="Check image: get original", ControlToolTip:="Get the original image if it exists", IsAuth:=False), PXML, PClonable> <PropertyOption(ControlText:="Check image: get original", ControlToolTip:="Get the original image if it exists", IsAuth:=False), PXML, PClonable>
Friend ReadOnly Property CheckImageReturnOrig As PropertyValue Friend ReadOnly Property CheckImageReturnOrig As PropertyValue
#End Region #End Region
#Region "IDownDetector Support"
Private ReadOnly Property IDownDetector_Value As Integer Implements DownDetector.IDownDetector.Value
Get
Return 100
End Get
End Property
Private ReadOnly Property IDownDetector_AddToLog As Boolean Implements DownDetector.IDownDetector.AddToLog
Get
Return False
End Get
End Property
Private ReadOnly Property IDownDetector_CheckSite As String Implements DownDetector.IDownDetector.CheckSite
Get
Return "reddit"
End Get
End Property
Private Function IDownDetector_Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean Implements DownDetector.IDownDetector.Available
Return MDD.Available(What, Silent)
End Function
#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)
@@ -85,7 +105,7 @@ Namespace API.Reddit
ApiClientSecret = New PropertyValue(String.Empty, GetType(String)) ApiClientSecret = New PropertyValue(String.Empty, GetType(String))
BearerToken = New PropertyValue(token, GetType(String), Sub(v) Responser.Headers.Add(DeclaredNames.Header_Authorization, v)) BearerToken = New PropertyValue(token, GetType(String), Sub(v) Responser.Headers.Add(DeclaredNames.Header_Authorization, v))
BearerTokenUseCurl = New PropertyValue(True) BearerTokenUseCurl = New PropertyValue(True)
TokenUpdateInterval = New PropertyValue(60 * 12) TokenUpdateInterval = New PropertyValue(360)
TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider
BearerTokenDateUpdate = New PropertyValue(Now.AddYears(-1)) BearerTokenDateUpdate = New PropertyValue(Now.AddYears(-1))
UseTokenForTimelines = New PropertyValue(False) UseTokenForTimelines = New PropertyValue(False)
@@ -97,10 +117,20 @@ Namespace API.Reddit
CheckImage = New PropertyValue(False) CheckImage = New PropertyValue(False)
CheckImageReturnOrig = New PropertyValue(True) CheckImageReturnOrig = New PropertyValue(True)
MDD = New MyDownDetector(Me)
UrlPatternUser = "https://www.reddit.com/{0}/{1}/" UrlPatternUser = "https://www.reddit.com/{0}/{1}/"
ImageVideoContains = "reddit.com" ImageVideoContains = "reddit.com"
UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/\?&]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue) UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/\?&]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
End Sub End Sub
Private Const SettingsVersionCurrent As Integer = 1
Friend Overrides Sub EndInit()
If CInt(SettingsVersion.Value) < SettingsVersionCurrent Then
SettingsVersion.Value = SettingsVersionCurrent
TokenUpdateInterval.Value = 360
End If
MyBase.EndInit()
End Sub
#End Region #End Region
#Region "GetInstance" #Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
@@ -108,81 +138,48 @@ Namespace API.Reddit
End Function End Function
#End Region #End Region
#Region "DownloadStarted, ReadyToDownload, Available, DownloadDone, UpdateRedGifsToken" #Region "DownloadStarted, ReadyToDownload, Available, DownloadDone, UpdateRedGifsToken"
Private ____DownloadStarted As Boolean = False Private ReadOnly MDD As MyDownDetector
Friend Overrides Sub DownloadStarted(ByVal What As Download) Private Class MyDownDetector : Inherits DownDetector.Checker(Of SiteSettings)
If What = Download.Main Then ____DownloadStarted = True Private __TrueValue As Boolean = False
MyBase.DownloadStarted(What) Friend Sub New(ByRef _Source As SiteSettings)
End Sub MyBase.New(_Source)
End Sub
Protected Overrides Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean
__TrueValue = Source.AvailableTrueValue(What)
Return MyBase.AvailableImpl(What, Silent)
End Function
Protected Overrides Function AvailableImpl_TRUE() As Boolean
Return AvailableImpl_TrueValueReturn()
End Function
Protected Overrides Function AvailableImpl_FALSE_SILENT_NOT_MSG_YES() As Boolean
Return AvailableImpl_TrueValueReturn()
End Function
Private Function AvailableImpl_TrueValueReturn() As Boolean
If __TrueValue Then Source.UpdateRedGifsToken()
Return __TrueValue AndAlso Source.UpdateTokenIfRequired()
End Function
Friend Overrides Sub Reset()
__TrueValue = False
MyBase.Reset()
End Sub
End Class
Friend Property SessionInterrupted As Boolean = False Friend Property SessionInterrupted As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If What = Download.Main Then If What = Download.Main Then
Dim result As Boolean = Not SessionInterrupted Return Not SessionInterrupted
If result Then
If ____DownloadStarted And ____AvailableRequested Then
____AvailableResult = AvailableImpl(What, ____AvailableSilent)
____AvailableChecked = True
____AvailableRequested = False
result = ____AvailableResult
ElseIf ____AvailableChecked Then
result = ____AvailableResult
End If
End If
Return result
Else Else
Return True Return True
End If End If
End Function End Function
Private ____AvailableRequested As Boolean = False
Private ____AvailableSilent As Boolean = True
Private ____AvailableChecked As Boolean = False
Private ____AvailableResult As Boolean = False
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
If What = Download.Main And ____DownloadStarted Then Return AvailableTrueValue(What) AndAlso UpdateTokenIfRequired()
____AvailableRequested = True
____AvailableSilent = Silent
Return True
Else
Return AvailableImpl(What, Silent)
End If
End Function End Function
Private Function AvailableImpl(ByVal What As Download, ByVal Silent As Boolean) As Boolean Private Function AvailableTrueValue(ByVal What As Download) As Boolean
Try Return Not What = Download.SavedPosts OrElse (Responser.CookiesExists And ACheck(SavedPostsUserName.Value))
AvailableText = String.Empty
Dim trueValue As Boolean = Not What = Download.SavedPosts OrElse (Responser.CookiesExists And ACheck(SavedPostsUserName.Value))
If Not trueValue Then Return False
Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("reddit")
If dl.ListExists Then
dl = dl.Take(4).ToList
Dim avg% = dl.Average(Function(d) d.Value)
If avg > 100 Then
AvailableText = "Over the past hour, Reddit has received an average of " &
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
dl.ListToString(vbCr)
If Silent Then
Return False
Else
If MsgBoxE({$"{AvailableText}{vbCr}{vbCr}Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes Then
If trueValue Then UpdateRedGifsToken()
Return trueValue AndAlso UpdateTokenIfRequired()
Else
Return False
End If
End If
End If
End If
If trueValue Then UpdateRedGifsToken()
Return trueValue AndAlso UpdateTokenIfRequired()
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True)
End Try
End Function End Function
Friend Overrides Sub DownloadDone(ByVal What As Download) Friend Overrides Sub DownloadDone(ByVal What As Download)
SessionInterrupted = False SessionInterrupted = False
____DownloadStarted = False MDD.Reset()
____AvailableRequested = False
____AvailableChecked = False
____AvailableSilent = True
____AvailableResult = False
MyBase.DownloadDone(What) MyBase.DownloadDone(What)
End Sub End Sub
Private Sub UpdateRedGifsToken() Private Sub UpdateRedGifsToken()
@@ -202,7 +199,7 @@ Namespace API.Reddit
End If End If
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) : Return String.Format(UrlPatternUser, IIf(.IsChannel, ChannelOption, "user"), .TrueName) : End With With DirectCast(User, UserData) : Return String.Format(UrlPatternUser, IIf(.IsChannel, ChannelOption, "user"), .NameTrue) : End With
End Function End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
If Not Media.Post.ID.IsEmptyString Then If Not Media.Post.ID.IsEmptyString Then
@@ -253,6 +250,7 @@ Namespace API.Reddit
Return False Return False
End Function End Function
Private Function UpdateTokenIfRequired() As Boolean Private Function UpdateTokenIfRequired() As Boolean
UpdateRedGifsToken()
If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso CredentialsExists Then If (CBool(UseTokenForTimelines.Value) Or CBool(UseTokenForSavedPosts.Value)) AndAlso CredentialsExists Then
If CDate(BearerTokenDateUpdate.Value).AddMinutes(TokenUpdateInterval.Value) <= Now Then Return UpdateToken() If CDate(BearerTokenDateUpdate.Value).AddMinutes(TokenUpdateInterval.Value) <= Now Then Return UpdateToken()
End If End If

View File

@@ -42,7 +42,6 @@ Namespace API.Reddit
End Get End Get
End Property End Property
Friend Property IsChannel As Boolean = False Friend Property IsChannel As Boolean = False
Friend Property TrueName As String = String.Empty
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String) Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get Get
Return {CannelsLabelName, CannelsLabelName_ChannelsForm, UserLabelName} Return {CannelsLabelName, CannelsLabelName_ChannelsForm, UserLabelName}
@@ -173,16 +172,16 @@ Namespace API.Reddit
#End Region #End Region
#Region "Load and Update user info" #Region "Load and Update user info"
Private Function UpdateNames() As Boolean Private Function UpdateNames() As Boolean
If TrueName.IsEmptyString Then If NameTrue(True).IsEmptyString Then
Dim n$() = Name.Split("@") Dim n$() = Name.Split("@")
If n.ListExists Then If n.ListExists Then
If n.Length = 2 Then If n.Length = 2 Then
TrueName = n(0) NameTrue = n(0)
IsChannel = True IsChannel = True
ElseIf IsChannel Then ElseIf IsChannel Then
TrueName = Name NameTrue = Name
Else Else
TrueName = n(0) NameTrue = n(0)
End If End If
End If End If
If Not IsSavedPosts Then If Not IsSavedPosts Then
@@ -201,7 +200,6 @@ Namespace API.Reddit
ViewMode = .Value(Name_ViewMode).FromXML(Of Integer)(CInt(CView.New)) ViewMode = .Value(Name_ViewMode).FromXML(Of Integer)(CInt(CView.New))
ViewPeriod = .Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(CPeriod.All)) ViewPeriod = .Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(CPeriod.All))
IsChannel = .Value(Name_IsChannel).FromXML(Of Boolean)(False) IsChannel = .Value(Name_IsChannel).FromXML(Of Boolean)(False)
TrueName = .Value(Name_TrueName)
RedGifsAccount = .Value(Name_RedGifsAccount) RedGifsAccount = .Value(Name_RedGifsAccount)
RedditAccount = .Value(Name_RedditAccount) RedditAccount = .Value(Name_RedditAccount)
UpdateNames() UpdateNames()
@@ -210,7 +208,7 @@ Namespace API.Reddit
.Add(Name_ViewMode, CInt(ViewMode)) .Add(Name_ViewMode, CInt(ViewMode))
.Add(Name_ViewPeriod, CInt(ViewPeriod)) .Add(Name_ViewPeriod, CInt(ViewPeriod))
.Add(Name_IsChannel, IsChannel.BoolToInteger) .Add(Name_IsChannel, IsChannel.BoolToInteger)
.Add(Name_TrueName, TrueName) .Add(Name_TrueName, NameTrue(True))
.Add(Name_RedGifsAccount, RedGifsAccount) .Add(Name_RedGifsAccount, RedGifsAccount)
.Add(Name_RedditAccount, RedditAccount) .Add(Name_RedditAccount, RedditAccount)
End If End If
@@ -230,7 +228,7 @@ Namespace API.Reddit
If CreatedByChannel And Settings.FromChannelDownloadTopUse And Settings.FromChannelDownloadTop > 0 Then _ If CreatedByChannel And Settings.FromChannelDownloadTopUse And Settings.FromChannelDownloadTop > 0 Then _
DownloadTopCount = Settings.FromChannelDownloadTop.Value DownloadTopCount = Settings.FromChannelDownloadTop.Value
If IsChannel Or IsSavedPosts Then UseMD5Comparison = False If IsChannel Or IsSavedPosts Then UseMD5Comparison = False
If IsSavedPosts Then TrueName = MySiteSettings.SavedPostsUserName.Value If IsSavedPosts Then NameTrue = MySiteSettings.SavedPostsUserName.Value
UpdateNames() UpdateNames()
If IsChannelForm Then If IsChannelForm Then
UseMD5Comparison = False UseMD5Comparison = False
@@ -310,10 +308,10 @@ Namespace API.Reddit
Dim NewPostDetected As Boolean = False Dim NewPostDetected As Boolean = False
Dim ExistsDetected As Boolean = False Dim ExistsDetected As Boolean = False
Dim IsCrossPost As Predicate(Of EContainer) = Function(e) Not e.Value(Node_CrosspostRootId).IsEmptyString Or Not e.Value(Node_CrosspostParentId).IsEmptyString Or Not e.Value(Node_CrosspostParent).IsEmptyString Dim IsCrossPost As Predicate(Of EContainer) = Function(e) Not e.Value(Node_CrosspostRootId).IsEmptyString Or Not e.Value(Node_CrosspostParentId).IsEmptyString Or Not e.Value(Node_CrosspostParent).IsEmptyString
Dim CheckNode As Predicate(Of EContainer) = Function(e) Not ParseUserMediaOnly OrElse If(e("author")?.Value, "/").ToLower.Equals(TrueName.StringToLower) Dim CheckNode As Predicate(Of EContainer) = Function(e) Not ParseUserMediaOnly OrElse If(e("author")?.Value, "/").ToLower.Equals(NameTrue.StringToLower)
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/{TrueName}/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"
ThrowAny(Token) ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -394,10 +392,10 @@ Namespace API.Reddit
Dim lDate As Date? Dim lDate As Date?
If IsSavedPosts Then If IsSavedPosts Then
URL = $"https://www.reddit.com/user/{TrueName}/saved.json?after={POST}" URL = $"https://www.reddit.com/user/{NameTrue}/saved.json?after={POST}"
If Not POST.IsEmptyString Then Thread.Sleep(savedPostsSleepTimer) If Not POST.IsEmptyString Then Thread.Sleep(savedPostsSleepTimer)
Else Else
URL = $"https://reddit.com/r/{TrueName}/{View}.json?allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic" URL = $"https://reddit.com/r/{NameTrue}/{View}.json?allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
End If End If
ThrowAny(Token) ThrowAny(Token)
@@ -480,7 +478,7 @@ Namespace API.Reddit
Private Sub GetUserInfo() Private Sub GetUserInfo()
Try Try
If Not IsSavedPosts And ChannelInfo Is Nothing Then If Not IsSavedPosts And ChannelInfo Is Nothing Then
Dim r$ = Responser.GetResponse($"https://reddit.com/{IIf(IsChannel, "r", "user")}/{TrueName}/about.json",, EDP.ReturnValue) Dim r$ = Responser.GetResponse($"https://reddit.com/{IIf(IsChannel, "r", "user")}/{NameTrue}/about.json",, EDP.ReturnValue)
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", "subreddit"}) Then If Not j Is Nothing AndAlso j.Contains({"data", "subreddit"}) Then
@@ -489,20 +487,10 @@ Namespace API.Reddit
UserSiteNameUpdate(.Value("title")) UserSiteNameUpdate(.Value("title"))
UserDescriptionUpdate(.Value("public_description")) UserDescriptionUpdate(.Value("public_description"))
Dim dir As SFile = MyFile.CutPath Dim dir As SFile = MyFile.CutPath
Dim __getFile As Action(Of String) = Sub(ByVal img As String) Dim fileCrFunc As Func(Of String, SFile) = Function(img) CreateFileFromUrl(img)
If Not img.IsEmptyString Then
Dim f As SFile = CreateFileFromUrl(img)
If Not f.Name.IsEmptyString Then
If f.Extension.IsEmptyString Then f.Extension = "jpg"
f.Path = dir.Path
If Not f.Exists Then GetWebFile(img, f, EDP.ReturnValue)
If f.Exists Then IconBannerDownloaded = True
End If
End If
End Sub
If DownloadIconBanner Then If DownloadIconBanner Then
__getFile.Invoke(.Value("icon_img")) SimpleDownloadAvatar(.Value("icon_img"), fileCrFunc)
__getFile.Invoke(.Value("banner_img")) SimpleDownloadAvatar(.Value("banner_img"), fileCrFunc)
End If End If
End With End With
End If End If
@@ -914,19 +902,24 @@ Namespace API.Reddit
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey, RedGifsAccount) Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey, RedGifsAccount)
If RedGifsHost Is Nothing Then RedGifsHost = Settings(RedGifs.RedGifsSiteKey).Default If RedGifsHost Is Nothing Then RedGifsHost = Settings(RedGifs.RedGifsSiteKey).Default
RedGifsResponser = RedGifsHost.Responser.Copy RedGifsResponser = RedGifsHost.Responser.Copy
Dim respNoHeaders As Responser = Responser.Copy
Dim m As UserMedia, m2 As UserMedia Dim m As UserMedia, m2 As UserMedia
Dim r$ Dim r$, url$
Dim j As EContainer Dim j As EContainer
Dim lastCount%, li% Dim lastCount%, li%
Dim rv As New ErrorsDescriber(EDP.ReturnValue)
respNoHeaders.Headers.Clear()
ProgressPre.ChangeMax(_ContentList.Count) ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1 For i% = 0 To _ContentList.Count - 1
m = _ContentList(i) m = _ContentList(i)
ProgressPre.Perform() ProgressPre.Perform()
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token) ThrowAny(Token)
r = Responser.GetResponse($"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json",, EDP.ReturnValue) url = $"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json"
r = Responser.GetResponse(url,, rv)
If r.IsEmptyString Then r = respNoHeaders.GetResponse(url,, rv)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, EDP.ReturnValue) j = JsonDocument.Parse(r, rv)
If Not j Is Nothing Then If Not j Is Nothing Then
If j.Count > 0 Then If j.Count > 0 Then
lastCount = _TempMediaList.Count lastCount = _TempMediaList.Count

View File

@@ -44,7 +44,6 @@ Namespace API.ThisVid
Friend Property DownloadPrivate As Boolean = True Friend Property DownloadPrivate As Boolean = True
Friend Property DownloadFavourite As Boolean = False Friend Property DownloadFavourite As Boolean = False
Friend Property DifferentFolders As Boolean = True Friend Property DifferentFolders As Boolean = True
Friend Property TrueName As String = String.Empty
Friend Property SiteMode As SiteModes = SiteModes.User Friend Property SiteMode As SiteModes = SiteModes.User
Private Property Arguments As String = String.Empty Private Property Arguments As String = String.Empty
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String) Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
@@ -80,7 +79,7 @@ Namespace API.ThisVid
If Not Force OrElse (Not SiteMode = SiteModes.User AndAlso Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then If Not Force OrElse (Not SiteMode = SiteModes.User AndAlso Not NewUrl.IsEmptyString AndAlso MyFileSettings.Exists) Then
Dim eObj As Plugin.ExchangeOptions = Nothing Dim eObj As Plugin.ExchangeOptions = Nothing
If Force Then eObj = MySettings.IsMyUser(NewUrl) If Force Then eObj = MySettings.IsMyUser(NewUrl)
If (Force And Not eObj.UserName.IsEmptyString) Or (Not Force And TrueName.IsEmptyString) Then If (Force And Not eObj.UserName.IsEmptyString) Or (Not Force And NameTrue(True).IsEmptyString) Then
Dim n$() = If(Force, eObj.UserName, Name).Split("@") Dim n$() = If(Force, eObj.UserName, Name).Split("@")
If n.ListExists(2) Then If n.ListExists(2) Then
@@ -98,8 +97,8 @@ Namespace API.ThisVid
End If End If
__TrueName = n(1) __TrueName = n(1)
If Force AndAlso (Not TrueName = __TrueName Or Not SiteMode = __Mode) Then If Force AndAlso (Not NameTrue(True) = __TrueName Or Not SiteMode = __Mode) Then
If ValidateChangeSearchOptions(ToStringForLog, $"{__Mode}: {__TrueName}", $"{SiteMode}: {TrueName}") Then If ValidateChangeSearchOptions(ToStringForLog, $"{__Mode}: {__TrueName}", $"{SiteMode}: {NameTrue(True)}") Then
__ForceApply = True __ForceApply = True
Else Else
Return False Return False
@@ -109,21 +108,21 @@ Namespace API.ThisVid
Arguments = __Arguments Arguments = __Arguments
Options = If(Force, eObj.Options, Options) Options = If(Force, eObj.Options, Options)
If Not Force Then If Not Force Then
TrueName = __TrueName NameTrue = __TrueName
SiteMode = __Mode SiteMode = __Mode
Settings.Labels.Add(SearchRequestLabelName) Settings.Labels.Add(SearchRequestLabelName)
Labels.ListAddValue(SearchRequestLabelName, LNC) Labels.ListAddValue(SearchRequestLabelName, LNC)
Labels.Sort() Labels.Sort()
UserSiteName = $"{SiteMode}: {TrueName}" UserSiteName = $"{SiteMode}: {NameTrue}"
If FriendlyName.IsEmptyString Then FriendlyName = UserSiteName If FriendlyName.IsEmptyString Then FriendlyName = UserSiteName
ElseIf Force And __ForceApply Then ElseIf Force And __ForceApply Then
TrueName = __TrueName NameTrue = __TrueName
SiteMode = __Mode SiteMode = __Mode
End If End If
Return True Return True
Else Else
SiteMode = SiteModes.User SiteMode = SiteModes.User
TrueName = Name NameTrue = Name
End If End If
End If End If
End If End If
@@ -136,7 +135,6 @@ Namespace API.ThisVid
DownloadPrivate = .Value(Name_DownloadPrivate).FromXML(Of Boolean)(True) DownloadPrivate = .Value(Name_DownloadPrivate).FromXML(Of Boolean)(True)
DownloadFavourite = .Value(Name_DownloadFavourite).FromXML(Of Boolean)(False) DownloadFavourite = .Value(Name_DownloadFavourite).FromXML(Of Boolean)(False)
DifferentFolders = .Value(Name_DifferentFolders).FromXML(Of Boolean)(True) DifferentFolders = .Value(Name_DifferentFolders).FromXML(Of Boolean)(True)
TrueName = .Value(Name_TrueName)
SiteMode = .Value(Name_SiteMode).FromXML(Of Integer)(SiteModes.User) SiteMode = .Value(Name_SiteMode).FromXML(Of Integer)(SiteModes.User)
Arguments = .Value(Name_Arguments) Arguments = .Value(Name_Arguments)
UpdateUserOptions() UpdateUserOptions()
@@ -150,7 +148,7 @@ Namespace API.ThisVid
.Add(Name_DownloadPrivate, DownloadPrivate.BoolToInteger) .Add(Name_DownloadPrivate, DownloadPrivate.BoolToInteger)
.Add(Name_DownloadFavourite, DownloadFavourite.BoolToInteger) .Add(Name_DownloadFavourite, DownloadFavourite.BoolToInteger)
.Add(Name_DifferentFolders, DifferentFolders.BoolToInteger) .Add(Name_DifferentFolders, DifferentFolders.BoolToInteger)
.Add(Name_TrueName, TrueName) .Add(Name_TrueName, NameTrue(True))
.Add(Name_SiteMode, CInt(SiteMode)) .Add(Name_SiteMode, CInt(SiteMode))
.Add(Name_Arguments, Arguments) .Add(Name_Arguments, Arguments)
@@ -259,18 +257,18 @@ Namespace API.ThisVid
Dim url$ = String.Empty Dim url$ = String.Empty
Select Case SiteMode Select Case SiteMode
Case SiteModes.Tags Case SiteModes.Tags
url = $"https://thisvid.com/{SiteSettings.P_Tags}/{TrueName}/" url = $"https://thisvid.com/{SiteSettings.P_Tags}/{NameTrue}/"
If Not Arguments.IsEmptyString Then url &= $"{Arguments}/" If Not Arguments.IsEmptyString Then url &= $"{Arguments}/"
If Page > 1 Then url &= $"{Page}/" If Page > 1 Then url &= $"{Page}/"
Case SiteModes.Categories Case SiteModes.Categories
url = $"https://thisvid.com/{SiteSettings.P_Categories}/{TrueName}/" url = $"https://thisvid.com/{SiteSettings.P_Categories}/{NameTrue}/"
If Not Arguments.IsEmptyString Then url &= $"{Arguments}/" If Not Arguments.IsEmptyString Then url &= $"{Arguments}/"
If Page > 1 Then url &= $"{Page}/" If Page > 1 Then url &= $"{Page}/"
Case SiteModes.Search Case SiteModes.Search
If Not Arguments.IsEmptyString Then If Not Arguments.IsEmptyString Then
url = $"https://thisvid.com/{Arguments}/" url = $"https://thisvid.com/{Arguments}/"
If Page > 1 Then url &= $"{Page}/" If Page > 1 Then url &= $"{Page}/"
url &= $"?q={TrueName}/" url &= $"?q={NameTrue}/"
End If End If
End Select End Select
Return url Return url
@@ -473,35 +471,47 @@ Namespace API.ThisVid
Dim u As UserMedia Dim u As UserMedia
Dim n$, r$ Dim n$, r$
Dim c% = 0 Dim c% = 0
Dim ii As Byte
Dim repeat As Boolean
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
Progress.Perform() Progress.Perform()
u = _TempMediaList(i) u = _TempMediaList(i)
If u.Type = UserMedia.Types.VideoPre Then If u.Type = UserMedia.Types.VideoPre Then
If Not DownloadTopCount.HasValue OrElse c <= DownloadTopCount.Value Then If Not DownloadTopCount.HasValue OrElse c <= DownloadTopCount.Value Then
ThrowAny(Token) repeat = False
r = Responser.GetResponse(u.URL,, EDP.ReturnValue) For ii = 0 To 1
If Not r.IsEmptyString Then ThrowAny(Token)
n = TitleHtmlConverter(RegexReplace(r, RegExVideoTitle)) r = Responser.GetResponse(u.URL,, EDP.ReturnValue)
u.Post.ID = u.URL If Not r.IsEmptyString Then
If Not n.IsEmptyString Then n = n.Replace("ThisVid.com", String.Empty).StringTrim.StringTrimEnd("-").StringTrim n = TitleHtmlConverter(RegexReplace(r, RegExVideoTitle))
If n.IsEmptyString Then n = TitleHtmlConverter(u.URL.Replace("https://thisvid.com/videos/", String.Empty).StringTrim.StringTrimEnd("-").StringTrim) u.Post.ID = u.URL
If n.IsEmptyString Then n = "VideoFile" If Not n.IsEmptyString Then n = n.Replace("ThisVid.com", String.Empty).StringTrim.StringTrimEnd("-").StringTrim
u.File = $"{n}.mp4" If n.IsEmptyString Then n = TitleHtmlConverter(u.URL.Replace("https://thisvid.com/videos/", String.Empty).StringTrim.StringTrimEnd("-").StringTrim)
u.PictureOption = n If n.IsEmptyString Then n = "VideoFile"
u.URL = RegexReplace(r, Regex_VideosThumb_OG_IMAGE) u.File = $"{n}.mp4"
If u.URL.IsEmptyString Then u.URL = RegexReplace(r, RegExVideosThumb1) u.PictureOption = n
If u.URL.IsEmptyString Then u.URL = RegexReplace(r, RegExVideosThumb2) u.URL = RegexReplace(r, Regex_VideosThumb_OG_IMAGE)
If Not u.URL.IsEmptyString Then If u.URL.IsEmptyString And Not repeat And ii = 0 Then
u.URL = LinkFormatterSecure(u.URL) Thread.Sleep(250)
u.Type = UserMedia.Types.Video u = _TempMediaList(i)
_TempPostsList.Add(u.Post.ID) repeat = True
_TempMediaList(i) = u Continue For
c += 1 End If
Else If u.URL.IsEmptyString Then u.URL = RegexReplace(r, RegExVideosThumb1)
_TempMediaList.RemoveAt(i) If u.URL.IsEmptyString Then u.URL = RegexReplace(r, RegExVideosThumb2)
If Not u.URL.IsEmptyString Then
u.URL = LinkFormatterSecure(u.URL)
u.Type = UserMedia.Types.Video
_TempPostsList.Add(u.Post.ID)
_TempMediaList(i) = u
c += 1
Else
_TempMediaList.RemoveAt(i)
End If
End If End If
End If If Not repeat Then Exit For
Next
Else Else
_TempMediaList.RemoveAt(i) _TempMediaList.RemoveAt(i)
End If End If

View File

@@ -15,7 +15,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports IG = SCrawler.API.Instagram.SiteSettings Imports IG = SCrawler.API.Instagram.SiteSettings
Imports DN = SCrawler.API.Base.DeclaredNames Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.ThreadsNet Namespace API.ThreadsNet
<Manifest("AndyProgram_ThreadsNet"), SeparatedTasks(1)> <Manifest("AndyProgram_ThreadsNet"), SavedPosts, SeparatedTasks(1), SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
#Region "Authorization" #Region "Authorization"
@@ -155,6 +155,7 @@ Namespace API.ThreadsNet
UrlPatternUser = "https://www.threads.net/@{0}" UrlPatternUser = "https://www.threads.net/@{0}"
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "threads.net/@"), 1) UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "threads.net/@"), 1)
ImageVideoContains = "threads.net" ImageVideoContains = "threads.net"
UserOptionsType = GetType(EditorExchangeOptionsBase)
End Sub End Sub
#End Region #End Region
#Region "UpdateResponserData" #Region "UpdateResponserData"
@@ -180,9 +181,6 @@ Namespace API.ThreadsNet
Friend Overrides Function BaseAuthExists() As Boolean Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists And {HH_CSRF_TOKEN, HH_IG_APP_ID}.All(Function(v) ACheck(Of String)(v.Value)) And CBool(DownloadData_Impl.Value) Return Responser.CookiesExists And {HH_CSRF_TOKEN, HH_IG_APP_ID}.All(Function(v) ACheck(Of String)(v.Value)) And CBool(DownloadData_Impl.Value)
End Function End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return String.Format(UrlPatternUser, DirectCast(User, UserData).NameTrue)
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Try Try
Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID) Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID)

View File

@@ -7,6 +7,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 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
@@ -51,9 +52,10 @@ Namespace API.ThreadsNet
#End Region #End Region
#Region "Exchange" #Region "Exchange"
Friend Overrides Function ExchangeOptionsGet() As Object Friend Overrides Function ExchangeOptionsGet() As Object
Return Nothing 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 NameTrue = DirectCast(Obj, EditorExchangeOptionsBase).UserName
End Sub End Sub
#End Region #End Region
#Region "Initializer" #Region "Initializer"
@@ -73,12 +75,13 @@ Namespace API.ThreadsNet
End Sub End Sub
Private Sub DisableDownload() Private Sub DisableDownload()
MySettings.DownloadData_Impl.Value = False MySettings.DownloadData_Impl.Value = False
MyMainLOG = $"{Site} downloading is disabled until you update your credentials" LogError(Nothing, $"{Site} downloading is disabled until you update your credentials")
End Sub End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If CBool(MySettings.DownloadData_Impl.Value) Then If CBool(MySettings.DownloadData_Impl.Value) Then
Dim errorFound As Boolean = False Dim errorFound As Boolean = False
Try Try
_IdChanged = False
Responser.Method = "POST" Responser.Method = "POST"
LoadSavePostsKV(True) LoadSavePostsKV(True)
ResetBaseTokens() ResetBaseTokens()
@@ -101,7 +104,12 @@ Namespace API.ThreadsNet
Else Else
DefaultParser_SkipPost = AddressOf SkipPost DefaultParser_SkipPost = AddressOf SkipPost
End If End If
DownloadData(String.Empty, Token) If IsSavedPosts Then
DefaultParser_ElemNode = {"node", "thread_items", 0, "post"}
DownloadSavedPosts(String.Empty, 0, Token)
Else
DownloadData(String.Empty, 0, Token)
End If
If _TempMediaList.Count > 0 Then FirstLoadingDone = True : setMaxPostDate.Invoke(_TempMediaList) If _TempMediaList.Count > 0 Then FirstLoadingDone = True : setMaxPostDate.Invoke(_TempMediaList)
Catch ex As Exception Catch ex As Exception
errorFound = True errorFound = True
@@ -110,17 +118,22 @@ Namespace API.ThreadsNet
Responser.Method = "POST" Responser.Method = "POST"
UpdateResponser() UpdateResponser()
MySettings.UpdateResponserData(Responser) MySettings.UpdateResponserData(Responser)
ValidateExtension()
If Not errorFound Then LoadSavePostsKV(False) If Not errorFound Then LoadSavePostsKV(False)
End Try End Try
End If End If
End Sub End Sub
Private Function IsPinnedPost(ByVal Items As IEnumerable(Of EContainer), ByVal Index As Integer) As Boolean Private Function IsPinnedPost(ByVal Items As IEnumerable(Of EContainer), ByVal Index As Integer) As Boolean
Try Try
If MaxLastDownDate.HasValue Then If IsSavedPosts Then
Dim d As Date? = AConvert(Of Date)(Items(Index).ItemF(DefaultParser_ElemNode_Default).Value("taken_at"), UnixDate32Provider, Nothing) Return False
If d.HasValue Then Return d.Value < MaxLastDownDate.Value Else
If MaxLastDownDate.HasValue Then
Dim d As Date? = AConvert(Of Date)(Items(Index).ItemF(DefaultParser_ElemNode_Default).Value("taken_at"), UnixDate32Provider, Nothing)
If d.HasValue Then Return d.Value < MaxLastDownDate.Value
End If
Return Not FirstLoadingDone
End If End If
Return Not FirstLoadingDone
Catch ex As Exception Catch ex As Exception
LogError(ex, "IsPinnedPost") LogError(ex, "IsPinnedPost")
Return Not FirstLoadingDone Return Not FirstLoadingDone
@@ -141,72 +154,208 @@ Namespace API.ThreadsNet
Responser.Headers.Add(IGS.Header_CSRF_TOKEN, csrf) Responser.Headers.Add(IGS.Header_CSRF_TOKEN, csrf)
End If End If
End Sub End Sub
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken) 'Private Const GQL_Q As String = "https://www.threads.net/api/graphql?lsd={0}&fb_dtsg={1}&doc_id={2}&fb_api_req_friendly_name={3}&server_timestamps=true&variables={4}"
Const urlPattern$ = "https://www.threads.net/api/graphql?lsd={0}&variables={1}&doc_id=6371597506283707&fb_api_req_friendly_name=BarcelonaProfileThreadsTabRefetchableQuery&server_timestamps=true&fb_dtsg={2}" Private Const GQL_Q2 As String = "https://www.threads.net/graphql/query"
Const var_init$ = """userID"":""{0}""" Private Const PayloadData As String = "lsd={0}&fb_dtsg={1}&doc_id={2}&fb_api_req_friendly_name={3}&server_timestamps=true&variables={4}"
Const var_cursor$ = """after"":""{1}"",""before"":null,""first"":25,""last"":null,""userID"":""{0}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false" Private Const GQL_P_DOC_ID As String = "9039187972876777" '"8779269398849532" '"6371597506283707"
Dim URL$ = String.Empty Private Const GQL_P_NAME As String = "BarcelonaProfileThreadsTabRefetchableDirectQuery" '"BarcelonaProfileThreadsTabRefetchableQuery"
'Private Const GQL_S_DOC_ID_1 As String = "9227844190587889" '"7758166704280174"
'Private Const GQL_S_NAME_1 As String = "BarcelonaSavedPageViewerQuery"
Private Const GQL_S_DOC_ID_2 As String = "9116629201788321" '"8617275414954442"
Private Const GQL_S_NAME_2 As String = "BarcelonaSavedPageRefetchableQuery"
Private Sub DownloadCheckCredentials()
If Not Valid Then
Dim idIsNull As Boolean = ID.IsEmptyString
UpdateCredentials()
If idIsNull And Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
If Not Valid Then DisableDownload() : Throw New Plugin.ExitException("Some credentials are missing")
End Sub
Private Function CheckErrors(ByVal e As EContainer) As Boolean
Return e.ListExists AndAlso Not JsonErrorMessage(e).IsEmptyString
End Function
Private Function JsonErrorMessage(ByVal e As EContainer) As String
Return e.ItemF({"errors", 0, "summary"})?.Value
End Function
Private Sub ProcessJsonErrorException(ByVal uex As JsonErrorException, Optional ByVal ThrowEx As Boolean = True)
If uex.UserNotFound Then
UserExists = False
_ForceSaveUserInfo = True
_ForceSaveUserInfoOnException = True
ElseIf ThrowEx Then
Throw New ExitException(uex.ErrMessage) With {.SimpleLogLine = True}
Else
LogError(Nothing, uex.ErrMessage)
End If
End Sub
Private Class JsonErrorException : Inherits Exception
Friend Property UserNotFound As Boolean = False
Private _ErrMessage As String = String.Empty
Public Property ErrMessage As String
Get
Return _ErrMessage
End Get
Set(ByVal m As String)
_ErrMessage = m
UserNotFound = _ErrMessage.StringToLower = "not found"
End Set
End Property
Public Overrides ReadOnly Property Message As String
Get
Return _ErrMessage
End Get
End Property
Friend Sub New()
End Sub
Friend Sub New(ByVal Message As String)
ErrMessage = Message
End Sub
End Class
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Round As Integer, ByVal Token As CancellationToken)
'Const var_init$ = """userID"":""{0}"""
'Const var_cursor$ = """after"":""{1}"",""before"":null,""first"":25,""last"":null,""userID"":""{0}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false"
Const var_cursor2$ = """after"":{1},""before"":null,""first"":10,""last"":null,""userID"":""{0}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaHasSelfReplyContextrelayprovider"":false,""__relay_internal__pv__BarcelonaShareableListsrelayprovider"":true,""__relay_internal__pv__BarcelonaIsSearchDiscoveryEnabledrelayprovider"":false,""__relay_internal__pv__BarcelonaOptionalCookiesEnabledrelayprovider"":true,""__relay_internal__pv__BarcelonaQuotedPostUFIEnabledrelayprovider"":false,""__relay_internal__pv__BarcelonaIsCrawlerrelayprovider"":false,""__relay_internal__pv__BarcelonaHasDisplayNamesrelayprovider"":false,""__relay_internal__pv__BarcelonaCanSeeSponsoredContentrelayprovider"":false,""__relay_internal__pv__BarcelonaShouldShowFediverseM075Featuresrelayprovider"":true,""__relay_internal__pv__BarcelonaShouldShowTagRedesignrelayprovider"":false,""__relay_internal__pv__BarcelonaIsInternalUserrelayprovider"":false"
Try Try
If Not Valid Then DownloadCheckCredentials()
Dim idIsNull As Boolean = ID.IsEmptyString
UpdateCredentials()
If idIsNull And Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If
If Not Valid Then DisableDownload() : Throw New Plugin.ExitException("Some credentials are missing")
Responser.Method = "POST" With Responser
Responser.Referer = $"https://www.threads.net/@{NameTrue}" .Method = "POST"
Responser.Headers.Add(GQL_HEADER_FB_LSD, Token_lsd) .Referer = $"https://www.threads.net/@{NameTrue}"
.ContentType = "application/x-www-form-urlencoded"
With .Headers
.Add(GQL_HEADER_FB_LSD, Token_lsd)
.Add(GQL_HEADER_FB_FRINDLY_NAME, GQL_P_NAME)
End With
End With
Dim nextCursor$ = String.Empty Dim nextCursor$ = String.Empty
Dim dataFound As Boolean = False Dim dataFound As Boolean = False
Dim vars$ Dim vars$ = String.Format(var_cursor2, ID, IIf(Cursor.IsEmptyString, "null", $"""{Cursor}"""))
If Cursor.IsEmptyString Then 'If Cursor.IsEmptyString Then
vars = String.Format(var_init, ID) ' vars = String.Format(var_init, ID)
Else 'Else
vars = String.Format(var_cursor, ID, Cursor) ' vars = String.Format(var_cursor, ID, Cursor)
End If 'End If
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & vars & "}") vars = String.Format(PayloadData, Token_lsd, Token_dtsg_Var, GQL_P_DOC_ID, GQL_P_NAME,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & vars & "}"))
URL = String.Format(urlPattern, Token_lsd, vars, Token_dtsg_Var) 'URL = String.Format(GQL_Q, Token_lsd, Token_dtsg_Var, GQL_P_DOC_ID, GQL_P_NAME, vars)
Using j As EContainer = GetDocument(URL, Token) Using j As EContainer = GetDocument(GQL_Q2, vars, Token)
If j.ListExists Then If Not CheckErrors(j) Then
With j({"data", "mediaData"}) If j.ListExists Then
If .ListExists Then With j({"data", "mediaData"})
nextCursor = .Value({"page_info"}, "end_cursor") If .ListExists Then
With .Item({"edges"}) nextCursor = .Value({"page_info"}, "end_cursor")
If .ListExists Then dataFound = DefaultParser(.Self, Sections.Timeline, Token) With .Item({"edges"})
End With If .ListExists Then dataFound = DefaultParser(.Self, Sections.Timeline, Token)
End If End With
End With End If
End With
End If
Else
Throw New JsonErrorException(JsonErrorMessage(j))
End If End If
End Using End Using
If dataFound And Not nextCursor.IsEmptyString Then DownloadData(nextCursor, Token) If dataFound And Not nextCursor.IsEmptyString Then DownloadData(nextCursor, 0, Token)
Catch uex As JsonErrorException
If Round > 0 Then
ProcessJsonErrorException(uex)
ElseIf Not _IdChanged AndAlso UpdateCredentials() Then
DownloadData(Cursor, Round + 1, Token)
Else
ProcessJsonErrorException(uex)
End If
Catch eex As ExitException
Throw eex
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]") ProcessException(ex, Token, "data downloading error")
End Try End Try
End Sub End Sub
Private Function GetDocument(ByVal URL As String, ByVal Token As CancellationToken, Optional ByVal Round As Integer = 0) As EContainer Private Sub DownloadSavedPosts(ByVal Cursor As String, ByVal Round As Integer, ByVal Token As CancellationToken)
'Const var_init$ = """__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsInlineReelsEnabledrelayprovider"":false,""__relay_internal__pv__BarcelonaUseCometVideoPlaybackEnginerelayprovider"":false,""__relay_internal__pv__BarcelonaOptionalCookiesEnabledrelayprovider"":true,""__relay_internal__pv__BarcelonaIsTextFragmentsEnabledForPostCaptionsrelayprovider"":true,""__relay_internal__pv__BarcelonaShouldShowFediverseM075Featuresrelayprovider"":true"
'Const var_cursor$ = """after"":""{0}"",""first"":25,""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsInlineReelsEnabledrelayprovider"":false,""__relay_internal__pv__BarcelonaUseCometVideoPlaybackEnginerelayprovider"":false,""__relay_internal__pv__BarcelonaOptionalCookiesEnabledrelayprovider"":true,""__relay_internal__pv__BarcelonaIsTextFragmentsEnabledForPostCaptionsrelayprovider"":true,""__relay_internal__pv__BarcelonaShouldShowFediverseM075Featuresrelayprovider"":true"
Const var_cursor2$ = """after"":{0},""first"":25,""__relay_internal__pv__BarcelonaQuotedPostUFIEnabledrelayprovider"":false,""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaHasSelfReplyContextrelayprovider"":false,""__relay_internal__pv__BarcelonaShareableListsrelayprovider"":true,""__relay_internal__pv__BarcelonaIsSearchDiscoveryEnabledrelayprovider"":false,""__relay_internal__pv__BarcelonaOptionalCookiesEnabledrelayprovider"":true,""__relay_internal__pv__BarcelonaIsCrawlerrelayprovider"":false,""__relay_internal__pv__BarcelonaHasDisplayNamesrelayprovider"":false,""__relay_internal__pv__BarcelonaCanSeeSponsoredContentrelayprovider"":false,""__relay_internal__pv__BarcelonaShouldShowFediverseM075Featuresrelayprovider"":true,""__relay_internal__pv__BarcelonaShouldShowTagRedesignrelayprovider"":false,""__relay_internal__pv__BarcelonaIsInternalUserrelayprovider"":false"
Try
DownloadCheckCredentials()
With Responser
.Method = "POST"
.Referer = "https://www.threads.net/"
.ContentType = "application/x-www-form-urlencoded"
With .Headers
.Add(GQL_HEADER_FB_LSD, Token_lsd)
'.Add(GQL_HEADER_FB_FRINDLY_NAME, If(Cursor.IsEmptyString, GQL_S_NAME_1, GQL_S_NAME_2))
.Add(GQL_HEADER_FB_FRINDLY_NAME, GQL_S_NAME_2)
End With
End With
Dim nextCursor$ = String.Empty
Dim dataFound As Boolean = False
'Dim vars$ = SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & If(Cursor.IsEmptyString, var_init, String.Format(var_cursor, Cursor)) & "}")
Dim vars$ = String.Format(PayloadData, Token_lsd, Token_dtsg_Var, GQL_S_DOC_ID_2, GQL_S_NAME_2,
SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(var_cursor2, IIf(Cursor.IsEmptyString, "null", $"""{Cursor}""")) & "}"))
'If Cursor.IsEmptyString Then
' URL = String.Format(GQL_Q, Token_lsd, Token_dtsg_Var, GQL_S_DOC_ID_1, GQL_S_NAME_1, vars)
'Else
' URL = String.Format(GQL_Q, Token_lsd, Token_dtsg_Var, GQL_S_DOC_ID_2, GQL_S_NAME_2, vars)
'End If
Using j As EContainer = GetDocument(GQL_Q2, vars, Token)
If Not CheckErrors(j) Then
If j.ListExists Then
With j({"data", "xdt_text_app_viewer", "saved_media"})
If .ListExists Then
nextCursor = .Value({"page_info"}, "end_cursor")
With .Item({"edges"})
If .ListExists Then dataFound = DefaultParser(.Self, Sections.Timeline, Token)
End With
End If
End With
End If
Else
Throw New JsonErrorException(JsonErrorMessage(j))
End If
End Using
If dataFound And Not nextCursor.IsEmptyString Then DownloadSavedPosts(nextCursor, 0, Token)
Catch uex As JsonErrorException
If Round > 0 Then
ProcessJsonErrorException(uex)
ElseIf Not _IdChanged AndAlso UpdateCredentials() Then
DownloadSavedPosts(Cursor, Round + 1, Token)
Else
ProcessJsonErrorException(uex)
End If
Catch eex As ExitException
Throw eex
Catch ex As Exception
ProcessException(ex, Token, "saved posts downloading error")
End Try
End Sub
Private Function GetDocument(ByVal URL As String, ByVal PayLoad As String, ByVal Token As CancellationToken, Optional ByVal Round As Integer = 0) As EContainer
Try Try
ThrowAny(Token) ThrowAny(Token)
If Round > 0 AndAlso Not UpdateCredentials() Then DisableDownload() : Throw New Exception("Failed to update credentials") If Round > 0 AndAlso Not UpdateCredentials() Then DisableDownload() : Throw New Exception("Failed to update credentials")
ThrowAny(Token) ThrowAny(Token)
WaitTimer() WaitTimer()
Dim r$ = Responser.GetResponse(URL) Dim r$ = Responser.GetResponse(URL, PayLoad)
If Not r.IsEmptyString Then Return JsonDocument.Parse(r) Else Throw New Exception("Failed to get a response") If Not r.IsEmptyString Then Return JsonDocument.Parse(r) Else Throw New Exception("Failed to get a response")
Catch ex As Exception Catch ex As Exception
If Round = 0 Then If Round = 0 Then
Return GetDocument(URL, Token, Round + 1) Return GetDocument(URL, PayLoad, Token, Round + 1)
Else Else
Throw ex Throw ex
End If End If
End Try End Try
End Function End Function
Private _IdChanged As Boolean = False
Private Function UpdateCredentials(Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Private Function UpdateCredentials(Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Dim URL$ = $"https://www.threads.net/@{NameTrue}" Dim URL$ = If(IsSavedPosts, "https://www.threads.net/", $"https://www.threads.net/@{NameTrue}")
ResetBaseTokens() ResetBaseTokens()
Dim headers As New HttpHeaderCollection Dim headers As New HttpHeaderCollection
headers.AddRange(Responser.Headers) headers.AddRange(Responser.Headers)
@@ -233,9 +382,25 @@ Namespace API.ThreadsNet
End With End With
WaitTimer() WaitTimer()
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException) Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
Dim newID$
Dim idStr$ = String.Empty
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
ParseTokens(r, 0) ParseTokens(r, 0)
If ID.IsEmptyString Then ID = RegexReplace(r, RParams.DMS("""props"":\{""user_id"":""(\d+)""", 1, EDP.ReturnValue)) newID = RegexReplace(r, RParams.DMS("""props"":\{[^\{\}]*?""user_id"":""(\d+)""", 1, EDP.ReturnValue))
If ID.IsEmptyString OrElse ID = newID Then
_IdChanged = ID.IsEmptyString
ID = newID
Else
_IdChanged = True
idStr = $"user ID changed from {ID} to {newID}"
LogError(Nothing, idStr)
ID = newID
End If
If _IdChanged Then
If Not idStr.IsEmptyString Then UserDescriptionUpdate(idStr, True, True, True)
_ForceSaveUserInfo = True
_ForceSaveUserInfoOnException = True
End If
End If End If
Return Valid Return Valid
Catch ex As Exception Catch ex As Exception
@@ -261,20 +426,22 @@ Namespace API.ThreadsNet
#End Region #End Region
#Region "ReparseMissing" #Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken) Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Const varsPattern$ = """postID"":""{0}"",""userID"":""{1}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false" 'Const varsPattern$ = """postID"":""{0}"",""userID"":""{1}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false"
Const varsPattern$ = """postID"":""{0}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaShouldShowFediverseM1Featuresrelayprovider"":true,""__relay_internal__pv__BarcelonaShareableListsrelayprovider"":true,""__relay_internal__pv__BarcelonaIsSearchDiscoveryEnabledrelayprovider"":false,""__relay_internal__pv__BarcelonaOptionalCookiesEnabledrelayprovider"":true,""__relay_internal__pv__BarcelonaQuotedPostUFIEnabledrelayprovider"":false,""__relay_internal__pv__BarcelonaIsCrawlerrelayprovider"":false,""__relay_internal__pv__BarcelonaHasDisplayNamesrelayprovider"":false,""__relay_internal__pv__BarcelonaCanSeeSponsoredContentrelayprovider"":false,""__relay_internal__pv__BarcelonaShouldShowFediverseM075Featuresrelayprovider"":true,""__relay_internal__pv__BarcelonaShouldShowTagRedesignrelayprovider"":false,""__relay_internal__pv__BarcelonaIsInternalUserrelayprovider"":false,""__relay_internal__pv__BarcelonaInlineComposerEnabledrelayprovider"":false"
'Const varsPattern$ = "{""postID"":""{0}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false}" 'Const varsPattern$ = "{""postID"":""{0}"",""__relay_internal__pv__BarcelonaIsLoggedInrelayprovider"":true,""__relay_internal__pv__BarcelonaIsFeedbackHubEnabledrelayprovider"":false}"
Const urlPattern$ = "https://www.threads.net/api/graphql?lsd={0}&variables={1}&fb_api_req_friendly_name=BarcelonaPostPageQuery&server_timestamps=true&fb_dtsg={2}&doc_id=25460088156920903" 'Const urlPattern$ = "https://www.threads.net/api/graphql?lsd={0}&variables={1}&fb_api_req_friendly_name=BarcelonaPostPageQuery&server_timestamps=true&fb_dtsg={2}&doc_id=25460088156920903"
Dim rList As New List(Of Integer) Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
DefaultParser_ElemNode = Nothing DefaultParser_ElemNode = Nothing
DefaultParser_IgnorePass = True DefaultParser_IgnorePass = True
Try Try
If ContentMissingExists Then If ContentMissingExists Then
Responser.Method = "POST" Responser.Method = "POST"
Responser.ContentType = "application/x-www-form-urlencoded"
Responser.Referer = $"https://www.threads.net/@{NameTrue}" Responser.Referer = $"https://www.threads.net/@{NameTrue}"
If Not IsSingleObjectDownload AndAlso Not UpdateCredentials() Then Throw New Exception("Failed to update credentials") If Not IsSingleObjectDownload AndAlso Not UpdateCredentials() Then Throw New Exception("Failed to update credentials")
Dim m As UserMedia Dim m As UserMedia
Dim vars$ Dim vars$
Dim r As Byte
Dim j As EContainer Dim j As EContainer
ProgressPre.ChangeMax(_ContentList.Count) ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1 For i% = 0 To _ContentList.Count - 1
@@ -282,21 +449,39 @@ Namespace API.ThreadsNet
m = _ContentList(i) m = _ContentList(i)
If m.State = UserMedia.States.Missing And Not m.Post.ID.IsEmptyString Then If m.State = UserMedia.States.Missing And Not m.Post.ID.IsEmptyString Then
ThrowAny(Token) ThrowAny(Token)
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(varsPattern, m.Post.ID.Split("_").FirstOrDefault, ID) & "}") 'vars = SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(varsPattern, m.Post.ID.Split("_").FirstOrDefault, ID) & "}")
URL = String.Format(urlPattern, Token_lsd, vars, Token_dtsg_Var) 'URL = String.Format(urlPattern, Token_lsd, vars, Token_dtsg_Var)
j = GetDocument(URL, Token) vars = String.Format(PayloadData, Token_lsd, Token_dtsg_Var, "9094233770675261", "BarcelonaPostPageDirectQuery",
If j.ListExists Then SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & String.Format(varsPattern, m.Post.ID) & "}"))
With j.ItemF({"data", "data", "edges", 0, "node", "thread_items", 0, "post"})
If .ListExists AndAlso DefaultParser({ .Self}, Sections.Timeline, Token) Then rList.Add(i) For r = 0 To 1
End With j = GetDocument(GQL_Q2, vars, Token)
j.Dispose() If Not CheckErrors(j) Then
End If If j.ListExists Then
With j.ItemF({"data", "data", "edges", 0, "node", "thread_items", 0, "post"})
If .ListExists AndAlso DefaultParser({ .Self}, Sections.Timeline, Token) Then rList.Add(i)
End With
j.Dispose()
End If
Else
j.DisposeIfReady(False)
If r > 0 Then
ProcessJsonErrorException(New JsonErrorException(JsonErrorMessage(j)))
ElseIf Not _IdChanged AndAlso UpdateCredentials() Then
Continue For
Else
ProcessJsonErrorException(New JsonErrorException(JsonErrorMessage(j)))
End If
End If
Next
End If End If
Next Next
End If End If
Catch eex As ExitException
Throw eex
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"ReparseMissing error [{URL}]") ProcessException(ex, Token, "reparseMissing error")
Finally Finally
DefaultParser_ElemNode = DefaultParser_ElemNode_Default DefaultParser_ElemNode = DefaultParser_ElemNode_Default
DefaultParser_IgnorePass = False DefaultParser_IgnorePass = False
@@ -314,9 +499,9 @@ Namespace API.ThreadsNet
If Not postCode.IsEmptyString Then If Not postCode.IsEmptyString Then
Dim postId$ = CodeToID(postCode) Dim postId$ = CodeToID(postCode)
If Not postId.IsEmptyString Then If Not postId.IsEmptyString Then
_NameTrue = MySettings.IsMyUser(url).UserName NameTrue = MySettings.IsMyUser(url).UserName
DefaultParser_PostUrlCreator = Function(post) url DefaultParser_PostUrlCreator = Function(post) url
If Not _NameTrue.IsEmptyString AndAlso UpdateCredentials(EDP.ReturnValue) Then If Not NameTrue(True).IsEmptyString AndAlso UpdateCredentials(EDP.ReturnValue) Then
_ContentList.Add(New UserMedia(url) With {.State = UserMedia.States.Missing, .Post = postId}) _ContentList.Add(New UserMedia(url) With {.State = UserMedia.States.Missing, .Post = postId})
ReparseMissing(Token) ReparseMissing(Token)
End If End If

View File

@@ -62,8 +62,5 @@ 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 GetUserUrl(ByVal User As IPluginContentProvider) As String
Return String.Format(UrlPatternUser, DirectCast(User, UserData).TrueName)
End Function
End Class End Class
End Namespace End Namespace

View File

@@ -62,15 +62,6 @@ Namespace API.TikTok
Friend Property TitleUseRegexForTitle_Value As String = String.Empty Friend Property TitleUseRegexForTitle_Value As String = String.Empty
Friend Property TitleUseGlobalRegexOptions As Boolean = True Friend Property TitleUseGlobalRegexOptions As Boolean = True
Private Property LastDownloadDate As Date? = Nothing Private Property LastDownloadDate As Date? = Nothing
Private _TrueName As String = String.Empty
Friend Property TrueName As String
Get
Return _TrueName.IfNullOrEmpty(Name)
End Get
Set(ByVal NewName As String)
_TrueName = NewName
End Set
End Property
#End Region #End Region
#Region "Exchange" #Region "Exchange"
Friend Overrides Function ExchangeOptionsGet() As Object Friend Overrides Function ExchangeOptionsGet() As Object
@@ -98,7 +89,6 @@ Namespace API.TikTok
TitleAddVideoID = .Value(Name_TitleAddVideoID).FromXML(Of Boolean)(True) TitleAddVideoID = .Value(Name_TitleAddVideoID).FromXML(Of Boolean)(True)
LastDownloadDate = AConvert(Of Date)(.Value(Name_LastDownloadDate), ADateTime.Formats.BaseDateTime, Nothing) LastDownloadDate = AConvert(Of Date)(.Value(Name_LastDownloadDate), ADateTime.Formats.BaseDateTime, Nothing)
If Not LastDownloadDate.HasValue Then LastDownloadDate = LastUpdated If Not LastDownloadDate.HasValue Then LastDownloadDate = LastUpdated
_TrueName = .Value(Name_TrueName)
TitleUseRegexForTitle = .Value(Name_TitleUseRegexForTitle).FromXML(Of Boolean)(False) TitleUseRegexForTitle = .Value(Name_TitleUseRegexForTitle).FromXML(Of Boolean)(False)
TitleUseRegexForTitle_Value = .Value(Name_TitleUseRegexForTitle_Value) TitleUseRegexForTitle_Value = .Value(Name_TitleUseRegexForTitle_Value)
TitleUseGlobalRegexOptions = .Value(Name_TitleUseGlobalRegexOptions).FromXML(Of Boolean)(True) TitleUseGlobalRegexOptions = .Value(Name_TitleUseGlobalRegexOptions).FromXML(Of Boolean)(True)
@@ -107,7 +97,6 @@ Namespace API.TikTok
.Add(Name_TitleUseNative, TitleUseNative.BoolToInteger) .Add(Name_TitleUseNative, TitleUseNative.BoolToInteger)
.Add(Name_TitleAddVideoID, TitleAddVideoID.BoolToInteger) .Add(Name_TitleAddVideoID, TitleAddVideoID.BoolToInteger)
.Add(Name_LastDownloadDate, AConvert(Of String)(LastDownloadDate, AModes.XML, ADateTime.Formats.BaseDateTime, String.Empty)) .Add(Name_LastDownloadDate, AConvert(Of String)(LastDownloadDate, AModes.XML, ADateTime.Formats.BaseDateTime, String.Empty))
.Add(Name_TrueName, _TrueName)
.Add(Name_TitleUseRegexForTitle, TitleUseRegexForTitle.BoolToInteger) .Add(Name_TitleUseRegexForTitle, TitleUseRegexForTitle.BoolToInteger)
.Add(Name_TitleUseRegexForTitle_Value, TitleUseRegexForTitle_Value) .Add(Name_TitleUseRegexForTitle_Value, TitleUseRegexForTitle_Value)
.Add(Name_TitleUseGlobalRegexOptions, TitleUseGlobalRegexOptions.BoolToInteger) .Add(Name_TitleUseGlobalRegexOptions, TitleUseGlobalRegexOptions.BoolToInteger)
@@ -174,7 +163,7 @@ Namespace API.TikTok
UserCache = Nothing UserCache = Nothing
End Sub End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim URL$ = $"https://www.tiktok.com/@{TrueName}" Dim URL$ = $"https://www.tiktok.com/@{NameTrue}"
UserCache = CreateCache() UserCache = CreateCache()
Try Try
Dim postID$, title$, postUrl$, newName$ Dim postID$, title$, postUrl$, newName$
@@ -232,10 +221,7 @@ Namespace API.TikTok
If Not ID.IsEmptyString Then _ForceSaveUserInfo = True If Not ID.IsEmptyString Then _ForceSaveUserInfo = True
End If End If
newName = j.Value("uploader") newName = j.Value("uploader")
If Not newName.IsEmptyString Then If Not newName.IsEmptyString Then NameTrue = newName
If Not _TrueName = newName Then _ForceSaveUserInfo = True
_TrueName = newName
End If
newName = j.Value("creator") newName = j.Value("creator")
If Not newName.IsEmptyString Then UserSiteName = newName If Not newName.IsEmptyString Then UserSiteName = newName
End If End If

View File

@@ -7,7 +7,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 System.Globalization Imports System.Globalization
Imports PersonalUtilities.Functions.XML.Base Imports System.Text.RegularExpressions
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Twitter Namespace API.Twitter
Friend Module Declarations Friend Module Declarations
@@ -16,6 +16,9 @@ Namespace API.Twitter
Friend ReadOnly DateProvider As ADateTime = GetDateProvider() Friend ReadOnly DateProvider As ADateTime = GetDateProvider()
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 GdlLimitRegEx As RParams = RParams.DM("Waiting until[\s\W\d\:]+\(rate limit\)", 0, RegexOptions.IgnoreCase, EDP.ReturnValue)
Friend ReadOnly GdlPostCoutNumberNodes As String() = {"data", "user", "result", "legacy", "statuses_count"}
Private Function GetDateProvider() As ADateTime Private Function GetDateProvider() As ADateTime
Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone
n.FullDateTimePattern = "ddd MMM dd HH:mm:ss +ffff yyyy" n.FullDateTimePattern = "ddd MMM dd HH:mm:ss +ffff yyyy"

View File

@@ -9,9 +9,9 @@
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports DModels = SCrawler.API.Twitter.UserData.DownloadModels Imports DModels = SCrawler.API.Twitter.UserData.DownloadModels
Namespace API.Twitter Namespace API.Twitter
Friend Class EditorExchangeOptions Friend Class EditorExchangeOptions : Inherits Base.EditorExchangeOptionsBase
Private Const DefaultOffset As Integer = 100 Private Const DefaultOffset As Integer = 100
Friend Property SiteKey As String = TwitterSiteKey Friend Overrides Property SiteKey As String = TwitterSiteKey
<PSetting(NameOf(SiteSettings.GifsDownload), NameOf(MySettings), LeftOffset:=DefaultOffset)> <PSetting(NameOf(SiteSettings.GifsDownload), NameOf(MySettings), LeftOffset:=DefaultOffset)>
Friend Property GifsDownload As Boolean Friend Property GifsDownload As Boolean
<PSetting(NameOf(SiteSettings.GifsSpecialFolder), NameOf(MySettings), LeftOffset:=DefaultOffset)> <PSetting(NameOf(SiteSettings.GifsSpecialFolder), NameOf(MySettings), LeftOffset:=DefaultOffset)>
@@ -42,6 +42,10 @@ Namespace API.Twitter
Caption:="Download model 'Likes'", Caption:="Download model 'Likes'",
ToolTip:="Download the data using the 'https://x.com/UserName/likes' command.", LeftOffset:=DefaultOffset)> ToolTip:="Download the data using the 'https://x.com/UserName/likes' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelLikes As Boolean = False Friend Overridable Property DownloadModelLikes As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Download 'Broadcasts'",
ToolTip:="Download broadcasts posted by the user using the 'https://x.com/i/broadcasts/abcdef1234567' URLs", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadBroadcasts As Boolean = False
<PSetting(Address:=SettingAddress.User, <PSetting(Address:=SettingAddress.User,
Caption:="Force apply", Caption:="Force apply",
ToolTip:="Force overrides the default parameters for the first download." & vbCr & "Applies to first download only.", LeftOffset:=DefaultOffset)> ToolTip:="Force overrides the default parameters for the first download." & vbCr & "Applies to first download only.", LeftOffset:=DefaultOffset)>
@@ -64,6 +68,7 @@ Namespace API.Twitter
MySettings = s MySettings = s
End Sub End Sub
Friend Sub New(ByVal u As UserData) Friend Sub New(ByVal u As UserData)
MyBase.New(u)
GifsDownload = u.GifsDownload GifsDownload = u.GifsDownload
GifsSpecialFolder = u.GifsSpecialFolder GifsSpecialFolder = u.GifsSpecialFolder
GifsPrefix = u.GifsPrefix GifsPrefix = u.GifsPrefix
@@ -72,6 +77,7 @@ Namespace API.Twitter
MediaModelAllowNonUserTweets = u.MediaModelAllowNonUserTweets MediaModelAllowNonUserTweets = u.MediaModelAllowNonUserTweets
If Not TypeOf u Is Mastodon.UserData Then If Not TypeOf u Is Mastodon.UserData Then
DownloadModelForceApply = u.DownloadModelForceApply DownloadModelForceApply = u.DownloadModelForceApply
DownloadBroadcasts = u.DownloadBroadcasts
Dim dm As DModels() = EnumExtract(Of DModels)(u.DownloadModel) Dim dm As DModels() = EnumExtract(Of DModels)(u.DownloadModel)
If dm.ListExists Then If dm.ListExists Then
DownloadModelMedia = dm.Contains(DModels.Media) DownloadModelMedia = dm.Contains(DModels.Media)

View File

@@ -11,14 +11,50 @@ Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports DN = SCrawler.API.Base.DeclaredNames Imports DN = SCrawler.API.Base.DeclaredNames
Imports IG = SCrawler.API.Instagram.SiteSettings
Namespace API.Twitter Namespace API.Twitter
<Manifest(TwitterSiteKey), SavedPosts, SeparatedTasks, SpecialForm(False)> <Manifest(TwitterSiteKey), SavedPosts, SeparatedTasks, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
#Region "Icon"
<PXML("UseNewIcon")> Private ReadOnly Property UseNewIconXML As PropertyValue
<PropertyOption(ControlText:="Use the new Twitter icon (X)", ControlToolTip:="Restart SCrawler to take effect")>
Private ReadOnly Property UseNewIcon As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
Return DirectCast(DefaultInstance, SiteSettings).UseNewIconXML
Else
Return UseNewIconXML
End If
End Get
End Property
Private Sub UpdateIcon()
If CBool(UseNewIcon.Value) Then _Icon = My.Resources.SiteResources.TwitterIconNew_32 : _Image = _Icon.ToBitmap
End Sub
#End Region
#Region "Categories" #Region "Categories"
Private Const CAT_DOWN As String = "Downloading" Private Const CAT_DOWN As String = "Downloading"
#End Region #End Region
#Region "Auth"
<PropertyOption(ControlText:="Update cookies", ControlToolTip:="Update cookies during requests", IsAuth:=True), PXML, PClonable, HiddenControl>
Friend ReadOnly Property CookiesUpdate As PropertyValue
<PropertyOption(ControlText:="Use UserAgent", ControlToolTip:="Use UserAgent in requests", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property UserAgentUse As PropertyValue
<PropertyOption(ControlText:="UserAgent", IsAuth:=True, AllowNull:=True, InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent),
PXML("UserAgent", OnlyForChecked:=True), PClonable>
Private ReadOnly Property UserAgentXML As PropertyValue
Friend ReadOnly Property UserAgent As String
Get
If CBool(UserAgentUse.Value) AndAlso Not CStr(UserAgentXML.Value).IsEmptyString Then
Return UserAgentXML.Value
Else
Return String.Empty
End If
End Get
End Property
#End Region
#Region "Other properties" #Region "Other properties"
<PropertyOption(ControlText:="Use the appropriate model", <PropertyOption(ControlText:="Use the appropriate model",
ControlToolTip:="Use the appropriate model for new users." & vbCr & ControlToolTip:="Use the appropriate model for new users." & vbCr &
@@ -35,10 +71,30 @@ Namespace API.Twitter
Friend Property UseNewEndPointProfiles As PropertyValue Friend Property UseNewEndPointProfiles As PropertyValue
#End Region #End Region
#Region "Limits" #Region "Limits"
Friend Const TimerDisabled As Integer = -1
Friend Const TimerFirstUseTheSame As Integer = -2
<PropertyOption(ControlText:="Abort on limit", ControlToolTip:="Abort twitter downloading when limit is reached", Category:=CAT_DOWN), PXML, PClonable> <PropertyOption(ControlText:="Abort on limit", ControlToolTip:="Abort twitter downloading when limit is reached", Category:=CAT_DOWN), PXML, PClonable>
Friend Property AbortOnLimit As PropertyValue Friend Property AbortOnLimit As PropertyValue
<PropertyOption(ControlText:="Download already parsed", ControlToolTip:="Download already parsed content on abort", Category:=CAT_DOWN), PXML, PClonable> <PropertyOption(ControlText:="Download already parsed", ControlToolTip:="Download already parsed content on abort", Category:=CAT_DOWN), PXML, PClonable>
Friend Property DownloadAlreadyParsed As PropertyValue Friend Property DownloadAlreadyParsed As PropertyValue
#End Region
#Region "Timers"
<PropertyOption(ControlText:="Sleep timer",
ControlToolTip:="Use sleep timer in requests." & vbCr &
"You can set a timer value (in seconds) to wait before each subsequent request." & vbCr &
"-1 to disable and use the default algorithm." & vbCr &
"Default: 20", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property SleepTimer As PropertyValue
<Provider(NameOf(SleepTimer), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerProvider As IFormatProvider
<PropertyOption(ControlText:="Sleep timer at start",
ControlToolTip:="Set a sleep timer (in seconds) before the first request." & vbCr &
"-1 to disable" & vbCr &
"-2 to use the 'Sleep timer' value" & vbCr &
"Default: -2", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property SleepTimerBeforeFirst As PropertyValue
<Provider(NameOf(SleepTimerBeforeFirst), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerBeforeFirstProvider As IFormatProvider
#End Region #End Region
<PropertyOption(ControlText:="Media Model: allow non-user tweets", ControlToolTip:="Allow downloading non-user tweets in the media-model.", Category:=DN.CAT_UserDefs), PXML, PClonable> <PropertyOption(ControlText:="Media Model: allow non-user tweets", ControlToolTip:="Allow downloading non-user tweets in the media-model.", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property MediaModelAllowNonUserTweets As PropertyValue Friend ReadOnly Property MediaModelAllowNonUserTweets As PropertyValue
@@ -76,7 +132,17 @@ Namespace API.Twitter
<Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)> <Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)>
Private ReadOnly Property MyConcurrentDownloadsProvider As IFormatProvider Private ReadOnly Property MyConcurrentDownloadsProvider As IFormatProvider
#End Region #End Region
Friend Overrides Property DefaultInstance As ISiteSettings
Get
Return MyBase.DefaultInstance
End Get
Set(ByVal Instance As ISiteSettings)
MyBase.DefaultInstance = Instance
If Not Instance Is Nothing Then UpdateIcon()
End Set
End Property
#End Region #End Region
#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(TwitterSite, "x.com", AccName, Temp, My.Resources.SiteResources.TwitterIcon_32, My.Resources.SiteResources.TwitterIcon_32.ToBitmap) MyBase.New(TwitterSite, "x.com", AccName, Temp, My.Resources.SiteResources.TwitterIcon_32, My.Resources.SiteResources.TwitterIcon_32.ToBitmap)
@@ -87,11 +153,28 @@ Namespace API.Twitter
.Cookies.Changed = False .Cookies.Changed = False
End With End With
UseNewIconXML = New PropertyValue(False)
CookiesUpdate = New PropertyValue(False)
UserAgentUse = New PropertyValue(True)
UserAgentXML = New PropertyValue(If(Responser.UserAgentExists, Responser.UserAgent, String.Empty), GetType(String),
Sub(ByVal Value As Object)
Responser.UserAgent = CStr(Value)
Responser.SaveSettings(, EDP.ReturnValue)
End Sub)
UseAppropriateModel = New PropertyValue(True) UseAppropriateModel = New PropertyValue(True)
UseNewEndPointSearch = New PropertyValue(True) UseNewEndPointSearch = New PropertyValue(True)
UseNewEndPointProfiles = New PropertyValue(True) UseNewEndPointProfiles = New PropertyValue(True)
AbortOnLimit = New PropertyValue(True) AbortOnLimit = New PropertyValue(True)
DownloadAlreadyParsed = New PropertyValue(True) DownloadAlreadyParsed = New PropertyValue(True)
SleepTimer = New PropertyValue(TimerDisabled)
SleepTimerProvider = New IG.TimersChecker(TimerDisabled)
SleepTimerBeforeFirst = New PropertyValue(TimerFirstUseTheSame)
SleepTimerBeforeFirstProvider = New IG.TimersChecker(TimerFirstUseTheSame)
MediaModelAllowNonUserTweets = New PropertyValue(False) MediaModelAllowNonUserTweets = New PropertyValue(False)
GifsDownload = New PropertyValue(True) GifsDownload = New PropertyValue(True)
GifsSpecialFolder = New PropertyValue(String.Empty, GetType(String)) GifsSpecialFolder = New PropertyValue(String.Empty, GetType(String))
@@ -101,27 +184,60 @@ Namespace API.Twitter
ConcurrentDownloads = New PropertyValue(1) ConcurrentDownloads = New PropertyValue(1)
MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "/(twitter|x).com/"), 2) _AllowUserAgentUpdate = False
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, $"/(twitter|x).com({CommunitiesUser}|)/"), 3)
UrlPatternUser = "https://x.com/{0}" UrlPatternUser = "https://x.com/{0}"
ImageVideoContains = "twitter" ImageVideoContains = "twitter"
CheckNetscapeCookiesOnEndInit = True CheckNetscapeCookiesOnEndInit = True
UseNetscapeCookies = True UseNetscapeCookies = True
End Sub End Sub
Friend Overrides Sub EndInit()
UpdateIcon()
MyBase.EndInit()
End Sub
#End Region
#Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData Return New UserData
End Function End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String #End Region
Return $"https://x.com/{User.Name}/status/{Media.Post.ID}" #Region "BaseAuthExists, Available"
End Function
Friend Overrides Function BaseAuthExists() As Boolean Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists Return Responser.CookiesExists
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
Return Settings.GalleryDLFile.Exists And BaseAuthExists() Return Settings.GalleryDLFile.Exists And BaseAuthExists()
End Function End Function
#End Region
#Region "Download"
Friend Property LIMIT_ABORT As Boolean = False Friend Property LIMIT_ABORT As Boolean = False
Friend ReadOnly Property LimitSkippedUsers As List(Of UserDataBase) Friend ReadOnly Property LimitSkippedUsers As List(Of UserDataBase)
Friend Property UserNumber As Integer = -1
Friend Overrides Sub DownloadStarted(ByVal What As ISiteSettings.Download)
UserNumber = 0
MyBase.DownloadStarted(What)
End Sub
Friend Overrides Sub AfterDownload(ByVal User As Object, ByVal What As ISiteSettings.Download)
If Not User Is Nothing AndAlso DirectCast(User, UserData).GDL_REQUESTS_COUNT > 0 Then UserNumber += 1
MyBase.AfterDownload(User, What)
End Sub
Friend Overrides Sub DownloadDone(ByVal What As ISiteSettings.Download) Friend Overrides Sub DownloadDone(ByVal What As ISiteSettings.Download)
If UserNumber > 0 Then
If CBool(CookiesUpdate.Value) Then
With CookieKeeper.ParseNetscapeText(CookiesNetscapeFile.GetText(EDP.ReturnValue), EDP.ReturnValue)
If .ListExists Then
Responser.Cookies.Clear()
Responser.Cookies.AddRange(.Self,, EDP.ReturnValue)
Responser.SaveCookies(EDP.ReturnValue)
Else
Update_SaveCookiesNetscape(True)
End If
End With
Else
Update_SaveCookiesNetscape(True)
End If
End If
UserNumber = -1
If LimitSkippedUsers.Count > 0 Then If LimitSkippedUsers.Count > 0 Then
With LimitSkippedUsers With LimitSkippedUsers
If .Count = 1 Then If .Count = 1 Then
@@ -136,6 +252,8 @@ Namespace API.Twitter
LIMIT_ABORT = False LIMIT_ABORT = False
MyBase.DownloadDone(What) MyBase.DownloadDone(What)
End Sub End Sub
#End Region
#Region "UserOptions, Update"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse (Not TypeOf Options Is EditorExchangeOptions OrElse If Options Is Nothing OrElse (Not TypeOf Options Is EditorExchangeOptions OrElse
Not DirectCast(Options, EditorExchangeOptions).SiteKey = TwitterSiteKey) Then _ Not DirectCast(Options, EditorExchangeOptions).SiteKey = TwitterSiteKey) Then _
@@ -151,5 +269,32 @@ Namespace API.Twitter
End If End If
MyBase.Update() MyBase.Update()
End Sub End Sub
#End Region
#Region "IsMyUser, IsMyImageVideo, GetUserPostUrl, GetUserUrl"
Friend Const CommunitiesUser As String = "/i/communities"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim e As ExchangeOptions = MyBase.IsMyUser(UserURL)
If Not e.UserName.IsEmptyString Then
If UserURL.Contains(CommunitiesUser) Then e.Options = CommunitiesUser : e.UserName &= "@c"
Return e
Else
Return Nothing
End If
End Function
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
If Not URL.IsEmptyString AndAlso (URL.Contains("twitter") Or URL.Contains("x.com")) Then
Return New ExchangeOptions(Site, String.Empty) With {.Exists = True}
Else
Return Nothing
End If
End Function
Friend Const SinglePostPattern As String = "https://x.com/i/web/status/{0}"
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return String.Format(SinglePostPattern, Media.Post.ID)
End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider) As String
Return DirectCast(User, UserData).GetUserUrl
End Function
#End Region
End Class End Class
End Namespace End Namespace

View File

@@ -7,6 +7,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 System.Threading Imports System.Threading
Imports System.Text.RegularExpressions
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
@@ -16,6 +17,7 @@ Imports PersonalUtilities.Tools.Web.Documents
Imports PersonalUtilities.Tools.Web.Documents.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports PKV = SCrawler.API.Instagram.UserData.PostKV
Namespace API.Twitter Namespace API.Twitter
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
#Region "XML names" #Region "XML names"
@@ -23,11 +25,21 @@ Namespace API.Twitter
Private Const Name_DownloadModel As String = "DownloadModel" Private Const Name_DownloadModel As String = "DownloadModel"
Private Const Name_DownloadModelForceApply As String = "DownloadModelForceApply" Private Const Name_DownloadModelForceApply As String = "DownloadModelForceApply"
Private Const Name_MediaModelAllowNonUserTweets As String = "MediaModelAllowNonUserTweets" Private Const Name_MediaModelAllowNonUserTweets As String = "MediaModelAllowNonUserTweets"
Private Const Name_DownloadBroadcasts As String = "DownloadBroadcasts"
Private Const Name_GifsDownload As String = "GifsDownload" Private Const Name_GifsDownload As String = "GifsDownload"
Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder" Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder"
Private Const Name_GifsPrefix As String = "GifsPrefix" Private Const Name_GifsPrefix As String = "GifsPrefix"
Private Const Name_IsCommunity As String = "IsCommunity"
Private Const Name_DownloadModelChanged As String = "DownloadModelChanged"
#End Region #End Region
#Region "Declarations" #Region "Declarations"
Private Const BroadCastPartUrl As String = "i/broadcasts"
Private Const Label_Community As String = "Community"
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {Label_Community}
End Get
End Property
Friend Enum DownloadModels As Integer Friend Enum DownloadModels As Integer
Undefined = 0 Undefined = 0
Media = 1 Media = 1
@@ -38,11 +50,20 @@ Namespace API.Twitter
Private FirstDownloadComplete As Boolean = False Private FirstDownloadComplete As Boolean = False
Friend Property DownloadModelForceApply As Boolean = False Friend Property DownloadModelForceApply As Boolean = False
Friend Property DownloadModel As DownloadModels = DownloadModels.Undefined Friend Property DownloadModel As DownloadModels = DownloadModels.Undefined
Private ReadOnly Property IsMultiMode As Boolean
Get
Return EnumExtract(Of DownloadModels)(DownloadModel).ListIfNothing.Count > 1
End Get
End Property
Private Property DownloadModelChanged As Boolean = False
Friend Property MediaModelAllowNonUserTweets As Boolean = False Friend Property MediaModelAllowNonUserTweets As Boolean = False
Friend Property DownloadBroadcasts As Boolean = False
Friend Property GifsDownload As Boolean = True Friend Property GifsDownload As Boolean = True
Friend Property GifsSpecialFolder As String = String.Empty Friend Property GifsSpecialFolder As String = String.Empty
Friend Property GifsPrefix As String = String.Empty Friend Property GifsPrefix As String = String.Empty
Friend Property IsCommunity As Boolean = False
Private ReadOnly LikesPosts As List(Of String) Private ReadOnly LikesPosts As List(Of String)
Private ReadOnly PostsKV As List(Of PKV)
Private ReadOnly _DataNames As List(Of String) Private ReadOnly _DataNames As List(Of String)
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Get Get
@@ -57,6 +78,9 @@ Namespace API.Twitter
Private Function RenameGdlFile(ByVal Input As SFile, ByVal i As Integer) As SFile 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) Return SFile.Rename(Input, $"{Input.PathWithSeparator}{i.NumToString(FileNameProvider)}.{Input.Extension}",, EDP.ThrowException)
End Function End Function
Friend Function GetUserUrl() As String
Return $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/{NameTrue}"
End Function
#End Region #End Region
#Region "Exchange options" #Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object Friend Overrides Function ExchangeOptionsGet() As Object
@@ -70,13 +94,18 @@ Namespace API.Twitter
GifsPrefix = .GifsPrefix GifsPrefix = .GifsPrefix
UseMD5Comparison = .UseMD5Comparison UseMD5Comparison = .UseMD5Comparison
RemoveExistingDuplicates = .RemoveExistingDuplicates RemoveExistingDuplicates = .RemoveExistingDuplicates
If RemoveExistingDuplicates Then StartMD5Checked = False
DownloadModel = DownloadModels.Undefined DownloadModel = DownloadModels.Undefined
DownloadModelForceApply = .DownloadModelForceApply DownloadModelForceApply = .DownloadModelForceApply
MediaModelAllowNonUserTweets = .MediaModelAllowNonUserTweets MediaModelAllowNonUserTweets = .MediaModelAllowNonUserTweets
DownloadBroadcasts = .DownloadBroadcasts
Dim dModel As DownloadModels = DownloadModel
If .DownloadModelMedia Then DownloadModel += DownloadModels.Media If .DownloadModelMedia Then DownloadModel += DownloadModels.Media
If .DownloadModelProfile Then DownloadModel += DownloadModels.Profile If .DownloadModelProfile Or .DownloadBroadcasts Then DownloadModel += DownloadModels.Profile
If .DownloadModelSearch Then DownloadModel += DownloadModels.Search If .DownloadModelSearch Then DownloadModel += DownloadModels.Search
If .DownloadModelLikes Then DownloadModel += DownloadModels.Likes If .DownloadModelLikes Then DownloadModel += DownloadModels.Likes
If Not dModel = DownloadModel Then DownloadModelChanged = True
NameTrue = .UserName
End With End With
End If End If
End Sub End Sub
@@ -85,11 +114,15 @@ Namespace API.Twitter
Friend Sub New() Friend Sub New()
_DataNames = New List(Of String) _DataNames = New List(Of String)
LikesPosts = New List(Of String) LikesPosts = New List(Of String)
PostsKV = New List(Of PKV)
UseInternalM3U8Function = True
End Sub 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 With Container
If Loading Then If Loading Then
DownloadBroadcasts = .Value(Name_DownloadBroadcasts).FromXML(Of Boolean)(False)
DownloadModelForceApply = .Value(Name_DownloadModelForceApply).FromXML(Of Boolean)(False) DownloadModelForceApply = .Value(Name_DownloadModelForceApply).FromXML(Of Boolean)(False)
DownloadModelChanged = .Value(Name_DownloadModelChanged).FromXML(Of Boolean)(False)
If .Contains(Name_FirstDownloadComplete) Then If .Contains(Name_FirstDownloadComplete) Then
FirstDownloadComplete = .Value(Name_FirstDownloadComplete).FromXML(Of Boolean)(False) FirstDownloadComplete = .Value(Name_FirstDownloadComplete).FromXML(Of Boolean)(False)
DownloadModel = .Value(Name_DownloadModel).FromXML(Of Integer)(DownloadModels.Undefined) DownloadModel = .Value(Name_DownloadModel).FromXML(Of Integer)(DownloadModels.Undefined)
@@ -121,10 +154,24 @@ Namespace API.Twitter
RemoveExistingDuplicates = .Value(Name_RemoveExistingDuplicates).FromXML(Of Boolean)(False) RemoveExistingDuplicates = .Value(Name_RemoveExistingDuplicates).FromXML(Of Boolean)(False)
StartMD5Checked = .Value(Name_StartMD5Checked).FromXML(Of Boolean)(False) StartMD5Checked = .Value(Name_StartMD5Checked).FromXML(Of Boolean)(False)
MediaModelAllowNonUserTweets = .Value(Name_MediaModelAllowNonUserTweets).FromXML(Of Boolean)(False) MediaModelAllowNonUserTweets = .Value(Name_MediaModelAllowNonUserTweets).FromXML(Of Boolean)(False)
IsCommunity = .Value(Name_IsCommunity).FromXML(Of Boolean)(False)
Else Else
If Name.Contains("@") And Not IsCommunity Then
IsCommunity = True
NameTrue = Name.Split("@")(0)
ID = NameTrue
ParseUserMediaOnly = False
Labels.ListAddValue(Label_Community, LNC)
Labels.Sort()
.Add(Name_UserID, ID)
.Add(Name_LabelsName, LabelsString)
.Add(Name_ParseUserMediaOnly, ParseUserMediaOnly.BoolToInteger)
End If
.Add(Name_FirstDownloadComplete, FirstDownloadComplete.BoolToInteger) .Add(Name_FirstDownloadComplete, FirstDownloadComplete.BoolToInteger)
.Add(Name_DownloadModelForceApply, DownloadModelForceApply.BoolToInteger) .Add(Name_DownloadModelForceApply, DownloadModelForceApply.BoolToInteger)
.Add(Name_DownloadModelChanged, DownloadModelChanged.BoolToInteger)
.Add(Name_DownloadModel, CInt(DownloadModel)) .Add(Name_DownloadModel, CInt(DownloadModel))
.Add(Name_DownloadBroadcasts, DownloadBroadcasts.BoolToInteger)
.Add(Name_GifsDownload, GifsDownload.BoolToInteger) .Add(Name_GifsDownload, GifsDownload.BoolToInteger)
.Add(Name_GifsSpecialFolder, GifsSpecialFolder) .Add(Name_GifsSpecialFolder, GifsSpecialFolder)
.Add(Name_GifsPrefix, GifsPrefix) .Add(Name_GifsPrefix, GifsPrefix)
@@ -132,6 +179,8 @@ Namespace API.Twitter
.Add(Name_RemoveExistingDuplicates, RemoveExistingDuplicates.BoolToInteger) .Add(Name_RemoveExistingDuplicates, RemoveExistingDuplicates.BoolToInteger)
.Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger) .Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger)
.Add(Name_MediaModelAllowNonUserTweets, MediaModelAllowNonUserTweets.BoolToInteger) .Add(Name_MediaModelAllowNonUserTweets, MediaModelAllowNonUserTweets.BoolToInteger)
.Add(Name_IsCommunity, IsCommunity.BoolToInteger)
.Add(Name_TrueName, NameTrue(True))
End If End If
End With End With
End Sub End Sub
@@ -145,8 +194,72 @@ Namespace API.Twitter
{{"item", "itemContent", "tweet_results", "result", "tweet", "legacy"}} {{"item", "itemContent", "tweet_results", "result", "tweet", "legacy"}}
} }
End Function End Function
Private Function ExtractBroadcast(ByVal e As EContainer, Optional ByVal PostID As String = Nothing, Optional ByVal PostDate As String = Nothing,
Optional ByVal Nodes As List(Of String()) = Nothing,
Optional ByVal IgnoreNodes As Boolean = False) As UserMedia
If e.ListExists Then
Dim __nodes As List(Of String()) = If(Nodes, GetContainerSubnodes())
Dim urlValue$
Dim m As UserMedia = Nothing
Dim __parseContainer As Func(Of EContainer, Boolean) =
Function(ByVal ee As EContainer) As Boolean
With ee
If .ListExists Then
urlValue = .ItemF(BroadcastsUrls, EDP.ReturnValue).XmlIfNothingValue
If Not urlValue.IsEmptyString AndAlso urlValue.Contains(BroadCastPartUrl) Then
m = MediaFromData(urlValue, PostID, PostDate,,, UTypes.m3u8)
If Not IsSingleObjectDownload Then m.SpecialFolder = "Broadcasts*"
Return True
End If
End If
End With
Return False
End Function
If IgnoreNodes Then
If __parseContainer(e) Then Return m
Else
For Each n As String() In __nodes
If __parseContainer(e(n)) Then Return m
Next
End If
m = ExtractBroadcast(e.ItemF(Of Object)({0}), PostID, PostDate, Nodes)
If Not m.URL.IsEmptyString Then Return m
End If
Return Nothing
End Function
Private ReadOnly Property MyFilePostsKV As SFile
Get
Dim f As SFile = MyFilePosts
If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
Return f
Else
Return Nothing
End If
End Get
End Property
Protected Sub LoadSavePostsKV(ByVal Load As Boolean)
Instagram.UserData.LoadSavePostsKV(Load, MyFilePostsKV, PostsKV)
End Sub
Private Function PostKVExists(ByVal PID As String, ByVal Model As DownloadModels,
ByVal MultiMode As Boolean, ByVal IgnorePKV As Boolean, ByVal AutoAdd As Boolean) As Boolean
Dim result As Boolean
If IgnorePKV Or PostsKV.Count = 0 Then
result = _TempPostsList.Contains(PID)
Else
result = PostsKV.Contains(New PKV(PID, PID, Model)) Or (Not MultiMode AndAlso _TempPostsList.Contains(PID))
End If
If Not result And AutoAdd Then
PostsKV.ListAddValue(New PKV(PID, PID, Model), LNC)
_TempPostsList.ListAddValue(PID, LNC)
End If
Return result
End Function
Friend Property GDL_REQUESTS_COUNT As Integer = 0
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try Try
GDL_REQUESTS_COUNT = 0
If MySettings.LIMIT_ABORT Then If MySettings.LIMIT_ABORT Then
Throw New TwitterLimitException(Me) Throw New TwitterLimitException(Me)
Else Else
@@ -154,9 +267,17 @@ Namespace API.Twitter
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.Post.ID), LAP.ClearBeforeAdd, LAP.NotContainsOnly) If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.Post.ID), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData_SavedPosts(Token) DownloadData_SavedPosts(Token)
Else Else
LoadSavePostsKV(True)
If PostsKV.Count = 0 And (_ContentList.Count > 0 Or _TempPostsList.Count > 0) Then
Dim m As DownloadModels = IIf(IsMultiMode, DownloadModels.Media, DownloadModel)
PostsKV.ListAddList(_TempPostsList.Select(Function(p) New PKV(p, p, m)), LNC)
PostsKV.ListAddList(_ContentList.Select(Function(p) New PKV(p.Post.ID, p.Post.ID, m)), LNC)
_ForceSaveUserData = True
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)
DownloadData_Timeline(Token) DownloadData_Timeline(Token)
LoadSavePostsKV(False)
If LikesPosts.Count > 0 Then If LikesPosts.Count > 0 Then
_ReparseLikes = True _ReparseLikes = True
ReparseMissing(Token) ReparseMissing(Token)
@@ -188,14 +309,17 @@ Namespace API.Twitter
Dim newTwitterNodes() As Object = {0, "content", "items"} Dim newTwitterNodes() As Object = {0, "content", "items"}
Dim p As Predicate(Of EContainer) Dim p As Predicate(Of EContainer)
Dim pIndx% Dim pIndx%
Dim indxChanged As Boolean = False
Dim isOneNode As Boolean, isPins As Boolean, ExistsDetected As Boolean, userInfoParsed As Boolean = False Dim isOneNode As Boolean, isPins As Boolean, ExistsDetected As Boolean, userInfoParsed As Boolean = False
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 currentModel As DownloadModels = DownloadModels.Undefined
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
nn = Nothing nn = Nothing
If dirIndx > 1 Then nn = ee If dirIndx > 1 Or IsCommunity Then nn = ee
If Not nn.ListExists Then If Not nn.ListExists Or IsCommunity Then
For Each node In nodes For Each node In nodes
nn = ee(node) nn = ee(node)
If nn.ListExists Then Exit For If nn.ListExists Then Exit For
@@ -212,14 +336,13 @@ Namespace API.Twitter
Case DateResult.Skip, DateResult.Exit : Return False Case DateResult.Skip, DateResult.Exit : Return False
End Select End Select
If Not _TempPostsList.Contains(PostID) Then If Not PostKVExists(PostID, currentModel, multiMode, False, True) Then
_TempPostsList.Add(PostID)
ElseIf dirIndx = 3 Then ElseIf dirIndx = 3 Then
ElseIf isPins Then ElseIf isPins Then
Return False Return False
Else Else
ExistsDetected = True ExistsDetected = Not multiMode
Return False Return multiMode
End If End If
tmpUserId = nn({"retweeted_status_result", "result", "legacy", "user_id_str"}).XmlIfNothingValue tmpUserId = nn({"retweeted_status_result", "result", "legacy", "user_id_str"}).XmlIfNothingValue
@@ -230,12 +353,21 @@ Namespace API.Twitter
If (Not ParseUserMediaOnly Or dirIndx = 3) OrElse If (Not ParseUserMediaOnly Or dirIndx = 3) OrElse
(dirIndx = 0 AndAlso MediaModelAllowNonUserTweets) OrElse (dirIndx = 0 AndAlso MediaModelAllowNonUserTweets) OrElse
(Not ID.IsEmptyString AndAlso tmpUserId = ID) Then (Not ID.IsEmptyString AndAlso tmpUserId = ID) Then
If dirIndx = 1 And DownloadBroadcasts Then
Dim m As UserMedia = ExtractBroadcast(nn, PostID, PostDate, nodes)
If Not m.URL.IsEmptyString Then
_TempMediaList.ListAddValue(m, LNC)
Else
m = ExtractBroadcast(ee, PostID, PostDate, nodes)
If Not m.URL.IsEmptyString Then _TempMediaList.ListAddValue(m, LNC)
End If
End If
If dirIndx = 3 Then If dirIndx = 3 Then
Dim lUrl$ = nn.ItemF({"content", "itemContent", "tweet_results", "result", "legacy", "entities", "media", 0}, "expanded_url").XmlIfNothingValue Dim lUrl$ = nn.ItemF({"content", "itemContent", "tweet_results", "result", "legacy", "entities", "media", 0}, "expanded_url").XmlIfNothingValue
If Not lUrl.IsEmptyString Then If Not lUrl.IsEmptyString Then
lUrl = RegexReplace(lUrl, StatusRegEx) lUrl = RegexReplace(lUrl, StatusRegEx)
If Not lUrl.IsEmptyString Then If Not lUrl.IsEmptyString Then
If Not _TempPostsList.Contains(lUrl) Then _TempPostsList.Add(lUrl) Else Return False If PostKVExists(lUrl, currentModel, multiMode, False, True) Then Return multiMode
LikesPosts.ListAddValue(lUrl, LNC) LikesPosts.ListAddValue(lUrl, LNC)
End If End If
End If End If
@@ -249,11 +381,23 @@ Namespace API.Twitter
tCache = CreateCache() tCache = CreateCache()
'0 - media
'1 - profile
'2 - search
'3 - likes
Dim dirs As List(Of SFile) = GetTimelineFromGalleryDL(tCache, Token) Dim dirs As List(Of SFile) = GetTimelineFromGalleryDL(tCache, Token)
If dirs.ListExists Then If dirs.ListExists Then
For Each dir As SFile In dirs For Each dir As SFile In dirs
dirIndx += 1 dirIndx += 1
Select Case dirIndx
Case 0 : currentModel = DownloadModels.Media
Case 1 : currentModel = DownloadModels.Profile
Case 2 : currentModel = DownloadModels.Search
Case 3 : currentModel = DownloadModels.Likes
Case Else : currentModel = DownloadModels.Undefined
End Select
If dirIndx = 3 Then likesDetected = True If dirIndx = 3 Then likesDetected = True
ExistsDetected = False ExistsDetected = False
@@ -269,10 +413,12 @@ Namespace API.Twitter
For i = 0 To timelineFiles.Count - 1 For i = 0 To timelineFiles.Count - 1
j = JsonDocument.Parse(timelineFiles(i).GetText) j = JsonDocument.Parse(timelineFiles(i).GetText)
If Not j Is Nothing Then If Not j Is Nothing Then
If i = 0 Then If i = 0 And Not indxChanged Then
If Not userInfoParsed Then If Not userInfoParsed Then
userInfoParsed = True userInfoParsed = True
Dim resValue$ = j.Value({"data", "user", "result"}, "__typename").StringTrim.StringToLower Dim resValue$ = j.Value({"data", IIf(IsCommunity, "communityResults", "user"), "result"}, "__typename").StringTrim.StringToLower
Dim icon$
Dim fileCrFunc As Func(Of String, SFile) = Function(img) UrlFile(img, True)
If resValue.IsEmptyString Then If resValue.IsEmptyString Then
UserExists = False UserExists = False
j.Dispose() j.Dispose()
@@ -281,6 +427,29 @@ Namespace API.Twitter
UserSuspended = True UserSuspended = True
j.Dispose() j.Dispose()
Exit Sub Exit Sub
ElseIf IsCommunity Then
With j({"data", "communityResults", "result", "community_media_timeline", "timeline", "instructions"})
If .ListExists Then
With .Find(entriesNode, True)
If .ListExists Then
With .ItemF({0, "content", "items", 0, "item", "itemContent", "tweet_results", "result", "tweet", "community_results", "result"})
If .ListExists Then
If ID = .Value("id_str") Then
UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description"))
icon = .Value({"custom_banner_media", "media_info"}, "original_img_url").
IfNullOrEmpty(.Value({"default_banner_media", "media_info"}, "original_img_url"))
If Not icon.IsEmptyString And DownloadIconBanner Then SimpleDownloadAvatar(icon, fileCrFunc)
End If
End If
End With
End If
End With
End If
End With
i = -1
indxChanged = True
Else Else
With j({"data", "user", "result"}) With j({"data", "user", "result"})
If .ListExists Then If .ListExists Then
@@ -290,25 +459,15 @@ Namespace API.Twitter
End If End If
With .Item({"legacy"}) With .Item({"legacy"})
If .ListExists Then If .ListExists Then
If .Value("screen_name").StringToLower = Name.ToLower Then If .Value("screen_name").StringToLower = NameTrue.ToLower Then
UserSiteNameUpdate(.Value("name")) UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description")) UserDescriptionUpdate(.Value("description"))
Dim __getImage As Action(Of String) = Sub(ByVal img As String)
If Not img.IsEmptyString Then icon = .Value("profile_image_url_https")
Dim __imgFile As SFile = UrlFile(img, True)
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
Dim 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
__getImage.Invoke(.Value("profile_banner_url")) SimpleDownloadAvatar(.Value("profile_banner_url"), fileCrFunc)
__getImage.Invoke(icon) SimpleDownloadAvatar(icon, fileCrFunc)
End If End If
End If End If
End If End If
@@ -316,38 +475,59 @@ Namespace API.Twitter
End If End If
End With End With
End If End If
ElseIf IsCommunity Then
i = -1
indxChanged = True
End If End If
Else Else
For pIndx = 0 To IIf(dirIndx < 2 Or dirIndx = 3, 1, 0) For pIndx = 0 To IIf(dirIndx < 2 Or dirIndx = 3, 1, 0)
optionalNode = Nothing optionalNode = Nothing
Select Case dirIndx rootNode = Nothing
Case 0, 1, 3 If IsCommunity Then
rootNode = j({"data", "user", "result", "timeline_v2", "timeline", "instructions"}) With j({"data", "communityResults", "result", "community_media_timeline", "timeline", "instructions"})
If rootNode.ListExists Then If .ListExists Then
If dirIndx = 3 Then If i = 0 Then
p = entriesNode rootNode = .Find(entriesNode, True)
isPins = False
Else Else
p = If(pIndx = 0, pinNode, timelineNode) rootNode = .Find(moduleItemsPredicate, True)
isPins = pIndx = 0
End If End If
optionalNode = rootNode optionalNode = rootNode
rootNode = rootNode.Find(p, dirIndx = 3)
If dirIndx <> 3 And rootNode.ListExists Then rootNode = rootNode.Find(entriesNode, dirIndx = 3)
End If End If
Case Else End With
isPins = False Else
rootNode = j({"globalObjects", "tweets"}) Select Case dirIndx
optionalNode = rootNode Case 0, 1, 3
End Select rootNode = j({"data", "user", "result", "timeline_v2", "timeline", "instructions"})
If rootNode.ListExists Then
If dirIndx = 3 Then
p = entriesNode
isPins = False
Else
p = If(pIndx = 0, pinNode, timelineNode)
isPins = pIndx = 0
End If
optionalNode = rootNode
rootNode = rootNode.Find(p, dirIndx = 3)
If dirIndx <> 3 And rootNode.ListExists Then rootNode = rootNode.Find(entriesNode, dirIndx = 3)
End If
Case Else
isPins = False
rootNode = j({"globalObjects", "tweets"})
optionalNode = rootNode
End Select
End If
If rootNode.ListExists Then If rootNode.ListExists Then
With rootNode With rootNode
isOneNode = dirIndx < 2 AndAlso .Name = entry If IsCommunity Then
isOneNode = pIndx = 0
Else
isOneNode = dirIndx < 2 AndAlso .Name = entry
End If
ProgressPre.ChangeMax(If(isOneNode, 1, .Count)) ProgressPre.ChangeMax(If(isOneNode, 1, .Count))
If isOneNode Then If isOneNode Then
ProgressPre.Perform() ProgressPre.Perform()
If Not __parseContainer(.Self) Then Exit For If Not __parseContainer(.Self) Then Continue For 'Exit For
Else Else
For nodeIndx = 0 To 1 For nodeIndx = 0 To 1
If nodeIndx = 0 Then If nodeIndx = 0 Then
@@ -362,17 +542,21 @@ Namespace API.Twitter
.ItemF(newTwitterNodes), .ItemF(newTwitterNodes),
.Self) .Self)
ProgressPre.Perform() ProgressPre.Perform()
If Not __parseContainer(tmpNode) Then Exit For If Not __parseContainer(tmpNode) Then
If isPins Then GoTo nextpIndx
Exit For
End If
Next Next
End With End With
End If End If
nextNodeIndx:
Next Next
End If End If
End With End With
End If End If
nextpIndx:
Next Next
'TODO: Twitter: is this line needed?
If ExistsDetected And i = 1 Then Exit For Else ExistsDetected = False If ExistsDetected And i = 1 Then Exit For Else ExistsDetected = False
End If End If
j.Dispose() j.Dispose()
@@ -390,6 +574,7 @@ Namespace API.Twitter
If DownloadModel = DownloadModels.Undefined Then If DownloadModel = DownloadModels.Undefined Then
If ParseUserMediaOnly Then If ParseUserMediaOnly Then
DownloadModel = DownloadModels.Media DownloadModel = DownloadModels.Media
If DownloadBroadcasts Then DownloadModel += DownloadModels.Profile
Else Else
DownloadModel = DownloadModels.Media + DownloadModels.Profile + DownloadModels.Search DownloadModel = DownloadModels.Media + DownloadModels.Profile + DownloadModels.Search
End If End If
@@ -596,19 +781,87 @@ Namespace API.Twitter
End Sub End Sub
Private Sub CheckForLimit(ByVal Value As String) Private Sub CheckForLimit(ByVal Value As String)
If Token.IsCancellationRequested Or (KillOnLimit AndAlso Not ProcessKilled AndAlso If Token.IsCancellationRequested Or (KillOnLimit AndAlso Not ProcessKilled AndAlso
Not Value.IsEmptyString AndAlso Value.ToLower.Contains("for rate limit reset")) Then Not Value.IsEmptyString AndAlso (Value.ToLower.Contains("for rate limit reset") OrElse
Not CStr(RegexReplace(Value, GdlLimitRegEx)).IsEmptyString)) Then
LimitReached = True LimitReached = True
Kill() Kill()
End If End If
End Sub End Sub
End Class End Class
Private ReadOnly Property SleepTimerValue(ByVal First As Boolean) As Integer
Get
Dim fTimer% = If(First, MySettings.SleepTimerBeforeFirst, MySettings.SleepTimer).Value
If First And fTimer = SiteSettings.TimerFirstUseTheSame Then fTimer = MySettings.SleepTimer.Value
Return fTimer
End Get
End Property
Private ReadOnly Property SleepRequest As String
Get
Dim s% = SleepTimerValue(False)
Return If(s = SiteSettings.TimerDisabled, String.Empty, $" --sleep-request {s}")
End Get
End Property
Private Sub GdlWaitFirstTimer(ByVal fTimer As Integer)
If GDL_REQUESTS_COUNT = 0 And Not fTimer = SiteSettings.TimerDisabled And MySettings.UserNumber > 0 Then Thread.Sleep(fTimer * 1000)
GDL_REQUESTS_COUNT += 1
End Sub
Private _GdlPreProgressPerformEnabled As Boolean = False
Private Sub GdlPreProgressPerform(ByVal Path As SFile, ByVal UpDir As SFile)
Dim f As SFile = Nothing
Try
Dim c% = -1, lb% = -1, cc%
Dim e As New ErrorsDescriber(EDP.ReturnValue)
While _GdlPreProgressPerformEnabled
Thread.Sleep(100)
If c > 0 Then
cc = If(SFile.GetFiles(Path,,, e)?.Count, 0)
If cc > c Then
Exit Sub
ElseIf cc > 0 And (lb = -1 Or cc > lb) Then
ProgressPre.Perform(cc - IIf(lb = -1, 0, lb))
lb = cc
End If
ElseIf Path.Exists(SFO.Path, False) Then
Dim files As List(Of SFile) = SFile.GetFiles(Path,,, e)
If files.ListExists Then
f = files.FirstOrDefault(Function(ff) Not ff.Name.IsEmptyString AndAlso ff.Name.StartsWith("01_"))
If UpDir.Exists(SFO.Path, False) Then
Dim fNew As SFile = $"{UpDir.PathWithSeparator}00.txt"
If f.Copy(fNew,, True, SFODelete.DeletePermanently,, e) Then
f = fNew
Using j As EContainer = JsonDocument.Parse(f.GetText(e), e)
If j.ListExists Then
c = j(GdlPostCoutNumberNodes).XmlIfNothingValue.FromXML(Of Integer)(-1)
If c > 0 Then c /= 30 : ProgressPre.ChangeMax(c) : Continue While
End If
End Using
End If
End If
Exit Sub
End If
End If
End While
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"{ToStringForLog()}:{vbCr}Path: '{Path.Path}'{vbCr}Path 2: '{UpDir.Path}'")
Finally
If f.Exists Then f.Delete(SFO.File, SFODelete.DeletePermanently, EDP.ReturnValue)
End Try
End Sub
Private Sub GdlPreProgressPerformWait(ByVal t As Task)
_GdlPreProgressPerformEnabled = False
Try
While t.Status = TaskStatus.Running Or t.Status = TaskStatus.WaitingToRun : Thread.Sleep(100) : End While
Catch
End Try
End Sub
Private Function GetDataFromGalleryDL(ByVal URL As String, ByVal Cache As CacheKeeper, ByVal UseTempPostList As Boolean, Private Function GetDataFromGalleryDL(ByVal URL As String, ByVal Cache As CacheKeeper, ByVal UseTempPostList As Boolean,
Optional ByVal Token As CancellationToken = Nothing) As SFile Optional ByVal Token As CancellationToken = Nothing) As SFile
Dim command$ = String.Empty Dim command$ = String.Empty
Try Try
Dim conf As SFile = GdlCreateConf(Cache.NewPath) Dim conf As SFile = GdlCreateConf(Cache.NewPath)
command = $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip --config ""{conf}"" --write-pages " Dim fTimer% = SleepTimerValue(True)
command &= GdlGetIdFilterString() command = $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip{SleepRequest} --config ""{conf}"" --write-pages "
'command &= GdlGetIdFilterString()
Dim dir As SFile = Cache.NewPath Dim dir As SFile = Cache.NewPath
If dir.Exists(SFO.Path,, EDP.ThrowException) Then If dir.Exists(SFO.Path,, EDP.ThrowException) Then
Using batch As New TwitterGDL(dir, Token, MySettings.AbortOnLimit.Value) Using batch As New TwitterGDL(dir, Token, MySettings.AbortOnLimit.Value)
@@ -620,6 +873,7 @@ Namespace API.Twitter
'#If DEBUG Then '#If DEBUG Then
'Debug.WriteLine(command) 'Debug.WriteLine(command)
'#End If '#End If
GdlWaitFirstTimer(fTimer)
batch.Execute(command) batch.Execute(command)
If batch.LimitReached Then If batch.LimitReached Then
If CBool(MySettings.DownloadAlreadyParsed.Value) And If CBool(MySettings.DownloadAlreadyParsed.Value) And
@@ -648,7 +902,9 @@ Namespace API.Twitter
Dim conf As SFile = GdlCreateConf(confCache.RootDirectory) Dim conf As SFile = GdlCreateConf(confCache.RootDirectory)
If DownloadModel = DownloadModels.Undefined And Not FirstDownloadComplete And DownloadModelForceApply Then If DownloadModel = DownloadModels.Undefined And Not FirstDownloadComplete And DownloadModelForceApply Then
If ParseUserMediaOnly Then If ParseUserMediaOnly And DownloadBroadcasts Then
DownloadModel = DownloadModels.Media + DownloadModels.Profile
ElseIf ParseUserMediaOnly Then
DownloadModel = DownloadModels.Media DownloadModel = DownloadModels.Media
Else Else
DownloadModel = DownloadModels.Media + DownloadModels.Profile + DownloadModels.Search DownloadModel = DownloadModels.Media + DownloadModels.Profile + DownloadModels.Search
@@ -659,30 +915,40 @@ Namespace API.Twitter
Dim rootDir As CacheKeeper = Cache.NewInstance Dim rootDir As CacheKeeper = Cache.NewInstance
Dim dir As SFile Dim dir As SFile
Dim dm As List(Of DownloadModels) = EnumExtract(Of DownloadModels)(DownloadModel).ListIfNothing Dim dm As List(Of DownloadModels) = EnumExtract(Of DownloadModels)(DownloadModel).ListIfNothing
Dim process As Boolean Dim process As Boolean, multiMode As Boolean
Dim currentModel As DownloadModels
Dim urlPrePattern$ = $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/"
Dim fTimer% = SleepTimerValue(True)
Dim t As Task
If DownloadBroadcasts AndAlso Not dm.Contains(DownloadModels.Profile) Then dm.Add(DownloadModels.Profile)
multiMode = dm.Count > 1
Using tgdl As New TwitterGDL(Nothing, Token, MySettings.AbortOnLimit.Value) With { Using tgdl As New TwitterGDL(Nothing, Token, MySettings.AbortOnLimit.Value) With {
.TempPostsList = _TempPostsList,
.AutoClear = True, .AutoClear = True,
.AutoReset = True, .AutoReset = True,
.CommandPermanent = $"chcp {BatchExecutor.UnicodeEncoding}", .CommandPermanent = $"chcp {BatchExecutor.UnicodeEncoding}",
.FileExchanger = confCache, .FileExchanger = confCache
.DebugMode = True
} }
tgdl.FileExchanger.DeleteCacheOnDispose = False tgdl.FileExchanger.DeleteCacheOnDispose = False
tgdl.FileExchanger.DeleteRootOnDispose = False tgdl.FileExchanger.DeleteRootOnDispose = False
For i As Byte = 0 To 3 For i As Byte = 0 To IIf(IsCommunity, 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)
tgdl.ChangeDirectory(dir) tgdl.ChangeDirectory(dir)
command = $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip --config ""{conf}"" --write-pages " command = $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip{SleepRequest} --config ""{conf}"" --write-pages "
command &= GdlGetIdFilterString() If multiMode Then
command &= "{0}"
Else
command &= GdlGetIdFilterString()
End If
Select Case i Select Case i
Case 0 : command &= $"https://x.com/{Name}/media" : process = dm.Contains(DownloadModels.Media) Case 0 : command &= $"{urlPrePattern}{NameTrue}/media" : currentModel = DownloadModels.Media : process = dm.Contains(currentModel) Or IsCommunity
Case 1 : command &= $"https://x.com/{Name}" : process = dm.Contains(DownloadModels.Profile) Case 1 : command &= $"{urlPrePattern}{NameTrue}" : currentModel = DownloadModels.Profile : process = dm.Contains(currentModel)
Case 2 : command &= $"-o search-endpoint=graphql https://x.com/search?q=from:{Name}+include:nativeretweets" : process = dm.Contains(DownloadModels.Search) Case 2 : command &= $"-o search-endpoint=graphql https://x.com/search?q=from:{NameTrue}+include:nativeretweets" : currentModel = DownloadModels.Search : process = dm.Contains(currentModel) And Not IsCommunity
Case 3 : command &= $"https://x.com/{Name}/likes" : process = dm.Contains(DownloadModels.Likes) 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
'#If DEBUG Then '#If DEBUG Then
@@ -690,7 +956,28 @@ Namespace API.Twitter
'#End If '#End If
ThrowAny(Token) ThrowAny(Token)
If process Then If process Then
If multiMode Then
If PostsKV.Count = 0 Then
tgdl.TempPostsList = New List(Of String)
Else
tgdl.TempPostsList = (From p As PKV In PostsKV Where p.Section = currentModel Select p.ID).ListIfNothing
End If
command = String.Format(command, GdlGetIdFilterString(tgdl.TempPostsList))
Else
tgdl.TempPostsList = _TempPostsList
End If
GdlWaitFirstTimer(fTimer)
_GdlPreProgressPerformEnabled = True
t = New Task(Sub() GdlPreProgressPerform(dir, conf))
t.Start()
tgdl.Execute(command) tgdl.Execute(command)
_GdlPreProgressPerformEnabled = False
GdlPreProgressPerformWait(t)
If tgdl.LimitReached Then If tgdl.LimitReached Then
If CBool(MySettings.DownloadAlreadyParsed.Value) And If CBool(MySettings.DownloadAlreadyParsed.Value) And
SFile.GetFiles(rootDir, "*.txt", IO.SearchOption.AllDirectories, EDP.ReturnValue).Count > 0 Then SFile.GetFiles(rootDir, "*.txt", IO.SearchOption.AllDirectories, EDP.ReturnValue).Count > 0 Then
@@ -713,16 +1000,22 @@ Namespace API.Twitter
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"{ToStringForLog()}: GetTimelineFromGalleryDL({command})") ProcessException(ex, Token, $"{ToStringForLog()}: GetTimelineFromGalleryDL({command})")
Return Nothing Return Nothing
Finally
_GdlPreProgressPerformEnabled = False
End Try End Try
End Function End Function
Private Function GdlGetIdFilterString() As String Private Function GdlGetIdFilterString(Optional ByVal TL As List(Of String) = Nothing) As String
Return If(_TempPostsList.Count > 0, $"--filter ""int(tweet_id) > {_TempPostsList.Last} or abort()"" ", String.Empty) If TL.ListExists Then TL.Sort()
With If(TL, _TempPostsList) : Return If(.Count > 0, $"--filter ""int(tweet_id) > { .Last} or abort()"" ", String.Empty) : End With
End Function End Function
Private Function GdlCreateConf(ByVal Path As SFile) As SFile Private Function GdlCreateConf(ByVal Path As SFile) As SFile
Try Try
Dim conf As SFile = $"{Path.PathWithSeparator}TwitterGdlConfig.conf" Dim conf As SFile = $"{Path.PathWithSeparator}TwitterGdlConfig.conf"
Dim __userAgent$ = MySettings.UserAgent
If Not __userAgent.IsEmptyString Then __userAgent = $"""user-agent"": ""{__userAgent}"","
Dim confText$ = "{""extractor"":{""cookies"": """ & MySettings.CookiesNetscapeFile.ToString.Replace("\", "/") & Dim confText$ = "{""extractor"":{""cookies"": """ & MySettings.CookiesNetscapeFile.ToString.Replace("\", "/") &
""",""cookies-update"": false,""twitter"":{""tweet-endpoint"": ""detail"",""cards"": false,""conversations"": true,""pinned"": false,""quoted"": false,""replies"": true,""retweets"": true,""strategy"": null,""text-tweets"": false,""twitpic"": false,""unique"": true,""users"": ""timeline"",""videos"": true}}}" $""",""cookies-update"": {IIf(CBool(MySettings.CookiesUpdate.Value), "true", "false")}," & __userAgent &
"""twitter"":{""tweet-endpoint"": ""detail"",""cards"": false,""conversations"": true,""pinned"": false,""quoted"": false,""replies"": true,""retweets"": true,""strategy"": null,""text-tweets"": false,""twitpic"": false,""unique"": true,""users"": ""timeline"",""videos"": true}}}"
If conf.Exists(SFO.Path, True, EDP.ThrowException) Then TextSaver.SaveTextToFile(confText, conf) If conf.Exists(SFO.Path, True, EDP.ThrowException) Then TextSaver.SaveTextToFile(confText, conf)
If Not conf.Exists Then Throw New IO.FileNotFoundException("Can't find Twitter GDL config file", conf) If Not conf.Exists Then Throw New IO.FileNotFoundException("Can't find Twitter GDL config file", conf)
Return conf Return conf
@@ -736,13 +1029,12 @@ Namespace API.Twitter
#Region "ReparseMissing" #Region "ReparseMissing"
Private _ReparseLikes As Boolean = False Private _ReparseLikes As Boolean = False
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken) Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Const SinglePostPattern$ = "https://x.com/{0}/status/{1}"
Dim rList As New List(Of Integer) Dim rList As New List(Of Integer)
Dim URL$ = String.Empty Dim URL$ = String.Empty
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
Dim m 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$()
@@ -753,14 +1045,7 @@ Namespace API.Twitter
Dim lim% Dim lim%
Dim specFolder$ = IIf(_ReparseLikes, "Likes", String.Empty) Dim specFolder$ = IIf(_ReparseLikes, "Likes", String.Empty)
ResetFileNameProvider() ResetFileNameProvider()
If IsSingleObjectDownload Then cache = If(IsSingleObjectDownload, Settings.Cache, CreateCache())
cache = Settings.Cache
ElseIf _ReparseLikes Then
cache = CreateCache()
Else
cache = New CacheKeeper(DownloadContentDefault_GetRootDir.CSFilePS)
cache.CacheDeleteError = CacheDeletionError(cache)
End If
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)
For i = 0 To lim - 1 For i = 0 To lim - 1
@@ -769,12 +1054,16 @@ Namespace API.Twitter
m = If(_ReparseLikes, Nothing, _ContentList(i)) m = If(_ReparseLikes, Nothing, _ContentList(i))
If Not m.Post.ID.IsEmptyString Or (IsSingleObjectDownload And Not m.URL_BASE.IsEmptyString) Or _ReparseLikes Then If Not m.Post.ID.IsEmptyString Or (IsSingleObjectDownload And Not m.URL_BASE.IsEmptyString) Or _ReparseLikes Then
ThrowAny(Token) ThrowAny(Token)
If IsSingleObjectDownload Then If m.Type = UTypes.m3u8 Then
_TempMediaList.Add(m)
rList.ListAddValue(i, LNC)
Continue For
ElseIf IsSingleObjectDownload Then
URL = m.URL_BASE URL = m.URL_BASE
ElseIf _ReparseLikes Then ElseIf _ReparseLikes Then
URL = LikesPosts(i) URL = LikesPosts(i)
Else Else
URL = String.Format(SinglePostPattern, Name, m.Post.ID) URL = String.Format(SiteSettings.SinglePostPattern, m.Post.ID)
End If End If
f = GetDataFromGalleryDL(URL, cache, False, Token) f = GetDataFromGalleryDL(URL, cache, False, Token)
If Not f.IsEmptyString Then If Not f.IsEmptyString Then
@@ -786,6 +1075,13 @@ Namespace API.Twitter
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", 0, "entries"})
If .ListExists Then If .ListExists Then
If IsSingleObjectDownload Or DownloadBroadcasts Then
mTmp = ExtractBroadcast(.Self, m.Post.ID, String.Empty, nodes)
If Not mTmp.URL.IsEmptyString Then
_TempMediaList.ListAddValue(mTmp, LNC)
rList.ListAddValue(i, LNC)
End If
End If
For Each n In .Self For Each n In .Self
For Each node In nodes For Each node In nodes
With n(node) With n(node)
@@ -823,7 +1119,10 @@ Namespace API.Twitter
#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)
_ContentList.Add(New UserMedia(Data.URL) With {.State = UStates.Missing}) GDL_REQUESTS_COUNT = 0
Dim um As New UserMedia(Data.URL) With {.State = UStates.Missing}
If Not Data.URL.IsEmptyString AndAlso Data.URL.Contains(BroadCastPartUrl) Then um.Type = UTypes.m3u8
_ContentList.Add(um)
ReparseMissing(Token) ReparseMissing(Token)
End Sub End Sub
#End Region #End Region
@@ -880,6 +1179,13 @@ Namespace API.Twitter
End Try End Try
End Function End Function
#End Region #End Region
#Region "Clear"
Protected Overrides Sub EraseData_AdditionalDataFiles()
MyFilePostsKV.Delete(SFO.File, SFODelete.DeleteToRecycleBin, EDP.SendToLog + EDP.ReturnValue)
_DataNames.Clear()
MyBase.EraseData_AdditionalDataFiles()
End Sub
#End Region
#Region "Create media" #Region "Create media"
Private Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String, Private Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _PictureOption As String = Nothing, Optional ByVal _PictureOption As String = Nothing,
@@ -902,6 +1208,31 @@ Namespace API.Twitter
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 DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Const ytDest$ = "[download] destination"
Dim f As SFile = Nothing
If MySettings.CookiesNetscapeFile.Exists And Settings.YtdlpFile.Exists And (Not URL.IsEmptyString AndAlso URL.Contains(BroadCastPartUrl)) Then
Dim destPath$ = DestinationFile.PathWithSeparator.Replace("\", "\\")
Dim rr As RParams = RParams.DM($"{destPath}.+mp4", 0, RegexOptions.IgnoreCase, EDP.ReturnValue)
Dim cmd$ = $"""{Settings.YtdlpFile.File}"" --no-cookies-from-browser --cookies ""{MySettings.CookiesNetscapeFile}"" "
cmd &= $"{URL} -P ""{destPath}"" --no-mtime"
Using ytdlp As New YTDLP.YTDLPBatch(Token)
With ytdlp
.Execute(cmd)
If .OutputData.Count > 0 Then
For Each outStr$ In .OutputData
If Not outStr.IsEmptyString AndAlso outStr.ToLower.Trim.StartsWith(ytDest) Then
f = CStr(RegexReplace(outStr, rr))
If Not f.Exists Then f = Nothing
Exit For
End If
Next
End If
End With
End Using
End If
Return f
End Function
#End Region #End Region
#Region "Exception" #Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
@@ -911,7 +1242,7 @@ Namespace API.Twitter
#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 _DataNames.Clear() : LikesPosts.Clear() If Not disposedValue And disposing Then _DataNames.Clear() : LikesPosts.Clear() : PostsKV.Clear()
MyBase.Dispose(disposing) MyBase.Dispose(disposing)
End Sub End Sub
#End Region #End Region

View File

@@ -299,6 +299,24 @@ Namespace API
End If End If
End Get End Get
End Property End Property
Friend ReadOnly Property ContextDownLimit As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_DOWN_LIMIT).ToArray
Else
Return New ToolStripMenuItem() {}
End If
End Get
End Property
Friend ReadOnly Property ContextDownDate As ToolStripMenuItem()
Get
If Count > 0 Then
Return Collections.Select(Function(c) DirectCast(c, UserDataBase).BTT_CONTEXT_DOWN_DATE).ToArray
Else
Return New ToolStripMenuItem() {}
End If
End Get
End Property
Friend ReadOnly Property ContextEdit As ToolStripMenuItem() Friend ReadOnly Property ContextEdit As ToolStripMenuItem()
Get Get
If Count > 0 Then If Count > 0 Then

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