Compare commits

..

23 Commits

Author SHA1 Message Date
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
Andy
444b3521eb 2024.5.18.0
YT
YouTubeSettings: add 'DefaultVideoHighlightFPS_H' and 'DefaultVideoHighlightFPS_L' properties
VideoOption: highlight frame rates higher/lower than this value

SCrawler
SiteSettingsBase: add 'UserAgentDefault' property
API.Facebook, API.Instagram, API.Mastodon, API.OnlyFans, API.ThreadsNet, API.Twitter: add categories
API.Instagram.SiteSettings: add 'DownDetector' validation; remove wrong header
API.Instagram.UserData: fix incorrect definition of pinned posts; add 'DefaultParser_Pinned' and 'DefaultParser_SkipPost' func (for Threads)
API.Threads: fix pinned posts processing
API.Reddit: add 429 bypass; change the naming method of video files (hosted on Reddit) to the 'YYYYMMDD_HHMMSS' pattern; add 'UserAgent' property
API.RedGifs: hide credential controls
API.Twitter: add 'Likes' downloading; change domain from twitter.com to x.com;
API.OnlyFans: set '_AllowUserAgentUpdate' to false
SiteEditorForm: group options by category
GroupListForm: enable 'OK' if it is filter
DownloadGroup: add 'FilterShowAllUsers' property
PropertyValueHost: add 'Category' property
MainFrame: the 'ALL' filter isn't unchecked when loading a filter from a saved one
Update user paths when global paths change
Scheduler: add the ability to clone the scheduler

PluginProvider
PropertyOption attribute: set category name when `IsAuth = True`
ISiteSettings: add 'UserAgentDefault' property
2024-05-18 01:17:29 +03:00
Andy
ec2266f1bf 2024.5.4.0
YT
remove dots from the end of the file name; add a setting to remove specific characters

SCrawler
API.Instagram: simplify the 'Connection closed' error
API.Reddit: update token refresh request; add 'BearerTokenUseCurl' hidden property
API.Threads: fix frong header name ('dnt'); update 'UpdateCredentials' function
AutoDownloader: change 'IndexOutOfRangeException' to 'Exception' in the 'Download' function
TDownloader: fix 'FilesUpdatePendingUsers' function (freeze)
UserSearchForm: add 'FriendlyName' to search results
2024-05-04 07:04:26 +03:00
Andy
7d9255c916 2024.4.26.0
Add 'CookieValueExtractorAttribute' and the ability to immediately populate fields with values that can be extracted from cookies
Feed: add the ability to load the last session of the current day (if it exists) as the current session after restarting SCrawler
UserSearchForm: include friendly name matches in search result
API.Xhamster: saved posts aren't downloading
2024-04-26 17:18:31 +03:00
131 changed files with 6407 additions and 1651 deletions

View File

@@ -1,17 +1,14 @@
# 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. Let me know you are working on it by posting a comment on the issue.
1. If you find an error in the code, please provide a link to the file and the line number.
1. Let me know you're working on this by posting a comment on this issue.
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.-->
# How to report a problem
1. Attach the **profile URLs or links** that you cannot download.
1. Attach the **LOG** if it exists.
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**)*
**[Read here](https://github.com/AAndyProgram/SCrawler/blob/main/FAQ.md#how-to-report-a-problem)**
# How to build from source
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.**
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

View File

@@ -1,3 +1,237 @@
# 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-05-18*
- Added
- YouTube (standalone app): highlight frame rates higher/lower than this value (`Settings` - `Defaults Video` - `Highlight FPS (higher/lower)`).
- Sites
- Instagram: 'DownDetector' support to determine if the site is accessible
- Reddit: change the naming method of video files (hosted on Reddit) to the `YYYYMMDD_HHMMSS` pattern
- Twitter
- `Likes` downloading *(user settings)*
- **changed domain from twitter.com to x.com**
- Site settings: group options by category
- Minor improvements
- PluginProvider
- `PropertyOption` attribute: set category name when `IsAuth = True`
- `ISiteSettings`: added `UserAgentDefault` property
- Updated
- gallery-dl up to version **1.27.0-dev**
- Fixed
- Sites
- Instagram: incorrect definition of pinned posts
- Threads: new posts are no longer downloaded from profiles with pinned posts
- Reddit: bypass error 429 for saved posts
- Twitter: **data is not downloading due to domain change from twitter.com to x.com**
- Minor bugs
# 2024.5.4.0
*2024-05-04*
- Added
- YouTube (standalone app): setting to remove specific characters (`Defaults` - `Remove characters`)
- Instagram: simplify the `Connection closed` error
- Users search: add `Friendly name` to search results
- Fixed
- YouTube (standalone app): incorrect download processing when the file name ends with a dot (Issue #188)
- The program is freezes when editing users in some cases
- Sites
- Reddit: token update error
- Threads: unable to obtain credentials (`ID`)
# 2024.4.26.0
*2024-04-26*
- Added
- Site settings: the values that can be extracted from cookies immediately populate fields
- Feed: ability to load the last session of the current day (if it exists) as the current session after restarting SCrawler
- Users search: include friendly name matches in search result
- Updated
- gallery-dl up to version **1.26.9**
- Fixed
- xHamster: **saved posts aren't downloading**
# 2024.4.14.0
*2024-04-14*

162
FAQ.md
View File

@@ -1,120 +1,98 @@
# 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.
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**
A: https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies
----
#### 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!*
# 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**
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**)*
**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 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/) 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.**
----
#### 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.
# Video how to configure
**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: 16 KiB

After

Width:  |  Height:  |  Size: 18 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: 18 KiB

After

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 26 KiB

After

Width:  |  Height:  |  Size: 26 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 35 KiB

After

Width:  |  Height:  |  Size: 46 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 22 KiB

After

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 29 KiB

After

Width:  |  Height:  |  Size: 29 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 25 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 24 KiB

After

Width:  |  Height:  |  Size: 25 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 22 KiB

After

Width:  |  Height:  |  Size: 25 KiB

View File

