Compare commits

...

21 Commits

Author SHA1 Message Date
Andy
7d169acebc 2022.10.23.0
PluginProvider: added 'DoNotUse' attribute.
Channels: copying a channel to the 'ChannelsDeleted' folder before deleting.
Twitter: updated status codes.
AutoDownloader: removed base parameters initialization; updated 'ToEContainer' function; 'StartupDelay' default value = 1; added IIndexable; fixed NextExecutionDate; added task delay based on index and tasks count; updated user selections algorithms.
MainFrame: coloring the button 'Download All' depending on the pause; updated user selections algorithms.
DownloadGroups: added LabelsExcluded, Sites and SitesExcluded; updated initialization; updated ToEContainer function; updated user selections algorithms
IGroup, GroupParameters: added LabelsExcluded, Sites and SitesExcluded; added Import and Export functions
Removed TrayIcon notifications. All notifications are now ToastNotifications.
SettingsHost: 'DoNotUse' attribute
Settings: added 'GetUsers' predicate function
2022-10-23 16:39:01 +03:00
Andy
f5c156b8e5 2022.10.18.0
Moved UserMedia xml initialization to the structure itself
Added download with feed skip
Added silent mode (temporary disabling notifications)
Added additional Instagram protection
Excluding users whose profiles do not exist from downloading with groups and AutoDownloader
Feed: delete file bugs; reorder data after file deletion; video playback bugs
SiteSettingsForm: enable 'OK' button when editing cookies
Fixed collection users ban
Settings: disabling ffmpeg missing notification; advanced notification management
Added 'ToolStripKeyMenuItem' control
Plugins: deprecated XVIDEOS and LPSG plugin libraries; moved them to SCrawler.
Updated license
PluginProvider: added 'BeginEdit' and 'EndEdit' function to ISiteSettings; changed GetSpecialData (ISiteSettings) return type to IEnumerable
PluginsEnvironment: removed 'IsMyClass' attribute
MainFrame: grouped all download buttons into one menu; reorganized code; removed 'F2' hotkey
AutoDownloader: added advanced pause options; added buttons to tray icon and AutoDownloader form
MissingPosts: finished; activated functions that were disabled; added download functions to UserData classes
UserDataBase: ability to use responser; ability to download m3u8; extended 'DownloadingException' with optional argument 'EObj'; user index in collection (button tag) changed to user instance; extended information with user labels; updated 'ProcessException' function
Replaced download buttons with 'KeyClick' control
Replaced FDatePickerForm with my library's form
Collections: Deleting multiple collections - disabled confirmation; ban each user in collection
2022-10-18 12:05:31 +03:00
Andy
d91ee72eaa Update LICENSE 2022-10-18 12:02:43 +03:00
Andy
4e9de23b60 Deprecated
Moved to SCrawler
2022-10-18 11:54:50 +03:00
Andy
129558c262 2022.9.24.0
Fixed wrong image opening in Autodownloader
Fixed incorrect feed grid resizing when removing media
Fixed incorrect removal of users from the collection
Fixed Instagram function displaying number of requests: wrong value type.
Fixed XVIDEOS cycle bug
Collection: add multiple users
Collection: new collections at the top
Copying user data
Feed: 'Season' and 'Date' to the post title.
2022-09-24 20:26:40 +03:00
Andy
a3e79eb4bc Update UserDataBase.vb
Fixed typo
2022-09-17 20:28:27 +03:00
Andy
eb28255de3 2022.9.17.0
Extended filters by date
Added download by dates for multiple users
Changed validation of dates ranges in UserDataBase
Add user filters by dates
Add disabling site downloading
Fixed Twitter date validator
2022-09-17 19:59:55 +03:00
Andy
92be0994ae 2022.9.16.0
Removed some compatible functions
Fixed Settings.GetUser bug
Design improvements
Changed UserMediD comparer
FeedVideo design updated, incorrect time position fixed, bugs fixed
Fixed getting Reddit channel video thumbnail
2022-09-16 19:41:24 +03:00
Andy
9567b0a367 2022.9.13.0
Added video duration to the feed
Added skipping of pinned Instagram posts if they are already downloaded
2022-09-13 16:20:07 +03:00
Andy
c28c0e1ba3 2022.9.10.0
Fixed: missed posts are not saved
Fixed memory leaking because of the video
2022-09-10 12:28:40 +03:00
Andy
86771eee94 2022.9.8.1
Fixed unexpected memory leak when using the 'Feed' form
2022-09-08 22:24:36 +03:00
Andy
02e8a15ae3 2022.9.8.0
Temporary disabled RedGifs downloading
Added 'missing posts', 'feed'
Fixed minor bugs
2022-09-08 12:36:25 +03:00
Andy
443ab329d5 2022.8.28.0
Changed target platforms
Added RedGifs pics
Fixed Switcher limit bug
2022-08-28 04:08:54 +03:00
Andy
a16bb8de90 Update CONTRIBUTING.md 2022-08-26 20:38:33 +03:00
Andy
0af5e6f8d4 Update README.md 2022-08-26 20:37:54 +03:00
Andy
54ffe10f71 2022.8.22.0
Cleaned up the code
Replace some old functions with new ones
Adapted to the new library environment
Enable/Disable display user/downloaded image
Autodownloader option 'Show notification' not saved
Separate thread for standalone video downloader
Expanded the description of some errors with additional information
Fixed date/time renaming issue
Fixed internal library bugs
Fixed minor bugs
2022-08-22 02:42:36 +03:00
Andy
e0dc66e0da 2022.7.7.0
Brushed the code in some classes
Extended PropertyOption attribute
Removed AuthNullException
Moved ExitException to UserData class
Removed Instagram HashUpdateRequired and its environment
Changed Reddit response status code check
Twitter images bug
Added Scheduler, task startup delay, webp to jpg
Fixed Stop button bug
Minor changes
2022-07-07 14:11:18 +03:00
Andy
ab020d9b5f 2022.6.10.0
Instagram User ID
2022-06-10 21:13:35 +03:00
Andy
4ba1624edf Update MainWindowGroups.png 2022-06-09 07:55:58 +03:00
Andy
f3d956f33f 2022.6.7.0
Fixed some design issues
2022-06-07 20:00:36 +03:00
Andy
4a5e050201 Update README.md 2022-06-06 21:49:00 +03:00
252 changed files with 12712 additions and 12696 deletions

1
.gitignore vendored
View File

@@ -35,6 +35,7 @@ bld/
[Ll]ogs/ [Ll]ogs/
ffmpeg/ ffmpeg/
Info/ Info/
Hidden/
# Visual Studio 2015/2017 cache/options directory # Visual Studio 2015/2017 cache/options directory
.vs/ .vs/

View File