@@ -1,5 +1,5 @@
<!-- # :rainbow_flag: Happy LGBT Pride Month :tada:
-->
# 🏳️‍🌈 Happy LGBT Pride Month 🎉
# 🏳️‍🌈 Social networks crawler 🏳️‍🌈
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
@@ -33,16 +33,16 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
![YouTube application](ProgramScreenshots/AppYouTube.png)
# 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;
- Reddit images, galleries of images, videos, saved posts;
- Redgifs videos (https://www.redgifs.com/);
- Twitter images and videos, saved (bookmarked) posts;
- OnlyFans images and videos, saved (bookmarked) posts;
- Redgifs images and videos (https://www.redgifs.com/);
- Twitter images and videos, saved (bookmarked) posts, likes, communities;
- OnlyFans images and videos, saved (bookmarked) posts, stories;
- JustForFans images and videos, saved (bookmarked) posts;
- Mastodon images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories, saved posts;
- Threads images and videos;
- Threads images and videos, saved posts;
- Facebook images and videos, stories, saved posts;
- TikTok videos;
- Pinterest boards, users, saved posts;
@@ -57,7 +57,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)
- Add users from parsed channel
- **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)
- Multiple accounts support
- Labeling users
@@ -79,15 +79,15 @@ A program to download photo and video from [any site](#supported-sites) (e.g. Yo
- **Reddit**
- **Twitter**
- **OnlyFans** *(partial support)*[^1]
- **Mastodon**
- **Instagram**
- **Threads**
- **Facebook**
- JustForFans *(partial support)*[^1]
- JustForFans *(partial support) ([video issue](https://discord.com/channels/1124032649682493462/1205547615199039551/1231349555132366870))*[^1]
- Mastodon *(out of support)*
- TikTok
- RedGifs
- Pinterest
- Imgur
- Imgur *(out of support)*
- Gfycat
- LPSG
- **PornHub**
@@ -109,7 +109,7 @@ First, the program downloads the full profile. After the program downloads only
# 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)**
# Guide
@@ -157,7 +157,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:
**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.**
@@ -183,7 +183,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)
Just add a user profile and **click the ```Download``` button**.
Just add a user profile and **click the `Download` button**.
```mermaid
stateDiagram

View File

@@ -36,8 +36,22 @@ Namespace Plugin.Attributes
Public Property IsInformationLabel As Boolean = False
''' <summary>Label text alignment.<br/>Default: <see cref="Drawing.ContentAlignment.TopCenter"/></summary>
Public Property LabelTextAlign As Drawing.ContentAlignment = Drawing.ContentAlignment.TopCenter
Private _IsAuth As Boolean = False
''' <summary>This is an authorization property</summary>
Public Property IsAuth As Boolean = False
Public Property IsAuth As Boolean
Get
Return _IsAuth
End Get
Set(ByVal _IsAuth As Boolean)
Me._IsAuth = _IsAuth
If _IsAuth And String.IsNullOrEmpty(Category) Then
Category = CategoryAuth
ElseIf Not _IsAuth AndAlso Not String.IsNullOrEmpty(Category) AndAlso Category = CategoryAuth Then
Category = String.Empty
End If
End Set
End Property
Public Const CategoryAuth As String = "Authorization"
Public Property Category As String = Nothing
Public Property InheritanceName As String = Nothing
''' <summary>Initialize a new property option attribute</summary>

View File

@@ -19,6 +19,7 @@ Namespace Plugin
ReadOnly Property Site As String
Property CMDEncoding As String
Property EnvironmentPrograms As IEnumerable(Of String)
Property UserAgentDefault As String
Sub EnvironmentProgramsUpdated()
Property AccountName As String
Property Temporary As Boolean

View File

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

View File

@@ -78,6 +78,17 @@ Namespace API.YouTube.Base
https = 1
m3u8 = 2
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 Type As Plugin.UserMediaTypes
Public ID As String

View File

@@ -22,6 +22,7 @@ Namespace API.YouTube.Base
End Sub
Public Shared Function StandardizeURL(ByVal URL As String) As String
Try
URL = URL.StringTrim
Dim isMusic As Boolean = False, isShorts As Boolean = False
If Info_GetUrlType(URL, isMusic, isShorts) = YouTubeMediaType.Single Then
If Not isMusic And Not isShorts Then
@@ -45,6 +46,7 @@ Namespace API.YouTube.Base
End Function
Public Shared Function StandardizeURL_Channel(ByVal URL As String, Optional ByVal Process As Boolean = True) As String
Try
URL = URL.StringTrim
Dim ct As YouTubeChannelTab = YouTubeChannelTab.All
Dim isMusic As Boolean = False
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,
Optional ByRef IsChannelUser As Boolean = False, Optional ByRef Id As String = Nothing,
Optional ByRef ChannelOptions As YouTubeChannelTab = YouTubeChannelTab.All) As YouTubeMediaType
URL = URL.StringTrim
If Not URL.IsEmptyString Then
IsMusic = URL.Contains("music.youtube.com")
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 DateAfter As Date? = Nothing, Optional ByVal DateBefore As Date? = Nothing,
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 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
@@ -162,7 +166,7 @@ Namespace API.YouTube.Base
If result Then
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
container.Dispose()
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)>
Private Property IDownloaderSettings_OpenFolderInOtherProgram As Boolean Implements IDownloaderSettings.OpenFolderInOtherProgram
Get
Return OpenFolderInOtherProgram.Use
Return OpenFolderInOtherProgram.Attribute.ValueTemp
End Get
Set(ByVal use As Boolean)
OpenFolderInOtherProgram.Use = use
OpenFolderInOtherProgram.Attribute.ValueTemp = use
End Set
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)"),
Description("The command to open a folder."), DefaultValue("")>
Private Property IDownloaderSettings_OpenFolderInOtherProgram_Command As String Implements IDownloaderSettings.OpenFolderInOtherProgram_Command
Get
Return OpenFolderInOtherProgram
Return OpenFolderInOtherProgram.ValueTemp
End Get
Set(ByVal command As String)
OpenFolderInOtherProgram.Value = command
OpenFolderInOtherProgram.ValueTemp = command
End Set
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")>
Friend ReadOnly Property CheckUpdatesAtStart As XMLValue(Of Boolean)
#End Region
@@ -162,6 +168,12 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"Info"}), Category("Info"), DisplayName("Create description files"),
Description("Create video description files. Default: false.")>
Public ReadOnly Property CreateDescriptionFiles As XMLValue(Of Boolean)
<Browsable(True), GridVisible, XMLVN({"Info"}, True), Category("Info"), DisplayName("Create description files: add upload date"),
Description("Add the upload date to the top of the description file. Default: true.")>
Public ReadOnly Property CreateDescriptionFiles_AddUploadDate 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)"),
Description("Create video thumbnail files. Default: true.")>
Public ReadOnly Property CreateThumbnails_Video As XMLValue(Of Boolean)
@@ -243,6 +255,18 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible(False), XMLVN({"Defaults"}), Category("Defaults"), DisplayName("Program description"),
Description("Add some additional info to the program info if you need")>
Friend ReadOnly Property ProgramDescription As XMLValue(Of String)
<Browsable(True), GridVisible, XMLVN({"Defaults"}, "%"""), Category("Defaults"), DisplayName("Remove characters"),
Description("Remove specific characters from a file name")>
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)
#End Region
#Region "Defaults ChannelsDownload"
<Browsable(True), GridVisible, XMLVN({"Defaults", "Channels"}), Category("Defaults"), DisplayName("Default download tabs for channels"),
@@ -287,6 +311,12 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, 1080), Category("Defaults Video"), DisplayName("Default definition"),
Description("The default maximum video resolution. -1 for max definition")>
Public ReadOnly Property DefaultVideoDefinition As XMLValue(Of Integer)
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, 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)"),
Description("Embed thumbnail in the video as cover art. Default: true.")>
Public ReadOnly Property DefaultVideoEmbedThumbnail As XMLValue(Of Boolean)
@@ -358,6 +388,15 @@ Namespace API.YouTube.Base
Throw New NotImplementedException("'GetFormat' is not available in 'FpsFormatProvider'")
End Function
End Class
<Browsable(True), GridVisible, XMLVN({"DefaultsVideo"}, 30), Category("Defaults Video"), DisplayName("Highlight FPS (higher)"),
Description("Highlight frame rates higher than this value." & vbCr & "Default: 30" & vbCr & "-1 to disable")>
Public ReadOnly Property DefaultVideoHighlightFPS_H As XMLValue(Of Integer)
<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")>
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
#Region "Defaults Audio"
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, "AAC"), Category("Defaults Audio"), DisplayName("Default codec"),
@@ -380,6 +419,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"DefaultsAudio"}, True), Category("Defaults Audio"), DisplayName("Embed thumbnail"),
Description("Embed thumbnail in the audio as cover art. Default: true.")>
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)"),
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)
@@ -405,6 +447,9 @@ Namespace API.YouTube.Base
<Browsable(True), GridVisible, XMLVN({"Playlists"}), Category("Music"), DisplayName("M3U8 Append file number"),
Description("Add file number to file name. Default: false.")>
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
#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

@@ -58,6 +58,11 @@ Namespace API.YouTube.Controls
If Not m.ID.IsEmptyString AndAlso m.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC"
If Not SelectedAudio.ID.IsEmptyString Then LBL_CODECS.Text &= $" / {SelectedAudio.Extension}{d}{SelectedAudio.Codec}{d}{SelectedAudio.Bitrate}k"
If Not SelectedAudio.ID.IsEmptyString AndAlso SelectedAudio.ID.StringToLower.Contains(DRC) Then LBL_CODECS.Text &= $"{d}DRC"
If MyYouTubeSettings.DefaultVideoHighlightFPS_H > 0 AndAlso m.FPS > MyYouTubeSettings.DefaultVideoHighlightFPS_H Then _
BackColor = MyColor.DeleteBack : ForeColor = MyColor.DeleteFore
If MyYouTubeSettings.DefaultVideoHighlightFPS_L > 0 AndAlso m.FPS < MyYouTubeSettings.DefaultVideoHighlightFPS_L Then _
BackColor = MyColor.UpdateBack : ForeColor = MyColor.UpdateFore
End If
Dim sv% = m.Size / 1024

View File

@@ -65,11 +65,11 @@ Namespace API.YouTube.Controls
Me.LBL_TIME = New System.Windows.Forms.Label()
Me.LBL_URL = New System.Windows.Forms.LinkLabel()
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_CANCEL = New System.Windows.Forms.Button()
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_AUDIO = New System.Windows.Forms.RadioButton()
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_EXTRA_AUDIO_FORMATS As PersonalUtilities.Forms.Controls.TextBoxExtended
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_CANCEL As Button
Private WithEvents TP_HEADER_INFO_2 As TableLayoutPanel
Private WithEvents TXT_FPS As PersonalUtilities.Forms.Controls.TextBoxExtended
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
End Class
End Namespace

View File

@@ -32,6 +32,7 @@ Namespace API.YouTube.Controls
Private Initialization As Boolean = True
Private ReadOnly InheritsFromContainer As Boolean
Private ReadOnly M3U8Files As List(Of SFile)
Friend Property UseCookies As Boolean = False
Private ReadOnly Property M3U8FilesFull As List(Of SFile)
Get
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)
Me.InheritsFromContainer = InheritsFromContainer
MyFieldsChecker = New FieldsChecker
UseCookies = MyYouTubeSettings.DefaultUseCookies
End Sub
#End Region
#Region "Form handlers"
@@ -121,7 +123,7 @@ Namespace API.YouTube.Controls
img = ImageRenderer.GetImage(SFile.GetBytesFromNet(imgUrl, EDP.ReturnValue), EDP.ReturnValue)
If Not img Is Nothing Then ICON_VIDEO.Image = img : ICON_VIDEO.InitialImage = img
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)
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()
@@ -227,7 +229,7 @@ Namespace API.YouTube.Controls
Dim data As IEnumerable(Of Control)
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
data = (From m As MediaObject In .Self.MediaObjects
Where m.Type = __contentType
@@ -610,7 +612,7 @@ Namespace API.YouTube.Controls
$"Video|{AvailableVideoFormats.Select(Function(vf) $"*.{vf.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.Extension = ext
If Not f.IsEmptyString Then f.Extension = ext
End If
#Enable Warning
f = CleanFileName(f)

View File

@@ -6,6 +6,7 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Runtime.CompilerServices
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.RegularExpressions
@@ -56,11 +57,20 @@ Namespace API.YouTube
Friend ReadOnly TitleHtmlConverter As Func(Of String, String) = Function(Input) Input.StringRemoveWinForbiddenSymbols().StringTrim()
Friend ReadOnly ProgressProvider As IMyProgressNumberProvider = MyProgressNumberProvider.Percentage
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
If Not f.IsEmptyString And Not f.Name.IsEmptyString Then
Dim ff As SFile = f
ff.Name = ff.Name.StringRemoveWinForbiddenSymbols
If Not ff.Name.IsEmptyString Then ff.Name = ff.Name.Replace("%", String.Empty)
ff.Name = ff.Name.StringRemoveWinForbiddenSymbols.StringTrim
ff.Name = ff.Name.StringReplaceSymbols({vbLf, vbCr, vbCrLf}, String.Empty, EDP.ReturnValue)
ff.Name = ff.Name.StringTrimEnd(".")
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)
If ff.Name.IsEmptyString Then ff.Name = "file"
Return ff
Else

View File

@@ -133,18 +133,25 @@ Namespace DownloadObjects.STDownloader
ICON_SITE.Image = .SiteIcon
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
LBL_INFO.Text = .File.Extension.StringToUpper
ElseIf Not .IsMusic And Not (.MediaType = Plugin.UserMediaTypes.Audio Or .MediaType = Plugin.UserMediaTypes.AudioPre) Then
If .Height > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{ .Height}p"
If h > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{h}p"
Else
LBL_INFO.Text = .File.Extension.StringToUpper
End If
Else
If .Bitrate > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{ .Bitrate}k"
If b > 0 Then
LBL_INFO.Text = $"{ .File.Extension.StringToUpper}{d}{b}k"
Else
LBL_INFO.Text = .File.Extension.StringToUpper
End If
@@ -221,7 +228,7 @@ Namespace DownloadObjects.STDownloader
t = 0
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
@@ -430,7 +437,7 @@ Namespace DownloadObjects.STDownloader
Else
RaiseEvent BeforeOpenEditor(Me, MyContainer)
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()
.Protected = IIf(f.DialogResult = DialogResult.OK, True, initProtected)
End Using
@@ -458,12 +465,12 @@ Namespace DownloadObjects.STDownloader
If Not MyContainer Is Nothing Then
Dim f As Form = Nothing
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
If MyContainer.IsMusic Then
f = New MusicPlaylistsForm(MyContainer)
Else
f = New VideoOptionsForm(MyContainer, True)
f = New VideoOptionsForm(MyContainer, True) With {.UseCookies = UseCookies}
End If
End Select
If Not f Is Nothing Then

View File

@@ -57,6 +57,12 @@ Namespace DownloadObjects.STDownloader
End If
MyNotificator = New YTNotificator(Me)
MyDownloaderSettings = MyYouTubeSettings
ProgramLogInitialize()
With ProgramLog
AddHandler .TextAdded, AddressOf ProgramLog_TextAdded
AddHandler .TextCleared, AddressOf ProgramLog_TextCleared
End With
UpdateLogButton()
End If
With MyView : .Import() : .SetFormSize() : End With
@@ -126,7 +132,8 @@ Namespace DownloadObjects.STDownloader
#End Region
#Region "Controls"
Protected Sub ControlCreateAndAdd(ByVal Container As IYouTubeMediaContainer, Optional ByVal DisableDownload As Boolean = False,
Optional ByVal PerformClick As Boolean = True, Optional ByVal 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()
With TP_CONTROLS
.SuspendLayout()
@@ -136,7 +143,7 @@ Namespace DownloadObjects.STDownloader
.RowStyles.Insert(0, New RowStyle(SizeType.Absolute, 60))
.RowCount = .RowStyles.Count
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.Removal, AddressOf MediaControl_Removal
AddHandler cnt.DownloadAgain, AddressOf MediaControl_DownloadAgain
@@ -157,7 +164,7 @@ Namespace DownloadObjects.STDownloader
If PerformClick Then cnt.PerformClick()
If Not DisableDownload And MyDownloaderSettings.DownloadAutomatically Then AddToDownload(cnt, True)
End With
End Sub, EDP.None)
End Sub, EDP.SendToLog)
End Sub
#Region "Controls rendering"
Private Overloads Sub OffsetControls()
@@ -247,7 +254,7 @@ Namespace DownloadObjects.STDownloader
Dim useCookiesParse As Boolean? = Nothing
If useCookies Then useCookiesParse = True
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 url$ = String.Empty
@@ -327,19 +334,19 @@ Namespace DownloadObjects.STDownloader
If Not c Is Nothing Then
Dim f As Form
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
If c.IsMusic Then
f = New MusicPlaylistsForm(c)
Else
f = New VideoOptionsForm(c)
f = New VideoOptionsForm(c) With {.UseCookies = useCookies}
End If
Case Else : c.Dispose() : Throw New ArgumentException($"Object type {c.ObjectType} not implemented", "IYouTubeMediaContainer.ObjectType")
End Select
If Not f Is Nothing Then
If TypeOf f Is IDesignXMLContainer Then DirectCast(f, IDesignXMLContainer).DesignXML = DesignXML
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()
End If
End If
@@ -449,12 +456,26 @@ Namespace DownloadObjects.STDownloader
End Try
End Sub
#End Region
#Region "LOG"
Private Sub BTT_LOG_Click(sender As Object, e As EventArgs) Handles BTT_LOG.Click
MyMainLOG_ShowForm(DesignXML,,,, AddressOf UpdateLogButton)
End Sub
Friend Sub UpdateLogButton()
If AppMode Then MyMainLOG_UpdateLogButton(BTT_LOG, TOOLBAR_TOP)
Private Sub UpdateLogButton()
If AppMode Then
Try : MyMainLOG_UpdateLogButton(BTT_LOG, TOOLBAR_TOP) : Catch : End Try
End If
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
Try
With MyYouTubeSettings

View File

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

View File

@@ -175,7 +175,9 @@ Namespace API.YouTube.Objects
Protected _ThumbnailUrl As String = String.Empty
<XMLEC> Public Overridable Property ThumbnailUrl As String Implements IDownloadableMedia.ThumbnailUrl
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
Else
Return _ThumbnailUrl
@@ -267,12 +269,11 @@ Namespace API.YouTube.Objects
<XMLEC(CollectionMode:=CollectionModes.String)>
Friend ReadOnly Property PostProcessing_OutputAudioFormats As List(Of String)
Friend Sub PostProcessing_OutputAudioFormats_Reset()
PostProcessing_OutputAudioFormats.Clear()
PostProcessing_OutputAudioFormats.ListAddList(MyYouTubeSettings.DefaultAudioCodecAddit)
If PostProcessing_OutputAudioFormats.Count > 0 Then
PostProcessing_OutputAudioFormats.Sort()
PostProcessing_OutputAudioFormats.RemoveAll(Function(s) s = -1)
End If
With PostProcessing_OutputAudioFormats
.Clear()
.ListAddList(MyYouTubeSettings.DefaultAudioCodecAddit)
If .Count > 0 Then .Sort()
End With
End Sub
<XMLEC("OutputAudioBitrate")> Protected _OutputAudioBitrate As Integer = -1
Friend Property OutputAudioBitrate As Integer
@@ -322,21 +323,19 @@ Namespace API.YouTube.Objects
<XMLEC(CollectionMode:=CollectionModes.String)>
Friend ReadOnly Property PostProcessing_OutputSubtitlesFormats As List(Of String)
Friend Sub PostProcessing_OutputSubtitlesFormats_Reset()
PostProcessing_OutputSubtitlesFormats.Clear()
PostProcessing_OutputSubtitlesFormats.ListAddList(MyYouTubeSettings.DefaultSubtitlesFormatAddit)
If PostProcessing_OutputSubtitlesFormats.Count > 0 Then
PostProcessing_OutputSubtitlesFormats.Sort()
PostProcessing_OutputSubtitlesFormats.RemoveAll(Function(s) s = -1)
End If
With PostProcessing_OutputSubtitlesFormats
.Clear()
.ListAddList(MyYouTubeSettings.DefaultSubtitlesFormatAddit)
If .Count > 0 Then .Sort()
End With
End Sub
Friend Sub SubtitlesSelectedIndexesReset()
SubtitlesSelectedIndexes.Clear()
Dim subs As List(Of Subtitles) = Subtitles
SubtitlesSelectedIndexes.ListAddList(MyYouTubeSettings.DefaultSubtitles.Select(Function(s) subs.FindIndex(Function(ss) ss.ID = s)))
If SubtitlesSelectedIndexes.Count > 0 Then
SubtitlesSelectedIndexes.Sort()
SubtitlesSelectedIndexes.RemoveAll(Function(s) s = -1)
End If
With SubtitlesSelectedIndexes
.Clear()
Dim subs As List(Of Subtitles) = Subtitles
.ListAddList(MyYouTubeSettings.DefaultSubtitles.Select(Function(s) subs.FindIndex(Function(ss) ss.ID = s)))
If .Count > 0 Then .Sort() : .RemoveAll(Function(s) s = -1)
End With
End Sub
Private Sub SetElementsSubtitles(ByVal Source As YouTubeMediaContainerBase)
If Not Source Is Nothing And HasElements Then
@@ -442,6 +441,19 @@ Namespace API.YouTube.Objects
End Get
End Property
<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
<XMLEC> Public Overridable Property Bitrate As Integer Implements IYouTubeMediaContainer.Bitrate
Get
@@ -459,6 +471,20 @@ Namespace API.YouTube.Objects
Me._Bitrate = _Bitrate
End Set
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 DateAdded As Date Implements IYouTubeMediaContainer.DateAdded
Private Property IUserMedia_PostDate As Date? Implements IUserMedia.PostDate
@@ -656,6 +682,15 @@ Namespace API.YouTube.Objects
End If
End Set
End Property
Friend Sub FileDateUpdate()
Dim n$ = _File.Name.StringTrim
Dim s$ = IIf(n.IsEmptyString, String.Empty, " ")
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
_File.Name = n
End Sub
Public Property FileSettings As SFile
Private Property IUserMedia_File As String Implements IUserMedia.File
Get
@@ -866,10 +901,14 @@ Namespace API.YouTube.Objects
Return Nothing
End Try
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}"
With Element
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)
If MyYouTubeSettings.MusicPlaylistCreate_M3U8_AppendNumber And .PlaylistIndex > 0 Then fName = $"{ .PlaylistIndex}. {fName}"
If Not .UserTitle.IsEmptyString Then
@@ -877,10 +916,7 @@ Namespace API.YouTube.Objects
If MyYouTubeSettings.MusicPlaylistCreate_M3U8_AppendArtist Then fName = $"{ .UserTitle} - {fName}"
End If
If MyYouTubeSettings.MusicPlaylistCreate_M3U8_AppendExt Then fName &= $".{f.Extension}"
Return String.Format(m3u8DataRow,
CInt(.Duration.TotalSeconds),
fName,
$"file:///{SymbolsConverter.ASCII.EncodeSymbolsOnly(f)}")
Return String.Format(m3u8DataRow, CInt(.Duration.TotalSeconds), fName, __f)
End With
End Function
Private ReadOnly DownloadProgressPattern As RParams = RParams.DMS("\[download\]\s*([\d\.,]+)", 1, EDP.ReturnValue)
@@ -921,23 +957,41 @@ Namespace API.YouTube.Objects
Dim t As TextSaver = Nothing
Try
Dim f As SFile
If MyYouTubeSettings.MusicPlaylistCreate_M3U8 Then
t = New TextSaver
t.AppendLine("#EXTM3U")
Elements.ForEach(Sub(e) t.AppendLine(GetPlaylistRow(e)))
f = $"{Elements(0).File.PathWithSeparator}Playlist.m3u8"
t.SaveAs(f, EDP.SendToLog)
If f.Exists Then AddFile(f)
t.Dispose()
End If
If MyYouTubeSettings.MusicPlaylistCreate_M3U Then
t = New TextSaver
Elements.ForEach(Sub(e) t.AppendLine(e.File))
f = $"{Elements(0).File.PathWithSeparator}Playlist.m3u"
t.SaveAs(f, EDP.SendToLog)
If f.Exists Then AddFile(f)
t.Dispose()
End If
Dim arr As M3U8CreationMode() = If(MyYouTubeSettings.MusicPlaylistCreate_CreationMode.Value = M3U8CreationMode.Both,
{M3U8CreationMode.Relative, M3U8CreationMode.Absolute},
{MyYouTubeSettings.MusicPlaylistCreate_CreationMode.Value})
Dim postfix$
Dim added As Boolean
Dim checkFile As Func(Of IYouTubeMediaContainer, Boolean) = Function(ByVal e As IYouTubeMediaContainer) As Boolean
If e.File.Exists Then
added = True
Return True
Else
Return False
End If
End Function
For Each cm As M3U8CreationMode In arr
If arr.Length > 1 AndAlso cm = M3U8CreationMode.Absolute Then postfix = "Abs" Else postfix = String.Empty
added = False
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
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[YouTubeMediaContainerBase.Download.CreatePlaylist]")
End Try
@@ -966,17 +1020,24 @@ Namespace API.YouTube.Objects
.Visible = True
.Value = 0
.Maximum = DownloadGetElemCountSingle()
.Information = $"Download {ObjectType}"
.Information = "Downloading"
End With
End If
Dim cDown As Boolean = False
Dim fCover As SFile = Nothing
Dim cUrl$ = String.Empty
For Each elem In Elements
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
.Download(UseCookies, Token)
cDown = .CoverDownloaded
fCover = .CoverFile
cUrl = .CoverURL
RemoveHandler .FileDownloadStarted, fDown
End With
If Token.IsCancellationRequested Or disposedValue Then Exit For
@@ -1003,6 +1064,8 @@ Namespace API.YouTube.Objects
End Try
End Sub
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)
Try
Dim url$ = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/playlist?list={PlsId}"
@@ -1038,7 +1101,8 @@ Namespace API.YouTube.Objects
url = LinkFormatterSecure(u)
f.Name = "cover"
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 Using
@@ -1111,7 +1175,7 @@ Namespace API.YouTube.Objects
.Value = 0
.Maximum = 100
.Provider = ProgressProvider
.Information = $"Download {MediaType}"
.Information = "Downloading"
End With
End If
.MainProcessName = MyYouTubeSettings.YTDLP.Name '"yt-dlp"
@@ -1143,15 +1207,25 @@ Namespace API.YouTube.Objects
If fileUrl.Exists Then AddFile(fileUrl)
End If
If MyYouTubeSettings.CreateDescriptionFiles And Not Description.IsEmptyString Then
Dim fileDesr As SFile = File
fileDesr.Extension = "txt"
TextSaver.SaveTextToFile(Description, fileDesr,,, EDP.None)
If fileDesr.Exists Then AddFile(fileDesr)
End If
With MyYouTubeSettings
If .CreateDescriptionFiles And (Not Description.IsEmptyString Or
(.CreateDescriptionFiles_CreateWithNoDescription And .CreateDescriptionFiles_AddUploadDate)) Then
Dim fileDesr As SFile = File
fileDesr.Extension = "txt"
Using fileDesrText As New TextSaver(fileDesr)
If .CreateDescriptionFiles_AddUploadDate Then fileDesrText.Append($"Uploaded: {DateAdded:yyyy-MM-dd HH:mm:ss}")
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 prExists Then Progress.InformationTemporary = $"Download {MediaType}: post processing"
If prExists Then Progress.InformationTemporary = "Downloading: post processing"
_ThumbnailFile = File
_ThumbnailFile.Name &= "_thumb"
_ThumbnailFile.Extension = "jpg"
@@ -1209,10 +1283,10 @@ Namespace API.YouTube.Objects
End Sub
Dim embedThumbTo As Action(Of 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
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)
End If
End Sub
@@ -1286,11 +1360,16 @@ Namespace API.YouTube.Objects
If format = mp3 And Not mp3ThumbEmbedded And MyYouTubeSettings.DefaultAudioEmbedThumbnail_ExtractedFiles Then _
embedThumbTo.Invoke(f) : mp3ThumbEmbedded = True
If Not M3U8_PlaylistFiles.ListExists AndAlso f.Exists Then M3U8_Append(f)
If format = mp3 AndAlso f.Exists AndAlso MyYouTubeSettings.VideoPlaylist_AddExtractedMP3.Value Then M3U8_Append(f)
End If
Next
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
ThrowAny(Token)
If SelectedVideoIndex >= 0 AndAlso tempFilesList.Count > 0 AndAlso tempFilesList.Exists(Function(tf) tf.ToReplace) Then
@@ -1310,15 +1389,29 @@ Namespace API.YouTube.Objects
'Delete unrequsted files
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 AndAlso OutputVideoFPS > 0 AndAlso SelectedVideo.Bitrate <> OutputVideoFPS Then
f = File
f.Name &= "tmp00"
.Execute($"ffmpeg -i ""{File}"" -filter:v fps={OutputVideoFPS.ToString.Replace(",", ".")} -c:a copy ""{f}""")
If f.Exists Then
File.Delete()
SFile.Rename(f, File,, EDP.LogMessageValue)
End If
If SelectedVideoIndex >= 0 Then
Dim reencodeFile As Action(Of String) =
Sub(ByVal ffmpegCommand As String)
f = File
f.Name &= "tmp00"
.Execute(String.Format(ffmpegCommand, File.ToString, f.ToString))
If f.Exists Then
If f.Size > 0 Then
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
@@ -1534,7 +1627,7 @@ Namespace API.YouTube.Objects
ID = .Value("id")
Title = TitleHtmlConverter.Invoke(.Value("title"))
Description = .Value("description")
URL = .Value("webpage_url")
URL = .Value("webpage_url").ToMusicUrl(IsMusic)
PlaylistID = .Value("playlist_id")
PlaylistCount = .Value("n_entries").IfNullOrEmpty(.Value("playlist_count")).FromXML(Of Integer)(0)
@@ -1572,6 +1665,7 @@ Namespace API.YouTube.Objects
If tValue.HasValue Then Duration = TimeSpan.FromSeconds(tValue.Value)
End If
DateAdded = AConvert(Of Date)(.Value("release_date").IfNullOrEmpty(.Value("upload_date")), DateAddedProvider, New Date)
If Not IsMusic Then FileDateUpdate()
ParseFormats(.Self)
@@ -1648,6 +1742,7 @@ Namespace API.YouTube.Objects
Dim obj As MediaObject
Dim nValue#
Dim sValue$
Dim allowWebm As Boolean = MyYouTubeSettings.DefaultVideoAllowWebm
Dim validCodecValue As Func(Of String, Boolean) = Function(codec) Not codec.IsEmptyString AndAlso Not codec = "none"
For Each ee In e({"formats"})
@@ -1698,12 +1793,13 @@ Namespace API.YouTube.Objects
Dim d As MediaObject = Nothing
Dim expWebm As Predicate(Of MediaObject) = Function(mo) mo.Extension = webm
Dim expAVC As Predicate(Of MediaObject) = Function(mo) mo.Codec.IfNullOrEmpty("/").ToLower.StartsWith(avc)
Dim comp As Func(Of MediaObject, Predicate(Of MediaObject), Boolean, Boolean) =
Function(mo, exp, isTrue) mo.Type = t And exp.Invoke(mo) = isTrue And mo.Width = d.Width
Dim CountWebm As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expWebm, False)
Dim RemoveWebm As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expWebm, True)
Dim CountAVC As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expAVC, True)
Dim RemoveAVC As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expAVC, False)
Dim comp As Func(Of MediaObject, Predicate(Of MediaObject), Boolean, Boolean, Boolean) =
Function(mo, exp, isTrue, checkHttp) mo.Type = t And exp.Invoke(mo) = isTrue And mo.Width = d.Width And
(Not checkHttp OrElse mo.ProtocolType = Protocols.https)
Dim CountWebm As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expWebm, False, allowWebm)
Dim RemoveWebm As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expWebm, True, allowWebm)
Dim CountAVC As Func(Of MediaObject, Boolean) = Function(mo) comp.Invoke(mo, expAVC, True, False)
Dim RemoveAVC As Predicate(Of MediaObject) = Function(mo) comp.Invoke(mo, expAVC, False, False)
For Each d In data
If MediaObjects.Count = 0 Then Exit For
If MediaObjects.LongCount(CountWebm) > 0 Then MediaObjects.RemoveAll(RemoveWebm)

View File

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

View File

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

View File

@@ -6,6 +6,7 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Runtime.CompilerServices
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Base
@@ -72,5 +73,12 @@ Namespace API.Base
$"Current query: [{CurrentQuery}]{vbCr}New query: [{NewQuery}]",
"Changing a query"}, vbExclamation,,, {"Process", "Cancel"}) = 0
End Function
<Extension> Friend Function GetCookieValue(ByVal Cookies As IEnumerable(Of System.Net.Cookie), ByVal CookieName As String) As String
If Cookies.ListExists Then Return If(Cookies.FirstOrDefault(Function(c) c.Name.ToLower = CookieName.ToLower)?.Value, String.Empty) Else Return String.Empty
End Function
<Extension> Friend Function GetCookieValue(ByVal Cookies As IEnumerable(Of System.Net.Cookie), ByVal CookieName As String,
ByVal PropName As String, ByVal PropNameComp As String) As String
Return If(PropName = PropNameComp, Cookies.GetCookieValue(CookieName), String.Empty)
End Function
End Module
End Namespace

View File

@@ -11,6 +11,9 @@ Namespace API.Base
Friend Const Header_Authorization As String = "authorization"
Friend Const Header_CSRFToken As String = "x-csrf-token"
Friend Const CAT_UserDefs As String = "New user defaults"
Friend Const CAT_Timers As String = "Timers"
Friend Const ConcurrentDownloadsCaption As String = "Concurrent downloads"
Friend Const ConcurrentDownloadsToolTip As String = "The number of concurrent downloads."
Friend Const SavedPostsUserNameCaption As String = "Saved posts user"
@@ -25,6 +28,8 @@ Namespace API.Base
Friend Const GifsDownloadCaption As String = "Download GIFs"
Friend Const UseMD5ComparisonCaption As String = "Use MD5 comparison"
Friend Const UseMD5ComparisonToolTip As String = "Each image will be checked for existence using MD5"
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()
End Sub
End Class

View File

@@ -77,7 +77,7 @@ Namespace API.Base
''' </summary>
Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer
Function EraseData(ByVal Mode As EraseMode) As Boolean
Function MoveFiles(ByVal CollectionName As String, ByVal SpecialCollectionPath As SFile) As Boolean
Function MoveFiles(ByVal CollectionName As String, ByVal SpecialCollectionPath As SFile, Optional ByVal NewUser As SplitCollectionUserInfo? = Nothing) As Boolean
Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Sub OpenFolder()
Property DownloadTopCount As Integer?

View File

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

View File

@@ -34,6 +34,16 @@ Namespace API.Base
Friend Property AccountName As String Implements ISiteSettings.AccountName
Friend Property Temporary As Boolean = False Implements ISiteSettings.Temporary
Friend Property DefaultInstance As ISiteSettings = Nothing Implements ISiteSettings.DefaultInstance
Protected _UserAgentDefault As String = String.Empty
Friend Overridable Property UserAgentDefault As String Implements ISiteSettings.UserAgentDefault
Get
Return _UserAgentDefault
End Get
Set(ByVal _UserAgentDefault As String)
Me._UserAgentDefault = _UserAgentDefault
If _AllowUserAgentUpdate And Not Responser Is Nothing And Not _UserAgentDefault.IsEmptyString Then Responser.UserAgent = _UserAgentDefault
End Set
End Property
Protected _AllowUserAgentUpdate As Boolean = True
Protected _SubscriptionsAllowed As Boolean = False
Friend ReadOnly Property SubscriptionsAllowed As Boolean Implements ISiteSettings.SubscriptionsAllowed
@@ -138,7 +148,6 @@ Namespace API.Base
Friend Overridable Sub BeginInit() Implements ISiteSettings.BeginInit
End Sub
Friend Overridable Sub EndInit() Implements ISiteSettings.EndInit
If _AllowUserAgentUpdate And Not DefaultUserAgent.IsEmptyString And Not Responser Is Nothing Then Responser.UserAgent = DefaultUserAgent
If CheckNetscapeCookiesOnEndInit Then Update_SaveCookiesNetscape(, True)
End Sub
#End Region

View File

@@ -80,6 +80,8 @@ Namespace API.Base
Private _CollectionButtonsExists As Boolean = False
Private _CollectionButtonsColorsSet As Boolean = False
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_DELETE As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_ERASE As ToolStripMenuItem
@@ -98,6 +100,8 @@ Namespace API.Base
End If
End With
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_DELETE = New ToolStripMenuItem(tn, i) With {.Name = tnn("DELETE"), .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
cf = MyColor.EditFore
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}
If Not b Is Nothing Then b.BackColor = cb : b.ForeColor = cf
Next
@@ -143,7 +148,7 @@ Namespace API.Base
Protected Const Name_UserID As String = "UserID"
Protected Const Name_Options As String = "Options"
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_Temporary As String = "Temporary"
Private Const Name_Favorite As String = "Favorite"
@@ -410,9 +415,7 @@ Namespace API.Base
End Function
Friend Overridable Sub SetPicture(ByVal f As SFile) Implements IUserData.SetPicture
Try
If f.Exists Then
Using p As New UserImage(f, MyFile) : p.Save() : End Using
End If
If f.Exists Then UserImage.NewUserPicture(f, MyFile)
Catch
End Try
End Sub
@@ -451,11 +454,7 @@ BlockPictureScan:
New ErrorsDescriber(EDP.ReturnValue) With {
.ReturnValue = New List(Of SFile),
.ReturnValueExists = True}).FirstOrDefault
If NewPicFile.Exists Then
p = New UserImage(NewPicFile, MyFile)
p.Save()
GoTo BlockReturn
End If
If NewPicFile.Exists Then p = UserImage.NewUserPicture(NewPicFile, MyFile,, True) : GoTo BlockReturn
BlockDeletePictureFolder:
On Error GoTo BlockReturn
If DelPath Then
@@ -654,6 +653,7 @@ BlockNullPicture:
End Sub
Protected ReadOnly _TempMediaList As List(Of UserMedia)
Protected ReadOnly _TempPostsList As List(Of String)
Private ReadOnly _MD5List As List(Of String)
Friend Function GetLastImageAddress() As SFile
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
@@ -679,6 +679,7 @@ BlockNullPicture:
Protected MyFileSettings As SFile
Protected MyFileData As SFile
Protected MyFilePosts As SFile
Private MyMD5File As SFile
Friend Overridable Property FileExists As Boolean = False Implements IUserData.FileExists
Friend Overridable Property DataMerging As Boolean
Get
@@ -856,6 +857,7 @@ BlockNullPicture:
LatestData = New List(Of UserMedia)
_TempMediaList = New List(Of UserMedia)
_TempPostsList = New List(Of String)
_MD5List = New List(Of String)
Labels = New List(Of String)
UserUpdatedEventHandlers = New List(Of IUserData.UserUpdatedEventHandler)
UserDownloadStateChangedEventHandlers = New List(Of UserDownloadStateChangedEventHandler)
@@ -950,7 +952,13 @@ BlockNullPicture:
LogError(ex, "user information loading error")
End Try
End Sub
Friend Overridable Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation
Private Sub UpdateUserInformation_Ex()
If _ForceSaveUserInfoOnException Then UpdateUserInformation()
End Sub
Friend Overridable Overloads Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation
UpdateUserInformation(False)
End Sub
Friend Overridable Overloads Sub UpdateUserInformation(ByVal DisableUserInfoUpdate As Boolean)
Try
UpdateDataFiles()
MyFileSettings.Exists(SFO.Path)
@@ -1001,7 +1009,7 @@ BlockNullPicture:
x.Save(MyFileSettings)
End Using
If Not IsSavedPosts Then Settings.UpdateUsersList(User, True)
If Not IsSavedPosts And Not DisableUserInfoUpdate Then Settings.UpdateUsersList(User, True)
Catch ex As Exception
LogError(ex, "user information saving error")
End Try
@@ -1034,6 +1042,8 @@ BlockNullPicture:
If _ContentList.Count > 0 Then x.AddRange(_ContentList)
x.Save(MyFileData)
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
LogError(ex, "history saving error")
End Try
@@ -1115,6 +1125,7 @@ BlockNullPicture:
Protected UseClientTokens As Boolean = False
Protected _ForceSaveUserData As Boolean = False
Protected _ForceSaveUserInfo As Boolean = False
Protected _ForceSaveUserInfoOnException As Boolean = False
Private _DownloadInProgress As Boolean = False
Private _EnvirUserExists As Boolean
Private _EnvirUserSuspended As Boolean
@@ -1128,11 +1139,13 @@ BlockNullPicture:
TokenPersonal = Nothing
ProgressPre.Reset()
UpdateDataFiles()
_MD5Loaded = False
_DownloadInProgress = True
_DescriptionChecked = False
_DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime
_ForceSaveUserData = False
_ForceSaveUserInfo = False
_ForceSaveUserInfoOnException = False
_EnvirUserExists = UserExists
_EnvirUserSuspended = UserSuspended
_EnvirCreatedByChannel = CreatedByChannel
@@ -1209,7 +1222,7 @@ BlockNullPicture:
ProgressPre.Done()
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 > 1000 Then _TempPostsList.ListAddList(_TempPostsList.ListTake(-2, 1000, EDP.ReturnValue).ListReverse, LAP.ClearBeforeAdd)
@@ -1262,9 +1275,11 @@ BlockNullPicture:
ThrowIfDisposed()
If Not _PictureExists Or _EnvirInvokeUserUpdated Then OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested Or TokenPersonal.IsCancellationRequested Or TokenQueue.IsCancellationRequested
UpdateUserInformation_Ex()
MyMainLOG = $"{ToStringForLog()}: downloading canceled"
Canceled = True
Catch exit_ex As ExitException
UpdateUserInformation_Ex()
If Not exit_ex.Silent Then
If exit_ex.SimpleLogLine Then
MyMainLOG = $"{ToStringForLog()}: downloading interrupted (exit) ({exit_ex.Message})"
@@ -1272,11 +1287,14 @@ BlockNullPicture:
ErrorsDescriber.Execute(EDP.SendToLog, exit_ex, $"{ToStringForLog()}: downloading interrupted (exit)")
End If
End If
If _EnvirInvokeUserUpdated Then OnUserUpdated()
Canceled = True
Catch dex As ObjectDisposedException When Disposed
Canceled = True
Catch ex As Exception
UpdateUserInformation_Ex()
LogError(ex, "downloading data error")
If _EnvirInvokeUserUpdated Then OnUserUpdated()
HasError = True
Finally
If Not UserExists Then AddNonExistingUserToLog($"User '{ToStringForLog()}' not found on the site")
@@ -1312,6 +1330,11 @@ BlockNullPicture:
MyFilePosts = MyFileSettings
MyFilePosts.Name &= "_Posts"
MyFilePosts.Extension = "txt"
If Not IsSavedPosts Then
MyMD5File = MyFileSettings
MyMD5File.Name &= "_MD5"
MyMD5File.Extension = "txt"
End If
Else
Throw New ArgumentNullException("User.File", "User file not detected")
End If
@@ -1435,81 +1458,94 @@ BlockNullPicture:
End Sub
#End Region
#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
Protected Property StartMD5Checked 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
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 itemsCount% = 0
Dim limit% = If(DownloadTopCount, 0)
Dim data As UserMedia = Nothing
Dim hashList As New Dictionary(Of String, 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
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 eIndx%
Dim eFinder As Predicate(Of SFile) = Function(ff) ff.File = data.File.File
If RemoveExistingDuplicates Then
RemoveExistingDuplicates = False
_ForceSaveUserInfo = True
If existingFiles.Count > 0 Then
Dim h$
ProgressPre.ChangeMax(existingFiles.Count)
For i = existingFiles.Count - 1 To 0 Step -1
ProgressPre.Perform()
h = __getMD5(New UserMedia With {.File = existingFiles(i)}, False)
If Not h.IsEmptyString Then
If hashList.ContainsKey(h) Then
MyMainLOG = $"{ToStringForLog()}: Removed image [{existingFiles(i).File}] (duplicate of [{hashList(h).File}])"
existingFiles(i).Delete(SFO.File, SFODelete.DeleteToRecycleBin, ErrMD5)
existingFiles.RemoveAt(i)
Else
hashList.Add(h, existingFiles(i))
End If
End If
Next
Dim existingFiles As List(Of SFile) = SFile.GetFiles(MyFileSettings.CutPath, "*.jpg|*.jpeg|*.png|*.gif",, EDP.ReturnValue).ListIfNothing
Dim eIndx%
Dim eFinder As Predicate(Of SFile) = Function(ff) ff.File = data.File.File
If existingFiles.Count > 0 Then
Dim h$
ProgressPre.ChangeMax(existingFiles.Count)
For i = existingFiles.Count - 1 To 0 Step -1
ProgressPre.Perform()
h = ValidateMD5_GetMD5(New UserMedia With {.File = existingFiles(i)}, False)
If Not h.IsEmptyString Then
If _MD5List.Contains(h) Then
MyMainLOG = $"{ToStringForLog()}: Removed image [{existingFiles(i).File}] (duplicate)"
existingFiles(i).Delete(SFO.File, SFODelete.DeleteToRecycleBin, ErrMD5)
existingFiles.RemoveAt(i)
Else
_MD5List.Add(h)
End If
End If
End If
Next
End If
If _ContentList.Count > 0 AndAlso _ContentList.Exists(missingMD5) Then
ProgressPre.ChangeMax(_ContentList.Count)
For i = 0 To _ContentList.Count - 1
data = _ContentList(i)
@@ -1519,61 +1555,34 @@ BlockNullPicture:
ThrowAny(Token)
eIndx = existingFiles.FindIndex(eFinder)
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
End If
End If
existingFiles.RemoveAll(eFinder)
End If
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
If _ContentList.Count > 0 Then
With _ContentList.Select(Function(d) d.MD5)
If .ListExists Then .ToList.ForEach(Sub(md5value) _
If Not md5value.IsEmptyString AndAlso Not hashList.ContainsKey(md5value) Then hashList.Add(md5value, New SFile))
End With
End If
ProgressPre.ChangeMax(_TempMediaList.Count)
For i = _TempMediaList.Count - 1 To 0 Step -1
ProgressPre.Perform()
If limit > 0 And itemsCount >= limit Then
_TempMediaList.RemoveAt(i)
Else
data = _TempMediaList(i)
If missingMD5(data) Then
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, True)
If Not data.MD5.IsEmptyString Then
If hashList.ContainsKey(data.MD5) Then
_TempMediaList.RemoveAt(i)
Else
hashList.Add(data.MD5, New SFile)
_TempMediaList(i) = data
itemsCount += 1
End If
End If
End If
data.MD5 = ValidateMD5_GetMD5(data, False)
If Not data.MD5.IsEmptyString Then _ContentList.Add(data) : _ForceSaveUserData = True
Next
existingFiles.Clear()
End If
Next
End If
If _ContentList.Count > 0 Then _MD5List.ListAddList(_ContentList.Select(Function(d) d.MD5), LAP.NotContainsOnly, EDP.ReturnValue)
End If
Catch iex As ArgumentOutOfRangeException When Disposed
Catch ex As Exception
@@ -1611,6 +1620,7 @@ BlockNullPicture:
Source.Progress.Done()
End Sub
End Class
Protected Const VideoFolderName As String = "Video"
Protected Sub DownloadContentDefault(ByVal Token As CancellationToken)
Try
Dim i%
@@ -1619,6 +1629,7 @@ BlockNullPicture:
If _ContentNew.Count > 0 Then
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
If _ContentNew.Count > 0 Then
If UseMD5Comparison Then LoadMD5()
MyFile.Exists(SFO.Path)
Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog
Dim MyDir$ = DownloadContentDefault_GetRootDir()
@@ -1627,6 +1638,7 @@ BlockNullPicture:
Dim __interrupt As Boolean
Dim f As SFile
Dim v As UserMedia
Dim __fileDeleted As Boolean
Dim fileNumProvider As SFileNumbers = SFileNumbers.Default
Dim __deleteFile As Action(Of SFile, String) = Sub(ByVal FileToDelete As SFile, ByVal FileUrl As String)
Try
@@ -1638,9 +1650,21 @@ BlockNullPicture:
ErrorsDescriber.Execute(EDP.SendToLog, file_del_ex)
End Try
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)
If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path)
If vsf Then CSFileP($"{MyDir}\{VideoFolderName}\").Exists(SFO.Path)
Progress.Maximum += _ContentNew.Count
If IsSingleObjectDownload Then
If _ContentNew.Count = 1 And _ContentNew(0).Type = UTypes.Video Then
@@ -1668,6 +1692,8 @@ BlockNullPicture:
If v.URL_BASE.IsEmptyString Then v.URL_BASE = v.URL
__fileDeleted = False
If Not f.IsEmptyString And Not v.URL.IsEmptyString Then
Try
__isVideo = v.Type = UTypes.Video Or f.Extension = "mp4" Or v.Type = UTypes.m3u8
@@ -1688,7 +1714,7 @@ BlockNullPicture:
End If
If __isVideo And vsf 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)
End If
End If
@@ -1712,19 +1738,26 @@ BlockNullPicture:
End If
End If
If __isVideo Then
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
updateDownCount()
v.File = ChangeFileNameByProvider(f, v)
v.State = UStates.Downloaded
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
Catch woex As OperationCanceledException When Token.IsCancellationRequested
__deleteFile.Invoke(f, v.URL_BASE)
@@ -1742,7 +1775,7 @@ BlockNullPicture:
Else
v.State = UStates.Skipped
End If
_ContentNew(i) = v
If Not __fileDeleted Then _ContentNew(i) = v
If DownloadTopCount.HasValue AndAlso dCount >= DownloadTopCount.Value Then
Progress.Perform(_ContentNew.Count - dTotal)
Exit Sub
@@ -1894,6 +1927,7 @@ BlockNullPicture:
If m.Contains(IUserData.EraseMode.History) Then
If MyFilePosts.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
If MyFileData.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
If MyMD5File.Delete(SFO.File, SFODelete.DeleteToRecycleBin, e) Then result = True
LastUpdated = Nothing
EraseData_AdditionalDataFiles()
UpdateUserInformation()
@@ -1910,6 +1944,8 @@ BlockNullPicture:
_TempMediaList.Clear()
_ContentNew.Clear()
_ContentList.Clear()
_MD5List.Clear()
_MD5Loaded = False
End If
End If
End If
@@ -1934,7 +1970,18 @@ BlockNullPicture:
Return 0
End If
End Function
Friend Overridable Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile) As Boolean Implements IUserData.MoveFiles
Friend Function SplitCollectionGetNewUserInfo() As SplitCollectionUserInfo
Dim u As New SplitCollectionUserInfo With {.UserOrig = User, .UserNew = User}
With u.UserNew
.CollectionName = String.Empty
.SpecialCollectionPath = Nothing
.UserModel = UsageModel.Default
.CollectionModel = UsageModel.Default
.UpdateUserFile()
End With
Return u
End Function
Friend Overridable Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile, Optional ByVal NewUser As SplitCollectionUserInfo? = Nothing) As Boolean Implements IUserData.MoveFiles
Dim UserBefore As UserInfo = User
Dim Removed As Boolean = True
Dim _TurnBack As Boolean = False
@@ -1950,6 +1997,7 @@ BlockNullPicture:
User.SpecialCollectionPath = String.Empty
User.UserModel = UsageModel.Default
User.CollectionModel = UsageModel.Default
If NewUser.HasValue Then User.SpecialPath = NewUser.Value.UserNew.SpecialPath
Else
Settings.Users.Remove(Me)
Removed = True
@@ -2150,6 +2198,12 @@ BlockNullPicture:
Private Sub BTT_CONTEXT_DOWN_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_CONTEXT_DOWN.KeyClick
Downloader.Add(Me, e.IncludeInTheFeed)
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
Using f As New Editors.UserCreatorForm(Me)
f.ShowDialog()
@@ -2225,10 +2279,13 @@ BlockNullPicture:
LatestData.Clear()
_TempMediaList.Clear()
_TempPostsList.Clear()
_MD5List.Clear()
TokenPersonal = Nothing
If Not ProgressPre Is Nothing Then ProgressPre.Reset() : ProgressPre.Dispose()
If Not Responser Is Nothing Then Responser.Dispose()
If Not BTT_CONTEXT_DOWN Is Nothing Then BTT_CONTEXT_DOWN.Dispose()
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_DELETE Is Nothing Then BTT_CONTEXT_DELETE.Dispose()
If Not BTT_CONTEXT_ERASE Is Nothing Then BTT_CONTEXT_ERASE.Dispose()

View File

@@ -0,0 +1,28 @@
' 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.Base
Friend Structure SplitCollectionUserInfo
Friend UserOrig As UserInfo
Friend UserNew As UserInfo
Friend Changed As Boolean
Friend ReadOnly Property SameDrive As Boolean
Get
Return GetUserDrive(UserOrig) = GetUserDrive(UserNew)
End Get
End Property
Private Shared Function GetUserDrive(ByVal User As UserInfo) As String
Dim u As UserInfo = User
If u.File.IsEmptyString Then u.UpdateUserFile()
Return u.File.Segments.FirstOrDefault.StringToLower
End Function
Public Overrides Function ToString() As String
Return $"[{UserOrig.File.CutPath.PathWithSeparator}] -> [{UserNew.File.CutPath.PathWithSeparator}]"
End Function
End Structure
End Namespace

View File

@@ -0,0 +1,111 @@
' 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.Base
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class SplitCollectionUserInfoChangePathsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim LBL_INFO As System.Windows.Forms.Label
Me.LIST_USERS = New System.Windows.Forms.ListBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
LBL_INFO = New System.Windows.Forms.Label()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(384, 261)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(384, 261)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_MAIN.Controls.Add(LBL_INFO, 0, 0)
TP_MAIN.Controls.Add(Me.LIST_USERS, 0, 1)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 2
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 50.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(384, 261)
TP_MAIN.TabIndex = 0
'
'LBL_INFO
'
LBL_INFO.Dock = System.Windows.Forms.DockStyle.Fill
LBL_INFO.Location = New System.Drawing.Point(3, 0)
LBL_INFO.Name = "LBL_INFO"
LBL_INFO.Size = New System.Drawing.Size(378, 50)
LBL_INFO.TabIndex = 0
LBL_INFO.Text = "Check the user destination paths and change them if necessary." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Double-click to c" &
"hange."
LBL_INFO.TextAlign = System.Drawing.ContentAlignment.MiddleCenter
'
'LIST_USERS
'
Me.LIST_USERS.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_USERS.FormattingEnabled = True
Me.LIST_USERS.Location = New System.Drawing.Point(3, 53)
Me.LIST_USERS.Name = "LIST_USERS"
Me.LIST_USERS.Size = New System.Drawing.Size(378, 205)
Me.LIST_USERS.TabIndex = 1
'
'SplitCollectionUserInfoChangePathsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(384, 261)
Me.Controls.Add(CONTAINER_MAIN)
Me.Icon = Global.SCrawler.My.Resources.Resources.UsersIcon_32
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(400, 300)
Me.Name = "SplitCollectionUserInfoChangePathsForm"
Me.ShowInTaskbar = False
Me.Text = "Collection users"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
Me.ResumeLayout(False)
End Sub
Private WithEvents LIST_USERS As ListBox
End Class
End Namespace

View File

@@ -0,0 +1,129 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="LBL_INFO.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
</root>

View File

@@ -0,0 +1,78 @@
' 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.Functions.Messaging
Namespace API.Base
Friend Class SplitCollectionUserInfoChangePathsForm
Private WithEvents MyDefs As DefaultFormOptions
Friend ReadOnly Property Users As List(Of SplitCollectionUserInfo)
''' <summary>
''' Cancel = use initial<br/>
''' Abort = abort operation<br/>
''' OK = use changes
''' </summary>
Friend Sub New(ByVal _Users As IEnumerable(Of SplitCollectionUserInfo))
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, Settings.Design)
Users = New List(Of SplitCollectionUserInfo)(_Users)
End Sub
Private Sub SplitCollectionUserInfoChangePathsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
.AddOkCancelToolbar()
LIST_USERS.Items.AddRange(Users.Cast(Of Object).ToArray)
.EndLoaderOperations()
.MyOkCancel.EnableOK = True
End With
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
MyDefs.CloseForm()
End Sub
Private Sub MyDefs_ButtonCancelClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonCancelClick
Dim m As New MMessage("You have canceled the change. Do you want to process user(s) as is or cancel the operation?", "Change user paths",
{New MsgBoxButton("Initial", "Process users as is (IGNORE changes to this form)") With {.CallBackObject = DialogResult.Cancel},
New MsgBoxButton("Process", "Process users as is (INCLUDE changes here)") With {.CallBackObject = DialogResult.OK},
New MsgBoxButton("Abort", "Abort operation") With {.CallBackObject = DialogResult.Abort},
New MsgBoxButton("Cancel", "Continue editing here") With {.CallBackObject = DialogResult.Retry}},
vbExclamation) With {.ButtonsPerRow = 4}
Dim result As DialogResult = CInt(MsgBoxE(m).Button.CallBackObject)
If result = DialogResult.Retry Then
e.Handled = True
Exit Sub
Else
MyDefs.CloseForm(result)
End If
End Sub
Private Sub SplitCollectionUserInfoChangePathsForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
Users.Clear()
End Sub
Private Sub LIST_USERS_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles LIST_USERS.MouseDoubleClick
Try
With LIST_USERS
If .SelectedIndex >= 0 Then
Dim obj As SplitCollectionUserInfo = .Items(.SelectedIndex)
Using f As New SplitCollectionUserInfoPathForm(obj)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
obj = f.User
If obj.Changed Then
Users(.SelectedIndex) = obj
.Items(.SelectedIndex) = obj
.Refresh()
End If
End If
End Using
End If
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Change user paths")
End Try
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,134 @@
' 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.Base
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class SplitCollectionUserInfoPathForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(SplitCollectionUserInfoPathForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Me.TXT_PATH_CURR = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_PATH_NEW = New PersonalUtilities.Forms.Controls.TextBoxExtended()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
CType(Me.TXT_PATH_CURR, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_PATH_NEW, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(484, 84)
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(484, 84)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_MAIN.Controls.Add(Me.TXT_PATH_CURR, 0, 0)
TP_MAIN.Controls.Add(Me.TXT_PATH_NEW, 0, 1)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 3
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(484, 84)
TP_MAIN.TabIndex = 0
'
'TXT_PATH_CURR
'
Me.TXT_PATH_CURR.CaptionText = "Current"
Me.TXT_PATH_CURR.CaptionWidth = 50.0R
Me.TXT_PATH_CURR.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_PATH_CURR.Location = New System.Drawing.Point(4, 4)
Me.TXT_PATH_CURR.Name = "TXT_PATH_CURR"
Me.TXT_PATH_CURR.Size = New System.Drawing.Size(476, 22)
Me.TXT_PATH_CURR.TabIndex = 0
Me.TXT_PATH_CURR.TextBoxReadOnly = True
'
'TXT_PATH_NEW
'
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Refresh"
ActionButton1.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Refresh
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Open"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Open
Me.TXT_PATH_NEW.Buttons.Add(ActionButton1)
Me.TXT_PATH_NEW.Buttons.Add(ActionButton2)
Me.TXT_PATH_NEW.CaptionText = "New"
Me.TXT_PATH_NEW.CaptionWidth = 50.0R
Me.TXT_PATH_NEW.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_PATH_NEW.Location = New System.Drawing.Point(4, 33)
Me.TXT_PATH_NEW.Name = "TXT_PATH_NEW"
Me.TXT_PATH_NEW.Size = New System.Drawing.Size(476, 22)
Me.TXT_PATH_NEW.TabIndex = 1
'
'SplitCollectionUserInfoPathForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(484, 84)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.Resources.UsersIcon_32
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(500, 123)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(500, 123)
Me.Name = "SplitCollectionUserInfoPathForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "User paths"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
CType(Me.TXT_PATH_CURR, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_PATH_NEW, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Private WithEvents TXT_PATH_CURR As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_PATH_NEW As PersonalUtilities.Forms.Controls.TextBoxExtended
End Class
End Namespace

View File

@@ -0,0 +1,154 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TP_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/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="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
wwAADsMBx2+oZAAAAR5JREFUOE+VkjFqwzAUhn2D9iShRyi+QhYbGujg3ZATZPKYdC6FQhPwlAMkg3dP
WQwhyWIyJIUW5NqyPb7oCVtIlhVTwYf8nv7/t2zJagel9KmqKsIACYL9RjI8UHz5zshougZr/AEvbxEP
aZCDBY3VslixaJvX3wzkkDiOwbZtDRGA5vdNAg+TL27qgmt5XkBG/gTdAG7Gt+3PP9oOaEGFCVEC6rp+
5g9MfM/c5e4OsEZMZkQEtGL5H2DdZ5JRArDwPA+iKII0TfkC9vroC9j5vq8JTWw3WzWgLMtZGIaa0MR8
vlAD8PYlSaIJTTiOowY0p0Bc19XEJo6HE59FAPuMzyAINKGJ1XLFZxHALtMrnkBXOIQIIIQ8YvF/KrgB
cMaRN0UdBBkAAAAASUVORK5CYII=
</value>
</data>
</root>

View File

@@ -0,0 +1,68 @@
' 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 SCrawler.DownloadObjects.STDownloader
Namespace API.Base
Friend Class SplitCollectionUserInfoPathForm
Private WithEvents MyDefs As DefaultFormOptions
Friend User As SplitCollectionUserInfo
Private ReadOnly UserNewPathDef As String
Friend Sub New(ByVal _User As SplitCollectionUserInfo)
InitializeComponent()
MyDefs = New DefaultFormOptions(Me, Settings.Design)
User = _User
UserNewPathDef = User.UserNew.File.CutPath.PathWithSeparator
End Sub
Private Sub SplitCollectionUserInfoPathForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize()
.AddOkCancelToolbar()
TXT_PATH_CURR.Text = User.UserOrig.File.CutPath.PathWithSeparator
TXT_PATH_NEW.Text = UserNewPathDef
.MyFieldsCheckerE = New FieldsChecker
.MyFieldsCheckerE.AddControl(Of String)(TXT_PATH_NEW, "New path")
.MyFieldsCheckerE.EndLoaderOperations()
.EndLoaderOperations()
End With
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
If MyDefs.MyFieldsChecker.AllParamsOK Then MyDefs.CloseForm()
End Sub
Private Sub TXT_PATH_NEW_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs) Handles TXT_PATH_NEW.ActionOnButtonClick
Select Case e.DefaultButton
Case ActionButton.DefaultButtons.Refresh : TXT_PATH_NEW.Text = UserNewPathDef
Case ActionButton.DefaultButtons.Open
Using ff As New Editors.GlobalLocationsChooserForm With {.MyInitialLocation = TXT_PATH_NEW.Text}
ff.ShowDialog()
If ff.DialogResult = DialogResult.OK Then
Dim dest As DownloadLocation = ff.MyDestination
If Not dest.Path.IsEmptyString Then
Dim ph As PathMoverHandler = Editors.GlobalLocationsChooserForm.ModelHandler(dest.Model)
If Not ph Is Nothing Then TXT_PATH_NEW.Text = ph.Invoke(User.UserNew, dest.Path.CSFileP).ToString
End If
End If
End Using
End Select
End Sub
Private Sub TXT_PATH_NEW_ActionOnTextChanged(sender As Object, e As EventArgs) Handles TXT_PATH_NEW.ActionOnTextChanged
If Not MyDefs.Initializing Then
Dim f As SFile = TXT_PATH_NEW.Text.CSFileP
If Not f.IsEmptyString Then
User.UserNew.SpecialPath = f
User.UserNew.UpdateUserFile()
User.Changed = Not User.UserNew.File.CutPath.PathWithSeparator = UserNewPathDef
End If
End If
End Sub
End Class
End Namespace

View File

@@ -11,6 +11,7 @@ Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Facebook
<Manifest("AndyProgram_Facebook"), SavedPosts, SeparatedTasks(1), SpecialForm(False)>
Friend Class SiteSettings : Inherits ThreadsNet.SiteSettings
@@ -31,11 +32,11 @@ Namespace API.Facebook
End Property
#End Region
#Region "Defaults"
<PropertyOption(ControlText:="Download photos", IsAuth:=False), PXML, PClonable>
<PropertyOption(ControlText:="Download photos", IsAuth:=False, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property ParsePhotoBlock As PropertyValue
<PropertyOption(ControlText:="Download videos", IsAuth:=False), PXML, PClonable>
<PropertyOption(ControlText:="Download videos", IsAuth:=False, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property ParseVideoBlock As PropertyValue
<PropertyOption(ControlText:="Download stories", IsAuth:=False), PXML, PClonable>
<PropertyOption(ControlText:="Download stories", IsAuth:=False, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property ParseStoriesBlock As PropertyValue
#End Region
#End Region

View File

@@ -7,8 +7,10 @@
' 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.Instagram
Friend Class EditorExchangeOptions
Friend NotInheritable Class EditorExchangeOptions
#Region "Download"
<PSetting(Caption:="Get timeline", ToolTip:="Download user timeline")>
Friend Property GetTimeline As Boolean
<PSetting(Caption:="Get reels", ToolTip:="Download user reels")>
@@ -19,6 +21,27 @@ Namespace API.Instagram
Friend Property GetStoriesUser As Boolean
<PSetting(Caption:="Get tagged posts", ToolTip:="Download user tagged posts")>
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
<PSetting(Address:=SettingAddress.User, Caption:=DN.UserNameChangeCaption, ToolTip:=DN.UserNameChangeToolTip)>
Friend Property UserName As String = String.Empty
<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)
With u
GetTimeline = .GetTimeline
@@ -26,6 +49,18 @@ Namespace API.Instagram
GetStories = .GetStories
GetStoriesUser = .GetStoriesUser
GetTagged = .GetTaggedData
GetTimeline_VideoPic = .GetTimeline_VideoPic
GetReels_VideoPic = .GetReels_VideoPic
GetStories_VideoPic = .GetStories_VideoPic
GetStoriesUser_VideoPic = .GetStoriesUser_VideoPic
GetTagged_VideoPic = .GetTaggedData_VideoPic
PutImageVideoFolder = .PutImageVideoFolder
UserName = .NameTrue(True)
ForceUpdateUserName = .ForceUpdateUserName
ForceUpdateUserInfo = .ForceUpdateUserInfo
End With
End Sub
Friend Sub New(ByVal s As SiteSettings)
@@ -35,6 +70,14 @@ Namespace API.Instagram
GetStories = CBool(.GetStories.Value)
GetStoriesUser = CBool(.GetStoriesUser.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 Sub
End Class

View File

@@ -14,6 +14,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Instagram
<Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
@@ -54,7 +55,13 @@ Namespace API.Instagram
End Function
End Class
#End Region
#Region "Authorization properties"
#Region "Categories"
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
#Region "Properties"
#Region "Authorization"
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_CSRF_TOKEN As String = "x-csrftoken"
@@ -63,14 +70,18 @@ Namespace API.Instagram
Friend Const Header_Browser As String = "Sec-Ch-Ua"
Friend Const Header_BrowserExt As String = "Sec-Ch-Ua-Full-Version-List"
Friend Const Header_Platform_Verion As String = "Sec-Ch-Ua-Platform-Version"
<PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Can be automatically extracted from cookies", IsAuth:=True, AllowNull:=True), 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
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3), PClonable(Clone:=False)>
<CookieValueExtractor(NameOf(HH_CSRF_TOKEN))>
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))
End Function
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), PClonable(Clone:=False)>
Friend ReadOnly Property HH_IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-asbd-id", IsAuth:=True, AllowNull:=True), 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
'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
Private ReadOnly Property HH_IG_WWW_CLAIM_IS_ZERO As Boolean
Get
@@ -79,16 +90,16 @@ Namespace API.Instagram
End Get
End Property
<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
<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
<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
<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
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists And ACheck(HH_IG_APP_ID.Value) And ACheck(HH_CSRF_TOKEN.Value)
@@ -117,90 +128,147 @@ Namespace API.Instagram
End If
End Sub
#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
<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
<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
<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
<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
<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
<Provider(NameOf(HH_IG_WWW_CLAIM_UPDATE_INTERVAL), FieldsChecker:=True)>
Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider
#End Region
<PropertyOption(ControlText:="Use GraphQL to download", IsAuth:=True), PXML, ControlNumber(16), PClonable>
<PropertyOption(ControlText:="Use GraphQL to download", IsAuth:=True), PXML, PClonable>
Friend ReadOnly Property USE_GQL As PropertyValue
#End Region
#Region "Download properties"
#Region "Download data"
<PropertyOption(ControlText:="Download timeline", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property DownloadTimeline As PropertyValue
<PXML> Private ReadOnly Property DownloadTimeline_Def As PropertyValue
<PropertyOption(ControlText:="Download reels", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property DownloadReels As PropertyValue
<PXML> Private ReadOnly Property DownloadReels_Def As PropertyValue
<PropertyOption(ControlText:="Download stories", Category:=CAT_DOWN), PXML, PClonable>
Friend ReadOnly Property DownloadStories 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."
<PropertyOption(ControlText:="Request timer (any)",
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),
PXML, ControlNumber(19), PClonable>
vbCr & "The default value is 1'000." & vbCr & "The minimum value is 0." & TimersUrgentTip, AllowNull:=False, Category:=DN.CAT_Timers),
PXML, PClonable>
Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue
<Provider(NameOf(RequestsWaitTimer_Any), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimer_AnyProvider As IFormatProvider
<PropertyOption(ControlText:="Request timer",
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,
AllowNull:=False), PXML, ControlNumber(20), PClonable>
AllowNull:=False, Category:=DN.CAT_Timers), PXML, PClonable>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider
<PropertyOption(ControlText:="Request timer counter",
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,
AllowNull:=False, LeftOffset:=120), PXML, ControlNumber(21), PClonable>
AllowNull:=False, LeftOffset:=120, Category:=DN.CAT_Timers), PXML, PClonable>
Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue
<Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider
<PropertyOption(ControlText:="Posts limit timer",
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,
AllowNull:=False), PXML, ControlNumber(22), PClonable>
AllowNull:=False, Category:=DN.CAT_Timers), PXML, PClonable>
Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue
<Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider
<PropertyOption(ControlText:="Get timeline", ControlToolTip:="Default value for new users"), 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
<PropertyOption(ControlText:="Get reels", ControlToolTip:="Default value for new users"), 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
<PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users"), 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
<PropertyOption(ControlText:="Get stories: user", ControlToolTip:="Default value for new users"), 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
<PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), 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
<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",
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
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region
#Region "Download ready"
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline"), PXML, ControlNumber(10), PClonable>
Friend ReadOnly Property DownloadTimeline As PropertyValue
<PXML> Private ReadOnly Property DownloadTimeline_Def As PropertyValue
<PropertyOption(ControlText:="Download reels", ControlToolTip:="Download reels"), PXML, ControlNumber(11), PClonable>
Friend ReadOnly Property DownloadReels As PropertyValue
<PXML> Private ReadOnly Property DownloadReels_Def As PropertyValue
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories"), PXML, ControlNumber(12), PClonable>
Friend ReadOnly Property DownloadStories As PropertyValue
<PXML> Private ReadOnly Property DownloadStories_Def As PropertyValue
<PropertyOption(ControlText:="Download stories: user", ControlToolTip:="Download stories (user)"), PXML, ControlNumber(13), PClonable>
Friend ReadOnly Property DownloadStoriesUser As PropertyValue
<PXML> Private ReadOnly Property DownloadStoriesUser_Def As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(14), PClonable>
Friend ReadOnly Property DownloadTagged As PropertyValue
<PXML> Private ReadOnly Property DownloadTagged_Def As PropertyValue
#End Region
#Region "429 bypass"
<PXML("InstagramDownloadingErrorDate")>
@@ -234,8 +302,40 @@ Namespace API.Instagram
End Get
End Property
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 LastRequestsCount As PropertyValue
<PropertyOption(IsInformationLabel:=True)>
Private ReadOnly Property LastRequestsCountLabel As PropertyValue
Private ReadOnly MyLastRequests As Dictionary(Of Date, Integer)
Private ReadOnly Property MyLastRequestsDate As Date
Get
@@ -289,36 +389,6 @@ Namespace API.Instagram
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[SiteSettings.Instagram.RefreshMyLastRequests]")
End Try
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
#Region "Initializer"
@@ -348,8 +418,11 @@ Namespace API.Instagram
platform = .Value(Header_Platform_Verion)
End If
'.Add(Header_IG_WWW_CLAIM, 0)
.Add("Origin", "https://www.instagram.com")
.Add("authority", "www.instagram.com")
.Add("Dnt", 1)
.Add("Dpr", 1)
'.Add("Dpr", 1)
.Remove("Dpr")
.Add("Sec-Ch-Ua-Mobile", "?0")
.Add("Sec-Ch-Ua-Model", """""")
.Add("Sec-Ch-Ua-Platform", """Windows""")
@@ -402,14 +475,30 @@ Namespace API.Instagram
SleepTimerOnPostsLimitProvider = New TimersChecker(10000)
GetTimeline = New PropertyValue(True)
GetTimeline_VideoPic = New PropertyValue(True)
GetReels = New PropertyValue(False)
GetReels_VideoPic = New PropertyValue(True)
GetStories = New PropertyValue(False)
GetStories_VideoPic = New PropertyValue(True)
GetStoriesUser = New PropertyValue(False)
GetStoriesUser_VideoPic = New PropertyValue(True)
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)
TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
DownloadingErrorDate = New PropertyValue(Now.AddYears(10), GetType(Date))
DownloadingErrorDate = New PropertyValue(Now.AddYears(-10), GetType(Date))
LastDownloadDate = New PropertyValue(Now.AddDays(-1))
LastRequestsCount = New PropertyValue(0)
LastRequestsCountLabel = New PropertyValue(String.Empty, GetType(String))
@@ -420,9 +509,19 @@ Namespace API.Instagram
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "instagram.com/"), 1)
ImageVideoContains = "instagram.com"
End Sub
Private Const SettingsVersionCurrent As Integer = 2
Friend Overrides Sub EndInit()
Try : MyLastRequests.Add(LastDownloadDate.Value, LastRequestsCount.Value) : Catch : End Try
If Not CBool(HH_IG_WWW_CLAIM_USE.Value) Then Responser.Headers.Remove(Header_IG_WWW_CLAIM)
If CInt(SettingsVersion.Value) < SettingsVersionCurrent Then
SettingsVersion.Value = SettingsVersionCurrent
HH_IG_WWW_CLAIM_UPDATE_INTERVAL.Value = 120
HH_IG_WWW_CLAIM_ALWAYS_ZERO.Value = False
HH_IG_WWW_CLAIM_RESET_EACH_SESSION.Value = True
HH_IG_WWW_CLAIM_RESET_EACH_TARGET.Value = True
HH_IG_WWW_CLAIM_USE.Value = True
HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO.Value = True
End If
MyBase.EndInit()
End Sub
#End Region
@@ -452,17 +551,101 @@ Namespace API.Instagram
End Function
#End Region
#Region "Downloading"
Private ____DownloadStarted As Boolean = False
Private ____AvailableRequested As Boolean = False
Private ____AvailableSilent As Boolean = True
Private ____AvailableChecked As Boolean = False
Private ____AvailableResult As Boolean = False
Private Sub ResetDownloadOptions()
If ActiveJobs < 1 Then
____DownloadStarted = False
____AvailableRequested = False
____AvailableChecked = False
____AvailableSilent = True
____AvailableResult = False
If ActiveSessionRequestsExists Then RefreshMyLastRequests(Now)
ActiveSessionRequestsExists = False
_NextWNM = UserData.WNM.Notify
_NextTagged = True
SkipUntilNextSession = False
AvailableText = String.Empty
ActiveJobs = 0
End If
End Sub
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
If MyBase.Available(What, Silent) And ActiveJobs < 2 Then
If CInt(DownDetectorValue.Value) >= 0 Then
If ____DownloadStarted Then
____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
If CInt(DownDetectorValue.Value) = -1 Then
Return True
Else
Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("instagram")
If dl.ListExists Then
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
Friend Property SkipUntilNextSession As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
Return ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso DownloadTimeline.Value
If ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso CBool(DownloadTimeline.Value) Then
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
Private ActiveJobs As Integer = 0
Private ActiveSessionDate As Date
Private ActiveSessionRequestsExists As Boolean = False
Private _NextWNM As UserData.WNM = UserData.WNM.Notify
Private _NextTagged As Boolean = True
Friend Overrides Sub DownloadStarted(ByVal What As Download)
ResetDownloadOptions()
ActiveJobs += 1
If ActiveJobs = 1 Then ActiveSessionDate = Now
If ActiveJobs = 1 Then ____DownloadStarted = True : ActiveSessionDate = Now
If Not HH_IG_WWW_CLAIM_IS_ZERO AndAlso
(
(CBool(HH_IG_WWW_CLAIM_USE_DEFAULT_ALGO.Value) AndAlso MyLastRequestsDate.AddMinutes(HH_IG_WWW_CLAIM_UPDATE_INTERVAL.Value) < Now) Or
@@ -494,6 +677,7 @@ Namespace API.Instagram
If _NextWNM = UserData.WNM.SkipTemp Or _NextWNM = UserData.WNM.SkipCurrent Then _NextWNM = UserData.WNM.Notify
_NextTagged = .TaggedCheckSession
MyLastRequestsCount = .RequestsCountSession
If .RequestsCountSession > 0 Then ActiveSessionRequestsExists = True
_FieldsChangerSuspended = True
HH_IG_WWW_CLAIM.Value = Responser.Headers.Value(Header_IG_WWW_CLAIM)
HH_CSRF_TOKEN.Value = Responser.Headers.Value(Header_CSRF_TOKEN)
@@ -501,11 +685,8 @@ Namespace API.Instagram
End With
End Sub
Friend Overrides Sub DownloadDone(ByVal What As Download)
_NextWNM = UserData.WNM.Notify
_NextTagged = True
RefreshMyLastRequests(Now)
ActiveJobs -= 1
SkipUntilNextSession = False
ResetDownloadOptions()
End Sub
#End Region
#Region "Settings"
@@ -557,7 +738,7 @@ Namespace API.Instagram
If vals.Any(Function(v) Not v.ValueOld = v.ValueNew) OrElse
Not Responser.Cookies.ListEquals(____Cookies) Then HH_IG_WWW_CLAIM.Value = 0 : credentialsUpdated = True
If Responser.CookiesExists Then
Dim csrf$ = If(Responser.Cookies.FirstOrDefault(Function(c) c.Name.StringToLower = Header_CSRF_TOKEN_COOKIE)?.Value, String.Empty)
Dim csrf$ = GetValueFromCookies(NameOf(HH_CSRF_TOKEN), Responser.Cookies)
If Not csrf.IsEmptyString Then
If Not AEquals(Of String)(CStr(HH_CSRF_TOKEN.Value), csrf) Then credentialsUpdated = True
HH_CSRF_TOKEN.Value = csrf

View File

@@ -194,7 +194,7 @@ Namespace API.Instagram
With j({"data", "xdt_api__v1__feed__reels_media__connection", "edges"})
If .ListExists Then
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 With
End If
@@ -217,7 +217,7 @@ Namespace API.Instagram
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
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 Using
End If

View File

@@ -26,12 +26,20 @@ Namespace API.Instagram
Private Const Name_LastCursor As String = "LastCursor"
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
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_VideoPic As String = "GetReels_VideoPic"
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_VideoPic As String = "GetStoriesUser_VideoPic"
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_NameTrue As String = "NameTrue"
Private Const Name_ForceUpdateUserName As String = "ForceUpdateUserName"
Private Const Name_ForceUpdateUserInfo As String = "ForceUpdateUserInfo"
#End Region
#Region "Declarations"
Protected Structure PostKV : Implements IEContainerProvider
@@ -79,17 +87,41 @@ Namespace API.Instagram
Private LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = False
Friend Property GetTimeline As Boolean = True
Friend Property GetTimeline_VideoPic As Boolean = True
Friend Property GetReels As Boolean = False
Friend Property GetReels_VideoPic As Boolean = True
Friend Property GetStories As Boolean
Friend Property GetStories_VideoPic As Boolean = True
Friend Property GetStoriesUser As Boolean
Friend Property GetStoriesUser_VideoPic As Boolean = True
Friend Property GetTaggedData As Boolean
Friend Property GetTaggedData_VideoPic As Boolean = True
Friend Property PutImageVideoFolder As Boolean = False
Private Function ExtractImageFrom(ByVal Section As Sections) As Boolean
Select Case Section
Case Sections.Timeline : Return GetTimeline_VideoPic
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
Protected _NameTrue As String = String.Empty
Friend ReadOnly Property NameTrue As String
Friend ReadOnly Property NameTrue(Optional ByVal Exact As Boolean = False) As String
Get
Return _NameTrue.IfNullOrEmpty(Name)
Return If(Exact, _NameTrue, _NameTrue.IfNullOrEmpty(Name))
End Get
End Property
Private UserNameRequested As Boolean = False
Friend Property ForceUpdateUserName As Boolean = False
Friend Property ForceUpdateUserInfo As Boolean = False
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
@@ -98,22 +130,38 @@ Namespace API.Instagram
LastCursor = .Value(Name_LastCursor)
FirstLoadingDone = .Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
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))
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_VideoPic = .Value(Name_GetTagged_VideoPic).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged_VideoPic.Value))
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
.Add(Name_LastCursor, LastCursor)
.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
.Add(Name_GetTimeline_VideoPic, GetTimeline_VideoPic.BoolToInteger)
.Add(Name_GetReels, GetReels.BoolToInteger)
.Add(Name_GetReels_VideoPic, GetReels_VideoPic.BoolToInteger)
.Add(Name_GetStories, GetStories.BoolToInteger)
.Add(Name_GetStories_VideoPic, GetStories_VideoPic.BoolToInteger)
.Add(Name_GetStoriesUser, GetStoriesUser.BoolToInteger)
.Add(Name_GetStoriesUser_VideoPic, GetStoriesUser_VideoPic.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_NameTrue, _NameTrue)
.Add(Name_ForceUpdateUserName, ForceUpdateUserName.BoolToInteger)
.Add(Name_ForceUpdateUserInfo, ForceUpdateUserInfo.BoolToInteger)
End If
End With
End Sub
@@ -130,6 +178,18 @@ Namespace API.Instagram
GetStories = .GetStories
GetStoriesUser = .GetStoriesUser
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 If
End Sub
@@ -147,15 +207,32 @@ Namespace API.Instagram
Private WwwClaimUse As Boolean = True
Private E560Thrown As Boolean = False
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
Friend Property Is560 As Boolean = False
Friend Property IsTokens As Boolean = False
Friend Property TokensData As String = String.Empty
Friend Shared Sub Throw560(ByRef Source As UserData)
If Not Source.E560Thrown Then
MyMainLOG = $"{Source.ToStringForLog}: ({IIf(Source.Err5xx > 0, Source.Err5xx, 560)}) Download skipped until next session"
Source.E560Thrown = True
End If
With Source
If Not .E560Thrown Then
If .ErrHandling = -1 Or .ErrHandlingLog Then _
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}
End Sub
Friend Shared Sub ThrowTokens(ByRef Source As UserData, ByVal Data As String)
@@ -316,6 +393,9 @@ Namespace API.Instagram
Dim errorFound As Boolean = False
Try
Err5xx = -1
ErrHandling = -1
ErrHandlingLog = True
ErrHandlingSection = Sections.Timeline
_Limit = If(DownloadTopCount, -1)
_TotalPostsParsed = 0
LoadSavePostsKV(True)
@@ -583,11 +663,13 @@ Namespace API.Instagram
'Check environment
If Not IsSavedPosts Then
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 Not ValidateBaseTokens() Then GetPageTokens()
If Not ValidateBaseTokens(TokensErrData) Then ValidateBaseTokens_Error(TokensErrData)
End If
If ForceUpdateUserName Then GetUserNameById()
If ForceUpdateUserInfo Then GetUserData()
End If
'Create query
@@ -670,6 +752,14 @@ Namespace API.Instagram
Select Case Section
Case Sections.Timeline
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)
EndCursor = .Value("next_max_id")
If If(.Item("items")?.Count, 0) > 0 Then
@@ -753,6 +843,11 @@ NextPageBlock:
Throw eex
Catch ex As Exception
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
Loop
Catch jsonNull2 As JsonDocumentException When jsonNull2.State = WebDocumentEventArgs.States.Error And
@@ -809,7 +904,7 @@ NextPageBlock:
With j("items")
For Each jj In .Self
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 _Limit > 0 And _TotalPostsParsed >= _Limit Then Throw New ExitException
Next
@@ -862,15 +957,20 @@ NextPageBlock:
Protected DefaultParser_IgnorePass As Boolean = False
Private ReadOnly DefaultParser_PostUrlCreator_Default As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/"
Protected DefaultParser_PostUrlCreator As Func(Of PostKV, String) = Function(post) $"https://www.instagram.com/p/{post.Code}/"
Protected DefaultParser_Pinned As Func(Of IEnumerable(Of EContainer), Integer, Boolean) = Nothing
Protected DefaultParser_SkipPost As Func(Of IEnumerable(Of EContainer), Integer, PostKV, Boolean) = Nothing
Protected Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
Optional ByVal SpecFolder As String = Nothing, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0) As Boolean
ThrowAny(Token)
If Items.Count > 0 Then
If Items.ListExists Then
Dim PostIDKV As PostKV
Dim Pinned As Boolean
Dim PostDate$, PostOriginUrl$
Dim before%
Dim i%, before%
Dim usePinFunc As Boolean = Not DefaultParser_Pinned Is Nothing
Dim skipPostFuncExists As Boolean = Not DefaultParser_SkipPost Is Nothing
Dim nn As EContainer
If SpecFolder.IsEmptyString Then
Select Case Section
Case Sections.Tagged : SpecFolder = TaggedFolder
@@ -879,14 +979,21 @@ NextPageBlock:
End Select
End If
ProgressPre.ChangeMax(Items.Count)
For Each nn In Items
For i = 0 To Items.Count - 1
nn = Items(i)
ProgressPre.Perform()
With If(Not DefaultParser_ElemNode Is Nothing, nn.ItemF(DefaultParser_ElemNode), nn)
If .ListExists Then
PostIDKV = New PostKV(.Value("code"), .Value("id"), Section)
PostOriginUrl = DefaultParser_PostUrlCreator(PostIDKV)
Pinned = .Contains("timeline_pinned_user_ids")
If Not DefaultParser_IgnorePass AndAlso PostKvExists(PostIDKV) Then
'Pinned = .Contains("timeline_pinned_user_ids")
If usePinFunc Then
Pinned = DefaultParser_Pinned.Invoke(Items, i)
Else
Pinned = If(.Item("timeline_pinned_user_ids")?.Count, 0) > 0
End If
If skipPostFuncExists AndAlso DefaultParser_SkipPost.Invoke(Items, i, PostIDKV) Then
ElseIf Not DefaultParser_IgnorePass AndAlso PostKvExists(PostIDKV) Then
If Not Section = Sections.Timeline OrElse Not Pinned Then Return False
Else
_TempPostsList.Add(PostIDKV.ID)
@@ -899,7 +1006,7 @@ NextPageBlock:
End Select
End If
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 _Limit > 0 And _TotalPostsParsed >= _Limit Then Return False
End If
@@ -938,6 +1045,7 @@ NextPageBlock:
Protected ObtainMedia_SizeFuncVid As Func(Of EContainer, Sizes) = Nothing
Protected ObtainMedia_SizeFuncPic As Func(Of EContainer, Sizes) = Nothing
Protected ObtainMedia_AllowAbstract As Boolean = False
Private Const ObtainMedia_NoSection As Integer = -10
Protected Sub ObtainMedia_SetReelsFunc()
ObtainMedia_SizeFuncPic = Function(ByVal ss As EContainer) As Sizes
If ss.Value("url").IsEmptyString Then
@@ -959,7 +1067,8 @@ NextPageBlock:
Optional ByVal DateObj As String = Nothing, Optional ByVal InitialType As Integer = -1,
Optional ByVal PostOriginUrl As String = Nothing,
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
Dim maxSize As Func(Of EContainer, Integer) = Function(ByVal _ss As EContainer) As Integer
Dim w% = AConvert(Of Integer)(_ss.Value("width"), 0)
@@ -1006,6 +1115,12 @@ NextPageBlock:
If TryExtractImage Then
t = 1
abstractDecision = True
If Not SpecialFolder.IsEmptyString AndAlso PutImageVideoFolder Then
Dim endsAbs As Boolean = SpecialFolder.EndsWith("*")
If endsAbs Then SpecialFolder = SpecialFolder.TrimEnd("*")
If Not SpecialFolder.IsEmptyString Then SpecialFolder = $"{SpecialFolder.TrimEnd("\")}\{VideoFolderName}{IIf(Not endsAbs, "*", String.Empty)}"
If endsAbs Then SpecialFolder &= "*"
End If
ElseIf t = -1 And InitialType = 8 And ObtainMedia_AllowAbstract Then
If n.Contains(vid) Then
t = 2
@@ -1052,7 +1167,8 @@ NextPageBlock:
End If
End With
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
DateObj = mDate(n)
With n("carousel_media").XmlIfNothing
@@ -1072,6 +1188,7 @@ NextPageBlock:
#Region "GetUserId, GetUserName"
Private Sub GetUserData()
Dim __idFound As Boolean = False
If ForceUpdateUserInfo Then ForceUpdateUserInfo = False : _ForceSaveUserInfo = True
Try
ChangeResponserMode(False)
UpdateRequestNumber()
@@ -1090,6 +1207,7 @@ NextPageBlock:
If Not eUrl.IsEmptyString AndAlso (descr.IsEmptyString OrElse Not descr.Contains(eUrl)) Then descr.StringAppendLine(eUrl)
UserDescriptionUpdate(descr)
Dim f As New SFile With {.Path = DownloadContentDefault_GetRootDir(), .Name = "ProfilePicture", .Extension = "jpg"}
f = SFile.IndexReindex(f)
If Not f.Exists Then
Dim profilePicture$ = .Value("profile_pic_url_hd")
If profilePicture.IsEmptyString OrElse Not GetWebFile(profilePicture, f, EDP.ReturnValue) Then
@@ -1102,6 +1220,7 @@ NextPageBlock:
End Using
End If
Catch ex As Exception
UserExists = False
If Not __idFound Then
If Responser.StatusCode = HttpStatusCode.NotFound Or Responser.StatusCode = HttpStatusCode.BadRequest Then
Throw ex
@@ -1115,6 +1234,7 @@ NextPageBlock:
End Sub
Private Function GetUserNameById() As Boolean
UserNameRequested = True
If ForceUpdateUserName Then ForceUpdateUserName = False : _ForceSaveUserInfo = True
Try
If Not ID.IsEmptyString Then
UpdateRequestNumber()
@@ -1131,7 +1251,7 @@ NextPageBlock:
Dim descr$ = $"Username changed from '{oldName}' to '{newName}' ({Now.ToStringDate(ADateTime.Formats.BaseDateTime)})!"
descr.StringAppendLine(UserDescription)
UserDescription = descr
_ForceSaveUserData = True
_ForceSaveUserInfo = True
End If
Return True
End If
@@ -1153,6 +1273,7 @@ NextPageBlock:
Dim qStr$, r$
Dim i% = -1
Dim jj As EContainer
Dim section As Sections = IIf(GetUserStory, Sections.UserStories, Sections.Stories)
ThrowAny(Token)
If StoriesList.ListExists Or GetUserStory Then
If Not GetUserStory Then tmpList = StoriesList.Take(5)
@@ -1169,7 +1290,7 @@ NextPageBlock:
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Contains("reels") Then
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 Using
End If
@@ -1177,7 +1298,8 @@ NextPageBlock:
End If
End If
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
With Node
ProgressPre.Perform()
@@ -1198,7 +1320,7 @@ NextPageBlock:
pid = storyID & s.Value("id")
If Not _TempPostsList.Contains(pid) Then
ThrowAny(Token)
ObtainMedia(s, pid, sFolder)
ObtainMedia(s, pid, sFolder,,,,,,, Section)
_TempPostsList.Add(pid)
End If
Next
@@ -1208,20 +1330,15 @@ NextPageBlock:
End If
End Sub
Private Function GetStoriesList() As List(Of String)
Try
UpdateRequestNumber()
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/highlights/{ID}/highlights_tray/",, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim ee As New ErrorsDescriber(EDP.ReturnValue) With {.DeclaredMessage = New MMessage($"{ToStringForLog()}:")}
Using j As EContainer = JsonDocument.Parse(r, ee).XmlIfNothing()("tray").XmlIfNothing
If j.Count > 0 Then Return j.Select(Function(jj) jj.Value("id").Replace("highlight:", String.Empty)).ListIfNothing
End Using
End If
Return Nothing
Catch ex As Exception
DownloadingException(ex, "API.Instagram.GetStoriesList", False, Sections.Stories)
Return Nothing
End Try
UpdateRequestNumber()
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/highlights/{ID}/highlights_tray/",, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim ee As New ErrorsDescriber(EDP.ReturnValue) With {.DeclaredMessage = New MMessage($"{ToStringForLog()}:")}
Using j As EContainer = JsonDocument.Parse(r, ee).XmlIfNothing()("tray").XmlIfNothing
If j.Count > 0 Then Return j.Select(Function(jj) jj.Value("id").Replace("highlight:", String.Empty)).ListIfNothing
End Using
End If
Return Nothing
End Function
#End Region
#Region "Download content"
@@ -1267,8 +1384,26 @@ NextPageBlock:
MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1
ElseIf Responser.StatusCode = 560 Or Responser.StatusCode = HttpStatusCode.InternalServerError Then '560, 500
If Responser.StatusCode = 560 And s = Sections.Stories And MySiteSettings.IgnoreStoriesDownloadingErrors Then
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
MySiteSettings.SkipUntilNextSession = True
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
MyMainLOG = $"Something is wrong. Your credentials may have expired [{CInt(Responser.StatusCode)}/{CInt(Responser.Status)}]: {ToString()} [{s}]"
DisableSection(s)

View File

@@ -20,6 +20,10 @@ Namespace API.JustForFans
Friend ReadOnly Property UserID As PropertyValue
<PropertyOption, PXML, PClonable(Clone:=False)>
Friend ReadOnly Property UserHash4 As PropertyValue
<CookieValueExtractor(NameOf(UserHash4))>
Private Function GetValueFromCookies(ByVal PropName As String, ByVal c As CookieKeeper) As String
Return c.GetCookieValue(UserHash4_CookieName, PropName, NameOf(UserHash4))
End Function
<PropertyOption(ControlText:="Accept", ControlToolTip:="Header 'Accept'"), PClonable>
Friend ReadOnly Property HeaderAccept As PropertyValue
<PropertyOption(InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent), PClonable, PXML(OnlyForChecked:=True)>
@@ -61,7 +65,7 @@ Namespace API.JustForFans
Private Sub UpdateUserHash4()
If Responser.CookiesExists Then
Dim hv_current$ = UserHash4.Value
Dim hv_cookie$ = If(Responser.Cookies.FirstOrDefault(Function(cc) cc.Name.ToLower = UserHash4_CookieName)?.Value, String.Empty)
Dim hv_cookie$ = GetValueFromCookies(NameOf(UserHash4), Responser.Cookies)
If Not hv_cookie.IsEmptyString And Not hv_cookie = hv_current And Responser.Cookies.Changed Then UserHash4.Value = hv_cookie
End If
End Sub

View File

@@ -14,6 +14,8 @@ Namespace API.Mastodon
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelProfile As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelSearch As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelForceApply As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property DownloadModelLikes As Boolean
<PSetting(Address:=SettingAddress.None)> Friend Overrides Property UserName As String
Friend Sub New(ByVal s As SiteSettings)
MyBase.New(s)
End Sub

View File

@@ -63,15 +63,15 @@ Namespace API.Mastodon
End Sub
#End Region
#Region "Other properties"
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsDownloadCaption), PXML, PClonable>
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsDownloadCaption, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsDownload As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip), PXML, PClonable>
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsSpecialFolder As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip), PXML, PClonable>
<PropertyOption(IsAuth:=False, ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsPrefix As PropertyValue
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
Private ReadOnly Property GifStringChecker As IFormatProvider
<PropertyOption(IsAuth:=False, ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip), PXML, PClonable>
<PropertyOption(IsAuth:=False, ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property UseMD5Comparison As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:="User related to my domain",
ControlToolTip:="Open user profiles and user posts through my domain."), PXML, PClonable>

View File

@@ -11,5 +11,11 @@ Namespace API.OnlyFans
Friend Module Declarations
Friend ReadOnly DateProvider As New ADateTime("O")
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 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 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>
''' Looks up a localized resource of type System.Byte[].
'''</summary>
@@ -73,5 +87,15 @@ Namespace My.Resources
Return CType(obj,Byte())
End Get
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 Namespace

View File

@@ -118,7 +118,13 @@
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<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">
<value>OFScraperConfigPattern.json;System.Byte[], mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</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>

View File

@@ -1,61 +1,63 @@
{
"config": {
"main_profile": "main_profile",
"metadata": "{configpath}/{profile}/.data/{model_username}_{model_id}",
"discord": "",
"file_options": {
"save_location": "",
"dir_format": "",
"file_format": "{filename}.{ext}",
"textlength": 0,
"space-replacer": " ",
"date": "YYYY-MM-DD"
},
"download_options": {
"file_size_limit": 0,
"file_size_min": 0,
"filter": [
"Images",
"Audios",
"Videos"
],
"auto_resume": false
},
"binary_options": {
"mp4decrypt": "",
"ffmpeg": ""
},
"cdm_options": {
"private-key": null,
"client-id": null,
"key-mode-default": "cdrm",
"keydb_api": ""
},
"performance_options": {
"download-sems": 6,
"maxfile-sem": 0,
"threads": 5
},
"advanced_options": {
"code-execution": false,
"dynamic-mode-default": "deviint",
"backend": "aio",
"downloadbars": false,
"cache-mode": "sqlite",
"appendlog": true,
"custom": null,
"sanitize_text": false,
"avatar": true
},
"responsetype": {
"timeline": "Posts",
"message": "Messages",
"archived": "Archived",
"paid": "Messages",
"stories": "Stories",
"highlights": "Stories",
"profile": "Profile",
"pinned": "Posts"
"main_profile": "main_profile",
"metadata": "{configpath}/{profile}/.data/{model_username}_{model_id}",
"discord": "",
"file_options": {
"save_location": "",
"dir_format": "",
"file_format": "{filename}.{ext}",
"textlength": 0,
"space_replacer": " ",
"date": "YYYY-MM-DD"
},
"download_options": {
"file_size_max": 0,
"file_size_min": 0,
"filter": [
"Images",
"Audios",
"Videos"
],
"auto_resume": false
},
"binary_options": {
"mp4decrypt": "",
"ffmpeg": ""
},
"cdm_options": {
"private-key": null,
"client-id": null,
"key-mode-default": "cdrm",
"keydb_api": ""
},
"performance_options": {
"download-sems": 6,
"maxfile-sem": 0,
"threads": 5
},
"advanced_options": {
"code-execution": false,
"dynamic-mode-default": "generic",
"backend": "aio",
"downloadbars": false,
"cache-mode": "sqlite",
"appendlog": true,
"custom": null,
"sanitize_text": false,
"avatar": true,
"custom_values": {
"DYNAMIC_GENERIC_URL": "https://raw.githubusercontent.com/datawhores/onlyfans-dynamic-rules/main/dynamicRules.json",
"CDRM": "https://old.cdrm-project.com/wv"
}
},
"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,22 +9,26 @@
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions
Imports DN = SCrawler.API.Base.DeclaredNames
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
#Region "Declarations"
#Region "Categories"
Private Const CAT_OFS As String = "OF-Scraper support"
Private Const CAT_ERRORS As String = "Errors"
#End Region
#Region "Options"
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download user timeline"), PXML, PClonable>
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download user timeline", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadTimeline As PropertyValue
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download profile stories if they exists"), PXML, PClonable>
<PropertyOption(ControlText:="Download stories", ControlToolTip:="Download profile stories if they exists", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadStories As PropertyValue
<PropertyOption(ControlText:="Download highlights", ControlToolTip:="Download profile highlights if they exists"), PXML, PClonable>
<PropertyOption(ControlText:="Download highlights", ControlToolTip:="Download profile highlights if they exists", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadHighlights As PropertyValue
<PropertyOption(ControlText:="Download chat", ControlToolTip:="Download unlocked chat media"), PXML, PClonable>
<PropertyOption(ControlText:="Download chat", ControlToolTip:="Download unlocked chat media", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property DownloadChatMedia As PropertyValue
#End Region
#Region "Headers"
@@ -32,16 +36,16 @@ Namespace API.OnlyFans
Private Const HeaderUserID As String = "User-Id"
Friend Const HeaderXBC As String = "X-Bc"
Friend Const HeaderAppToken As String = "App-Token"
<PropertyOption(ControlText:=HeaderUserID, AllowNull:=False), PClonable(Clone:=False)>
<PropertyOption(ControlText:=HeaderUserID, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)>
Friend ReadOnly Property HH_USER_ID As PropertyValue
<PropertyOption(ControlText:=HeaderXBC, AllowNull:=False), PClonable(Clone:=False)>
<PropertyOption(ControlText:=HeaderXBC, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)>
Private ReadOnly Property HH_X_BC As PropertyValue
<PropertyOption(ControlText:=HeaderAppToken, AllowNull:=False), PClonable(Clone:=False)>
<PropertyOption(ControlText:=HeaderAppToken, AllowNull:=False, IsAuth:=True), PClonable(Clone:=False)>
Private ReadOnly Property HH_APP_TOKEN As PropertyValue
<PropertyOption(ControlText:=HeaderBrowser, ControlToolTip:="Can be null", AllowNull:=True,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua), PClonable, PXML(OnlyForChecked:=True)>
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua, IsAuth:=True), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(AllowNull:=False, InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent), PClonable, PXML(OnlyForChecked:=True)>
<PropertyOption(AllowNull:=False, InheritanceName:=SettingsCLS.HEADER_DEF_UserAgent, IsAuth:=True), PClonable, PXML(OnlyForChecked:=True)>
Friend ReadOnly Property UserAgent As PropertyValue
Private Sub UpdateHeader(ByVal PropertyName As String, ByVal Value As String)
Dim hName$ = String.Empty
@@ -59,33 +63,33 @@ Namespace API.OnlyFans
Responser.UserAgent = Value
End If
End Sub
<CookieValueExtractor(NameOf(HH_USER_ID)), CookieValueExtractor(NameOf(HH_X_BC))>
Private Function GetValueFromCookies(ByVal PropName As String, ByVal c As CookieKeeper) As String
If c.ListExists Then
Select Case PropName
Case NameOf(HH_USER_ID) : Return c.GetCookieValue("auth_id")
Case NameOf(HH_X_BC) : Return c.GetCookieValue("fp")
End Select
End If
Return String.Empty
End Function
#End Region
#Region "Rules"
<PXML("LastDateUpdated")> Private ReadOnly Property LastDateUpdated_XML As PropertyValue
Friend Property LastDateUpdated As Date
#Region "Errors"
<PClonable, PXML("UpdateRules401")> Private ReadOnly Property UpdateRules401_XML As PropertyValue
<PropertyOption(ControlText:="Try updating rules when you get a 401 error", Category:=CAT_ERRORS), HiddenControl>
Friend ReadOnly Property UpdateRules401 As PropertyValue
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
Set(ByVal d As Date)
LastDateUpdated_XML.Value = d
End Set
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."), PXML, PClonable>
Friend ReadOnly Property UseOldAuthRules As PropertyValue
<PropertyOption(ControlText:="Dynamic rules update", ControlToolTip:="'Dynamic rules' update interval (minutes). Default: 1440", LeftOffset:=110), 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."), PXML, PClonable>
Friend ReadOnly Property DynamicRules As PropertyValue
#End Region
#Region "OFScraper"
<PClonable, PXML("OFScraperPath")> Private ReadOnly Property OFScraperPath_XML As PropertyValue
<PropertyOption(ControlText:="OF-Scraper path", ControlToolTip:="The path to the 'ofscraper.exe'")>
<PropertyOption(ControlText:="OF-Scraper path", ControlToolTip:="The path to the 'ofscraper.exe'", Category:=CAT_OFS)>
Friend ReadOnly Property OFScraperPath As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
@@ -96,7 +100,7 @@ Namespace API.OnlyFans
End Get
End Property
<PClonable, PXML("OFScraperMP4decrypt")> Private ReadOnly Property OFScraperMP4decrypt_XML As PropertyValue
<PropertyOption(ControlText:="mp4decrypt path", ControlToolTip:="The path to the 'mp4decrypt.exe'")>
<PropertyOption(ControlText:="mp4decrypt path", ControlToolTip:="The path to the 'mp4decrypt.exe'", Category:=CAT_OFS)>
Friend ReadOnly Property OFScraperMP4decrypt As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
@@ -108,7 +112,7 @@ Namespace API.OnlyFans
End Property
Friend Const KeyModeDefault_Default As String = "cdrm"
<PClonable, PXML("KeyModeDefault")> Private ReadOnly Property KeyModeDefault_XML As PropertyValue
<PropertyOption(ControlText:="key-mode-default")>
<PropertyOption(ControlText:="key-mode-default", Category:=CAT_OFS)>
Friend ReadOnly Property KeyModeDefault As PropertyValue
Get
If Not DefaultInstance Is Nothing Then
@@ -118,12 +122,30 @@ Namespace API.OnlyFans
End If
End Get
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
#End Region
#End Region
#Region "Initializer"
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)
If Rules Is Nothing Then
Rules = New DynamicRulesEnv
Rules.Update(False, True)
End If
_AllowUserAgentUpdate = False
With Responser
.Accept = "application/json, text/plain, */*"
.AutomaticDecompression = Net.DecompressionMethods.GZip
@@ -154,13 +176,6 @@ Namespace API.OnlyFans
DownloadHighlights = 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))
If ACheck(OFScraperPath_XML.Value) Then
Dim f As SFile = OFScraperPath_XML.Value
@@ -175,6 +190,9 @@ Namespace API.OnlyFans
End If
OFScraperMP4decrypt_XML = New PropertyValue(String.Empty, GetType(String))
KeyModeDefault_XML = New PropertyValue(KeyModeDefault_Default)
Keydb_Api_XML = New PropertyValue(String.Empty, GetType(String))
UpdateRules401_XML = New PropertyValue(False)
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "onlyfans.com/"), 1, EDP.ReturnValue)
UrlPatternUser = "https://onlyfans.com/{0}"
@@ -187,10 +205,28 @@ Namespace API.OnlyFans
End Function
#End Region
#Region "Update"
Friend Overrides Sub BeginUpdate()
_TempSettingsEnv.DisposeIfReady
_TempSettingsEnv = Nothing
MyBase.BeginUpdate()
End Sub
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()
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
#Region "Download"
Friend Overrides Function BaseAuthExists() As Boolean

View File

@@ -91,6 +91,7 @@ Namespace API.OnlyFans
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
_DownloadingException_AuthFileUpdate = False
If Not MySettings.SessionAborted Then
ValidateOFScraper()
_AbsMediaIndex = 0
@@ -393,6 +394,14 @@ Namespace API.OnlyFans
Loop While Not _complete
End Sub
#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,
Optional ByRef Result As Boolean = False, Optional ByVal IsHL As Boolean = False,
Optional ByVal SpecFolder As String = Nothing, Optional ByVal PostUserID As String = Nothing,
@@ -404,11 +413,14 @@ Namespace API.OnlyFans
With n("media")
If .ListExists Then
For Each m In .Self
If IsHL Then
postUrl = m.Value({"files", "source"}, "url")
Else
postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
End If
postUrl = GetMediaURL(m)
'If IsHL Then
' 'postUrl = m.Value({"files", "source"}, "url")
' postUrl = GetMediaURL(m)
'Else
' 'postUrl = m.Value({"source"}, "source").IfNullOrEmpty(m.Value("full"))
' postUrl = GetMediaURL(m)
'End If
postUrlBase = String.Empty
Select Case m.Value("type")
Case "photo" : t = UTypes.Picture : ext = "jpg"
@@ -537,36 +549,16 @@ Namespace API.OnlyFans
End Sub
#End Region
#Region "Auth"
Private ReadOnly Property AuthFile As SFile
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
Private Function UpdateSignature(ByVal Path As String) As Boolean
Try
If UpdateAuthFile(ForceUpdateAuth) Then
Const nullMsg$ = "The auth parameter is null"
Dim j As EContainer
Try
j = JsonDocument.Parse(AuthFile.GetText)
Catch jex As Exception
If Round = 0 Then
AuthFile.Delete()
UpdateAuthFile(True)
Return UpdateSignature(Path, ForceUpdateAuth, Round + 1)
Else
MySettings.SessionAborted = True
Return False
End If
End Try
If Not Rules.Update(False) Then Rules.Update(True)
If Rules.Exists Then
Const nullMsg$ = "The auth parameter(s) is null"
Dim j As EContainer = Rules.CurrentContainer
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)
pattern = pattern.Replace("{}", "{0}").Replace("{:x}", "{1:x}")
Dim li%() = j("checksum_indexes").Select(Function(e) CInt(e(0).Value)).ToArray
@@ -590,38 +582,16 @@ Namespace API.OnlyFans
Responser.Headers.Add(HeaderSign, sign)
Responser.Headers.Add(HeaderTime, t)
j.Dispose()
Return True
End If
Else
MySettings.SessionAborted = True
End If
Return False
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendToLog + EDP.ReturnValue, ex, $"{ToStringForLog()}: UpdateSignature", False)
End Try
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
Dim s As New Security.Cryptography.SHA1CryptoServiceProvider
Dim inputBytes() As Byte = System.Text.Encoding.UTF8.GetBytes(Input)
@@ -653,37 +623,51 @@ Namespace API.OnlyFans
Private Function OFS_CreateConfig() As SFile
Try
Const confMainPattern$ = "{0}"": ""([^""]*)"""
Const confMainPatternRulesManual$ = "DYNAMIC_RULE"": (""[^""]*"")"
If OFSCache Is Nothing Then OFSCache = If(IsSingleObjectDownload, Settings.Cache.NewInstance, CreateCache())
Dim currentCache As CacheKeeper = OFSCache.NewInstance
currentCache.Validate()
Dim cacheRoot As SFile = currentCache.NewPath
cacheRoot.Exists(SFO.Path, True, EDP.ThrowException)
Dim f As SFile = $"{SettingsFolderName}\OFScraperConfigPattern.json"
Dim f As SFile = Rules.OFScraperConfigPatternFile
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
Dim replaceValue$ = String.Empty
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)
Dim ff As SFile
configText = f.GetText
Dim updateConf As Action(Of String, String) = Sub(ByVal patternValue As String, ByVal __replaceValue As String)
rp.Pattern = String.Format(confMainPattern, patternValue)
rp.Nothing = configText
replaceValue = __replaceValue
configText = RegexReplace(configText, rp)
End Sub
Dim updateConf As Action(Of String, String, Boolean) =
Sub(ByVal patternValue As String, ByVal __replaceValue As String, ByVal __isRules As Boolean)
rp.Pattern = String.Format(IIf(__isRules, confMainPatternRulesManual, confMainPattern), patternValue)
rp.Nothing = configText
replaceValue = __replaceValue
configText = RegexReplace(configText, rp)
End Sub
If Not configText.IsEmptyString Then
updateConf("save_location", cacheRoot.PathNoSeparator.Replace("\", "/"))
updateConf("save_location", cacheRoot.PathNoSeparator.Replace("\", "/"), False)
If ACheck(MySettings.OFScraperMP4decrypt.Value) Then
ff = CStr(MySettings.OFScraperMP4decrypt.Value)
If ff.Exists Then updateConf("mp4decrypt", ff.ToString.Replace("\", "/"))
If ff.Exists Then updateConf("mp4decrypt", ff.ToString.Replace("\", "/"), False)
End If
If Settings.FfmpegFile.Exists Then updateConf("ffmpeg", Settings.FfmpegFile.File.ToString.Replace("\", "/"), False)
updateConf("key-mode-default", CStr(MySettings.KeyModeDefault.Value).IfNullOrEmpty(SiteSettings.KeyModeDefault_Default), False)
updateConf("keydb_api", CStr(MySettings.Keydb_Api.Value), False)
If Rules.RulesReplaceConfig Then
If Rules.RulesConfigManualMode Then
updateConf(DynamicRulesEnv.DynamicRulesConfig_Mode_NodeName, "manual", False)
configText = configText.Replace(DynamicRulesEnv.DynamicRulesConfigNodeName_URL, DynamicRulesEnv.DynamicRulesConfigNodeName_RULES)
updateConf(DynamicRulesEnv.DynamicRulesConfigNodeName_RULES, Rules.CurrentContainerRulesText, True)
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, False)
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), False)
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.Name = "config"
f.Extension = "json"
@@ -776,14 +760,20 @@ Namespace API.OnlyFans
Private _DownloadingException_AuthFileUpdate 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
If Responser.StatusCode = Net.HttpStatusCode.BadRequest Then '400
If Not _DownloadingException_AuthFileUpdate AndAlso UpdateAuthFile(True) Then
If Responser.StatusCode = Net.HttpStatusCode.BadRequest Or
(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
Return 2
Else
MySettings.SessionAborted = True
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
ElseIf Responser.StatusCode = Net.HttpStatusCode.NotFound Then '404
UserExists = False

View File

@@ -287,7 +287,7 @@ Namespace API.Pinterest
End Function
End Class
Private Function GetDataFromGalleryDL(ByVal URL As String, ByVal IsBoardsRequested As Boolean, ByVal Token As CancellationToken) As List(Of String)
Dim command$ = $"gallery-dl --verbose --simulate "
Dim command$ = $"""{Settings.GalleryDLFile.File}"" --verbose --simulate "
Try
If Not URL.IsEmptyString Then
If MySettings.CookiesNetscapeFile.Exists Then command &= $"--cookies ""{MySettings.CookiesNetscapeFile}"" "

View File

@@ -21,6 +21,6 @@ Namespace API.Reddit
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)
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 Namespace

View File

@@ -8,6 +8,7 @@
' but WITHOUT ANY WARRANTY
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.Reddit.M3U8_Declarations
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web
@@ -61,15 +62,18 @@ Namespace API.Reddit
Private ReadOnly ProgressExists As Boolean
Private ReadOnly Property ProgressPre As PreProgress
Private ReadOnly UsePreProgress As Boolean
Private ReadOnly Media As UserMedia
#End Region
Private Sub New(ByVal URL As String, ByVal OutFile As SFile, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean)
Private Sub New(ByVal URL As String, ByVal Media As UserMedia, ByVal OutFile As SFile, ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean)
PlayListURL = URL
Me.Media = Media
BaseURL = RegexReplace(URL, BaseUrlPattern)
Video = New List(Of String)
Audio = New List(Of String)
Me.OutFile = OutFile
Me.OutFile.Name = "PlayListFile"
Me.OutFile.Extension = "mp4"
If Media.Post.Date.HasValue Then Me.OutFile.Name = Media.Post.Date.Value.ToString("yyyyMMdd_HHmmss")
Me.Progress = Progress
ProgressExists = Not Me.Progress Is Nothing
ProgressPre = New PreProgress(Progress)
@@ -202,9 +206,9 @@ Namespace API.Reddit
End Function
#End Region
#Region "Statics"
Friend Shared Function Download(ByVal URL As String, ByVal f As SFile, ByVal Token As CancellationToken,
Friend Shared Function Download(ByVal URL As String, ByVal Media As UserMedia, ByVal f As SFile, ByVal Token As CancellationToken,
ByVal Progress As MyProgress, ByVal UsePreProgress As Boolean) As SFile
Using m As New M3U8(URL, f, Progress, UsePreProgress) : Return m.Download(Token) : End Using
Using m As New M3U8(URL, Media, f, Progress, UsePreProgress) : Return m.Download(Token) : End Using
End Function
#End Region
#Region "IDisposable Support"

View File

@@ -10,6 +10,7 @@ Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.Base
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
@@ -34,6 +35,8 @@ Namespace API.Reddit
"You can find different tokens in the responses. Make sure that bearer token belongs to Reddit and not RedGifs." & vbCr &
"There is not need to add a token if you are not using cookies to download the timeline.", IsAuth:=True)>
Friend ReadOnly Property BearerToken As PropertyValue
<PropertyOption(ControlText:="Use 'cUrl' to get a token", IsAuth:=True), PXML, PClonable, HiddenControl>
Private ReadOnly Property BearerTokenUseCurl As PropertyValue
#Region "TokenUpdateInterval"
<PropertyOption(ControlText:="Token refresh interval", ControlToolTip:="Interval (in minutes) to refresh the token",
AllowNull:=False, LeftOffset:=120, IsAuth:=True), PXML, PClonable>
@@ -55,7 +58,6 @@ Namespace API.Reddit
Return {AuthUserName.Value, AuthPassword.Value, ApiClientID.Value, ApiClientSecret.Value}.All(Function(v$) Not v.IsEmptyString)
End Get
End Property
#End Region
#Region "Other"
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos", IsAuth:=False), PXML, PClonable>
@@ -82,7 +84,8 @@ Namespace API.Reddit
ApiClientID = New PropertyValue(String.Empty, GetType(String))
ApiClientSecret = New PropertyValue(String.Empty, GetType(String))
BearerToken = New PropertyValue(token, GetType(String), Sub(v) Responser.Headers.Add(DeclaredNames.Header_Authorization, v))
TokenUpdateInterval = New PropertyValue(60 * 12)
BearerTokenUseCurl = New PropertyValue(True)
TokenUpdateInterval = New PropertyValue(360)
TokenUpdateIntervalProvider = New TokenRefreshIntervalProvider
BearerTokenDateUpdate = New PropertyValue(Now.AddYears(-1))
UseTokenForTimelines = New PropertyValue(False)
@@ -98,6 +101,14 @@ Namespace API.Reddit
ImageVideoContains = "reddit.com"
UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/\?&]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
End Sub
Private Const SettingsVersionCurrent As Integer = 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
#Region "GetInstance"
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
@@ -269,29 +280,51 @@ Namespace API.Reddit
result = False
Dim r$ = String.Empty
Dim c% = 0
Dim _found As Boolean
Dim useCurl As Boolean = Settings.CurlFile.Exists And CBool(BearerTokenUseCurl.Value)
Dim curlUsed As Boolean = useCurl
Do
c += 1
Using resp As New Responser With {
.Method = "POST",
.ProcessExceptionDecision = Function(status, obj, ee) If(status.StatusCode = 429, EDP.ReturnValue, ee)
.ProcessExceptionDecision = Function(ByVal status As IResponserStatus, ByVal nullArg As Object, ByVal currErr As ErrorsDescriber) As ErrorsDescriber
If status.StatusCode = 429 Then
useCurl = False
Return EDP.ReturnValue
ElseIf status.StatusCode = Net.HttpStatusCode.Forbidden And Not useCurl And Settings.CurlFile.Exists Then
useCurl = True
Return EDP.ReturnValue
Else
Return currErr
End If
End Function
}
With resp
With .PayLoadValues
.Add("grant_type", "password")
.Add("username", UserName)
.Add("password", Password)
End With
.CredentialsUserName = ClientID
.CredentialsPassword = ClientSecret
.PreAuthenticate = True
If useCurl Then
If Settings.CurlFile.Exists Then
curlUsed = True
.Mode = Responser.Modes.Curl
.CurlPath = Settings.CurlFile
.CurlArgumentsLeft = $"-d ""grant_type=password&username={UserName}&password={Password}"" --user ""{ClientID}:{ClientSecret}"""
Else
Throw New ArgumentNullException("cUrl file", "The path to the cUrl file is not specified")
End If
Else
.Mode = Responser.Modes.Default
With .PayLoadValues
.Add("grant_type", "password")
.Add("username", UserName)
.Add("password", Password)
End With
.CredentialsUserName = ClientID
.CredentialsPassword = ClientSecret
.PreAuthenticate = True
End If
End With
r = resp.GetResponse("https://www.reddit.com/api/v1/access_token",, EDP.ThrowException)
End Using
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
_found = True
Dim newToken$ = j.Value("access_token")
If Not newToken.IsEmptyString Then
BearerToken.Value = $"Bearer {newToken}"
@@ -302,7 +335,7 @@ Namespace API.Reddit
End If
End Using
End If
Loop While c < 5 And Not _found
Loop While c < 5 And Not result
End If
Return result
Catch ex As Exception

View File

@@ -225,6 +225,7 @@ Namespace API.Reddit
#End Region
#Region "Download Overrides"
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
Err429Count = 0
_CrossPosts.Clear()
If CreatedByChannel And Settings.FromChannelDownloadTopUse And Settings.FromChannelDownloadTop > 0 Then _
DownloadTopCount = Settings.FromChannelDownloadTop.Value
@@ -287,6 +288,7 @@ Namespace API.Reddit
End Sub
#End Region
#Region "Download Functions (User, Channel)"
Private Err429Count As Integer = 0
Private _TotalPostsDownloaded As Integer = 0
Private ReadOnly _CrossPosts As List(Of String)
Private Const SiteGfycatKey As String = "gfycat"
@@ -375,6 +377,7 @@ Namespace API.Reddit
Loop While Not _completed
End Sub
Private Sub DownloadDataChannel(ByVal POST As String, ByVal Token As CancellationToken)
Const savedPostsSleepTimer% = 2000
Dim eObj% = 0
Dim round% = 0
Dim URL$ = String.Empty
@@ -392,12 +395,14 @@ Namespace API.Reddit
If IsSavedPosts Then
URL = $"https://www.reddit.com/user/{TrueName}/saved.json?after={POST}"
If Not POST.IsEmptyString Then Thread.Sleep(savedPostsSleepTimer)
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"
End If
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If IsSavedPosts Then Err429Count = 0
If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
If w.Count > 0 Then
@@ -458,8 +463,12 @@ Namespace API.Reddit
End If
_completed = True
Catch ex As Exception
If ProcessException(ex, Token, $"channel data downloading error [{URL}]",, eObj) = HttpStatusCode.InternalServerError Then
Dim errValue% = ProcessException(ex, Token, $"{IIf(IsSavedPosts, "saved posts", "channel")} data downloading error [{URL}]",, eObj)
If errValue = HttpStatusCode.InternalServerError Then
If round = 2 Then eObj = HttpStatusCode.InternalServerError
ElseIf errValue = 429 And round = 0 Then
Thread.Sleep(savedPostsSleepTimer)
round += 1
Else
_completed = True
End If
@@ -905,19 +914,24 @@ Namespace API.Reddit
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey, RedGifsAccount)
If RedGifsHost Is Nothing Then RedGifsHost = Settings(RedGifs.RedGifsSiteKey).Default
RedGifsResponser = RedGifsHost.Responser.Copy
Dim respNoHeaders As Responser = Responser.Copy
Dim m As UserMedia, m2 As UserMedia
Dim r$
Dim r$, url$
Dim j As EContainer
Dim lastCount%, li%
Dim rv As New ErrorsDescriber(EDP.ReturnValue)
respNoHeaders.Headers.Clear()
ProgressPre.ChangeMax(_ContentList.Count)
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
ProgressPre.Perform()
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
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
j = JsonDocument.Parse(r, EDP.ReturnValue)
j = JsonDocument.Parse(r, rv)
If Not j Is Nothing Then
If j.Count > 0 Then
lastCount = _TempMediaList.Count
@@ -975,7 +989,7 @@ Namespace API.Reddit
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID, .UserID = _UserID}}
If t = UTypes.Picture Or t = UTypes.GIF Then m.File = CreateFileFromUrl(m.URL) Else m.File = Nothing
If ReplacePreview And m.URL.Contains("preview") And Not t = UTypes.Picture Then m.URL = $"https://i.redd.it/{m.File.File}"
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateTrueProvider(IsChannel), Nothing) Else m.Post.Date = Nothing
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateTrueProvider(IsChannel Or IsSavedPosts), Nothing) Else m.Post.Date = Nothing
Return m
End Function
Private Function TryFile(ByVal URL As String) As Boolean
@@ -1027,7 +1041,7 @@ Namespace API.Reddit
Return URL.Contains(SiteRedGifsKey)
End Function
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile, ByVal Token As CancellationToken) As SFile
Return M3U8.Download(URL, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
Return M3U8.Download(URL, Media, DestinationFile, Token, Progress, Not IsSingleObjectDownload)
End Function
Protected Overrides Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
If Not IsChannel Or Not SaveToCache Then
@@ -1057,8 +1071,11 @@ Namespace API.Reddit
ElseIf .StatusCode = HttpStatusCode.InternalServerError Then '500
If Not IsNothing(EObj) AndAlso IsNumeric(EObj) AndAlso CInt(EObj) = HttpStatusCode.InternalServerError Then Return 1
Return HttpStatusCode.InternalServerError
ElseIf .StatusCode = 429 And IsSavedPosts And Err429Count = 0 Then
Err429Count += 1
Return 429
ElseIf .StatusCode = 429 AndAlso
((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And MySiteSettings.UseTokenForSavedPosts.Value)) AndAlso
((Not IsSavedPosts And CBool(MySiteSettings.UseTokenForTimelines.Value)) Or (IsSavedPosts And CBool(MySiteSettings.UseTokenForSavedPosts.Value))) AndAlso
Not MySiteSettings.CredentialsExists Then '429
MyMainLOG = $"{ToStringForLog()}: [{CInt(Responser.StatusCode)}] You should use OAuth authorization or disable " &
IIf(IsSavedPosts, "token usage for downloading saved posts", "the use of token and cookies for downloading timelines")

View File

@@ -18,9 +18,9 @@ Namespace API.RedGifs
<Manifest(RedGifsSiteKey)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
<PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), DependentFields(NameOf(UserAgent)), ControlNumber(1), PClonable(Clone:=False)>
<PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), DependentFields(NameOf(UserAgent)), ControlNumber(1), PClonable(Clone:=False), HiddenControl>
Friend ReadOnly Property Token As PropertyValue
<PropertyOption, ControlNumber(2), PClonable>
<PropertyOption, ControlNumber(2), PClonable, HiddenControl>
Private ReadOnly Property UserAgent As PropertyValue
<PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue
Private Const TokenName As String = "authorization"
@@ -107,7 +107,9 @@ Namespace API.RedGifs
Friend Overrides Sub Update()
If _SiteEditorFormOpened Then
Dim NewToken$ = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
If Not _LastTokenValue = NewToken Then TokenLastDateUpdated.Value = Now
If Not _LastTokenValue = NewToken And Not NewToken.IsEmptyString Then TokenLastDateUpdated.Value = Now
If Responser.CookiesExists AndAlso MsgBoxE({"RedGifs doesn't require cookies! Do you still want to use cookies?", "RedGifs cookies"},
vbExclamation,,, {"Use", "Don't use"}) = 1 Then Responser.Cookies.Clear()
End If
MyBase.Update()
End Sub

View File

@@ -13,8 +13,9 @@ Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports PersonalUtilities.Functions.RegularExpressions
Imports IG = SCrawler.API.Instagram.SiteSettings
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.ThreadsNet
<Manifest("AndyProgram_ThreadsNet"), SeparatedTasks(1)>
<Manifest("AndyProgram_ThreadsNet"), SavedPosts, SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
#Region "Authorization"
@@ -25,6 +26,10 @@ Namespace API.ThreadsNet
Return __HH_CSRF_TOKEN
End Get
End Property
<CookieValueExtractor(NameOf(HH_CSRF_TOKEN))>
Private Function GetValueFromCookies(ByVal PropName As String, ByVal c As CookieKeeper) As String
Return c.GetCookieValue(IG.Header_CSRF_TOKEN_COOKIE, PropName, NameOf(HH_CSRF_TOKEN))
End Function
<PClonable> Protected ReadOnly __HH_IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", AllowNull:=False, IsAuth:=True), ControlNumber(10)>
Friend Overridable ReadOnly Property HH_IG_APP_ID As PropertyValue
@@ -36,10 +41,10 @@ Namespace API.ThreadsNet
Friend ReadOnly Property HH_ASBD_ID As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua", AllowNull:=True, IsAuth:=True,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua), ControlNumber(30), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER As PropertyValue
Friend ReadOnly Property HH_BROWSER As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-full", ControlToolTip:=SettingsCLS.HEADER_DEF_sec_ch_ua_full_version_list, AllowNull:=True, IsAuth:=True,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_full_version_list), ControlNumber(40), PClonable, PXML(OnlyForChecked:=True)>
Private ReadOnly Property HH_BROWSER_EXT As PropertyValue
Friend ReadOnly Property HH_BROWSER_EXT As PropertyValue
<PropertyOption(ControlText:="sec-ch-ua-platform-ver", ControlToolTip:=SettingsCLS.HEADER_DEF_sec_ch_ua_platform_version, AllowNull:=True, IsAuth:=True, LeftOffset:=135,
InheritanceName:=SettingsCLS.HEADER_DEF_sec_ch_ua_platform_version), ControlNumber(50), PClonable, PXML(OnlyForChecked:=True)>
Friend ReadOnly Property HH_PLATFORM_VER As PropertyValue
@@ -71,14 +76,14 @@ Namespace API.ThreadsNet
#Region "Other properties"
<PropertyOption(ControlText:="Request timer (any)",
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." & IG.TimersUrgentTip, AllowNull:=False),
vbCr & "The default value is 1'000." & vbCr & "The minimum value is 0." & IG.TimersUrgentTip, AllowNull:=False, Category:=DN.CAT_Timers),
PXML, PClonable>
Friend ReadOnly Property RequestsWaitTimer_Any As PropertyValue
<Provider(NameOf(RequestsWaitTimer_Any), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimer_AnyProvider As IFormatProvider
<PropertyOption(ControlText:="Download data",
ControlToolTip:="The internal value indicates that site data should be downloaded." & vbCr &
"It becomes unchecked when the site returns an error."), PXML>
"It becomes unchecked when the site returns an error.", Category:="Download"), PXML>
Friend ReadOnly Property DownloadData_Impl As PropertyValue
#End Region
#End Region
@@ -123,9 +128,10 @@ Namespace API.ThreadsNet
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "cors"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchSite, "same-origin"))
.Add("Sec-Fetch-User", "?1")
.Add("dht", 1)
.Add("dnt", 1)
.Add("drp", 1)
.Add(Instagram.UserData.GQL_HEADER_FB_FRINDLY_NAME, "BarcelonaProfileThreadsTabRefetchableQuery")
.Remove("dht")
End With
.CookiesExtractMode = Responser.CookiesExtractModes.Any
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
@@ -195,7 +201,7 @@ Namespace API.ThreadsNet
End Sub
Friend Overrides Sub Update()
If _SiteEditorFormOpened And Responser.CookiesExists Then
Dim csrf$ = If(Responser.Cookies.FirstOrDefault(Function(c) c.Name.StringToLower = IG.Header_CSRF_TOKEN_COOKIE)?.Value, String.Empty)
Dim csrf$ = GetValueFromCookies(NameOf(HH_CSRF_TOKEN), Responser.Cookies)
If Not csrf.IsEmptyString Then HH_CSRF_TOKEN.Value = csrf
If Not __Cookies Is Nothing AndAlso Not __Cookies.ListEquals(Responser.Cookies) Then DownloadData_Impl.Value = True
End If

View File

@@ -17,6 +17,10 @@ Imports PersonalUtilities.Tools.Web.Clients.EventArguments
Imports IGS = SCrawler.API.Instagram.SiteSettings
Namespace API.ThreadsNet
Friend Class UserData : Inherits Instagram.UserData
#Region "XML names"
Private Const Name_MaxLastDownDate As String = "MaxLastDownDate"
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
#End Region
#Region "Declarations"
Private ReadOnly Property MySettings As SiteSettings
Get
@@ -29,9 +33,20 @@ Namespace API.ThreadsNet
Return ValidateBaseTokens() And Not ID.IsEmptyString
End Get
End Property
Private Property MaxLastDownDate As Date? = Nothing
Private Property FirstLoadingDone As Boolean = False
#End Region
#Region "Loader"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
MaxLastDownDate = AConvert(Of Date)(.Value(Name_MaxLastDownDate), DateTimeDefaultProvider, Nothing)
FirstLoadingDone = .Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
Else
.Add(Name_MaxLastDownDate, AConvert(Of String)(MaxLastDownDate, DateTimeDefaultProvider, String.Empty))
.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
End If
End With
End Sub
#End Region
#Region "Exchange"
@@ -49,6 +64,7 @@ Namespace API.ThreadsNet
DefaultParser_PostUrlCreator = Function(post) $"https://www.threads.net/@{NameTrue}/post/{post.Code}"
_ResponserAutoUpdateCookies = True
_ResponserAddResponseReceivedHandler = True
DefaultParser_Pinned = AddressOf IsPinnedPost
End Sub
#End Region
#Region "Download functions"
@@ -66,7 +82,32 @@ Namespace API.ThreadsNet
Responser.Method = "POST"
LoadSavePostsKV(True)
ResetBaseTokens()
DownloadData(String.Empty, Token)
Dim setMaxPostDate As Action(Of List(Of UserMedia)) =
Sub(ByVal l As List(Of UserMedia))
With (From c As UserMedia In l Where c.Post.Date.HasValue Select c.Post.Date.Value)
If .ListExists Then MaxLastDownDate = .Max : _ForceSaveUserInfo = True
End With
End Sub
If FirstLoadingDone Then
If Not MaxLastDownDate.HasValue And _ContentList.Count > 0 Then setMaxPostDate.Invoke(_ContentList)
Else
If _ContentList.Count > 0 Then
FirstLoadingDone = True
If Not MaxLastDownDate.HasValue Then setMaxPostDate.Invoke(_ContentList)
End If
End If
If FirstLoadingDone Then
DefaultParser_SkipPost = Nothing
Else
DefaultParser_SkipPost = AddressOf SkipPost
End If
If IsSavedPosts Then
DefaultParser_ElemNode = {"node", "thread_items", 0, "post"}
DownloadSavedPosts(String.Empty, Token)
Else
DownloadData(String.Empty, Token)
End If
If _TempMediaList.Count > 0 Then FirstLoadingDone = True : setMaxPostDate.Invoke(_TempMediaList)
Catch ex As Exception
errorFound = True
Throw ex
@@ -78,6 +119,25 @@ Namespace API.ThreadsNet
End Try
End If
End Sub
Private Function IsPinnedPost(ByVal Items As IEnumerable(Of EContainer), ByVal Index As Integer) As Boolean
Try
If IsSavedPosts Then
Return False
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
Catch ex As Exception
LogError(ex, "IsPinnedPost")
Return Not FirstLoadingDone
End Try
End Function
Private Function SkipPost(ByVal Items As IEnumerable(Of EContainer), ByVal Index As Integer, ByVal Post As PostKV) As Boolean
Return PostKvExists(Post)
End Function
Protected Overrides Sub UpdateResponser()
If Not Responser Is Nothing AndAlso Not Responser.Disposed Then
RemoveHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
@@ -90,22 +150,32 @@ Namespace API.ThreadsNet
Responser.Headers.Add(IGS.Header_CSRF_TOKEN, csrf)
End If
End Sub
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}"
Private Const GQL_P_DOC_ID As String = "6371597506283707"
Private Const GQL_P_NAME As String = "BarcelonaProfileThreadsTabRefetchableQuery"
Private Const GQL_S_DOC_ID_1 As String = "7758166704280174"
Private Const GQL_S_NAME_1 As String = "BarcelonaSavedPageViewerQuery"
Private Const GQL_S_DOC_ID_2 As String = "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 Overloads Sub DownloadData(ByVal Cursor As String, ByVal Token As CancellationToken)
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}"
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"
Dim URL$ = String.Empty
Try
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")
DownloadCheckCredentials()
Responser.Method = "POST"
Responser.Referer = $"https://www.threads.net/@{NameTrue}"
Responser.Headers.Add(GQL_HEADER_FB_LSD, Token_lsd)
Responser.Headers.Add(GQL_HEADER_FB_FRINDLY_NAME, GQL_P_NAME)
Dim nextCursor$ = String.Empty
Dim dataFound As Boolean = False
@@ -118,7 +188,7 @@ Namespace API.ThreadsNet
End If
vars = 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)
If j.ListExists Then
@@ -138,6 +208,47 @@ Namespace API.ThreadsNet
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Private Sub DownloadSavedPosts(ByVal Cursor As String, 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"
Dim URL$ = String.Empty
Try
DownloadCheckCredentials()
Responser.Method = "POST"
Responser.Referer = "https://www.threads.net/"
Responser.Headers.Add(GQL_HEADER_FB_LSD, Token_lsd)
Responser.Headers.Add(GQL_HEADER_FB_FRINDLY_NAME, If(Cursor.IsEmptyString, GQL_S_NAME_1, GQL_S_NAME_2))
Dim nextCursor$ = String.Empty
Dim dataFound As Boolean = False
Dim vars$ = SymbolsConverter.ASCII.EncodeSymbolsOnly("{" & If(Cursor.IsEmptyString, var_init, String.Format(var_cursor, 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(URL, Token)
If j.ListExists Then
With j({"data", "xdt_viewer", "text_app_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
End Using
If dataFound And Not nextCursor.IsEmptyString Then DownloadSavedPosts(nextCursor, Token)
Catch ex As Exception
ProcessException(ex, Token, $"saved posts downloading error [{URL}]")
End Try
End Sub
Private Function GetDocument(ByVal URL As String, ByVal Token As CancellationToken, Optional ByVal Round As Integer = 0) As EContainer
Try
ThrowAny(Token)
@@ -155,7 +266,7 @@ Namespace API.ThreadsNet
End Try
End Function
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()
Dim headers As New HttpHeaderCollection
headers.AddRange(Responser.Headers)
@@ -164,16 +275,27 @@ Namespace API.ThreadsNet
.Method = "GET"
.Referer = URL
With .Headers
.Remove(GQL_HEADER_FB_LSD)
.Clear()
.Add("dnt", 1)
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Authority, "www.threads.net"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.Origin, "https://www.threads.net"))
.Add("Sec-Ch-Ua-Model", "")
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaMobile, "?0"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecChUaPlatform, """Windows"""))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchDest, "document"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchMode, "navigate"))
.Add(HttpHeaderCollection.GetSpecialHeader(MyHeaderTypes.SecFetchSite, "none"))
.Add("Upgrade-Insecure-Requests", 1)
.Add("Sec-Fetch-User", "?1")
.Add(IGS.Header_Browser, MySettings.HH_BROWSER.Value)
.Add(IGS.Header_BrowserExt, MySettings.HH_BROWSER_EXT.Value)
End With
End With
WaitTimer()
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then
ParseTokens(r, 0)
If ID.IsEmptyString Then ID = RegexReplace(r, RParams.DMS("""props"":\{""user_id"":""(\d+)""\},", 1, EDP.ReturnValue))
If ID.IsEmptyString Then ID = RegexReplace(r, RParams.DMS("""props"":\{""user_id"":""(\d+)""", 1, EDP.ReturnValue))
End If
Return Valid
Catch ex As Exception

View File

@@ -15,6 +15,7 @@ Namespace API.Twitter
Friend Const TwitterSiteKey As String = "AndyProgram_Twitter"
Friend ReadOnly DateProvider As ADateTime = GetDateProvider()
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)
Private Function GetDateProvider() As ADateTime
Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone
n.FullDateTimePattern = "ddd MMM dd HH:mm:ss +ffff yyyy"

View File

@@ -8,6 +8,7 @@
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes
Imports DModels = SCrawler.API.Twitter.UserData.DownloadModels
Imports DN = SCrawler.API.Base.DeclaredNames
Namespace API.Twitter
Friend Class EditorExchangeOptions
Private Const DefaultOffset As Integer = 100
@@ -28,20 +29,26 @@ Namespace API.Twitter
Friend Overridable Property MediaModelAllowNonUserTweets As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Media'",
ToolTip:="Download the data using the 'https://twitter.com/UserName/media' command.", LeftOffset:=DefaultOffset)>
ToolTip:="Download the data using the 'https://x.com/UserName/media' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelMedia As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Profile'",
ToolTip:="Download the data using the 'https://twitter.com/UserName' command.", LeftOffset:=DefaultOffset)>
ToolTip:="Download the data using the 'https://x.com/UserName' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelProfile As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Search'",
ToolTip:="Download the data using the 'https://twitter.com/search?q=from:UserName+include:nativeretweets' command.", LeftOffset:=DefaultOffset)>
ToolTip:="Download the data using the 'https://x.com/search?q=from:UserName+include:nativeretweets' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelSearch As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Download model 'Likes'",
ToolTip:="Download the data using the 'https://x.com/UserName/likes' command.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelLikes As Boolean = False
<PSetting(Address:=SettingAddress.User,
Caption:="Force apply",
ToolTip:="Force overrides the default parameters for the first download." & vbCr & "Applies to first download only.", LeftOffset:=DefaultOffset)>
Friend Overridable Property DownloadModelForceApply As Boolean = False
<PSetting(Address:=SettingAddress.User, Caption:=DN.UserNameChangeCaption, ToolTip:=DN.UserNameChangeToolTip, LeftOffset:=DefaultOffset)>
Friend Overridable Property UserName As String = String.Empty
Private ReadOnly Property MySettings As Object
Friend Sub New(ByVal s As SiteSettings)
GifsDownload = s.GifsDownload.Value
@@ -73,8 +80,10 @@ Namespace API.Twitter
DownloadModelMedia = dm.Contains(DModels.Media)
DownloadModelProfile = dm.Contains(DModels.Profile)
DownloadModelSearch = dm.Contains(DModels.Search)
DownloadModelLikes = dm.Contains(DModels.Likes)
End If
End If
UserName = u.NameTrue(True)
MySettings = u.HOST.Source
End Sub
End Class

View File

@@ -16,32 +16,37 @@ Namespace API.Twitter
<Manifest(TwitterSiteKey), SavedPosts, SeparatedTasks, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
#Region "Categories"
Private Const CAT_DOWN As String = "Downloading"
#End Region
#Region "Other properties"
<PropertyOption(ControlText:="Use the appropriate model",
ControlToolTip:="Use the appropriate model for new users." & vbCr &
"If disabled, all download models will be used for the first download. " &
"Next, the appropriate download model will be automatically selected." & vbCr &
"Otherwise the appropriate download model will be selected right from the start."), PXML, PClonable>
"Otherwise the appropriate download model will be selected right from the start.", Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property UseAppropriateModel As PropertyValue
#Region "End points"
<PropertyOption(ControlText:="New endpoint: search", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the search model."), PXML, PClonable>
<PropertyOption(ControlText:="New endpoint: search", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the search model.",
Category:=CAT_DOWN), PXML, PClonable>
Friend Property UseNewEndPointSearch As PropertyValue
<PropertyOption(ControlText:="New endpoint: profiles", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the profile models."), PXML, PClonable>
<PropertyOption(ControlText:="New endpoint: profiles", ControlToolTip:="Use new endpoint argument (-o search-endpoint=graphql) for the profile models.",
Category:=CAT_DOWN), PXML, PClonable>
Friend Property UseNewEndPointProfiles As PropertyValue
#End Region
#Region "Limits"
<PropertyOption(ControlText:="Abort on limit", ControlToolTip:="Abort twitter downloading when limit is reached"), 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
<PropertyOption(ControlText:="Download already parsed", ControlToolTip:="Download already parsed content on abort"), PXML, PClonable>
<PropertyOption(ControlText:="Download already parsed", ControlToolTip:="Download already parsed content on abort", Category:=CAT_DOWN), PXML, PClonable>
Friend Property DownloadAlreadyParsed As PropertyValue
#End Region
<PropertyOption(ControlText:="Media Model: allow non-user tweets", ControlToolTip:="Allow downloading non-user tweets in the media-model."), 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
<PropertyOption(ControlText:=DN.GifsDownloadCaption), PXML, PClonable>
<PropertyOption(ControlText:=DN.GifsDownloadCaption, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsDownload As PropertyValue
<PropertyOption(ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip), PXML, PClonable>
<PropertyOption(ControlText:=DN.GifsSpecialFolderCaption, ControlToolTip:=DN.GifsSpecialFolderToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsSpecialFolder As PropertyValue
<PropertyOption(ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip), PXML, PClonable>
<PropertyOption(ControlText:=DN.GifsPrefixCaption, ControlToolTip:=DN.GifsPrefixToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property GifsPrefix As PropertyValue
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
Private ReadOnly Property GifStringChecker As IFormatProvider
@@ -63,17 +68,17 @@ Namespace API.Twitter
Throw New NotImplementedException("[GetFormat] is not available in the context of [GifStringProvider]")
End Function
End Class
<PropertyOption(ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip), PXML, PClonable>
<PropertyOption(ControlText:=DN.UseMD5ComparisonCaption, ControlToolTip:=DN.UseMD5ComparisonToolTip, Category:=DN.CAT_UserDefs), PXML, PClonable>
Friend ReadOnly Property UseMD5Comparison As PropertyValue
<PropertyOption(ControlText:=DN.ConcurrentDownloadsCaption,
ControlToolTip:=DN.ConcurrentDownloadsToolTip, AllowNull:=False, LeftOffset:=120), PXML, TaskCounter, PClonable>
ControlToolTip:=DN.ConcurrentDownloadsToolTip, AllowNull:=False, LeftOffset:=120, Category:=CAT_DOWN), PXML, TaskCounter, PClonable>
Friend ReadOnly Property ConcurrentDownloads As PropertyValue
<Provider(NameOf(ConcurrentDownloads), FieldsChecker:=True)>
Private ReadOnly Property MyConcurrentDownloadsProvider As IFormatProvider
#End Region
#End Region
Friend Sub New(ByVal AccName As String, ByVal Temp As Boolean)
MyBase.New(TwitterSite, "twitter.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)
LimitSkippedUsers = New List(Of UserDataBase)
@@ -96,8 +101,8 @@ Namespace API.Twitter
ConcurrentDownloads = New PropertyValue(1)
MyConcurrentDownloadsProvider = New ConcurrentDownloadsProvider
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, "/(twitter|x).com/"), 2)
UrlPatternUser = "https://twitter.com/{0}"
UserRegex = RParams.DMS(String.Format(UserRegexDefaultPattern, $"/(twitter|x).com({CommunitiesUser}|)/"), 3)
UrlPatternUser = "https://x.com/{0}"
ImageVideoContains = "twitter"
CheckNetscapeCookiesOnEndInit = True
UseNetscapeCookies = True
@@ -105,8 +110,9 @@ Namespace API.Twitter
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
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 $"https://twitter.com/{User.Name}/status/{Media.Post.ID}"
Return String.Format(SinglePostPattern, Media.Post.ID)
End Function
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists
@@ -146,5 +152,18 @@ Namespace API.Twitter
End If
MyBase.Update()
End Sub
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 GetUserUrl(ByVal User As IPluginContentProvider) As String
Return DirectCast(User, UserData).GetUserUrl
End Function
End Class
End Namespace

View File

@@ -26,13 +26,30 @@ Namespace API.Twitter
Private Const Name_GifsDownload As String = "GifsDownload"
Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder"
Private Const Name_GifsPrefix As String = "GifsPrefix"
Private Const Name_IsCommunity As String = "IsCommunity"
#End Region
#Region "Declarations"
Private Const Label_Community As String = "Community"
Private _NameTrue As String = String.Empty
Friend Property NameTrue(Optional ByVal Exact As Boolean = False) As String
Get
Return If(Exact, _NameTrue, _NameTrue.IfNullOrEmpty(Name))
End Get
Set(ByVal NewName As String)
_NameTrue = NewName
End Set
End Property
Friend Overrides ReadOnly Property SpecialLabels As IEnumerable(Of String)
Get
Return {Label_Community}
End Get
End Property
Friend Enum DownloadModels As Integer
Undefined = 0
Media = 1
Profile = 2
Search = 5
Likes = 10
End Enum
Private FirstDownloadComplete As Boolean = False
Friend Property DownloadModelForceApply As Boolean = False
@@ -41,6 +58,8 @@ Namespace API.Twitter
Friend Property GifsDownload As Boolean = True
Friend Property GifsSpecialFolder 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 _DataNames As List(Of String)
Private ReadOnly Property MySettings As SiteSettings
Get
@@ -55,6 +74,9 @@ Namespace API.Twitter
Private Function RenameGdlFile(ByVal Input As SFile, ByVal i As Integer) As SFile
Return SFile.Rename(Input, $"{Input.PathWithSeparator}{i.NumToString(FileNameProvider)}.{Input.Extension}",, EDP.ThrowException)
End Function
Friend Function GetUserUrl() As String
Return $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/{NameTrue}"
End Function
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object
@@ -68,12 +90,15 @@ Namespace API.Twitter
GifsPrefix = .GifsPrefix
UseMD5Comparison = .UseMD5Comparison
RemoveExistingDuplicates = .RemoveExistingDuplicates
If RemoveExistingDuplicates Then StartMD5Checked = False
DownloadModel = DownloadModels.Undefined
DownloadModelForceApply = .DownloadModelForceApply
MediaModelAllowNonUserTweets = .MediaModelAllowNonUserTweets
If .DownloadModelMedia Then DownloadModel += DownloadModels.Media
If .DownloadModelProfile Then DownloadModel += DownloadModels.Profile
If .DownloadModelSearch Then DownloadModel += DownloadModels.Search
If .DownloadModelLikes Then DownloadModel += DownloadModels.Likes
_NameTrue = .UserName
End With
End If
End Sub
@@ -81,6 +106,7 @@ Namespace API.Twitter
#Region "Initializer, loader"
Friend Sub New()
_DataNames = New List(Of String)
LikesPosts = New List(Of String)
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
@@ -117,7 +143,20 @@ Namespace API.Twitter
RemoveExistingDuplicates = .Value(Name_RemoveExistingDuplicates).FromXML(Of Boolean)(False)
StartMD5Checked = .Value(Name_StartMD5Checked).FromXML(Of Boolean)(False)
MediaModelAllowNonUserTweets = .Value(Name_MediaModelAllowNonUserTweets).FromXML(Of Boolean)(False)
IsCommunity = .Value(Name_IsCommunity).FromXML(Of Boolean)(False)
_NameTrue = .Value(Name_TrueName)
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_DownloadModelForceApply, DownloadModelForceApply.BoolToInteger)
.Add(Name_DownloadModel, CInt(DownloadModel))
@@ -128,6 +167,8 @@ Namespace API.Twitter
.Add(Name_RemoveExistingDuplicates, RemoveExistingDuplicates.BoolToInteger)
.Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger)
.Add(Name_MediaModelAllowNonUserTweets, MediaModelAllowNonUserTweets.BoolToInteger)
.Add(Name_IsCommunity, IsCommunity.BoolToInteger)
.Add(Name_TrueName, _NameTrue)
End If
End With
End Sub
@@ -142,21 +183,32 @@ Namespace API.Twitter
}
End Function
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If MySettings.LIMIT_ABORT Then
Throw New TwitterLimitException(Me)
Else
If IsSavedPosts Then
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.Post.ID), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData_SavedPosts(Token)
Try
If MySettings.LIMIT_ABORT Then
Throw New TwitterLimitException(Me)
Else
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData_Timeline(Token)
If IsSavedPosts Then
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.Post.ID), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData_SavedPosts(Token)
Else
LikesPosts.Clear()
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData_Timeline(Token)
If LikesPosts.Count > 0 Then
_ReparseLikes = True
ReparseMissing(Token)
_ReparseLikes = False
End If
End If
End If
End If
Finally
_ReparseLikes = False
End Try
End Sub
Private Sub DownloadData_Timeline(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Dim tCache As CacheKeeper = Nothing
Dim likesDetected As Boolean = False
Try
Const entry$ = "entry"
Dim PostID$ = String.Empty
@@ -173,14 +225,15 @@ Namespace API.Twitter
Dim newTwitterNodes() As Object = {0, "content", "items"}
Dim p As Predicate(Of EContainer)
Dim pIndx%
Dim indxChanged 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 __parseContainer As Func(Of EContainer, Boolean) =
Function(ByVal ee As EContainer) As Boolean
nn = Nothing
If dirIndx > 1 Then nn = ee
If Not nn.ListExists Then
If dirIndx > 1 Or IsCommunity Then nn = ee
If Not nn.ListExists Or IsCommunity Then
For Each node In nodes
nn = ee(node)
If nn.ListExists Then Exit For
@@ -199,6 +252,7 @@ Namespace API.Twitter
If Not _TempPostsList.Contains(PostID) Then
_TempPostsList.Add(PostID)
ElseIf dirIndx = 3 Then
ElseIf isPins Then
Return False
Else
@@ -211,9 +265,22 @@ Namespace API.Twitter
If tmpUserId.IsEmptyString Then tmpUserId = nn.ItemF({"extended_entities", "media", 0, sourceIdPredicate}).XmlIfNothingValue.
IfNullOrEmpty(nn.Value("user_id")).IfNullOrEmpty(nn.Value("user_id_str")).IfNullOrEmpty("/")
If Not ParseUserMediaOnly OrElse
If (Not ParseUserMediaOnly Or dirIndx = 3) OrElse
(dirIndx = 0 AndAlso MediaModelAllowNonUserTweets) OrElse
(Not ID.IsEmptyString AndAlso tmpUserId = ID) Then ObtainMedia(nn, PostID, PostDate)
(Not ID.IsEmptyString AndAlso tmpUserId = ID) Then
If dirIndx = 3 Then
Dim lUrl$ = nn.ItemF({"content", "itemContent", "tweet_results", "result", "legacy", "entities", "media", 0}, "expanded_url").XmlIfNothingValue
If Not lUrl.IsEmptyString Then
lUrl = RegexReplace(lUrl, StatusRegEx)
If Not lUrl.IsEmptyString Then
If Not _TempPostsList.Contains(lUrl) Then _TempPostsList.Add(lUrl) Else Return False
LikesPosts.ListAddValue(lUrl, LNC)
End If
End If
Else
ObtainMedia(nn, PostID, PostDate)
End If
End If
End If
Return True
End Function
@@ -225,6 +292,8 @@ Namespace API.Twitter
For Each dir As SFile In dirs
dirIndx += 1
If dirIndx = 3 Then likesDetected = True
ExistsDetected = False
If Not dir.IsEmptyString Then
@@ -238,10 +307,22 @@ Namespace API.Twitter
For i = 0 To timelineFiles.Count - 1
j = JsonDocument.Parse(timelineFiles(i).GetText)
If Not j Is Nothing Then
If i = 0 Then
If i = 0 And Not indxChanged Then
If Not userInfoParsed Then
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 __getImage As Action(Of String) = Sub(ByVal img As String)
If Not img.IsEmptyString Then
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
If resValue.IsEmptyString Then
UserExists = False
j.Dispose()
@@ -250,6 +331,29 @@ Namespace API.Twitter
UserSuspended = True
j.Dispose()
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 __getImage.Invoke(icon)
End If
End If
End With
End If
End With
End If
End With
i = -1
indxChanged = True
Else
With j({"data", "user", "result"})
If .ListExists Then
@@ -259,21 +363,11 @@ Namespace API.Twitter
End If
With .Item({"legacy"})
If .ListExists Then
If .Value("screen_name").StringToLower = Name.ToLower Then
If .Value("screen_name").StringToLower = NameTrue.ToLower Then
UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description"))
Dim __getImage As Action(Of String) = Sub(ByVal img As String)
If Not img.IsEmptyString Then
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")
icon = .Value("profile_image_url_https")
If Not icon.IsEmptyString Then icon = icon.Replace("_normal", String.Empty)
If DownloadIconBanner Then
__getImage.Invoke(.Value("profile_banner_url"))
@@ -285,29 +379,55 @@ Namespace API.Twitter
End If
End With
End If
ElseIf IsCommunity Then
i = -1
indxChanged = True
End If
Else
For pIndx = 0 To IIf(dirIndx < 2, 1, 0)
For pIndx = 0 To IIf(dirIndx < 2 Or dirIndx = 3, 1, 0)
optionalNode = Nothing
Select Case dirIndx
Case 0, 1
rootNode = j({"data", "user", "result", "timeline_v2", "timeline", "instructions"})
If rootNode.ListExists Then
p = If(pIndx = 0, pinNode, timelineNode)
isPins = pIndx = 0
rootNode = Nothing
If IsCommunity Then
With j({"data", "communityResults", "result", "community_media_timeline", "timeline", "instructions"})
If .ListExists Then
If i = 0 Then
rootNode = .Find(entriesNode, True)
Else
rootNode = .Find(moduleItemsPredicate, True)
End If
optionalNode = rootNode
rootNode = rootNode.Find(p, False)
If rootNode.ListExists Then rootNode = rootNode.Find(entriesNode, False)
End If
Case Else
isPins = False
rootNode = j({"globalObjects", "tweets"})
optionalNode = rootNode
End Select
End With
Else
Select Case dirIndx
Case 0, 1, 3
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
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))
If isOneNode Then
ProgressPre.Perform()
@@ -336,7 +456,6 @@ Namespace API.Twitter
End If
Next
'TODO: Twitter: is this line needed?
If ExistsDetected And i = 1 Then Exit For Else ExistsDetected = False
End If
j.Dispose()
@@ -369,12 +488,12 @@ Namespace API.Twitter
ProcessException(ex, Token, $"data downloading error [{URL}]")
Finally
If Not tCache Is Nothing Then tCache.Dispose()
If _TempPostsList.Count > 0 Then _TempPostsList.Sort()
If _TempPostsList.Count > 0 And Not likesDetected Then _TempPostsList.Sort()
End Try
End Sub
Private Sub DownloadData_SavedPosts(ByVal Token As CancellationToken)
Try
Dim f As SFile = GetDataFromGalleryDL("https://twitter.com/i/bookmarks", Settings.Cache, True, Token)
Dim f As SFile = GetDataFromGalleryDL("https://x.com/i/bookmarks", Settings.Cache, True, Token)
Dim files As List(Of SFile) = SFile.GetFiles(f, "*.txt")
If files.ListExists Then
ResetFileNameProvider(Math.Max(files.Count.ToString.Length, 3))
@@ -417,21 +536,24 @@ Namespace API.Twitter
#End Region
#Region "Obtain media"
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Attempts As Integer = 0)
Optional ByVal Attempts As Integer = 0, Optional ByVal SpecialFolder As String = Nothing)
Dim s As EContainer = e({"extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status", "extended_entities", "media"})
If If(s?.Count, 0) = 0 Then s = e({"retweeted_status_result", "result", "legacy", "extended_entities", "media"})
If If(s?.Count, 0) > 0 Then
Dim mUrl$
Dim media As UserMedia
For Each m As EContainer In s
If Not CheckVideoNode(m, PostID, PostDate, State) Then
If Not CheckVideoNode(m, PostID, PostDate, State, SpecialFolder) Then
mUrl = m.Value("media_url").IfNullOrEmpty(m.Value("media_url_https"))
If Not mUrl.IsEmptyString Then
Dim dName$ = UrlFile(mUrl)
If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then
_DataNames.Add(dName)
_TempMediaList.ListAddValue(MediaFromData(mUrl, PostID, PostDate, GetPictureOption(m), State, UTypes.Picture, Attempts), LNC)
media = MediaFromData(mUrl, PostID, PostDate, GetPictureOption(m), State, UTypes.Picture, Attempts)
If Not SpecialFolder.IsEmptyString Then media.SpecialFolder = SpecialFolder
_TempMediaList.ListAddValue(media, LNC)
End If
End If
End If
@@ -439,15 +561,17 @@ Namespace API.Twitter
End If
End Sub
Private Function CheckVideoNode(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal State As UStates = UStates.Unknown) As Boolean
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal SpecialFolder As String = Nothing) As Boolean
Try
If CheckForGif(w, PostID, PostDate, State) Then Return True
If CheckForGif(w, PostID, PostDate, State, SpecialFolder) Then Return True
Dim URL$ = GetVideoNodeURL(w)
If Not URL.IsEmptyString Then
Dim f$ = UrlFile(URL)
If Not f.IsEmptyString AndAlso Not _DataNames.Contains(f) Then
_DataNames.Add(f)
_TempMediaList.ListAddValue(MediaFromData(URL, PostID, PostDate,, State, UTypes.Video), LNC)
Dim m As UserMedia = MediaFromData(URL, PostID, PostDate,, State, UTypes.Video)
If Not SpecialFolder.IsEmptyString Then m.SpecialFolder = SpecialFolder
_TempMediaList.ListAddValue(m, LNC)
End If
Return True
End If
@@ -458,7 +582,7 @@ Namespace API.Twitter
End Try
End Function
Private Function CheckForGif(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal State As UStates = UStates.Unknown) As Boolean
Optional ByVal State As UStates = UStates.Unknown, Optional ByVal SpecialFolder As String = Nothing) As Boolean
Try
Dim gifUrl As Predicate(Of EContainer) = Function(e) Not e.Value("content_type").IsEmptyString AndAlso
e.Value("content_type").Contains("mp4") AndAlso
@@ -477,9 +601,13 @@ Namespace API.Twitter
If Not ff.IsEmptyString Then
If GifsDownload And Not _DataNames.Contains(ff) Then
m = MediaFromData(url, PostID, PostDate,, State, UTypes.Video)
If Not SpecialFolder.IsEmptyString Then m.SpecialFolder = SpecialFolder
f = m.File
If Not f.IsEmptyString And Not GifsPrefix.IsEmptyString Then f.Name = $"{GifsPrefix}{f.Name}" : m.File = f
If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = $"{GifsSpecialFolder}*"
If Not GifsSpecialFolder.IsEmptyString Then
If Not m.SpecialFolder.IsEmptyString Then m.SpecialFolder &= "\"
m.SpecialFolder &= $"{GifsSpecialFolder}*"
End If
_TempMediaList.ListAddValue(m, LNC)
End If
Return True
@@ -615,6 +743,7 @@ Namespace API.Twitter
Dim dir As SFile
Dim dm As List(Of DownloadModels) = EnumExtract(Of DownloadModels)(DownloadModel).ListIfNothing
Dim process As Boolean
Dim urlPrePattern$ = $"https://x.com{IIf(IsCommunity, SiteSettings.CommunitiesUser, String.Empty)}/"
Using tgdl As New TwitterGDL(Nothing, Token, MySettings.AbortOnLimit.Value) With {
.TempPostsList = _TempPostsList,
@@ -625,7 +754,7 @@ Namespace API.Twitter
}
tgdl.FileExchanger.DeleteCacheOnDispose = False
tgdl.FileExchanger.DeleteRootOnDispose = False
For i As Byte = 0 To 2
For i As Byte = 0 To IIf(IsCommunity, 0, 3)
dir = rootDir.NewPath
dir.Exists(SFO.Path, True, EDP.ThrowException)
outList.Add(dir)
@@ -633,9 +762,10 @@ Namespace API.Twitter
command = $"""{Settings.GalleryDLFile}"" --verbose --no-download --no-skip --config ""{conf}"" --write-pages "
command &= GdlGetIdFilterString()
Select Case i
Case 0 : command &= $"https://twitter.com/{Name}/media" : process = dm.Contains(DownloadModels.Media)
Case 1 : command &= $"https://twitter.com/{Name}" : process = dm.Contains(DownloadModels.Profile)
Case 2 : command &= $"-o search-endpoint=graphql https://twitter.com/search?q=from:{Name}+include:nativeretweets" : process = dm.Contains(DownloadModels.Search)
Case 0 : command &= $"{urlPrePattern}{NameTrue}/media" : process = dm.Contains(DownloadModels.Media) Or IsCommunity
Case 1 : command &= $"{urlPrePattern}{NameTrue}" : process = dm.Contains(DownloadModels.Profile)
Case 2 : command &= $"-o search-endpoint=graphql https://x.com/search?q=from:{NameTrue}+include:nativeretweets" : process = dm.Contains(DownloadModels.Search) And Not IsCommunity
Case 3 : command &= $"{urlPrePattern}{NameTrue}/likes" : process = dm.Contains(DownloadModels.Likes)
Case Else : process = False
End Select
'#If DEBUG Then
@@ -687,13 +817,13 @@ Namespace API.Twitter
End Function
#End Region
#Region "ReparseMissing"
Private _ReparseLikes As Boolean = False
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Const SinglePostPattern$ = "https://twitter.com/{0}/status/{1}"
Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
Dim cache As CacheKeeper = Nothing
Try
If ContentMissingExists Then
If ContentMissingExists Or (_ReparseLikes And LikesPosts.Count > 0) Then
Dim m As UserMedia
Dim PostDate$
Dim nodes As List(Of String()) = GetContainerSubnodes()
@@ -702,24 +832,24 @@ Namespace API.Twitter
Dim f As SFile
Dim i%, ii%
Dim files As List(Of SFile)
Dim lim%
Dim specFolder$ = IIf(_ReparseLikes, "Likes", String.Empty)
ResetFileNameProvider()
If IsSingleObjectDownload Then
cache = Settings.Cache
Else
cache = New CacheKeeper(DownloadContentDefault_GetRootDir.CSFilePS)
cache.CacheDeleteError = CacheDeletionError(cache)
End If
ProgressPre.ChangeMax(_ContentList.Count)
For i = 0 To _ContentList.Count - 1
cache = If(IsSingleObjectDownload, Settings.Cache, CreateCache())
If _ReparseLikes Then lim = LikesPosts.Count Else lim = _ContentList.Count
ProgressPre.ChangeMax(lim)
For i = 0 To lim - 1
ProgressPre.Perform()
If _ContentList(i).State = UStates.Missing Then
m = _ContentList(i)
If Not m.Post.ID.IsEmptyString Or (IsSingleObjectDownload And Not m.URL_BASE.IsEmptyString) Then
If _ReparseLikes OrElse _ContentList(i).State = UStates.Missing Then
m = If(_ReparseLikes, Nothing, _ContentList(i))
If Not m.Post.ID.IsEmptyString Or (IsSingleObjectDownload And Not m.URL_BASE.IsEmptyString) Or _ReparseLikes Then
ThrowAny(Token)
If IsSingleObjectDownload Then
URL = m.URL_BASE
ElseIf _ReparseLikes Then
URL = LikesPosts(i)
Else
URL = String.Format(SinglePostPattern, Name, m.Post.ID)
URL = String.Format(SiteSettings.SinglePostPattern, m.Post.ID)
End If
f = GetDataFromGalleryDL(URL, cache, False, Token)
If Not f.IsEmptyString Then
@@ -737,7 +867,7 @@ Namespace API.Twitter
If .ListExists Then
PostDate = String.Empty
If .Contains("created_at") Then PostDate = .Value("created_at") Else PostDate = String.Empty
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts)
ObtainMedia(.Self, m.Post.ID, PostDate, UStates.Missing, m.Attempts, specFolder)
rList.ListAddValue(i, LNC)
End If
End With
@@ -759,7 +889,7 @@ Namespace API.Twitter
ProcessException(ex, Token, $"ReparseMissing error [{URL}]")
Finally
If Not cache Is Nothing And Not IsSingleObjectDownload Then cache.Dispose()
If rList.Count > 0 Then
If rList.Count > 0 And Not _ReparseLikes Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
@@ -856,7 +986,7 @@ Namespace API.Twitter
#End Region
#Region "IDisposable support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _DataNames.Clear()
If Not disposedValue And disposing Then _DataNames.Clear() : LikesPosts.Clear()
MyBase.Dispose(disposing)
End Sub
#End Region

View File

@@ -299,6 +299,24 @@ Namespace API
End If
End Get
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()
Get
If Count > 0 Then
@@ -558,7 +576,7 @@ Namespace API
End Sub
#End Region
#Region "Move, Merge"
Friend Overrides Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile) As Boolean
Friend Overrides Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile, Optional ByVal NewUser As SplitCollectionUserInfo? = Nothing) As Boolean
Throw New NotImplementedException("Move files is not available in the collection context")
End Function
Friend Overloads Sub MergeData(ByVal Merging As Boolean)
@@ -601,7 +619,19 @@ Namespace API
"Operation canceled", MsgBoxStyle.Critical)
Return False
Else
_Item.MoveFiles(String.Empty, Nothing)
Dim uObj As SplitCollectionUserInfo? = DirectCast(_Item, UserDataBase).SplitCollectionGetNewUserInfo
If uObj.Value.SameDrive Then
uObj = Nothing
Else
Using f As New SplitCollectionUserInfoChangePathsForm({uObj})
f.ShowDialog()
Select Case f.DialogResult
Case DialogResult.OK : If f.Users(0).Changed Then uObj = f.Users(0) Else uObj = Nothing
Case DialogResult.Abort : Return False
End Select
End Using
End If
_Item.MoveFiles(String.Empty, Nothing, uObj)
MainFrameObj.ImageHandler(_Item)
AddRemoveBttDeleteHandler(_Item, False)
RaiseEvent OnUserRemoved(_Item)
@@ -618,7 +648,7 @@ Namespace API
End If
Dim m As New MMessage($"Collection [{CollectionName} (number of profiles: {Count})] may contain data" & vbCr &
"Are you sure you want to delete the collection and all of its files?", MsgTitle,
{New MsgBoxButton("Delete") With {.ToolTip = "Delete the collection and all files", .KeyCode = Keys.Enter},
{New MsgBoxButton("Delete", "Delete the collection and all files") With {.KeyCode = Keys.Enter},
New MsgBoxButton("Split") With {
.ToolTip = "Users will be removed from the collection and will be displayed in the program as separate users." & vbCr &
"All user data will remain.",
@@ -653,12 +683,31 @@ Namespace API
MsgBoxE({$"Collection [{CollectionName}] data merged{vbCr}Unable to split merged collection{vbCr}Operation canceled", MsgTitle}, vbExclamation)
Return 0
Else
Collections.ForEach(Sub(ByVal c As IUserData)
If c.MoveFiles(String.Empty, Nothing) Then
UserListLoader.UpdateUser(Settings.GetUser(c), True)
MainFrameObj.ImageHandler(c)
End If
End Sub)
Dim uu As New List(Of SplitCollectionUserInfo)(Collections.Select(Function(uuu As UserDataBase) uuu.SplitCollectionGetNewUserInfo))
If uu.All(Function(uuu) uuu.SameDrive) Then
uu.Clear()
Else
Using colPaths As New SplitCollectionUserInfoChangePathsForm(uu)
colPaths.ShowDialog()
Select Case colPaths.DialogResult
Case DialogResult.OK
If colPaths.Users.Any(Function(uuu) uuu.Changed) Then
uu = New List(Of SplitCollectionUserInfo)(colPaths.Users)
Else
uu.Clear()
End If
Case DialogResult.Abort : Return 0
End Select
End Using
End If
Collections.ListForEach(Sub(ByVal c As IUserData, ByVal indx As Integer)
Dim uObj As SplitCollectionUserInfo? = Nothing
If uu.Count > 0 AndAlso indx.ValueBetween(0, uu.Count - 1) AndAlso uu(indx).Changed Then uObj = uu(indx)
If c.MoveFiles(String.Empty, Nothing, uObj) Then
UserListLoader.UpdateUser(Settings.GetUser(c), True)
MainFrameObj.ImageHandler(c)
End If
End Sub)
If Collections.All(Function(c) c.CollectionName.IsEmptyString) Then
Settings.Users.Remove(Me)
Collections.Clear()

View File

@@ -265,7 +265,12 @@ Namespace API.Xhamster
Dim checkLimit As Func(Of Boolean) = Function() limit > 0 And SearchPostsCount >= limit And IsVideo
If IsSavedPosts Then
containerNodes.Add(If(IsVideo, {"favoriteVideoListComponent", "models"}, {"favoritesGalleriesAndPhotosCollection"}))
If IsVideo Then
containerNodes.Add({"favoriteVideoListComponent", "models"})
containerNodes.Add({"favoriteVideoListComponent", "videoThumbProps"})
Else
containerNodes.Add({"favoritesGalleriesAndPhotosCollection"})
End If
ElseIf Not SiteMode = SiteModes.Search Then
If IsVideo Then
containerNodes.Add({"trendingVideoListComponent", "models"})

View File

@@ -59,10 +59,10 @@ Namespace API.YouTube
.Cookies.Clear()
.Cookies.AddRange(Responser.Cookies)
.CookiesUpdated = True
.PerformUpdate()
End With
End If
End With
DirectCast(MyYouTubeSettings, YTSettings_Internal).PerformUpdate()
End If
MyBase.Update()
End Sub

View File

@@ -203,7 +203,7 @@ Namespace API.YouTube
If IsMusic Or DownloadYTVideos Then
maxDate = Nothing
LastDownloadDateVideos = nDate(LastDownloadDateVideos)
url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/{IIf(IsMusic Or IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}"
url = $"https://{IIf(IsMusic, "music", "www")}.youtube.com/{IIf(IsMusic Or IsChannelUser, $"{YouTubeFunctions.UserChannelOption}/", "@")}{ID}/videos"
container = YouTubeFunctions.Parse(url, YTUseCookies, Token, pr, __getMinDate(LastDownloadDateVideos), __maxDate,, True)
applySpecFolder.Invoke(IIf(IsMusic, String.Empty, "Videos"), False)
If fillList.Invoke(LastDownloadDateVideos, False) Then LastDownloadDateVideos = If(maxDate, Now)
@@ -345,6 +345,8 @@ Namespace API.YouTube
If resp.Status = Net.WebExceptionStatus.ConnectFailure And Round < 2 Then
Thread.Sleep(1000)
DownloadCommunity(Cursor, Token, Round + 1)
ElseIf resp.StatusCode = Net.HttpStatusCode.NotFound Then
MyMainLOG = $"{ToStringForLog()} {errMsg} (not found)"
Else
Throw resp.ErrorException
End If

Binary file not shown.

After

Width:  |  Height:  |  Size: 264 B

View File

@@ -58,7 +58,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Change 'ActiveDownloadingProgress' size")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub Downloader_Reconfigured()

View File

@@ -16,11 +16,13 @@ Imports PersonalUtilities.Tools.Notifications
Namespace DownloadObjects
Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider, IComparable(Of AutoDownloader)
Friend Event PauseChanged(ByVal Value As PauseModes)
Friend Event PlanChanged As Scheduler.PlanChangedEventHandler
Friend Enum Modes As Integer
None = 0
Specified = 3
Groups = 4
End Enum
Friend Const NoPauseMode As Integer = -100
Friend Enum PauseModes As Integer
Disabled = -2
Enabled = -1
@@ -198,6 +200,52 @@ Namespace DownloadObjects
Private Const Name_ShowSimpleNotification As String = "ShowSimpleNotification"
#End Region
#Region "Declarations"
Private _LVIState As Integer = 0
Friend Function LVIStateChanged() As Boolean
Dim ____LVIState%
Dim result As Boolean
If Downloading Then
____LVIState = 1
ElseIf DownloadReady(True, True) Or ForceStartRequested Then
____LVIState = 2
ElseIf Not Working And Not IsManual Then
____LVIState = 3
ElseIf IsPaused Then
____LVIState = 4
ElseIf Settings.AutomationBrushUndownloadedPlansMinutes.Value > 0 AndAlso
LastDownloadDate.AddMinutes(Settings.AutomationBrushUndownloadedPlansMinutes.Value) < Now Then
____LVIState = 5
Else
____LVIState = 0
End If
result = Not _LVIState = ____LVIState
_LVIState = ____LVIState
Return result
End Function
Friend ReadOnly Property LVI As ListViewItem
Get
Dim l As New ListViewItem(ToString)
If Downloading Then
l.BackColor = MyColor.OkBack
l.ForeColor = MyColor.OkFore
ElseIf DownloadReady(True, True) Or ForceStartRequested Then
l.BackColor = MyColor.EditBack
l.ForeColor = MyColor.EditFore
ElseIf Not Working And Not IsManual Then
l.BackColor = MyColor.DeleteBack
l.ForeColor = MyColor.DeleteFore
ElseIf Working And IsPaused And Not IsManual Then
l.BackColor = MyColor.UpdateBack
l.ForeColor = MyColor.UpdateFore
ElseIf Settings.AutomationBrushUndownloadedPlansMinutes.Value > 0 AndAlso
LastDownloadDate.AddMinutes(Settings.AutomationBrushUndownloadedPlansMinutes.Value) < Now Then
l.BackColor = Color.FromArgb(224, 224, 224)
l.ForeColor = Color.FromArgb(64, 64, 64)
End If
LVIStateChanged()
Return l
End Get
End Property
Friend Property Source As Scheduler
Private _Mode As Modes = Modes.None
Friend Property Mode As Modes
@@ -266,11 +314,15 @@ Namespace DownloadObjects
End Property
Private Function GetWorkingState() As String
Dim OutStr$
If Working Then
If StartupDelay > 0 And _StartTime.AddMinutes(StartupDelay) > Now Then
OutStr = $"delayed until {_StartTime.AddMinutes(StartupDelay).ToStringDate(ADateTime.Formats.BaseDateTime)}"
If Working And Not IsManual Then
If _Downloading Then
OutStr = "downloading"
ElseIf _ForceStartRequested Then
OutStr = "force start pending"
ElseIf _StopRequested Then
OutStr = "stopping"
ElseIf StartupDelay > 0 And _StartTime.AddMinutes(StartupDelay) > Now Then
OutStr = $"delayed ({StartupDelay}) until {_StartTime.AddMinutes(StartupDelay).ToStringDate(ADateTime.Formats.BaseDateTime)}"
Else
OutStr = "working"
End If
@@ -281,14 +333,26 @@ Namespace DownloadObjects
Case Else : OutStr &= $", paused ([{Pause}] until {AConvert(Of String)(_PauseValue, ADateTime.Formats.BaseDateTime, "?")})"
End Select
End If
ElseIf IsManual Then
If _Downloading Then
OutStr = "downloading"
ElseIf _ForceStartRequested Then
OutStr = "force start pending"
Else
OutStr = String.Empty
End If
Else
OutStr = "stopped"
End If
Return OutStr
End Function
Private Function GetWorkingState_Manual() As String
Dim OutStr$ = GetWorkingState()
If Not OutStr.IsEmptyString Then Return $" ({OutStr})" Else Return String.Empty
End Function
Public Overrides Function ToString() As String
If IsManual Then
Return $"{Name} (manual): last download date: {GetLastDateString()}"
Return $"{Name} (manual{GetWorkingState_Manual()}): last download date: {GetLastDateString()}"
Else
Return $"{Name} ({GetWorkingState()}): last download date: {GetLastDateString()}; next run: {GetNextDateString()}"
End If
@@ -315,9 +379,7 @@ Namespace DownloadObjects
Friend Sub New(ByVal x As EContainer)
Me.New
Initialization = True
Dim m% = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
If m = 1 Or m = 2 Then m = Modes.Specified
Mode = m
Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
Import(x)
If Name.IsEmptyString Then Name = "Default"
Groups.ListAddList(x.Value(Name_Groups).StringToList(Of String)("|"), LAP.NotContainsOnly)
@@ -394,10 +456,10 @@ Namespace DownloadObjects
End Function
#End Region
#Region "Execution"
Private AThread As Thread
Private _Working As Boolean = False
Friend ReadOnly Property Working As Boolean
Get
Return If(AThread?.IsAlive, False)
Return _Working
End Get
End Property
Private _StartTime As Date = Now
@@ -405,11 +467,8 @@ Namespace DownloadObjects
If Not IsManual Or Force Then
If Init Then _StartTime = Now
_IsNewPlan = False
If Not Working And Not Mode = Modes.None Then
AThread = New Thread(New ThreadStart(AddressOf Checker))
AThread.SetApartmentState(ApartmentState.MTA)
AThread.Start()
End If
If Not Working And Not Mode = Modes.None Then _Working = True
RaiseEvent PlanChanged(Me)
End If
End Sub
Private _StopRequested As Boolean = False
@@ -433,6 +492,7 @@ Namespace DownloadObjects
Case Else : _PauseValue = Nothing
End Select
RaiseEvent PauseChanged(p)
RaiseEvent PlanChanged(Me)
End Set
End Property
Private ReadOnly Property IsPaused As Boolean
@@ -456,7 +516,10 @@ Namespace DownloadObjects
End Get
End Property
Friend Sub [Stop]()
If Working Then _StopRequested = True
If Working Then
If Downloading Then _StopRequested = True Else _Working = False
RaiseEvent PlanChanged(Me)
End If
End Sub
Friend Overloads Sub Skip()
If LastDownloadDate.AddMinutes(Timer) <= Now Then
@@ -464,65 +527,59 @@ Namespace DownloadObjects
Else
_LastDownloadDateSkip = LastDownloadDate.AddMinutes(Timer)
End If
RaiseEvent PlanChanged(Me)
End Sub
Friend Overloads Sub Skip(ByVal Minutes As Integer)
_LastDownloadDateSkip = If(_LastDownloadDateSkip, Now).AddMinutes(Minutes)
RaiseEvent PlanChanged(Me)
End Sub
Friend Overloads Sub Skip(ByVal ToDate As Date)
_LastDownloadDateSkip = ToDate
RaiseEvent PlanChanged(Me)
End Sub
Friend Sub SkipReset()
_LastDownloadDateSkip = Nothing
RaiseEvent PlanChanged(Me)
End Sub
Friend Sub ForceStart()
_ForceStartRequested = True
If IsManual Then Start(False, True)
RaiseEvent PlanChanged(Me)
End Sub
Private _ForceStartRequested As Boolean = False
Private _SpecialDelayUse As Boolean = False
Private _SpecialDelayTime As Date? = Nothing
Private Sub Checker()
Try
Dim _StartDownload As Boolean
While (Not _StopRequested Or Downloader.Working) And Not Mode = Modes.None
If ((IsManual And _ForceStartRequested) Or (NextExecutionDate < Now And Not IsPaused) Or _ForceStartRequested) And
Not _StopRequested And Not Mode = Modes.None Then
If Downloader.Working Then
_SpecialDelayUse = True
Else
If _SpecialDelayUse And Not _SpecialDelayTime.HasValue Then _SpecialDelayTime = Now.AddSeconds(10)
If Not _SpecialDelayUse OrElse (_SpecialDelayTime.HasValue AndAlso _SpecialDelayTime.Value < Now) Then
_SpecialDelayUse = False
_SpecialDelayTime = Nothing
_StartDownload = False
If Settings.Automation.Count = 1 Or _ForceStartRequested Or Index = -1 Then
_StartDownload = True
Else
_StartDownload = NextExecutionDate.AddMilliseconds(1000 * (Index + 1)).Ticks <= Now.Ticks
End If
If _StartDownload Then
Download()
If IsManual Then Exit While
End If
End If
End If
Friend ReadOnly Property ForceStartRequested As Boolean
Get
Return _ForceStartRequested
End Get
End Property
Friend ReadOnly Property DownloadReady(Optional ByVal IgnorePause As Boolean = False, Optional ByVal IgnoreDownloaderWorking As Boolean = False) As Boolean
Get
If _StopRequested Then _Working = False
Return (Working Or IsManual) And ((IsManual And _ForceStartRequested) Or (Not IsManual And NextExecutionDate < Now And (Not IsPaused Or IgnorePause)) Or _ForceStartRequested) And
Not _StopRequested And Not Mode = Modes.None And (Not Downloader.Working Or IgnoreDownloaderWorking)
End Get
End Property
Friend ReadOnly Property NextDate As Date?
Get
If Not _StopRequested And Not Mode = Modes.None Then
If IsManual Or _ForceStartRequested Then
Return Now.AddYears(-10)
ElseIf Not IsPaused And Not IsManual And Working Then
Return NextExecutionDate
End If
Thread.Sleep(500)
End While
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[AutoDownloader.Checker]")
Finally
_StopRequested = False
End Try
End Sub
End If
Return Nothing
End Get
End Property
Private _Downloading As Boolean = False
Friend ReadOnly Property Downloading As Boolean
Get
Return _Downloading
End Get
End Property
Private Sub Download()
Friend Sub Download()
_Downloading = True
RaiseEvent PlanChanged(Me)
Dim Keys As New List(Of String)
Try
Dim users As New List(Of IUserData)
@@ -572,11 +629,23 @@ Namespace DownloadObjects
With Downloader
.AutoDownloaderWorking = True
If .Downloaded.Count > 0 Then .Downloaded.RemoveAll(Function(u) Keys.Contains(u.Key)) : .InvokeDownloadsChangeEvent()
Do : Try : doRound += 1 : .AddRange(users, True) : Exit Do : Catch iex As IndexOutOfRangeException : Thread.Sleep(200) : End Try : Loop While doRound < doLim
Do
Try
doRound += 1
.AddRange(users, True)
Exit Do
Catch iex As Exception
If doRound = doLim Then
Throw iex
Else
Thread.Sleep(200)
End If
End Try
Loop While doRound <= doLim
While .Working Or .Count > 0 : notify.Invoke() : Thread.Sleep(200) : End While
.AutoDownloaderWorking = False
notify.Invoke
If simple And DownloadedUsersCount + DownloadedSubscriptionsCount > 0 Then
If simple And (DownloadedUsersCount + DownloadedSubscriptionsCount) > 0 Then
Dim msg$ = String.Empty
If DownloadedUsersCount > 0 Then msg = $"{DownloadedUsersCount} user(s) "
If DownloadedSubscriptionsCount > 0 Then msg &= $"{IIf(DownloadedUsersCount > 0, "and ", String.Empty)}{DownloadedSubscriptionsCount} subscription(s) "
@@ -586,7 +655,7 @@ Namespace DownloadObjects
End With
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[AutoDownloader.Download]")
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"[AutoDownloader.Download({Name})]")
Finally
Keys.Clear()
LastDownloadDate = Now
@@ -594,6 +663,8 @@ Namespace DownloadObjects
_Downloading = False
_ForceStartRequested = False
_LastDownloadDateSkip = Nothing
If _StopRequested Then _Working = False
RaiseEvent PlanChanged(Me)
End Try
End Sub
Private Sub ShowNotification(ByVal u As IUserData)

View File

@@ -28,9 +28,10 @@ Namespace DownloadObjects
Dim ActionButton1 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(AutoDownloaderEditorForm))
Dim ActionButton2 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_NOTIFY As System.Windows.Forms.TableLayoutPanel
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TP_NOTIFY As System.Windows.Forms.TableLayoutPanel
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim ActionButton5 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.DEF_GROUP = New SCrawler.DownloadObjects.Groups.GroupDefaults()
Me.OPT_SPEC = New System.Windows.Forms.RadioButton()
@@ -178,9 +179,14 @@ Namespace DownloadObjects
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Name = "Edit"
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Name = "Clear"
ActionButton2.Name = "Info"
ActionButton2.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Info
ActionButton2.ToolTipText = "Open group"
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Clear"
Me.TXT_GROUPS.Buttons.Add(ActionButton1)
Me.TXT_GROUPS.Buttons.Add(ActionButton2)
Me.TXT_GROUPS.Buttons.Add(ActionButton3)
Me.TXT_GROUPS.CaptionText = "Groups"
Me.TXT_GROUPS.CaptionWidth = 50.0R
Me.TXT_GROUPS.Dock = System.Windows.Forms.DockStyle.Fill
@@ -260,9 +266,9 @@ Namespace DownloadObjects
'
'TXT_TIMER
'
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Refresh"
Me.TXT_TIMER.Buttons.Add(ActionButton3)
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Refresh"
Me.TXT_TIMER.Buttons.Add(ActionButton4)
Me.TXT_TIMER.CaptionText = "Timer"
Me.TXT_TIMER.CaptionToolTipEnabled = True
Me.TXT_TIMER.CaptionToolTipText = "Timer (in minutes)"
@@ -275,9 +281,9 @@ Namespace DownloadObjects
'
'NUM_DELAY
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Refresh"
Me.NUM_DELAY.Buttons.Add(ActionButton4)
ActionButton5.BackgroundImage = CType(resources.GetObject("ActionButton5.BackgroundImage"), System.Drawing.Image)
ActionButton5.Name = "Refresh"
Me.NUM_DELAY.Buttons.Add(ActionButton5)
Me.NUM_DELAY.CaptionText = "Delay"
Me.NUM_DELAY.CaptionToolTipEnabled = True
Me.NUM_DELAY.CaptionToolTipText = "Startup delay"

View File

@@ -189,6 +189,18 @@
</value>
</data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAAIGNIUk0AAHolAACAgwAA+f8AAIDpAAB1
MAAA6mAAADqYAAAXb5JfxUYAAAAJcEhZcwAADsQAAA7EAZUrDhsAAAFQSURBVFhH7ZfNDcIwFIMZoXcm
YBtGYRHECIgTR1ZhBsS9YoJgQ1Poi5sfqhIOWPqkqvV7dWlI0oVzriry5Dd5HSS0PFwasAEn0AJn4Dle
o6fpykaVHYDNwB7YG6ZgzWiQrABosAbqaXNh7bprN1AyAAp3b42msuva9ooGYIFpELA931D2FI+VxzAI
gTIdAEb+7KpBz+p4RclQyifoXwdKwgAwcMAl3/mEAOz9GJgokQGyR/sHr8CzlwFwgU+vCuagUQE4gSjz
HGxUAM5iyiyxUp4IJ5QEAYomHCvlidCiJAigjKNYKU8M6B/g9wJUH4TV/4ZFE5GV8kSQE1HRVGylPBHC
qbh0MbJSnhH0YtQFyFqOiZXyCOLLMQVDckNCrJRHEN+QeMGY3JJZKY8hb0vmxQLTYAplm1IvFNbblnuh
Qb0Pk3exGZjv06wW8uT3cIs7jQnSONrSxH0AAAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
@@ -203,22 +215,6 @@
<value>Show a simple notification instead of a user notification.
This means that if any user data has been downloaded with the plan, a simple notification will be shown with the number of users downloaded.
The 'Image' and 'User icon' parameters will be ignored.</value>
</data>
<data name="ActionButton3.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="ActionButton4.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
@@ -234,6 +230,22 @@ The 'Image' and 'User icon' parameters will be ignored.</value>
HhQDmFjYeHVKFp7WX/Xuv9Kq9/+Vd/z7r7rv/3+l7f//y676DEwDN/9L+BVvYkKLCTgDhNkkVUyVlr74
qbbz73/VOTc/qsy89kWx+9h7qbQpJwS1bbOAscGGrB6EUTggLOqf16C55ft/HlnNAFZOXgVWdi4FRgYG
VnR1MIwhwMTCyqEQ37qEmZVDFF0OE/9nAACtFF4Ey6OP+wAAAABJRU5ErkJggg==
</value>
</data>
<data name="ActionButton5.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>
</root>

View File

@@ -134,11 +134,26 @@ Namespace DownloadObjects
Private Sub TXT_GROUPS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles TXT_GROUPS.ActionOnButtonClick
Select Case Sender.DefaultButton
Case ActionButton.DefaultButtons.Edit
Using f As New LabelsForm(MyGroups, (From g As DownloadGroup In Settings.Groups Where Not g.IsViewFilter Select g.Name)) With {.Text = "Groups", .Icon = My.Resources.GroupByIcon_16}
Using f As New LabelsForm(MyGroups, (From g As DownloadGroup In Settings.Groups Where Not g.IsViewFilter Select g.Name)) With {
.Text = "Groups (F3 to edit)",
.Icon = My.Resources.GroupByIcon_16,
.IsGroups = True
}
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then MyGroups.ListAddList(f.LabelsList, LAP.ClearBeforeAdd) : TXT_GROUPS.Text = MyGroups.ListToString
End Using
Case ActionButton.DefaultButtons.Clear : MyGroups.Clear()
Case ActionButton.DefaultButtons.Info
Try
If MyGroups.Count > 0 Then
Dim i% = Settings.Groups.IndexOf(MyGroups(0))
If i >= 0 Then
Using gf As New GroupEditorForm(Settings.Groups(i)) : gf.ShowDialog() : End Using
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Show group")
End Try
End Select
End Sub
Private Sub ChangeEnabled() Handles OPT_DISABLED.CheckedChanged,

View File

@@ -14,15 +14,19 @@ Imports PauseModes = SCrawler.DownloadObjects.AutoDownloader.PauseModes
Namespace DownloadObjects
Friend Class Scheduler : Implements IEnumerable(Of AutoDownloader), IMyEnumerator(Of AutoDownloader), IDisposable
Friend Const Name_Plan As String = "Plan"
Friend Delegate Sub PlanChangedEventHandler(ByVal Plan As AutoDownloader)
Friend Event PauseChanged As AutoDownloader.PauseChangedEventHandler
Private Sub OnPauseChanged(ByVal Value As PauseModes)
RaiseEvent PauseChanged(Pause)
End Sub
Friend Event PlanChanged As PlanChangedEventHandler
Private Sub OnPlanChanged(ByVal Plan As AutoDownloader)
Try : RaiseEvent PlanChanged(Plan) : Catch : End Try
End Sub
Private ReadOnly Plans As List(Of AutoDownloader)
Friend Const FileNameDefault As String = "AutoDownload"
Friend ReadOnly FileDefault As SFile = $"{SettingsFolderName}\{FileNameDefault}.xml"
Friend File As SFile = Nothing
Private ReadOnly PlanWorking As Predicate(Of AutoDownloader) = Function(Plan) Plan.Working
Private ReadOnly PlanDownloading As Predicate(Of AutoDownloader) = Function(Plan) Plan.Downloading
Private ReadOnly PlansWaiter As Action(Of Predicate(Of AutoDownloader)) = Sub(ByVal Predicate As Predicate(Of AutoDownloader))
While Plans.Exists(Predicate) : Thread.Sleep(200) : End While
@@ -69,6 +73,7 @@ Namespace DownloadObjects
Friend Sub Add(ByVal Plan As AutoDownloader)
Plan.Source = Me
AddHandler Plan.PauseChanged, AddressOf OnPauseChanged
AddHandler Plan.PlanChanged, AddressOf OnPlanChanged
Plans.Add(Plan)
Plans.ListReindex
Update()
@@ -77,9 +82,9 @@ Namespace DownloadObjects
If Index.ValueBetween(0, Count - 1) Then
With Plans(Index)
.Stop()
If .Working Then
If .Downloading Then
Await Task.Run(Sub()
While .Working : Thread.Sleep(510) : End While
While .Downloading : Thread.Sleep(510) : End While
End Sub)
End If
.Dispose()
@@ -103,10 +108,10 @@ Namespace DownloadObjects
End Try
End Sub
Friend Function Reset(ByVal f As SFile, ByVal IsInit As Boolean) As Boolean
If Plans.Count > 0 Then
If Not Plans.Exists(PlanWorking) Then
If Count > 0 Then
If Not Plans.Exists(PlanDownloading) Then
Pause = PauseModes.Unlimited
If Plans.Exists(PlanWorking) Then
If Plans.Exists(PlanDownloading) Then
MsgBoxE({$"Some plans are already being worked.{vbCr}Wait for the plans to complete their work and try again.",
"Change scheduler"}, vbCritical)
Pause = PauseModes.Unlimited
@@ -114,6 +119,7 @@ Namespace DownloadObjects
End If
End If
[Stop]()
While Working : Thread.Sleep(200) : End While
If _UpdateRequired Then Update()
Plans.ListClearDispose(,, EDP.LogMessageValue)
End If
@@ -127,11 +133,12 @@ Namespace DownloadObjects
Plans.Add(New AutoDownloader(x))
End If
End Using
If Plans.Count > 0 Then Plans.ForEach(Sub(ByVal p As AutoDownloader)
p.Source = Me
If Not IsInit Then p.Pause = PauseModes.Unlimited
AddHandler p.PauseChanged, AddressOf OnPauseChanged
End Sub) : Plans.ListReindex
If Count > 0 Then Plans.ForEach(Sub(ByVal p As AutoDownloader)
p.Source = Me
If Not IsInit Then p.Pause = PauseModes.Unlimited
AddHandler p.PauseChanged, AddressOf OnPauseChanged
AddHandler p.PlanChanged, AddressOf OnPlanChanged
End Sub) : Plans.ListReindex
End If
Return True
End Function
@@ -163,38 +170,96 @@ Namespace DownloadObjects
End Sub
#End Region
#Region "Execution"
Private AThread As Thread = Nothing
Private _StopRequested As Boolean = False
Friend ReadOnly Property Working As Boolean
Get
Return If(AThread?.IsAlive, False)
End Get
End Property
Friend Async Function Start(ByVal Init As Boolean) As Task
Try
_StopRequested = False
Await Task.Run(Sub()
Dim r% = 0
Do
r += 1
Try
If Count > 0 Then
If Plans.Exists(PlanDownloading) Then PlansWaiter(PlanDownloading)
For Each Plan In Plans
Plan.Start(Init)
PlansWaiter(PlanDownloading)
Thread.Sleep(1000)
Next
End If
If Count > 0 Then PlansWaiter(PlanDownloading) : Plans.ForEach(Sub(p) p.Start(Init))
Exit Do
Catch io_ex As InvalidOperationException 'Collection was modified; enumeration operation may not execute
End Try
Loop While r < 10
End Sub)
If Not Working Then
AThread = New Thread(New ThreadStart(AddressOf Checker))
AThread.SetApartmentState(ApartmentState.MTA)
AThread.Start()
End If
Catch ex As Exception
If Init Then
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Start automation")
MainFrameObj.UpdateLogButton()
Else
Throw ex
End If
End Try
End Function
Friend Sub [Stop]()
If Working Then _StopRequested = True
If Count > 0 Then Plans.ForEach(Sub(p) p.Stop())
End Sub
Private Sub Checker()
Do
Try
If Count = 0 Or _StopRequested Then Exit Sub
PlansWaiter.Invoke(PlanDownloading)
Dim i% = Checker_GetNextPlanIndex()
If i >= 0 Then Checker_DownloadPlan(i)
Thread.Sleep(500)
Catch dex As ArgumentOutOfRangeException When disposedValue Or _StopRequested
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[Scheduler.Checker]")
End Try
Loop While Not _StopRequested
_StopRequested = False
End Sub
Private Sub Checker_DownloadPlan(ByVal PlanIndex As Integer)
While Downloader.Working : Thread.Sleep(200) : End While
With Plans(PlanIndex)
If .Downloading Then
PlansWaiter.Invoke(PlanDownloading)
ElseIf .DownloadReady Then
.Download()
If Settings.AutomationScript.Use AndAlso Not Settings.AutomationScript.Value.IsEmptyString AndAlso
(Not .IsManual Or Not Settings.AutomationScript_ExcludeManual) Then ExecuteCommand(Settings.AutomationScript)
End If
End With
End Sub
Private Function Checker_GetNextPlanIndex() As Integer
Try
Dim result% = -1
Dim l As New List(Of KeyValuePair(Of Integer, Date))
Dim d As Date?
If Count > 0 Then
For i% = 0 To Count - 1
With Plans(i)
If .DownloadReady Then
d = .NextDate
If d.HasValue Then l.Add(New KeyValuePair(Of Integer, Date)(i, d.Value))
End If
End With
Next
End If
If l.Count > 0 Then
Dim md As Date = l.Min(Function(p) p.Value)
result = l.Find(Function(p) p.Value = md).Key
l.Clear()
End If
Return result
Catch
Return -1
End Try
End Function
Friend Property Pause(Optional ByVal LimitDate As Date? = Nothing) As PauseModes
Get
If Count > 0 Then Return Plans.FirstOrDefault(Function(p) p.Pause >= PauseModes.Disabled).Pause Else Return PauseModes.Disabled
@@ -218,7 +283,8 @@ Namespace DownloadObjects
If Not disposedValue Then
If disposing Then
[Stop]()
If Plans.Exists(PlanWorking) Then Task.WaitAll(Task.Run(Sub() PlansWaiter(PlanWorking)))
If Plans.Exists(PlanDownloading) Then Task.WaitAll(Task.Run(Sub() PlansWaiter(PlanDownloading)))
While Working : Thread.Sleep(200) : End While
If _UpdateRequired Then Update()
Plans.ListClearDispose
End If

View File

@@ -23,7 +23,8 @@ Namespace DownloadObjects
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Me.LIST_PLANS = New System.Windows.Forms.ListBox()
Me.LIST_PLANS = New System.Windows.Forms.ListView()
Me.COL_MAIN = CType(New System.Windows.Forms.ColumnHeader(), System.Windows.Forms.ColumnHeader)
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
@@ -47,12 +48,25 @@ Namespace DownloadObjects
'
'LIST_PLANS
'
Me.LIST_PLANS.Alignment = System.Windows.Forms.ListViewAlignment.Left
Me.LIST_PLANS.Columns.AddRange(New System.Windows.Forms.ColumnHeader() {Me.COL_MAIN})
Me.LIST_PLANS.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_PLANS.FormattingEnabled = True
Me.LIST_PLANS.FullRowSelect = True
Me.LIST_PLANS.HeaderStyle = System.Windows.Forms.ColumnHeaderStyle.None
Me.LIST_PLANS.HideSelection = False
Me.LIST_PLANS.Location = New System.Drawing.Point(0, 0)
Me.LIST_PLANS.MultiSelect = False
Me.LIST_PLANS.Name = "LIST_PLANS"
Me.LIST_PLANS.ShowGroups = False
Me.LIST_PLANS.Size = New System.Drawing.Size(414, 316)
Me.LIST_PLANS.TabIndex = 0
Me.LIST_PLANS.UseCompatibleStateImageBehavior = False
Me.LIST_PLANS.View = System.Windows.Forms.View.Details
'
'COL_MAIN
'
Me.COL_MAIN.Text = "Task"
Me.COL_MAIN.Width = 410
'
'SchedulerEditorForm
'
@@ -63,7 +77,6 @@ Namespace DownloadObjects
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(430, 380)
Me.Name = "SchedulerEditorForm"
Me.ShowIcon = True
Me.ShowInTaskbar = False
Me.Text = "Scheduler"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
@@ -72,6 +85,7 @@ Namespace DownloadObjects
Me.ResumeLayout(False)
End Sub
Private WithEvents LIST_PLANS As ListBox
Private WithEvents LIST_PLANS As ListView
Private WithEvents COL_MAIN As ColumnHeader
End Class
End Namespace

View File

@@ -6,8 +6,12 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports System.ComponentModel
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Forms.Controls.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools
Imports ECI = PersonalUtilities.Forms.Toolbars.EditToolbar.ControlItem
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
@@ -129,6 +133,16 @@ Namespace DownloadObjects
SetTitle()
.EndLoaderOperations(False)
End With
SchedulerCheckerThread = New Thread(New ThreadStart(AddressOf SchedulerChecker))
SchedulerCheckerThread.SetApartmentState(ApartmentState.MTA)
SchedulerCheckerThread.Start()
Try : AddHandler Settings.Automation.PlanChanged, AddressOf Scheduler_PauseChanged : Catch : End Try
End Sub
Private _CloseRequested As Boolean = False
Private Sub SchedulerEditorForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
_CloseRequested = True
While If(SchedulerCheckerThread?.IsAlive, False) : Thread.Sleep(200) : End While
Try : RemoveHandler Settings.Automation.PlanChanged, AddressOf Scheduler_PauseChanged : Catch : End Try
End Sub
Private Sub SchedulerEditorForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
If e.KeyCode = Keys.Escape Then
@@ -141,21 +155,48 @@ Namespace DownloadObjects
Private Sub SchedulerEditorForm_Disposed(sender As Object, e As EventArgs) Handles Me.Disposed
PauseArr.Dispose()
End Sub
Private Sub SchedulerEditorForm_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
Try : ControlInvokeFast(LIST_PLANS, Sub()
COL_MAIN.Width = -2
LIST_PLANS.Refresh()
End Sub, EDP.None) : Catch : End Try
End Sub
#End Region
Private Property ListSelectedIndex As Integer
Get
Return If(LIST_PLANS.SelectedIndices.Count > 0, LIST_PLANS.SelectedIndices(0), -1)
End Get
Set(ByVal indx As Integer)
Try : ControlInvokeFast(LIST_PLANS, Sub()
With LIST_PLANS
.SelectedItems.Clear()
.Items(indx).Selected = True
.FocusedItem = .Items(indx)
.Refresh()
.EnsureVisible(indx)
End With
End Sub, EDP.None) : Catch : End Try
End Set
End Property
Private _RefillInProgress As Boolean = False
Private Sub Refill() Handles MyDefs.ButtonUpdateClick
Try
If Not _RefillInProgress Then
_RefillInProgress = True
LIST_PLANS.Items.Clear()
If Settings.Automation.Count > 0 Then
LIST_PLANS.Items.AddRange(Settings.Automation.Select(Function(a) a.ToString()).Cast(Of Object).ToArray)
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then LIST_PLANS.SelectedIndex = _LatestSelected
Else
_LatestSelected = -1
ControlInvokeFast(LIST_PLANS,
Sub()
If Not _RefillInProgress Then
_RefillInProgress = True
With LIST_PLANS.Items
.Clear()
If Settings.Automation.Count > 0 Then
.AddRange(Settings.Automation.Select(Function(a) a.LVI).ToArray)
If _LatestSelected.ValueBetween(0, .Count - 1) Then ListSelectedIndex = _LatestSelected
Else
_LatestSelected = -1
End If
End With
_RefillInProgress = False
End If
_RefillInProgress = False
End If
End Sub)
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadObjects.SchedulerEditorForm.Refill]")
End Try
@@ -194,7 +235,7 @@ Namespace DownloadObjects
Private Sub Edit() Handles MyDefs.ButtonEditClick
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
Using f As New AutoDownloaderEditorForm(Settings.Automation(_LatestSelected)) : f.ShowDialog() : End Using
Refill()
LIST_PLANS_Refresh(_LatestSelected)
Else
MsgBoxE("You have not selected a plan to edit.", vbExclamation)
End If
@@ -222,19 +263,83 @@ Namespace DownloadObjects
#End Region
#Region "List handlers"
Private _LatestSelected As Integer = -1
Private _LatestSelectedChangeEnabled As Boolean = True
Private Sub LIST_PLANS_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_PLANS.SelectedIndexChanged
_LatestSelected = LIST_PLANS.SelectedIndex
PauseArr.PlanIndex = _LatestSelected
PauseArr.UpdatePauseButtons(False)
If _LatestSelectedChangeEnabled Then
_LatestSelected = ListSelectedIndex
PauseArr.PlanIndex = _LatestSelected
PauseArr.UpdatePauseButtons(False)
End If
End Sub
Private Sub LIST_PLANS_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles LIST_PLANS.MouseDoubleClick
Edit()
End Sub
Private Sub LIST_PLANS_Refresh(Optional ByVal PlanIndex As Integer = -1)
_LatestSelectedChangeEnabled = False
Try
ControlInvokeFast(LIST_PLANS,
Sub()
Dim indx% = If(PlanIndex >= 0, PlanIndex, ListSelectedIndex)
If indx = -1 And PlanIndex = -1 Then indx = _LatestSelected
If indx.ValueBetween(0, Settings.Automation.Count - 1) Then _
LIST_PLANS.Items(indx) = Settings.Automation(indx).LVI
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then ListSelectedIndex = _LatestSelected
End Sub, EDP.None)
Catch
Finally
_LatestSelectedChangeEnabled = True
End Try
End Sub
Private Sub Scheduler_PauseChanged(ByVal Plan As AutoDownloader)
LIST_PLANS_Refresh(Plan.Index)
End Sub
Private SchedulerCheckerThread As Thread
Private Sub SchedulerChecker()
Try
While Not _CloseRequested
Try
With Settings.Automation
If .Count > 0 Then
For i% = 0 To .Count - 1
If .Item(i).LVIStateChanged Then LIST_PLANS_Refresh(i)
If _CloseRequested Then Exit Sub
Thread.Sleep(200)
Next
Else
If _CloseRequested Then Exit Sub
Thread.Sleep(200)
End If
End With
Catch
End Try
End While
Catch
End Try
End Sub
#End Region
#Region "Settings, Start, Skip, Pause"
Private Function GetSchedulerFiles() As List(Of SFile)
Return SFile.GetFiles(SettingsFolderName.CSFileP, $"{Scheduler.FileNameDefault}*.xml",, EDP.ReturnValue)
End Function
Private Class SchedulerList : Inherits SimpleListForm(Of String)
Friend Sub New(ByVal Source As IEnumerable(Of String), Optional ByRef DesignXML As EContainer = Nothing)
MyBase.New(Source, DesignXML)
End Sub
Protected Overrides Sub MyForm_Load(sender As Object, e As EventArgs)
MyBase.MyForm_Load(sender, e)
CMB_DATA.Button(ADB.Add).ToolTipText = "Create a new scheduler"
CMB_DATA.Button(ADB.SaveAs).ToolTipText = "Clone an existing scheduler and save it as a new one"
CMB_DATA.Button(ADB.Delete).ToolTipText = "Delete the selected scheduler"
CMB_DATA.Buttons.UpdateButtonsPositions()
End Sub
Protected Overrides Sub CMB_DATA_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As ActionButtonEventArgs)
If e.DefaultButton = ADB.SaveAs Then
AddNewItem(e, e.Key, e.KeyEventArgs)
Else
MyBase.CMB_DATA_ActionOnButtonClick(Sender, e)
End If
End Sub
End Class
Private Sub BTT_SETTINGS_Click(sender As Object, e As EventArgs) Handles BTT_SETTINGS.Click
Const msgTitle$ = "Change scheduler"
Try
@@ -244,7 +349,7 @@ Namespace DownloadObjects
If .ListExists Then .ForEach(Sub(ff) l.Add(ff, ff.Name.Replace(Scheduler.FileNameDefault, String.Empty).StringTrimStart("_").IfNullOrEmpty(defName)))
End With
If l.Count > 0 Then
Using chooser As New SimpleListForm(Of String)(l.Values.Cast(Of String), Settings.Design) With {
Using chooser As New SchedulerList(l.Values.Cast(Of String), Settings.Design) With {
.DesignXMLNodeName = "SchedulerChooserForm",
.Icon = ImageRenderer.GetIcon(My.Resources.ScriptPic_32, EDP.ReturnValue),
.FormText = "Schedulers",
@@ -256,17 +361,56 @@ Namespace DownloadObjects
Dim f As SFile
Dim selectedName$
Dim addedObj$ = String.Empty
Dim addedObjIsClone As Boolean = False
Dim createSchedulerPath As Func(Of String, SFile) = Function(n) $"{SettingsFolderName}\{Scheduler.FileNameDefault}_{n.StringRemoveWinForbiddenSymbols}.xml"
.ClearButtons()
.Buttons = {ADB.Add, ADB.Delete}
.Buttons = {ADB.Add, ADB.SaveAs, ADB.Delete}
AddHandler .AddClick, Sub(ByVal obj As Object, ByVal args As SimpleListFormEventArgs)
If addedObj.IsEmptyString Then
addedObj = InputBoxE("Enter a new scheduler name:", msgTitle)
args.Result = Not addedObj.IsEmptyString
If args.Result Then args.Item = addedObj
If args.Result Then
If l.Values.Count > 0 AndAlso l.Values.ListIndexOf(Function(n) n.StringToLower = addedObj.StringToLower) >= 0 Then
args.Result = False
MsgBoxE({$"A scheduler named '{addedObj}' already exists", msgTitle}, vbCritical)
Else
args.Item = addedObj
addedObjIsClone = Not args.ButtonEventArgs Is Nothing AndAlso
TypeOf args.ButtonEventArgs Is ActionButtonEventArgs AndAlso
DirectCast(args.ButtonEventArgs, ActionButtonEventArgs).DefaultButton = ADB.SaveAs
If addedObjIsClone Then
Dim cloneF As SFile = createSchedulerPath.Invoke(addedObj)
If Not cloneF.Exists And Settings.Automation.File.Exists Then
Using x As New XmlFile(Settings.Automation.File, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
x.Save(cloneF, EDP.SendToLog)
End Using
End If
End If
End If
End If
Else
MsgBoxE({"You can only create one scheduler at a time", "Create a new scheduler"}, vbCritical)
End If
End Sub
AddHandler .DeleteClick, Sub(ByVal obj As Object, ByVal args As SimpleListFormEventArgs)
Dim n$ = AConvert(Of String)(args.Item, String.Empty)
If Not n.IsEmptyString Then
If MsgBoxE({$"Are you sure you want to delete the '{n}' scheduler?", msgTitle}, vbExclamation,,,
{"Process", "Cancel"}) = 0 Then
Dim delF As SFile = createSchedulerPath.Invoke(n)
If delF.Exists AndAlso delF.Delete Then
args.Result = True
If l.ContainsKey(delF) Then
l.Remove(delF)
Else
Dim delIndx% = l.ListIndexOf(Function(dd) dd.Value = n)
If delIndx >= 0 Then l.Remove(l.Keys(delIndx))
End If
End If
End If
End If
End Sub
If Settings.Automation.File.Name = Scheduler.FileNameDefault Then
.DataSelectedIndexes.Add(0)
Else
@@ -279,7 +423,7 @@ Namespace DownloadObjects
If selectedName = defName Then
f = Settings.Automation.FileDefault
Else
f = $"{SettingsFolderName}\{Scheduler.FileNameDefault}_{selectedName.StringRemoveWinForbiddenSymbols}.xml"
f = createSchedulerPath.Invoke(selectedName)
End If
If Not Settings.Automation.File = f AndAlso Settings.Automation.Reset(f, False) Then
Settings.Automation.File = f
@@ -312,13 +456,13 @@ Namespace DownloadObjects
Private Sub BTT_START_Click(sender As Object, e As EventArgs) Handles BTT_START.Click
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
With Settings.Automation(_LatestSelected) : .Start(.IsNewPlan) : End With
Refill()
LIST_PLANS_Refresh(_LatestSelected)
End If
End Sub
Private Sub BTT_START_FORCE_Click(sender As Object, e As EventArgs) Handles BTT_START_FORCE.Click
If _LatestSelected.ValueBetween(0, LIST_PLANS.Items.Count - 1) Then
With Settings.Automation(_LatestSelected)
If .Working Or .IsManual Then .ForceStart() : Refill()
If .Working Or .IsManual Then .ForceStart() : LIST_PLANS_Refresh(_LatestSelected)
End With
End If
End Sub
@@ -328,10 +472,10 @@ Namespace DownloadObjects
Select Case mode
Case String.Empty
Settings.Automation(_LatestSelected).Skip()
Refill()
LIST_PLANS_Refresh(_LatestSelected)
Case "m"
Dim mins% = AConvert(Of Integer)(InputBoxE("Enter a number of minutes you want to delay:", Sender.Text, 60), -1)
If mins > 0 Then Settings.Automation(_LatestSelected).Skip(mins) : Refill()
If mins > 0 Then Settings.Automation(_LatestSelected).Skip(mins) : LIST_PLANS_Refresh(_LatestSelected)
Case "d"
Dim d As Date? = Nothing
Using f As New DateTimeSelectionForm(DateTimeSelectionForm.Modes.Date +
@@ -342,16 +486,13 @@ Namespace DownloadObjects
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then d = f.MyDateStart
End Using
If d.HasValue Then Settings.Automation(_LatestSelected).Skip(d.Value) : Refill()
If d.HasValue Then Settings.Automation(_LatestSelected).Skip(d.Value) : LIST_PLANS_Refresh(_LatestSelected)
Case "r"
Settings.Automation(_LatestSelected).SkipReset()
Refill()
LIST_PLANS_Refresh(_LatestSelected)
End Select
End If
End Sub
Private Sub PauseArr_Updating() Handles PauseArr.Updating
Refill()
End Sub
#End Region
#Region "Move"
Private Sub BTT_MOVE_UP_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_MOVE_UP.Click, BTT_MOVE_DOWN.Click

View File

@@ -35,6 +35,7 @@ Namespace DownloadObjects
Dim MENU_LOAD_SEP_7 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_0 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_8 As System.Windows.Forms.ToolStripSeparator
Dim MENU_LOAD_SEP_9 As System.Windows.Forms.ToolStripSeparator
Me.OPT_DEFAULT = New System.Windows.Forms.ToolStripMenuItem()
Me.OPT_SUBSCRIPTIONS = New System.Windows.Forms.ToolStripMenuItem()
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
@@ -44,6 +45,8 @@ Namespace DownloadObjects
Me.BTT_LOAD_SESSION_CHOOSE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_COPY_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MOVE_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_COPY_SPEC_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MOVE_SPEC_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOAD_FAV = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_LOAD_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_ADD_FAV = New System.Windows.Forms.ToolStripMenuItem()
@@ -57,19 +60,22 @@ Namespace DownloadObjects
Me.BTT_FEED_DELETE_SPEC = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_LIST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_DELETE_DAILY_DATE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CURR_SESSION_SET = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MERGE_SESSIONS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CLEAR_DAILY = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_RESET_DAILY = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MERGE_FEEDS = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CHECK_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CHECK_NONE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_SAVE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_LOAD = New System.Windows.Forms.ToolStripMenuItem()
Me.SEP_0 = New System.Windows.Forms.ToolStripSeparator()
Me.MENU_DOWN = New System.Windows.Forms.ToolStripDropDownButton()
Me.BTT_DOWN_ALL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_DOWN_SELECTED = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_REFRESH = New System.Windows.Forms.ToolStripButton()
Me.TP_DATA = New System.Windows.Forms.TableLayoutPanel()
Me.BTT_VIEW_SAVE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_VIEW_LOAD = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CURR_SESSION_SET_LAST = New System.Windows.Forms.ToolStripMenuItem()
SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
MENU_VIEW = New System.Windows.Forms.ToolStripDropDownButton()
@@ -82,6 +88,7 @@ Namespace DownloadObjects
MENU_LOAD_SEP_7 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_0 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_8 = New System.Windows.Forms.ToolStripSeparator()
MENU_LOAD_SEP_9 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout()
Me.SuspendLayout()
'
@@ -157,6 +164,16 @@ Namespace DownloadObjects
MENU_LOAD_SEP_0.Name = "MENU_LOAD_SEP_0"
MENU_LOAD_SEP_0.Size = New System.Drawing.Size(349, 6)
'
'MENU_LOAD_SEP_8
'
MENU_LOAD_SEP_8.Name = "MENU_LOAD_SEP_8"
MENU_LOAD_SEP_8.Size = New System.Drawing.Size(349, 6)
'
'MENU_LOAD_SEP_9
'
MENU_LOAD_SEP_9.Name = "MENU_LOAD_SEP_9"
MENU_LOAD_SEP_9.Size = New System.Drawing.Size(349, 6)
'
'ToolbarTOP
'
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
@@ -170,7 +187,7 @@ Namespace DownloadObjects
'
Me.MENU_LOAD_SESSION.AutoToolTip = False
Me.MENU_LOAD_SESSION.DisplayStyle = System.Windows.Forms.ToolStripItemDisplayStyle.Image
Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_CURRENT, Me.BTT_LOAD_SESSION_LAST, Me.BTT_LOAD_SESSION_CHOOSE, MENU_LOAD_SEP_0, Me.BTT_COPY_TO, Me.BTT_MOVE_TO, MENU_LOAD_SEP_1, Me.BTT_LOAD_FAV, Me.BTT_LOAD_SPEC, MENU_LOAD_SEP_2, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_ADD_FAV_REMOVE, Me.BTT_FEED_REMOVE_FAV, MENU_LOAD_SEP_3, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_ADD_SPEC_REMOVE, Me.BTT_FEED_REMOVE_SPEC, MENU_LOAD_SEP_4, Me.BTT_FEED_CLEAR_FAV, Me.BTT_FEED_CLEAR_SPEC, Me.BTT_FEED_DELETE_SPEC, Me.BTT_FEED_DELETE_DAILY_LIST, Me.BTT_FEED_DELETE_DAILY_DATE, MENU_LOAD_SEP_5, Me.BTT_MERGE_SESSIONS, Me.BTT_CLEAR_DAILY, MENU_LOAD_SEP_6, Me.BTT_MERGE_FEEDS, MENU_LOAD_SEP_7, Me.BTT_CHECK_ALL, Me.BTT_CHECK_NONE, MENU_LOAD_SEP_8, Me.BTT_VIEW_SAVE, Me.BTT_VIEW_LOAD})
Me.MENU_LOAD_SESSION.DropDownItems.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_LOAD_SESSION_CURRENT, Me.BTT_LOAD_SESSION_LAST, Me.BTT_LOAD_SESSION_CHOOSE, MENU_LOAD_SEP_0, Me.BTT_COPY_TO, Me.BTT_MOVE_TO, MENU_LOAD_SEP_1, Me.BTT_COPY_SPEC_TO, Me.BTT_MOVE_SPEC_TO, MENU_LOAD_SEP_2, Me.BTT_LOAD_FAV, Me.BTT_LOAD_SPEC, MENU_LOAD_SEP_3, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_ADD_FAV_REMOVE, Me.BTT_FEED_REMOVE_FAV, MENU_LOAD_SEP_4, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_ADD_SPEC_REMOVE, Me.BTT_FEED_REMOVE_SPEC, MENU_LOAD_SEP_5, Me.BTT_FEED_CLEAR_FAV, Me.BTT_FEED_CLEAR_SPEC, Me.BTT_FEED_DELETE_SPEC, Me.BTT_FEED_DELETE_DAILY_LIST, Me.BTT_FEED_DELETE_DAILY_DATE, MENU_LOAD_SEP_6, Me.BTT_CURR_SESSION_SET, Me.BTT_CURR_SESSION_SET_LAST, Me.BTT_MERGE_SESSIONS, Me.BTT_CLEAR_DAILY, Me.BTT_RESET_DAILY, MENU_LOAD_SEP_7, Me.BTT_MERGE_FEEDS, MENU_LOAD_SEP_8, Me.BTT_CHECK_ALL, Me.BTT_CHECK_NONE, MENU_LOAD_SEP_9, Me.BTT_VIEW_SAVE, Me.BTT_VIEW_LOAD})
Me.MENU_LOAD_SESSION.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.MENU_LOAD_SESSION.ImageTransparentColor = System.Drawing.Color.Magenta
Me.MENU_LOAD_SESSION.Name = "MENU_LOAD_SESSION"
@@ -212,6 +229,24 @@ Namespace DownloadObjects
Me.BTT_MOVE_TO.Size = New System.Drawing.Size(352, 22)
Me.BTT_MOVE_TO.Text = "Move checked to..."
'
'BTT_COPY_SPEC_TO
'
Me.BTT_COPY_SPEC_TO.AutoToolTip = True
Me.BTT_COPY_SPEC_TO.Image = Global.SCrawler.My.Resources.Resources.PastePic_32
Me.BTT_COPY_SPEC_TO.Name = "BTT_COPY_SPEC_TO"
Me.BTT_COPY_SPEC_TO.Size = New System.Drawing.Size(352, 22)
Me.BTT_COPY_SPEC_TO.Text = "Copy feed/session files to..."
Me.BTT_COPY_SPEC_TO.ToolTipText = "Copy all the files of the loaded feed/session to..."
'
'BTT_MOVE_SPEC_TO
'
Me.BTT_MOVE_SPEC_TO.AutoToolTip = True
Me.BTT_MOVE_SPEC_TO.Image = Global.SCrawler.My.Resources.Resources.CutPic_48
Me.BTT_MOVE_SPEC_TO.Name = "BTT_MOVE_SPEC_TO"
Me.BTT_MOVE_SPEC_TO.Size = New System.Drawing.Size(352, 22)
Me.BTT_MOVE_SPEC_TO.Text = "Move feed/session files to..."
Me.BTT_MOVE_SPEC_TO.ToolTipText = "Move all the files of the loaded feed/session to..."
'
'BTT_LOAD_FAV
'
Me.BTT_LOAD_FAV.Image = Global.SCrawler.My.Resources.Resources.HeartPic_32
@@ -303,6 +338,15 @@ Namespace DownloadObjects
Me.BTT_FEED_DELETE_DAILY_DATE.Size = New System.Drawing.Size(352, 22)
Me.BTT_FEED_DELETE_DAILY_DATE.Text = "Delete daily feed (by date)"
'
'BTT_CURR_SESSION_SET
'
Me.BTT_CURR_SESSION_SET.AutoToolTip = True
Me.BTT_CURR_SESSION_SET.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_CURR_SESSION_SET.Name = "BTT_CURR_SESSION_SET"
Me.BTT_CURR_SESSION_SET.Size = New System.Drawing.Size(352, 22)
Me.BTT_CURR_SESSION_SET.Text = "Set current session..."
Me.BTT_CURR_SESSION_SET.ToolTipText = "Select one of the download sessions and set it as the current session"
'
'BTT_MERGE_SESSIONS
'
Me.BTT_MERGE_SESSIONS.AutoToolTip = True
@@ -322,6 +366,15 @@ Namespace DownloadObjects
Me.BTT_CLEAR_DAILY.Text = "Clear session"
Me.BTT_CLEAR_DAILY.ToolTipText = "Clear current session"
'
'BTT_RESET_DAILY
'
Me.BTT_RESET_DAILY.AutoToolTip = True
Me.BTT_RESET_DAILY.Image = Global.SCrawler.My.Resources.Resources.RefreshPic_24
Me.BTT_RESET_DAILY.Name = "BTT_RESET_DAILY"
Me.BTT_RESET_DAILY.Size = New System.Drawing.Size(352, 22)
Me.BTT_RESET_DAILY.Text = "Reset current session"
Me.BTT_RESET_DAILY.ToolTipText = "A new file will be created for the current session"
'
'BTT_MERGE_FEEDS
'
Me.BTT_MERGE_FEEDS.AutoToolTip = True
@@ -343,6 +396,20 @@ Namespace DownloadObjects
Me.BTT_CHECK_NONE.Size = New System.Drawing.Size(352, 22)
Me.BTT_CHECK_NONE.Text = "Select none"
'
'BTT_VIEW_SAVE
'
Me.BTT_VIEW_SAVE.Name = "BTT_VIEW_SAVE"
Me.BTT_VIEW_SAVE.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_SAVE.Text = "Save current view"
'
'BTT_VIEW_LOAD
'
Me.BTT_VIEW_LOAD.AutoToolTip = True
Me.BTT_VIEW_LOAD.Name = "BTT_VIEW_LOAD"
Me.BTT_VIEW_LOAD.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_LOAD.Text = "Load view (from saved)"
Me.BTT_VIEW_LOAD.ToolTipText = "Load one of your previously saved views"
'
'SEP_0
'
Me.SEP_0.Name = "SEP_0"
@@ -409,24 +476,12 @@ Namespace DownloadObjects
Me.TP_DATA.Size = New System.Drawing.Size(484, 436)
Me.TP_DATA.TabIndex = 1
'
'MENU_LOAD_SEP_8
'BTT_CURR_SESSION_SET_LAST
'
MENU_LOAD_SEP_8.Name = "MENU_LOAD_SEP_8"
MENU_LOAD_SEP_8.Size = New System.Drawing.Size(349, 6)
'
'BTT_VIEW_SAVE
'
Me.BTT_VIEW_SAVE.Name = "BTT_VIEW_SAVE"
Me.BTT_VIEW_SAVE.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_SAVE.Text = "Save current view"
'
'BTT_VIEW_LOAD
'
Me.BTT_VIEW_LOAD.AutoToolTip = True
Me.BTT_VIEW_LOAD.Name = "BTT_VIEW_LOAD"
Me.BTT_VIEW_LOAD.Size = New System.Drawing.Size(352, 22)
Me.BTT_VIEW_LOAD.Text = "Load view (from saved)"
Me.BTT_VIEW_LOAD.ToolTipText = "Load one of your previously saved views"
Me.BTT_CURR_SESSION_SET_LAST.Image = Global.SCrawler.My.Resources.Resources.ArrowDownPic_Blue_24
Me.BTT_CURR_SESSION_SET_LAST.Name = "BTT_CURR_SESSION_SET_LAST"
Me.BTT_CURR_SESSION_SET_LAST.Size = New System.Drawing.Size(352, 22)
Me.BTT_CURR_SESSION_SET_LAST.Text = "Set last download session as current session"
'
'DownloadFeedForm
'
@@ -483,5 +538,10 @@ Namespace DownloadObjects
Private WithEvents BTT_MOVE_TO As ToolStripMenuItem
Private WithEvents BTT_VIEW_SAVE As ToolStripMenuItem
Private WithEvents BTT_VIEW_LOAD As ToolStripMenuItem
Private WithEvents BTT_CURR_SESSION_SET As ToolStripMenuItem
Private WithEvents BTT_COPY_SPEC_TO As ToolStripMenuItem
Private WithEvents BTT_MOVE_SPEC_TO As ToolStripMenuItem
Private WithEvents BTT_RESET_DAILY As ToolStripMenuItem
Private WithEvents BTT_CURR_SESSION_SET_LAST As ToolStripMenuItem
End Class
End Namespace

View File

@@ -159,10 +159,13 @@
<metadata name="MENU_LOAD_SEP_0.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="ToolbarTOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<metadata name="MENU_LOAD_SEP_8.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="MENU_LOAD_SEP_9.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="ToolbarTOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
</root>

View File

@@ -173,6 +173,7 @@ Namespace DownloadObjects
MENU_DOWN.Visible = OPT_SUBSCRIPTIONS.Checked
UpdateSettings()
FeedChangeMode(FeedModes.Current)
Downloader.FilesLoadLastSession()
RefillList(True, False)
.EndLoaderOperations(False)
End With
@@ -189,7 +190,6 @@ Namespace DownloadObjects
DataList.Clear()
End Sub
Private Sub DownloadFeedForm_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
'If e.KeyCode = Keys.F5 Then RefillList() : e.Handled = True
If Not e.Handled Then
Dim b As Boolean = False
If e = GoToButton Then
@@ -206,6 +206,8 @@ Namespace DownloadObjects
Case Keys.Down, Keys.Right, Keys.PageDown : changePage = 1
Case Keys.Home : gotoHome = True
Case Keys.End : gotoHome = False
Case Keys.Escape : If Settings.FeedEscToClose Then Close()
Case Else : If e.Control And e.KeyCode = Keys.W Then Close()
End Select
If changePage.HasValue Then
b = True
@@ -275,7 +277,6 @@ Namespace DownloadObjects
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Feed removed")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub Feed_SPEC_LOAD(ByVal Source As ToolStripMenuItem, ByVal e As EventArgs)
@@ -439,7 +440,9 @@ Namespace DownloadObjects
End Sub
Private Sub SessionChooser(ByVal GetLast As Boolean, Optional ByVal GetFilesOnly As Boolean = False,
Optional ByRef ResultFilesList As List(Of SFile) = Nothing,
Optional ByVal SelectedMode As FeedModes = -1)
Optional ByVal SelectedMode As FeedModes = -1,
Optional ByVal GetSessionFile As Boolean = False,
Optional ByRef SessionFile As SFile = Nothing)
Try
LoadedSessionName = String.Empty
Downloader.ClearSessions()
@@ -474,6 +477,12 @@ Namespace DownloadObjects
If fList.ListExists Then
If GetFilesOnly Then
ResultFilesList.AddRange(fList)
ElseIf GetSessionFile Then
If fList.Count > 1 Then
MsgBoxE({"You must select one session file", "Get session file"}, vbExclamation)
Else
SessionFile = fList(0)
End If
Else
DataList.Clear()
If SelectedMode >= 0 Then
@@ -507,17 +516,21 @@ Namespace DownloadObjects
f = Downloader.FilesSessionActual(False)
End If
If f.Exists Then
If SelectedMode >= 0 Then
If SelectedMode = FeedModes.Saved Then LoadedSessionName = f.Name
FeedChangeMode(SelectedMode)
If GetSessionFile Then
If Not Downloader.FilesSessionActual(False) = f Then SessionFile = f
Else
If SelectedMode >= 0 Then
If SelectedMode = FeedModes.Saved Then LoadedSessionName = f.Name
FeedChangeMode(SelectedMode)
End If
DataList.Clear()
x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then DataList.ListAddList(x, lcr)
x.Dispose()
CleanDataList()
RefillList(False, False)
End If
DataList.Clear()
x = New XmlFile(f,, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then DataList.ListAddList(x, lcr)
x.Dispose()
CleanDataList()
RefillList(False, False)
End If
Else
m.Text = "Saved sessions not found"
@@ -529,17 +542,24 @@ Namespace DownloadObjects
End Try
End Sub
#End Region
#Region "Move/Copy"
Private Sub BTT_COPY_MOVE_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_TO.Click, BTT_MOVE_TO.Click
MoveCopyFiles(True, sender, Nothing, Nothing)
End Sub
Private Function MoveCopyFiles(ByVal IsInternal As Boolean, ByVal Sender As Object, ByVal MCTOptions As FeedMoveCopyTo, ByVal FeedMediaData As FeedMedia) As Boolean
Const MsgTitle$ = "Copy/Move checked files"
Private Sub BTT_COPY_MOVE_SPEC_TO_Click(sender As Object, e As EventArgs) Handles BTT_COPY_SPEC_TO.Click, BTT_MOVE_SPEC_TO.Click
MoveCopyFiles(True, sender, Nothing, Nothing, False)
End Sub
Private Function MoveCopyFiles(ByVal IsInternal As Boolean, ByVal Sender As Object, ByVal MCTOptions As FeedMoveCopyTo,
ByVal FeedMediaData As FeedMedia, Optional ByVal GetChecked As Boolean = True) As Boolean
Dim MsgTitle$ = "Copy/Move checked files"
Try
Dim isCopy As Boolean = Not Sender Is Nothing AndAlso Sender Is BTT_COPY_TO
Dim isCopy As Boolean = Not Sender Is Nothing AndAlso (Sender Is BTT_COPY_TO OrElse Sender Is BTT_COPY_SPEC_TO)
Dim moveOptions As FeedMoveCopyTo = Nothing
Dim ff As SFile = Nothing, df As SFile
Dim data As IEnumerable(Of UserMediaD) = Nothing
Dim dd As UserMediaD
Dim __user As UserInfo
Dim __isSavedPosts As Boolean
Dim data_files As IEnumerable(Of SFile) = Nothing
Dim new_files As New List(Of SFile)
Dim mm As UserMediaD
@@ -555,10 +575,16 @@ Namespace DownloadObjects
Dim sesFilesReplaced As Boolean = False
Dim filesReplace As New List(Of KeyValuePair(Of SFile, SFile))
Dim updateFileLocations As Boolean = Settings.FeedMoveCopyUpdateFileLocationOnMove
Dim postUrl$
Dim result As Boolean = False
If FeedMediaData Is Nothing Then
data = GetCheckedMedia()
If GetChecked Then
data = GetCheckedMedia()
ElseIf DataList.Count > 0 Then
data = DataList.Where(Function(__dd) Not If(__dd.User?.IsSubscription, __dd.UserInfo.IsSubscription) AndAlso __dd.Data.File.Exists)
End If
With data
If .ListExists Then data_files = .Select(Function(m) m.Data.File)
End With
@@ -566,7 +592,18 @@ Namespace DownloadObjects
data = {FeedMediaData.Media}
data_files = {FeedMediaData.File}
End If
MsgTitle = $"{IIf(isCopy, "Copy", "Move")} {IIf(Not FeedMediaData Is Nothing Or GetChecked, "checked", "ALL")} files"
If data.ListExists Then
If (FeedMediaData Is Nothing And Not GetChecked And Not isCopy) AndAlso
MsgBoxE({$"YOU ARE TRYING TO MOVE ALL FEED/SESSION DATA.{vbCr}EVERY FILE WILL BE MOVED, NOT JUST THE SELECTED ONES.", MsgTitle},
vbExclamation,,, {"Process", "Cancel"}) = 1 Then
ShowOperationCanceledMsg(MsgTitle)
Return False
End If
If MCTOptions.Destination.IsEmptyString Then
Using f As New FeedCopyToForm(data_files, isCopy)
f.ShowDialog()
@@ -579,7 +616,6 @@ Namespace DownloadObjects
With moveOptions
If Not .Destination.IsEmptyString And .ReplaceUserProfile And .ReplaceUserProfile_CreateIfNull And .ReplaceUserProfile_Profile Is Nothing Then
Dim existingPathInstances As IEnumerable(Of String) = Nothing
Dim __user As UserInfo
Dim __host As Plugin.Hosts.SettingsHost = Settings(API.PathPlugin.PluginKey).Default
Dim __userName$ = .Destination.Segments.LastOrDefault
If Settings.UsersList.Count > 0 Then _
@@ -651,9 +687,16 @@ Namespace DownloadObjects
indx = Downloader.Files.FindIndex(finder)
If indx >= 0 Then
mm = Downloader.Files(indx)
__user = mm.UserInfo
mm_data = mm.Data
mm_data.File = df
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date)
__isSavedPosts = mm.IsSavedPosts And moveOptions.ReplaceUserProfile_Profile Is Nothing
postUrl = mm.PostUrl(True)
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date) With {
.IsSavedPosts = __isSavedPosts,
.PostUrl = postUrl
}
If __isSavedPosts Then mm.UserInfo = __user
Downloader.Files(indx) = mm
downloaderFilesUpdated = True
End If
@@ -679,9 +722,16 @@ Namespace DownloadObjects
indx = sessionData.FindIndex(finder)
If indx >= 0 Then
mm = sessionData(indx)
__user = mm.UserInfo
mm_data = mm.Data
mm_data.File = df
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date)
__isSavedPosts = mm.IsSavedPosts And moveOptions.ReplaceUserProfile_Profile Is Nothing
postUrl = mm.PostUrl(True)
mm = New UserMediaD(mm_data, If(moveOptions.ReplaceUserProfile_Profile, mm.User), mm.Session, mm.Date) With {
.IsSavedPosts = __isSavedPosts,
.PostUrl = postUrl
}
If __isSavedPosts Then mm.UserInfo = __user
sessionData(indx) = mm
sesFilesReplaced = True
If DataList.Count > 0 Then
@@ -720,6 +770,7 @@ Namespace DownloadObjects
Settings.Feeds.UpdateWhereDataReplaced()
End Try
End Function
#End Region
#Region "Load fav, spec"
Private Sub BTT_LOAD_FAV_Click(sender As Object, e As EventArgs) Handles BTT_LOAD_FAV.Click
FeedChangeMode(FeedModes.Special, {FeedSpecial.FavoriteName})
@@ -860,7 +911,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Delete daily sessions (by list)")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub BTT_FEED_DELETE_DAILY_DATE_Click(sender As Object, e As EventArgs) Handles BTT_FEED_DELETE_DAILY_DATE.Click
@@ -898,20 +948,23 @@ Namespace DownloadObjects
End Using
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "Delete daily sessions (by date)")
MainFrameObj.UpdateLogButton()
End Try
End Sub
#End Region
#Region "Clear session"
Private Sub BTT_CLEAR_DAILY_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DAILY.Click
If MsgBoxE({"Are you sure you want to clear this session data?", "Clear session"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
Downloader.Files.Clear()
ClearTable()
RefillList()
End If
#Region "Sessions set, merge, clear"
Private Sub BTT_CURR_SESSION_SET_Click(sender As Object, e As EventArgs) Handles BTT_CURR_SESSION_SET.Click, BTT_CURR_SESSION_SET_LAST.Click
Try
Dim f As SFile = Nothing
SessionChooser(sender Is BTT_CURR_SESSION_SET_LAST,,,, True, f)
If Not f.IsEmptyString AndAlso f.Exists Then
Downloader.FilesLoadLastSession(f)
FeedChangeMode(FeedModes.Current)
RefillList(True, False)
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Replace current session")
End Try
End Sub
#End Region
#Region "Merge feeds"
Private Sub BTT_MERGE_SESSIONS_Click(sender As Object, e As EventArgs) Handles BTT_MERGE_SESSIONS.Click
Try
Const msgTitle$ = "Merge feeds"
@@ -972,6 +1025,23 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadFeedForm.MergeSessions]")
End Try
End Sub
Private Sub BTT_CLEAR_DAILY_Click(sender As Object, e As EventArgs) Handles BTT_CLEAR_DAILY.Click
If MsgBoxE({"Are you sure you want to clear this session data?", "Clear session"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
Downloader.Files.Clear()
ClearTable()
RefillList()
End If
End Sub
Private Sub BTT_RESET_DAILY_Click(sender As Object, e As EventArgs) Handles BTT_RESET_DAILY.Click
If MsgBoxE({"Are you sure you want to reset the current session?" & vbCr &
"A new file will be created for the current session", "Reset current session"}, vbExclamation,,, {"Process", "Cancel"}) = 0 Then
Downloader.ResetSession()
FeedChangeMode(FeedModes.Current)
RefillList(True, False)
End If
End Sub
#End Region
#Region "Merge feeds"
Private Sub BTT_MERGE_FEEDS_Click(sender As Object, e As EventArgs) Handles BTT_MERGE_FEEDS.Click
Try
Const msgTitle$ = "Merge feeds"
@@ -1244,32 +1314,36 @@ Namespace DownloadObjects
End Try
End Sub
Private Sub RefillAfterDelete()
With MyRange
Dim indx% = .CurrentIndex
Dim indxChanged As Boolean = False
.HandlersSuspended = True
.Update()
If .Count > 0 Then
If indx.ValueBetween(0, .Count - 1) Then
.CurrentIndex = indx
ElseIf (indx - 1).ValueBetween(0, .Count - 1) Then
.CurrentIndex = indx - 1
indxChanged = True
Else
.CurrentIndex = .Count - 1
indxChanged = Not indx = .CurrentIndex
Try
With MyRange
Dim indx% = .CurrentIndex
Dim indxChanged As Boolean = False
.HandlersSuspended = True
.Update()
If .Count > 0 Then
If indx.ValueBetween(0, .Count - 1) Then
.CurrentIndex = indx
ElseIf (indx - 1).ValueBetween(0, .Count - 1) Then
.CurrentIndex = indx - 1
indxChanged = True
Else
.CurrentIndex = .Count - 1
indxChanged = Not indx = .CurrentIndex
End If
.UpdateControls()
.HandlersSuspended = False
If Not indxChanged Then LatestScrollValueDisabled = True
DirectCast(MyRange.Switcher, RangeSwitcher(Of UserMediaD)).PerformIndexChanged()
If Not indxChanged Then
LatestScrollValueDisabled = False
SetScrollValue(True)
End If
End If
.UpdateControls()
.HandlersSuspended = False
If Not indxChanged Then LatestScrollValueDisabled = True
DirectCast(MyRange.Switcher, RangeSwitcher(Of UserMediaD)).PerformIndexChanged()
If Not indxChanged Then
LatestScrollValueDisabled = False
SetScrollValue(True)
End If
End If
.HandlersSuspended = False
End With
End With
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[DownloadFeedForm.RefillAfterDelete]")
End Try
End Sub
#End Region
#Region "Range"

View File

@@ -27,7 +27,6 @@ Namespace DownloadObjects
Dim TP_LBL As System.Windows.Forms.TableLayoutPanel
Dim CONTEXT_SEP_3 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_4 As System.Windows.Forms.ToolStripSeparator
Me.CONTEXT_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
Me.CH_CHECKED = New System.Windows.Forms.CheckBox()
Me.LBL_INFO = New System.Windows.Forms.Label()
Me.CONTEXT_DATA = New System.Windows.Forms.ContextMenuStrip(Me.components)
@@ -37,6 +36,7 @@ Namespace DownloadObjects
Me.BTT_CONTEXT_OPEN_USER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_OPEN_USER_URL = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_CONTEXT_OPEN_USER_POST = New System.Windows.Forms.ToolStripMenuItem()
Me.CONTEXT_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
Me.BTT_COPY_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_MOVE_TO = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_FEED_ADD_FAV = New System.Windows.Forms.ToolStripMenuItem()
@@ -52,6 +52,7 @@ Namespace DownloadObjects
Me.ICON_SITE = New System.Windows.Forms.PictureBox()
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
Me.LBL_TITLE = New System.Windows.Forms.Label()
Me.BTT_CONTEXT_OPEN_FILE_FOLDER = New System.Windows.Forms.ToolStripMenuItem()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
TP_LBL = New System.Windows.Forms.TableLayoutPanel()
CONTEXT_SEP_3 = New System.Windows.Forms.ToolStripSeparator()
@@ -67,11 +68,6 @@ Namespace DownloadObjects
CONTEXT_SEP_1.Name = "CONTEXT_SEP_1"
CONTEXT_SEP_1.Size = New System.Drawing.Size(302, 6)
'
'CONTEXT_SEP_2
'
Me.CONTEXT_SEP_2.Name = "CONTEXT_SEP_2"
Me.CONTEXT_SEP_2.Size = New System.Drawing.Size(302, 6)
'
'TP_LBL
'
TP_LBL.ColumnCount = 3
@@ -114,9 +110,9 @@ Namespace DownloadObjects
'
'CONTEXT_DATA
'
Me.CONTEXT_DATA.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_CONTEXT_DOWN, Me.CONTEXT_SEP_0, Me.BTT_CONTEXT_OPEN_MEDIA, Me.BTT_CONTEXT_OPEN_USER, CONTEXT_SEP_1, Me.BTT_CONTEXT_OPEN_USER_URL, Me.BTT_CONTEXT_OPEN_USER_POST, Me.CONTEXT_SEP_2, Me.BTT_COPY_TO, Me.BTT_MOVE_TO, CONTEXT_SEP_3, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_ADD_FAV_REMOVE, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_ADD_SPEC_REMOVE, Me.BTT_FEED_REMOVE_FAV, Me.BTT_FEED_REMOVE_SPEC, CONTEXT_SEP_4, Me.BTT_CONTEXT_FIND_USER, Me.BTT_CONTEXT_INFO, Me.CONTEXT_SEP_5, Me.BTT_CONTEXT_DELETE})
Me.CONTEXT_DATA.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_CONTEXT_DOWN, Me.CONTEXT_SEP_0, Me.BTT_CONTEXT_OPEN_MEDIA, Me.BTT_CONTEXT_OPEN_USER, Me.BTT_CONTEXT_OPEN_FILE_FOLDER, CONTEXT_SEP_1, Me.BTT_CONTEXT_OPEN_USER_URL, Me.BTT_CONTEXT_OPEN_USER_POST, Me.CONTEXT_SEP_2, Me.BTT_COPY_TO, Me.BTT_MOVE_TO, CONTEXT_SEP_3, Me.BTT_FEED_ADD_FAV, Me.BTT_FEED_ADD_FAV_REMOVE, Me.BTT_FEED_ADD_SPEC, Me.BTT_FEED_ADD_SPEC_REMOVE, Me.BTT_FEED_REMOVE_FAV, Me.BTT_FEED_REMOVE_SPEC, CONTEXT_SEP_4, Me.BTT_CONTEXT_FIND_USER, Me.BTT_CONTEXT_INFO, Me.CONTEXT_SEP_5, Me.BTT_CONTEXT_DELETE})
Me.CONTEXT_DATA.Name = "CONTEXT_PIC"
Me.CONTEXT_DATA.Size = New System.Drawing.Size(306, 414)
Me.CONTEXT_DATA.Size = New System.Drawing.Size(306, 436)
'
'BTT_CONTEXT_DOWN
'
@@ -160,6 +156,11 @@ Namespace DownloadObjects
Me.BTT_CONTEXT_OPEN_USER_POST.Size = New System.Drawing.Size(305, 22)
Me.BTT_CONTEXT_OPEN_USER_POST.Text = "Open post"
'
'CONTEXT_SEP_2
'
Me.CONTEXT_SEP_2.Name = "CONTEXT_SEP_2"
Me.CONTEXT_SEP_2.Size = New System.Drawing.Size(302, 6)
'
'BTT_COPY_TO
'
Me.BTT_COPY_TO.Image = Global.SCrawler.My.Resources.Resources.PastePic_32
@@ -289,6 +290,13 @@ Namespace DownloadObjects
Me.LBL_TITLE.Size = New System.Drawing.Size(140, 25)
Me.LBL_TITLE.TabIndex = 1
'
'BTT_CONTEXT_OPEN_FILE_FOLDER
'
Me.BTT_CONTEXT_OPEN_FILE_FOLDER.Image = Global.SCrawler.My.Resources.Resources.FolderPic_32
Me.BTT_CONTEXT_OPEN_FILE_FOLDER.Name = "BTT_CONTEXT_OPEN_FILE_FOLDER"
Me.BTT_CONTEXT_OPEN_FILE_FOLDER.Size = New System.Drawing.Size(305, 22)
Me.BTT_CONTEXT_OPEN_FILE_FOLDER.Text = "Open file folder"
'
'FeedMedia
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -335,5 +343,6 @@ Namespace DownloadObjects
Private WithEvents BTT_MOVE_TO As ToolStripMenuItem
Private WithEvents CONTEXT_SEP_5 As ToolStripSeparator
Private WithEvents CONTEXT_SEP_2 As ToolStripSeparator
Private WithEvents BTT_CONTEXT_OPEN_FILE_FOLDER As ToolStripMenuItem
End Class
End Namespace

View File

@@ -178,6 +178,7 @@ Namespace DownloadObjects
BTT_CONTEXT_DOWN.Visible = True
CONTEXT_SEP_0.Visible = True
BTT_CONTEXT_OPEN_USER.Visible = False
BTT_CONTEXT_OPEN_FILE_FOLDER.Visible = False
CONTEXT_SEP_5.Visible = False
BTT_CONTEXT_DELETE.Visible = False
@@ -221,8 +222,8 @@ Namespace DownloadObjects
Information = $"Type: {Media.Data.Type}"
Information.StringAppendLine($"File: {File.File}")
Information.StringAppendLine($"Address: {File}")
Information.StringAppendLine($"Downloaded: {Media.Date.ToStringDate(ADateTime.Formats.BaseDateTime)}")
If Media.Data.Post.Date.HasValue Then Information.StringAppendLine($"Posted: {Media.Data.Post.Date.Value.ToStringDate(ADateTime.Formats.BaseDateTime)}")
Information.StringAppendLine($"Downloaded: {Media.Date.ToStringDateDef}")
If Media.Data.Post.Date.HasValue Then Information.StringAppendLine($"Post date: {Media.Data.Post.Date.Value.ToStringDateDef}")
Dim infoType As UserMedia.Types = If(IsSubscription, UserMedia.Types.Picture, Media.Data.Type)
Dim h%
Dim s As Size
@@ -267,23 +268,27 @@ Namespace DownloadObjects
BTT_CONTEXT_OPEN_MEDIA.Text &= " video"
BTT_CONTEXT_DELETE.Text &= " video"
h = VideoHeight
AddHandler MyVideo.DoubleClick, AddressOf MyPicture_DoubleClick
Case Else : Throw New ArgumentNullException With {.HelpLink = 1}
End Select
Dim info$ = $"[{infoType}] - "
Dim info$ = If(Settings.FeedAddTypeToCaption.Value And Not IsSubscription, $"[{infoType}] - ", String.Empty)
If Not Media.User Is Nothing Then
With Media.User
Dim otherName$ = If(Media.IsSavedPosts, "Saved", Media.UserInfo.Name)
Dim site$ = If(Settings.FeedAddSiteToCaption.Value, $"{ .Site} - ", String.Empty)
UserKey = .Key
Information &= vbNewLine.StringDup(2)
If .IncludedInCollection Then Information.StringAppendLine($"User collection: { .CollectionName}")
Information.StringAppendLine($"User site: { .Site}")
Information.StringAppendLine($"User name: {IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)}")
Information.StringAppendLine($"User name: {CStr(IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)).IfNullOrEmpty(otherName)}")
If .IncludedInCollection Then info &= $"[{ .CollectionName}]: "
If Settings.FeedShowFriendlyNames Or Not DirectCast(.Self, UserDataBase).FeedIsUser Then
info &= $"{ .Site} - { .FriendlyName.IfNullOrEmpty(.Name)}"
info &= $"{site}{ .FriendlyName.IfNullOrEmpty(.Name).IfNullOrEmpty(otherName)}"
Else
info &= $"{ .Site} - {IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)}"
info &= $"{site}{CStr(IIf(Not .FriendlyName.IsEmptyString And Not .IncludedInCollection, .FriendlyName, .Name)).IfNullOrEmpty(otherName)}"
End If
End With
End If
@@ -412,8 +417,12 @@ Namespace DownloadObjects
End Sub
#End Region
#Region "Open media, folder"
Private Sub BTT_CONTEXT_OPEN_MEDIA_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_MEDIA.Click
File.Open()
Private Sub BTT_CONTEXT_OPEN_MEDIA_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_MEDIA.Click, BTT_CONTEXT_OPEN_FILE_FOLDER.Click
If Not sender Is Nothing AndAlso sender Is BTT_CONTEXT_OPEN_FILE_FOLDER Then
GlobalOpenPath(File)
Else
File.Open()
End If
End Sub
Private Sub BTT_CONTEXT_OPEN_USER_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_OPEN_USER.Click
If Not UserKey.IsEmptyString Then
@@ -451,6 +460,8 @@ Namespace DownloadObjects
Dim url$ = String.Empty
If IsSubscription Then
url = Post.URL_BASE
ElseIf Not Media.PostUrl.IsEmptyString Then
url = Media.PostUrl
Else
If Not UserKey.IsEmptyString And Not Post.Post.ID.IsEmptyString Then
Dim u As IUserData

View File

@@ -139,7 +139,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[FeedSpecial.UpdateUsers]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Friend Overloads Shared Function UpdateUsers(ByVal Item As UserMediaD, ByVal InitialUser As UserInfo, ByVal NewUser As UserInfo,
@@ -148,6 +147,7 @@ Namespace DownloadObjects
Dim user As IUserData
Dim path$ = InitialUser.File.CutPath.PathWithSeparator
Dim pathNew$ = NewUser.File.CutPath.PathWithSeparator
Dim isSaved As Boolean = Item.IsSavedPosts
If Item.UserInfo.Equals(InitialUser) Or Item.UserInfo.Equals(NewUser) Then
If Item.Data.File.PathWithSeparator.Contains(path) Then
data = Item.Data
@@ -157,8 +157,9 @@ Namespace DownloadObjects
Else
user = Item.User
End If
If isSaved Then isSaved = Item.UserInfo.Equals(DirectCast(user, UserDataBase).User)
If Not If(user?.IsSubscription, False) Then
Item = New UserMediaD(data, user, Item.Session, Item.Date)
Item = New UserMediaD(data, user, Item.Session, Item.Date) With {.IsSavedPosts = isSaved}
Result = True
Return Item
End If
@@ -175,8 +176,11 @@ Namespace DownloadObjects
If indx >= 0 Then
Dim m As UserMediaD = Items(indx)
Dim mm As UserMedia = m.Data
Dim user As UserInfo = m.UserInfo
Dim __isSavedPosts As Boolean = m.IsSavedPosts And MCTOptions.ReplaceUserProfile_Profile Is Nothing
mm.File = NewFile
m = New UserMediaD(mm, If(MCTOptions.ReplaceUserProfile_Profile, m.User), m.Session, m.Date)
m = New UserMediaD(mm, If(MCTOptions.ReplaceUserProfile_Profile, m.User), m.Session, m.Date) With {.IsSavedPosts = __isSavedPosts}
If __isSavedPosts Then m.UserInfo = user
Items(indx) = m
_FilesUpdated = True
End If
@@ -191,6 +195,7 @@ Namespace DownloadObjects
#Region "Add"
Friend Overloads Function Add(ByVal Item As UserMediaD, Optional ByVal AutoSave As Boolean = True) As Boolean
If Not Items.Contains(Item) Then
Item.PostUrl = Item.PostUrl(True)
Items.Add(Item)
If AutoSave Then Save()
Return True
@@ -231,7 +236,65 @@ Namespace DownloadObjects
Friend Function RemoveNotExist(ByVal p As Predicate(Of UserMediaD)) As Integer
If Count > 0 And Not _NotExistRemoved Then
_NotExistRemoved = True
Dim ri% = Items.RemoveAll(p)
Dim ri% = 0
If Settings.FeedSpecialSearchForMissing Then
Dim i% = -1
Dim d As UserMediaD = Nothing
Dim m As UserMedia
Dim f As SFile = Nothing
Dim ff As SFile
Dim postUrl$ = String.Empty
Dim user As IUserData
Dim processRemove As Boolean
Dim userArr As New List(Of IUserData)
Dim updateUser As Func(Of IUserData, Boolean) =
Function(ByVal replaceUser As IUserData) As Boolean
If f.Exists(SFO.Path, False) Then
ff = SFile.GetFiles(f, d.Data.File.File, IO.SearchOption.AllDirectories, EDP.ReturnValue).FirstOrDefault
If Not ff.IsEmptyString Then
m = d.Data
m.File = ff
d = New UserMediaD(m, If(replaceUser, d.User), d.Session, d.Date) With {
.IsSavedPosts = If(replaceUser Is Nothing, d.IsSavedPosts, DirectCast(replaceUser, UserDataBase).IsSavedPosts),
.PostUrl = postUrl
}
Items(i) = d
ri += 1
processRemove = False
Return True
End If
End If
Return False
End Function
For i = Count - 1 To 0 Step -1
If p.Invoke(Items(i)) Then
d = Items(i)
postUrl = d.PostUrl(True)
f = Nothing
ff = Nothing
processRemove = True
f = If(d.User?.File, New SFile).IfNullOrEmpty(d.UserInfo.File).CutPath
If updateUser(Nothing) Then Continue For
If Settings.FeedSpecialSearchForMissing_Deep Then
If userArr.Count = 0 Then userArr.ListAddList(Settings.GetUsers(Function(u) True))
If userArr.Count > 0 Then
For Each user In userArr
f = user.File.CutPath
If updateUser(user) Then Exit For
Next
End If
End If
If processRemove Then Items.RemoveAt(i) : ri += 1
End If
Next
Else
ri = Items.RemoveAll(p)
End If
If ri > 0 Then Save()
Return ri
Else

View File

@@ -111,7 +111,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[FeedSpecialCollection.Load]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
Private Sub Feeds_FeedDeleted(ByVal Source As FeedSpecialCollection, ByVal Feed As FeedSpecial)
@@ -236,7 +235,7 @@ Namespace DownloadObjects
Friend Sub UpdateUsers(ByVal InitialUser As UserInfo, ByVal NewUser As UserInfo)
Try
Load()
If Count > 0 Then
If Count > 0 AndAlso Not UserInfo.ExactEquals(InitialUser, NewUser) Then
Feeds.ForEach(Sub(f) f.UpdateUsers(InitialUser, NewUser))
If Downloader.Files.Count > 0 Then
PendingUsersToUpdate.Add(New KeyValuePair(Of UserInfo, UserInfo)(InitialUser, NewUser))
@@ -245,7 +244,6 @@ Namespace DownloadObjects
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendToLog, ex, "[FeedSpecialCollection.UpdateUsers]")
MainFrameObj.UpdateLogButton()
End Try
End Sub
#End Region

View File

@@ -176,5 +176,9 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendToLog, ex, $"An error occurred while performing action [{ActionName}] on file [{MediaFile}]")
End Try
End Function
Private Sub MyVideo_DoubleClick(sender As Object, e As EventArgs) Handles MyVideo.DoubleClick
[Stop]()
OnDoubleClick(e)
End Sub
End Class
End Namespace

View File

@@ -20,6 +20,7 @@ Namespace DownloadObjects.Groups
Private Const Name_FilterViewMode As String = "FilterViewMode"
Private Const Name_FilterGroupUsers As String = "FilterGroupUsers"
Private Const Name_FilterShowGroupsInsteadLabels As String = "FilterShowGroupsInsteadLabels"
Private Const Name_FilterShowAllUsers As String = "FilterShowAllUsers"
#End Region
#Region "Declarations"
#Region "Controls"
@@ -36,6 +37,7 @@ Namespace DownloadObjects.Groups
Friend Property FilterViewMode As ViewModes = ViewModes.IconLarge
Friend Property FilterGroupUsers As Boolean = True
Friend Property FilterShowGroupsInsteadLabels As Boolean = True
Friend Property FilterShowAllUsers As Boolean = False
#End Region
Private File As SFile = Nothing
Friend Overrides Property Name As String
@@ -144,13 +146,15 @@ Namespace DownloadObjects.Groups
FilterViewMode = e.Value(Name_FilterViewMode).FromXML(Of Integer)(ViewModes.IconLarge)
FilterGroupUsers = e.Value(Name_FilterGroupUsers).FromXML(Of Boolean)(True)
FilterShowGroupsInsteadLabels = e.Value(Name_FilterShowGroupsInsteadLabels).FromXML(Of Boolean)(True)
FilterShowAllUsers = e.Value(Name_FilterShowAllUsers).FromXML(Of Boolean)(False)
End If
End Sub
Protected Overrides Function Export(ByVal e As EContainer) As EContainer
MyBase.Export(e)
e.AddRange({New EContainer(Name_FilterViewMode, CInt(FilterViewMode)),
New EContainer(Name_FilterGroupUsers, FilterGroupUsers.BoolToInteger),
New EContainer(Name_FilterShowGroupsInsteadLabels, FilterShowGroupsInsteadLabels.BoolToInteger)})
New EContainer(Name_FilterShowGroupsInsteadLabels, FilterShowGroupsInsteadLabels.BoolToInteger),
New EContainer(Name_FilterShowAllUsers, FilterShowAllUsers.BoolToInteger)})
Return e
End Function
#End Region
@@ -166,6 +170,7 @@ Namespace DownloadObjects.Groups
FilterViewMode = .FilterViewMode
FilterGroupUsers = .FilterGroupUsers
FilterShowGroupsInsteadLabels = .FilterShowGroupsInsteadLabels
FilterShowAllUsers = .FilterShowAllUsers
End If
End With
End If

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