@@ -8,16 +8,18 @@ I welcome requests! Follow these steps to contribute:
1. If you have a code change suggestion, you can post a replacement code block. I also accept pull requests. 1. If you have a code change suggestion, you can post a replacement code block. I also accept pull requests.
# How to build from source # How to build from source
1. Delete the "PersonalUtilities" project from the solution. 1. Delete the "PersonalUtilities" project from the solution.
1. Delete the "PersonalUtilities.Notifications" project from the solution. 1. Delete the "PersonalUtilities.Notifications" project from the solution.
1. Add the latest versions of the ```PersonalUtilities.dll``` and ```PersonalUtilities.Notifications.dll``` libraries (from the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest)). 1. The following libraries must be added to project references with the '**Copy to output folder**' option:
- ```PersonalUtilities.dll```
- ```PersonalUtilities.Notifications.dll```
- ```Microsoft.Toolkit.Uwp.Notifications.dll```
- ```System.ValueTuple.dll```
1. Import PersonalUtilities.Functions for the whole project. 1. Import PersonalUtilities.Functions for the whole project.
**Always use the correct "PersonalUtilities.dll" library. You must download this library from the release of the code you downloaded.** **Always use the correct libraries. You must download libraries from the same release date as the code commit date.**
# How to request a new site # How to request a new site
1. Check [issues](https://github.com/AAndyProgram/SCrawler/issues) (open and [closed](https://github.com/AAndyProgram/SCrawler/issues?q=is%3Aissue+is%3Aclosed)) and [discussions](https://github.com/AAndyProgram/SCrawler/discussions) to find your issue. Perhaps I have already answered your request. 1. Check [issues](https://github.com/AAndyProgram/SCrawler/issues) (open and [closed](https://github.com/AAndyProgram/SCrawler/issues?q=is%3Aissue+is%3Aclosed)) and [discussions](https://github.com/AAndyProgram/SCrawler/discussions) to find your issue. Perhaps I have already answered your request.
1. If you don't find anything, create a new issue with your request. I usually reply as soon as possible (within the next few hours). 1. If you don't find anything, create a new issue with your request. I usually reply as soon as possible (within the next few hours).
@@ -34,14 +36,5 @@ I welcome requests! Follow these steps to contribute:
If I'm interested in a site you want to add, it may be added in future releases. If I'm interested in a site you want to add, it may be added in future releases.
# Sites I will never develop # Sites I will never develop
- Facebook - Facebook
- Tumblr
# Sites requested by users
- TikTok
- API for receiving data without authorization was not found. Therefore, I don't have time to start developing this site parsing algorithm. If anyone knows of requests that may collect data without OAuth authentication, please let me know.
# Contact me
[![matrix](https://img.shields.io/badge/Matrix-%40andyprogram%3Amatrix.org-informational)](https://matrix.to/#/@andyprogram:matrix.org)

View File

@@ -1,5 +1,189 @@
# 2022.10.23.0
*2022-10-23*
- Added
- RedGifs token Auto-Renewal
- Download groups: ability to select sites
- Download groups: ability to exclude labels and sites
- AutoDownloader: ability to exclude labels and sites in ```All```, ```Default``` and ```Specified``` modes
- The ```Download All``` button turns blue when pause is enabled
- Updated Twitter status codes
- Minor improvements
- Fixed
- Updated Twitter status codes
- AutoDownloader: incorrect next run date in scheduler task information
- AutoDownloader: minor bugs
- (Issue #69) **RedGifs data is not downloading**. Requires token.
- Minor bugs
# 2022.10.18.0
*2022-10-18*
- Added
- **TikTok** ([limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits))
- **Search form** (```Ctrl+F```)
- Feed improvements
- Ability to save the download session for viewing later
- Ability to download user, excluding from the feed (use the ```Ctrl``` key with a button click of with a hot key press)
- Ability to disable the notification about the absence of the ffmpeg.exe file
- Extended user information with labels
- Advanced AutoDownloader pause options
- Added pause buttons to tray icon and AutoDownloader form
- Additional Instagram protection
- Advanced notification management
- Silent mode (temporarily disable notification)
- Excluding users whose profiles do not exist from downloading with groups and AutoDownloader
- Minor improvements
- Updated
- Grouped all download buttons into one menu
- **Finished missing posts**. You can now download missing posts if they exist.
- PluginProvider: added ```BeginEdit``` and ```EndEdit``` methods
- PluginProvider: ```GetSpecialData``` return type changed from ```IEnumerable(Of PluginUserMedia)``` to ```IEnumerable```
- XVIDEOS and LPSG plugins are moved from libraries to SCrawler
- Fixed
- (Issue #69) **RedGifs data is not downloading**. Requires cookies and token.
- Some minor bugs when deleting a collection
- Feed: start video playing may cause the program to freeze (strange behavior of the vlc library)
- Feed: videos hosted on Reddit not showing up in feed
- Feed: minor bugs
- Collection users were not banned when deleted with the ban option
- When trying to delete multiple collections, each collection asked for confirmation to delete
- Minor bugs
# 2022.9.24.0
*2022-09-24*
- Added
- Ability to copy user data to another destination
- Ability to add 'Session' and 'Date' values to the post title in the feed
- Minor feed improvements
- The newly created collection will now appear at the top of the list (after reopening the form)
- Ability to add multiple users at a time to the collection.
- Fixed
- Autodownloader opens a compressed image instead of a full one
- Incorrect resizing of the feed grid after deleting a media file
- Incorrect behavior when deleting/removing a user from a collection.
- An incorrect function that displayed the number of spent Instagram requests.
- Bug in the XVIDEOS downloader
- Minor bugs
# 2022.9.17.0
*2022-09-17*
- Added
- Added two date filters to filter users (in range, not in range)
- (Request #71) Download data for a specific date range
- The ability to disable site downloading (in the site settings form)
- Updated
- Plugins
- Fixed
- (Issue #71) ```Download data to the date``` doesn't work for Twitter
- Download data for a specific date range doesn't work for multiple users
- Incorrect feed sorting algorithm
- Minor bugs
# 2022.9.16.0
*2022-09-16*
- Fixed
- Failed to get video thumbnail for channel video post
- Incorrect rendering of the 'Feed' table when the number of columns is more than one
- Minor design bugs
# 2022.9.13.0
*2022-09-13*
- Added
- Video duration to the feed
- Fixed
- (Issue #70) Instagram posts not downloading if there are pinned posts that have already been downloaded
- Minor bugs
# 2022.9.10.0
*2022-09-10*
- Fixed
- The memory is still leaking. This time because of the video. *Using WMP was not the best choice.*
# 2022.9.8.1
*2022-09-08*
- Fixed
- Unexpected memory leak when using the 'Feed' form
# 2022.9.8.0
*2022-09-08*
- Added
- **Feed** (feed of downloaded media files)
- Missing posts tracking and management
- Simple scheduler notifications
- Fixed
- (Issue #67) Saved Instagram posts not downloading
# 2022.8.28.0
*2022-08-28*
- Added
- RedGifs icon
- Fixed
- Incorrect number of posts displayed in the Reddit channels downloader.
# 2022.8.22.0
*2022-08-22*
- Added
- Ability to enable/disable the display of the downloaded image in toast notifications (AutoDownloader)
- Ability to enable/disable the display of the user icon in toast notifications (AutoDownloader)
- Downloading with standalone video downloader has been moved to a separate thread
- Fixed
- (Issue #35) The file name does not change only by date
- (Issue #62) Internal library error
- AutoDownloader option ```Show notifications``` not saved
- Minor bugs
# 2022.7.7.0
*2022-07-07*
- Added
- **Scheduler** (creating multiple automation tasks)
- Automation startup delay
- Download ```webp``` in ```jpg``` format
- Development: the ability to create a label control, that provides some information
- Removed
- Instagram auto-fill hash from cookies
- Updated
- Plugins
- Fixed
- ```Stop``` option not working properly
- In some cases, Twitter image is not downloading
- Minor bugs
# 2022.6.10.0
*2022-06-10*
**Attention! From now on, Instagram requires Cookies, Hash and authorization headers!**
- Fixed
- Can't get Instagram user ID
# 2022.6.6.0 # 2022.6.6.0
*2022-06-06*
- Added - Added
- Ability to pause automation - Ability to pause automation
- Fixed - Fixed
@@ -8,6 +192,8 @@
# 2022.6.3.0 # 2022.6.3.0
*2022-06-03*
Changed version numbering method. From now on, new versions will be numbered by release date (YYYY.M.D) Changed version numbering method. From now on, new versions will be numbered by release date (YYYY.M.D)
**Attention! Starting with this release, SCrawler may not work on windows 7 and 8 or may not work correctly. All future releases will only be guaranteed to work on windows 10 and 11.** **Attention! Starting with this release, SCrawler may not work on windows 7 and 8 or may not work correctly. All future releases will only be guaranteed to work on windows 10 and 11.**
@@ -21,6 +207,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.10 # 3.0.0.10
*2022-05-23*
- Added - Added
- **Downloading groups** - **Downloading groups**
- **Download saved Twitter posts** (bookmarks) - **Download saved Twitter posts** (bookmarks)
@@ -42,6 +230,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.9 # 3.0.0.9
*2022-04-24*
- Added - Added
- Excluded labels - Excluded labels
- Ability to disable user grouping - Ability to disable user grouping
@@ -52,6 +242,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.8 # 3.0.0.8
*2022-04-19*
- Added - Added
- Script mode ```command``` - Script mode ```command```
- Disabled Instagram error 403 (Forbidden) logging for downloading tagged data - Disabled Instagram error 403 (Forbidden) logging for downloading tagged data
@@ -60,6 +252,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.7 # 3.0.0.7
*2022-04-14*
- Added - Added
- Ability to run a script after the user download is complete - Ability to run a script after the user download is complete
- Hotkey ```F2``` for additional options in the user creation form - Hotkey ```F2``` for additional options in the user creation form
@@ -70,6 +264,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.6 # 3.0.0.6
*2022-04-04*
- Added - Added
- ```GoTo Start``` channels button - ```GoTo Start``` channels button
- ```GoTo End``` channels button - ```GoTo End``` channels button
@@ -81,17 +277,23 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.5 # 3.0.0.5
*2022-04-02*
- Added - Added
- ```New```, ```Hot```, ```Top``` Reddit channel and user download modes - ```New```, ```Hot```, ```Top``` Reddit channel and user download modes
# 3.0.0.4 # 3.0.0.4
*2022-03-26*
- Fixed - Fixed
- External plugins do not save information about downloaded files - External plugins do not save information about downloaded files
- The user cannot be added to the collection if a special path has been specified. - The user cannot be added to the collection if a special path has been specified.
# 3.0.0.3 # 3.0.0.3
*2022-03-24*
- Added - Added
- Download all by specific sites - Download all by specific sites
- Download all, ignoring the ```Ready for download``` option - Download all, ignoring the ```Ready for download``` option
@@ -103,6 +305,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.2 # 3.0.0.2
*2022-03-22*
- Added - Added
- **LPSG** site plugin - **LPSG** site plugin
- **XVIDEOS** site plugin - **XVIDEOS** site plugin
@@ -113,6 +317,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.1 # 3.0.0.1
*2022-03-20*
- Added - Added
- Download data up to a specific date - Download data up to a specific date
- Update and Reset functions in the plugin (ISiteSettings) - Update and Reset functions in the plugin (ISiteSettings)
@@ -126,6 +332,8 @@ Changed version numbering method. From now on, new versions will be numbered by
# 3.0.0.0 # 3.0.0.0
*2022-03-17*
**Attention! This version of the program makes changes user data file (Users.xml). Once you start using this version, you will not be able to use previous versions of the program. Therefore, it is highly recommended to archive the program settings folder and archive the users' data files (you can use the [```ArchiveSCrawlerUsersDataFiles.bat```](Tools/ArchiveSCrawlerUsersDataFiles.bat) tool to archive the data files of all users).** **Attention! This version of the program makes changes user data file (Users.xml). Once you start using this version, you will not be able to use previous versions of the program. Therefore, it is highly recommended to archive the program settings folder and archive the users' data files (you can use the [```ArchiveSCrawlerUsersDataFiles.bat```](Tools/ArchiveSCrawlerUsersDataFiles.bat) tool to archive the data files of all users).**
- Added - Added
@@ -166,6 +374,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 2.0.0.4 # 2.0.0.4
*2022-02-07*
**Removed compatibility of program settings with version 1.0.0.4 and lower.** **Removed compatibility of program settings with version 1.0.0.4 and lower.**
**If your program version is 1.0.0.4 and lower, it is strongly recommended that you upgrade to release 2.0.0.1 to update the program settings (and run the program). Then update to this release. Otherwise, you will have to configure the program settings again** **If your program version is 1.0.0.4 and lower, it is strongly recommended that you upgrade to release 2.0.0.1 to update the program settings (and run the program). Then update to this release. Otherwise, you will have to configure the program settings again**
@@ -180,6 +390,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 2.0.0.3 # 2.0.0.3
*2022-02-02*
**Removed compatibility of program settings with version 1.0.0.4 and lower.** **Removed compatibility of program settings with version 1.0.0.4 and lower.**
**If your program version is 1.0.0.4 and lower, it is strongly recommended that you upgrade to release 2.0.0.1 to update the program settings (and run the program). Then update to this release. Otherwise, you will have to configure the program settings again** **If your program version is 1.0.0.4 and lower, it is strongly recommended that you upgrade to release 2.0.0.1 to update the program settings (and run the program). Then update to this release. Otherwise, you will have to configure the program settings again**
@@ -195,6 +407,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 2.0.0.2 # 2.0.0.2
*2022-01-23*
**This is the last release that supports program settings of version 1.0.0.4 and lower. Compatibility of program settings with version 1.0.0.4 and lower will be removed in future releases. It is strongly recommended that you upgrade to this release before future releases. Otherwise, you will have to configure the program settings again. If your program version is 1.0.1.0 or higher, you should not pay attention to this message.** **This is the last release that supports program settings of version 1.0.0.4 and lower. Compatibility of program settings with version 1.0.0.4 and lower will be removed in future releases. It is strongly recommended that you upgrade to this release before future releases. Otherwise, you will have to configure the program settings again. If your program version is 1.0.1.0 or higher, you should not pay attention to this message.**
- Added - Added
@@ -217,6 +431,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 2.0.0.1 # 2.0.0.1
*2021-12-29*
- Added - Added
- Download individual Imgur media files (use the "Download video" form). - Download individual Imgur media files (use the "Download video" form).
- Fixed - Fixed
@@ -225,6 +441,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 2.0.0.0 # 2.0.0.0
*2021-12-27*
- Added - Added
- **Instagram** - **Instagram**
- Filter by site - Filter by site
@@ -242,6 +460,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 1.0.1.0 # 1.0.1.0
*2021-12-20*
- Added - Added
- Extended site settings - Extended site settings
- Non-existend users will be marked in red - Non-existend users will be marked in red
@@ -263,6 +483,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 1.0.0.4 # 1.0.0.4
*2021-12-12*
- Added - Added
- Full channels support (you can now add channel (subreddit) for standard download) - Full channels support (you can now add channel (subreddit) for standard download)
- ```Ready for download``` now available for collections and can be changed for multiple user - ```Ready for download``` now available for collections and can be changed for multiple user
@@ -271,12 +493,16 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 1.0.0.3 # 1.0.0.3
*2021-12-11*
- Fixed - Fixed
- Custom "Download videos" option is not saved - Custom "Download videos" option is not saved
- The "Download all" button is not activated after changing modes - The "Download all" button is not activated after changing modes
# 1.0.0.2 # 1.0.0.2
*2021-12-10*
- Added - Added
- Ability to choose what types of media you want to download (images only, videos only, both) - Ability to choose what types of media you want to download (images only, videos only, both)
- Ability to name files by date - Ability to name files by date
@@ -285,6 +511,8 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 1.0.0.1 # 1.0.0.1
*2021-12-09*
- Added - Added
- Limited download if user added from the channel - Limited download if user added from the channel
- Forced limited download for any user - Forced limited download for any user
@@ -307,4 +535,6 @@ At the requests of some users, I added [screenshots](ProgramScreenshots) of the
# 1.0.0.0 # 1.0.0.0
*2021-12-07*
Initial release Initial release

22
FAQ.md
View File

@@ -18,7 +18,7 @@ A: https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies
#### Q: **I can't copy cookies.** #### Q: **I can't copy cookies.**
A: Use the mouse. Don't use ```Ctrl``` + ```A```! A: Use the mouse. Don't use ```Ctrl+A```!
---- ----
@@ -44,6 +44,8 @@ A: How to request a new site you can read [here](CONTRIBUTING.md#how-to-request-
A: Check your credentials. Both of these sites require cookies. Check your [Twitter tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) and [Instagram settings](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram-settings). 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. A: Check your credentials. Both of these sites require cookies. Check your [Twitter tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) and [Instagram settings](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram-settings). 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.
**[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
---- ----
#### Q: **I have set credentials but still nothing is downloading** #### Q: **I have set credentials but still nothing is downloading**
@@ -94,6 +96,24 @@ A: Just add that user back to the program. In the dialog box that opens, click o
---- ----
#### 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?** #### Q: **Can you add a step-by-step guide or video on how to use the program?**
A: **NO**! I will not do it. 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. A: **NO**! I will not do it. 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.

View File

@@ -1,6 +1,4 @@
List of available plugins: List of available plugins:
- LPSG
- XVIDEOS
Tools: Tools:
- [image2post](https://github.com/unknown81311/SCrawler-image2post) by @unknown81311: **get reddit post URL from file.** - [image2post](https://github.com/unknown81311/SCrawler-image2post) by @unknown81311: **get reddit post URL from file.**

Binary file not shown.

After

Width:  |  Height:  |  Size: 483 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.7 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 7.4 KiB

After

Width:  |  Height:  |  Size: 9.2 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 369 KiB

After

Width:  |  Height:  |  Size: 363 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 379 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 6.8 KiB

After

Width:  |  Height:  |  Size: 15 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.5 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.6 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 19 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 KiB

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 9.3 KiB

After

Width:  |  Height:  |  Size: 11 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 11 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 10 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 26 KiB

After

Width:  |  Height:  |  Size: 28 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 15 KiB

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.6 KiB

View File

@@ -18,7 +18,7 @@ https://www.4kdownload.com/products/product-stogram
| Download posts by location | No | **Yes** | | Download posts by location | No | **Yes** |
| Save Private Instagram Content with Permission| Yes | Yes | | Save Private Instagram Content with Permission| Yes | Yes |
| Download Instagram Stories and Highlights | Yes | Yes | | Download Instagram Stories and Highlights | Yes | Yes |
| See Others Instagram Feed As Your Own | No | **Yes** | | See Others Instagram Feed As Your Own | Yes | Yes |
| Download Instagram Video Posts | Yes | Yes | | Download Instagram Video Posts | Yes | Yes |
| Backup Your Instagram Account | Yes | Yes | | Backup Your Instagram Account | Yes | Yes |
| Save Instagram Posts by Date | Yes | Yes | | Save Instagram Posts by Date | Yes | Yes |
@@ -31,7 +31,7 @@ https://www.4kdownload.com/products/product-stogram
| Automatic Subscriptions Update | **Free** | Paid (43.56 EUR) | | Automatic Subscriptions Update | **Free** | Paid (43.56 EUR) |
| Posts and Captions Export | No | Paid (43.56 EUR) | | Posts and Captions Export | No | Paid (43.56 EUR) |
| Advertisements free | **No ADs at all for free** | Paid (14.52) | | Advertisements free | **No ADs at all for free** | Paid (14.52) |
| Operating Systems | Windows 7+ | Windows 7+, MacOS 10.13+, Ubuntu x64 | | Operating Systems | Windows 10+ | Windows 7+, MacOS 10.13+, Ubuntu x64 |
| Select want content type to download | **Yes** | No | | Select want content type to download | **Yes** | No |
| Instagram support | Yes | Yes | | Instagram support | Yes | Yes |
| Twitter support | **Yes** | No | | Twitter support | **Yes** | No |
@@ -66,9 +66,9 @@ https://github.com/RipMeApp/ripme
| Export and import subscriptions | No | No | | Export and import subscriptions | No | No |
| **Paid** | **No** | **No** | | **Paid** | **No** | **No** |
| **Free options** | The program is completely free | The program is completely free, but site limits are not declared | | **Free options** | The program is completely free | The program is completely free, but site limits are not declared |
| Operating Systems | Windows 7+ | Windows, MacOS, Linux | | Operating Systems | Windows 10+ | Windows, MacOS, Linux |
| Select want content type to download | Yes | Yes | | Select want content type to download | Yes | Yes |
| Suported sites | 3 internal and any site using plugins | 86+ sites (declared) | | Suported sites | 6 internal and any site using plugins | 86+ sites (declared) |
| Other sites support | **Yes** | No | | Other sites support | **Yes** | No |
| Still supported | **Yes** | **No (last release date May 4, 2021)** | | Still supported | **Yes** | **No (last release date May 4, 2021)** |

View File

@@ -1,4 +1,4 @@
# Social networks crawler # :rainbow_flag: Social networks crawler :rainbow_flag:
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest) [![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
[![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE) [![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE)
@@ -6,7 +6,9 @@
[![GUIDE](https://img.shields.io/badge/GUIDE-green)](https://github.com/AAndyProgram/SCrawler/wiki) [![GUIDE](https://img.shields.io/badge/GUIDE-green)](https://github.com/AAndyProgram/SCrawler/wiki)
[![How to support](https://img.shields.io/badge/HowToSupport-green)](HowToSupport.md) [![How to support](https://img.shields.io/badge/HowToSupport-green)](HowToSupport.md)
A program to download photo and video from [any site](#supported-sites) (e.g. Reddit, Twitter, Instagram). A program to download photo and video from [any site](#supported-sites) (e.g. Reddit, Twitter, Instagram, TikTok, RedGifs, XVIDEOS, LPSG).
**If you like SCrawler, please like the program on [this site]( https://alternativeto.net/software/scrawler/about/)**
Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush: Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush:
@@ -19,14 +21,11 @@ Do you like this program? Consider adding to my coffee fund by making a donation
# What can program do: # What can program do:
- Download pictures and videos from users' profiles and subreddits: - Download pictures and videos from users' profiles and subreddits:
- Reddit images; - Reddit images, galleries of images, videos (downloading Reddit hosted video is going through ffmpeg (**ffmpeg only works with the x64 program**));
- Reddit galleries of images;
- Reddit videos (downloading Reddit hosted video is going through ffmpeg (**ffmpeg only works with the x64 program**));
- Redgifs videos (https://www.redgifs.com/); - Redgifs videos (https://www.redgifs.com/);
- Twitter images and videos; - Twitter images and videos;
- Instagram images and videos; - Instagram images and videos, tagged posts, stories;
- Instagram tagged posts; - TikTok videos ([limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits));
- Instagram stories;
- Imgur images, galleries and videos; - Imgur images, galleries and videos;
- Gfycat videos; - Gfycat videos;
- [Other](#supported-sites) supported sites - [Other](#supported-sites) supported sites
@@ -35,6 +34,7 @@ Do you like this program? Consider adding to my coffee fund by making a donation
- Add users from parsed channel - Add users from parsed channel
- **Advanced user management** - **Advanced user management**
- **Automation** (downloading data automatically every ```X``` minutes) - **Automation** (downloading data automatically every ```X``` minutes)
- **Feed** (feed of downloaded media files)
- Labeling users - Labeling users
- Create download groups - Create download groups
- Adding users to favorites and temporary - Adding users to favorites and temporary
@@ -52,6 +52,7 @@ Do you like this program? Consider adding to my coffee fund by making a donation
- **Reddit** - **Reddit**
- **Twitter** - **Twitter**
- **Instagram** - **Instagram**
- **TikTok** ([limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits))
- RedGifs - RedGifs
- Imgur - Imgur
- Gfycat - Gfycat
@@ -59,7 +60,9 @@ Do you like this program? Consider adding to my coffee fund by making a donation
- XVIDEOS - XVIDEOS
- [Other sites](Plugins.md) - [Other sites](Plugins.md)
# How does it works: **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
# How it works
First, the program downloads the full profile. After the program downloads only new posts. The program remembers downloaded posts. First, the program downloads the full profile. After the program downloads only new posts. The program remembers downloaded posts.
@@ -71,8 +74,6 @@ The program parses all user posts, obtain MD5 images hash and compares them wit
The program parses all user posts and compares file names with existing ones to remove duplicates. Then the media will be downloaded. The program parses all user posts and compares file names with existing ones to remove duplicates. Then the media will be downloaded.
You can read about Instagram restrictions [here](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram-limits)
## How to request a new site ## How to request a new site
Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about
@@ -80,12 +81,33 @@ Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about
# Requirements # Requirements
- Windows 10, 11 with NET Framework 4.6.1 or higher (v4.6.1 must be installed). You can check version compatibility with this [tool](Tools/NET.FrameworkVersion.ps1). - Windows 10, 11 with NET Framework 4.6.1 or higher (v4.6.1 must be installed). You can check version compatibility with this [tool](Tools/NET.FrameworkVersion.ps1).
- Authorization [cookies](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies) and [tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) for Twitter (if you want to download data from Twitter) - **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
- Authorization [cookies](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies) and [Hash](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram) for Instagram (if you want to download data from Instagram), [Hash 2](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-instagram-hash-2) for saved Instagram posts, Instagram [stories authorization headers](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-instagram-stories-authorization-headers) for Stories and Tagged data
- ffmpeg library for downloading videos hosted on Reddit (you can download it from the [official repo](https://github.com/GyanD/codexffmpeg/releases/tag/2021-01-12-git-ca21cb1e36) or [from my first release](https://github.com/AAndyProgram/SCrawler/releases/download/1.0.0.0/ffmpeg.zip)). **ffmpeg only works with the x64 version of the program.**
# Guide # Guide
- [Main window](https://github.com/AAndyProgram/SCrawler/wiki)
- [Users](https://github.com/AAndyProgram/SCrawler/wiki/Users)
- [Add/Edit/Delete users](https://github.com/AAndyProgram/SCrawler/wiki/Users)
- [Collections](https://github.com/AAndyProgram/SCrawler/wiki#collections)
- [User operations](https://github.com/AAndyProgram/SCrawler/wiki#context-menu)
- [User labels](https://github.com/AAndyProgram/SCrawler/wiki/Users#labels)
- **[DOWNLOAD](https://github.com/AAndyProgram/SCrawler/wiki#download)**
- [Automation](https://github.com/AAndyProgram/SCrawler/wiki/Settings#automation)
- [Download groups](https://github.com/AAndyProgram/SCrawler/wiki/Settings#download-groups)
- [Downloading information](https://github.com/AAndyProgram/SCrawler/wiki#info)
- [Reddit channels](https://github.com/AAndyProgram/SCrawler/wiki/Channels)
- [Saved posts](https://github.com/AAndyProgram/SCrawler/wiki#saved-posts)
- [View modes, filters](https://github.com/AAndyProgram/SCrawler/wiki#view)
- **[SETTINGS](https://github.com/AAndyProgram/SCrawler/wiki/Settings)**
- **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
- [Reddit](https://github.com/AAndyProgram/SCrawler/wiki/Settings#reddit)
- [Twitter](https://github.com/AAndyProgram/SCrawler/wiki/Settings#twitter)
- [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram)
- [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok)
- [RedGifs](https://github.com/AAndyProgram/SCrawler/wiki/Settings#redgifs)
- [XVIDEOS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#xvideos)
- [LPSG](https://github.com/AAndyProgram/SCrawler/wiki/Settings#lpsg)
**Full guide you can find [here](https://github.com/AAndyProgram/SCrawler/wiki)** **Full guide you can find [here](https://github.com/AAndyProgram/SCrawler/wiki)**
# Installation # Installation
@@ -100,10 +122,7 @@ Just download [latest](https://github.com/AAndyProgram/SCrawler/releases/latest)
# How to build from source # How to build from source
1. Delete the "PersonalUtilities" project from the solution. Read about how to build from source [here](CONTRIBUTING.md#how-to-build-from-source)
1. Delete the "PersonalUtilities.Notifications" project from the solution.
1. Add the latest versions of the ```PersonalUtilities.dll``` and ```PersonalUtilities.Notifications.dll``` libraries (from the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest)).
1. Import PersonalUtilities.Functions for the whole project.
# How to make a plugin # How to make a plugin
@@ -117,22 +136,9 @@ Read more about how to support the program [here](HowToSupport.md).
The program has an intuitive interface. The program has an intuitive interface.
You need to set up authorization for Twitter and Instagram: **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
- Authorization [cookies](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies) and [tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) for **Twitter** (if you want to download data from Twitter)
- Authorization [cookies](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies) and [Hash](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram) for **Instagram** (if you want to download data from Instagram), [Hash 2](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-instagram-hash-2) for **saved Instagram posts**, Instagram [stories authorization headers](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-instagram-stories-authorization-headers) for **Stories** and **Tagged data**
Just add a user profile and **click the ```Start downloading``` button**. Just add a user profile and **click the ```Download``` button**.
You can add users by patterns:
- https://www.instagram.com/SomeUserName
- https://twitter.com/SomeUserName
- https://reddit.com/user/SomeUserName
- https://reddit.com/r/SomeSubredditName
- https://www.redgifs.com/users/SomeUserName
- u/SomeUserName
- r/SomeSubredditName
- SomeUserName (in this case, you need to select the user's site)
- SomeSubredditName
Read more about adding users and subreddits [here](https://github.com/AAndyProgram/SCrawler/wiki/Users) Read more about adding users and subreddits [here](https://github.com/AAndyProgram/SCrawler/wiki/Users)
@@ -145,7 +151,3 @@ Create a shortcut for the program. Open shortcut properties. In the ```Shortcut`
Example: ```D:\Programs\SCrawler\SCrawler.exe v``` Example: ```D:\Programs\SCrawler\SCrawler.exe v```
![Separate video downloader](ProgramScreenshots/SeparateVideoDownloader.png) ![Separate video downloader](ProgramScreenshots/SeparateVideoDownloader.png)
# Contact me
[![matrix](https://img.shields.io/badge/Matrix-%40andyprogram%3Amatrix.org-informational)](https://matrix.to/#/@andyprogram:matrix.org)

View File

@@ -30,19 +30,5 @@ Friend Module Declarations
Friend ReadOnly Property FileRegExExt As New RParams(FileUrlRegexDefault, 0, Nothing, InputForbidRemover) Friend ReadOnly Property FileRegExExt As New RParams(FileUrlRegexDefault, 0, Nothing, InputForbidRemover)
Friend ReadOnly Property FileRegExExt2 As New RParams("([^/]+?)(?=(\Z|&))", 0, Nothing, InputForbidRemover) Friend ReadOnly Property FileRegExExt2 As New RParams("([^/]+?)(?=(\Z|&))", 0, Nothing, InputForbidRemover)
Friend ReadOnly Property FileExistsRegEx As RParams = RParams.DMS(FileUrlRegexDefault, 2) Friend ReadOnly Property FileExistsRegEx As RParams = RParams.DMS(FileUrlRegexDefault, 2)
Private Class PUMComparer : Implements IEqualityComparer, IEqualityComparer(Of PluginUserMedia) Friend ReadOnly TempListAddParams As New ListAddParams(LAP.NotContainsOnly) With {.Comparer = New FComparer(Of PluginUserMedia)(Function(x, y) x.URL = y.URL)}
Private Overloads Function Equals(ByVal x As PluginUserMedia, ByVal y As PluginUserMedia) As Boolean Implements IEqualityComparer(Of PluginUserMedia).Equals
Return x.URL = y.URL
End Function
Private Function IEqualityComparer_Equals(ByVal x As Object, ByVal y As Object) As Boolean Implements IEqualityComparer.Equals
Return DirectCast(x, PluginUserMedia).URL = DirectCast(y, PluginUserMedia).URL
End Function
Private Overloads Function GetHashCode(ByVal Obj As Object) As Integer Implements IEqualityComparer.GetHashCode
Throw New NotImplementedException()
End Function
Private Overloads Function GetHashCode(ByVal Obj As PluginUserMedia) As Integer Implements IEqualityComparer(Of PluginUserMedia).GetHashCode
Throw New NotImplementedException()
End Function
End Class
Friend ReadOnly TempListAddParams As New ListAddParams(LAP.NotContainsOnly) With {.Comparer = New PUMComparer}
End Module End Module

View File

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

View File

@@ -30,7 +30,7 @@ Public Class SiteSettings : Implements ISiteSettings
.LoadSettings() .LoadSettings()
Else Else
.CookiesDomain = "www.lpsg.com" .CookiesDomain = "www.lpsg.com"
.Cookies = New CookieKeeper("www.lpsg.com") .Cookies = New CookieKeeper(.CookiesDomain)
End If End If
End With End With
End Sub End Sub
@@ -54,6 +54,10 @@ Public Class SiteSettings : Implements ISiteSettings
End Sub End Sub
#End Region #End Region
#Region "Update" #Region "Update"
Public Sub BeginEdit() Implements ISiteSettings.BeginEdit
End Sub
Public Sub EndEdit() Implements ISiteSettings.EndEdit
End Sub
Public Sub BeginUpdate() Implements ISiteSettings.BeginUpdate Public Sub BeginUpdate() Implements ISiteSettings.BeginUpdate
End Sub End Sub
Public Sub EndUpdate() Implements ISiteSettings.EndUpdate Public Sub EndUpdate() Implements ISiteSettings.EndUpdate
@@ -81,7 +85,7 @@ Public Class SiteSettings : Implements ISiteSettings
Else Else
Return Nothing Return Nothing
End If End If
Catch ex As Exception Catch
Return Nothing Return Nothing
End Try End Try
End Function End Function
@@ -92,9 +96,12 @@ Public Class SiteSettings : Implements ISiteSettings
Return Nothing Return Nothing
End Function End Function
Public Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean Implements ISiteSettings.Available Public Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean Implements ISiteSettings.Available
Return True Return If(Responser.Cookies?.Count, 0) > 0
End Function End Function
Public Function ReadyToDownload(ByVal What As ISiteSettings.Download) As Boolean Implements ISiteSettings.ReadyToDownload Public Function ReadyToDownload(ByVal What As ISiteSettings.Download) As Boolean Implements ISiteSettings.ReadyToDownload
Return True Return True
End Function End Function
Public Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String Implements ISiteSettings.GetUserPostUrl
Return String.Empty
End Function
End Class End Class

View File

@@ -38,7 +38,8 @@ Public Class UserData : Implements IPluginContentProvider
Public Property SeparateVideoFolder As Boolean Implements IPluginContentProvider.SeparateVideoFolder Public Property SeparateVideoFolder As Boolean Implements IPluginContentProvider.SeparateVideoFolder
Public Property DataPath As String Implements IPluginContentProvider.DataPath Public Property DataPath As String Implements IPluginContentProvider.DataPath
Public Property PostsNumberLimit As Integer? Implements IPluginContentProvider.PostsNumberLimit Public Property PostsNumberLimit As Integer? Implements IPluginContentProvider.PostsNumberLimit
Public Property PostsDateLimit As Date? Implements IPluginContentProvider.PostsDateLimit Public Property DownloadDateFrom As Date? Implements IPluginContentProvider.DownloadDateFrom
Public Property DownloadDateTo As Date? Implements IPluginContentProvider.DownloadDateTo
#End Region #End Region
#Region "Interface exchange options" #Region "Interface exchange options"
Public Sub ExchangeOptionsSet(ByVal Obj As Object) Implements IPluginContentProvider.ExchangeOptionsSet Public Sub ExchangeOptionsSet(ByVal Obj As Object) Implements IPluginContentProvider.ExchangeOptionsSet
@@ -95,7 +96,7 @@ Public Class UserData : Implements IPluginContentProvider
If Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then If Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
LogProvider.Add("LPSG not available") LogProvider.Add("LPSG not available")
Else Else
LogProvider.Add(ex, "[LPSG.UserData.GetMedia]") LogProvider.Add(ex, $"[LPSG.UserData.GetMedia({Name})]")
End If End If
End Try End Try
End Sub End Sub
@@ -152,7 +153,8 @@ Public Class UserData : Implements IPluginContentProvider
If Responser.Client.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then If Responser.Client.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
LogProvider.Add("LPSG not available") LogProvider.Add("LPSG not available")
Else Else
m.DownloadState = UStates.Skipped m.DownloadState = UStates.Missing
m.Attempts += 1
End If End If
End Try End Try
RaiseEvent ProgressChanged(1) RaiseEvent ProgressChanged(1)

View File

@@ -47,8 +47,7 @@ Friend NotInheritable Class M3U8
CachePath.Delete(SFO.Path, SFODelete.None, EDP.None) CachePath.Delete(SFO.Path, SFODelete.None, EDP.None)
End Try End Try
End Function End Function
Friend Shared Function Download(ByVal URL As String, ByVal Appender As String, ByVal ffmpegFile As SFile, ByVal f As SFile, Friend Shared Function Download(ByVal URL As String, ByVal Appender As String, ByVal ffmpegFile As SFile, ByVal f As SFile, ByRef Logger As ILogProvider) As SFile
ByRef Logger As ILogProvider) As SFile
Try Try
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
Using w As New WebClient Using w As New WebClient
@@ -62,7 +61,7 @@ Friend NotInheritable Class M3U8
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
If Not ex.HelpLink = 1 Then Logger.Add(ex, "[M3U8.Download]") If Not ex.HelpLink = 1 Then Logger.Add(ex, $"[M3U8.Download({URL}, {Appender}, {ffmpegFile}, {f})]")
Throw ex Throw ex
End Try End Try
End Function End Function

View File

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

View File

@@ -25,14 +25,9 @@ Partial Public Class SettingsForm : Inherits System.Windows.Forms.Form
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(SettingsForm)) Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(SettingsForm))
Me.LIST_DOMAINS = New System.Windows.Forms.ListBox() Me.LIST_DOMAINS = New System.Windows.Forms.ListBox()
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
Me.BTT_ADD = New System.Windows.Forms.ToolStripButton()
Me.BTT_DELETE = New System.Windows.Forms.ToolStripButton()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer() CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
CONTAINER_MAIN.ContentPanel.SuspendLayout() CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.TopToolStripPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout() CONTAINER_MAIN.SuspendLayout()
Me.ToolbarTOP.SuspendLayout()
Me.SuspendLayout() Me.SuspendLayout()
' '
'CONTAINER_MAIN 'CONTAINER_MAIN
@@ -41,7 +36,7 @@ Partial Public Class SettingsForm : Inherits System.Windows.Forms.Form
'CONTAINER_MAIN.ContentPanel 'CONTAINER_MAIN.ContentPanel
' '
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.LIST_DOMAINS) CONTAINER_MAIN.ContentPanel.Controls.Add(Me.LIST_DOMAINS)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(384, 266) CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(384, 291)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0) CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -50,52 +45,15 @@ Partial Public Class SettingsForm : Inherits System.Windows.Forms.Form
CONTAINER_MAIN.Size = New System.Drawing.Size(384, 291) CONTAINER_MAIN.Size = New System.Drawing.Size(384, 291)
CONTAINER_MAIN.TabIndex = 0 CONTAINER_MAIN.TabIndex = 0
' '
'CONTAINER_MAIN.TopToolStripPanel
'
CONTAINER_MAIN.TopToolStripPanel.Controls.Add(Me.ToolbarTOP)
'
'LIST_DOMAINS 'LIST_DOMAINS
' '
Me.LIST_DOMAINS.Dock = System.Windows.Forms.DockStyle.Fill Me.LIST_DOMAINS.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_DOMAINS.FormattingEnabled = True Me.LIST_DOMAINS.FormattingEnabled = True
Me.LIST_DOMAINS.Location = New System.Drawing.Point(0, 0) Me.LIST_DOMAINS.Location = New System.Drawing.Point(0, 0)
Me.LIST_DOMAINS.Name = "LIST_DOMAINS" Me.LIST_DOMAINS.Name = "LIST_DOMAINS"
Me.LIST_DOMAINS.Size = New System.Drawing.Size(384, 266) Me.LIST_DOMAINS.Size = New System.Drawing.Size(384, 291)
Me.LIST_DOMAINS.TabIndex = 0 Me.LIST_DOMAINS.TabIndex = 0
' '
'ToolbarTOP
'
Me.ToolbarTOP.Dock = System.Windows.Forms.DockStyle.None
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_ADD, Me.BTT_DELETE})
Me.ToolbarTOP.Location = New System.Drawing.Point(0, 0)
Me.ToolbarTOP.Name = "ToolbarTOP"
Me.ToolbarTOP.Size = New System.Drawing.Size(384, 25)
Me.ToolbarTOP.Stretch = True
Me.ToolbarTOP.TabIndex = 0
'
'BTT_ADD
'
Me.BTT_ADD.AutoToolTip = False
Me.BTT_ADD.BackColor = System.Drawing.Color.FromArgb(CType(CType(192, Byte), Integer), CType(CType(255, Byte), Integer), CType(CType(192, Byte), Integer))
Me.BTT_ADD.ForeColor = System.Drawing.Color.DarkGreen
Me.BTT_ADD.Image = CType(resources.GetObject("BTT_ADD.Image"), System.Drawing.Image)
Me.BTT_ADD.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_ADD.Name = "BTT_ADD"
Me.BTT_ADD.Size = New System.Drawing.Size(49, 22)
Me.BTT_ADD.Text = "Add"
'
'BTT_DELETE
'
Me.BTT_DELETE.AutoToolTip = False
Me.BTT_DELETE.BackColor = System.Drawing.Color.FromArgb(CType(CType(255, Byte), Integer), CType(CType(192, Byte), Integer), CType(CType(192, Byte), Integer))
Me.BTT_DELETE.ForeColor = System.Drawing.Color.Maroon
Me.BTT_DELETE.Image = CType(resources.GetObject("BTT_DELETE.Image"), System.Drawing.Image)
Me.BTT_DELETE.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DELETE.Name = "BTT_DELETE"
Me.BTT_DELETE.Size = New System.Drawing.Size(60, 22)
Me.BTT_DELETE.Text = "Delete"
'
'SettingsForm 'SettingsForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
@@ -112,18 +70,11 @@ Partial Public Class SettingsForm : Inherits System.Windows.Forms.Form
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Settings" Me.Text = "Settings"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False) CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.TopToolStripPanel.ResumeLayout(False)
CONTAINER_MAIN.TopToolStripPanel.PerformLayout()
CONTAINER_MAIN.ResumeLayout(False) CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout() CONTAINER_MAIN.PerformLayout()
Me.ToolbarTOP.ResumeLayout(False)
Me.ToolbarTOP.PerformLayout()
Me.ResumeLayout(False) Me.ResumeLayout(False)
End Sub End Sub
Private WithEvents LIST_DOMAINS As Windows.Forms.ListBox Private WithEvents LIST_DOMAINS As Windows.Forms.ListBox
Private WithEvents ToolbarTOP As Windows.Forms.ToolStrip
Private WithEvents BTT_ADD As Windows.Forms.ToolStripButton
Private WithEvents BTT_DELETE As Windows.Forms.ToolStripButton
End Class End Class

View File

@@ -120,60 +120,7 @@
<metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> <metadata name="CONTAINER_MAIN.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </metadata>
<metadata name="ToolbarTOP.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>17, 17</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" /> <assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<data name="BTT_ADD.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAN+SURBVEhLrZVZSFRRGMdvKa6oE5Y1bpTtRY2pJYk3ayyd
xgrvaDXlQotLKVqSo7QR2QIREUX0EgUSET1V9NTyYBHt6ZTOqNPY7DomWNbriX/fuYzkg2jY/eAPM5zD
//+d7/7OvcJkFXIlqDX0ahDGE18LbJt6cSOtWWTaDhGbPonQdZEsIrY7cuWQwLapFzfZ9FlkES8ERL8W
EPteQMLHYFR69coFUNcs5o2AWe+nYW5HKFK7otHkL1IuoKBbZLzzFHMo0qwxWN8zG2eHSpULkGxalmIO
w2qrCvm2eJr/AlwZrlIuYN9XHcuwqKC3JWC3czGqXKm4OVKvXMARTyHTfUlEmWspatxp9D8Ld0ZM/xYw
EeejMnkMv0tdS1DnzkBzv4jT/jy0fm/EzLvhE0p9P7JV7jB3lHHiu6BHhMGmRbkjH3WebTjq245z/nL6
nYFjvnVo8efjzKAOrcONuD1skoNuDNfj8lAFWgZL0OQrphEWoMa1E+oHkZADuHn0K2L8rYDEjhBoCENO
itSXgr2u5TjkycTx/g1koMP5Qb0ccHogj8xEVLlTsaNvIXJ750BjiUZSewhU5LPTIv0N4J1zc76osUTR
ZjWKAuaHvZk44dPijF9HAXk4OaCFyZdNzyIde5zLUGifh5yeOKzoikJ8RzBU7wSE06Us+jQmoMAqIpnM
U6mDXJtaxrDSrUGDdw2O9a/HCTI96suByZuNw57VqKa1MtcybLXPxTo6qWzeHgx+Gbn5tCcCpHdjAnbZ
NmKtNZYwTESJYwnq6WE2EinNZMhNj3izZDXQqKppJJymLfZkZHfHYWlnJNQfghBFIw5rEyA8Jj2ggJdj
Ag769cw0ZGAtP8rYhZH97NLPanbpVxW7/PMAu/atlnSQzNeg0qWB0bkIensSmj3lqHUaf1d4ilipU2LG
LxIzWCUmfSZ9JL2VmBzAMR0PsVHxTbeGmlmleyWMjoXYTKfMpNPWuI3y2oTimE5WfOP1bw1sBz2X/N4E
pNONnm8Oxx6HQTYJbJt6cZOLAzUsrzdeftHxt2kskbLbFpjx/xY3OeWtYKssMUgkUmYQzvzbUDzK+f8W
N6l3lbCk9lCoCMOI5wKCnhIlZgUD9tkNjJuHUefTOYaPKOCNggEl3RILp84FukDCQ9I9CnihYEBxpySP
hNiWL5DURnqmVACxzI3G1aScC8If1IGynvf45pQAAAAASUVORK5CYII=
</value>
</data>
<data name="BTT_DELETE.Image" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8
YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAVFSURBVEhLjZVrTJNXGMcLQmdHO6Sdt6ygAyYgN+1bS+uE
4ASlxVfSUkFkRMyouILinShGYzTRKCZL9mH7sH3YMj+YzUSXZXNeQOcEFkFhysbVQWlL6dsLvMwtWaBn
/1OKl1A2nuSX8p7znP/z5znnPa+ARntubkRjXNxnd5Ys6b2xbNmn+XL5WxgO80/+T/SoVOo/YmLu9S9d
+uhqfLwRQxEgxD9J44nZLH6Qm/tNT20tGbh4kTw9dMh3Q6NpyJBI3sF0+FRW8OhimHX2kpJB/vx5Ml5f
TwaKitwfJyZWxURGRmF6qkhDXNwn3QcOkKenTpGBkyeJFcmWI0fIdbX6XppEsgIpQYv0aTTvQdzCX7hA
eKzl6+rI+IkTpJdlPd/K5R8hRQrCBHdkMisVh3MyeOwYsSJp+OxZYq2t9d1QqX5OlUgSkPhKEbRlo724
2EqdU/FxiPOHD5NxGPOWlZHGxYs7kaYGEsGt6OhLvRUVZAAFLMB69CixY8HImTPEjnbdVqubU8TiRCT7
i/QoFBuHi4qsY+fOER5mxmGKx7rx/fvJ6O7dpEGl4splsq+RqgNSgWH58mXXlcp7/Tt3+oaQZAPDcDOC
PXGhZc6DB8kdFFktFic9ZJhcm9FoHzt92t8SHo55tJevqSFjEL+rUrkTRKIvIWwCaYBuuCCckckSUaTZ
smMHse/ZQxzV1WRk3z7CoZiH/jfV1b4WjaZjsKDAyh8/7nfMY45HLl9VNSWuVLqTRKJL0KsAyQHxUOAP
4WqpNOlHhaJpqLTU56isJE7gMpuJGwJeFPPu3UvG4HaMCuOZx7NfHO1t0mg86WIxFafOV4L54MVRDYRQ
JZWuvJWe3mzfupU4y8uJC3hMJuKFw1EUHMUGjhYUEO/69cSr0RA3aMrI8K6WSC5j/S5AnYvADPHpEK6J
ikpuSEtrtrHshHvbNuLSaomLYQgnlxNOIiFceDjh5s0jI2Kx73ZsrEcdFUU3tBKkgNfBrOLT4W/Xg/T0
9mEIOqgYcAIq7CcsjPzOMH8bExO/R/6HIBXMSdwf9rIys33dOotDJJopDuiYNT5+opFl+5OiowuwJBLM
TdxrMh3kNmzgHHA/m7gNDAJLcjJ5VFjYuX3t2lVY+p/Xij9cJlMdt2mTyxERMUPcid7TdlHxAdAbGkqe
gO5Vq3zthYW/GdVq2qbZi3h27TrG5eW5gzl3ymRkKC/vH3tCgo+K9wTE20ATeMwwk+1GY+f22YrgKNZx
Wq3HIRb7hV9py6JFpEun+/N0VlZL2+bNw5akJPIYoq3gPvgJNIL2NWsmW43Gjg1pafSCfHHVuysqajmd
zoNjN1N84ULSk5//rIphbiG1Oi8l5f1Ovb6/C72fFm8AN8F10KpSTbYUFrZ9wbJ044UgROA2GKwjCxYE
dU7FKxWKm0g0A7qR0n3Z2e92GAx9Hampz8V/AN+Ba6A9K2ui1WDoRu5yIBQ4jcYud0xMUOdmhrmNpKqA
+PSXSrg/J0eNje1rS031vSx+JSSEtGZmTtxlWRvyckGUoKW0tGSYZV0uiL7k/K89wcWnQ1iTnZ2Bje3F
C0muBsRxbUxe1mqHdCtWfI6cqQKI+TeLio5bt2zxONVqX49O96xGqWzA+Gzi0yE0ZWYqaDtase4XjWby
ilZre0MkqsecHky1CBHCxMZGPjQYvnqq1zsv5+Tg9IXWYJwBYjpPk2YJ4bXi4g9+1ett91mW0yYk0G+B
AcgBPa7P19I/FgAlyA/8zvX1fw3Qo0lPzmbwNgj6ws0D1DH9WNNf+jyXoCbo/f9mAFowYEwg+Bc5Ntw7
FHW1qQAAAABJRU5ErkJggg==
</value>
</data>
<data name="$this.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="$this.Icon" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
AAABAAUAEBAAAAEAIABoBAAAVgAAABgYAAABACAAiAkAAL4EAAAgIAAAAQAIAKgIAABGDgAAMDAAAAEA AAABAAUAEBAAAAEAIABoBAAAVgAAABgYAAABACAAiAkAAL4EAAAgIAAAAQAIAKgIAABGDgAAMDAAAAEA

View File

@@ -8,28 +8,24 @@
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms.Toolbars Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Public Class SettingsForm : Implements IOkCancelToolbar Public Class SettingsForm
Private ReadOnly MyDefs As DefaultFormProps Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property Settings As SiteSettings Private ReadOnly Property Settings As SiteSettings
Friend Sub New(ByRef s As SiteSettings) Friend Sub New(ByRef s As SiteSettings, ByRef Design As XML.XmlFile)
InitializeComponent() InitializeComponent()
MyDefs = New DefaultFormProps
Settings = s Settings = s
MyDefs = New DefaultFormOptions(Me, Design)
End Sub End Sub
Private Sub SettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load Private Sub SettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
With MyDefs With MyDefs
.MyViewInitialize(Me, Settings.Design, True) .MyViewInitialize(True)
.AddEditToolbar({EditToolbar.ControlItem.Add, EditToolbar.ControlItem.Delete})
.AddOkCancelToolbar() .AddOkCancelToolbar()
.DelegateClosingChecker()
If Settings.Domains.Count > 0 Then Settings.Domains.ForEach(Sub(d) LIST_DOMAINS.Items.Add(d)) If Settings.Domains.Count > 0 Then Settings.Domains.ForEach(Sub(d) LIST_DOMAINS.Items.Add(d))
.EndLoaderOperations() .EndLoaderOperations()
End With End With
Catch ex As Exception
MyDefs.InvokeLoaderError(ex)
End Try
End Sub End Sub
Private Sub OK() Implements IOkCancelToolbar.OK Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
Settings.Domains.Clear() Settings.Domains.Clear()
With LIST_DOMAINS With LIST_DOMAINS
If .Items.Count > 0 Then If .Items.Count > 0 Then
@@ -39,10 +35,7 @@ Public Class SettingsForm : Implements IOkCancelToolbar
Settings.UpdateDomains() Settings.UpdateDomains()
MyDefs.CloseForm() MyDefs.CloseForm()
End Sub End Sub
Private Sub Cancel() Implements IOkCancelToolbar.Cancel Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
MyDefs.CloseForm(Windows.Forms.DialogResult.Cancel)
End Sub
Private Sub BTT_ADD_Click(sender As Object, e As EventArgs) Handles BTT_ADD.Click
Dim nd$ = InputBoxE("Enter a new domain using the pattern [xvideos.com]:", "New domain") Dim nd$ = InputBoxE("Enter a new domain using the pattern [xvideos.com]:", "New domain")
If Not nd.IsEmptyString Then If Not nd.IsEmptyString Then
If Not LIST_DOMAINS.Items.Contains(nd) Then If Not LIST_DOMAINS.Items.Contains(nd) Then
@@ -52,11 +45,10 @@ Public Class SettingsForm : Implements IOkCancelToolbar
End If End If
End If End If
End Sub End Sub
Private Sub BTT_DELETE_Click(sender As Object, e As EventArgs) Handles BTT_DELETE.Click Private Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE
If _LatestSelected.ValueBetween(0, LIST_DOMAINS.Items.Count - 1) Then If _LatestSelected.ValueBetween(0, LIST_DOMAINS.Items.Count - 1) Then
Dim n$ = LIST_DOMAINS.Items(_LatestSelected) Dim n$ = LIST_DOMAINS.Items(_LatestSelected)
If MsgBoxE({$"Are you sure you want to delete the [{n}] domain?", If MsgBoxE({$"Are you sure you want to delete the [{n}] domain?", "Removing domains"}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
"Removing domains"}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
LIST_DOMAINS.Items.RemoveAt(_LatestSelected) LIST_DOMAINS.Items.RemoveAt(_LatestSelected)
MsgBoxE($"Domain [{n}] removed") MsgBoxE($"Domain [{n}] removed")
Else Else

View File

@@ -26,7 +26,7 @@ Public Class SiteSettings : Implements ISiteSettings
Public Property Logger As ILogProvider Implements ISiteSettings.Logger Public Property Logger As ILogProvider Implements ISiteSettings.Logger
#Region "M3U8" #Region "M3U8"
Private ReadOnly OS64 As Boolean Private ReadOnly OS64 As Boolean
Private ReadOnly FfmpegExists As Boolean Friend ReadOnly FfmpegExists As Boolean
Friend ReadOnly FfmpegFile As SFile Friend ReadOnly FfmpegFile As SFile
Friend ReadOnly Property UseM3U8 As Boolean Friend ReadOnly Property UseM3U8 As Boolean
Get Get
@@ -41,7 +41,6 @@ Public Class SiteSettings : Implements ISiteSettings
Public ReadOnly Property Responser As Response Public ReadOnly Property Responser As Response
Private Const DomainsDefault As String = "xvideos.com|xnxx.com" Private Const DomainsDefault As String = "xvideos.com|xnxx.com"
Private _Initialized As Boolean = False Private _Initialized As Boolean = False
Friend Design As XmlFile
Public Sub New() Public Sub New()
Responser = New Response($"Settings\Responser_{Site}.xml") Responser = New Response($"Settings\Responser_{Site}.xml")
With Responser With Responser
@@ -98,6 +97,10 @@ Public Class SiteSettings : Implements ISiteSettings
Public Sub DownloadDone(ByVal What As ISiteSettings.Download) Implements ISiteSettings.DownloadDone Public Sub DownloadDone(ByVal What As ISiteSettings.Download) Implements ISiteSettings.DownloadDone
End Sub End Sub
#End Region #End Region
Public Sub BeginEdit() Implements ISiteSettings.BeginEdit
End Sub
Public Sub EndEdit() Implements ISiteSettings.EndEdit
End Sub
Public Sub BeginUpdate() Implements ISiteSettings.BeginUpdate Public Sub BeginUpdate() Implements ISiteSettings.BeginUpdate
End Sub End Sub
Public Sub EndUpdate() Implements ISiteSettings.EndUpdate Public Sub EndUpdate() Implements ISiteSettings.EndUpdate
@@ -109,10 +112,8 @@ Public Class SiteSettings : Implements ISiteSettings
Public Sub Reset() Implements ISiteSettings.Reset Public Sub Reset() Implements ISiteSettings.Reset
End Sub End Sub
Public Sub OpenSettingsForm() Implements ISiteSettings.OpenSettingsForm Public Sub OpenSettingsForm() Implements ISiteSettings.OpenSettingsForm
Using f As New SettingsForm(Me) Using Design As New XmlFile("Settings\Design_XVIDEOS.xml")
Design = New XmlFile("Settings\Design_XVIDEOS.xml") Using f As New SettingsForm(Me, Design) : f.ShowDialog() : End Using
f.ShowDialog()
Design.Dispose()
End Using End Using
End Sub End Sub
Public Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Implements ISiteSettings.UserOptions Public Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Implements ISiteSettings.UserOptions
@@ -182,4 +183,7 @@ Public Class SiteSettings : Implements ISiteSettings
End If End If
Return Nothing Return Nothing
End Function End Function
Public Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String Implements ISiteSettings.GetUserPostUrl
Return String.Empty
End Function
End Class End Class

View File

@@ -14,8 +14,8 @@ Imports UStates = SCrawler.Plugin.PluginUserMedia.States
Imports UTypes = SCrawler.Plugin.PluginUserMedia.Types Imports UTypes = SCrawler.Plugin.PluginUserMedia.Types
Public Class UserData : Implements IPluginContentProvider Public Class UserData : Implements IPluginContentProvider
#Region "Interface declarations" #Region "Interface declarations"
Public Event ProgressChanged(Count As Integer) Implements IPluginContentProvider.ProgressChanged Public Event ProgressChanged(ByVal Count As Integer) Implements IPluginContentProvider.ProgressChanged
Public Event TotalCountChanged(Count As Integer) Implements IPluginContentProvider.TotalCountChanged Public Event TotalCountChanged(ByVal Count As Integer) Implements IPluginContentProvider.TotalCountChanged
Public Property Thrower As IThrower Implements IPluginContentProvider.Thrower Public Property Thrower As IThrower Implements IPluginContentProvider.Thrower
Public Property LogProvider As ILogProvider Implements IPluginContentProvider.LogProvider Public Property LogProvider As ILogProvider Implements IPluginContentProvider.LogProvider
Public Property ESettings As ISiteSettings Implements IPluginContentProvider.Settings Public Property ESettings As ISiteSettings Implements IPluginContentProvider.Settings
@@ -37,7 +37,8 @@ Public Class UserData : Implements IPluginContentProvider
Public Property SeparateVideoFolder As Boolean Implements IPluginContentProvider.SeparateVideoFolder Public Property SeparateVideoFolder As Boolean Implements IPluginContentProvider.SeparateVideoFolder
Public Property DataPath As String Implements IPluginContentProvider.DataPath Public Property DataPath As String Implements IPluginContentProvider.DataPath
Public Property PostsNumberLimit As Integer? Implements IPluginContentProvider.PostsNumberLimit Public Property PostsNumberLimit As Integer? Implements IPluginContentProvider.PostsNumberLimit
Public Property PostsDateLimit As Date? Implements IPluginContentProvider.PostsDateLimit Public Property DownloadDateFrom As Date? Implements IPluginContentProvider.DownloadDateFrom
Public Property DownloadDateTo As Date? Implements IPluginContentProvider.DownloadDateTo
#End Region #End Region
#Region "Interface exchange options" #Region "Interface exchange options"
Public Sub ExchangeOptionsSet(ByVal Obj As Object) Implements IPluginContentProvider.ExchangeOptionsSet Public Sub ExchangeOptionsSet(ByVal Obj As Object) Implements IPluginContentProvider.ExchangeOptionsSet
@@ -56,14 +57,21 @@ Public Class UserData : Implements IPluginContentProvider
Private Property Responser As Response Private Property Responser As Response
Public Sub GetMedia() Implements IPluginContentProvider.GetMedia Public Sub GetMedia() Implements IPluginContentProvider.GetMedia
Try Try
If Not Settings.UseM3U8 Then LogProvider.Add("File [ffmpeg.exe] not found") : Exit Sub If Not Settings.UseM3U8 Then
If Settings.FfmpegExists Then
LogProvider.Add($"XVIDEOS [{Name}]: The plugin only works with x64 OS.")
Else
LogProvider.Add($"XVIDEOS [{Name}]: File [ffmpeg.exe] not found")
End If
Exit Sub
End If
If Not Responser Is Nothing Then Responser.Dispose() If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Response Responser = New Response
Responser.Copy(Settings.Responser) Responser.Copy(Settings.Responser)
Dim NextPage% = 0 Dim NextPage% = 0
Dim r$ Dim r$
Dim j As EContainer, jj As EContainer Dim jj As EContainer
Dim e As ErrorsDescriber = EDP.ThrowException Dim e As ErrorsDescriber = EDP.ThrowException
Dim user$ = Settings.GetUserUrl(Name, False) Dim user$ = Settings.GetUserUrl(Name, False)
Dim p As PluginUserMedia Dim p As PluginUserMedia
@@ -74,8 +82,7 @@ Public Class UserData : Implements IPluginContentProvider
r = Responser.GetResponse($"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}",, e) r = Responser.GetResponse($"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}",, e)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True
j = JsonDocument.Parse(r).XmlIfNothing With JsonDocument.Parse(r).XmlIfNothing
With j
If .Contains("videos") Then If .Contains("videos") Then
With .Item("videos") With .Item("videos")
If .Count > 0 Then If .Count > 0 Then
@@ -86,9 +93,12 @@ Public Class UserData : Implements IPluginContentProvider
.URL = $"https://www.xvideos.com{jj.Value("u")}" .URL = $"https://www.xvideos.com{jj.Value("u")}"
} }
If Not p.PostID.IsEmptyString And Not jj.Value("u").IsEmptyString Then If Not p.PostID.IsEmptyString And Not jj.Value("u").IsEmptyString Then
If Not TempPostsList.Contains(p.PostID) Then TempPostsList.Add(p.PostID) : TempMediaList.Add(p) Else Exit Do If Not TempPostsList.Contains(p.PostID) Then TempPostsList.Add(p.PostID) : TempMediaList.Add(p) Else .Dispose() : Exit Do
End If End If
Next Next
Else
.Dispose()
Exit Do
End If End If
End With End With
Else Else
@@ -105,9 +115,7 @@ Public Class UserData : Implements IPluginContentProvider
If TempMediaList.Count > 0 Then If TempMediaList.Count > 0 Then
For i% = 0 To TempMediaList.Count - 1 For i% = 0 To TempMediaList.Count - 1
Thrower.ThrowAny() Thrower.ThrowAny()
With TempMediaList(i) With TempMediaList(i) : TempMediaList(i) = GetVideoData(.URL, Responser, Settings.DownloadUHD.Value, .PostID, LogProvider) : End With
TempMediaList(i) = GetVideoData(.URL, Responser, Settings.DownloadUHD.Value, .PostID, LogProvider)
End With
Next Next
TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString) TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End If End If
@@ -149,7 +157,7 @@ Public Class UserData : Implements IPluginContentProvider
Dim t$ = RegexReplace(r, VideoTitleRegex) Dim t$ = RegexReplace(r, VideoTitleRegex)
r = resp.GetResponse(m,, EDP.ThrowException) r = resp.GetResponse(m,, EDP.ThrowException)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim ls As List(Of VSize) = FNF.RegexFields(Of VSize)(r, {M3U8Reparse}, {1, 2}) Dim ls As List(Of VSize) = RegexFields(Of VSize)(r, {M3U8Reparse}, {1, 2})
If ls.ListExists And Not DownloadUHD Then ls.RemoveAll(Function(v) v.Size > 1080) If ls.ListExists And Not DownloadUHD Then ls.RemoveAll(Function(v) v.Size > 1080)
If ls.ListExists Then If ls.ListExists Then
ls.Sort() ls.Sort()
@@ -203,7 +211,8 @@ Public Class UserData : Implements IPluginContentProvider
m.File = f m.File = f
m.DownloadState = UStates.Downloaded m.DownloadState = UStates.Downloaded
Catch ex As Exception Catch ex As Exception
m.DownloadState = UStates.Skipped m.DownloadState = UStates.Missing
m.Attempts += 1
End Try End Try
TempMediaList(i) = m TempMediaList(i) = m
RaiseEvent ProgressChanged(1) RaiseEvent ProgressChanged(1)

View File

@@ -1,3 +1,3 @@
[*.vb] [*.vb]
# Modifier preferences # Modifier preferences
file_header_template = Copyright (C) 2022 Andy\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/> file_header_template = Copyright (C) 2023 Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -32,6 +32,10 @@ Namespace Plugin.Attributes
Public Property AllowNull As Boolean = True Public Property AllowNull As Boolean = True
''' <summary>Offset the control from the left border of the form.<br/>Default: 100</summary> ''' <summary>Offset the control from the left border of the form.<br/>Default: 100</summary>
Public Property LeftOffset As Integer = 100 Public Property LeftOffset As Integer = 100
''' <summary>This control is an information label.<br/>Default: <see langword="False"/></summary>
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
''' <summary>This is an authorization property</summary> ''' <summary>This is an authorization property</summary>
Public Property IsAuth As Boolean = False Public Property IsAuth As Boolean = False
''' <summary>Initialize a new property option attribute</summary> ''' <summary>Initialize a new property option attribute</summary>
@@ -49,6 +53,9 @@ Namespace Plugin.Attributes
ElementName = XMLElementName ElementName = XMLElementName
End Sub End Sub
End Class End Class
''' <summary>Attribute to disable some properties for host use</summary>
<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class DoNotUse : Inherits Attribute
End Class
''' <summary>Special property updater</summary> ''' <summary>Special property updater</summary>
<AttributeUsage(AttributeTargets.Method, AllowMultiple:=True, Inherited:=False)> Public NotInheritable Class PropertyUpdater : Inherits Attribute <AttributeUsage(AttributeTargets.Method, AllowMultiple:=True, Inherited:=False)> Public NotInheritable Class PropertyUpdater : Inherits Attribute
Public ReadOnly Name As String Public ReadOnly Name As String

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -26,7 +26,8 @@ Namespace Plugin
Property SeparateVideoFolder As Boolean Property SeparateVideoFolder As Boolean
Property DataPath As String Property DataPath As String
Property PostsNumberLimit As Integer? Property PostsNumberLimit As Integer?
Property PostsDateLimit As Date? Property DownloadDateFrom As Date?
Property DownloadDateTo As Date?
Function ExchangeOptionsGet() As Object Function ExchangeOptionsGet() As Object
Sub ExchangeOptionsSet(ByVal Obj As Object) Sub ExchangeOptionsSet(ByVal Obj As Object)
Sub XmlFieldsSet(ByVal Fields As List(Of KeyValuePair(Of String, String))) Sub XmlFieldsSet(ByVal Fields As List(Of KeyValuePair(Of String, String)))

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -21,8 +21,9 @@ Namespace Plugin
Function GetUserUrl(ByVal UserName As String, ByVal Channel As Boolean) As String Function GetUserUrl(ByVal UserName As String, ByVal Channel As Boolean) As String
Function IsMyUser(ByVal UserURL As String) As ExchangeOptions Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable(Of PluginUserMedia) Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
Function GetInstance(ByVal What As Download) As IPluginContentProvider Function GetInstance(ByVal What As Download) As IPluginContentProvider
Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
#Region "XML Support" #Region "XML Support"
Sub Load(ByVal XMLValues As IEnumerable(Of KeyValuePair(Of String, String))) Sub Load(ByVal XMLValues As IEnumerable(Of KeyValuePair(Of String, String)))
#End Region #End Region
@@ -31,6 +32,8 @@ Namespace Plugin
Sub EndInit() Sub EndInit()
Sub BeginUpdate() Sub BeginUpdate()
Sub EndUpdate() Sub EndUpdate()
Sub BeginEdit()
Sub EndEdit()
#End Region #End Region
#Region "Site availability" #Region "Site availability"
Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean

View File

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

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -13,13 +13,13 @@ Namespace Plugin
Public HostKey As String Public HostKey As String
Public IsChannel As Boolean Public IsChannel As Boolean
Public Exists As Boolean Public Exists As Boolean
Public Sub New(ByVal Site As String, ByVal _Name As String) Public Sub New(ByVal Site As String, ByVal Name As String)
UserName = _Name UserName = Name
SiteName = Site SiteName = Site
End Sub End Sub
Public Sub New(ByVal Site As String, ByVal _Name As String, ByVal _IsChannel As Boolean) Public Sub New(ByVal Site As String, ByVal Name As String, ByVal IsChannel As Boolean)
Me.New(Site, _Name) Me.New(Site, Name)
IsChannel = _IsChannel Me.IsChannel = IsChannel
End Sub End Sub
End Structure End Structure
End Namespace End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -17,7 +17,7 @@ Namespace Plugin
GIF = 50 GIF = 50
m3u8 = 100 m3u8 = 100
End Enum End Enum
Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : End Enum Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : Missing = 4 : End Enum
Public ContentType As Integer Public ContentType As Integer
Public URL As String Public URL As String
Public MD5 As String Public MD5 As String
@@ -26,5 +26,6 @@ Namespace Plugin
Public PostID As String Public PostID As String
Public PostDate As Date? Public PostDate As Date?
Public SpecialFolder As String Public SpecialFolder As String
Public Attempts As Integer
End Structure End Structure
End Namespace End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -10,9 +10,9 @@ Namespace Plugin
Public Structure PropertyData Public Structure PropertyData
Public ReadOnly Name As String Public ReadOnly Name As String
Public ReadOnly Value As Object Public ReadOnly Value As Object
Public Sub New(ByVal _Name As String, ByVal _Value As Object) Public Sub New(ByVal Name As String, ByVal Value As Object)
Name = _Name Me.Name = Name
Value = _Value Me.Value = Value
End Sub End Sub
End Structure End Structure
End Namespace End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or

View File

@@ -17,10 +17,6 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution
EndProject EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.PluginProvider", "SCrawler.PluginProvider\SCrawler.PluginProvider.vbproj", "{D4650F6B-5A54-44B6-999B-6C675B7116B1}" Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.PluginProvider", "SCrawler.PluginProvider\SCrawler.PluginProvider.vbproj", "{D4650F6B-5A54-44B6-999B-6C675B7116B1}"
EndProject EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.Plugin.LPSG", "SCrawler.Plugin.LPSG\SCrawler.Plugin.LPSG.vbproj", "{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}"
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.Plugin.XVIDEOS", "SCrawler.Plugin.XVIDEOS\SCrawler.Plugin.XVIDEOS.vbproj", "{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}"
EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "PersonalUtilities.Notifications", "..\..\MyUtilities\PersonalUtilities.Notifications\PersonalUtilities.Notifications.vbproj", "{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}" Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "PersonalUtilities.Notifications", "..\..\MyUtilities\PersonalUtilities.Notifications\PersonalUtilities.Notifications.vbproj", "{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}"
EndProject EndProject
Global Global
@@ -69,30 +65,6 @@ Global
{D4650F6B-5A54-44B6-999B-6C675B7116B1}.Release|x64.Build.0 = Release|x64 {D4650F6B-5A54-44B6-999B-6C675B7116B1}.Release|x64.Build.0 = Release|x64
{D4650F6B-5A54-44B6-999B-6C675B7116B1}.Release|x86.ActiveCfg = Release|x86 {D4650F6B-5A54-44B6-999B-6C675B7116B1}.Release|x86.ActiveCfg = Release|x86
{D4650F6B-5A54-44B6-999B-6C675B7116B1}.Release|x86.Build.0 = Release|x86 {D4650F6B-5A54-44B6-999B-6C675B7116B1}.Release|x86.Build.0 = Release|x86
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Debug|Any CPU.Build.0 = Debug|Any CPU
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Debug|x64.ActiveCfg = Debug|x64
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Debug|x64.Build.0 = Debug|x64
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Debug|x86.ActiveCfg = Debug|x86
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Debug|x86.Build.0 = Debug|x86
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Release|Any CPU.ActiveCfg = Release|Any CPU
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Release|Any CPU.Build.0 = Release|Any CPU
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Release|x64.ActiveCfg = Release|x64
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Release|x64.Build.0 = Release|x64
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Release|x86.ActiveCfg = Release|x86
{22A130B2-DDF4-4FB5-BA38-E5DB4CF1B8A2}.Release|x86.Build.0 = Release|x86
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Debug|Any CPU.Build.0 = Debug|Any CPU
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Debug|x64.ActiveCfg = Debug|x64
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Debug|x64.Build.0 = Debug|x64
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Debug|x86.ActiveCfg = Debug|x86
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Debug|x86.Build.0 = Debug|x86
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Release|Any CPU.ActiveCfg = Release|Any CPU
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Release|Any CPU.Build.0 = Release|Any CPU
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Release|x64.ActiveCfg = Release|x64
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Release|x64.Build.0 = Release|x64
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Release|x86.ActiveCfg = Release|x86
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Release|x86.Build.0 = Release|x86
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Debug|Any CPU.Build.0 = Debug|Any CPU {FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Debug|Any CPU.Build.0 = Debug|Any CPU
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Debug|x64.ActiveCfg = Debug|x64 {FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Debug|x64.ActiveCfg = Debug|x64

View File

@@ -123,4 +123,4 @@ insert_final_newline=false
[*.vb] [*.vb]
# Modifier preferences # Modifier preferences
visual_basic_preferred_modifier_order = Partial,Default,Private,Protected,Public,Friend,NotOverridable,Overridable,MustOverride,Overloads,Overrides,MustInherit,NotInheritable,Static,Shared,Shadows,ReadOnly,WriteOnly,Dim,Const,WithEvents,Widening,Narrowing,Custom,Async:suggestion visual_basic_preferred_modifier_order = Partial,Default,Private,Protected,Public,Friend,NotOverridable,Overridable,MustOverride,Overloads,Overrides,MustInherit,NotInheritable,Static,Shared,Shadows,ReadOnly,WriteOnly,Dim,Const,WithEvents,Widening,Narrowing,Custom,Async:suggestion
file_header_template = Copyright (C) 2022 Andy\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/> file_header_template = Copyright (C) 2023 Andy https://github.com/AAndyProgram\nThis program is free software: you can redistribute it and/or modify\nit under the terms of the GNU General Public License as published by\nthe Free Software Foundation, either version 3 of the License, or\n(at your option) any later version.\n\nThis program is distributed in the hope that it will be useful,\nbut WITHOUT ANY WARRANTY; without even the implied warranty of\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\nGNU General Public License for more details.\n\nYou should have received a copy of the GNU General Public License\nalong with this program. If not, see <https://www.gnu.org/licenses/>

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -16,7 +16,7 @@ Namespace API.Base
Friend Structure Data : Implements IRegExCreator, IComparable(Of Data) Friend Structure Data : Implements IRegExCreator, IComparable(Of Data)
Friend [Date] As Date Friend [Date] As Date
Friend Value As Integer Friend Value As Integer
Friend Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists Then If ParamsArray.ListExists Then
Try : [Date] = Date.Parse(ParamsArray(0)) : Catch : End Try Try : [Date] = Date.Parse(ParamsArray(0)) : Catch : End Try
If ParamsArray.Length > 1 Then Value = AConvert(Of Integer)(ParamsArray(1), 0) If ParamsArray.Length > 1 Then Value = AConvert(Of Integer)(ParamsArray(1), 0)
@@ -26,7 +26,7 @@ Namespace API.Base
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Return $"{AConvert(Of String)([Date], ADateTime.Formats.BaseDateTime, String.Empty)} [{Value}]" Return $"{AConvert(Of String)([Date], ADateTime.Formats.BaseDateTime, String.Empty)} [{Value}]"
End Function End Function
Friend Function CompareTo(ByVal Other As Data) As Integer Implements IComparable(Of Data).CompareTo Private Function CompareTo(ByVal Other As Data) As Integer Implements IComparable(Of Data).CompareTo
Return [Date].CompareTo(Other.Date) * -1 Return [Date].CompareTo(Other.Date) * -1
End Function End Function
End Structure End Structure
@@ -37,7 +37,7 @@ Namespace API.Base
Using w As New WebClient Using w As New WebClient
Dim r$ = w.DownloadString($"https://downdetector.co.uk/status/{Site}/") Dim r$ = w.DownloadString($"https://downdetector.co.uk/status/{Site}/")
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
l = FNF.RegexFields(Of Data)(r, {Params}, {1, 2}) l = RegexFields(Of Data)(r, {Params}, {1, 2})
If l.ListExists(2) Then If l.ListExists(2) Then
l.Sort() l.Sort()
l2 = New List(Of Data) l2 = New List(Of Data)

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -6,9 +6,9 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Hosts
Imports System.Threading Imports System.Threading
Imports PersonalUtilities.Forms.Toolbars Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.Plugin.Hosts
Imports PDownload = SCrawler.Plugin.ISiteSettings.Download Imports PDownload = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Base Namespace API.Base
Friend NotInheritable Class ProfileSaved Friend NotInheritable Class ProfileSaved
@@ -25,13 +25,10 @@ Namespace API.Base
HOST.DownloadStarted(PDownload.SavedPosts) HOST.DownloadStarted(PDownload.SavedPosts)
Dim u As New UserInfo With {.Plugin = HOST.Key, .Site = HOST.Name, .SpecialPath = HOST.SavedPostsPath} Dim u As New UserInfo With {.Plugin = HOST.Key, .Site = HOST.Name, .SpecialPath = HOST.SavedPostsPath}
Using user As IUserData = HOST.GetInstance(PDownload.SavedPosts, Nothing, False, False) Using user As IUserData = HOST.GetInstance(PDownload.SavedPosts, Nothing, False, False)
If Not user Is Nothing AndAlso (Not user.Name.IsEmptyString Or Not HOST.IsMyClass) Then If Not user Is Nothing AndAlso Not user.Name.IsEmptyString Then
u.Name = user.Name u.Name = user.Name
With DirectCast(user, UserDataBase).User
u.IsChannel = .IsChannel
u.UpdateUserFile()
End With
With DirectCast(user, UserDataBase) With DirectCast(user, UserDataBase)
With .User : u.IsChannel = .IsChannel : u.UpdateUserFile() : End With
.User = u .User = u
.LoadUserInformation() .LoadUserInformation()
.IsSavedPosts = True .IsSavedPosts = True
@@ -40,7 +37,7 @@ Namespace API.Base
End With End With
HOST.BeforeStartDownload(user, PDownload.SavedPosts) HOST.BeforeStartDownload(user, PDownload.SavedPosts)
user.DownloadData(Token) user.DownloadData(Token)
Progress.InformationTemporary = $"Images: {user.DownloadedPictures(False)}; Videos: {user.DownloadedVideos(False)}" Progress.InformationTemporary = $"{HOST.Name} Images: {user.DownloadedPictures(False)}; Videos: {user.DownloadedVideos(False)}"
HOST.AfterDownload(user, PDownload.SavedPosts) HOST.AfterDownload(user, PDownload.SavedPosts)
End If End If
End Using End Using
@@ -48,7 +45,7 @@ Namespace API.Base
Progress.InformationTemporary = $"Host [{HOST.Name}] is unavailable" Progress.InformationTemporary = $"Host [{HOST.Name}] is unavailable"
End If End If
Else Else
Progress.InformationTemporary = $"Host [{HOST.Name}] is nor ready" Progress.InformationTemporary = $"Host [{HOST.Name}] is not ready"
End If End If
Catch ex As Exception Catch ex As Exception
Progress.InformationTemporary = $"{HOST.Name} downloading error" Progress.InformationTemporary = $"{HOST.Name} downloading error"

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -6,17 +6,23 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.WEB
Imports SCrawler.Plugin
Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Base Namespace API.Base
Friend MustInherit Class SiteSettingsBase : Implements ISiteSettings Friend MustInherit Class SiteSettingsBase : Implements ISiteSettings, IResponserContainer
Friend ReadOnly Property Site As String Implements ISiteSettings.Site Friend ReadOnly Property Site As String Implements ISiteSettings.Site
Friend Overridable ReadOnly Property Icon As Icon = Nothing Implements ISiteSettings.Icon Friend Overridable ReadOnly Property Icon As Icon Implements ISiteSettings.Icon
Friend Overridable ReadOnly Property Image As Image = Nothing Implements ISiteSettings.Image Friend Overridable ReadOnly Property Image As Image Implements ISiteSettings.Image
Private Property Logger As ILogProvider = LogConnector Implements ISiteSettings.Logger Private Property Logger As ILogProvider = LogConnector Implements ISiteSettings.Logger
Friend Overridable ReadOnly Property Responser As Response Friend Overridable ReadOnly Property Responser As Response
Private Property IResponserContainer_Responser As Response Implements IResponserContainer.Responser
Get
Return Responser
End Get
Set : End Set
End Property
Friend MustOverride Function GetInstance(ByVal What As Download) As IPluginContentProvider Implements ISiteSettings.GetInstance Friend MustOverride Function GetInstance(ByVal What As Download) As IPluginContentProvider Implements ISiteSettings.GetInstance
Friend Sub New(ByVal SiteName As String) Friend Sub New(ByVal SiteName As String)
Site = SiteName Site = SiteName
@@ -25,7 +31,15 @@ Namespace API.Base
Site = SiteName Site = SiteName
Responser = New Response($"{SettingsFolderName}\Responser_{Site}.xml") Responser = New Response($"{SettingsFolderName}\Responser_{Site}.xml")
With Responser With Responser
If .File.Exists Then .LoadSettings() Else .CookiesDomain = CookiesDomain : .SaveSettings() If .File.Exists Then
If EncryptCookies.CookiesEncrypted Then .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.LoadSettings()
Else
.CookiesDomain = CookiesDomain
.Cookies = New CookieKeeper(.CookiesDomain) With {.EncryptKey = SettingsCLS.CookieEncryptKey}
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.SaveSettings()
End If
End With End With
End Sub End Sub
#Region "XML" #Region "XML"
@@ -36,11 +50,16 @@ Namespace API.Base
Friend Overridable Sub BeginInit() Implements ISiteSettings.BeginInit Friend Overridable Sub BeginInit() Implements ISiteSettings.BeginInit
End Sub End Sub
Friend Overridable Sub EndInit() Implements ISiteSettings.EndInit Friend Overridable Sub EndInit() Implements ISiteSettings.EndInit
EncryptCookies.ValidateCookiesEncrypt(Responser)
End Sub End Sub
Friend Overridable Sub BeginUpdate() Implements ISiteSettings.BeginUpdate Friend Overridable Sub BeginUpdate() Implements ISiteSettings.BeginUpdate
End Sub End Sub
Friend Overridable Sub EndUpdate() Implements ISiteSettings.EndUpdate Friend Overridable Sub EndUpdate() Implements ISiteSettings.EndUpdate
End Sub End Sub
Friend Overridable Sub BeginEdit() Implements ISiteSettings.BeginEdit
End Sub
Friend Overridable Sub EndEdit() Implements ISiteSettings.EndEdit
End Sub
#End Region #End Region
#Region "Before and After Download" #Region "Before and After Download"
Friend Overridable Sub DownloadStarted(ByVal What As Download) Implements ISiteSettings.DownloadStarted Friend Overridable Sub DownloadStarted(ByVal What As Download) Implements ISiteSettings.DownloadStarted
@@ -63,6 +82,9 @@ Namespace API.Base
End If End If
Return String.Empty Return String.Empty
End Function End Function
Friend Overridable Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String Implements ISiteSettings.GetUserPostUrl
Return String.Empty
End Function
Protected UserRegex As RParams = Nothing Protected UserRegex As RParams = Nothing
Friend Overridable Function IsMyUser(ByVal UserURL As String) As ExchangeOptions Implements ISiteSettings.IsMyUser Friend Overridable Function IsMyUser(ByVal UserURL As String) As ExchangeOptions Implements ISiteSettings.IsMyUser
Try Try
@@ -72,7 +94,7 @@ Namespace API.Base
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Base.SiteSettingsBase.IsMyUser]") Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"[API.Base.SiteSettingsBase.IsMyUser({UserURL})]")
End Try End Try
End Function End Function
Protected ImageVideoContains As String = String.Empty Protected ImageVideoContains As String = String.Empty
@@ -83,17 +105,25 @@ Namespace API.Base
Return Nothing Return Nothing
End If End If
End Function End Function
Friend Overridable Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable(Of PluginUserMedia) Implements ISiteSettings.GetSpecialData Friend Overridable Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable Implements ISiteSettings.GetSpecialData
Return Nothing Return Nothing
End Function End Function
Friend Overridable Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia) Friend Shared Function GetSpecialDataFile(ByVal Path As String, ByVal AskForPath As Boolean, ByRef SpecFolderObj As String) As SFile
Return Nothing Dim f As SFile = Path.CSFileP
If f.Name.IsEmptyString Then f.Name = "OutputFile"
#Disable Warning BC40000
If Path.CSFileP.IsEmptyString Or AskForPath Then f = SFile.SaveAs(f, "File destination",,,, EDP.ReturnValue) : SpecFolderObj = f.Path
#Enable Warning
Return f
End Function End Function
#End Region #End Region
#Region "Ready, Available" #Region "Ready, Available"
Friend Overridable Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean Implements ISiteSettings.Available Friend Overridable Function BaseAuthExists() As Boolean
Return True Return True
End Function End Function
Friend Overridable Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean Implements ISiteSettings.Available
Return BaseAuthExists()
End Function
Friend Overridable Function ReadyToDownload(ByVal What As Download) As Boolean Implements ISiteSettings.ReadyToDownload Friend Overridable Function ReadyToDownload(ByVal What As Download) As Boolean Implements ISiteSettings.ReadyToDownload
Return True Return True
End Function End Function

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -6,9 +6,24 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Base Namespace API.Base
Friend Module Structures Friend Module Structures
Friend Structure UserMedia : Implements IEquatable(Of UserMedia) Friend Structure UserMedia : Implements IEquatable(Of UserMedia), IEContainerProvider
#Region "XML Names"
Friend Const Name_MediaNode As String = "MediaData"
Private Const Name_MediaType As String = "Type"
Private Const Name_MediaState As String = "State"
Private Const Name_MediaAttempts As String = "Attempts"
Private Const Name_MediaURL As String = "URL"
Private Const Name_MediaHash As String = "Hash"
Private Const Name_MediaFile As String = "File"
Private Const Name_MediaPostID As String = "ID"
Private Const Name_MediaPostDate As String = "Date"
Private Const Name_SpecialFolder As String = "SpecialFolder"
#End Region
Friend Enum Types As Integer Friend Enum Types As Integer
Undefined = 0 Undefined = 0
[Picture] = 1 [Picture] = 1
@@ -18,7 +33,7 @@ Namespace API.Base
GIF = 50 GIF = 50
m3u8 = 100 m3u8 = 100
End Enum End Enum
Friend Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : End Enum Friend Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : Missing = 4 : End Enum
Friend [Type] As Types Friend [Type] As Types
Friend URL_BASE As String Friend URL_BASE As String
Friend URL As String Friend URL As String
@@ -27,31 +42,60 @@ Namespace API.Base
Friend Post As UserPost Friend Post As UserPost
Friend PictureOption As String Friend PictureOption As String
Friend State As States Friend State As States
Friend Attempts As Integer
''' <summary> ''' <summary>
''' SomeFolder<br/> ''' SomeFolder<br/>
''' SomeFolder\SomeFolder2 ''' SomeFolder\SomeFolder2
''' </summary> ''' </summary>
Friend SpecialFolder As String Friend SpecialFolder As String
Friend Sub New(ByVal _URL As String) Friend Sub New(ByVal URL As String)
URL = _URL Me.URL = URL
URL_BASE = _URL URL_BASE = URL
File = URL File = URL
Type = Types.Undefined Type = Types.Undefined
End Sub End Sub
Friend Sub New(ByVal _URL As String, ByVal _Type As Types) Friend Sub New(ByVal URL As String, ByVal Type As Types)
Me.New(_URL) Me.New(URL)
[Type] = _Type Me.Type = Type
End Sub End Sub
Friend Sub New(ByVal m As Plugin.PluginUserMedia) Friend Sub New(ByVal m As Plugin.PluginUserMedia)
If Not IsNothing(m) Then
[Type] = m.ContentType [Type] = m.ContentType
URL = m.URL URL = m.URL
URL_BASE = URL
MD5 = m.MD5 MD5 = m.MD5
File = m.File File = m.File
Post = New UserPost With {.ID = m.PostID, .[Date] = m.PostDate} Post = New UserPost With {.ID = m.PostID, .[Date] = m.PostDate}
State = m.DownloadState State = m.DownloadState
SpecialFolder = m.SpecialFolder SpecialFolder = m.SpecialFolder
Attempts = m.Attempts
End Sub
Friend Sub New(ByVal e As EContainer, ByVal UserInstance As IUserData)
Type = e.Attribute(Name_MediaType).Value.FromXML(Of Integer)(CInt(Types.Undefined))
State = e.Attribute(Name_MediaState).Value.FromXML(Of Integer)(CInt(States.Downloaded))
Attempts = e.Attribute(Name_MediaAttempts).Value.FromXML(Of Integer)(0)
URL = e.Attribute(Name_MediaURL).Value
URL_BASE = e.Value
MD5 = e.Attribute(Name_MediaHash).Value
File = e.Attribute(Name_MediaFile).Value
Dim vp As Boolean? = Nothing
Dim upath$ = String.Empty
If Not UserInstance Is Nothing Then
With DirectCast(UserInstance, UserDataBase)
vp = .SeparateVideoFolder
upath = .MyFile.CutPath.PathWithSeparator
End With
End If End If
SpecialFolder = e.Attribute(Name_SpecialFolder).Value
If Not SpecialFolder.IsEmptyString Then upath &= $"{SpecialFolder}\"
If vp.HasValue AndAlso vp.Value Then upath &= $"Video\"
If Not upath.IsEmptyString Then File = $"{upath.CSFilePS}{File.File}"
Post = New UserPost With {
.ID = e.Attribute(Name_MediaPostID).Value,
.[Date] = AConvert(Of Date)(e.Attribute(Name_MediaPostDate).Value, ParsersDataDateProvider, Nothing)
}
End Sub End Sub
Public Shared Widening Operator CType(ByVal _URL As String) As UserMedia Public Shared Widening Operator CType(ByVal _URL As String) As UserMedia
Return New UserMedia(_URL) Return New UserMedia(_URL)
@@ -59,6 +103,17 @@ Namespace API.Base
Public Shared Widening Operator CType(ByVal m As UserMedia) As String Public Shared Widening Operator CType(ByVal m As UserMedia) As String
Return m.URL Return m.URL
End Operator End Operator
Public Overrides Function GetHashCode() As Integer
If Not File.IsEmptyString Then
Return File.GetHashCode
ElseIf Not URL_BASE.IsEmptyString Then
Return URL_BASE.GetHashCode
ElseIf Not URL.IsEmptyString Then
Return URL.GetHashCode
Else
Return 0
End If
End Function
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Return URL Return URL
End Function End Function
@@ -71,7 +126,8 @@ Namespace API.Base
.URL = URL, .URL = URL,
.SpecialFolder = SpecialFolder, .SpecialFolder = SpecialFolder,
.PostID = Post.ID, .PostID = Post.ID,
.PostDate = Post.Date .PostDate = Post.Date,
.Attempts = Attempts
} }
End Function End Function
Friend Overloads Function Equals(ByVal Other As UserMedia) As Boolean Implements IEquatable(Of UserMedia).Equals Friend Overloads Function Equals(ByVal Other As UserMedia) As Boolean Implements IEquatable(Of UserMedia).Equals
@@ -80,6 +136,19 @@ Namespace API.Base
Public Overrides Function Equals(ByVal Obj As Object) As Boolean Public Overrides Function Equals(ByVal Obj As Object) As Boolean
Return Equals(CType(Obj, UserMedia)) Return Equals(CType(Obj, UserMedia))
End Function End Function
Friend Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return New EContainer(Name_MediaNode, URL_BASE, {New EAttribute(Name_MediaType, CInt(Type)),
New EAttribute(Name_MediaState, CInt(State)),
New EAttribute(Name_MediaAttempts, Attempts),
New EAttribute(Name_MediaURL, URL),
New EAttribute(Name_MediaHash, MD5),
New EAttribute(Name_MediaFile, File.File),
New EAttribute(Name_SpecialFolder, SpecialFolder),
New EAttribute(Name_MediaPostID, Post.ID),
New EAttribute(Name_MediaPostDate, AConvert(Of String)(Post.Date, ParsersDataDateProvider, String.Empty))
}
)
End Function
End Structure End Structure
Friend Structure UserPost : Implements IEquatable(Of UserPost), IComparable(Of UserPost) Friend Structure UserPost : Implements IEquatable(Of UserPost), IComparable(Of UserPost)
''' <summary>Post ID</summary> ''' <summary>Post ID</summary>
@@ -106,14 +175,14 @@ Namespace API.Base
Friend Function CompareTo(ByVal Other As UserPost) As Integer Implements IComparable(Of UserPost).CompareTo Friend Function CompareTo(ByVal Other As UserPost) As Integer Implements IComparable(Of UserPost).CompareTo
Return GetCompareValue(Me).CompareTo(GetCompareValue(Other)) Return GetCompareValue(Me).CompareTo(GetCompareValue(Other))
End Function End Function
#End Region
Private Function GetCompareValue(ByVal Post As UserPost) As Long Private Function GetCompareValue(ByVal Post As UserPost) As Long
Dim v& = 0 Dim v& = 0
If Post.Date.HasValue Then v = Post.Date.Value.Ticks * -1 If Post.Date.HasValue Then v = Post.Date.Value.Ticks * -1
Return v Return v
End Function End Function
#End Region
End Structure End Structure
Friend Structure Sizes : Implements IComparable(Of Sizes) Friend Structure Sizes : Implements IRegExCreator, IComparable(Of Sizes)
Friend Value As Integer Friend Value As Integer
Friend Data As String Friend Data As String
Friend ReadOnly HasError As Boolean Friend ReadOnly HasError As Boolean
@@ -125,6 +194,16 @@ Namespace API.Base
HasError = True HasError = True
End Try End Try
End Sub End Sub
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists(2) Then
Return New Sizes With {
.Value = AConvert(Of Integer)(ParamsArray(0), 0),
.Data = ParamsArray(1)
}
Else
Return New Sizes
End If
End Function
Friend Function CompareTo(ByVal Other As Sizes) As Integer Implements IComparable(Of Sizes).CompareTo Friend Function CompareTo(ByVal Other As Sizes) As Integer Implements IComparable(Of Sizes).CompareTo
Return Value.CompareTo(Other.Value) * -1 Return Value.CompareTo(Other.Value) * -1
End Function End Function

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -9,8 +9,8 @@
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Forms.Toolbars Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.WEB
Imports System.IO Imports System.IO
Imports System.Net Imports System.Net
Imports System.Threading Imports System.Threading
@@ -21,39 +21,42 @@ Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Base Namespace API.Base
Friend MustInherit Class UserDataBase : Implements IUserData, IPluginContentProvider, IThrower Friend MustInherit Class UserDataBase : Implements IUserData, IPluginContentProvider, IThrower
Friend Const UserFileAppender As String = "User" Friend Const UserFileAppender As String = "User"
Private ReadOnly _OnUserUpdatedHandlers As List(Of IUserData.OnUserUpdatedEventHandler) #Region "Events"
Friend Custom Event OnUserUpdated As IUserData.OnUserUpdatedEventHandler Implements IUserData.OnUserUpdated Private ReadOnly UserUpdatedEventHandlers As List(Of IUserData.UserUpdatedEventHandler)
AddHandler(ByVal e As IUserData.OnUserUpdatedEventHandler) Friend Custom Event UserUpdated As IUserData.UserUpdatedEventHandler Implements IUserData.UserUpdated
If Not _OnUserUpdatedHandlers.Contains(e) Then _OnUserUpdatedHandlers.Add(e) AddHandler(ByVal e As IUserData.UserUpdatedEventHandler)
If Not UserUpdatedEventHandlers.Contains(e) Then UserUpdatedEventHandlers.Add(e)
End AddHandler End AddHandler
RemoveHandler(ByVal e As IUserData.OnUserUpdatedEventHandler) RemoveHandler(ByVal e As IUserData.UserUpdatedEventHandler)
If _OnUserUpdatedHandlers.Contains(e) Then _OnUserUpdatedHandlers.Remove(e) If UserUpdatedEventHandlers.Contains(e) Then UserUpdatedEventHandlers.Remove(e)
End RemoveHandler End RemoveHandler
RaiseEvent(ByVal User As IUserData) RaiseEvent(ByVal User As IUserData)
If _OnUserUpdatedHandlers.Count > 0 Then Try
For Each e As IUserData.OnUserUpdatedEventHandler In _OnUserUpdatedHandlers If UserUpdatedEventHandlers.Count > 0 Then
Try : e.Invoke(User) : Catch : End Try For i% = 0 To UserUpdatedEventHandlers.Count - 1
Try : UserUpdatedEventHandlers(i).Invoke(User) : Catch : End Try
Next Next
End If End If
Catch
End Try
End RaiseEvent End RaiseEvent
End Event End Event
Protected Sub RaiseEvent_OnUserUpdated() Protected Sub OnUserUpdated()
RaiseEvent OnUserUpdated(Me) RaiseEvent UserUpdated(Me)
End Sub End Sub
Friend Sub RemoveUpdateHandlers() Friend Sub RemoveUpdateHandlers()
_OnUserUpdatedHandlers.Clear() UserUpdatedEventHandlers.Clear()
End Sub End Sub
#End Region
#Region "Collection buttons" #Region "Collection buttons"
Private _CollectionButtonsExists As Boolean = False Private _CollectionButtonsExists As Boolean = False
Private _CollectionButtonsColorsSet As Boolean = False Private _CollectionButtonsColorsSet As Boolean = False
Friend InternalCollectionIndex As Integer = -1 Friend WithEvents BTT_CONTEXT_DOWN As ToolStripKeyMenuItem
Friend WithEvents BTT_CONTEXT_DOWN As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_EDIT As ToolStripMenuItem Friend WithEvents BTT_CONTEXT_EDIT As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_DELETE As ToolStripMenuItem Friend WithEvents BTT_CONTEXT_DELETE As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_OPEN_PATH As ToolStripMenuItem Friend WithEvents BTT_CONTEXT_OPEN_PATH As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_OPEN_SITE As ToolStripMenuItem Friend WithEvents BTT_CONTEXT_OPEN_SITE As ToolStripMenuItem
Friend Sub CreateButtons(ByVal CollectionIndex As Integer) Friend Sub CreateButtons()
InternalCollectionIndex = CollectionIndex
Dim tn$ = $"[{Site}] - {Name}" Dim tn$ = $"[{Site}] - {Name}"
Dim _tn$ = $"{Site}{Name}" Dim _tn$ = $"{Site}{Name}"
Dim tnn As Func(Of String, String) = Function(Input) $"{Input}{_tn}" Dim tnn As Func(Of String, String) = Function(Input) $"{Input}{_tn}"
@@ -65,11 +68,11 @@ Namespace API.Base
i = .Image i = .Image
End If End If
End With End With
BTT_CONTEXT_DOWN = New ToolStripMenuItem(tn, i) With {.Name = tnn("DOWN"), .Tag = CollectionIndex} BTT_CONTEXT_DOWN = New ToolStripKeyMenuItem(tn, i) With {.Name = tnn("DOWN"), .Tag = Me}
BTT_CONTEXT_EDIT = New ToolStripMenuItem(tn, i) With {.Name = tnn("EDIT"), .Tag = CollectionIndex} 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 = CollectionIndex} BTT_CONTEXT_DELETE = New ToolStripMenuItem(tn, i) With {.Name = tnn("DELETE"), .Tag = Me}
BTT_CONTEXT_OPEN_PATH = New ToolStripMenuItem(tn, i) With {.Name = tnn("PATH"), .Tag = CollectionIndex} BTT_CONTEXT_OPEN_PATH = New ToolStripMenuItem(tn, i) With {.Name = tnn("PATH"), .Tag = Me}
BTT_CONTEXT_OPEN_SITE = New ToolStripMenuItem(tn, i) With {.Name = tnn("SITE"), .Tag = CollectionIndex} BTT_CONTEXT_OPEN_SITE = New ToolStripMenuItem(tn, i) With {.Name = tnn("SITE"), .Tag = Me}
UpdateButtonsColor() UpdateButtonsColor()
_CollectionButtonsExists = True _CollectionButtonsExists = True
If _UserInformationLoaded Then _CollectionButtonsColorsSet = True If _UserInformationLoaded Then _CollectionButtonsColorsSet = True
@@ -78,11 +81,11 @@ Namespace API.Base
Dim cb As Color = SystemColors.Control Dim cb As Color = SystemColors.Control
Dim cf As Color = SystemColors.ControlText Dim cf As Color = SystemColors.ControlText
If Not UserExists Then If Not UserExists Then
cb = ColorBttDeleteBack cb = MyColor.DeleteBack
cf = ColorBttDeleteFore cf = MyColor.DeleteFore
ElseIf UserSuspended Then ElseIf UserSuspended Then
cb = ColorBttEditBack cb = MyColor.EditBack
cf = ColorBttEditFore cf = MyColor.EditFore
End If End If
For Each b As ToolStripMenuItem In {BTT_CONTEXT_DOWN, BTT_CONTEXT_EDIT, BTT_CONTEXT_DELETE, BTT_CONTEXT_OPEN_PATH, BTT_CONTEXT_OPEN_SITE} For Each b As ToolStripMenuItem In {BTT_CONTEXT_DOWN, BTT_CONTEXT_EDIT, BTT_CONTEXT_DELETE, BTT_CONTEXT_OPEN_PATH, BTT_CONTEXT_OPEN_SITE}
If Not b Is Nothing Then b.BackColor = cb : b.ForeColor = cf If Not b Is Nothing Then b.BackColor = cb : b.ForeColor = cf
@@ -120,22 +123,23 @@ Namespace API.Base
Private Const Name_ScriptData As String = "ScriptData" Private Const Name_ScriptData As String = "ScriptData"
Private Const Name_DataMerging As String = "DataMerging" Private Const Name_DataMerging As String = "DataMerging"
#Region "Downloaded data"
Private Const Name_MediaType As String = "Type"
Private Const Name_MediaURL As String = "URL"
Private Const Name_MediaHash As String = "Hash"
Private Const Name_MediaFile As String = "File"
Private Const Name_MediaPostID As String = "ID"
Private Const Name_MediaPostDate As String = "Date"
#End Region
#End Region #End Region
#Region "Declarations" #Region "Declarations"
#Region "Host, Site, Progress, Self"
Friend Property HOST As SettingsHost Implements IUserData.HOST
Friend ReadOnly Property Site As String Implements IContentProvider.Site Friend ReadOnly Property Site As String Implements IContentProvider.Site
Get Get
Return HOST.Name Return HOST.Name
End Get End Get
End Property End Property
Friend Property Progress As MyProgress Friend Property Progress As MyProgress
Friend ReadOnly Property Self As IUserData Implements IUserData.Self
Get
Return Me
End Get
End Property
#End Region
#Region "User name, ID, exist, suspend"
Friend User As UserInfo Friend User As UserInfo
Friend Property IsSavedPosts As Boolean Implements IPluginContentProvider.IsSavedPosts Friend Property IsSavedPosts As Boolean Implements IPluginContentProvider.IsSavedPosts
Friend Overridable Property UserExists As Boolean = True Implements IUserData.Exists, IPluginContentProvider.UserExists Friend Overridable Property UserExists As Boolean = True Implements IUserData.Exists, IPluginContentProvider.UserExists
@@ -152,7 +156,8 @@ Namespace API.Base
End Property End Property
Friend Overridable Property ID As String = String.Empty Implements IContentProvider.ID, IPluginContentProvider.ID Friend Overridable Property ID As String = String.Empty Implements IContentProvider.ID, IPluginContentProvider.ID
Friend Overridable Property FriendlyName As String = String.Empty Implements IContentProvider.FriendlyName Friend Overridable Property FriendlyName As String = String.Empty Implements IContentProvider.FriendlyName
#Region "UserDescription" #End Region
#Region "Description"
Friend Property UserDescription As String = String.Empty Implements IContentProvider.Description, IPluginContentProvider.UserDescription Friend Property UserDescription As String = String.Empty Implements IContentProvider.Description, IPluginContentProvider.UserDescription
Protected _DescriptionEveryTime As Boolean = False Protected _DescriptionEveryTime As Boolean = False
Protected _DescriptionChecked As Boolean = False Protected _DescriptionChecked As Boolean = False
@@ -174,7 +179,7 @@ Namespace API.Base
_DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime _DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime
End Sub End Sub
#End Region #End Region
Friend Property ParseUserMediaOnly As Boolean = False Implements IUserData.ParseUserMediaOnly, IPluginContentProvider.ParseUserMediaOnly #Region "Favorite, Temporary"
Protected _Favorite As Boolean = False Protected _Favorite As Boolean = False
Friend Overridable Property Favorite As Boolean Implements IContentProvider.Favorite Friend Overridable Property Favorite As Boolean Implements IContentProvider.Favorite
Get Get
@@ -195,17 +200,15 @@ Namespace API.Base
If _Temporary Then _Favorite = False If _Temporary Then _Favorite = False
End Set End Set
End Property End Property
#End Region
#Region "Channel"
Friend Overridable ReadOnly Property IsChannel As Boolean Implements IUserData.IsChannel Friend Overridable ReadOnly Property IsChannel As Boolean Implements IUserData.IsChannel
Get Get
Return User.IsChannel Return User.IsChannel
End Get End Get
End Property End Property
Friend Property CreatedByChannel As Boolean = False Friend Property CreatedByChannel As Boolean = False
Friend ReadOnly Property Self As IUserData Implements IUserData.Self #End Region
Get
Return Me
End Get
End Property
#Region "Images" #Region "Images"
Friend Overridable Function GetUserPicture() As Image Implements IUserData.GetPicture Friend Overridable Function GetUserPicture() As Image Implements IUserData.GetPicture
If Settings.ViewModeIsPicture Then If Settings.ViewModeIsPicture Then
@@ -214,21 +217,21 @@ Namespace API.Base
Return Nothing Return Nothing
End If End If
End Function End Function
Friend Function GetUserPictureAddress() As SFile Friend Function GetUserPictureToastAddress() As SFile
Return GetPicture(Of SFile)(False) Return GetPicture(Of SFile)(False, True)
End Function End Function
Friend Overridable Sub SetPicture(ByVal f As SFile) Implements IUserData.SetPicture Friend Overridable Sub SetPicture(ByVal f As SFile) Implements IUserData.SetPicture
Try Try
If Not f.IsEmptyString AndAlso f.Exists Then If f.Exists Then
Using p As New UserImage(f, User.File) : p.Save() : End Using Using p As New UserImage(f, User.File) : p.Save() : End Using
End If End If
Catch ex As Exception Catch
End Try End Try
End Sub End Sub
Protected Function GetNullPicture(ByVal MaxHeigh As XML.Base.XMLValue(Of Integer)) As Bitmap Protected Function GetNullPicture(ByVal MaxHeigh As XML.Base.XMLValue(Of Integer)) As Bitmap
Return New Bitmap(CInt(DivideWithZeroChecking(MaxHeigh.Value, 100) * 75), MaxHeigh.Value) Return New Bitmap(CInt(DivideWithZeroChecking(MaxHeigh.Value, 100) * 75), MaxHeigh.Value)
End Function End Function
Protected Function GetPicture(Of T)(Optional ByVal ReturnNullImageOnNothing As Boolean = True) As T Protected Function GetPicture(Of T)(Optional ByVal ReturnNullImageOnNothing As Boolean = True, Optional ByVal GetToast As Boolean = False) As T
Dim rsfile As Boolean = GetType(T) Is GetType(SFile) Dim rsfile As Boolean = GetType(T) Is GetType(SFile)
Dim f As SFile = Nothing Dim f As SFile = Nothing
Dim p As UserImage = Nothing Dim p As UserImage = Nothing
@@ -260,7 +263,7 @@ BlockPictureScan:
New ErrorsDescriber(EDP.ReturnValue) With { New ErrorsDescriber(EDP.ReturnValue) With {
.ReturnValue = New List(Of SFile), .ReturnValue = New List(Of SFile),
.ReturnValueExists = True}).FirstOrDefault .ReturnValueExists = True}).FirstOrDefault
If Not NewPicFile.IsEmptyString AndAlso NewPicFile.Exists Then If NewPicFile.Exists Then
p = New UserImage(NewPicFile, MyFile) p = New UserImage(NewPicFile, MyFile)
p.Save() p.Save()
GoTo BlockReturn GoTo BlockReturn
@@ -275,8 +278,14 @@ BlockReturn:
On Error GoTo BlockNullPicture On Error GoTo BlockNullPicture
If Not p Is Nothing Then If Not p Is Nothing Then
Dim i As Image = Nothing Dim i As Image = Nothing
Dim a As SFile = p.Address Dim a As SFile = Nothing
If Not rsfile Then If rsfile Then
If GetToast Then
a = p.Large.Address
Else
a = p.Address
End If
Else
Select Case Settings.ViewMode.Value Select Case Settings.ViewMode.Value
Case View.LargeIcon : i = p.Large.OriginalImage.Clone Case View.LargeIcon : i = p.Large.OriginalImage.Clone
Case View.SmallIcon : i = p.Small.OriginalImage.Clone Case View.SmallIcon : i = p.Small.OriginalImage.Clone
@@ -288,8 +297,8 @@ BlockReturn:
BlockNullPicture: BlockNullPicture:
If ReturnNullImageOnNothing Then If ReturnNullImageOnNothing Then
Select Case Settings.ViewMode.Value Select Case Settings.ViewMode.Value
Case View.LargeIcon : Return CObj(GetNullPicture(Settings.MaxLargeImageHeigh)) Case View.LargeIcon : Return CObj(GetNullPicture(Settings.MaxLargeImageHeight))
Case View.SmallIcon : Return CObj(GetNullPicture(Settings.MaxSmallImageHeigh)) Case View.SmallIcon : Return CObj(GetNullPicture(Settings.MaxSmallImageHeight))
End Select End Select
End If End If
Return Nothing Return Nothing
@@ -299,11 +308,11 @@ BlockNullPicture:
Friend Property SeparateVideoFolder As Boolean? Friend Property SeparateVideoFolder As Boolean?
Protected ReadOnly Property SeparateVideoFolderF As Boolean Protected ReadOnly Property SeparateVideoFolderF As Boolean
Get Get
Return (SeparateVideoFolder.HasValue AndAlso SeparateVideoFolder.Value) OrElse Settings.SeparateVideoFolder.Value Return If(SeparateVideoFolder, Settings.SeparateVideoFolder.Value)
End Get End Get
End Property End Property
#End Region #End Region
#Region "Collections support" #Region "Collections"
Protected _IsCollection As Boolean = False Protected _IsCollection As Boolean = False
Protected Friend ReadOnly Property IsCollection As Boolean Implements IUserData.IsCollection Protected Friend ReadOnly Property IsCollection As Boolean Implements IUserData.IsCollection
Get Get
@@ -332,16 +341,38 @@ BlockNullPicture:
End Sub End Sub
Friend Overridable ReadOnly Property Labels As List(Of String) Implements IUserData.Labels Friend Overridable ReadOnly Property Labels As List(Of String) Implements IUserData.Labels
#End Region #End Region
#Region "Downloading params" #Region "Downloading"
Protected _DataLoaded As Boolean = False Protected _DataLoaded As Boolean = False
Protected _DataParsed As Boolean = False Protected _DataParsed As Boolean = False
Friend Property ParseUserMediaOnly As Boolean = False Implements IUserData.ParseUserMediaOnly, IPluginContentProvider.ParseUserMediaOnly
Friend Overridable Property ReadyForDownload As Boolean = True Implements IUserData.ReadyForDownload Friend Overridable Property ReadyForDownload As Boolean = True Implements IUserData.ReadyForDownload
Friend Property DownloadImages As Boolean = True Implements IUserData.DownloadImages Friend Property DownloadImages As Boolean = True Implements IUserData.DownloadImages
Friend Property DownloadVideos As Boolean = True Implements IUserData.DownloadVideos Friend Property DownloadVideos As Boolean = True Implements IUserData.DownloadVideos
Friend Property DownloadMissingOnly As Boolean = False Implements IUserData.DownloadMissingOnly
#End Region #End Region
#Region "Content" #Region "Content"
Protected ReadOnly _ContentList As List(Of UserMedia) Protected ReadOnly _ContentList As List(Of UserMedia)
Protected ReadOnly _ContentNew As List(Of UserMedia) Protected ReadOnly _ContentNew As List(Of UserMedia)
Friend ReadOnly Property LatestData As List(Of UserMedia)
Protected ReadOnly MissingFinder As Predicate(Of UserMedia) = Function(c) c.State = UStates.Missing
Friend ReadOnly Property ContentMissing As List(Of UserMedia)
Get
If _ContentList.Count > 0 Then
Return _ContentList.Where(Function(c) MissingFinder(c)).ListIfNothing
Else
Return New List(Of UserMedia)
End If
End Get
End Property
Friend Overridable ReadOnly Property ContentMissingExists As Boolean
Get
Return _ContentList.Exists(MissingFinder)
End Get
End Property
Friend Sub RemoveMedia(ByVal m As UserMedia, ByVal State As UStates?)
Dim i% = If(State.HasValue, _ContentList.FindIndex(Function(mm) mm.State = State.Value And mm.Equals(m)), _ContentList.IndexOf(m))
If i >= 0 Then _ContentList.RemoveAt(i)
End Sub
Protected ReadOnly _TempMediaList As List(Of UserMedia) Protected ReadOnly _TempMediaList As List(Of UserMedia)
Protected ReadOnly _TempPostsList As List(Of String) Protected ReadOnly _TempPostsList As List(Of String)
Friend Function GetLastImageAddress() As SFile Friend Function GetLastImageAddress() As SFile
@@ -378,7 +409,7 @@ BlockNullPicture:
End Set End Set
End Property End Property
#End Region #End Region
#Region "Information" #Region "Information, counters, error, update date"
Friend Overridable Property LastUpdated As Date? Friend Overridable Property LastUpdated As Date?
Friend Overridable Property HasError As Boolean = False Implements IUserData.HasError Friend Overridable Property HasError As Boolean = False Implements IUserData.HasError
Private _DownloadedPicturesTotal As Integer = 0 Private _DownloadedPicturesTotal As Integer = 0
@@ -422,6 +453,28 @@ BlockNullPicture:
$" (P - {DownloadedPictures(True)}; V - {DownloadedVideos(True)})" $" (P - {DownloadedPictures(True)}; V - {DownloadedVideos(True)})"
End Get End Get
End Property End Property
Friend Overridable Function GetUserInformation() As String
Dim OutStr$ = $"User: {Name} (site: {Site}"
If IncludedInCollection Then OutStr &= $"; collection: {CollectionName}"
OutStr &= ")"
OutStr.StringAppendLine($"Labels: {Labels.ListToString}")
OutStr.StringAppendLine($"Path: {MyFile.CutPath.Path}")
OutStr.StringAppendLine($"Total downloaded ({DownloadedTotal(True).NumToString(ANumbers.Formats.Number, 3)}):")
OutStr.StringAppendLine($"Pictures: {DownloadedPictures(True).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(True).NumToString(ANumbers.Formats.Number, 3)}")
If Not UserDescription.IsEmptyString Then
OutStr.StringAppendLine(String.Empty)
OutStr.StringAppendLine(UserDescription)
End If
OutStr.StringAppendLine(String.Empty)
OutStr.StringAppendLine($"Last updated at: {AConvert(Of String)(LastUpdated, ADateTime.Formats.BaseDateTime, "not yet")}")
If _DataParsed Then
OutStr.StringAppendLine("Downloaded now:")
OutStr.StringAppendLine($"Pictures: {DownloadedTotal(False).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(False).NumToString(ANumbers.Formats.Number, 3)}")
End If
Return OutStr
End Function
#End Region #End Region
#Region "Script" #Region "Script"
Friend Overridable Property ScriptUse As Boolean = False Implements IUserData.ScriptUse Friend Overridable Property ScriptUse As Boolean = False Implements IUserData.ScriptUse
@@ -431,7 +484,6 @@ BlockNullPicture:
#Region "Plugins Support" #Region "Plugins Support"
Protected Event ProgressChanged As IPluginContentProvider.ProgressChangedEventHandler Implements IPluginContentProvider.ProgressChanged Protected Event ProgressChanged As IPluginContentProvider.ProgressChangedEventHandler Implements IPluginContentProvider.ProgressChanged
Protected Event TotalCountChanged As IPluginContentProvider.TotalCountChangedEventHandler Implements IPluginContentProvider.TotalCountChanged Protected Event TotalCountChanged As IPluginContentProvider.TotalCountChangedEventHandler Implements IPluginContentProvider.TotalCountChanged
Friend Property HOST As SettingsHost Implements IUserData.HOST
Private Property IPluginContentProvider_Settings As ISiteSettings Implements IPluginContentProvider.Settings Private Property IPluginContentProvider_Settings As ISiteSettings Implements IPluginContentProvider.Settings
Get Get
Return HOST.Source Return HOST.Source
@@ -489,11 +541,18 @@ BlockNullPicture:
End Function End Function
Friend Overridable ReadOnly Property FitToAddParams As Boolean Implements IUserData.FitToAddParams Friend Overridable ReadOnly Property FitToAddParams As Boolean Implements IUserData.FitToAddParams
Get Get
If Settings.LastUpdatedDate.HasValue AndAlso LastUpdated.HasValue AndAlso With Settings
LastUpdated.Value.Date > Settings.LastUpdatedDate.Value.Date Then Return False If LastUpdated.HasValue And Not .ViewDateMode.Value = ShowingDates.Off Then
If Not Settings.Labels.ExcludedIgnore AndAlso Settings.Labels.Excluded.ValuesList.ListContains(Labels) Then Return False Dim f As Date = If(.ViewDateFrom.HasValue, .ViewDateFrom.Value.Date, Date.MinValue.Date)
If Settings.SelectedSites.Count = 0 OrElse Settings.SelectedSites.Contains(Site) Then Dim t As Date = If(.ViewDateTo.HasValue, .ViewDateTo.Value.Date, Date.MaxValue.Date)
Select Case Settings.ShowingMode.Value Select Case DirectCast(.ViewDateMode.Value, ShowingDates)
Case ShowingDates.In : If Not LastUpdated.Value.ValueBetween(f, t) Then Return False
Case ShowingDates.Not : If LastUpdated.Value.ValueBetween(f, t) Then Return False
End Select
End If
If Not .Labels.ExcludedIgnore AndAlso .Labels.Excluded.ValuesList.ListContains(Labels) Then Return False
If .SelectedSites.Count = 0 OrElse .SelectedSites.Contains(Site) Then
Select Case .ShowingMode.Value
Case ShowingModes.Regular : Return Not Temporary And Not Favorite Case ShowingModes.Regular : Return Not Temporary And Not Favorite
Case ShowingModes.Temporary : Return Temporary Case ShowingModes.Temporary : Return Temporary
Case ShowingModes.Favorite : Return Favorite Case ShowingModes.Favorite : Return Favorite
@@ -506,6 +565,7 @@ BlockNullPicture:
Else Else
Return False Return False
End If End If
End With
End Get End Get
End Property End Property
Friend Function GetLVIGroup(ByVal Destination As ListView) As ListViewGroup Implements IUserData.GetLVIGroup Friend Function GetLVIGroup(ByVal Destination As ListView) As ListViewGroup Implements IUserData.GetLVIGroup
@@ -524,38 +584,18 @@ BlockNullPicture:
Return Destination.Groups.Item(LabelsKeeper.NoLabeledName) Return Destination.Groups.Item(LabelsKeeper.NoLabeledName)
End Try End Try
End Function End Function
Friend Overridable Function GetUserInformation() As String
Dim OutStr$ = $"User: {Name}"
OutStr.StringAppendLine($"Path: {MyFile.CutPath.Path}")
OutStr.StringAppendLine($"Total downloaded ({DownloadedTotal(True).NumToString(ANumbers.Formats.Number, 3)}):")
OutStr.StringAppendLine($"Pictures: {DownloadedPictures(True).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(True).NumToString(ANumbers.Formats.Number, 3)}")
If Not UserDescription.IsEmptyString Then
OutStr.StringAppendLine(String.Empty)
OutStr.StringAppendLine(UserDescription)
End If
OutStr.StringAppendLine(String.Empty)
OutStr.StringAppendLine($"Last updated at: {AConvert(Of String)(LastUpdated, ADateTime.Formats.BaseDateTime, "not yet")}")
If _DataParsed Then
OutStr.StringAppendLine("Downloaded now:")
OutStr.StringAppendLine($"Pictures: {DownloadedTotal(False).NumToString(ANumbers.Formats.Number, 3)}")
OutStr.StringAppendLine($"Videos: {DownloadedVideos(False).NumToString(ANumbers.Formats.Number, 3)}")
End If
Return OutStr
End Function
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Private ReadOnly _InvokeImageHandler As Boolean
''' <summary>By using this constructor you must set UserName and MyFile manually</summary> ''' <summary>By using this constructor you must set UserName and MyFile manually</summary>
Friend Sub New(Optional ByVal InvokeImageHandler As Boolean = True) Friend Sub New(Optional ByVal InvokeImageHandler As Boolean = True)
_InvokeImageHandler = InvokeImageHandler
_ContentList = New List(Of UserMedia) _ContentList = New List(Of UserMedia)
_ContentNew = New List(Of UserMedia) _ContentNew = New List(Of UserMedia)
LatestData = New List(Of UserMedia)
_TempMediaList = New List(Of UserMedia) _TempMediaList = New List(Of UserMedia)
_TempPostsList = New List(Of String) _TempPostsList = New List(Of String)
Labels = New List(Of String) Labels = New List(Of String)
_OnUserUpdatedHandlers = New List(Of IUserData.OnUserUpdatedEventHandler) UserUpdatedEventHandlers = New List(Of IUserData.UserUpdatedEventHandler)
If InvokeImageHandler Then ImageHandler(Me) If InvokeImageHandler Then MainFrameObj.ImageHandler(Me)
End Sub End Sub
Friend Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean, Friend Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean,
Optional ByVal AttachUserInfo As Boolean = True) Implements IUserData.SetEnvironment Optional ByVal AttachUserInfo As Boolean = True) Implements IUserData.SetEnvironment
@@ -566,13 +606,29 @@ BlockNullPicture:
End If End If
End Sub End Sub
''' <exception cref="ArgumentOutOfRangeException"></exception> ''' <exception cref="ArgumentOutOfRangeException"></exception>
Friend Overloads Shared Function GetInstance(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True) As IUserData Friend Shared Function GetInstance(ByVal u As UserInfo, Optional ByVal _LoadUserInformation As Boolean = True) As IUserData
If Not u.Plugin.IsEmptyString Then If Not u.Plugin.IsEmptyString Then
Return Settings(u.Plugin).GetInstance(u.DownloadOption, u, _LoadUserInformation) Return Settings(u.Plugin).GetInstance(u.DownloadOption, u, _LoadUserInformation)
Else Else
Throw New ArgumentOutOfRangeException("Plugin", $"Plugin [{u.Plugin}] information does not recognized by loader") Throw New ArgumentOutOfRangeException("Plugin", $"Plugin [{u.Plugin}] information does not recognized by loader")
End If End If
End Function End Function
Friend Shared Function GetPostUrl(ByVal u As IUserData, ByVal PostData As UserMedia) As String
Dim uName$ = String.Empty
Try
If Not u Is Nothing AndAlso Not u.IsCollection Then
With DirectCast(u, UserDataBase)
If Not .User.Plugin.IsEmptyString Then
uName = .User.Name
Return Settings(.User.Plugin).GetUserPostUrl(.ID, PostData.Post.ID)
End If
End With
End If
Return String.Empty
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"GetPostUrl({uName}, {PostData.Post.ID})", String.Empty)
End Try
End Function
#End Region #End Region
#Region "Information & Content data files loader and saver" #Region "Information & Content data files loader and saver"
#Region "User information" #Region "User information"
@@ -659,37 +715,14 @@ BlockNullPicture:
Protected MustOverride Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected MustOverride Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
#End Region #End Region
#Region "User data" #Region "User data"
Friend Overridable Overloads Sub LoadContentInformation() Friend Overridable Overloads Sub LoadContentInformation(Optional ByVal Force As Boolean = False)
Try Try
UpdateDataFiles() UpdateDataFiles()
If Not MyFileData.Exists Then Exit Sub If Not MyFileData.Exists Or (_DataLoaded And Not Force) Then Exit Sub
Using x As New XmlFile(MyFileData, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True} Using x As New XmlFile(MyFileData, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
x.LoadData() x.LoadData()
If x.Count > 0 Then If x.Count > 0 Then
Dim fs$ = MyFile.CutPath.PathWithSeparator For Each v As EContainer In x : _ContentList.Add(New UserMedia(v, Me)) : Next
Dim gfn As Func(Of String, String) = Function(ByVal Input As String) As String
If Input.IsEmptyString Then
Return String.Empty
Else
If Input.Contains("\") Then
Return New SFile(Input).File
Else
Return Input
End If
End If
End Function
For Each v As EContainer In x
_ContentList.Add(New UserMedia With {
.Type = AConvert(Of Integer)(v.Attribute(Name_MediaType).Value, 0),
.URL = v.Attribute(Name_MediaURL).Value,
.URL_BASE = v.Value,
.MD5 = v.Attribute(Name_MediaHash).Value,
.File = fs & gfn.Invoke(v.Attribute(Name_MediaFile).Value),
.Post = New UserPost With {
.ID = v.Attribute(Name_MediaPostID).Value,
.[Date] = AConvert(Of Date)(v.Attribute(Name_MediaPostDate).Value, ParsersDataDateProvider, Nothing)}
})
Next
End If End If
_DataLoaded = True _DataLoaded = True
End Using End Using
@@ -703,18 +736,7 @@ BlockNullPicture:
If MyFileData.IsEmptyString Then Exit Sub If MyFileData.IsEmptyString Then Exit Sub
MyFileData.Exists(SFO.Path) MyFileData.Exists(SFO.Path)
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Data"} Using x As New XmlFile With {.AllowSameNames = True, .Name = "Data"}
If _ContentList.Count > 0 Then If _ContentList.Count > 0 Then x.AddRange(_ContentList)
For Each i As UserMedia In _ContentList
x.Add(New EContainer("MediaData", i.URL_BASE,
{New EAttribute(Name_MediaType, CInt(i.Type)),
New EAttribute(Name_MediaURL, i.URL),
New EAttribute(Name_MediaHash, i.MD5),
New EAttribute(Name_MediaFile, i.File.File),
New EAttribute(Name_MediaPostID, i.Post.ID),
New EAttribute(Name_MediaPostDate, AConvert(Of String)(i.Post.Date, ParsersDataDateProvider, String.Empty))
}))
Next
End If
x.Save(MyFileData) x.Save(MyFileData)
End Using End Using
Catch ex As Exception Catch ex As Exception
@@ -730,17 +752,62 @@ BlockNullPicture:
If Not URL.IsEmptyString Then Process.Start(URL) If Not URL.IsEmptyString Then Process.Start(URL)
Catch ex As Exception Catch ex As Exception
If Not e.Exists Then e = New ErrorsDescriber(EDP.ShowAllMsg) If Not e.Exists Then e = New ErrorsDescriber(EDP.ShowAllMsg)
MsgBoxE($"Error on trying to open [{Site}] page of user [{Name}]", MsgBoxStyle.Critical, e) MsgBoxE({$"Error when trying to open [{Site}] page of user [{Name}]", $"User [{ToString()}]"}, MsgBoxStyle.Critical, e, ex)
End Try End Try
End Sub End Sub
Friend Overridable Sub OpenFolder() Implements IUserData.OpenFolder Friend Overridable Sub OpenFolder() Implements IUserData.OpenFolder
GlobalOpenPath(MyFile.CutPath) GlobalOpenPath(MyFile.CutPath)
End Sub End Sub
#End Region #End Region
#Region "Download functions and options" #Region "Download limits"
Protected Enum DateResult : [Continue] : [Skip] : [Exit] : End Enum
Friend Overridable Property DownloadTopCount As Integer? = Nothing Implements IUserData.DownloadTopCount, IPluginContentProvider.PostsNumberLimit Friend Overridable Property DownloadTopCount As Integer? = Nothing Implements IUserData.DownloadTopCount, IPluginContentProvider.PostsNumberLimit
Friend Overridable Property DownloadToDate As Date? = Nothing Implements IUserData.DownloadToDate, IPluginContentProvider.PostsDateLimit Friend Overridable Property IncludeInTheFeed As Boolean = True
Private _DownloadDateFrom As Date? = Nothing
Private _DownloadDateFromF As Date
Friend Overridable Property DownloadDateFrom As Date? Implements IUserData.DownloadDateFrom, IPluginContentProvider.DownloadDateFrom
Get
Return _DownloadDateFrom
End Get
Set(ByVal d As Date?)
_DownloadDateFrom = d
If _DownloadDateFrom.HasValue Then _DownloadDateFromF = _DownloadDateFrom.Value.Date Else _DownloadDateFromF = Date.MinValue.Date
End Set
End Property
Private _DownloadDateTo As Date? = Nothing
Private _DownloadDateToF As Date
Friend Overridable Property DownloadDateTo As Date? Implements IUserData.DownloadDateTo, IPluginContentProvider.DownloadDateTo
Get
Return _DownloadDateTo
End Get
Set(ByVal d As Date?)
_DownloadDateTo = d
If _DownloadDateTo.HasValue Then _DownloadDateToF = _DownloadDateTo.Value Else _DownloadDateToF = Date.MaxValue.Date
End Set
End Property
Protected Function CheckDatesLimit(ByVal DateObj As Object, ByVal DateProvider As IFormatProvider) As DateResult
Try
If (DownloadDateFrom.HasValue Or DownloadDateTo.HasValue) AndAlso ACheck(DateObj) Then
Dim td As Date? = AConvert(Of Date)(DateObj, DateProvider, Nothing)
If td.HasValue Then
If td.Value.ValueBetween(_DownloadDateFromF, _DownloadDateToF) Then
Return DateResult.Continue
ElseIf td.Value > _DownloadDateToF Then
Return DateResult.Skip
Else
Return DateResult.Exit
End If
End If
End If
Return DateResult.Continue
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[UserDataBase.CheckDatesLimit({If(TypeOf DateObj Is String, CStr(DateObj), "?")})]", DateResult.Continue)
End Try
End Function
#End Region
#Region "Download functions and options"
Protected Responser As Response Protected Responser As Response
Protected UseResponserClient As Boolean = False
Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData
Dim Canceled As Boolean = False Dim Canceled As Boolean = False
_ExternalCompatibilityToken = Token _ExternalCompatibilityToken = Token
@@ -750,10 +817,14 @@ BlockNullPicture:
If Not Responser Is Nothing Then Responser.Dispose() If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Response Responser = New Response
If Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser) If Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser)
'TODO: remove
Responser.DecodersError = New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue) With {
.DeclaredMessage = New MMessage($"SymbolsConverter error: [{ToStringForLog()}]", ToStringForLog())}
Dim UpPic As Boolean = Settings.ViewModeIsPicture AndAlso GetPicture(Of Image)(False) Is Nothing Dim UpPic As Boolean = Settings.ViewModeIsPicture AndAlso GetPicture(Of Image)(False) Is Nothing
Dim sEnvir() As Boolean = {UserExists, UserSuspended} Dim sEnvir() As Boolean = {UserExists, UserSuspended}
Dim EnvirChanged As Func(Of Boolean) = Function() Not sEnvir(0) = UserExists Or Not sEnvir(1) = UserSuspended Dim EnvirChanged As Func(Of Boolean) = Function() Not sEnvir(0) = UserExists Or Not sEnvir(1) = UserSuspended
Dim _downContent As Func(Of UserMedia, Boolean) = Function(c) c.State = UStates.Downloaded
UserExists = True UserExists = True
UserSuspended = False UserSuspended = False
DownloadedPictures(False) = 0 DownloadedPictures(False) = 0
@@ -762,29 +833,40 @@ BlockNullPicture:
_TempPostsList.Clear() _TempPostsList.Clear()
Dim __SaveData As Boolean = Not CreatedByChannel Or Not Settings.FromChannelDownloadTopUse Dim __SaveData As Boolean = Not CreatedByChannel Or Not Settings.FromChannelDownloadTopUse
If Not _DataLoaded Then LoadContentInformation() LoadContentInformation()
If MyFilePosts.Exists Then _TempPostsList.ListAddList(File.ReadAllLines(MyFilePosts)) If MyFilePosts.Exists Then _TempPostsList.ListAddList(File.ReadAllLines(MyFilePosts))
If _ContentList.Count > 0 Then _TempPostsList.ListAddList(_ContentList.Select(Function(u) u.Post.ID), LNC) If _ContentList.Count > 0 Then _TempPostsList.ListAddList(_ContentList.Select(Function(u) u.Post.ID), LNC)
If Not DownloadMissingOnly Then
ThrowAny(Token) ThrowAny(Token)
DownloadDataF(Token) DownloadDataF(Token)
ThrowAny(Token) ThrowAny(Token)
If Settings.ReparseMissingInTheRoutine Then ReparseMissing(Token) : ThrowAny(Token)
Else
ReparseMissing(Token)
End If
If _TempMediaList.Count > 0 Then If _TempMediaList.Count > 0 Then
If Not DownloadImages Then _TempMediaList.RemoveAll(Function(m) m.Type = UTypes.GIF Or m.Type = UTypes.Picture) If Not DownloadImages Then _TempMediaList.RemoveAll(Function(m) m.Type = UTypes.GIF Or m.Type = UTypes.Picture)
If Not DownloadVideos Then _TempMediaList.RemoveAll(Function(m) m.Type = UTypes.Video Or If Not DownloadVideos Then _TempMediaList.RemoveAll(Function(m) m.Type = UTypes.Video Or
m.Type = UTypes.VideoPre Or m.Type = UTypes.m3u8) m.Type = UTypes.VideoPre Or m.Type = UTypes.m3u8)
If DownloadMissingOnly Then _TempMediaList.RemoveAll(Function(m) Not m.State = UStates.Missing)
End If End If
ReparseVideo(Token) ReparseVideo(Token)
ThrowAny(Token) ThrowAny(Token)
If _TempPostsList.Count > 0 And __SaveData Then TextSaver.SaveTextToFile(_TempPostsList.ListToString(Environment.NewLine), MyFilePosts, True,, EDP.None) If _TempPostsList.Count > 0 And Not DownloadMissingOnly And __SaveData Then _
TextSaver.SaveTextToFile(_TempPostsList.ListToString(Environment.NewLine), MyFilePosts, True,, EDP.None)
_ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd) _ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd)
DownloadContent(Token) DownloadContent(Token)
ThrowIfDisposed() ThrowIfDisposed()
_ContentList.ListAddList(_ContentNew.Where(Function(c) c.State = UStates.Downloaded), LNC)
If DownloadedTotal(False) > 0 Or EnvirChanged.Invoke Then LatestData.ListAddList(_ContentNew.Where(_downContent), LNC)
Dim mcb& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
_ContentList.ListAddList(_ContentNew.Where(Function(c) _downContent(c) Or MissingFinder(c)), LNC)
Dim mca& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
If DownloadedTotal(False) > 0 Or EnvirChanged.Invoke Or Not mcb = mca Then
If __SaveData Then If __SaveData Then
LastUpdated = Now LastUpdated = Now
RunScript() RunScript()
@@ -803,7 +885,7 @@ BlockNullPicture:
If _CollectionButtonsExists AndAlso EnvirChanged.Invoke Then UpdateButtonsColor() If _CollectionButtonsExists AndAlso EnvirChanged.Invoke Then UpdateButtonsColor()
End If End If
ThrowIfDisposed() ThrowIfDisposed()
If UpPic Or EnvirChanged.Invoke Then RaiseEvent_OnUserUpdated() If UpPic Or EnvirChanged.Invoke Then OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested Catch oex As OperationCanceledException When Token.IsCancellationRequested
MyMainLOG = $"{Site} - {Name}: downloading canceled" MyMainLOG = $"{Site} - {Name}: downloading canceled"
Canceled = True Canceled = True
@@ -814,23 +896,14 @@ BlockNullPicture:
HasError = True HasError = True
Finally Finally
If Not Responser Is Nothing Then Responser.Dispose() : Responser = Nothing If Not Responser Is Nothing Then Responser.Dispose() : Responser = Nothing
If Not Canceled Then _DataParsed = True ': LastUpdated = Now If Not Canceled Then _DataParsed = True
_ContentNew.Clear() _ContentNew.Clear()
DownloadTopCount = Nothing DownloadTopCount = Nothing
DownloadToDate = Nothing DownloadDateFrom = Nothing
DownloadDateTo = Nothing
DownloadMissingOnly = False
End Try End Try
End Sub End Sub
Protected Function CheckDatesLimit(ByVal DateString As String, ByVal DateProvider As IFormatProvider) As Boolean
Try
If DownloadToDate.HasValue And Not DateString.IsEmptyString Then
Dim td As Date? = AConvert(Of Date)(DateString, DateProvider, Nothing)
If td.HasValue Then Return td.Value < DownloadToDate.Value
End If
Return True
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[UserDataBase.CheckDatesLimit({DateString})]", True)
End Try
End Function
Protected Sub UpdateDataFiles() Protected Sub UpdateDataFiles()
If Not User.File.IsEmptyString Then If Not User.File.IsEmptyString Then
MyFileData = User.File MyFileData = User.File
@@ -839,12 +912,56 @@ BlockNullPicture:
MyFilePosts.Name &= "_Posts" MyFilePosts.Name &= "_Posts"
MyFilePosts.Extension = "txt" MyFilePosts.Extension = "txt"
Else Else
Throw New ArgumentNullException("User.File", "User file does not detected") Throw New ArgumentNullException("User.File", "User file not detected")
End If End If
End Sub End Sub
Protected MustOverride Sub DownloadDataF(ByVal Token As CancellationToken) Protected MustOverride Sub DownloadDataF(ByVal Token As CancellationToken)
Protected MustOverride Sub ReparseVideo(ByVal Token As CancellationToken) Protected Overridable Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
''' <summary>
''' Missing posts must be collected from [<see cref="_ContentList"/>].<br/>
''' Reparsed post must be added to [<see cref="_TempMediaList"/>].<br/>
''' At the end of the function, reparsed posts must be removed from [<see cref="_ContentList"/>].
''' </summary>
Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken)
End Sub
Protected MustOverride Sub DownloadContent(ByVal Token As CancellationToken) Protected MustOverride Sub DownloadContent(ByVal Token As CancellationToken)
Private NotInheritable Class OptionalWebClient : Implements IDisposable
Private ReadOnly WC As WebClient
Private ReadOnly RC As Response
Private ReadOnly RCERROR As New ErrorsDescriber(EDP.ThrowException)
Private ReadOnly UseResponserClient As Boolean
Friend Sub New(ByRef Source As UserDataBase)
UseResponserClient = Source.UseResponserClient
If UseResponserClient Then
RC = Source.Responser
Else
WC = New WebClient
End If
End Sub
Friend Sub DownloadFile(ByVal URL As String, ByVal File As String)
If UseResponserClient Then
RC.DownloadFile(URL, File, RCERROR)
Else
WC.DownloadFile(URL, File)
End If
End Sub
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing And Not WC Is Nothing Then WC.Dispose()
disposedValue = True
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
Protected Sub DownloadContentDefault(ByVal Token As CancellationToken) Protected Sub DownloadContentDefault(ByVal Token As CancellationToken)
Try Try
Dim i% Dim i%
@@ -854,14 +971,16 @@ BlockNullPicture:
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString) _ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
If _ContentNew.Count > 0 Then If _ContentNew.Count > 0 Then
MyFile.Exists(SFO.Path) MyFile.Exists(SFO.Path)
Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog
Dim MyDir$ = MyFile.CutPath.PathNoSeparator Dim MyDir$ = MyFile.CutPath.PathNoSeparator
Dim vsf As Boolean = SeparateVideoFolderF Dim vsf As Boolean = SeparateVideoFolderF
Dim __isVideo As Boolean Dim __isVideo As Boolean
Dim f As SFile Dim f As SFile
Dim v As UserMedia Dim v As UserMedia
Using w As New WebClient
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path) Using w As New OptionalWebClient(Me)
Progress.TotalCount += _ContentNew.Count If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path)
Progress.Maximum += _ContentNew.Count
For i = 0 To _ContentNew.Count - 1 For i = 0 To _ContentNew.Count - 1
ThrowAny(Token) ThrowAny(Token)
v = _ContentNew(i) v = _ContentNew(i)
@@ -876,7 +995,7 @@ BlockNullPicture:
If v.URL_BASE.IsEmptyString Then v.URL_BASE = v.URL If v.URL_BASE.IsEmptyString Then v.URL_BASE = v.URL
If Not v.File.IsEmptyString And Not v.URL_BASE.IsEmptyString Then If Not v.File.IsEmptyString And Not v.URL.IsEmptyString Then
Try Try
__isVideo = v.Type = UTypes.Video Or f.Extension = "mp4" __isVideo = v.Type = UTypes.Video Or f.Extension = "mp4"
@@ -886,6 +1005,8 @@ BlockNullPicture:
Case UTypes.Video : f.Extension = "mp4" Case UTypes.Video : f.Extension = "mp4"
Case UTypes.GIF : f.Extension = "gif" Case UTypes.GIF : f.Extension = "gif"
End Select End Select
ElseIf f.Extension = "webp" And Settings.DownloadNativeImageFormat Then
f.Extension = "jpg"
End If End If
If Not v.SpecialFolder.IsEmptyString Then If Not v.SpecialFolder.IsEmptyString Then
@@ -896,7 +1017,13 @@ BlockNullPicture:
f.Path = $"{f.PathWithSeparator}Video" f.Path = $"{f.PathWithSeparator}Video"
If Not v.SpecialFolder.IsEmptyString Then f.Exists(SFO.Path) If Not v.SpecialFolder.IsEmptyString Then f.Exists(SFO.Path)
End If End If
w.DownloadFile(v.URL_BASE, f.ToString)
If v.Type = UTypes.m3u8 And UseInternalM3U8Function Then
f = DownloadM3U8(v.URL, v, f)
If f.IsEmptyString Then Throw New Exception("M3U8 download failed")
Else
w.DownloadFile(v.URL, f.ToString)
End If
If __isVideo Then If __isVideo Then
v.Type = UTypes.Video v.Type = UTypes.Video
@@ -910,7 +1037,9 @@ BlockNullPicture:
v.State = UStates.Downloaded v.State = UStates.Downloaded
dCount += 1 dCount += 1
Catch wex As Exception Catch wex As Exception
ErrorDownloading(f, v.URL_BASE) v.Attempts += 1
v.State = UStates.Missing
If MissingErrorsAdd Then ErrorDownloading(f, v.URL)
End Try End Try
Else Else
v.State = UStates.Skipped v.State = UStates.Skipped
@@ -935,20 +1064,30 @@ BlockNullPicture:
HasError = True HasError = True
End Try End Try
End Sub End Sub
Protected UseInternalM3U8Function As Boolean = False
Protected Overridable Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
Return Nothing
End Function
''' <param name="RDE">Request DownloadingException</param> ''' <param name="RDE">Request DownloadingException</param>
Protected Sub ProcessException(ByVal ex As Exception, ByVal Token As CancellationToken, ByVal Message As String, Optional ByVal RDE As Boolean = True) ''' <returns>0 - exit</returns>
Protected Function ProcessException(ByVal ex As Exception, ByVal Token As CancellationToken, ByVal Message As String, Optional ByVal RDE As Boolean = True, Optional ByVal EObj As Object = Nothing) As Integer
If Not ((TypeOf ex Is OperationCanceledException And Token.IsCancellationRequested) Or If Not ((TypeOf ex Is OperationCanceledException And Token.IsCancellationRequested) Or
(TypeOf ex Is ObjectDisposedException And Disposed)) Then (TypeOf ex Is ObjectDisposedException And Disposed)) Then
If RDE AndAlso DownloadingException(ex, Message, True) = 0 Then LogError(ex, Message) : HasError = True If RDE Then
Dim v% = DownloadingException(ex, Message, True, EObj)
If v = 0 Then LogError(ex, Message) : HasError = True
Return v
End If End If
End Sub End If
Return 0
End Function
''' <summary>0 - Execute LogError and set HasError</summary> ''' <summary>0 - Execute LogError and set HasError</summary>
Protected MustOverride Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer Protected MustOverride Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Optional ByVal EObj As Object = Nothing) As Integer
Protected Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile Protected Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
Dim ff As SFile = Nothing Dim ff As SFile = Nothing
Try Try
If Not f.IsEmptyString AndAlso f.Exists Then If f.Exists Then
If Settings.FileReplaceNameByDate Or Settings.FileAddTimeToFileName Then If Not Settings.FileReplaceNameByDate.Value = FileNameReplaceMode.None Then
ff = f ff = f
ff.Name = String.Format(FileDateAppenderPattern, f.Name, CStr(AConvert(Of String)(If(m.Post.Date, Now), FileDateAppenderProvider, String.Empty))) ff.Name = String.Format(FileDateAppenderPattern, f.Name, CStr(AConvert(Of String)(If(m.Post.Date, Now), FileDateAppenderProvider, String.Empty)))
ff = SFile.Indexed_IndexFile(ff,, New NumberedFile(ff)) ff = SFile.Indexed_IndexFile(ff,, New NumberedFile(ff))
@@ -984,14 +1123,14 @@ BlockNullPicture:
End Try End Try
End Sub End Sub
#End Region #End Region
#Region "Delete, Move, Merge" #Region "Delete, Move, Merge, Copy"
Friend Overridable Function Delete() As Integer Implements IUserData.Delete Friend Overridable Function Delete(Optional ByVal Multiple As Boolean = False) As Integer Implements IUserData.Delete
Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path) Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then
ImageHandler(Me, False) If Not IncludedInCollection Then MainFrameObj.ImageHandler(Me, False)
Settings.UsersList.Remove(User) Settings.UsersList.Remove(User)
Settings.UpdateUsersList() Settings.UpdateUsersList()
Settings.Users.Remove(Me) If Not IncludedInCollection Then Settings.Users.Remove(Me)
Downloader.UserRemove(Me) Downloader.UserRemove(Me)
Dispose(True) Dispose(True)
Return 1 Return 1
@@ -1108,10 +1247,52 @@ BlockNullPicture:
End If End If
Return f Return f
End Function End Function
Private Class FilesCopyingException : Inherits ErrorsDescriberException
Friend Sub New(ByVal User As IUserData, ByVal Msg As String, ByVal Path As SFile)
SendInLogOnlyMessage = True
If User.IncludedInCollection Then _MainMessage = $"[{User.CollectionName}] - "
_MainMessage &= $"[{User.Site}] - [{User.Name}]. {Msg}: {Path.Path}."
End Sub
End Class
Friend Overridable Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements IUserData.CopyFiles
Dim fSource As SFile = Nothing
Dim fDest As SFile = Nothing
Try
Dim pOffset%
If IncludedInCollection Then
If DataMerging Then pOffset = 1 Else pOffset = 2
Else
pOffset = 1
End If
fSource = User.File.CutPath(pOffset).Path.CSFileP
Dim OptPath$ = String.Empty
If IncludedInCollection Then
OptPath = $"Collections\{CollectionName}" 'Copying a collection based on the first file
Else
OptPath = $"{Site}\{Name}"
End If
fDest = $"{DestinationPath.PathWithSeparator}{OptPath}".CSFileP
If fDest.Exists(SFO.Path, False) AndAlso MsgBoxE({$"The following path already exists:{vbCr}{fDest.Path}" & vbCr &
"Do you want to copy files here?", "Copying files"}, vbExclamation + vbYesNo) = vbNo Then _
Throw New FilesCopyingException(Me, "The following path already exists", fDest)
If DestinationPath.Exists(SFO.Path, True) Then
My.Computer.FileSystem.CopyDirectory(fSource, fDest, FileIO.UIOption.OnlyErrorDialogs, FileIO.UICancelOption.ThrowException)
Else
Throw New FilesCopyingException(Me, "Cannot create the following path", fDest)
End If
Return True
Catch cex As OperationCanceledException
Return ErrorsDescriber.Execute(e, New FilesCopyingException(Me, "Copy canceled", fDest),, False)
Catch ex As Exception
Return ErrorsDescriber.Execute(e, ex,, False)
End Try
End Function
#End Region #End Region
#Region "Errors functions" #Region "Errors functions"
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String) Protected Sub LogError(ByVal ex As Exception, ByVal Message As String)
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"{IIf(IncludedInCollection, $"{CollectionName}-", String.Empty)}{Site} - {Name}: {Message}") ErrorsDescriber.Execute(EDP.SendInLog, ex, $"{ToStringForLog()}: {Message}")
End Sub End Sub
Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String) Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String)
If Not f.Exists Then MyMainLOG = $"Error downloading from [{URL}] to [{f}]" If Not f.Exists Then MyMainLOG = $"Error downloading from [{URL}] to [{f}]"
@@ -1126,11 +1307,14 @@ BlockNullPicture:
End Sub End Sub
''' <exception cref="OperationCanceledException"></exception> ''' <exception cref="OperationCanceledException"></exception>
''' <exception cref="ObjectDisposedException"></exception> ''' <exception cref="ObjectDisposedException"></exception>
Friend Overloads Sub ThrowAny(ByVal Token As CancellationToken) Friend Overridable Overloads Sub ThrowAny(ByVal Token As CancellationToken)
Token.ThrowIfCancellationRequested() Token.ThrowIfCancellationRequested()
ThrowIfDisposed() ThrowIfDisposed()
End Sub End Sub
#End Region #End Region
Protected Function ToStringForLog() As String
Return $"{IIf(IncludedInCollection, $"[{CollectionName}] - ", String.Empty)}[{Site}] - {Name}"
End Function
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
If IsCollection Then If IsCollection Then
Return CollectionName Return CollectionName
@@ -1138,9 +1322,19 @@ BlockNullPicture:
Return IIf(FriendlyName.IsEmptyString, Name, FriendlyName) Return IIf(FriendlyName.IsEmptyString, Name, FriendlyName)
End If End If
End Function End Function
Public Overrides Function GetHashCode() As Integer
Dim hcStr$
If Not CollectionName.IsEmptyString Then
hcStr = CollectionName
Else
hcStr = IIf(FriendlyName.IsEmptyString, Name, FriendlyName)
End If
If hcStr.IsEmptyString Then hcStr = LVIKey
Return hcStr.GetHashCode
End Function
#Region "Buttons actions" #Region "Buttons actions"
Private Sub BTT_CONTEXT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DOWN.Click Private Sub BTT_CONTEXT_DOWN_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_CONTEXT_DOWN.KeyClick
Downloader.Add(Me) Downloader.Add(Me, e.IncludeInTheFeed)
End Sub End Sub
Private Sub BTT_CONTEXT_EDIT_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_EDIT.Click Private Sub BTT_CONTEXT_EDIT_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_EDIT.Click
Using f As New Editors.UserCreatorForm(Me) Using f As New Editors.UserCreatorForm(Me)
@@ -1193,6 +1387,7 @@ BlockNullPicture:
If disposing Then If disposing Then
_ContentList.Clear() _ContentList.Clear()
_ContentNew.Clear() _ContentNew.Clear()
LatestData.Clear()
_TempMediaList.Clear() _TempMediaList.Clear()
_TempPostsList.Clear() _TempPostsList.Clear()
If Not Responser Is Nothing Then Responser.Dispose() If Not Responser Is Nothing Then Responser.Dispose()
@@ -1201,7 +1396,7 @@ BlockNullPicture:
If Not BTT_CONTEXT_DELETE Is Nothing Then BTT_CONTEXT_DELETE.Dispose() If Not BTT_CONTEXT_DELETE Is Nothing Then BTT_CONTEXT_DELETE.Dispose()
If Not BTT_CONTEXT_OPEN_PATH Is Nothing Then BTT_CONTEXT_OPEN_PATH.Dispose() If Not BTT_CONTEXT_OPEN_PATH Is Nothing Then BTT_CONTEXT_OPEN_PATH.Dispose()
If Not BTT_CONTEXT_OPEN_SITE Is Nothing Then BTT_CONTEXT_OPEN_SITE.Dispose() If Not BTT_CONTEXT_OPEN_SITE Is Nothing Then BTT_CONTEXT_OPEN_SITE.Dispose()
_OnUserUpdatedHandlers.Clear() UserUpdatedEventHandlers.Clear()
End If End If
disposedValue = True disposedValue = True
End If End If
@@ -1228,7 +1423,7 @@ BlockNullPicture:
Sub DownloadData(ByVal Token As CancellationToken) Sub DownloadData(ByVal Token As CancellationToken)
End Interface End Interface
Friend Interface IUserData : Inherits IContentProvider, IComparable(Of UserDataBase), IComparable, IEquatable(Of UserDataBase), IIndexable, IDisposable Friend Interface IUserData : Inherits IContentProvider, IComparable(Of UserDataBase), IComparable, IEquatable(Of UserDataBase), IIndexable, IDisposable
Event OnUserUpdated(ByVal User As IUserData) Event UserUpdated(ByVal User As IUserData)
Property ParseUserMediaOnly As Boolean Property ParseUserMediaOnly As Boolean
#Region "Images" #Region "Images"
Function GetPicture() As Image Function GetPicture() As Image
@@ -1256,6 +1451,7 @@ BlockNullPicture:
ReadOnly Property Key As String ReadOnly Property Key As String
Property DownloadImages As Boolean Property DownloadImages As Boolean
Property DownloadVideos As Boolean Property DownloadVideos As Boolean
Property DownloadMissingOnly As Boolean
Property ScriptUse As Boolean Property ScriptUse As Boolean
Property ScriptData As String Property ScriptData As String
Function GetLVI(ByVal Destination As ListView) As ListViewItem Function GetLVI(ByVal Destination As ListView) As ListViewItem
@@ -1268,12 +1464,14 @@ BlockNullPicture:
''' 2 - Collection removed<br/> ''' 2 - Collection removed<br/>
''' 3 - Collection split ''' 3 - Collection split
''' </summary> ''' </summary>
Function Delete() As Integer Function Delete(Optional ByVal Multiple As Boolean = False) As Integer
Function MoveFiles(ByVal CollectionName As String) As Boolean Function MoveFiles(ByVal CollectionName As String) As Boolean
Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Sub OpenFolder() Sub OpenFolder()
ReadOnly Property Self As IUserData ReadOnly Property Self As IUserData
Property DownloadTopCount As Integer? Property DownloadTopCount As Integer?
Property DownloadToDate As Date? Property DownloadDateFrom As Date?
Property DownloadDateTo As Date?
Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean, Sub SetEnvironment(ByRef h As SettingsHost, ByVal u As UserInfo, ByVal _LoadUserInformation As Boolean,
Optional ByVal AttachUserInfo As Boolean = True) Optional ByVal AttachUserInfo As Boolean = True)
ReadOnly Property Disposed As Boolean ReadOnly Property Disposed As Boolean

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -6,9 +6,9 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Imports System.Net Imports System.Net
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Gfycat Namespace API.Gfycat
Friend NotInheritable Class Envir Friend NotInheritable Class Envir
Private Sub New() Private Sub New()

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -6,12 +6,12 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Net
Imports SCrawler.API.Base
Imports SCrawler.API.Imgur.Declarations
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WebDocuments.JSON Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports System.Net
Imports SCrawler.API.Imgur.Declarations
Imports SCrawler.API.Base
Namespace API.Imgur Namespace API.Imgur
Namespace Declarations Namespace Declarations
Friend Module Imgur_Declarations Friend Module Imgur_Declarations
@@ -67,7 +67,7 @@ Namespace API.Imgur
Return DownloadingException(ex, $"[API.Imgur.Envir.GetImage({URL})]", String.Empty, e) Return DownloadingException(ex, $"[API.Imgur.Envir.GetImage({URL})]", String.Empty, e)
End Try End Try
End Function End Function
Friend Shared Function GetVideoInfo(ByVal URL As String) As IEnumerable(Of UserMedia) Friend Shared Function GetVideoInfo(ByVal URL As String, Optional ByVal e As ErrorsDescriber = Nothing) As IEnumerable(Of UserMedia)
Try Try
If Not URL.IsEmptyString AndAlso URL.ToLower.Contains("imgur") AndAlso Not Settings.ImgurClientID.IsEmptyString Then If Not URL.IsEmptyString AndAlso URL.ToLower.Contains("imgur") AndAlso Not Settings.ImgurClientID.IsEmptyString Then
Dim img$ = GetImage(URL, EDP.ReturnValue) Dim img$ = GetImage(URL, EDP.ReturnValue)
@@ -79,7 +79,8 @@ Namespace API.Imgur
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Imgur standalone downloader: fetch media error") If Not e.Exists Then e = EDP.LogMessageValue
Return ErrorsDescriber.Execute(e, ex, "Imgur standalone downloader: fetch media error")
End Try End Try
End Function End Function
Private Shared Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Private Shared Function DownloadingException(ByVal ex As Exception, ByVal Message As String,

View File

@@ -0,0 +1,135 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Instagram
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class AdditionalSettingsForm : 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
Me.CH_DOWN_TIME = New System.Windows.Forms.CheckBox()
Me.CH_DOWN_TAG = New System.Windows.Forms.CheckBox()
Me.CH_DOWN_SAVED = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
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(234, 78)
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(234, 103)
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.CH_DOWN_TIME, 0, 0)
TP_MAIN.Controls.Add(Me.CH_DOWN_TAG, 0, 1)
TP_MAIN.Controls.Add(Me.CH_DOWN_SAVED, 0, 2)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 4
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.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(234, 78)
TP_MAIN.TabIndex = 0
'
'CH_DOWN_TIME
'
Me.CH_DOWN_TIME.AutoSize = True
Me.CH_DOWN_TIME.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_TIME.Location = New System.Drawing.Point(4, 4)
Me.CH_DOWN_TIME.Name = "CH_DOWN_TIME"
Me.CH_DOWN_TIME.Size = New System.Drawing.Size(226, 19)
Me.CH_DOWN_TIME.TabIndex = 0
Me.CH_DOWN_TIME.Text = "Download Timeline"
Me.CH_DOWN_TIME.UseVisualStyleBackColor = True
'
'CH_DOWN_TAG
'
Me.CH_DOWN_TAG.AutoSize = True
Me.CH_DOWN_TAG.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_TAG.Location = New System.Drawing.Point(4, 30)
Me.CH_DOWN_TAG.Name = "CH_DOWN_TAG"
Me.CH_DOWN_TAG.Size = New System.Drawing.Size(226, 19)
Me.CH_DOWN_TAG.TabIndex = 1
Me.CH_DOWN_TAG.Text = "Download Stories and Tagged data"
Me.CH_DOWN_TAG.UseVisualStyleBackColor = True
'
'CH_DOWN_SAVED
'
Me.CH_DOWN_SAVED.AutoSize = True
Me.CH_DOWN_SAVED.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_SAVED.Location = New System.Drawing.Point(4, 56)
Me.CH_DOWN_SAVED.Name = "CH_DOWN_SAVED"
Me.CH_DOWN_SAVED.Size = New System.Drawing.Size(226, 19)
Me.CH_DOWN_SAVED.TabIndex = 2
Me.CH_DOWN_SAVED.Text = "Download saved posts"
Me.CH_DOWN_SAVED.UseVisualStyleBackColor = True
'
'AdditionalSettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(234, 103)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteResources.InstagramIcon_32
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(250, 142)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(250, 142)
Me.Name = "AdditionalSettingsForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Additional settings"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents CH_DOWN_TIME As CheckBox
Private WithEvents CH_DOWN_TAG As CheckBox
Private WithEvents CH_DOWN_SAVED As CheckBox
End Class
End Namespace

View File

@@ -0,0 +1,126 @@
<?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>
</root>

View File

@@ -0,0 +1,41 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Namespace API.Instagram
Friend Class AdditionalSettingsForm
Private WithEvents MyDefs As DefaultFormOptions
Friend Property MyParameters As SettingsExchangeOptions
Friend Sub New(ByVal Parameters As SettingsExchangeOptions)
InitializeComponent()
MyParameters = Parameters
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
Private Sub MyForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize(True)
.AddOkCancelToolbar()
With MyParameters
CH_DOWN_TIME.Checked = .DownloadTimeline
CH_DOWN_TAG.Checked = .DownloadStoriesTagged
CH_DOWN_SAVED.Checked = .DownloadSaved
End With
.EndLoaderOperations()
End With
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
MyParameters = New SettingsExchangeOptions With {
.DownloadTimeline = CH_DOWN_TIME.Checked,
.DownloadStoriesTagged = CH_DOWN_TAG.Checked,
.DownloadSaved = CH_DOWN_SAVED.Checked,
.Changed = True
}
MyDefs.CloseForm()
End Sub
End Class
End Namespace

View File

@@ -1,36 +0,0 @@
' Copyright (C) 2022 Andy
' 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 Sections = SCrawler.API.Instagram.UserData.Sections
Namespace API.Instagram
Friend Class AuthNullException : Inherits ArgumentNullException
Public Overrides ReadOnly Property ParamName As String
Public Overrides ReadOnly Property Message As String
Friend Sub New(ByVal s As Sections, ByVal IsSavedPosts As Boolean)
If IsSavedPosts Then
ParamName = "HashSavedPosts"
ElseIf s = Sections.Timeline Then
ParamName = "Hash"
Else
ParamName = "IG_APP_ID, IG_WWW_CLAIM"
End If
Message = $"Instagram auth for [{s}] is not set"
End Sub
Friend Shared Sub ThrowIfNull(ByVal s As Sections, ByVal IsSavedPosts As Boolean, ByVal Host As SiteSettings)
Dim b As Boolean = False
If IsSavedPosts Then
If Not ACheck(Host.HashSavedPosts.Value) Then b = True
ElseIf s = Sections.Timeline Then
If Not ACheck(Host.Hash.Value) Then Host.HashUpdateRequired.Value = True : b = True
Else
If Not Host.StoriesAndTaggedReady Then b = True
End If
If b Then Throw New AuthNullException(s, IsSavedPosts)
End Sub
End Class
End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -10,16 +10,8 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Instagram Namespace API.Instagram
Friend Module Declarations Friend Module Declarations
Friend Const InstagramSite As String = "Instagram" Friend Const InstagramSite As String = "Instagram"
Friend Const InstagramSiteKey As String = "AndyProgram_Instagram"
Friend ReadOnly FilesPattern As RParams = RParams.DMS(".+?([^/\?]+?\.[\w\d]{3,4})(?=(\?|\Z))", 1, EDP.ReturnValue) Friend ReadOnly FilesPattern As RParams = RParams.DMS(".+?([^/\?]+?\.[\w\d]{3,4})(?=(\?|\Z))", 1, EDP.ReturnValue)
Friend ReadOnly Property DateProvider As New JsonDate Friend ReadOnly Property DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v))
Friend Class JsonDate : Implements ICustomProvider
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
Return ADateTime.ParseUnicode(Value)
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("GetFormat is not available in this context")
End Function
End Class
End Module End Module
End Namespace End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -11,10 +11,8 @@ Namespace API.Instagram
Friend Class EditorExchangeOptions Friend Class EditorExchangeOptions
Friend Property GetStories As Boolean Friend Property GetStories As Boolean
Friend Property GetTagged As Boolean Friend Property GetTagged As Boolean
Private ReadOnly Property MySiteSettings As SiteSettings
Friend Sub New(ByVal h As ISiteSettings) Friend Sub New(ByVal h As ISiteSettings)
MySiteSettings = DirectCast(h, SiteSettings) With DirectCast(h, SiteSettings)
With MySiteSettings
GetStories = CBool(.GetStories.Value) GetStories = CBool(.GetStories.Value)
GetTagged = CBool(.GetTagged.Value) GetTagged = CBool(.GetTagged.Value)
End With End With

View File

@@ -1,15 +0,0 @@
' Copyright (C) 2022 Andy
' 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.Instagram
Friend Class ExitException : Inherits Exception
Friend Sub New(ByRef CompleteArg As Boolean)
CompleteArg = True
End Sub
End Class
End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -95,13 +95,13 @@ Namespace API.Instagram
Me.ClientSize = New System.Drawing.Size(260, 78) Me.ClientSize = New System.Drawing.Size(260, 78)
Me.Controls.Add(CONTAINER_MAIN) Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteResources.InstagramIcon_32
Me.KeyPreview = True Me.KeyPreview = True
Me.MaximizeBox = False Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(276, 117) Me.MaximumSize = New System.Drawing.Size(276, 117)
Me.MinimizeBox = False Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(276, 117) Me.MinimumSize = New System.Drawing.Size(276, 117)
Me.Name = "OptionsForm" Me.Name = "OptionsForm"
Me.ShowIcon = False
Me.ShowInTaskbar = False Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Options" Me.Text = "Options"

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -7,22 +7,19 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Namespace API.Instagram Namespace API.Instagram
Friend Class OptionsForm : Implements IOkCancelToolbar Friend Class OptionsForm
Private ReadOnly MyDefs As DefaultFormProps Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property MyExchangeOptions As EditorExchangeOptions Private ReadOnly Property MyExchangeOptions As EditorExchangeOptions
Friend Sub New(ByRef ExchangeOptions As EditorExchangeOptions) Friend Sub New(ByRef ExchangeOptions As EditorExchangeOptions)
InitializeComponent() InitializeComponent()
MyExchangeOptions = ExchangeOptions MyExchangeOptions = ExchangeOptions
MyDefs = New DefaultFormProps MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub End Sub
Private Sub OptionsForm_Load(sender As Object, e As EventArgs) Handles Me.Load Private Sub OptionsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs With MyDefs
.MyViewInitialize(Me, Settings.Design, True) .MyViewInitialize(True)
.AddOkCancelToolbar() .AddOkCancelToolbar()
.DelegateClosingChecker()
.AppendDetectors()
With MyExchangeOptions With MyExchangeOptions
CH_GET_STORIES.Checked = .GetStories CH_GET_STORIES.Checked = .GetStories
CH_GET_TAGGED.Checked = .GetTagged CH_GET_TAGGED.Checked = .GetTagged
@@ -30,15 +27,12 @@ Namespace API.Instagram
.EndLoaderOperations() .EndLoaderOperations()
End With End With
End Sub End Sub
Private Sub OK() Implements IOkCancelToolbar.OK Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With MyExchangeOptions With MyExchangeOptions
.GetStories = CH_GET_STORIES.Checked .GetStories = CH_GET_STORIES.Checked
.GetTagged = CH_GET_TAGGED.Checked .GetTagged = CH_GET_TAGGED.Checked
End With End With
MyDefs.CloseForm() MyDefs.CloseForm()
End Sub End Sub
Private Sub Cancel() Implements IOkCancelToolbar.Cancel
MyDefs.CloseForm(DialogResult.Cancel)
End Sub
End Class End Class
End Namespace End Namespace

View File

@@ -0,0 +1,23 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Instagram
Friend Structure SettingsExchangeOptions
Friend DownloadTimeline As Boolean
Friend DownloadStoriesTagged As Boolean
Friend DownloadSaved As Boolean
Friend Changed As Boolean
Friend Sub New(ByVal Source As SiteSettings)
With Source
DownloadTimeline = .DownloadTimeline
DownloadStoriesTagged = .DownloadStoriesTagged
DownloadSaved = .DownloadSaved
End With
End Sub
End Structure
End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -10,23 +10,23 @@ Imports SCrawler.API.Base
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Instagram Namespace API.Instagram
<Manifest("AndyProgram_Instagram"), UseClassAsIs, SeparatedTasks(1), SavedPosts, SpecialForm(False)> <Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False), SpecialForm(True)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Interface Declarations" #Region "Declarations"
#Region "Images"
Friend Overrides ReadOnly Property Icon As Icon Friend Overrides ReadOnly Property Icon As Icon
Get Get
Return My.Resources.InstagramIcon Return My.Resources.SiteResources.InstagramIcon_32
End Get End Get
End Property End Property
Friend Overrides ReadOnly Property Image As Image Friend Overrides ReadOnly Property Image As Image
Get Get
Return My.Resources.InstagramPic76 Return My.Resources.SiteResources.InstagramPic_76
End Get End Get
End Property End Property
#End Region #End Region
@@ -54,7 +54,7 @@ Namespace API.Instagram
Return Nothing Return Nothing
End Function End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException() Throw New NotImplementedException("[GetFormat] is not available in the context of [TimersChecker]")
End Function End Function
End Class End Class
Private Class TaggedNotifyLimitChecker : Implements IFieldsCheckerProvider Private Class TaggedNotifyLimitChecker : Implements IFieldsCheckerProvider
@@ -72,31 +72,48 @@ Namespace API.Instagram
End If End If
End Function End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException() Throw New NotImplementedException("[GetFormat] is not available in the context of [TaggedNotifyLimitChecker]")
End Function End Function
End Class End Class
#End Region #End Region
#Region "Authorization properties" #Region "Authorization properties"
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)> <PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash", IsAuth:=True, AllowNull:=False), PXML("InstaHash"), ControlNumber(0)>
Friend ReadOnly Property Hash As PropertyValue Friend ReadOnly Property Hash As PropertyValue
<PropertyOption(ControlText:="Hash 2", ControlToolTip:="Instagram session hash for saved posts", IsAuth:=True), PXML("InstaHashSavedPosts"), ControlNumber(1)> Private Const HashSavedPosts_Text As String = "Hash 2"
<PropertyOption(ControlText:=HashSavedPosts_Text, ControlToolTip:="Instagram session hash for saved posts", IsAuth:=True), PXML("InstaHashSavedPosts"), ControlNumber(1)>
Friend ReadOnly Property HashSavedPosts As PropertyValue Friend ReadOnly Property HashSavedPosts As PropertyValue
<PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Instagram token for tagged data", IsAuth:=True), ControlNumber(2)> <PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Instagram token for tagged data", IsAuth:=True, AllowNull:=False), ControlNumber(2)>
Friend ReadOnly Property CSRF_TOKEN As PropertyValue Friend ReadOnly Property CSRF_TOKEN As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True), ControlNumber(3)> <PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3)>
Friend Property IG_APP_ID As PropertyValue Friend Property IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True), ControlNumber(4)> <PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=False), ControlNumber(4)>
Friend Property IG_WWW_CLAIM As PropertyValue Friend Property IG_WWW_CLAIM As PropertyValue
<PropertyOption(ControlText:="Saved posts user", IsAuth:=True), PXML("SavedPostsUserName"), ControlNumber(5)> Private Const SavedPostsUserName_Text As String = "Saved posts user"
<PropertyOption(ControlText:=SavedPostsUserName_Text, IsAuth:=True), PXML("SavedPostsUserName"), ControlNumber(5)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend ReadOnly Property StoriesAndTaggedReady As Boolean Friend Overrides Function BaseAuthExists() As Boolean
Get Return If(Responser.Cookies?.Count, 0) > 0 And ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value)
Return ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value) End Function
End Get Private Const Header_IG_APP_ID As String = "x-ig-app-id"
End Property Private Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Private Const Header_CSRF_TOKEN As String = "x-csrftoken"
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then
Dim f$ = String.Empty
Select Case PropName
Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID
Case NameOf(IG_WWW_CLAIM) : f = Header_IG_WWW_CLAIM
Case NameOf(CSRF_TOKEN) : f = Header_CSRF_TOKEN
End Select
If Not f.IsEmptyString Then
If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
Responser.SaveSettings()
End If
End If
End Sub
#End Region #End Region
#Region "Download properties" #Region "Download properties"
Friend ReadOnly Property HashUpdateRequired As XMLValue(Of Boolean)
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(6)> <PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(6)>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
@@ -120,11 +137,17 @@ Namespace API.Instagram
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)> <Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region #End Region
#Region "Download ready"
Friend ReadOnly Property DownloadTimeline As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadStoriesTagged As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadSaved As XMLValue(Of Boolean)
#End Region
#Region "429 bypass" #Region "429 bypass"
Friend ReadOnly Property DownloadingErrorDate As XMLValue(Of Date) Private ReadOnly Property DownloadingErrorDate As XMLValue(Of Date)
Friend Property LastApplyingValue As Integer? = Nothing Friend Property LastApplyingValue As Integer? = Nothing
Friend ReadOnly Property ReadyForDownload As Boolean Friend ReadOnly Property ReadyForDownload As Boolean
Get Get
If SkipUntilNextSession Then Return False
With DownloadingErrorDate With DownloadingErrorDate
If .ValueF.Exists Then If .ValueF.Exists Then
Return .ValueF.Value.AddMinutes(If(LastApplyingValue, 10)) < Now Return .ValueF.Value.AddMinutes(If(LastApplyingValue, 10)) < Now
@@ -134,8 +157,11 @@ Namespace API.Instagram
End With End With
End Get End Get
End Property End Property
Friend ReadOnly Property LastDownloadDate As XMLValue(Of Date) Private ReadOnly Property LastDownloadDate As XMLValue(Of Date)
Friend ReadOnly Property LastRequestsCount As XMLValue(Of Integer) Private ReadOnly Property LastRequestsCount As XMLValue(Of Integer)
<PropertyOption(IsInformationLabel:=True), ControlNumber(100)>
Private Property LastRequestsCountLabel As PropertyValue
Private ReadOnly LastRequestsCountLabelStr As Func(Of Integer, String) = Function(r) $"Number of spent requests: {r.NumToGroupIntegral}"
Private TooManyRequestsReadyForCatch As Boolean = True Private TooManyRequestsReadyForCatch As Boolean = True
Friend Function GetWaitDate() As Date Friend Function GetWaitDate() As Date
With DownloadingErrorDate With DownloadingErrorDate
@@ -165,26 +191,26 @@ Namespace API.Instagram
End With End With
End Sub End Sub
#End Region #End Region
Friend Overrides ReadOnly Property Responser As WEB.Response #End Region
#Region "Initializer"
Friend Sub New(ByRef _XML As XmlFile, ByVal GlobalPath As SFile) Friend Sub New(ByRef _XML As XmlFile, ByVal GlobalPath As SFile)
MyBase.New(InstagramSite) MyBase.New(InstagramSite, "instagram.com")
Responser = New WEB.Response($"{SettingsFolderName}\Responser_{Site}.xml")
Dim app_id$ = String.Empty Dim app_id$ = String.Empty
Dim www_claim$ = String.Empty Dim www_claim$ = String.Empty
Dim token$ = String.Empty Dim token$ = String.Empty
With Responser With Responser
If .File.Exists Then If .Headers.Count > 0 Then
.LoadSettings()
With .Headers With .Headers
If .ContainsKey(Header_CSRF_TOKEN) Then token = .Item(Header_CSRF_TOKEN) If .ContainsKey(Header_CSRF_TOKEN) Then token = .Item(Header_CSRF_TOKEN)
If .ContainsKey(Header_IG_APP_ID) Then app_id = .Item(Header_IG_APP_ID) If .ContainsKey(Header_IG_APP_ID) Then app_id = .Item(Header_IG_APP_ID)
If .ContainsKey(Header_IG_WWW_CLAIM) Then www_claim = .Item(Header_IG_WWW_CLAIM) If .ContainsKey(Header_IG_WWW_CLAIM) Then www_claim = .Item(Header_IG_WWW_CLAIM)
End With End With
Else End If
.CookiesDomain = "instagram.com" If Not .Cookies Is Nothing Then
.SaveSettings() .Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False
End If End If
End With End With
@@ -192,13 +218,16 @@ Namespace API.Instagram
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String)) SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
HashUpdateRequired = New XMLValue(Of Boolean)("InstaHashUpdateRequired", True, _XML, n)
Hash = New PropertyValue(String.Empty, GetType(String)) Hash = New PropertyValue(String.Empty, GetType(String))
HashSavedPosts = New PropertyValue(String.Empty, GetType(String)) HashSavedPosts = New PropertyValue(String.Empty, GetType(String))
CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(CSRF_TOKEN), v)) CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(CSRF_TOKEN), v))
IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_APP_ID), v)) IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_APP_ID), v))
IG_WWW_CLAIM = New PropertyValue(www_claim, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_WWW_CLAIM), v)) IG_WWW_CLAIM = New PropertyValue(www_claim, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_WWW_CLAIM), v))
DownloadTimeline = New XMLValue(Of Boolean)("DownloadTimeline", True, _XML, n)
DownloadStoriesTagged = New XMLValue(Of Boolean)("DownloadStoriesTagged", True, _XML, n)
DownloadSaved = New XMLValue(Of Boolean)("DownloadSaved", True, _XML, n)
RequestsWaitTimer = New PropertyValue(1000) RequestsWaitTimer = New PropertyValue(1000)
RequestsWaitTimerProvider = New TimersChecker(100) RequestsWaitTimerProvider = New TimersChecker(100)
RequestsWaitTimerTaskCount = New PropertyValue(1) RequestsWaitTimerTaskCount = New PropertyValue(1)
@@ -211,44 +240,76 @@ Namespace API.Instagram
TaggedNotifyLimit = New PropertyValue(200) TaggedNotifyLimit = New PropertyValue(200)
TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
DownloadingErrorDate = New XMLValue(Of Date) With { DownloadingErrorDate = New XMLValue(Of Date) With {.Provider = New XMLValueConversionProvider(Function(ss, vv) AConvert(Of String)(vv, AModes.Var, Nothing))}
.Provider = New XMLValueConversionProvider(Function(ss, vv) AConvert(Of String)(vv, AModes.Var, Nothing))}
DownloadingErrorDate.SetExtended("InstagramDownloadingErrorDate", Now.AddYears(-10), _XML, n) DownloadingErrorDate.SetExtended("InstagramDownloadingErrorDate", Now.AddYears(-10), _XML, n)
LastDownloadDate = New XMLValue(Of Date)("LastDownloadDate", Now.AddDays(-1), _XML, n) LastDownloadDate = New XMLValue(Of Date)("LastDownloadDate", Now.AddDays(-1), _XML, n)
LastRequestsCount = New XMLValue(Of Integer)("LastRequestsCount", 0, _XML, n) LastRequestsCount = New XMLValue(Of Integer)("LastRequestsCount", 0, _XML, n)
LastRequestsCountLabel = New PropertyValue(LastRequestsCountLabelStr.Invoke(LastRequestsCount.Value))
AddHandler LastRequestsCount.OnValueChanged, Sub(sender, __name, __value) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(DirectCast(__value, Existable(Of Integer)).Value)
UrlPatternUser = "https://www.instagram.com/{0}/" UrlPatternUser = "https://www.instagram.com/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?instagram.com/([^/]+)", 1) UserRegex = RParams.DMS("[htps:/]{7,8}.*?instagram.com/([^/]+)", 1)
ImageVideoContains = "instagram.com" ImageVideoContains = "instagram.com"
End Sub End Sub
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider Private Structure LatestValues
Select Case What Friend Hash As String
Case Download.Main : Return New UserData Friend Hash2 As String
Case Download.SavedPosts Friend Token As String
Dim u As New UserData Friend AppID As String
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))} Friend WwwClaim As String
Return u Friend Exists As Boolean
End Select Friend Sub New(ByVal Source As SiteSettings)
Return Nothing Exists = True
End Function With Source
Private Const Header_IG_APP_ID As String = "x-ig-app-id" Hash = AConvert(Of String)(.Hash.Value, String.Empty)
Private Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim" Hash2 = AConvert(Of String)(.HashSavedPosts.Value, String.Empty)
Private Const Header_CSRF_TOKEN As String = "x-csrftoken" With .Responser.Headers
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object) If .ContainsKey(Header_CSRF_TOKEN) Then Token = .Item(Header_CSRF_TOKEN)
If Not PropName.IsEmptyString Then If .ContainsKey(Header_IG_APP_ID) Then AppID = .Item(Header_IG_APP_ID)
Dim f$ = String.Empty If .ContainsKey(Header_IG_WWW_CLAIM) Then WwwClaim = .Item(Header_IG_WWW_CLAIM)
Select Case PropName End With
Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID End With
Case NameOf(IG_WWW_CLAIM) : f = Header_IG_WWW_CLAIM
Case NameOf(CSRF_TOKEN) : f = Header_CSRF_TOKEN
End Select
If Not f.IsEmptyString Then
If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
Responser.SaveSettings()
End If
End If
End Sub End Sub
End Structure
Private LV As LatestValues = Nothing
Private ASO As SettingsExchangeOptions = Nothing
Friend Overrides Sub BeginEdit()
LV = New LatestValues(Me)
ASO = Nothing
MyBase.BeginEdit()
End Sub
Friend Overrides Sub EndEdit()
LV = Nothing
ASO = Nothing
MyBase.EndEdit()
End Sub
Friend Overrides Sub Update()
If LV.Exists Then
Dim __lv As New LatestValues(Me)
If If(Responser.Cookies?.Count, 0) > 0 Then
Dim _cookiesChanged As Boolean = If(Responser.Cookies?.Changed, False)
If Not DownloadTimeline AndAlso (_cookiesChanged Or
(Not LV.Hash = __lv.Hash And Not __lv.Hash.IsEmptyString)) Then DownloadTimeline.Value = True
If Not DownloadSaved AndAlso (_cookiesChanged Or (Not LV.Hash2 = __lv.Hash2 And Not __lv.Hash2.IsEmptyString)) Then DownloadSaved.Value = True
If Not DownloadStoriesTagged AndAlso (
_cookiesChanged Or (
(Not LV.Hash = __lv.Hash Or Not LV.Token = __lv.Token Or Not LV.AppID = __lv.AppID Or Not LV.WwwClaim = __lv.WwwClaim) And
(Not __lv.Hash.IsEmptyString And Not __lv.Token.IsEmptyString And Not __lv.AppID.IsEmptyString And Not __lv.WwwClaim.IsEmptyString)
)) Then DownloadStoriesTagged.Value = True
End If
End If
If ASO.Changed Then
DownloadTimeline.Value = ASO.DownloadTimeline
DownloadStoriesTagged.Value = ASO.DownloadStoriesTagged
DownloadSaved.Value = ASO.DownloadSaved
End If
LV = Nothing
ASO = Nothing
If Not Responser.Cookies Is Nothing Then Responser.Cookies.Changed = False
MyBase.Update()
End Sub
#End Region
#Region "PropertiesDataChecker"
<PropertiesDataChecker({NameOf(Hash), NameOf(HashSavedPosts)})> <PropertiesDataChecker({NameOf(Hash), NameOf(HashSavedPosts)})>
Private Function CheckHashControls(ByVal p As IEnumerable(Of PropertyData)) As Boolean Private Function CheckHashControls(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists(2) Then If p.ListExists(2) Then
@@ -292,20 +353,64 @@ Namespace API.Instagram
End If End If
Return False Return False
End Function End Function
Friend Overrides Sub BeginInit() <PropertiesDataChecker({NameOf(HashSavedPosts), NameOf(SavedPostsUserName)})>
End Sub Private Function CheckSavedOptions(ByVal p As IEnumerable(Of PropertyData)) As Boolean
Friend Overrides Sub EndInit() If p.ListExists Then
If (CStr(Hash.Value).IsEmptyString Or HashUpdateRequired) AndAlso Responser.Cookies.ListExists Then GatherInstaHash() Const MsgTitle$ = "Saved posts credentials"
End Sub Dim __hash$ = String.Empty
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean Dim __name$ = String.Empty
Return ActiveJobs < 2 AndAlso ReadyForDownload Dim _OptionlErrorText$ = $"For download saved posts, you must to set both [{HashSavedPosts_Text}] and [{SavedPostsUserName_Text}]."
For i% = 0 To p.Count - 1
Select Case p(i).Name
Case NameOf(HashSavedPosts) : __hash = p(i).Value
Case NameOf(SavedPostsUserName) : __name = p(i).Value
End Select
Next
If __hash = __name Then
If __hash.IsEmptyString Then
Return True
Else
MsgBoxE({$"[{HashSavedPosts_Text}] and [{SavedPostsUserName_Text}] for saved posts cannot be equal!", MsgTitle}, vbCritical)
End If
Else
If __hash.IsEmptyString Then
MsgBoxE({$"[{HashSavedPosts_Text}] not set.{vbCr}{_OptionlErrorText}", MsgTitle}, vbCritical)
ElseIf __name.IsEmptyString Then
MsgBoxE({$"[{SavedPostsUserName_Text}] not set.{vbCr}{_OptionlErrorText}", MsgTitle}, vbCritical)
Else
Return True
End If
End If
End If
Return False
End Function
#End Region
#Region "Plugin functions"
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
Select Case What
Case Download.Main : Return New UserData
Case Download.SavedPosts
Dim u As New UserData
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}
Return u
End Select
Return Nothing
End Function End Function
#Region "Downloading" #Region "Downloading"
Friend Property SkipUntilNextSession As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() Then
Select Case What
Case Download.Main : Return ACheck(Hash.Value) And DownloadTimeline
Case Download.SavedPosts : Return ACheck(HashSavedPosts.Value) And DownloadSaved
End Select
End If
Return False
End Function
Private ActiveJobs As Integer = 0 Private ActiveJobs As Integer = 0
Private _NextWNM As UserData.WNM = UserData.WNM.Notify Private _NextWNM As UserData.WNM = UserData.WNM.Notify
Private _NextTagged As Boolean = True Private _NextTagged As Boolean = True
Friend Overrides Sub DownloadStarted(ByVal What As Download) Friend Overrides Sub DownloadStarted(ByVal What As Download)
If CStr(Hash.Value).IsEmptyString Or HashUpdateRequired Then GatherInstaHash()
ActiveJobs += 1 ActiveJobs += 1
End Sub End Sub
Friend Overrides Sub BeforeStartDownload(ByVal User As Object, ByVal What As Download) Friend Overrides Sub BeforeStartDownload(ByVal User As Object, ByVal What As Download)
@@ -336,42 +441,11 @@ Namespace API.Instagram
_NextTagged = True _NextTagged = True
LastDownloadDate.Value = Now LastDownloadDate.Value = Now
ActiveJobs -= 1 ActiveJobs -= 1
If HashUpdateRequired Then MyMainLOG = "Check your Instagram credentials" SkipUntilNextSession = False
End Sub End Sub
#End Region #End Region
<PropertyUpdater(NameOf(Hash))> Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
Friend Function GatherInstaHash() As Boolean Return UserData.GetVideoInfo(URL, Responser)
Try
If Not Responser.Cookies.ListExists Then Throw New Exception("Instagram cookies does not set")
Dim rs As New RParams("preload"" href=""(https://static.cdninstagram.com/rsrc.php/[^""]+?.js[^""]*)""", Nothing, 1, RegexReturn.List) With {.MatchTimeOut = 10}
Dim h$
Dim r$ = Responser.GetResponse("https://www.instagram.com",, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim JsUrls As List(Of String) = RegexReplace(r, rs)
If JsUrls.ListExists Then
rs = New RParams("\{.+?var h=""([\w\d\S]+?)"".+?\)\.generatePaginationActionCreators", Nothing, 1) With {.MatchTimeOut = 10}
For Each url$ In JsUrls
r = Responser.GetResponse(url,, EDP.ReturnValue)
If Not r.IsEmptyString Then
h = RegexReplace(r, rs)
If Not h.IsEmptyString AndAlso h.Length > 30 Then
Hash.Value = h
HashUpdateRequired.Value = False
Return True
End If
End If
Next
End If
End If
Return False
Catch ex As Exception
HashUpdateRequired.Value = True
Hash.Value = String.Empty
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[SiteSettings.GaterInstaHash]", False)
End Try
End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return UserData.GetVideoInfo(URL, Responser, Me)
End Function End Function
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is EditorExchangeOptions Then Options = New EditorExchangeOptions(Me) If Options Is Nothing OrElse Not TypeOf Options Is EditorExchangeOptions Then Options = New EditorExchangeOptions(Me)
@@ -379,5 +453,12 @@ Namespace API.Instagram
Using f As New OptionsForm(Options) : f.ShowDialog() : End Using Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If End If
End Sub End Sub
Friend Overrides Sub OpenSettingsForm()
Using f As New AdditionalSettingsForm(If(ASO.Changed, ASO, New SettingsExchangeOptions(Me)))
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then ASO = f.MyParameters
End Using
End Sub
#End Region
End Class End Class
End Namespace End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -6,24 +6,25 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Net
Imports System.Threading
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.Messaging Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports System.Threading
Imports System.Net
Imports System.Reflection
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Instagram Namespace API.Instagram
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
Private Const MaxPostsCount As Integer = 200 #Region "XML Names"
Private Const Name_LastCursor As String = "LastCursor" Private Const Name_LastCursor As String = "LastCursor"
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone" Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
Private Const Name_GetStories As String = "GetStories" Private Const Name_GetStories As String = "GetStories"
Private Const Name_GetTagged As String = "GetTaggedData" Private Const Name_GetTagged As String = "GetTaggedData"
Private Const Name_TaggedChecked As String = "TaggedChecked" Private Const Name_TaggedChecked As String = "TaggedChecked"
#End Region
#Region "Declarations"
Private ReadOnly Property MySiteSettings As SiteSettings Private ReadOnly Property MySiteSettings As SiteSettings
Get Get
Return DirectCast(HOST.Source, SiteSettings) Return DirectCast(HOST.Source, SiteSettings)
@@ -34,6 +35,8 @@ Namespace API.Instagram
Private FirstLoadingDone As Boolean = False Private FirstLoadingDone As Boolean = False
Friend Property GetStories As Boolean Friend Property GetStories As Boolean
Friend Property GetTaggedData As Boolean Friend Property GetTaggedData As Boolean
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptions(HOST.Source) With {.GetStories = GetStories, .GetTagged = GetTaggedData} Return New EditorExchangeOptions(HOST.Source) With {.GetStories = GetStories, .GetTagged = GetTaggedData}
End Function End Function
@@ -45,6 +48,8 @@ Namespace API.Instagram
End With End With
End If End If
End Sub End Sub
#End Region
#Region "Initializer, loader"
Friend Sub New() Friend Sub New()
End Sub End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
@@ -62,44 +67,64 @@ Namespace API.Instagram
Container.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger) Container.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
End If End If
End Sub End Sub
#End Region
#Region "Download data" #Region "Download data"
Private E560Thrown As Boolean = False
Private Class ExitException : Inherits Exception
Friend Shared Sub Throw560(ByRef Source As UserData)
If Not Source.E560Thrown Then
MyMainLOG = $"{Source.ToStringForLog}: (560) Download skipped until next session"
Source.E560Thrown = True
End If
Throw New ExitException
End Sub
Friend Sub New()
End Sub
Friend Sub New(ByRef CompleteArg As Boolean)
CompleteArg = True
End Sub
End Class
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim s As Sections = Sections.Timeline
Try Try
ThrowAny(Token)
_InstaHash = String.Empty _InstaHash = String.Empty
HasError = False HasError = False
If Not LastCursor.IsEmptyString Then Dim fc As Boolean = IIf(IsSavedPosts, MySiteSettings.DownloadSaved.Value, MySiteSettings.DownloadTimeline.Value)
DownloadData(LastCursor, Sections.Timeline, Token) If fc And Not LastCursor.IsEmptyString Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(LastCursor, s, Token)
ThrowAny(Token) ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True If Not HasError Then FirstLoadingDone = True
End If End If
If Not HasError Then If fc And Not HasError Then
DownloadData(String.Empty, Sections.Timeline, Token) s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(String.Empty, s, Token)
ThrowAny(Token) ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True If Not HasError Then FirstLoadingDone = True
End If End If
If FirstLoadingDone Then LastCursor = String.Empty If FirstLoadingDone Then LastCursor = String.Empty
If IsSavedPosts Then If IsSavedPosts Then
DownloadPosts(Token) If MySiteSettings.DownloadSaved Then s = Sections.SavedPosts : DownloadPosts(Token)
ElseIf MySiteSettings.StoriesAndTaggedReady Then ElseIf MySiteSettings.BaseAuthExists() Then
DownloadedTags = 0 DownloadedTags = 0
If GetStories Then DownloadData(String.Empty, Sections.Stories, Token) If MySiteSettings.DownloadStoriesTagged And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token)
If GetTaggedData Then DownloadData(String.Empty, Sections.Tagged, Token) If MySiteSettings.DownloadStoriesTagged And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token)
End If End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
Catch eex As ExitException Catch eex As ExitException
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, "[API.Instagram.UserData.DownloadDataF", False) ProcessException(ex, Token, "[API.Instagram.UserData.DownloadDataF]", False, s)
Finally
E560Thrown = False
End Try End Try
End Sub End Sub
Private _InstaHash As String = String.Empty Private _InstaHash As String = String.Empty
Friend Enum Sections Private Enum Sections : Timeline : Tagged : Stories : SavedPosts : End Enum
Timeline
Tagged
Stories
End Enum
Private Const StoriesFolder As String = "Stories" Private Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged" Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass" #Region "429 bypass"
Private Const MaxPostsCount As Integer = 200
Friend Property RequestsCount As Integer = 0 Friend Property RequestsCount As Integer = 0
Friend Enum WNM As Integer Friend Enum WNM As Integer
Notify = 0 Notify = 0
@@ -174,7 +199,7 @@ Namespace API.Instagram
Dim m As New MMessage("You have not entered a valid posts limit", "Tagged posts download limit", {tryBtt, selectBtt, cancelBtt}) Dim m As New MMessage("You have not entered a valid posts limit", "Tagged posts download limit", {tryBtt, selectBtt, cancelBtt})
Dim mh As New MMessage("", "Tagged posts download limit", {"Confirm", tryBtt, selectBtt, cancelBtt}) With {.ButtonsPerRow = 2} Dim mh As New MMessage("", "Tagged posts download limit", {"Confirm", tryBtt, selectBtt, cancelBtt}) With {.ButtonsPerRow = 2}
Do Do
v = AConvert(Of Integer)(InputBoxE(aStr, "Tagged posts download limit", CInt(MySiteSettings.TaggedNotifyLimit.Value)), Nothing) v = AConvert(Of Integer)(InputBoxE(aStr, "Tagged posts download limit", CInt(MySiteSettings.TaggedNotifyLimit.Value)), AModes.Var, Nothing)
If v.HasValue Then If v.HasValue Then
mh.Text = $"You have entered a limit of {v.Value.NumToString(p)} posts" mh.Text = $"You have entered a limit of {v.Value.NumToString(p)} posts"
Select Case MsgBoxE(mh).Index Select Case MsgBoxE(mh).Index
@@ -238,6 +263,7 @@ Namespace API.Instagram
Try Try
Dim n As EContainer, nn As EContainer, node As EContainer Dim n As EContainer, nn As EContainer, node As EContainer
Dim HasNextPage As Boolean = False Dim HasNextPage As Boolean = False
Dim Pinned As Boolean
Dim EndCursor$ = String.Empty Dim EndCursor$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty
Dim TaggedCount% Dim TaggedCount%
@@ -247,13 +273,12 @@ Namespace API.Instagram
'Check environment 'Check environment
If Cursor.IsEmptyString And _InstaHash.IsEmptyString Then _ If Cursor.IsEmptyString And _InstaHash.IsEmptyString Then _
_InstaHash = CStr(If(IsSavedPosts, MySiteSettings.HashSavedPosts, MySiteSettings.Hash).Value) _InstaHash = CStr(If(IsSavedPosts, MySiteSettings.HashSavedPosts, MySiteSettings.Hash).Value)
AuthNullException.ThrowIfNull(Section, IsSavedPosts, MySiteSettings)
If ID.IsEmptyString Then GetUserId() If ID.IsEmptyString Then GetUserId()
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID") If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
'Create query 'Create query
Select Case Section Select Case Section
Case Sections.Timeline Case Sections.Timeline, Sections.SavedPosts
Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}" Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}"
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars) vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)
URL = $"https://www.instagram.com/graphql/query/?query_hash={_InstaHash}&variables={vars}" URL = $"https://www.instagram.com/graphql/query/?query_hash={_InstaHash}&variables={vars}"
@@ -288,13 +313,13 @@ Namespace API.Instagram
RequestsCount += 1 RequestsCount += 1
ThrowAny(Token) ThrowAny(Token)
'Data 'Parsing
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
n = j.ItemF(ENode).XmlIfNothing n = j.ItemF(ENode).XmlIfNothing
If n.Count > 0 Then If n.Count > 0 Then
Select Case Section Select Case Section
Case Sections.Timeline Case Sections.Timeline, Sections.SavedPosts
If n.Contains("page_info") Then If n.Contains("page_info") Then
With n("page_info") With n("page_info")
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False) HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
@@ -308,15 +333,20 @@ Namespace API.Instagram
node = nn(0).XmlIfNothing node = nn(0).XmlIfNothing
If IsSavedPosts Then If IsSavedPosts Then
PostID = node.Value("shortcode") PostID = node.Value("shortcode")
If Not PostID.IsEmptyString Then If Not PostID.IsEmptyString AndAlso _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
If _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete) Else _SavedPostsIDs.Add(PostID)
End If End If
Else
PostID = node.Value("id") PostID = node.Value("id")
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete) Pinned = CBool(If(node("pinned_for_users")?.Count, 0))
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) And Not Pinned Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID) _TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp") PostDate = node.Value("taken_at_timestamp")
If Not CheckDatesLimit(PostDate, DateProvider) Then Throw New ExitException(_DownloadComplete) If IsSavedPosts Then
_SavedPostsIDs.Add(PostID)
Else
Select Case CheckDatesLimit(PostDate, DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : If Not Pinned Then Throw New ExitException(_DownloadComplete)
End Select
ObtainMedia(node, PostID, PostDate, SpecFolder) ObtainMedia(node, PostID, PostDate, SpecFolder)
End If End If
Next Next
@@ -330,8 +360,7 @@ Namespace API.Instagram
_TempPostsList.Add(PostID) _TempPostsList.Add(PostID)
ObtainMedia2(nn, PostID, SpecFolder) ObtainMedia2(nn, PostID, SpecFolder)
DownloadedTags += 1 DownloadedTags += 1
If DownloadTagsLimit.HasValue AndAlso DownloadedTags >= DownloadTagsLimit.Value Then _ If DownloadTagsLimit.HasValue AndAlso DownloadedTags >= DownloadTagsLimit.Value Then Throw New ExitException(_DownloadComplete)
Throw New ExitException(_DownloadComplete)
Next Next
If TaggedLimitsNotifications Then If TaggedLimitsNotifications Then
TaggedCount = j.Value("total_count").FromXML(Of Integer)(0) TaggedCount = j.Value("total_count").FromXML(Of Integer)(0)
@@ -351,9 +380,6 @@ Namespace API.Instagram
End If End If
_DownloadComplete = True _DownloadComplete = True
If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Section, Token) If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Section, Token)
Catch iane As AuthNullException
ErrorsDescriber.Execute(EDP.SendInLog, iane)
Throw New ExitException(_DownloadComplete)
Catch eex As ExitException Catch eex As ExitException
Throw eex Throw eex
Catch oex As OperationCanceledException When Token.IsCancellationRequested Catch oex As OperationCanceledException When Token.IsCancellationRequested
@@ -361,7 +387,7 @@ Namespace API.Instagram
Catch dex As ObjectDisposedException When Disposed Catch dex As ObjectDisposedException When Disposed
Exit Do Exit Do
Catch ex As Exception Catch ex As Exception
If DownloadingException(ex, $"data downloading error [{URL}]", Section, False) = 1 Then Continue Do Else Exit Do If DownloadingException(ex, $"data downloading error [{URL}]", False, Section) = 1 Then Continue Do Else Exit Do
End Try End Try
Loop Loop
Catch eex2 As ExitException Catch eex2 As ExitException
@@ -369,7 +395,7 @@ Namespace API.Instagram
Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted
If oex2.HelpLink = InstAborted Then HasError = True If oex2.HelpLink = InstAborted Then HasError = True
Catch DoEx As Exception Catch DoEx As Exception
ProcessException(DoEx, Token, $"data downloading error [{URL}]") ProcessException(DoEx, Token, $"data downloading error [{URL}]",, Section)
End Try End Try
End Sub End Sub
Private Sub DownloadPosts(ByVal Token As CancellationToken) Private Sub DownloadPosts(ByVal Token As CancellationToken)
@@ -390,7 +416,8 @@ Namespace API.Instagram
Dim e As New ErrorsDescriber(EDP.ThrowException) Dim e As New ErrorsDescriber(EDP.ThrowException)
For i% = _Index To _SavedPostsIDs.Count - 1 For i% = _Index To _SavedPostsIDs.Count - 1
_Index = i _Index = i
URL = $"https://instagram.com/p/{_SavedPostsIDs(i)}/?__a=1" 'URL = $"https://instagram.com/p/{_SavedPostsIDs(i)}/?__a=1"
URL = $"https://i.instagram.com/api/v1/media/{_SavedPostsIDs(i)}/info/"
ThrowAny(Token) ThrowAny(Token)
NextRequest(((i + 1) Mod 5) = 0) NextRequest(((i + 1) Mod 5) = 0)
ThrowAny(Token) ThrowAny(Token)
@@ -419,21 +446,44 @@ Namespace API.Instagram
Next Next
End If End If
_DownloadComplete = True _DownloadComplete = True
Catch eex As ExitException
Throw eex
Catch oex As OperationCanceledException When Token.IsCancellationRequested Catch oex As OperationCanceledException When Token.IsCancellationRequested
Exit Do Exit Do
Catch dex As ObjectDisposedException When Disposed Catch dex As ObjectDisposedException When Disposed
Exit Do Exit Do
Catch ex As Exception Catch ex As Exception
If DownloadingException(ex, $"downloading saved posts error [{URL}]") = 1 Then Continue Do Else Exit Do If DownloadingException(ex, $"downloading saved posts error [{URL}]", False, Sections.SavedPosts) = 1 Then Continue Do Else Exit Do
End Try End Try
Loop Loop
Catch eex2 As ExitException
Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted
If oex2.HelpLink = InstAborted Then HasError = True If oex2.HelpLink = InstAborted Then HasError = True
Catch DoEx As Exception Catch DoEx As Exception
ProcessException(DoEx, Token, $"downloading saved posts error [{URL}]") ProcessException(DoEx, Token, $"downloading saved posts error [{URL}]",, Sections.SavedPosts)
End Try End Try
End Sub End Sub
#End Region #End Region
#Region "Code ID converters"
Private Shared Function CodeToID(ByVal Code As String) As String
Const CodeSymbols$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
Try
If Not Code.IsEmptyString Then
Dim c As Char
Dim id& = 0
For i% = 0 To Code.Length - 1
c = Code(i)
id = (id * 64) + CodeSymbols.IndexOf(c)
Next
Return id
Else
Return String.Empty
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.Instagram.UserData.CodeToID({Code})", String.Empty)
End Try
End Function
#End Region
#Region "Obtain Media" #Region "Obtain Media"
Private Sub ObtainMedia(ByVal node As EContainer, ByVal PostID As String, ByVal PostDate As String, ByVal SpecFolder As String) Private Sub ObtainMedia(ByVal node As EContainer, ByVal PostID As String, ByVal PostDate As String, ByVal SpecFolder As String)
Dim CreateMedia As Action(Of EContainer) = Dim CreateMedia As Action(Of EContainer) =
@@ -536,7 +586,8 @@ Namespace API.Instagram
End Try End Try
End Sub End Sub
#End Region #End Region
Private Sub GetUserId() #Region "GetUserId"
<Obsolete> Private Sub GetUserId_Old()
Try Try
Dim r$ = Responser.GetResponse($"https://www.instagram.com/{Name}/?__a=1",, EDP.ThrowException) Dim r$ = Responser.GetResponse($"https://www.instagram.com/{Name}/?__a=1",, EDP.ThrowException)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -552,6 +603,23 @@ Namespace API.Instagram
End If End If
End Try End Try
End Sub End Sub
Private Sub GetUserId()
Try
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/users/web_profile_info/?username={Name}",, EDP.ThrowException)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
ID = j({"data", "user"}, "id").XmlIfNothingValue
End Using
End If
Catch ex As Exception
If Responser.StatusCode = HttpStatusCode.NotFound Or Responser.StatusCode = HttpStatusCode.BadRequest Then
Throw ex
Else
LogError(ex, "get Instagram user id")
End If
End Try
End Sub
#End Region
#Region "Pinned stories" #Region "Pinned stories"
Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken) Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken)
Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}" Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}"
@@ -607,30 +675,35 @@ Namespace API.Instagram
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
DownloadingException(ex, "API.Instagram.GetStoriesList", Sections.Stories, False) DownloadingException(ex, "API.Instagram.GetStoriesList", False, Sections.Stories)
Return Nothing Return Nothing
End Try End Try
End Function End Function
#End Region #End Region
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken) #Region "Download content"
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
#End Region
#Region "Exceptions"
''' <exception cref="ExitException"></exception>
''' <inheritdoc cref="UserDataBase.ThrowAny(CancellationToken)"/>
Friend Overrides Sub ThrowAny(ByVal Token As CancellationToken)
If MySiteSettings.SkipUntilNextSession Then ExitException.Throw560(Me)
MyBase.ThrowAny(Token)
End Sub
''' <summary> ''' <summary>
''' <inheritdoc cref="UserDataBase.DownloadingException(Exception, String)"/><br/> ''' <inheritdoc cref="UserDataBase.DownloadingException(Exception, String, Boolean, Object)"/><br/>
''' 1 - continue ''' 1 - continue
''' </summary> ''' </summary>
Protected Overloads Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Return DownloadingException(ex, Message, Sections.Timeline, FromPE) Optional ByVal s As Object = Nothing) As Integer
End Function
Private Overloads Function DownloadingException(ByVal ex As Exception, ByVal Message As String, ByVal s As Sections, ByVal FromPE As Boolean) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
HasError = True HasError = True
MyMainLOG = $"Instagram credentials have expired: {ToString()} [{s}]" MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
MySiteSettings.HashUpdateRequired.Value = True DisableSection(s)
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then
Return 3 Return 3
ElseIf Responser.StatusCode = 429 Then ElseIf Responser.StatusCode = 429 Then
@@ -642,14 +715,29 @@ Namespace API.Instagram
Caught429 = True Caught429 = True
MyMainLOG = $"Number of requests before error 429: {RequestsCount}" MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1 Return 1
ElseIf Responser.StatusCode = 560 Then
MySiteSettings.SkipUntilNextSession = True
Else Else
MySiteSettings.HashUpdateRequired.Value = True MyMainLOG = $"Instagram hash requested [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
MyMainLOG = $"Instagram hash requested: {ToString()} [{s}]" DisableSection(s)
If Not FromPE Then LogError(ex, Message) : HasError = True If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0 Return 0
End If End If
Return 2 Return 2
End Function End Function
Private Sub DisableSection(ByVal Section As Object)
If Not IsNothing(Section) AndAlso TypeOf Section Is Sections Then
Dim s As Sections = DirectCast(Section, Sections)
Select Case s
Case Sections.Timeline : MySiteSettings.DownloadTimeline.Value = False
Case Sections.SavedPosts : MySiteSettings.DownloadSaved.Value = False
Case Else : MySiteSettings.DownloadStoriesTagged.Value = False
End Select
MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper
End If
End Sub
#End Region
#Region "Create media"
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String, Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal SpecialFolder As String = Nothing) As UserMedia Optional ByVal SpecialFolder As String = Nothing) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern)) _URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
@@ -659,13 +747,16 @@ Namespace API.Instagram
m.SpecialFolder = SpecialFolder m.SpecialFolder = SpecialFolder
Return m Return m
End Function End Function
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal r As Response, ByVal _Settings As SiteSettings) As IEnumerable(Of UserMedia) #End Region
#Region "Standalone downloader"
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal r As Response) As IEnumerable(Of UserMedia)
Try Try
If Not URL.IsEmptyString AndAlso URL.Contains("instagram.com") Then If Not URL.IsEmptyString AndAlso URL.Contains("instagram.com") Then
Dim PID$ = RegexReplace(URL, RParams.DMS(".*?instagram.com/p/([_\w\d]+)", 1)) Dim PID$ = RegexReplace(URL, RParams.DMS(".*?instagram.com/p/([_\w\d]+)", 1))
If Not PID.IsEmptyString AndAlso Not ACheck(Of Long)(PID) Then PID = CodeToID(PID)
If Not PID.IsEmptyString Then If Not PID.IsEmptyString Then
Using t As New UserData Using t As New UserData
t.SetEnvironment(Settings(_Settings.GetType.GetCustomAttribute(Of Plugin.Attributes.Manifest)().GUID), Nothing, False, False) t.SetEnvironment(Settings(InstagramSiteKey), Nothing, False, False)
t.Responser = New Response t.Responser = New Response
t.Responser.Copy(r) t.Responser.Copy(r)
t._SavedPostsIDs.Add(PID) t._SavedPostsIDs.Add(PID)
@@ -676,12 +767,15 @@ Namespace API.Instagram
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Instagram standalone downloader: fetch media error") Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, $"Instagram standalone downloader: fetch media error ({URL})")
End Try End Try
End Function End Function
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _SavedPostsIDs.Clear() If Not disposedValue And disposing Then _SavedPostsIDs.Clear()
MyBase.Dispose(disposing) MyBase.Dispose(disposing)
End Sub End Sub
#End Region
End Class End Class
End Namespace End Namespace

View File

@@ -0,0 +1,37 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.LPSG
Friend Module Declarations
Friend ReadOnly Property PhotoRegEx As RParams = RParams.DM("(https://www.lpsg.com/attachments)(.+?)(?="")", 0, RegexReturn.List)
Friend ReadOnly Property PhotoRegExExt As New RParams("img.data.src=""(/proxy[^""]+?)""", Nothing, 1, RegexReturn.List) With {
.Converter = Function(Input) $"https://www.lpsg.com/{SymbolsConverter.HTML.Decode(Input)}"}
Friend ReadOnly Property NextPageRegex As RParams = RParams.DMS("<link rel=""next"" href=""(.+?/page-(\d+))""", 2)
Private Const FileUrlRegexDefault As String = "([^/]+?)(jpg|jpeg|gif|png|webm)"
Private ReadOnly InputFReplacer As New ErrorsDescriber(EDP.ReturnValue)
Private ReadOnly InputForbidRemover As Func(Of String, String) = Function(Input) If(Input.IsEmptyString, Input, Input.StringRemoveWinForbiddenSymbols(, InputFReplacer))
Friend ReadOnly Property FileRegEx As New RParams(FileUrlRegexDefault, Nothing, 0) With {
.Converter = Function(ByVal Input As String) As String
Input = InputForbidRemover.Invoke(Input)
If Not Input.IsEmptyString Then
Dim lv$ = Input.Split("-").LastOrDefault
If Not lv.IsEmptyString Then
Input = Input.Replace($"-{lv}", String.Empty)
Input &= $".{lv}"
End If
End If
Return Input
End Function}
Friend ReadOnly Property FileRegExExt As New RParams(FileUrlRegexDefault, 0, Nothing, InputForbidRemover)
Friend ReadOnly Property FileRegExExt2 As New RParams("([^/]+?)(?=(\Z|&))", 0, Nothing, InputForbidRemover)
Friend ReadOnly Property FileExistsRegEx As RParams = RParams.DMS(FileUrlRegexDefault, 2)
Friend ReadOnly Property TempListAddParams As New ListAddParams(LAP.NotContainsOnly) With {.Comparer = New FComparer(Of UserMedia)(Function(x, y) x.URL = y.URL)}
End Module
End Namespace

View File

@@ -0,0 +1,37 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.LPSG
<Manifest("AndyProgram_LPSG")>
Friend Class SiteSettings : Inherits Base.SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.LPSGIcon_48
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.LPSGPic_32
End Get
End Property
Friend Sub New()
MyBase.New("LPSG", "www.lpsg.com")
UrlPatternUser = "https://www.lpsg.com/threads/{0}/"
UserRegex = RParams.DMS(".+?lpsg.com/threads/([^/]+)", 1)
End Sub
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return If(Responser.Cookies?.Count, 0) > 0
End Function
End Class
End Namespace

View File

@@ -0,0 +1,104 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports Converters = PersonalUtilities.Functions.SymbolsConverter.Converters
Namespace API.LPSG
Friend Class UserData : Inherits UserDataBase
Private Const Name_LatestPage As String = "LatestPage"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then
LatestPage = Container.Value(Name_LatestPage)
Else
Container.Add(Name_LatestPage, LatestPage)
End If
End Sub
Private Property LatestPage As String = String.Empty
Private Enum Mode : Internal : External : End Enum
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
Responser.Error = EDP.ThrowException
Dim NextPage$
Dim r$
Dim _LPage As Func(Of String) = Function() If(LatestPage.IsEmptyString, String.Empty, $"page-{LatestPage}")
Do
URL = $"https://www.lpsg.com/threads/{Name}/{_LPage.Invoke}"
r = Responser.GetResponse(URL)
UserExists = True
UserSuspended = False
ThrowAny(Token)
If Not r.IsEmptyString Then
NextPage = RegexReplace(r, NextPageRegex)
UpdateMediaList(RegexReplace(r, PhotoRegEx), Mode.Internal)
UpdateMediaList(RegexReplace(r, PhotoRegExExt), Mode.External)
If NextPage = LatestPage Or NextPage.IsEmptyString Then Exit Do Else LatestPage = NextPage
Else
Exit Do
End If
Loop
If _TempMediaList.ListExists And _ContentList.ListExists Then _
_TempMediaList.RemoveAll(Function(m) _ContentList.Exists(Function(mm) mm.URL = m.URL))
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Private Sub UpdateMediaList(ByVal l As List(Of String), ByVal m As Mode)
If l.ListExists Then
Dim f As SFile
Dim u$
Dim exists As Boolean
Dim r As RParams
Dim ude As New ErrorsDescriber(EDP.ReturnValue)
For Each url$ In l
If Not url.IsEmptyString Then u = SymbolsConverter.Decode(url, {Converters.HTML, Converters.ASCII}, ude) Else u = String.Empty
If Not u.IsEmptyString Then
exists = Not IsEmptyString(RegexReplace(u, FileExistsRegEx))
If m = Mode.Internal Then
r = FileRegEx
Else
r = FileRegExExt
If Not exists Then
r = FileRegExExt2
exists = Not IsEmptyString(RegexReplace(u, FileRegExExt2))
End If
End If
If exists Then
f = CStr(RegexReplace(u, r))
f.Path = MyFile.CutPath.PathNoSeparator
f.Separator = "\"
If f.Extension.IsEmptyString Then f.Extension = "jpg"
_TempMediaList.ListAddValue(New UserMedia With {.Type = UTypes.Picture, .URL = url, .File = f}, TempListAddParams)
End If
End If
Next
End If
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
With Responser : .UseWebClient = True : .UseWebClientCookies = True : .ResetError() : End With
UseResponserClient = True
DownloadContentDefault(Token)
End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
MyMainLOG = $"{ToStringForLog()}: LPSG not available"
Return 1
Else
Return 0
End If
End Function
End Class
End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -9,9 +9,9 @@
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports PersonalUtilities.Forms.Toolbars Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports System.Threading
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.Plugin.Hosts Imports SCrawler.Plugin.Hosts
Imports System.Threading
Imports SCrawler.API.Reddit.RedditViewExchange Imports SCrawler.API.Reddit.RedditViewExchange
Imports View = SCrawler.API.Reddit.IRedditView.View Imports View = SCrawler.API.Reddit.IRedditView.View
Imports Period = SCrawler.API.Reddit.IRedditView.Period Imports Period = SCrawler.API.Reddit.IRedditView.Period
@@ -44,10 +44,12 @@ Namespace API.Reddit
Return ListAddList(Nothing, Posts).ListAddList(PostsLatest).ListSort Return ListAddList(Nothing, Posts).ListAddList(PostsLatest).ListSort
End Get End Get
End Property End Property
Private ReadOnly Property Source As IEnumerable(Of UserPost) Implements IRangeSwitcherContainer(Of UserPost).Source Private Property Source As IEnumerable(Of UserPost) Implements IRangeSwitcherContainer(Of UserPost).Source
Get Get
Return Posts Return Posts
End Get End Get
Set(ByVal s As IEnumerable(Of UserPost))
End Set
End Property End Property
Friend Property LatestParsedDate As Date? = Nothing Friend Property LatestParsedDate As Date? = Nothing
Private _Downloading As Boolean = False Private _Downloading As Boolean = False
@@ -110,7 +112,7 @@ Namespace API.Reddit
ChannelExistentUserNames.ListAddList((From p As UserPost In PostsAll ChannelExistentUserNames.ListAddList((From p As UserPost In PostsAll
Where Not p.UserID.IsEmptyString AndAlso Where Not p.UserID.IsEmptyString AndAlso
Settings.UsersList.Exists(Function(u) u.Site = Site And u.Name = p.UserID) Settings.UsersList.Exists(Function(u) u.Site = Site And u.Name = p.UserID)
Select p.UserID), LAP.NotContainsOnly) Select p.UserID), LNC)
ChannelExistentUserNames.RemoveAll(Function(u) Not Settings.UsersList.Exists(Function(uu) uu.Site = Site And uu.Name = u)) ChannelExistentUserNames.RemoveAll(Function(u) Not Settings.UsersList.Exists(Function(uu) uu.Site = Site And uu.Name = u))
End If End If
End Sub End Sub
@@ -163,7 +165,7 @@ Namespace API.Reddit
If Not ViewMode = View.New And AutoGetLimits Then If Not ViewMode = View.New And AutoGetLimits Then
Return _DownloadLimitPost Return _DownloadLimitPost
Else Else
Dim PID$ = ListAddList(Nothing, Posts, LAP.NotContainsOnly).ListAddList(PostsLatest, LAP.NotContainsOnly).ListSort.FirstOrDefault.ID Dim PID$ = ListAddList(Nothing, Posts, LNC).ListAddList(PostsLatest, LNC).ListSort.FirstOrDefault.ID
If AutoGetLimits And Not PID.IsEmptyString Then If AutoGetLimits And Not PID.IsEmptyString Then
Return PID Return PID
Else Else
@@ -231,15 +233,22 @@ Namespace API.Reddit
Return New Channel(f) Return New Channel(f)
End Operator End Operator
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
If Not Name.IsEmptyString Then Return If(Name.IsEmptyString, ID, Name)
Return Name
Else
Return ID
End If
End Function End Function
Friend Sub Delete() Friend Sub Delete()
File.Delete(, SFODelete.DeleteToRecycleBin) Dim f As SFile = ChannelsCollection.ChannelsDeletedPath
FilePosts.Delete(, SFODelete.DeleteToRecycleBin) With File
f.Name = .Name
f.Extension = .Extension
.Copy(f,, True, SFODelete.DeleteToRecycleBin)
.Delete(, SFODelete.DeleteToRecycleBin)
End With
With FilePosts
f.Name = .Name
f.Extension = .Extension
.Copy(f,, True, SFODelete.DeleteToRecycleBin)
.Delete(, SFODelete.DeleteToRecycleBin)
End With
End Sub End Sub
Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True, Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True,
Optional ByVal p As MyProgress = Nothing) Optional ByVal p As MyProgress = Nothing)
@@ -259,7 +268,7 @@ Namespace API.Reddit
.DownloadData(Token) .DownloadData(Token)
End With End With
Dim b% = Posts.Count Dim b% = Posts.Count
Posts.ListAddList(d.GetNewChannelPosts(), LAP.NotContainsOnly) Posts.ListAddList(d.GetNewChannelPosts(), LNC)
If Posts.Count - b > 0 Then CountOfLoadedPostsPerSession.Add(Posts.Count - b) If Posts.Count - b > 0 Then CountOfLoadedPostsPerSession.Add(Posts.Count - b)
Posts.Sort() Posts.Sort()
LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate) LatestParsedDate = If(Posts.FirstOrDefault(Function(pp) pp.Date.HasValue).Date, LatestParsedDate)
@@ -362,8 +371,8 @@ Namespace API.Reddit
UpdateUsersStats() UpdateUsersStats()
If Not ViewMode = View.New Then If Not ViewMode = View.New Then
Dim l As New List(Of String) Dim l As New List(Of String)
If Posts.Count > 0 Or PostsLatest.Count > 0 Then l.ListAddList((From p In PostsAll Where Not p.ID.IsEmptyString Select p.ID), LAP.NotContainsOnly) If Posts.Count > 0 Or PostsLatest.Count > 0 Then l.ListAddList((From p In PostsAll Where Not p.ID.IsEmptyString Select p.ID), LNC)
l.ListAddList(PostsNames, LAP.NotContainsOnly) l.ListAddList(PostsNames, LNC)
If l.Count > 0 Then TextSaver.SaveTextToFile(l.ListToString("|"), FilePosts, True,, EDP.SendInLog) If l.Count > 0 Then TextSaver.SaveTextToFile(l.ListToString("|"), FilePosts, True,, EDP.SendInLog)
End If End If
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Channel"} Using x As New XmlFile With {.AllowSameNames = True, .Name = "Channel"}

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -6,14 +6,27 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports PersonalUtilities.Forms.Toolbars Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.API.Base
Imports System.Threading
Namespace API.Reddit Namespace API.Reddit
Friend Class ChannelsCollection : Implements ICollection(Of Channel), IMyEnumerator(Of Channel), IChannelLimits, IDisposable Friend Class ChannelsCollection : Implements ICollection(Of Channel), IMyEnumerator(Of Channel), IChannelLimits, IDisposable
Friend Shared ReadOnly Property ChannelsPath As SFile = $"{SettingsFolderName}\Channels\" Friend Shared ReadOnly Property ChannelsPath As SFile
Friend Shared ReadOnly Property ChannelsPathCache As SFile = $"{Settings.GlobalPath.Value.PathWithSeparator}_CachedData\" Get
Return $"{SettingsFolderName}\Channels\"
End Get
End Property
Friend Shared ReadOnly Property ChannelsDeletedPath As SFile
Get
Return $"{SettingsFolderName}\ChannelsDeleted\"
End Get
End Property
Friend Shared ReadOnly Property ChannelsPathCache As SFile
Get
Return $"{Settings.GlobalPath.Value.PathWithSeparator}_CachedData\"
End Get
End Property
Private ReadOnly Channels As List(Of Channel) Private ReadOnly Channels As List(Of Channel)
Friend Structure ChannelImage : Implements IEquatable(Of ChannelImage) Friend Structure ChannelImage : Implements IEquatable(Of ChannelImage)
Friend File As SFile Friend File As SFile
@@ -42,7 +55,7 @@ Namespace API.Reddit
Return Nothing Return Nothing
End If End If
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex) Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Reddit.ChannelsCollection.GetUserFiles]")
End Try End Try
End Function End Function
Friend Sub UpdateUsersStats() Friend Sub UpdateUsersStats()
@@ -97,7 +110,7 @@ Namespace API.Reddit
If Item(i).ID = ChannelID Then Return Item(i) If Item(i).ID = ChannelID Then Return Item(i)
Next Next
End If End If
Throw New ArgumentException($"Channel ID [{ChannelID}] does not found in channels collection", "ChannelID") With {.HelpLink = 1} Throw New ArgumentException($"Channel ID [{ChannelID}] not found in channel collection", "ChannelID") With {.HelpLink = 1}
End Get End Get
End Property End Property
Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True, Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True,

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -17,26 +17,8 @@ Namespace API.Reddit
New NodeParams("children", True, True, True)} New NodeParams("children", True, True, True)}
Friend ReadOnly UrlBasePattern As RParams = RParams.DM("(?<=/)([^/]+?\.[\w]{3,4})(?=(\?|\Z))", 0) Friend ReadOnly UrlBasePattern As RParams = RParams.DM("(?<=/)([^/]+?\.[\w]{3,4})(?=(\?|\Z))", 0)
Friend ReadOnly VideoRegEx As RParams = RParams.DM("http.{0,1}://[^" & Chr(34) & "]+?mp4", 0) Friend ReadOnly VideoRegEx As RParams = RParams.DM("http.{0,1}://[^" & Chr(34) & "]+?mp4", 0)
Friend ReadOnly DateProvider As New JsonDate
Friend ReadOnly DateProviderChannel As New JsonDateChannel
Private ReadOnly EUR_PROVIDER As New ANumbers(ANumbers.Cultures.EUR) Private ReadOnly EUR_PROVIDER As New ANumbers(ANumbers.Cultures.EUR)
Friend Class JsonDate : Implements ICustomProvider Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicodeJS(v, n, e))
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider, Friend ReadOnly DateProviderChannel As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(AConvert(Of Integer)(v, EUR_PROVIDER, v), n, e))
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
Return ADateTime.ParseUnicodeJS(Value, NothingArg, e)
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("GetFormat is not available in this context")
End Function
End Class
Friend Class JsonDateChannel : Implements ICustomProvider
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
Return ADateTime.ParseUnicode(AConvert(Of Integer)(Value, EUR_PROVIDER, Value), NothingArg, e)
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("GetFormat is not available in this context")
End Function
End Class
End Module End Module
End Namespace End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -15,12 +15,10 @@ Namespace API.Reddit
Friend Module M3U8_Declarations Friend Module M3U8_Declarations
Friend ReadOnly BaseUrlPattern As RParams = RParams.DM("([htps:/]{7,8}.+?/.+?)(?=/)", 0, EDP.ReturnValue) Friend ReadOnly BaseUrlPattern As RParams = RParams.DM("([htps:/]{7,8}.+?/.+?)(?=/)", 0, EDP.ReturnValue)
''' <summary>Video</summary> ''' <summary>Video</summary>
Friend ReadOnly PlayListRegEx_1 As RParams = RParams.DM("(#EXT-X-STREAM-INF)(.+)(RESOLUTION=)(\d+)(.+?[\r\n]{1,2})(.+?)([\r\n]{1,2})", 0, Friend ReadOnly PlayListRegEx_1 As RParams = RParams.DM("(#EXT-X-STREAM-INF)(.+)(RESOLUTION=)(\d+)(.+?[\r\n]{1,2})(.+?)([\r\n]{1,2})", 0, RegexReturn.List)
RegexReturn.List, EDP.SendInLog, EDP.ReturnValue)
''' <summary>Audio, Video</summary> ''' <summary>Audio, Video</summary>
Friend ReadOnly PlayListRegEx_2 As RParams = RParams.DM("(?<=#EXT-X-BYTERANGE.+?[\r\n]{1,2})(.+)(?=[\r\n]{0,2})", 0, Friend ReadOnly PlayListRegEx_2 As RParams = RParams.DM("(?<=#EXT-X-BYTERANGE.+?[\r\n]{1,2})(.+)(?=[\r\n]{0,2})", 0, RegexReturn.List)
RegexReturn.List, EDP.SendInLog, EDP.ReturnValue) Friend ReadOnly PlayListAudioRegEx As RParams = RParams.DM("(HLS_AUDIO_(\d+)[^""]+)", 0, RegexReturn.List)
Friend ReadOnly PlayListAudioRegEx As RParams = RParams.DM("(HLS_AUDIO_(\d+)[^""]+)", 0, RegexReturn.List, EDP.SendInLog, EDP.ReturnValue)
Friend ReadOnly DPED As New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue) Friend ReadOnly DPED As New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue)
End Module End Module
End Namespace End Namespace
@@ -80,11 +78,11 @@ Namespace API.Reddit
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim l As New List(Of Resolution) Dim l As New List(Of Resolution)
If Type = Types.Video Then If Type = Types.Video Then
l = FNF.RegexFields(Of Resolution)(r, {PlayListRegEx_1}, {6, 4}) l = RegexFields(Of Resolution)(r, {PlayListRegEx_1}, {6, 4})
Else Else
Try Try
l = FNF.RegexFields(Of Resolution)(r, {PlayListAudioRegEx}, {1, 2}) l = RegexFields(Of Resolution)(r, {PlayListAudioRegEx}, {1, 2})
Catch anull As FNF.RegexFieldsTextBecameNullException Catch anull As RegexFieldsTextBecameNullException
l.Clear() l.Clear()
End Try End Try
End If End If
@@ -132,7 +130,7 @@ Namespace API.Reddit
End If End If
If CachePath.Exists(SFO.Path) Then If CachePath.Exists(SFO.Path) Then
Dim p As New SFileNumbers(ConcatFile.Name,,, New ANumbers With {.Format = ANumbers.Formats.General}) Dim p As New SFileNumbers(ConcatFile.Name,,, New ANumbers With {.Format = ANumbers.Formats.General})
ConcatFile = SFile.Indexed_IndexFile(ConcatFile,, p, EDP.ThrowException) 'EDP.ReturnValue ConcatFile = SFile.Indexed_IndexFile(ConcatFile,, p, EDP.ThrowException)
Dim i% Dim i%
Dim eFiles As New List(Of SFile) Dim eFiles As New List(Of SFile)
Dim dFile As SFile = CachePath Dim dFile As SFile = CachePath

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -27,7 +27,6 @@ Namespace API.Reddit
Dim TP_VIEW_MODE As System.Windows.Forms.TableLayoutPanel Dim TP_VIEW_MODE As System.Windows.Forms.TableLayoutPanel
Dim LBL_VIEW_MODE As System.Windows.Forms.Label Dim LBL_VIEW_MODE As System.Windows.Forms.Label
Dim LBL_PERIOD As System.Windows.Forms.Label Dim LBL_PERIOD As System.Windows.Forms.Label
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(RedditViewSettingsForm))
Me.OPT_VIEW_MODE_NEW = New System.Windows.Forms.RadioButton() Me.OPT_VIEW_MODE_NEW = New System.Windows.Forms.RadioButton()
Me.OPT_VIEW_MODE_HOT = New System.Windows.Forms.RadioButton() Me.OPT_VIEW_MODE_HOT = New System.Windows.Forms.RadioButton()
Me.OPT_VIEW_MODE_TOP = New System.Windows.Forms.RadioButton() Me.OPT_VIEW_MODE_TOP = New System.Windows.Forms.RadioButton()
@@ -266,7 +265,7 @@ Namespace API.Reddit
Me.ClientSize = New System.Drawing.Size(477, 112) Me.ClientSize = New System.Drawing.Size(477, 112)
Me.Controls.Add(CONTAINER_MAIN) Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon) Me.Icon = Global.SCrawler.My.Resources.SiteResources.RedditIcon_128
Me.KeyPreview = True Me.KeyPreview = True
Me.MaximizeBox = False Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(493, 151) Me.MaximumSize = New System.Drawing.Size(493, 151)

File diff suppressed because it is too large Load Diff

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -7,17 +7,16 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports CView = SCrawler.API.Reddit.IRedditView.View Imports CView = SCrawler.API.Reddit.IRedditView.View
Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit Namespace API.Reddit
Friend Class RedditViewSettingsForm : Implements IOkCancelToolbar Friend Class RedditViewSettingsForm
Private ReadOnly MyDefs As DefaultFormProps Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property MyOptions As IRedditView Private ReadOnly Property MyOptions As IRedditView
Friend Sub New(ByRef opt As IRedditView) Friend Sub New(ByRef opt As IRedditView)
InitializeComponent() InitializeComponent()
MyOptions = opt MyOptions = opt
MyDefs = New DefaultFormProps MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub End Sub
Private Sub ChannelSettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load Private Sub ChannelSettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try Try
@@ -29,10 +28,8 @@ Namespace API.Reddit
End If End If
If Not n.IsEmptyString Then Text = n If Not n.IsEmptyString Then Text = n
With MyDefs With MyDefs
.MyViewInitialize(Me, Settings.Design, True) .MyViewInitialize(True)
.AddOkCancelToolbar() .AddOkCancelToolbar()
.AppendDetectors()
.DelegateClosingChecker()
Select Case MyOptions.ViewMode Select Case MyOptions.ViewMode
Case CView.Hot : OPT_VIEW_MODE_HOT.Checked = True Case CView.Hot : OPT_VIEW_MODE_HOT.Checked = True
Case CView.Top : OPT_VIEW_MODE_TOP.Checked = True Case CView.Top : OPT_VIEW_MODE_TOP.Checked = True
@@ -53,7 +50,7 @@ Namespace API.Reddit
MyDefs.InvokeLoaderError(ex) MyDefs.InvokeLoaderError(ex)
End Try End Try
End Sub End Sub
Private Sub OK() Implements IOkCancelToolbar.OK Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With MyOptions With MyOptions
Select Case True Select Case True
Case OPT_VIEW_MODE_HOT.Checked : .ViewMode = CView.Hot Case OPT_VIEW_MODE_HOT.Checked : .ViewMode = CView.Hot
@@ -71,19 +68,7 @@ Namespace API.Reddit
End With End With
MyDefs.CloseForm() MyDefs.CloseForm()
End Sub End Sub
Private Sub Cancel() Implements IOkCancelToolbar.Cancel Private Sub ChangePeriodEnabled() Handles OPT_VIEW_MODE_NEW.CheckedChanged, OPT_VIEW_MODE_HOT.CheckedChanged, OPT_VIEW_MODE_TOP.CheckedChanged
MyDefs.CloseForm(DialogResult.Cancel)
End Sub
Private Sub OPT_VIEW_MODE_NEW_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_VIEW_MODE_NEW.CheckedChanged
ChangePeriodEnabled()
End Sub
Private Sub OPT_VIEW_MODE_HOT_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_VIEW_MODE_HOT.CheckedChanged
ChangePeriodEnabled()
End Sub
Private Sub OPT_VIEW_MODE_TOP_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_VIEW_MODE_TOP.CheckedChanged
ChangePeriodEnabled()
End Sub
Private Sub ChangePeriodEnabled()
TP_PERIOD.Enabled = OPT_VIEW_MODE_TOP.Checked TP_PERIOD.Enabled = OPT_VIEW_MODE_TOP.Checked
End Sub End Sub
End Class End Class

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -9,46 +9,37 @@
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports DownDetector = SCrawler.API.Base.DownDetector Imports DownDetector = SCrawler.API.Base.DownDetector
Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Reddit Namespace API.Reddit
<Manifest(RedditSiteKey), UseClassAsIs, SavedPosts, SpecialForm(False)> <Manifest(RedditSiteKey), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon Friend Overrides ReadOnly Property Icon As Icon
Get Get
Return My.Resources.RedditIcon Return My.Resources.SiteResources.RedditIcon_128
End Get End Get
End Property End Property
Friend Overrides ReadOnly Property Image As Image Friend Overrides ReadOnly Property Image As Image
Get Get
Return My.Resources.RedditPic512 Return My.Resources.SiteResources.RedditPic_512
End Get End Get
End Property End Property
<PropertyOption(ControlText:="Saved posts user"), PXML("SavedPostsUserName")> <PropertyOption(ControlText:="Saved posts user"), PXML("SavedPostsUserName")>
Friend ReadOnly Property SavedPostsUserName As PropertyValue Friend ReadOnly Property SavedPostsUserName As PropertyValue
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos"), PXML> <PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos"), PXML>
Friend ReadOnly Property UseM3U8 As PropertyValue Friend ReadOnly Property UseM3U8 As PropertyValue
Friend Overrides ReadOnly Property Responser As WEB.Response
Friend Sub New() Friend Sub New()
MyBase.New(RedditSite) MyBase.New(RedditSite, "reddit.com")
Responser = New WEB.Response($"{SettingsFolderName}\Responser_{Site}.xml")
With Responser With Responser
If .File.Exists Then If .Decoders.Count = 0 OrElse Not .Decoders.Contains(SymbolsConverter.Converters.Unicode) Then _
.LoadSettings() .Decoders.Add(SymbolsConverter.Converters.Unicode) : .SaveSettings()
Else
.CookiesDomain = "reddit.com"
.Decoders.Add(SymbolsConverter.Converters.Unicode)
.SaveSettings()
End If
End With End With
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String)) SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
UseM3U8 = New PropertyValue(True) UseM3U8 = New PropertyValue(True)
UrlPatternUser = "https://www.reddit.com/user/{0}/" UrlPatternUser = "https://www.reddit.com/user/{0}/"
UrlPatternChannel = "https://www.reddit.com/r/{0}/" UrlPatternChannel = "https://www.reddit.com/r/{0}/"
ImageVideoContains = "redgifs" ImageVideoContains = "reddit.com"
End Sub End Sub
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
Select Case What Select Case What
@@ -88,10 +79,15 @@ Namespace API.Reddit
If Silent Then If Silent Then
Return False Return False
Else Else
Return MsgBoxE({"Over the past hour, Reddit has received an average of " & If MsgBoxE({"Over the past hour, Reddit has received an average of " &
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr & avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
dl.ListToString(vbCr) & vbCr & vbCr & dl.ListToString(vbCr) & vbCr & vbCr &
"Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes "Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes Then
DirectCast(Settings(RedGifs.RedGifsSiteKey).Source, RedGifs.SiteSettings).UpdateTokenIfRequired()
Return True
Else
Return False
End If
End If End If
End If End If
End If End If
@@ -100,8 +96,11 @@ Namespace API.Reddit
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True) Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True)
End Try End Try
End Function End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia) Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
Return UserData.GetVideoInfo(URL, Responser) Dim spf$ = String.Empty
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
f = $"{f.PathWithSeparator}OptionalPath\"
Return UserData.GetVideoInfo(URL, Responser, f, spf)
End Function End Function
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean) Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange
@@ -109,5 +108,8 @@ Namespace API.Reddit
Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using
End If End If
End Sub End Sub
Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
Return $"https://www.reddit.com/comments/{PostID.Split("_").LastOrDefault}/"
End Function
End Class End Class
End Namespace End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -6,15 +6,16 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.Reddit.RedditViewExchange
Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.ImageRenderer Imports PersonalUtilities.Tools.ImageRenderer
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.Reddit.RedditViewExchange
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports CView = SCrawler.API.Reddit.IRedditView.View Imports CView = SCrawler.API.Reddit.IRedditView.View
@@ -58,7 +59,7 @@ Namespace API.Reddit
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
#End Region #End Region
Friend Property ChannelInfo As Channel Friend Property ChannelInfo As Channel
Private ReadOnly ChannelPostsNames As New List(Of String) Private ReadOnly ChannelPostsNames As List(Of String)
Friend Property SkipExistsUsers As Boolean = True Implements IChannelData.SkipExistsUsers Friend Property SkipExistsUsers As Boolean = True Implements IChannelData.SkipExistsUsers
Private ReadOnly _ExistsUsersNames As List(Of String) Private ReadOnly _ExistsUsersNames As List(Of String)
Friend Property SaveToCache As Boolean = False Implements IChannelData.SaveToCache Friend Property SaveToCache As Boolean = False Implements IChannelData.SaveToCache
@@ -163,6 +164,8 @@ Namespace API.Reddit
End If End If
If DownloadTopCount.HasValue Then DownloadLimitCount = DownloadTopCount If DownloadTopCount.HasValue Then DownloadLimitCount = DownloadTopCount
End If End If
If SaveToCache AndAlso Not Responser.Decoders.Contains(SymbolsConverter.Converters.HTML) Then _
Responser.Decoders.Add(SymbolsConverter.Converters.HTML)
DownloadDataChannel(String.Empty, Token) DownloadDataChannel(String.Empty, Token)
If ChannelInfo Is Nothing Then _TempPostsList.ListAddList(_TempMediaList.Select(Function(m) m.Post.ID), LNC) If ChannelInfo Is Nothing Then _TempPostsList.ListAddList(_TempMediaList.Select(Function(m) m.Post.ID), LNC)
Else Else
@@ -173,6 +176,8 @@ Namespace API.Reddit
#Region "Download Functions (User, Channel)" #Region "Download Functions (User, Channel)"
Private _TotalPostsDownloaded As Integer = 0 Private _TotalPostsDownloaded As Integer = 0
Private ReadOnly _CrossPosts As List(Of String) Private ReadOnly _CrossPosts As List(Of String)
Private Const SiteGfycatKey As String = "gfycat"
Private Const SiteRedGifsKey As String = "redgifs"
Private Sub DownloadDataUser(ByVal POST As String, ByVal Token As CancellationToken) Private Sub DownloadDataUser(ByVal POST As String, ByVal Token As CancellationToken)
Const CPRI$ = "crosspostRootId" Const CPRI$ = "crosspostRootId"
Const CPPI$ = "crosspostParentId" Const CPPI$ = "crosspostParentId"
@@ -227,12 +232,15 @@ Namespace API.Reddit
Continue For Continue For
End If End If
If nn.Contains("created") Then PostDate = nn("created").Value Else PostDate = String.Empty If nn.Contains("created") Then PostDate = nn("created").Value Else PostDate = String.Empty
If DownloadToDate.HasValue AndAlso Not CheckDatesLimit(PostDate, DateTrueProvider(IsChannel)) Then Exit Sub Select Case CheckDatesLimit(PostDate, DateTrueProvider(IsChannel))
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
_ItemsBefore = _TempMediaList.Count _ItemsBefore = _TempMediaList.Count
added = True added = True
s = nn.ItemF({"source", "url"}) s = nn.ItemF({"source", "url"})
If s.XmlIfNothingValue("/").StringContains({"redgifs.com", "gfycat.com"}) Then If s.XmlIfNothingValue("/").StringContains({$"{SiteRedGifsKey}.com", $"{SiteGfycatKey}.com"}) Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, s.Value, _PostID(), PostDate,, IsChannel), LNC) _TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, s.Value, _PostID(), PostDate,, IsChannel), LNC)
ElseIf Not CreateImgurMedia(s.XmlIfNothingValue, _PostID(), PostDate,, IsChannel) Then ElseIf Not CreateImgurMedia(s.XmlIfNothingValue, _PostID(), PostDate,, IsChannel) Then
s = nn.ItemF({"media"}).XmlIfNothing s = nn.ItemF({"media"}).XmlIfNothing
@@ -264,7 +272,7 @@ Namespace API.Reddit
If Not s.IsEmptyString AndAlso TryFile(s.Value) Then If Not s.IsEmptyString AndAlso TryFile(s.Value) Then
With s.Value.ToLower With s.Value.ToLower
Select Case True Select Case True
Case .Contains("redgifs"), .Contains("gfycat") : tmpType = UTypes.VideoPre Case .Contains(SiteRedGifsKey), .Contains(SiteGfycatKey) : tmpType = UTypes.VideoPre
Case .Contains("m3u8") : If Settings.UseM3U8 Then tmpType = UTypes.m3u8 Case .Contains("m3u8") : If Settings.UseM3U8 Then tmpType = UTypes.m3u8
Case .Contains(".gif") And TryFile(s.Value) : tmpType = UTypes.GIF Case .Contains(".gif") And TryFile(s.Value) : tmpType = UTypes.GIF
Case TryFile(s.Value) : tmpType = UTypes.Picture Case TryFile(s.Value) : tmpType = UTypes.Picture
@@ -322,7 +330,7 @@ Namespace API.Reddit
If ChannelPostsNames.Contains(PostID) Then If ChannelPostsNames.Contains(PostID) Then
If ViewMode = CView.New Then ExistsDetected = True Else NewPostDetected = True 'bypass If ViewMode = CView.New Then ExistsDetected = True Else NewPostDetected = True 'bypass
Continue For 'Exit Sub Continue For
End If End If
If DownloadLimitCount.HasValue AndAlso _TotalPostsDownloaded >= DownloadLimitCount.Value Then Exit Sub If DownloadLimitCount.HasValue AndAlso _TotalPostsDownloaded >= DownloadLimitCount.Value Then Exit Sub
If Not DownloadLimitPost.IsEmptyString AndAlso DownloadLimitPost = PostID Then Exit Sub If Not DownloadLimitPost.IsEmptyString AndAlso DownloadLimitPost = PostID Then Exit Sub
@@ -370,16 +378,15 @@ Namespace API.Reddit
ElseIf Not s.Value({"media", "reddit_video"}, "fallback_url").IsEmptyString Then ElseIf Not s.Value({"media", "reddit_video"}, "fallback_url").IsEmptyString Then
tmpUrl = s.Value({"media", "reddit_video"}, "fallback_url") tmpUrl = s.Value({"media", "reddit_video"}, "fallback_url")
If SaveToCache Then If SaveToCache Then
tmpUrl = s.Value("thumbnail") tmpUrl = GetVideoRedditPreview(s)
If Not tmpUrl.IsEmptyString Then If Not tmpUrl.IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC) _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, _UserID, IsChannel, False), LNC)
_TotalPostsDownloaded += 1 _TotalPostsDownloaded += 1
End If End If
ElseIf UseM3U8 AndAlso Not s.Value({"media", "reddit_video"}, "hls_url").IsEmptyString Then ElseIf UseM3U8 AndAlso Not s.Value({"media", "reddit_video"}, "hls_url").IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, s.Value({"media", "reddit_video"}, "hls_url"), _TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, s.Value({"media", "reddit_video"}, "hls_url"),
PostID, PostDate, _UserID, IsChannel), LNC) PostID, PostDate, _UserID, IsChannel), LNC)
Else Else
'_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre + UTypes.m3u8, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC) _TempMediaList.ListAddValue(MediaFromData(UTypes.Video, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1 _TotalPostsDownloaded += 1
End If End If
@@ -409,19 +416,6 @@ Namespace API.Reddit
End Sub End Sub
#End Region #End Region
#Region "Download Base Functions" #Region "Download Base Functions"
Private Function ImgurPicture(ByVal Source As EContainer, ByVal Value As String) As String
Try
Dim e As EContainer = Source({"source", "url"}).XmlIfNothing
If Not e.IsEmptyString AndAlso e.Value.ToLower.Contains("imgur") Then
Return e.Value
Else
Return Value
End If
Catch ex As Exception
LogError(ex, "[ImgurPicture]")
Return Value
End Try
End Function
Private Function CreateImgurMedia(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String, Private Function CreateImgurMedia(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _UserID As String = "", Optional ByVal IsChannel As Boolean = False) As Boolean Optional ByVal _UserID As String = "", Optional ByVal IsChannel As Boolean = False) As Boolean
If Not _URL.IsEmptyString AndAlso _URL.Contains("imgur") Then If Not _URL.IsEmptyString AndAlso _URL.Contains("imgur") Then
@@ -440,8 +434,33 @@ Namespace API.Reddit
ElseIf _URL.Contains(".gif") Then ElseIf _URL.Contains(".gif") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.GIF, _URL, PostID, PostDate, _UserID, IsChannel), LNC) _TempMediaList.ListAddValue(MediaFromData(UTypes.GIF, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
Else Else
Dim obj As IEnumerable(Of UserMedia) = Imgur.Envir.GetVideoInfo(_URL, EDP.ReturnValue)
If Not obj.ListExists Then
If Not TryFile(_URL) Then _URL &= ".jpg" If Not TryFile(_URL) Then _URL &= ".jpg"
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID, IsChannel), LNC) _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
Else
Dim ut As UTypes
Dim m As UserMedia
For Each data As UserMedia In obj
With data
If Not .URL.IsEmptyString Then
If Not .File.IsEmptyString Then
Select Case .File.Extension
Case "jpg", "png", "jpeg" : ut = UTypes.Picture
Case "gifv" : ut = IIf(SaveToCache, UTypes.Picture, UTypes.Video)
Case "mp4" : ut = UTypes.Video
Case "gif" : ut = UTypes.GIF
Case Else : ut = UTypes.Picture : .File.Extension = "jpg"
End Select
m = MediaFromData(ut, _URL, PostID, PostDate, _UserID, IsChannel)
m.URL = .URL
m.File = .File.File
_TempMediaList.ListAddValue(m, LNC)
End If
End If
End With
Next
End If
End If End If
Return True Return True
Else Else
@@ -470,21 +489,70 @@ Namespace API.Reddit
Return False Return False
End Try End Try
End Function End Function
Private Function GetVideoRedditPreview(ByVal Node As EContainer) As String
Try
If Not Node Is Nothing Then
Dim n As EContainer = Node.ItemF({"preview", "images", 0})
Dim DestNode$() = Nothing
If If(n?.Count, 0) > 0 Then
If If(n("resolutions")?.Count, 0) > 0 Then
DestNode = {"resolutions"}
ElseIf If(n({"variants", "nsfw", "resolutions"})?.Count, 0) > 0 Then
DestNode = {"variants", "nsfw", "resolutions"}
End If
If Not DestNode Is Nothing Then
With n(DestNode)
Dim sl As List(Of Sizes) = .Select(Function(e) New Sizes(e.Value("width"), e.Value("url"))).
ListWithRemove(Function(ss) ss.HasError Or ss.Data.IsEmptyString)
If sl.ListExists Then
Dim s As Sizes
sl.Sort()
s = sl.First
sl.Clear()
Return s.Data
End If
End With
End If
End If
End If
Return String.Empty
Catch ex As Exception
ProcessException(ex, Nothing, "reddit video preview parsing error", False)
Return String.Empty
End Try
End Function
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken) Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
Dim RedGifsResponser As Response = Nothing
Try Try
ThrowAny(Token) ThrowAny(Token)
Const v2 As UTypes = UTypes.VideoPre + UTypes.m3u8 Const v2 As UTypes = UTypes.VideoPre + UTypes.m3u8
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(p) p.Type = UTypes.VideoPre Or p.Type = v2) Then If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(p) p.Type = UTypes.VideoPre Or p.Type = v2) Then
Dim r$, v$ Dim r$, v$
Dim e As New ErrorsDescriber(EDP.ReturnValue) Dim e As New ErrorsDescriber(EDP.ReturnValue)
Dim m As UserMedia Dim m As UserMedia, m2 As UserMedia
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey)
RedGifsResponser = RedGifsHost.Responser.Copy
For i% = _TempMediaList.Count - 1 To 0 Step -1 For i% = _TempMediaList.Count - 1 To 0 Step -1
ThrowAny(Token) ThrowAny(Token)
If _TempMediaList(i).Type = UTypes.VideoPre Or _TempMediaList(i).Type = v2 Then If _TempMediaList(i).Type = UTypes.VideoPre Or _TempMediaList(i).Type = v2 Then
m = _TempMediaList(i) m = _TempMediaList(i)
If _TempMediaList(i).Type = UTypes.VideoPre Then If _TempMediaList(i).Type = UTypes.VideoPre Then
If m.URL.Contains("gfycat.com") Then If m.URL.Contains($"{SiteGfycatKey}.com") Then
r = Gfycat.Envir.GetVideo(m.URL) r = Gfycat.Envir.GetVideo(m.URL)
ElseIf m.URL.Contains(SiteRedGifsKey) Then
m2 = RedGifs.UserData.GetDataFromUrlId(m.URL, False, RedGifsResponser, RedGifsHost)
If m2.State = UStates.Missing Then
m.State = UStates.Missing
_ContentList.Add(m)
_TempMediaList.RemoveAt(i)
ElseIf m2.State = RedGifs.UserData.DataGone Then
_TempMediaList.RemoveAt(i)
Else
m2.URL_BASE = m.URL
m2.Post = m.Post
_TempMediaList(i) = m2
End If
Continue For
Else Else
r = Responser.GetResponse(m.URL,, e) r = Responser.GetResponse(m.URL,, e)
End If End If
@@ -505,33 +573,125 @@ Namespace API.Reddit
End If End If
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, "video reparsing error", False) ProcessException(ex, Token, "video reparsing error", False)
Finally
If Not RedGifsResponser Is Nothing Then RedGifsResponser.Dispose()
End Try End Try
End Sub End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response) As IEnumerable(Of UserMedia) Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Dim RedGifsResponser As Response = Nothing
Try Try
If Not URL.IsEmptyString AndAlso URL.Contains("redgifs") Then If Not ChannelInfo Is Nothing Or SaveToCache Then Exit Sub
If ContentMissingExists Then
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey)
RedGifsResponser = RedGifsHost.Responser.Copy
Dim m As UserMedia, m2 As UserMedia
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
If Not m.URL.IsEmptyString AndAlso m.URL.Contains(SiteRedGifsKey) Then
m2 = RedGifs.UserData.GetDataFromUrlId(m.URL, False, RedGifsResponser, RedGifsHost)
If m2.State = RedGifs.UserData.DataGone Then
rList.Add(i)
ElseIf Not m2.Type = UTypes.Undefined And Not m2.State = UStates.Missing Then
m.Type = m2.Type
m.File = m2.File
m.URL_BASE = m.URL
m.URL = m2.URL
rList.Add(i)
_TempMediaList.ListAddValue(m, LNC)
End If
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "missing data downloading error")
Finally
If Not RedGifsResponser Is Nothing Then RedGifsResponser.Dispose()
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try
End Sub
Private Sub ParsePost(ByVal URL As String)
Try
If Not URL.IsEmptyString Then
Dim __id$ = RegexReplace(URL, RParams.DMS("comments/([^/]+)", 1, EDP.ReturnValue))
If Not __id.IsEmptyString Then
URL = $"https://www.reddit.com/comments/{__id.Split("_").LastOrDefault}/.json"
Dim r$ = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
With j.ItemF({0, "data", "children", 0, "data"})
If .ListExists Then
If .Contains({"media"}, "reddit_video") Then
With .Item({"media"}, "reddit_video")
If UseM3U8 AndAlso .Item("hls_url").XmlIfNothingValue("/").ToLower.Contains("m3u8") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, .Value("hls_url"), __id, String.Empty), LNC)
ElseIf Not UseM3U8 AndAlso .Item("fallback_url").XmlIfNothingValue("/").ToLower.Contains("mp4") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, .Value("fallback_url"), __id, String.Empty), LNC)
End If
End With
ElseIf Not .Value("url").IsEmptyString Then
If .Value("url").StringContains({$"{SiteRedGifsKey}.com", $"{SiteGfycatKey}.com"}) Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, .Value("url"), __id, String.Empty), LNC)
Else
CreateImgurMedia(.Value("url"), __id, String.Empty)
End If
End If
End If
End With
End Using
End If
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"API.Reddit.ParsePost({URL})")
End Try
End Sub
Private Class AbsProgress : Inherits PersonalUtilities.Forms.Toolbars.MyProgress
Public Overrides Sub Perform(Optional ByVal Value As Double = 1)
End Sub
End Class
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response, ByVal f As SFile, ByVal SpecialFolder As String) As IEnumerable(Of UserMedia)
Try
If Not URL.IsEmptyString Then
Using r As New UserData Using r As New UserData
r._TempMediaList.Add(MediaFromData(UTypes.VideoPre, URL, String.Empty, String.Empty,, False))
r.Responser = New Response r.Responser = New Response
r.Responser.Copy(resp) r.Responser.Copy(resp)
r.ParsePost(URL)
If r._TempMediaList.Count > 0 Then
r.ReparseVideo(Nothing) r.ReparseVideo(Nothing)
If r._TempMediaList.ListExists Then Return {r._TempMediaList(0)} If r._TempMediaList.Count > 0 Then
r._ContentNew.AddRange(r._TempMediaList)
r.Progress = New AbsProgress
r.User.File.Path = f.Path
r.SeparateVideoFolder = False
r.DownloadContent(Nothing)
If r._ContentNew.Exists(Function(c) c.State = UStates.Downloaded) Then _
Return {New UserMedia With {.State = UStates.Downloaded, .SpecialFolder = SpecialFolder}}
End If
End If
End Using End Using
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Video searching error") Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.Reddit.UserData.GetVideoInfo({URL})]")
End Try End Try
End Function End Function
#End Region #End Region
#Region "Structure creator" #Region "Structure creator"
Protected Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String, Protected Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _UserID As String = "", Optional ByVal IsChannel As Boolean = False) As UserMedia Optional ByVal _UserID As String = "", Optional ByVal IsChannel As Boolean = False,
Optional ByVal ReplacePreview As Boolean = True) As UserMedia
If _URL.IsEmptyString And t = UTypes.Picture Then Return Nothing If _URL.IsEmptyString And t = UTypes.Picture Then Return Nothing
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern)) _URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID, .UserID = _UserID}} 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 = UrlToFile(m.URL) Else m.File = Nothing If t = UTypes.Picture Or t = UTypes.GIF Then m.File = UrlToFile(m.URL) Else m.File = Nothing
If m.URL.Contains("preview") Then m.URL = $"https://i.redd.it/{m.File.File}" If ReplacePreview And m.URL.Contains("preview") 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), Nothing) Else m.Post.Date = Nothing
Return m Return m
End Function End Function
@@ -551,6 +711,7 @@ Namespace API.Reddit
End Function End Function
#End Region #End Region
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
Dim RedGifsResponser As Response = Nothing
Try Try
Const _RFN$ = "RedditVideo" Const _RFN$ = "RedditVideo"
Const RFN$ = _RFN & "{0}" Const RFN$ = _RFN & "{0}"
@@ -560,7 +721,10 @@ Namespace API.Reddit
If _ContentNew.Count > 0 Then If _ContentNew.Count > 0 Then
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString) _ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
If _ContentNew.Count > 0 Then If _ContentNew.Count > 0 Then
RedGifsResponser = Settings(RedGifs.RedGifsSiteKey).Responser.Copy
MyFile.Exists(SFO.Path) MyFile.Exists(SFO.Path)
Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog
Dim IsImgurStuff As Boolean
Dim MyDir$ Dim MyDir$
If Not IsSavedPosts AndAlso (IsChannel And SaveToCache And Not ChannelInfo Is Nothing) Then If Not IsSavedPosts AndAlso (IsChannel And SaveToCache And Not ChannelInfo Is Nothing) Then
MyDir = ChannelInfo.CachePath.PathNoSeparator MyDir = ChannelInfo.CachePath.PathNoSeparator
@@ -579,6 +743,7 @@ Namespace API.Reddit
Dim vsf As Boolean = SeparateVideoFolderF Dim vsf As Boolean = SeparateVideoFolderF
Dim UseMD5 As Boolean = Not IsChannel Or (Not cached And Settings.ChannelsRegularCheckMD5) Dim UseMD5 As Boolean = Not IsChannel Or (Not cached And Settings.ChannelsRegularCheckMD5)
Dim bDP As New ErrorsDescriber(EDP.None) Dim bDP As New ErrorsDescriber(EDP.None)
Dim RGRERROR As New ErrorsDescriber(EDP.ThrowException)
Dim ImgurUrls As New List(Of String) Dim ImgurUrls As New List(Of String)
Dim TryBytes As Func(Of String, Imaging.ImageFormat, String) = Dim TryBytes As Func(Of String, Imaging.ImageFormat, String) =
Function(ByVal __URL As String, ByVal ImgFormat As Imaging.ImageFormat) As String Function(ByVal __URL As String, ByVal ImgFormat As Imaging.ImageFormat) As String
@@ -628,8 +793,8 @@ Namespace API.Reddit
End Function End Function
Dim m$ Dim m$
Using w As New WebClient Using w As New WebClient
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path) If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path)
Progress.TotalCount += _ContentNew.Count Progress.Maximum += _ContentNew.Count
For i = 0 To _ContentNew.Count - 1 For i = 0 To _ContentNew.Count - 1
ThrowAny(Token) ThrowAny(Token)
v = _ContentNew(i) v = _ContentNew(i)
@@ -651,6 +816,7 @@ Namespace API.Reddit
If (Not m.IsEmptyString AndAlso Not HashList.Contains(m)) Or Not (v.Type = UTypes.Picture Or If (Not m.IsEmptyString AndAlso Not HashList.Contains(m)) Or Not (v.Type = UTypes.Picture Or
v.Type = UTypes.GIF) Or Not UseMD5 Or ImgurUrls.Count > 0 Then v.Type = UTypes.GIF) Or Not UseMD5 Or ImgurUrls.Count > 0 Then
IsImgurStuff = ImgurUrls.Count > 0
Do Do
If Not cached And Not m.IsEmptyString Then HashList.Add(m) If Not cached And Not m.IsEmptyString Then HashList.Add(m)
v.MD5 = m v.MD5 = m
@@ -664,6 +830,7 @@ Namespace API.Reddit
f = SFile.Indexed_IndexFile(f,,, EDP.ReturnValue) f = SFile.Indexed_IndexFile(f,,, EDP.ReturnValue)
End If End If
End If End If
If f.Extension = "webp" And Settings.DownloadNativeImageFormat Then f.Extension = "jpg"
f.Path = MyDir f.Path = MyDir
Try Try
If (v.Type = UTypes.Video Or v.Type = UTypes.m3u8 Or (ImgurUrls.Count > 0 AndAlso f.Extension = "mp4")) And If (v.Type = UTypes.Video Or v.Type = UTypes.m3u8 Or (ImgurUrls.Count > 0 AndAlso f.Extension = "mp4")) And
@@ -676,12 +843,14 @@ Namespace API.Reddit
f = M3U8.Download(v.URL, f) f = M3U8.Download(v.URL, f)
ElseIf ImgurUrls.Count > 0 Then ElseIf ImgurUrls.Count > 0 Then
w.DownloadFile(ImgurUrls(0), f.ToString) w.DownloadFile(ImgurUrls(0), f.ToString)
ElseIf v.URL.Contains(SiteRedGifsKey) Then
RedGifsResponser.DownloadFile(v.URL, f, RGRERROR)
Else Else
w.DownloadFile(v.URL, f.ToString) w.DownloadFile(v.URL, f.ToString)
End If End If
If Not v.Type = UTypes.m3u8 Or Not f.IsEmptyString Then If Not v.Type = UTypes.m3u8 Or Not f.IsEmptyString Then
Select Case v.Type Select Case v.Type
Case UTypes.Picture : DownloadedPictures(False) += 1 Case UTypes.Picture, UTypes.GIF : DownloadedPictures(False) += 1
Case UTypes.Video, UTypes.m3u8 : DownloadedVideos(False) += 1 Case UTypes.Video, UTypes.m3u8 : DownloadedVideos(False) += 1
End Select End Select
If Not IsChannel Or Not SaveToCache Then If Not IsChannel Or Not SaveToCache Then
@@ -694,7 +863,11 @@ Namespace API.Reddit
dCount += 1 dCount += 1
End If End If
Catch wex As Exception Catch wex As Exception
If Not IsChannel Then ErrorDownloading(f, v.URL) If Not IsChannel Then
If Not IsImgurStuff And MissingErrorsAdd Then ErrorDownloading(f, v.URL)
v.Attempts += 1
v.State = UStates.Missing
End If
End Try End Try
If ImgurUrls.Count > 0 Then ImgurUrls.RemoveAt(0) If ImgurUrls.Count > 0 Then ImgurUrls.RemoveAt(0)
Loop While ImgurUrls.Count > 0 Loop While ImgurUrls.Count > 0
@@ -722,19 +895,22 @@ Namespace API.Reddit
HasError = True HasError = True
End Try End Try
End Sub End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
If Responser.StatusCode = HttpStatusCode.NotFound Then Optional ByVal EObj As Object = Nothing) As Integer
With Responser
If .StatusCode = HttpStatusCode.NotFound Then
UserExists = False UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden Then ElseIf .StatusCode = HttpStatusCode.Forbidden Then
UserSuspended = True UserSuspended = True
ElseIf Responser.StatusCode = HttpStatusCode.BadGateway Or ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then
Responser.StatusCode = HttpStatusCode.ServiceUnavailable Or MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})"
Responser.StatusCode = HttpStatusCode.GatewayTimeout Then ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then
MyMainLOG = $"Reddit is currently unavailable ({ToString()})" Return 1
Else Else
If Not FromPE Then LogError(ex, Message) : HasError = True If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0 Return 0
End If End If
End With
Return 1 Return 1
End Function End Function
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -6,18 +6,14 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.RedGifs Namespace API.RedGifs
Friend Module Declarations Friend Module Declarations
Friend Const RedGifsSiteKey As String = "AndyProgram_RedGifs"
Friend Const RedGifsSite As String = "RedGifs" Friend Const RedGifsSite As String = "RedGifs"
Friend ReadOnly DateProvider As New JsonDate Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v, n, e))
Friend Class JsonDate : Implements ICustomProvider Friend ReadOnly WatchIDRegex As RParams = RParams.DMS(".+?watch/([^\?&""/]+)", 1, EDP.ReturnValue)
Friend Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider, Friend ReadOnly ThumbsIDRegex As RParams = RParams.DMS("([^/\?&""]+?)(-\w+?|)\.(mp4|jpg)", 1, EDP.ReturnValue,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert Function(v) If(CStr(v).IsEmptyString, String.Empty, CStr(v).ToLower.Trim))
Return ADateTime.ParseUnicode(Value, NothingArg, e)
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("GetFormat is not available in this context")
End Function
End Class
End Module End Module
End Namespace End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -6,24 +6,158 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports SCrawler.API.Base Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.RedGifs Namespace API.RedGifs
<Manifest("AndyProgram_RedGifs"), UseClassAsIs> <Manifest(RedGifsSiteKey)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.RedGifsIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.RedGifsPic_32
End Get
End Property
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Bearer token")>
Friend Property Token As PropertyValue
<PXML> Friend Property TokenLastDateUpdated As PropertyValue
<DoNotUse> Friend ReadOnly Property NoCredentialsResponser As Response
Private Const TokenName As String = "authorization"
#End Region
#Region "Initializer"
Friend Sub New() Friend Sub New()
MyBase.New(RedGifsSite, "redgifs.com") MyBase.New(RedGifsSite, "redgifs.com")
Dim t$ = String.Empty
With Responser
Dim b As Boolean = Not .UseWebClient Or Not .UseWebClientCookies Or Not .UseWebClientAdditionalHeaders
.UseWebClient = True
.UseWebClientCookies = True
.UseWebClientAdditionalHeaders = True
If .Headers.Count > 0 AndAlso .Headers.ContainsKey(TokenName) Then t = .Headers(TokenName)
If b Then .SaveSettings()
End With
NoCredentialsResponser = New Response($"{SettingsFolderName}\Responser_{RedGifsSite}_NC.xml") With {
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey,
.CookiesDomain = "redgifs.com"
}
With NoCredentialsResponser
If .File.Exists Then
.LoadSettings()
Else
.Cookies = New CookieKeeper(.CookiesDomain) With {.EncryptKey = SettingsCLS.CookieEncryptKey}
.SaveSettings()
End If
End With
Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v))
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date))
UrlPatternUser = "https://www.redgifs.com/users/{0}/" UrlPatternUser = "https://www.redgifs.com/users/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1) UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1)
ImageVideoContains = "redgifs" ImageVideoContains = "redgifs"
End Sub End Sub
#End Region
#Region "Response updater"
Private Sub UpdateResponse(ByVal Value As String)
With Responser.Headers
If .Count = 0 OrElse Not .ContainsKey(TokenName) Then .Add(TokenName, Value) Else .Item(TokenName) = Value
Responser.SaveSettings()
End With
End Sub
#End Region
#Region "Token updaters"
Friend Function UpdateTokenIfRequired() As Boolean
Dim d As Date? = AConvert(Of Date)(TokenLastDateUpdated.Value, AModes.Var, Nothing)
If Not d.HasValue OrElse d.Value < Now.AddDays(-1) Then
Return UpdateToken()
Else
Return True
End If
End Function
<PropertyUpdater(NameOf(Token))>
Friend Function UpdateToken() As Boolean
Try
Dim r$
Dim NewToken$ = String.Empty
Using resp As New Response : r = resp.GetResponse("https://api.redgifs.com/v2/auth/temporary",, EDP.ThrowException) : End Using
If Not r.IsEmptyString Then
Dim j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing Then
NewToken = j.Value("token")
j.Dispose()
End If
End If
If Not NewToken.IsEmptyString Then
Token.Value = $"Bearer {NewToken}"
TokenLastDateUpdated.Value = Now
Return True
Else
Return False
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.RedGifs.SiteSettings.UpdateToken]", False)
End Try
End Function
#End Region
#Region "Update settings"
Private _LastTokenValue As String = String.Empty
Friend Overrides Sub BeginEdit()
_LastTokenValue = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
MyBase.BeginEdit()
End Sub
Friend Overrides Sub Update()
Dim NewToken$ = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
If Not _LastTokenValue = NewToken Then TokenLastDateUpdated.Value = Now
MyBase.Update()
End Sub
Friend Overrides Sub EndEdit()
_LastTokenValue = String.Empty
MyBase.EndEdit()
End Sub
#End Region
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData Return New UserData
End Function End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia) Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
Return Reddit.UserData.GetVideoInfo(URL, Nothing) If BaseAuthExists() Then
Using resp As Response = Responser.Copy
Dim m As UserMedia = UserData.GetDataFromUrlId(URL, False, resp, Settings(RedGifsSiteKey))
If Not m.State = UStates.Missing And Not m.State = UserData.DataGone And (m.Type = UTypes.Picture Or m.Type = UTypes.Video) Then
Try
Dim spf$ = String.Empty
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
If f.IsEmptyString Then
f = m.File.File
Else
f.Name = m.File.Name
f.Extension = m.File.Extension
End If
resp.DownloadFile(m.URL, f, EDP.ThrowException)
m.State = UStates.Downloaded
m.SpecialFolder = spf
Return {m}
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"Redgifs standalone download error: [{URL}]")
End Try
End If
End Using
End If
Return Nothing
End Function
Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
Return $"https://www.redgifs.com/watch/{PostID}"
End Function
Friend Overrides Function BaseAuthExists() As Boolean
Return UpdateTokenIfRequired() AndAlso ACheck(Token.Value)
End Function End Function
End Class End Class
End Namespace End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy ' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify ' 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 ' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or ' the Free Software Foundation, either version 3 of the License, or
@@ -6,84 +6,254 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports System.Threading
Imports System.Net
Imports SCrawler.API.Base
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.RedGifs Namespace API.RedGifs
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
Friend Sub New() Friend Const DataGone As HttpStatusCode = HttpStatusCode.Gone
End Sub Private Const PostDataUrl As String = "https://api.redgifs.com/v2/gifs/{0}?views=yes&users=yes"
#Region "Base declarations"
Private ReadOnly Property MySettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub End Sub
#End Region
#Region "Initializer"
Friend Sub New()
UseResponserClient = True
End Sub
#End Region
#Region "Download functions"
Private NoCredentialsResponser As Response
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
NoCredentialsResponser = MySettings.NoCredentialsResponser.Copy
DownloadData(1, Token) DownloadData(1, Token)
Finally
NoCredentialsResponser.Dispose()
End Try
End Sub End Sub
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken) Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent&page={Page}" Dim _page As Func(Of String) = Function() If(Page = 1, String.Empty, $"&page={Page}")
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException) URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent{_page.Invoke}"
Dim r$ = NoCredentialsResponser.GetResponse(URL,, EDP.ThrowException)
Dim postDate$, postID$ Dim postDate$, postID$
Dim pTotal% = 0 Dim pTotal% = 0
Dim u$
Dim ut As UTypes
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Contains("gifs") Then If j.Contains("gifs") Then
pTotal = j.Value("pages").FromXML(Of Integer)(0) pTotal = j.Value("pages").FromXML(Of Integer)(0)
For Each g As EContainer In j("gifs") For Each g As EContainer In j("gifs")
postDate = g.Value("createDate") postDate = g.Value("createDate")
If Not CheckDatesLimit(postDate, DateProvider) Then Exit Sub Select Case CheckDatesLimit(postDate, DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
postID = g.Value("id") postID = g.Value("id")
If Not _TempPostsList.Contains(postID) Then _TempPostsList.Add(postID) Else Exit For If Not _TempPostsList.Contains(postID) Then _TempPostsList.Add(postID) Else Exit For
With g("urls") ObtainMedia(g, postID, postDate)
If .ListExists Then
u = If(.Item("hd"), .Item("sd")).XmlIfNothingValue
If Not u.IsEmptyString Then
ut = UTypes.Undefined
'Type 1: video
'Type 2: image
Select Case g.Value("type").FromXML(Of Integer)(0)
Case 1 : ut = UTypes.Video
Case 2 : ut = UTypes.Picture
End Select
If Not ut = UTypes.Undefined Then _TempMediaList.ListAddValue(MediaFromData(ut, u, postID, postDate))
End If
End If
End With
Next Next
End If End If
End Using End Using
End If End If
If pTotal > 0 And Page < pTotal Then DownloadData(Page + 1, Token) If pTotal > 0 And Page < pTotal Then DownloadData(Page + 1, Token)
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]") ProcessException(ex, Token, $"data downloading error [{URL}]",, True)
End Try End Try
End Sub End Sub
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken) #End Region
#Region "Media obtain, extract"
Private Sub ObtainMedia(ByVal j As EContainer, ByVal PostID As String,
Optional ByVal PostDateStr As String = Nothing, Optional ByVal PostDateDate As Date? = Nothing,
Optional ByVal State As UStates = UStates.Unknown)
Dim tMedia As UserMedia = ExtractMedia(j)
If Not tMedia.Type = UTypes.Undefined Then _
_TempMediaList.ListAddValue(MediaFromData(tMedia.Type, tMedia.URL, PostID, PostDateStr, PostDateDate, State))
End Sub End Sub
Private Shared Function ExtractMedia(ByVal j As EContainer) As UserMedia
If Not j Is Nothing Then
With j("urls")
If .ListExists Then
Dim u$ = If(.Item("hd"), .Item("sd")).XmlIfNothingValue
If Not u.IsEmptyString Then
Dim ut As UTypes = UTypes.Undefined
'Type 1: video
'Type 2: image
Select Case j.Value("type").FromXML(Of Integer)(0)
Case 1 : ut = UTypes.Video
Case 2 : ut = UTypes.Picture
End Select
Return New UserMedia(u, ut)
End If
End If
End With
End If
Return Nothing
End Function
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
If _ContentList.Exists(MissingFinder) Then
Dim url$, r$
Dim u As UserMedia
Dim j As EContainer
For i% = 0 To _ContentList.Count - 1
If _ContentList(i).State = UserMedia.States.Missing Then
ThrowAny(Token)
u = _ContentList(i)
If Not u.Post.ID.IsEmptyString Then
url = String.Format(PostDataUrl, u.Post.ID.ToLower)
Try
r = Responser.GetResponse(url,, EDP.ThrowException)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
If If(j("gif")?.Count, 0) > 0 Then
ObtainMedia(j("gif"), u.Post.ID,, u.Post.Date, UStates.Missing)
rList.Add(i)
End If
End If
End If
Catch down_ex As Exception
u.Attempts += 1
_ContentList(i) = u
End Try
Else
rList.Add(i)
End If
End If
Next
End If
Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception
ProcessException(ex, Token, $"missing data downloading error",, False)
Finally
If Not Disposed And rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
End If
End Try
End Sub
#End Region
#Region "Downloader"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String) As UserMedia #End Region
#Region "Get post data statics"
''' <summary>
''' https://thumbs4.redgifs.com/abcde-large.jpg?expires -> abcde<br/>
''' https://thumbs4.redgifs.com/abcde.mp4?expires -> abcde<br/>
''' https://www.redgifs.com/watch/abcde?rel=a -> abcde
''' </summary>
Friend Shared Function GetVideoIdFromUrl(ByVal URL As String) As String
If Not URL.IsEmptyString Then
Return RegexReplace(URL, If(URL.Contains("/watch/"), WatchIDRegex, ThumbsIDRegex))
Else
Return String.Empty
End If
End Function
Friend Shared Function GetDataFromUrlId(ByVal Obj As String, ByVal ObjIsID As Boolean, ByVal Responser As Response,
ByVal Host As Plugin.Hosts.SettingsHost) As UserMedia
Dim URL$ = String.Empty
Try
If Obj.IsEmptyString Then Return Nothing
If Not ObjIsID Then
Obj = GetVideoIdFromUrl(Obj)
If Not Obj.IsEmptyString Then Return GetDataFromUrlId(Obj, True, Responser, Host)
Else
If Host Is Nothing Then Host = Settings(RedGifsSiteKey)
If Host.Source.Available(Plugin.ISiteSettings.Download.Main, True) Then
If Responser Is Nothing Then Responser = Host.Responser.Copy
URL = String.Format(PostDataUrl, Obj.ToLower)
Dim r$ = Responser.DownloadString(URL, EDP.ThrowException)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing Then
Dim tm As UserMedia = ExtractMedia(j("gif"))
tm.Post.ID = Obj
tm.File = CStr(RegexReplace(tm.URL, FilesPattern))
If tm.File.IsEmptyString Then
tm.File.Name = Obj
Select Case tm.Type
Case UTypes.Picture : tm.File.Extension = "jpg"
Case UTypes.Video : tm.File.Extension = "mp4"
End Select
End If
Return tm
End If
End Using
End If
Else
Return New UserMedia With {.State = UStates.Missing}
End If
End If
Return Nothing
Catch ex As Exception
If Not Responser Is Nothing AndAlso (Responser.Client.StatusCode = DataGone Or Responser.Client.StatusCode = HttpStatusCode.NotFound) Then
Return New UserMedia With {.State = DataGone}
Else
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.RedGifs.UserData.GetDataFromUrlId({URL})]",
New UserMedia With {.State = UStates.Missing})
End If
End Try
End Function
#End Region
#Region "Create media"
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String,
ByVal PostDateStr As String, ByVal PostDateDate As Date?, ByVal State As UStates) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern)) _URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}} Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern)) : m.URL_BASE = m.URL If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, DateProvider, Nothing) Else m.Post.Date = Nothing If Not PostDateStr.IsEmptyString Then
m.Post.Date = AConvert(Of Date)(PostDateStr, DateProvider, Nothing)
ElseIf PostDateDate.HasValue Then
m.Post.Date = PostDateDate
Else
m.Post.Date = Nothing
End If
m.State = State
Return m Return m
End Function End Function
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer #End Region
If Responser.StatusCode = HttpStatusCode.NotFound Then #Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
Dim IsNoCredentialsResponser As Boolean = AConvert(Of Boolean)(EObj, False)
Dim s As WebExceptionStatus = -1
Dim sc As HttpStatusCode = -1
If IsNoCredentialsResponser Then
If Not NoCredentialsResponser Is Nothing Then
s = NoCredentialsResponser.Status
sc = NoCredentialsResponser.StatusCode
End If
Else
s = Responser.Client.Status
sc = Responser.Client.StatusCode
End If
If sc = HttpStatusCode.NotFound Or s = DataGone Then
UserExists = False UserExists = False
ElseIf sc = HttpStatusCode.Unauthorized Then
MyMainLOG = $"RedGifs credentials have expired [{CInt(sc)}]: {ToStringForLog()}"
Else Else
If Not FromPE Then LogError(ex, Message) : HasError = True If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0 Return 0
End If End If
Return 1 Return 1
End Function End Function
#End Region
End Class End Class
End Namespace End Namespace

View File

@@ -0,0 +1,65 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.TikTok
Friend Module Declarations
Friend ReadOnly RegexEnvir As New RegexParseEnvir
Friend ReadOnly CheckDateProvider As New CustomProvider(Function(v, d, p, n, e)
With DirectCast(v, Date?)
If .HasValue Then Return .Value Else Return Nothing
End With
End Function)
Friend Class RegexParseEnvir
Private ReadOnly UrlIdRegex As RParams = RParams.DMS("http[s]?://[w\.]{0,4}tiktok.com/[^/]+?/video/(\d+)", 1, EDP.ReturnValue)
Private ReadOnly RegexItemsArrPre As RParams = RParams.DMS("ItemList"":\{""user-post"":\{""list"":\[([^\[]+)\]", 1)
Private ReadOnly RegexItemsArr As RParams = RParams.DM("\d+", 0, RegexReturn.List)
Private ReadOnly VideoPattern As New RParams(String.Empty, Nothing, 1, EDP.ReturnValue)
Private ReadOnly DatePattern As New RParams(String.Empty, Nothing, 1, EDP.ReturnValue)
Private ReadOnly UserIdFromVideo As RParams = RParams.DMS("/\?a=(\d+)", 1, EDP.ReturnValue)
Friend Function GetIDList(ByVal r As String) As List(Of String)
Try
If Not r.IsEmptyString Then
Dim l As List(Of String) = Nothing
Dim IdArr$ = RegexReplace(r, RegexItemsArrPre)
If Not IdArr.IsEmptyString Then l = RegexReplace(IdArr, RegexItemsArr)
If l.ListExists Then l.RemoveAll(Function(id) id.IsEmptyString)
Return l
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.TikTok.RegexParseEnvir.GetIDList]")
End Try
End Function
Friend Function GetVideoData(ByVal r As String, ByVal ID As String, ByRef URL As String, ByRef [Date] As Date?) As Boolean
Try
[Date] = Nothing
URL = String.Empty
If Not r.IsEmptyString Then
VideoPattern.Pattern = "video"":\{""id"":""" & ID & """[^\}]+?""downloadAddr"":""([^""]+)"""
DatePattern.Pattern = """:{""id"":""" & ID & """,""desc"":.+?""createTime"":""(\d+)"
Dim u$ = RegexReplace(r, VideoPattern)
If Not u.IsEmptyString Then URL = SymbolsConverter.Unicode.Decode(u, EDP.ReturnValue)
Dim d$ = RegexReplace(r, DatePattern)
If Not d.IsEmptyString Then [Date] = ADateTime.ParseUnicode(d)
Return Not URL.IsEmptyString
End If
Return False
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.TikTok.RegexParseEnvir.GetVideoData]", False)
End Try
End Function
Friend Function ExtractPostID(ByVal URL As String) As String
If Not URL.IsEmptyString Then Return RegexReplace(URL, UrlIdRegex) Else Return String.Empty
End Function
Friend Function ExtractUserID(ByVal VideoUrl As String) As String
If Not VideoUrl.IsEmptyString Then Return RegexReplace(VideoUrl, UserIdFromVideo) Else Return String.Empty
End Function
End Class
End Module
End Namespace

View File

@@ -0,0 +1,42 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.TikTok
<Manifest("AndyProgram_TikTok")>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.TikTokIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.TikTokPic_192
End Get
End Property
Friend Sub New()
MyBase.New("TikTok", "www.tiktok.com")
UrlPatternUser = "https://www.tiktok.com/@{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?tiktok.com/@([^/]+)", 1)
ImageVideoContains = "tiktok.com"
End Sub
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
Return UserData.GetVideoInfo(URL, Responser)
End Function
Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0
End Function
End Class
End Namespace

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