Compare commits

..

29 Commits

Author SHA1 Message Date
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
Andy
dd272c6f6d 2022.6.6.0
Minor fixes
Fixed Twitter gifs
2022-06-06 21:32:43 +03:00
Andy
fbcda1ae75 2022.6.4.0
Added pause automation
Extended automation information
Updated automation checker
2022-06-04 02:43:46 +03:00
Andy
9e87369c9b Update ReadMe 2022-06-04 02:14:18 +03:00
Andy
cc3618a50e Update CONTRIBUTING.md 2022-06-04 02:10:44 +03:00
Andy
33b9e9cfc6 2022.6.3.0
Updated plugin environments and dependencies
Added automation
Fixed Insta hash issue
Updated groups
Added toast notifications
Updated tagged posts notifications
Updated M3U8; fixed audio issue
Extended some of log exceptions
Fixed minor bugs
Other minor improvements
2022-06-03 20:42:28 +03:00
Andy
26dca2246e Update README.md 2022-05-27 21:40:30 +03:00
Andy
60b459e217 3.0.0.10
Added downloading groups
Added downloading Twitter saved posts
Added scripts when closing and completing the download
Opening Info and Progress forms when downloads start
Disabling the opening of forms Info and Progress at the start of downloads if it was once closed
Added focusing the main window when opening Info or Progress forms
Fixed downloading Instagram tagged data
Fixed forbidden characters Instagram stories
Updated form field checkers
Fixed downloading Imgur and Gfycat if they were posted on Reddit
Fixed separate Instagram posts were not downloading via the Video Downloader form.
Date time filenames
Twitter 4K images
2022-05-23 15:51:08 +03:00
Andy
f491e03812 Merge pull request #37 from unknown81311/main
Update MainFrame.vb
2022-05-02 08:11:35 +03:00
unknown81311
418f44edfd Update MainFrame.vb 2022-04-27 19:24:37 -06:00
Andy
075a2b9b80 3.0.0.9
Updated labels class
Moved some settings from SettingsCLS to LabelsKeeper
Excluded labels
Disable user grouping
Show groups of user sites when filtering by labels
Removed adding 'No Parsed' internal label
Fixed redownloading Instagram Stories
Changed global settings form
Updated Labels form
Fixed text separator in UserCreatorForm
Add target user if hidden
2022-04-24 20:35:30 +03:00
Andy
20c74ec8f1 Update ProgramsComparison.md 2022-04-20 18:48:06 +03:00
Andy
0594e77e0b 3.0.0.8
Script mode command
Disabled Instagram error 403
Fixed script does not run
2022-04-19 14:58:56 +03:00
Andy
a5fa935e76 3.0.0.7
Added script usage
Fixed  downloading of LPSG images
Fixed Instagram Stories
Fixed date/time file pattern
2022-04-14 18:12:01 +03:00
Andy
c90dd5637e Update Plugins.md 2022-04-12 05:41:03 +03:00
Andy
9a301ebc5e 3.0.0.6
Added GoTo Start/End channels buttons
Fixed saved Reddit posts downloading
Fixed Reddit accessibility check
Disabled main progress bar progress when downloading saved posts
Added Date and Time for Stories and Tagged Photos
2022-04-04 03:00:22 +03:00
Andy
11a590f14e 3.0.0.5
Added options for Reddit channel and user
Fixed minor bugs and typos
2022-04-02 04:36:38 +03:00
Andy
975d46715c 3.0.0.4
Changed XVIDEOS.M3U8 errors
Added TryCatch to XVIDEOS.UserData.Download
Removed old declarations in UserDataBase
Changed description replacement in UserDataHost
2022-03-26 20:00:55 +03:00
Andy
726fc486ce 3.0.0.3
Added additional 'download all' options
Fixed ListImagesLoader (User.FitToAddParams)
Fixed Instagram default value of SleepTimerOnPostsLimit
Fixed XVIDEOS typo
2022-03-24 19:14:58 +03:00
Andy
ede81f9d05 Update HowToSupport.md 2022-03-23 00:41:18 +03:00
174 changed files with 12113 additions and 2556 deletions

View File

@@ -12,7 +12,7 @@ A clear and concise description of what the bug is.
**To Reproduce** **To Reproduce**
Steps to reproduce the behavior: Steps to reproduce the behavior:
1. Profile URL: 1. **Profile URL**:
2. Do something 2. Do something
3. See error 3. See error
@@ -26,8 +26,10 @@ A clear and concise description of what you expected to happen.
If applicable, add screenshots to help explain your problem. If applicable, add screenshots to help explain your problem.
**Release information (please complete the following information):** **Release information (please complete the following information):**
- OS [e.g. Windows 10, Windows 11]
- Architecture [e.g. x86, x64] - Architecture [e.g. x86, x64]
- Version [e.g. 2.0.0.0] - Version [e.g. 2.0.0.0]
- NET.Framework version
**Additional context** **Additional context**
Add any other context about the problem here. Add any other context about the problem here.

View File

@@ -1,6 +1,6 @@
--- ---
name: Add plugin name: I developed a plugin for SCrawler
about: Add plugin to plugin list about: I developed a plugin for SCrawler. Add plugin to plugin list.
title: "[NEW PLUGIN]" title: "[NEW PLUGIN]"
labels: 'New Plugin' labels: 'New Plugin'
assignees: '' assignees: ''

View File

@@ -3,30 +3,40 @@
I welcome requests! Follow these steps to contribute: I welcome requests! Follow these steps to contribute:
1. Find an [issue](https://github.com/AAndyProgram/SCrawler/issues) that needs assistance. 1. Find an [issue](https://github.com/AAndyProgram/SCrawler/issues) that needs assistance.
2. Let me know you are working on it by posting a comment on the issue. 1. Let me know you are working on it by posting a comment on the issue.
3. If you find an error in the code, please provide a link to the file and the line number. 1. If you find an error in the code, please provide a link to the file and the line number.
4. If you have a suggestion to change the code, you can post a block of code to replace. I don't currently have time to learn pull requests, so it might work this way. 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.
2. Add the latest version of the "PersonalUtilities.dll" library (from the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest)). 1. Delete the "PersonalUtilities.Notifications" project from the solution.
3. Import PersonalUtilities.Functions for the whole project. 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.
**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.
2. 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).
- If I'm interested in a site you want to add, it may be added in future releases.
- If the site has an API that does not require authorization, it may be added in the coming releases. # Requirements for new site requests
- You can make it faster by posting a link to the API. **I don't use OAuth authentication** in my application, so if it's not too hard to make a new parsing algorithm **without OAuth** authorization, I can start developing it in the coming days. Otherwise, I need time to figure out how to do it.
- If the site does not have an API that does not require authorization, this may take some time. **Attention! I'll add a new site only if I'm interested. I also have a life, and any development takes time.**
- If you will be posting request urls **without OAuth** authentication, I might consider adding your site if I have time.
- If I'm **not** interested in the site you want to add, you can pay to have it added by making a donation of approximately $10. **But before that, you still need to create an issue. If I'm not interested, you can offer me a deal to develop it for money. I'll check the site you want to add, check the availability of the API and tell you how much time I need to develop it and the price. If you agree, I will do it.** [![ko-fi](https://www.ko-fi.com/img/githubbutton_sm.svg)](https://ko-fi.com/andyprogram) - Post a link to the site's API
- Post request URLs **without OAuth** authentication
- Post a **complete cURL** request which provides the required information (JSON is better)
**I don't use OAuth authentication** in my application, so if it's not too hard to make a new parsing algorithm **without OAuth** authorization, I can start developing it in the coming days. Otherwise, I need time to figure out how to do it.
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
@@ -39,3 +49,5 @@ I welcome requests! Follow these steps to contribute:
# Contact me # Contact me
[![matrix](https://img.shields.io/badge/Matrix-%40andyprogram%3Amatrix.org-informational)](https://matrix.to/#/@andyprogram:matrix.org) [![matrix](https://img.shields.io/badge/Matrix-%40andyprogram%3Amatrix.org-informational)](https://matrix.to/#/@andyprogram:matrix.org)
[![discord](https://img.shields.io/badge/discord-AndyProgram%233804-yellowgreen)](https://discordapp.com/users/1012768226679206009) AndyProgram#3804

View File

@@ -1,5 +1,191 @@
# 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-06-06*
- Added
- Ability to pause automation
- Fixed
- GIFs from Twitter not downloading
- Not quite correct algorithm for stopping automation
# 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)
**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.**
- Added
- **Automation** (downloading data automatically every ```X``` minutes)
- Expanded settings for Instagram tagged posts that are downloaded for the first time.
- Fixed
- Videos hosted on Reddit that are downloaded via m3u8 playlists are missing an audio track.
- Instagram hash not able to be auto-filled from cookies
# 3.0.0.10
*2022-05-23*
- Added
- **Downloading groups**
- **Download saved Twitter posts** (bookmarks)
- Ability to enable/disable progress form opening at the start of downloading
- Ability to enable/disable Info form opening at the start of downloading
- The ability to disable the opening of forms Info and Progress at the start of downloads if it was once closed
- Focusing the main window when opening Info or Progress forms
- Ability to execute a script/command when closing SCrawler
- Ability to execute a script/command after all downloads are completed
- Minor improvements
- Fixed
- Instagram tagged data not downloading (now requires one more parameter **x-csrftoken** to download tagged data)
- In some cases, Instagram Stories cannot be downloaded due to forbidden Windows characters
- Separate Instagram posts were not downloading via the Video Downloader form.
- In some cases, an Imgur video hosted on Reddit won't download
- Gfycat data not downloading from saved Reddit posts
- In some cases, the date and time are not added to the filename
- Unable to download photos from Twitter in full resolution (4K)
# 3.0.0.9
*2022-04-24*
- Added
- Excluded labels
- Ability to disable user grouping
- Ability to show groups of user sites when filtering by labels
- Fixed
- Removed adding "No Parsed" internal label when not needed
- Redownloading Instagram Stories
# 3.0.0.8
*2022-04-19*
- Added
- Script mode ```command```
- Disabled Instagram error 403 (Forbidden) logging for downloading tagged data
- Fixed
- The script does not run after the user download is complete
# 3.0.0.7
*2022-04-14*
- Added
- Ability to run a script after the user download is complete
- Hotkey ```F2``` for additional options in the user creation form
- Fixed
- (Issue #32) In some cases, Date and Time are still not added for Stories and Tagged Photos
- (Issue #33) Instagram Stories downloading error
- LPSG downloader does not download all content
# 3.0.0.6
*2022-04-04*
- Added
- ```GoTo Start``` channels button
- ```GoTo End``` channels button
- Fixed
- In some cases, saved Reddit posts didn't fully download
- Incorrect Reddit accessibility check algorithm
- Incorrect behavior of the main progress bar when downloading saved posts
- (Issue #25) Date and Time not added for Stories and Tagged Photos
# 3.0.0.5
*2022-04-02*
- Added
- ```New```, ```Hot```, ```Top``` Reddit channel and user download modes
# 3.0.0.4
*2022-03-26*
- Fixed
- External plugins do not save information about downloaded files
- The user cannot be added to the collection if a special path has been specified.
# 3.0.0.3
*2022-03-24*
- Added
- Download all by specific sites
- Download all, ignoring the ```Ready for download``` option
- Download all by specific sites, ignoring the ```Ready for download``` option
- Fixed
- (Issue #19) Typo in default Instagram settings (Post limit timer)
- Typo when applying "Download UHD" in XVIDEOS plugin
- The sites filter does not work unless the "Fast profiles loading" option is enabled.
# 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
@@ -10,6 +196,8 @@
# 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)
@@ -23,6 +211,8 @@
# 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
@@ -63,6 +253,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**
@@ -77,6 +269,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**
@@ -92,6 +286,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
@@ -114,6 +310,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
@@ -122,6 +320,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
@@ -139,6 +339,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
@@ -160,6 +362,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
@@ -168,12 +372,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
@@ -182,6 +390,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
@@ -204,4 +414,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

34
FAQ.md
View File

@@ -2,6 +2,8 @@
**Please read the [GUIDE](https://github.com/AAndyProgram/SCrawler/wiki/) Before asking a question!** **Please read the [GUIDE](https://github.com/AAndyProgram/SCrawler/wiki/) Before asking a question!**
**Also read [here](README.md) for basic information.**
Most of your questions are already answered. All settings, functions, buttons and everything else described in the guide. Most of your questions are already answered. All settings, functions, buttons and everything else described in the guide.
Any other questions I will keep in this file. Any other questions I will keep in this file.
@@ -44,6 +46,30 @@ A: Check your credentials. Both of these sites require cookies. Check your [Twit
---- ----
#### Q: **I have set credentials but still nothing is downloading**
A: Click the ```Start downloading``` button
----
#### Q: **Where can I find the release?**
A: https://github.com/AAndyProgram/SCrawler/releases/latest
----
#### Q: **How to run the program?**
A: Double-click ```SCrawler.exe```
----
#### Q: **Where to find binaries?**
A: https://github.com/AAndyProgram/SCrawler/releases/latest
----
#### Q: **Does the program remember the last download and check for new posts, downloading only new posts? Or does the program download the entire profile every time?** #### Q: **Does the program remember the last download and check for new posts, downloading only new posts? Or does the program download the entire profile every time?**
A: The program stored posts IDs in users' folders. For the first time, the program downloads the entire profile. All subsequent times the program will check for new posts and download **only new posts**! A: The program stored posts IDs in users' folders. For the first time, the program downloads the entire profile. All subsequent times the program will check for new posts and download **only new posts**!
@@ -64,4 +90,10 @@ A: There is no functionality to remove an individual label. You can open the ```
#### Q: **How to remove a user from the blacklist** #### Q: **How to remove a user from the blacklist**
A: Just add that user back to the program. In the dialog box that opens, click on the ```Add and remove from blacklist```` button. A: Just add that user back to the program. In the dialog box that opens, click on the ```Add and remove from blacklist``` button.
----
#### Q: **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.

View File

@@ -2,10 +2,10 @@ Your support is very valuable to me. Any support is greatly appreciated. Your su
You can support the program by: You can support the program by:
- **Bitcoin**: bitcoin:BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET - **Bitcoin**: bitcoin:BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET
- :heavy_dollar_sign: making donaion making donations on this site: https://ko-fi.com/andyprogram - :heavy_dollar_sign: make a donation on this site: https://ko-fi.com/andyprogram
- :repeat: make a post about my program on your profile (Reddit, Twitter, Instagram and any other social networks) - :repeat: make a post about my program on your profile (Reddit, Twitter, Instagram and any other social networks)
- :speech_balloon: tell your friends about the program - :speech_balloon: tell your friends about the program
- :heart: like the program on this site: https://alternativeto.net/software/scrawler/about/ - :heart: like the program on this site: https://alternativeto.net/software/scrawler/about/
- suggest my program as an alternative ([on this site](https://alternativeto.net/software/scrawler/about/)) to any program you have used before - suggest my program as an alternative ([on this site](https://alternativeto.net/software/scrawler/about/)) to any program you have used before
I would be very grateful for any support! :blush: I would be very grateful for any support! :blush:

View File

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

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 15 KiB

After

Width:  |  Height:  |  Size: 17 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 574 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 7.4 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 11 KiB

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 21 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 369 KiB

After

Width:  |  Height:  |  Size: 370 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 377 KiB

After

Width:  |  Height:  |  Size: 379 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.4 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 6.3 KiB

After

Width:  |  Height:  |  Size: 7.7 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 10 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 10 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.5 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 23 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 7.6 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 26 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 15 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

View File

@@ -5,6 +5,8 @@ https://www.4kdownload.com/products/product-stogram
| Option | SCrawler | 4K Stogram | | Option | SCrawler | 4K Stogram |
| ---- | ---- | ---- | | ---- | ---- | ---- |
| User managament | **Advanced** | Primitive | | User managament | **Advanced** | Primitive |
| Automatic downloads | **Yes** | No |
| Downloading groups | **Yes** | No |
| Labeling users | **Yes** | No | | Labeling users | **Yes** | No |
| Filtering | **Yes** | No | | Filtering | **Yes** | No |
| Collections | **Yes** | No | | Collections | **Yes** | No |
@@ -16,10 +18,10 @@ 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 | No (only limited download) | **Yes** | | Save Instagram Posts by Date | Yes | Yes |
| Download Instagram Saved Posts | Yes | Yes | | Download Instagram Saved Posts | Yes | Yes |
| Download Instagram Tagged Posts | Yes | Yes | | Download Instagram Tagged Posts | Yes | Yes |
| Export and import subscriptions | No | **Yes** | | Export and import subscriptions | No | **Yes** |
@@ -29,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 |
@@ -44,6 +46,8 @@ https://github.com/RipMeApp/ripme
| Option | SCrawler | RipMeApp | | Option | SCrawler | RipMeApp |
| ---- | ---- | ---- | | ---- | ---- | ---- |
| User managament | **Advanced** | No | | User managament | **Advanced** | No |
| Automatic downloads | **Yes** | No |
| Downloading groups | **Yes** | No |
| Labeling users | **Yes** | No | | Labeling users | **Yes** | No |
| Filtering | **Yes** | No | | Filtering | **Yes** | No |
| Collections | **Yes** | No | | Collections | **Yes** | No |
@@ -62,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)** |
@@ -75,4 +79,4 @@ https://github.com/mikf/gallery-dl
**CLI tool**! Configured with JSON files only. Users need to learn complex configuration options, JSON, commands to use that tool. Very difficult to configure. **CLI tool**! Configured with JSON files only. Users need to learn complex configuration options, JSON, commands to use that tool. Very difficult to configure.
SCrawler has advanced user management, collections, labels, groups, a beautiful view, GUI, the ability to add plugins for other sites and much more. Just try it and compare. SCrawler has advanced user management, collections, labels, groups, automatic downloads, a beautiful view, GUI, the ability to add plugins for other sites and much more. Just try it and compare.

View File

@@ -1,7 +1,7 @@
# 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](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/) [![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE)
[![FAQ](https://img.shields.io/badge/FAQ-green)](FAQ.md) [![FAQ](https://img.shields.io/badge/FAQ-green)](FAQ.md)
[![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)
@@ -21,20 +21,25 @@ Do you like this program? Consider adding to my coffee fund by making a donation
- Download pictures and videos from users' profiles and subreddits: - Download pictures and videos from users' profiles and subreddits:
- Reddit images; - Reddit images;
- Reddit galleries of images; - Reddit galleries of images;
- Redgifs hosted videos (https://www.redgifs.com/); - Reddit videos (downloading Reddit hosted video is going through ffmpeg (**ffmpeg only works with the x64 program**));
- Reddit hosted videos (downloading Reddit hosted video is going through ffmpeg (**ffmpeg only works with the x64 program**)); - Redgifs videos (https://www.redgifs.com/);
- Twitter images and videos; - Twitter images and videos;
- Instagram images and videos. - Instagram images and videos;
- Imgur images, galleries and videos - Instagram tagged posts;
- Gfycat videos - Instagram stories;
- Imgur images, galleries and videos;
- Gfycat videos;
- [Other](#supported-sites) supported sites - [Other](#supported-sites) supported sites
- Parse [channel and view data](https://github.com/AAndyProgram/SCrawler/wiki/Channels). - Parse [channel and view data](https://github.com/AAndyProgram/SCrawler/wiki/Channels)
- Download [saved Reddit and Instagram posts](https://github.com/AAndyProgram/SCrawler/wiki/Home#saved-posts). - Download [saved Reddit, Twitter and Instagram posts](https://github.com/AAndyProgram/SCrawler/wiki/Home#saved-posts)
- Add users from parsed channel. - Add users from parsed channel
- **Advanced user management.** - **Advanced user management**
- Labeling users. - **Automation** (downloading data automatically every ```X``` minutes)
- Adding users to favorites and temporary. - **Feed** (feed of downloaded media files)
- Filter exists users by label or group. - Labeling users
- Create download groups
- Adding users to favorites and temporary
- Filter exists users by label or group
- Selection of media types you want to download (images only, videos only, both) - Selection of media types you want to download (images only, videos only, both)
- Download a special video, image or gallery - Download a special video, image or gallery
- Making collections (grouping users into collections) - Making collections (grouping users into collections)
@@ -75,7 +80,7 @@ Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about
# Requirements # Requirements
- Windows 7, 8, 9, 10, 11 with NET Framework 4.6.1 or higher - 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) - 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 - 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.** - 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.**
@@ -86,7 +91,7 @@ Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about
# Installation # Installation
**Just unzip the program archive to any folder, copy the file ```ffmpeg.exe``` into it and enjoy.** :blush: **Just download the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest), unzip the program archive to any folder, copy the file ```ffmpeg.exe``` into it and enjoy.** :blush:
**Don't put program in the ```Program Files``` system folder (this is portable program and program settings are stored in the program folder)** **Don't put program in the ```Program Files``` system folder (this is portable program and program settings are stored in the program folder)**
@@ -96,9 +101,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. Add the latest version of the "PersonalUtilities.dll" library (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
@@ -114,9 +117,9 @@ The program has an intuitive interface.
You need to set up authorization for Twitter and Instagram: You need to set up authorization for Twitter and Instagram:
- 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 [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** - Authorization [cookies](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies), [Hash](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram) and [authorization headers](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-instagram-authorization-headers) 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**
Just add a user profile and click the ```Start downloading``` button. Just add a user profile and **click the ```Start downloading``` button**.
You can add users by patterns: You can add users by patterns:
- https://www.instagram.com/SomeUserName - https://www.instagram.com/SomeUserName
@@ -144,3 +147,5 @@ Example: ```D:\Programs\SCrawler\SCrawler.exe v```
# Contact me # Contact me
[![matrix](https://img.shields.io/badge/Matrix-%40andyprogram%3Amatrix.org-informational)](https://matrix.to/#/@andyprogram:matrix.org) [![matrix](https://img.shields.io/badge/Matrix-%40andyprogram%3Amatrix.org-informational)](https://matrix.to/#/@andyprogram:matrix.org)
[![discord](https://img.shields.io/badge/discord-AndyProgram%233804-yellowgreen)](https://discordapp.com/users/1012768226679206009) AndyProgram#3804

View File

@@ -9,10 +9,15 @@
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Friend Module Declarations Friend Module Declarations
Friend ReadOnly Property PhotoRegEx As RParams = RParams.DM("(https://www.lpsg.com/attachments)(.+?)(?="")", 0, RegexReturn.List) 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) Friend ReadOnly Property NextPageRegex As RParams = RParams.DMS("<link rel=""next"" href=""(.+?/page-(\d+))""", 2)
Private Const FileUrlRegexDefault As String = "(.+[^/]+?)(jpg|jpeg|gif|png)" 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 { Friend ReadOnly Property FileRegEx As New RParams(FileUrlRegexDefault, Nothing, 0) With {
.Converter = Function(ByVal Input As String) As String .Converter = Function(ByVal Input As String) As String
Input = InputForbidRemover.Invoke(Input)
If Not Input.IsEmptyString Then If Not Input.IsEmptyString Then
Dim lv$ = Input.Split("-").LastOrDefault Dim lv$ = Input.Split("-").LastOrDefault
If Not lv.IsEmptyString Then If Not lv.IsEmptyString Then
@@ -22,5 +27,8 @@ Friend Module Declarations
End If End If
Return Input Return Input
End Function} 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 FileExistsRegEx As RParams = RParams.DMS(FileUrlRegexDefault, 2)
Friend ReadOnly TempListAddParams As New ListAddParams(LAP.NotContainsOnly) With {.Comparer = New FComparer(Of PluginUserMedia)(Function(x, y) x.URL = y.URL)}
End Module End Module

View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("LPSG plugin for SCrawler")> <Assembly: AssemblyDescription("LPSG plugin for SCrawler")>
<Assembly: AssemblyCompany("AndyProgram")> <Assembly: AssemblyCompany("AndyProgram")>
<Assembly: AssemblyProduct("LPSG")> <Assembly: AssemblyProduct("LPSG")>
<Assembly: AssemblyCopyright("Copyright © 2022")> <Assembly: AssemblyCopyright("Copyright © 2022")>
<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("1.0.0.0")> <Assembly: AssemblyVersion("2022.9.8.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")> <Assembly: AssemblyFileVersion("2022.9.8.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
@@ -81,7 +81,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
@@ -91,10 +91,13 @@ Public Class SiteSettings : Implements ISiteSettings
Public Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable(Of PluginUserMedia) Implements ISiteSettings.GetSpecialData Public Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable(Of PluginUserMedia) Implements ISiteSettings.GetSpecialData
Return Nothing Return Nothing
End Function End Function
Public Function Available(ByVal What As ISiteSettings.Download) 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 True
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

@@ -7,6 +7,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 PersonalUtilities.Functions.RegularExpressions
Imports UStates = SCrawler.Plugin.PluginUserMedia.States
Imports UTypes = SCrawler.Plugin.PluginUserMedia.Types
Imports Converters = PersonalUtilities.Functions.SymbolsConverter.Converters
Public Class UserData : Implements IPluginContentProvider Public Class UserData : Implements IPluginContentProvider
#Region "XML names" #Region "XML names"
Private Const Name_LatestPage As String = "LatestPage" Private Const Name_LatestPage As String = "LatestPage"
@@ -58,14 +61,14 @@ Public Class UserData : Implements IPluginContentProvider
#End Region #End Region
Private Property LatestPage As String = String.Empty Private Property LatestPage As String = String.Empty
Private Property Responser As Response = Nothing Private Property Responser As Response = Nothing
Private Enum Mode : Internal : External : End Enum
Public Sub GetMedia() Implements IPluginContentProvider.GetMedia Public Sub GetMedia() Implements IPluginContentProvider.GetMedia
Try Try
If Not Responser Is Nothing Then Responser.Dispose() If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Response Responser = New Response
With Responser : .Copy(Settings.Responser) : .Error = EDP.ThrowException : End With With Responser : .Copy(Settings.Responser) : .Error = EDP.ThrowException : End With
Dim l As List(Of String) = Nothing Dim NextPage$
Dim NextPage$ = String.Empty
Dim r$ Dim r$
Dim _LPage As Func(Of String) = Function() If(LatestPage.IsEmptyString, String.Empty, $"page-{LatestPage}") Dim _LPage As Func(Of String) = Function() If(LatestPage.IsEmptyString, String.Empty, $"page-{LatestPage}")
@@ -76,35 +79,60 @@ Public Class UserData : Implements IPluginContentProvider
Thrower.ThrowAny() Thrower.ThrowAny()
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
NextPage = RegexReplace(r, NextPageRegex) NextPage = RegexReplace(r, NextPageRegex)
l.ListAddList(RegexReplace(r, PhotoRegEx), LAP.NotContainsOnly) UpdateMediaList(RegexReplace(r, PhotoRegEx), Mode.Internal)
UpdateMediaList(RegexReplace(r, PhotoRegExExt), Mode.External)
If NextPage = LatestPage Or NextPage.IsEmptyString Then Exit Do Else LatestPage = NextPage If NextPage = LatestPage Or NextPage.IsEmptyString Then Exit Do Else LatestPage = NextPage
Else Else
Exit Do Exit Do
End If End If
Loop Loop
If l.ListExists Then If TempMediaList.ListExists And ExistingContentList.ListExists Then _
Dim f As SFile TempMediaList.RemoveAll(Function(m) ExistingContentList.Exists(Function(mm) mm.URL = m.URL))
For Each u$ In l
If Not IsEmptyString(RegexReplace(u, FileExistsRegEx)) Then
f = CStr(RegexReplace(u, FileRegEx))
f.Path = DataPath.CSFilePSN
f.Separator = "\"
TempMediaList.Add(New PluginUserMedia With {.ContentType = PluginUserMedia.Types.Picture, .URL = u, .File = f})
End If
Next
If TempMediaList.ListExists And ExistingContentList.ListExists Then _
TempMediaList.RemoveAll(Function(m) ExistingContentList.Exists(Function(mm) mm.URL = m.URL))
End If
Catch oex As OperationCanceledException Catch oex As OperationCanceledException
Catch dex As ObjectDisposedException Catch dex As ObjectDisposedException
Catch ex As Exception Catch ex As Exception
LogProvider.Add(ex, "[LPSG.UserData.GetMedia]") If Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
LogProvider.Add("LPSG not available")
Else
LogProvider.Add(ex, $"[LPSG.UserData.GetMedia({Name})]")
End If
End Try End Try
End Sub 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 = DataPath.CSFilePSN
f.Separator = "\"
If f.Extension.IsEmptyString Then f.Extension = "jpg"
TempMediaList.ListAddValue(New PluginUserMedia With {.ContentType = UTypes.Picture, .URL = url, .File = f}, TempListAddParams)
End If
End If
Next
End If
End Sub
Public Sub Download() Implements IPluginContentProvider.Download Public Sub Download() Implements IPluginContentProvider.Download
Try Try
With Responser : .UseWebClient = True : .UseWebClientCookies = True : End With With Responser : .UseWebClient = True : .UseWebClientCookies = True : .ResetError() : End With
If TempMediaList.ListExists Then If TempMediaList.ListExists Then
Dim m As PluginUserMedia Dim m As PluginUserMedia
Dim eweb As ErrorsDescriber = EDP.ThrowException Dim eweb As ErrorsDescriber = EDP.ThrowException
@@ -112,15 +140,20 @@ Public Class UserData : Implements IPluginContentProvider
For i% = 0 To TempMediaList.Count - 1 For i% = 0 To TempMediaList.Count - 1
Thrower.ThrowAny() Thrower.ThrowAny()
m = TempMediaList(i) m = TempMediaList(i)
m.DownloadState = PluginUserMedia.States.Tried m.DownloadState = UStates.Tried
Try Try
If Not m.URL.IsEmptyString And Not m.File.IsEmptyString Then If Not m.URL.IsEmptyString And Not m.File.IsEmptyString Then
Responser.DownloadFile(m.URL, m.File, eweb) Responser.DownloadFile(m.URL, m.File, eweb)
m.DownloadState = PluginUserMedia.States.Downloaded m.DownloadState = UStates.Downloaded
Else Else
m.DownloadState = PluginUserMedia.States.Skipped m.DownloadState = UStates.Skipped
End If
Catch wex As Exception
If Responser.Client.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
LogProvider.Add("LPSG not available")
Else
m.DownloadState = UStates.Skipped
End If End If
Catch ex As Exception
End Try End Try
RaiseEvent ProgressChanged(1) RaiseEvent ProgressChanged(1)
TempMediaList(i) = m TempMediaList(i) = m

View File

@@ -41,13 +41,13 @@ Friend NotInheritable Class M3U8
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
Logger.Add(ex, "[M3U8.Save]") Logger.Add(ex, "[M3U8.Save]")
Return Nothing ex.HelpLink = 1
Throw ex
Finally Finally
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
@@ -61,8 +61,8 @@ Friend NotInheritable Class M3U8
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
Logger.Add(ex, "[M3U8.Download]") If Not ex.HelpLink = 1 Then Logger.Add(ex, $"[M3U8.Download({URL}, {Appender}, {ffmpegFile}, {f})]")
Return Nothing Throw ex
End Try End Try
End Function End Function
End Class End Class

View File

@@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("XVIDEOS plugin for SCrawler")> <Assembly: AssemblyDescription("XVIDEOS plugin for SCrawler")>
<Assembly: AssemblyCompany("AndyProgram")> <Assembly: AssemblyCompany("AndyProgram")>
<Assembly: AssemblyProduct("XVIDEOS")> <Assembly: AssemblyProduct("XVIDEOS")>
<Assembly: AssemblyCopyright("Copyright © 2022")> <Assembly: AssemblyCopyright("Copyright © 2022")>
<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("1.0.0.0")> <Assembly: AssemblyVersion("2022.9.8.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")> <Assembly: AssemblyFileVersion("2022.9.8.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(True)
.MyViewInitialize(Me, Settings.Design, 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 ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK 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 ToolbarBttCancel() Implements IOkCancelToolbar.ToolbarBttCancel Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbar.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 EditToolbar.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
@@ -78,12 +77,12 @@ Public Class SiteSettings : Implements ISiteSettings
If Not ACheck(SiteDomains.Value) Then SiteDomains.Value = DomainsDefault If Not ACheck(SiteDomains.Value) Then SiteDomains.Value = DomainsDefault
Domains.ListAddList(CStr(SiteDomains.Value).Split("|"), LAP.NotContainsOnly, LAP.ClearBeforeAdd) Domains.ListAddList(CStr(SiteDomains.Value).Split("|"), LAP.NotContainsOnly, LAP.ClearBeforeAdd)
Domains.ListAddList(DomainsDefault.Split("|"), LAP.NotContainsOnly) Domains.ListAddList(DomainsDefault.Split("|"), LAP.NotContainsOnly)
SiteDomains.Value = Domains.ListToString(, "|") SiteDomains.Value = Domains.ListToString("|")
_DomainsUpdateInProgress = False _DomainsUpdateInProgress = False
End If End If
End Sub End Sub
#Region "Downloading" #Region "Downloading"
Public Function Available(ByVal What As ISiteSettings.Download) As Boolean Implements ISiteSettings.Available Public Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean Implements ISiteSettings.Available
Return UseM3U8 Return UseM3U8
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
@@ -109,10 +108,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 +179,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

@@ -10,10 +10,12 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports UStates = SCrawler.Plugin.PluginUserMedia.States
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
@@ -54,7 +56,14 @@ 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)
@@ -71,7 +80,7 @@ Public Class UserData : Implements IPluginContentProvider
Thrower.ThrowAny() Thrower.ThrowAny()
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 If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True
j = JsonDocument.Parse(r).XmlIfNothing j = JsonDocument.Parse(r).XmlIfNothing
With j With j
If .Contains("videos") Then If .Contains("videos") Then
@@ -90,6 +99,7 @@ Public Class UserData : Implements IPluginContentProvider
End If End If
End With End With
Else Else
.Dispose()
Exit Do Exit Do
End If End If
.Dispose() .Dispose()
@@ -102,9 +112,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
@@ -146,8 +154,8 @@ 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 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()
m = $"{appender}/{ls(0).Value}" m = $"{appender}/{ls(0).Value}"
@@ -164,7 +172,7 @@ Public Class UserData : Implements IPluginContentProvider
End If End If
If Not m.IsEmptyString Then If Not m.IsEmptyString Then
Return New PluginUserMedia With { Return New PluginUserMedia With {
.ContentType = PluginUserMedia.Types.m3u8, .ContentType = UTypes.m3u8,
.PostID = pID, .PostID = pID,
.URL = m, .URL = m,
.File = $"{t}.mp4", .File = $"{t}.mp4",
@@ -194,9 +202,14 @@ Public Class UserData : Implements IPluginContentProvider
m = TempMediaList(i) m = TempMediaList(i)
f = m.File f = m.File
f.Path = DefPath f.Path = DefPath
f = M3U8.Download(m.URL, m.SpecialFolder, Settings.FfmpegFile, f, LogProvider) m.DownloadState = UStates.Tried
m.File = f Try
If Not f.IsEmptyString Then m.DownloadState = PluginUserMedia.States.Downloaded f = M3U8.Download(m.URL, m.SpecialFolder, Settings.FfmpegFile, f, LogProvider)
m.File = f
m.DownloadState = UStates.Downloaded
Catch ex As Exception
m.DownloadState = UStates.Skipped
End Try
TempMediaList(i) = m TempMediaList(i) = m
RaiseEvent ProgressChanged(1) RaiseEvent ProgressChanged(1)
Next Next

View File

@@ -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>

View File

@@ -23,6 +23,7 @@ Namespace Plugin
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(Of PluginUserMedia)
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
@@ -33,7 +34,7 @@ Namespace Plugin
Sub EndUpdate() Sub EndUpdate()
#End Region #End Region
#Region "Site availability" #Region "Site availability"
Function Available(ByVal What As Download) As Boolean Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
Function ReadyToDownload(ByVal What As Download) As Boolean Function ReadyToDownload(ByVal What As Download) As Boolean
#End Region #End Region
#Region "Downloading" #Region "Downloading"

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 © 2022")>
<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("3.0.0.2")> <Assembly: AssemblyVersion("2022.9.8.0")>
<Assembly: AssemblyFileVersion("3.0.0.2")> <Assembly: AssemblyFileVersion("2022.9.8.0")>
<Assembly: NeutralResourcesLanguage("en")> <Assembly: NeutralResourcesLanguage("en")>

View File

@@ -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

@@ -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

View File

@@ -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

@@ -21,6 +21,8 @@ Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.Plugin.LPSG", "SCr
EndProject EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.Plugin.XVIDEOS", "SCrawler.Plugin.XVIDEOS\SCrawler.Plugin.XVIDEOS.vbproj", "{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}" Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "SCrawler.Plugin.XVIDEOS", "SCrawler.Plugin.XVIDEOS\SCrawler.Plugin.XVIDEOS.vbproj", "{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}"
EndProject EndProject
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "PersonalUtilities.Notifications", "..\..\MyUtilities\PersonalUtilities.Notifications\PersonalUtilities.Notifications.vbproj", "{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}"
EndProject
Global Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU Debug|Any CPU = Debug|Any CPU
@@ -91,6 +93,18 @@ Global
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Release|x64.Build.0 = 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.ActiveCfg = Release|x86
{CCCF47F4-C97C-4193-AC4B-C56DF2F9AA8A}.Release|x86.Build.0 = 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.Build.0 = Debug|Any CPU
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Debug|x64.ActiveCfg = Debug|x64
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Debug|x64.Build.0 = Debug|x64
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Debug|x86.ActiveCfg = Debug|x86
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Debug|x86.Build.0 = Debug|x86
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Release|Any CPU.ActiveCfg = Release|Any CPU
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Release|Any CPU.Build.0 = Release|Any CPU
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Release|x64.ActiveCfg = Release|x64
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Release|x64.Build.0 = Release|x64
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Release|x86.ActiveCfg = Release|x86
{FC532253-1AB3-4DEF-A28A-DFDD9A481EB2}.Release|x86.Build.0 = Release|x86
EndGlobalSection EndGlobalSection
GlobalSection(SolutionProperties) = preSolution GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE HideSolutionNode = FALSE

View File

@@ -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,32 +26,39 @@ 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
Friend Shared Function GetData(ByVal Site As String) As List(Of Data) Friend Shared Function GetData(ByVal Site As String) As List(Of Data)
Try Try
Dim l As List(Of Data) = Nothing Dim l As List(Of Data) = Nothing
Dim l2 As List(Of Data) = Nothing
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
Dim lDate As Date = l(0).Date
Dim i%
Dim indx% = -1
For i = 1 To l.Count - 1
If l(i).Date < lDate Then indx = i : Exit For Else lDate = l(i).Date
Next
If indx >= 0 Then
For i = indx To 0 Step -1 : l.RemoveAt(i) : Next
End If
l.Sort() l.Sort()
l2 = New List(Of Data)
Dim d As Data
Dim eDates As New List(Of Date)
Dim MaxValue As Func(Of Date, Integer) = Function(dd) (From ddd In l Where ddd.Date = dd Select ddd.Value).DefaultIfEmpty(0).Max
For i% = 0 To l.Count - 1
If Not eDates.Contains(l(i).Date) Then
d = l(i)
d.Value = MaxValue(d.Date)
l2.Add(d)
eDates.Add(d.Date)
End If
Next
eDates.Clear()
l.Clear()
l2.Sort()
End If End If
End If End If
End Using End Using
Return l Return l2
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"[DownDetector.GetData({Site})]") Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"[DownDetector.GetData({Site})]")
End Try End Try

View File

@@ -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
@@ -21,17 +21,14 @@ Namespace API.Base
Friend Sub Download(ByVal Token As CancellationToken) Friend Sub Download(ByVal Token As CancellationToken)
Try Try
If HOST.Source.ReadyToDownload(PDownload.SavedPosts) Then If HOST.Source.ReadyToDownload(PDownload.SavedPosts) Then
If HOST.Available(PDownload.SavedPosts) Then If HOST.Available(PDownload.SavedPosts, False) Then
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 Or Not HOST.IsMyClass) 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

View File

@@ -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,6 +50,7 @@ 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
@@ -63,6 +78,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
@@ -91,7 +109,7 @@ Namespace API.Base
End Function End Function
#End Region #End Region
#Region "Ready, Available" #Region "Ready, Available"
Friend Overridable Function Available(ByVal What As Download) As Boolean Implements ISiteSettings.Available Friend Overridable Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean Implements ISiteSettings.Available
Return True Return True
End Function 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

View File

@@ -18,7 +18,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,6 +27,7 @@ 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
@@ -106,12 +107,12 @@ 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 IComparable(Of Sizes)
Friend Value As Integer Friend Value As Integer

View File

@@ -9,6 +9,7 @@
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
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.WEB
Imports System.IO Imports System.IO
Imports System.Net Imports System.Net
@@ -20,28 +21,33 @@ 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
Next Try : UserUpdatedEventHandlers(i).Invoke(User) : Catch : End Try
End If Next
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
@@ -77,11 +83,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
@@ -115,9 +121,14 @@ Namespace API.Base
Private Const Name_PicturesCount As String = "PicturesCount" Private Const Name_PicturesCount As String = "PicturesCount"
Private Const Name_LastUpdated As String = "LastUpdated" Private Const Name_LastUpdated As String = "LastUpdated"
Private Const Name_ScriptUse As String = "ScriptUse"
Private Const Name_ScriptData As String = "ScriptData"
Private Const Name_DataMerging As String = "DataMerging" Private Const Name_DataMerging As String = "DataMerging"
#Region "Downloaded data" #Region "Downloaded data"
Private Const Name_MediaType As String = "Type" 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_MediaURL As String = "URL"
Private Const Name_MediaHash As String = "Hash" Private Const Name_MediaHash As String = "Hash"
Private Const Name_MediaFile As String = "File" Private Const Name_MediaFile As String = "File"
@@ -126,12 +137,21 @@ Namespace API.Base
#End Region #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
@@ -148,7 +168,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
@@ -170,7 +191,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
@@ -191,37 +212,39 @@ 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
Return GetPicture() Return GetPicture(Of Image)()
Else Else
Return Nothing Return Nothing
End If End If
End Function End Function
Friend Function GetUserPictureToastAddress() As SFile
Return GetPicture(Of SFile)(False, True)
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(Optional ByVal ReturnNullImageOnNothing As Boolean = True) As Image 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 f As SFile = Nothing Dim f As SFile = Nothing
Dim p As UserImage = Nothing Dim p As UserImage = Nothing
Dim DelPath As Boolean = True Dim DelPath As Boolean = True
@@ -248,11 +271,11 @@ BlockPictureFolder:
End If End If
BlockPictureScan: BlockPictureScan:
On Error GoTo BlockDeletePictureFolder On Error GoTo BlockDeletePictureFolder
Dim NewPicFile As SFile = SFile.GetFiles(MyFile.CutPath, "*.jpg|*.png",, Dim NewPicFile As SFile = SFile.GetFiles(MyFile.CutPath, "*.jpg|*.jpeg|*.png",,
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
@@ -267,18 +290,27 @@ 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
Select Case Settings.ViewMode.Value Dim a As SFile = Nothing
Case View.LargeIcon : i = p.Large.OriginalImage.Clone If rsfile Then
Case View.SmallIcon : i = p.Small.OriginalImage.Clone If GetToast Then
End Select a = p.Large.Address
Else
a = p.Address
End If
Else
Select Case Settings.ViewMode.Value
Case View.LargeIcon : i = p.Large.OriginalImage.Clone
Case View.SmallIcon : i = p.Small.OriginalImage.Clone
End Select
End If
p.Dispose() p.Dispose()
Return i If rsfile Then Return CObj(a) Else Return CObj(i)
End If End If
BlockNullPicture: BlockNullPicture:
If ReturnNullImageOnNothing Then If ReturnNullImageOnNothing Then
Select Case Settings.ViewMode.Value Select Case Settings.ViewMode.Value
Case View.LargeIcon : Return GetNullPicture(Settings.MaxLargeImageHeigh) Case View.LargeIcon : Return CObj(GetNullPicture(Settings.MaxLargeImageHeight))
Case View.SmallIcon : Return GetNullPicture(Settings.MaxSmallImageHeigh) Case View.SmallIcon : Return CObj(GetNullPicture(Settings.MaxSmallImageHeight))
End Select End Select
End If End If
Return Nothing Return Nothing
@@ -292,7 +324,7 @@ BlockNullPicture:
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
@@ -321,18 +353,47 @@ 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
If _ContentList.Count > 0 Then
Return _ContentList.LastOrDefault(Function(c) c.Type = UTypes.Picture And Not c.File.IsEmptyString And Not c.File.Extension = "gif").File
Else
Return Nothing
End If
End Function
#End Region #End Region
#Region "Files" #Region "Files"
Friend Overridable Property MyFile As SFile Implements IUserData.File Friend Overridable Property MyFile As SFile Implements IUserData.File
@@ -360,7 +421,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
@@ -404,12 +465,34 @@ 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}"
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
#Region "Script"
Friend Overridable Property ScriptUse As Boolean = False Implements IUserData.ScriptUse
Friend Overridable Property ScriptData As String Implements IUserData.ScriptData
#End Region #End Region
#End Region #End Region
#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
@@ -469,6 +552,7 @@ BlockNullPicture:
Get Get
If Settings.LastUpdatedDate.HasValue AndAlso LastUpdated.HasValue AndAlso If Settings.LastUpdatedDate.HasValue AndAlso LastUpdated.HasValue AndAlso
LastUpdated.Value.Date > Settings.LastUpdatedDate.Value.Date Then Return False LastUpdated.Value.Date > Settings.LastUpdatedDate.Value.Date Then Return False
If Not Settings.Labels.ExcludedIgnore AndAlso Settings.Labels.Excluded.ValuesList.ListContains(Labels) Then Return False
If Settings.SelectedSites.Count = 0 OrElse Settings.SelectedSites.Contains(Site) Then If Settings.SelectedSites.Count = 0 OrElse Settings.SelectedSites.Contains(Site) Then
Select Case Settings.ShowingMode.Value Select Case Settings.ShowingMode.Value
Case ShowingModes.Regular : Return Not Temporary And Not Favorite Case ShowingModes.Regular : Return Not Temporary And Not Favorite
@@ -476,7 +560,7 @@ BlockNullPicture:
Case ShowingModes.Favorite : Return Favorite Case ShowingModes.Favorite : Return Favorite
Case ShowingModes.Deleted : Return Not UserExists Case ShowingModes.Deleted : Return Not UserExists
Case ShowingModes.Suspended : Return UserSuspended Case ShowingModes.Suspended : Return UserSuspended
Case ShowingModes.Labels : Return Settings.Labels.CurrentSelection.ListContains(Labels) Case ShowingModes.Labels : Return Settings.Labels.Current.ValuesList.ListContains(Labels)
Case ShowingModes.NoLabels : Return Labels.Count = 0 Case ShowingModes.NoLabels : Return Labels.Count = 0
Case Else : Return True Case Else : Return True
End Select End Select
@@ -487,52 +571,32 @@ BlockNullPicture:
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
Try Try
If Settings.ShowingMode.Value = ShowingModes.Labels Then If Settings.ShowingMode.Value = ShowingModes.Labels And Not Settings.ShowGroupsInsteadLabels Then
If Labels.Count > 0 And Settings.Labels.CurrentSelection.Count > 0 Then If Labels.Count > 0 And Settings.Labels.Current.Count > 0 Then
For i% = 0 To Labels.Count - 1 For i% = 0 To Labels.Count - 1
If Settings.Labels.CurrentSelection.Contains(Labels(i)) Then Return Destination.Groups.Item(Labels(i)) If Settings.Labels.Current.Contains(Labels(i)) Then Return Destination.Groups.Item(Labels(i))
Next Next
End If End If
Return Destination.Groups.Item(LabelsKeeper.NoLabeledName) ElseIf Settings.ShowGroups Then
Else
Return Destination.Groups.Item(GetLviGroupName(HOST, Temporary, Favorite, IsCollection, IsChannel)) Return Destination.Groups.Item(GetLviGroupName(HOST, Temporary, Favorite, IsCollection, IsChannel))
End If End If
Return Destination.Groups.Item(LabelsKeeper.NoLabeledName)
Catch ex As Exception Catch ex As Exception
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
@@ -543,13 +607,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"
@@ -559,7 +639,7 @@ BlockNullPicture:
If MyFile.Exists Then If MyFile.Exists Then
FileExists = True FileExists = True
Using x As New XmlFile(MyFile) With {.XmlReadOnly = True} Using x As New XmlFile(MyFile) With {.XmlReadOnly = True}
User.Name = x.Value(Name_UserName) If User.Name.IsEmptyString Then User.Name = x.Value(Name_UserName)
UserExists = x.Value(Name_UserExists).FromXML(Of Boolean)(True) UserExists = x.Value(Name_UserExists).FromXML(Of Boolean)(True)
UserSuspended = x.Value(Name_UserSuspended).FromXML(Of Boolean)(False) UserSuspended = x.Value(Name_UserSuspended).FromXML(Of Boolean)(False)
ID = x.Value(Name_UserID) ID = x.Value(Name_UserID)
@@ -576,6 +656,8 @@ BlockNullPicture:
DownloadedVideos(True) = x.Value(Name_VideoCount).FromXML(Of Integer)(0) DownloadedVideos(True) = x.Value(Name_VideoCount).FromXML(Of Integer)(0)
DownloadedPictures(True) = x.Value(Name_PicturesCount).FromXML(Of Integer)(0) DownloadedPictures(True) = x.Value(Name_PicturesCount).FromXML(Of Integer)(0)
LastUpdated = AConvert(Of Date)(x.Value(Name_LastUpdated), ADateTime.Formats.BaseDateTime, Nothing) LastUpdated = AConvert(Of Date)(x.Value(Name_LastUpdated), ADateTime.Formats.BaseDateTime, Nothing)
ScriptUse = x.Value(Name_ScriptUse).FromXML(Of Boolean)(False)
ScriptData = x.Value(Name_ScriptData)
DataMerging = x.Value(Name_DataMerging).FromXML(Of Boolean)(False) DataMerging = x.Value(Name_DataMerging).FromXML(Of Boolean)(False)
ChangeCollectionName(x.Value(Name_CollectionName), False) ChangeCollectionName(x.Value(Name_CollectionName), False)
Labels.ListAddList(x.Value(Name_LabelsName).StringToList(Of String, List(Of String))("|", EDP.ReturnValue), LAP.NotContainsOnly, LAP.ClearBeforeAdd) Labels.ListAddList(x.Value(Name_LabelsName).StringToList(Of String, List(Of String))("|", EDP.ReturnValue), LAP.NotContainsOnly, LAP.ClearBeforeAdd)
@@ -615,8 +697,10 @@ BlockNullPicture:
x.Add(Name_VideoCount, DownloadedVideos(True)) x.Add(Name_VideoCount, DownloadedVideos(True))
x.Add(Name_PicturesCount, DownloadedPictures(True)) x.Add(Name_PicturesCount, DownloadedPictures(True))
x.Add(Name_LastUpdated, AConvert(Of String)(LastUpdated, ADateTime.Formats.BaseDateTime, String.Empty)) x.Add(Name_LastUpdated, AConvert(Of String)(LastUpdated, ADateTime.Formats.BaseDateTime, String.Empty))
x.Add(Name_ScriptUse, ScriptUse.BoolToInteger)
x.Add(Name_ScriptData, ScriptData)
x.Add(Name_CollectionName, CollectionName) x.Add(Name_CollectionName, CollectionName)
x.Add(Name_LabelsName, Labels.ListToString(, "|", EDP.ReturnValue)) x.Add(Name_LabelsName, Labels.ListToString("|", EDP.ReturnValue))
x.Add(Name_DataMerging, DataMerging.BoolToInteger) x.Add(Name_DataMerging, DataMerging.BoolToInteger)
LoadUserInformation_OptionalFields(x, False) LoadUserInformation_OptionalFields(x, False)
@@ -632,36 +716,31 @@ 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 Dim fs$ = MyFile.CutPath.PathWithSeparator
Dim gfn As Func(Of String, String) = Function(ByVal Input As String) As String Dim gfn As Func(Of String, String) = Function(Input) If(Input.IsEmptyString, String.Empty,
If Input.IsEmptyString Then If(Input.Contains("\"), Input.CSFile.File, Input))
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 For Each v As EContainer In x
_ContentList.Add(New UserMedia With { _ContentList.Add(New UserMedia With {
.Type = AConvert(Of Integer)(v.Attribute(Name_MediaType).Value, 0), .Type = v.Attribute(Name_MediaType).Value.FromXML(Of Integer)(CInt(UTypes.Undefined)),
.URL = v.Attribute(Name_MediaURL).Value, .State = v.Attribute(Name_MediaState).Value.FromXML(Of Integer)(CInt(UStates.Downloaded)),
.URL_BASE = v.Value, .Attempts = v.Attribute(Name_MediaAttempts).Value.FromXML(Of Integer)(0),
.MD5 = v.Attribute(Name_MediaHash).Value, .URL = v.Attribute(Name_MediaURL).Value,
.File = fs & gfn.Invoke(v.Attribute(Name_MediaFile).Value), .URL_BASE = v.Value,
.Post = New UserPost With { .MD5 = v.Attribute(Name_MediaHash).Value,
.ID = v.Attribute(Name_MediaPostID).Value, .File = fs & gfn.Invoke(v.Attribute(Name_MediaFile).Value),
.[Date] = AConvert(Of Date)(v.Attribute(Name_MediaPostDate).Value, ParsersDataDateProvider, Nothing)} .Post = New UserPost With {
}) .ID = v.Attribute(Name_MediaPostID).Value,
.[Date] = AConvert(Of Date)(v.Attribute(Name_MediaPostDate).Value, ParsersDataDateProvider, Nothing)
}
})
Next Next
End If End If
_DataLoaded = True _DataLoaded = True
@@ -678,14 +757,17 @@ BlockNullPicture:
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
For Each i As UserMedia In _ContentList For Each i As UserMedia In _ContentList
x.Add(New EContainer("MediaData", i.URL_BASE, x.Add(New EContainer("MediaData", i.URL_BASE, {New EAttribute(Name_MediaType, CInt(i.Type)),
{New EAttribute(Name_MediaType, CInt(i.Type)), New EAttribute(Name_MediaState, CInt(i.State)),
New EAttribute(Name_MediaURL, i.URL), New EAttribute(Name_MediaAttempts, i.Attempts),
New EAttribute(Name_MediaHash, i.MD5), New EAttribute(Name_MediaURL, i.URL),
New EAttribute(Name_MediaFile, i.File.File), New EAttribute(Name_MediaHash, i.MD5),
New EAttribute(Name_MediaPostID, i.Post.ID), New EAttribute(Name_MediaFile, i.File.File),
New EAttribute(Name_MediaPostDate, AConvert(Of String)(i.Post.Date, ParsersDataDateProvider, String.Empty)) New EAttribute(Name_MediaPostID, i.Post.ID),
})) New EAttribute(Name_MediaPostDate, AConvert(Of String)(i.Post.Date, ParsersDataDateProvider, String.Empty))
}
)
)
Next Next
End If End If
x.Save(MyFileData) x.Save(MyFileData)
@@ -703,7 +785,7 @@ 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
@@ -724,9 +806,10 @@ BlockNullPicture:
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)
Dim UpPic As Boolean = Settings.ViewModeIsPicture AndAlso GetPicture(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
@@ -735,31 +818,39 @@ 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)
ThrowAny(Token) If Not DownloadMissingOnly Then
DownloadDataF(Token) ThrowAny(Token)
ThrowAny(Token) DownloadDataF(Token)
ThrowAny(Token)
Else
'ReparseMissing(Token)
End If
_TempMediaList.ListAddList(ContentMissing, LNC)
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 __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) LatestData.ListAddList(_ContentNew.Where(_downContent), LNC)
If DownloadedTotal(False) > 0 Or EnvirChanged.Invoke Then _ContentList.ListAddList(_ContentNew.Where(_downContent), LNC)
If DownloadedTotal(False) > 0 Or EnvirChanged.Invoke Or _ContentList.Exists(MissingFinder) Then
If __SaveData Then If __SaveData Then
LastUpdated = Now LastUpdated = Now
RunScript()
DownloadedPictures(True) = SFile.GetFiles(User.File.CutPath, "*.jpg|*.jpeg|*.png|*.gif|*.webm",, EDP.ReturnValue).Count DownloadedPictures(True) = SFile.GetFiles(User.File.CutPath, "*.jpg|*.jpeg|*.png|*.gif|*.webm",, EDP.ReturnValue).Count
DownloadedVideos(True) = SFile.GetFiles(User.File.CutPath, "*.mp4|*.mkv|*.mov", SearchOption.AllDirectories, EDP.ReturnValue).Count DownloadedVideos(True) = SFile.GetFiles(User.File.CutPath, "*.mp4|*.mkv|*.mov", SearchOption.AllDirectories, EDP.ReturnValue).Count
If Labels.Contains(LabelsKeeper.NoParsedUser) Then Labels.Remove(LabelsKeeper.NoParsedUser) If Labels.Contains(LabelsKeeper.NoParsedUser) Then Labels.Remove(LabelsKeeper.NoParsedUser)
@@ -775,7 +866,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
@@ -786,10 +877,11 @@ 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 DownloadToDate = Nothing
DownloadMissingOnly = False
End Try End Try
End Sub End Sub
Protected Function CheckDatesLimit(ByVal DateString As String, ByVal DateProvider As IFormatProvider) As Boolean Protected Function CheckDatesLimit(ByVal DateString As String, ByVal DateProvider As IFormatProvider) As Boolean
@@ -811,11 +903,14 @@ 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
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)
Protected Sub DownloadContentDefault(ByVal Token As CancellationToken) Protected Sub DownloadContentDefault(ByVal Token As CancellationToken)
Try Try
@@ -826,6 +921,7 @@ 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
@@ -833,7 +929,7 @@ BlockNullPicture:
Dim v As UserMedia Dim v As UserMedia
Using w As New WebClient Using w As New WebClient
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path) If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", 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)
@@ -858,6 +954,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
@@ -882,7 +980,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_BASE)
End Try End Try
Else Else
v.State = UStates.Skipped v.State = UStates.Skipped
@@ -899,6 +999,7 @@ BlockNullPicture:
End Using End Using
End If End If
End If End If
Catch iex As IndexOutOfRangeException When Disposed
Catch oex As OperationCanceledException When Token.IsCancellationRequested Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception Catch ex As Exception
@@ -918,17 +1019,11 @@ BlockNullPicture:
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
Dim d As Date? = m.Post.Date If Not Settings.FileReplaceNameByDate.Value = FileNameReplaceMode.None Then
If Settings.FileReplaceNameByDate Then
Dim dd$ = AConvert(Of String)(If(d, Now), FileDateAppenderProvider, String.Empty)
ff = f ff = f
ff.Name = dd 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))
ElseIf d.HasValue AndAlso (Settings.FileAddDateToFileName Or Settings.FileAddTimeToFileName) AndAlso
(Not FileDateAppenderProvider Is Nothing And Not FileDateAppenderPattern.IsEmptyString) Then
ff = f
ff.Name = String.Format(FileDateAppenderPattern, f.Name, CStr(AConvert(Of String)(d.Value, FileDateAppenderProvider, String.Empty)))
End If End If
If Not ff.Name.IsEmptyString Then My.Computer.FileSystem.RenameFile(f, ff.File) : Return ff If Not ff.Name.IsEmptyString Then My.Computer.FileSystem.RenameFile(f, ff.File) : Return ff
End If End If
@@ -938,19 +1033,38 @@ BlockNullPicture:
Return f Return f
End Try End Try
End Function End Function
Private Sub RunScript()
Try
Const spa$ = "{0}"
If ScriptUse Then
Dim ScriptPattern$
If Not ScriptData.IsEmptyString Then
ScriptPattern = ScriptData
Else
ScriptPattern = Settings.ScriptData.Value
End If
If Not ScriptPattern.IsEmptyString Then
If Not ScriptPattern.Contains(spa) Then ScriptPattern &= $" ""{spa}"""
Using b As New BatchExecutor With {.RedirectStandardError = True}
b.Execute({String.Format(ScriptPattern, MyFile.CutPath(1).PathNoSeparator)}, EDP.SendInLog + EDP.ThrowException)
If b.HasError Or Not b.ErrorOutput.IsEmptyString Then Throw New Exception(b.ErrorOutput, b.ErrorException)
End Using
End If
End If
Catch ex As Exception
LogError(ex, "script execution error")
End Try
End Sub
#End Region #End Region
#Region "Delete, Move, Merge" #Region "Delete, Move, Merge"
Friend Overridable Function Delete() As Integer Implements IUserData.Delete Friend Overridable Function Delete() As Integer Implements IUserData.Delete
Return DeleteF(Me)
End Function
Friend Function DeleteF(ByVal Instance As IUserData) As Integer
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) MainFrameObj.ImageHandler(Me, False)
Settings.UsersList.Remove(User) Settings.UsersList.Remove(User)
Settings.UpdateUsersList() Settings.UpdateUsersList()
Settings.Users.Remove(Instance) Settings.Users.Remove(Me)
Downloader.UserRemove(Instance) Downloader.UserRemove(Me)
Dispose(True) Dispose(True)
Return 1 Return 1
Else Else
@@ -958,24 +1072,22 @@ BlockNullPicture:
End If End If
End Function End Function
Friend Overridable Function MoveFiles(ByVal __CollectionName As String) As Boolean Implements IUserData.MoveFiles Friend Overridable Function MoveFiles(ByVal __CollectionName As String) As Boolean Implements IUserData.MoveFiles
Return MoveFilesF(Me, __CollectionName)
End Function
Friend Function MoveFilesF(ByRef Instance As IUserData, ByVal __CollectionName As String) As Boolean
Dim UserBefore As UserInfo = User Dim UserBefore As UserInfo = User
Dim Removed As Boolean = True Dim Removed As Boolean = True
Dim _TurnBack As Boolean = False Dim _TurnBack As Boolean = False
Try Try
Dim f As SFile Dim f As SFile
If IncludedInCollection Then If IncludedInCollection Then
Settings.Users.Add(Instance) Settings.Users.Add(Me)
Removed = False Removed = False
User.CollectionName = String.Empty User.CollectionName = String.Empty
User.IncludedInCollection = False User.IncludedInCollection = False
Else Else
Settings.Users.Remove(Instance) Settings.Users.Remove(Me)
Removed = True Removed = True
User.CollectionName = __CollectionName User.CollectionName = __CollectionName
User.IncludedInCollection = True User.IncludedInCollection = True
User.SpecialPath = Nothing
End If End If
_TurnBack = True _TurnBack = True
User.UpdateUserFile() User.UpdateUserFile()
@@ -987,7 +1099,7 @@ BlockNullPicture:
"Destination directory is not empty!"}, MsgBoxStyle.Exclamation,,, {"Delete", "Cancel"}) = 1 Then "Destination directory is not empty!"}, MsgBoxStyle.Exclamation,,, {"Delete", "Cancel"}) = 1 Then
MsgBoxE("Operation canceled", MsgBoxStyle.Exclamation) MsgBoxE("Operation canceled", MsgBoxStyle.Exclamation)
User = UserBefore User = UserBefore
If Removed Then Settings.Users.Add(Instance) Else Settings.Users.Remove(Instance) If Removed Then Settings.Users.Add(Me) Else Settings.Users.Remove(Me)
_TurnBack = False _TurnBack = False
Return False Return False
End If End If
@@ -995,6 +1107,8 @@ BlockNullPicture:
End If End If
f.CutPath.Exists(SFO.Path) f.CutPath.Exists(SFO.Path)
Directory.Move(UserBefore.File.CutPath(, EDP.ThrowException).Path, f.Path) Directory.Move(UserBefore.File.CutPath(, EDP.ThrowException).Path, f.Path)
If Not ScriptData.IsEmptyString AndAlso ScriptData.Contains(UserBefore.File.PathNoSeparator) Then _
ScriptData = ScriptData.Replace(UserBefore.File.PathNoSeparator, MyFile.PathNoSeparator)
Settings.UsersList.Remove(UserBefore) Settings.UsersList.Remove(UserBefore)
Settings.UpdateUsersList(User) Settings.UpdateUsersList(User)
UpdateUserInformation() UpdateUserInformation()
@@ -1003,7 +1117,7 @@ BlockNullPicture:
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Files moving error") ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Files moving error")
User = UserBefore User = UserBefore
If _TurnBack Then If _TurnBack Then
If Removed Then Settings.Users.Add(Instance) Else Settings.Users.Remove(Instance) If Removed Then Settings.Users.Add(Me) Else Settings.Users.Remove(Me)
End If End If
Return False Return False
End Try End Try
@@ -1048,6 +1162,8 @@ BlockNullPicture:
New ErrorsDescriber(False, False, False, New List(Of SFile))).Count = 0 Then New ErrorsDescriber(False, False, False, New List(Of SFile))).Count = 0 Then
UserBefore.File.CutPath.Delete(SFO.Path, Settings.DeleteMode, EDP.SendInLog) UserBefore.File.CutPath.Delete(SFO.Path, Settings.DeleteMode, EDP.SendInLog)
End If End If
If Not ScriptData.IsEmptyString AndAlso ScriptData.Contains(UserBefore.File.PathNoSeparator) Then _
ScriptData = ScriptData.Replace(UserBefore.File.PathNoSeparator, MyFile.PathNoSeparator)
UpdateUserInformation() UpdateUserInformation()
End If End If
Catch ioex As InvalidOperationException When ioex.HelpLink = 1 Catch ioex As InvalidOperationException When ioex.HelpLink = 1
@@ -1093,25 +1209,6 @@ BlockNullPicture:
Else Else
Return IIf(FriendlyName.IsEmptyString, Name, FriendlyName) Return IIf(FriendlyName.IsEmptyString, Name, FriendlyName)
End If End If
'If Settings.ViewModeIsPicture Then
' If IsCollection Then
' Return CollectionName
' Else
' Return IIf(FriendlyName.IsEmptyString, Name, FriendlyName)
' End If
'Else
' Dim t$ = String.Empty
' If Temporary Then
' t = " (T)"
' ElseIf Favorite Then
' t = " (F)"
' End If
' If IsCollection Then
' Return $"Collection [{CollectionName}]{t}"
' Else
' Return $"[{Site}]{t} {IIf(FriendlyName.IsEmptyString, Name, FriendlyName)}"
' End If
'End If
End Function 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_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DOWN.Click
@@ -1168,6 +1265,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()
@@ -1176,7 +1274,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
@@ -1203,7 +1301,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
@@ -1231,6 +1329,9 @@ 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 ScriptData As String
Function GetLVI(ByVal Destination As ListView) As ListViewItem Function GetLVI(ByVal Destination As ListView) As ListViewItem
Function GetLVIGroup(ByVal Destination As ListView) As ListViewGroup Function GetLVIGroup(ByVal Destination As ListView) As ListViewGroup
Sub LoadUserInformation() Sub LoadUserInformation()

View File

@@ -10,8 +10,8 @@ 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 System.Net
Imports SCrawler.API.Imgur.Declarations
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.API.Imgur.Declarations
Namespace API.Imgur Namespace API.Imgur
Namespace Declarations Namespace Declarations
Friend Module Imgur_Declarations Friend Module Imgur_Declarations
@@ -79,7 +79,7 @@ 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") Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog + EDP.ReturnValue, 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

@@ -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

@@ -11,15 +11,6 @@ Namespace API.Instagram
Friend Module Declarations Friend Module Declarations
Friend Const InstagramSite As String = "Instagram" Friend Const InstagramSite As String = "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

@@ -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

@@ -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 ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK 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 ToolbarBttCancel() Implements IOkCancelToolbar.ToolbarBttCancel
MyDefs.CloseForm(DialogResult.Cancel)
End Sub
End Class End Class
End Namespace End Namespace

View File

@@ -9,7 +9,8 @@
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.Forms
Imports PersonalUtilities.Tools.WEB
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
@@ -17,7 +18,8 @@ Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Instagram Namespace API.Instagram
<Manifest("AndyProgram_Instagram"), UseClassAsIs, SeparatedTasks(1), SavedPosts, SpecialForm(False)> <Manifest("AndyProgram_Instagram"), UseClassAsIs, SeparatedTasks(1), SavedPosts, SpecialForm(False)>
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.InstagramIcon
@@ -30,21 +32,48 @@ Namespace API.Instagram
End Property End Property
#End Region #End Region
#Region "Providers" #Region "Providers"
Private Class TimersChecker : Implements ICustomProvider Private Class TimersChecker : Implements IFieldsCheckerProvider
Private Property ErrorMessage As String Implements IFieldsCheckerProvider.ErrorMessage
Private Property Name As String Implements IFieldsCheckerProvider.Name
Private Property TypeError As Boolean Implements IFieldsCheckerProvider.TypeError
Private ReadOnly LVProvider As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
Private ReadOnly _LowestValue As Integer Private ReadOnly _LowestValue As Integer
Friend Sub New(ByVal LowestValue As Integer) Friend Sub New(ByVal LowestValue As Integer)
_LowestValue = LowestValue _LowestValue = LowestValue
End Sub End Sub
Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider, Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
If ACheck(Of Integer)(Value) AndAlso CInt(Value) >= _LowestValue Then TypeError = False
ErrorMessage = String.Empty
If Not ACheck(Of Integer)(Value) Then
TypeError = True
ElseIf CInt(Value) < _LowestValue Then
ErrorMessage = $"The value of [{Name}] field must be greater than or equal to {_LowestValue.NumToString(LVProvider)}"
Else
Return Value
End If
Return Nothing
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException("[GetFormat] is not available in the context of [TimersChecker]")
End Function
End Class
Private Class TaggedNotifyLimitChecker : Implements IFieldsCheckerProvider
Private Property ErrorMessage As String Implements IFieldsCheckerProvider.ErrorMessage
Private Property Name As String Implements IFieldsCheckerProvider.Name
Private Property TypeError As Boolean Implements IFieldsCheckerProvider.TypeError
Private Function Convert(ByVal Value As Object, ByVal DestinationType As Type, ByVal Provider As IFormatProvider,
Optional ByVal NothingArg As Object = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Object Implements ICustomProvider.Convert
Dim v% = AConvert(Of Integer)(Value, -10)
If v > 0 Or v = -1 Then
Return Value Return Value
Else Else
ErrorMessage = $"The value of [{Name}] field must be greater than 0 or equal to -1"
Return Nothing Return Nothing
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
@@ -53,39 +82,64 @@ Namespace API.Instagram
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)> <PropertyOption(ControlText:="Hash 2", 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-ig-app-id", IsAuth:=True), ControlNumber(2)> <PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Instagram token for tagged data", IsAuth:=True), ControlNumber(2)>
Friend ReadOnly Property CSRF_TOKEN As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True), 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(3)> <PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True), 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(4)> <PropertyOption(ControlText:="Saved posts user", 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 ReadOnly Property BaseAuthExists As Boolean
Get Get
Return ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) Return Responser.Cookies.Count > 0 And ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value)
End Get End Get
End Property End Property
Private Const Header_IG_APP_ID As String = "x-ig-app-id"
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(5)>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider Private ReadOnly Property RequestsWaitTimerProvider As IFormatProvider
<PropertyOption(ControlText:="Request timer counter", AllowNull:=False, LeftOffset:=120), PXML("RequestsWaitTimerTaskCount"), ControlNumber(6)> <PropertyOption(ControlText:="Request timer counter", AllowNull:=False, LeftOffset:=120), PXML("RequestsWaitTimerTaskCount"), ControlNumber(7)>
Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue
<Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)> <Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)>
Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider Private ReadOnly Property RequestsWaitTimerTaskCountProvider As IFormatProvider
<PropertyOption(ControlText:="Posts limit timer", AllowNull:=False), PXML("SleepTimerOnPostsLimit"), ControlNumber(7)> <PropertyOption(ControlText:="Posts limit timer", AllowNull:=False), PXML("SleepTimerOnPostsLimit"), ControlNumber(8)>
Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue
<Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)> <Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider
<PropertyOption(ControlText:="Get stories"), PXML, ControlNumber(8)> <PropertyOption(ControlText:="Get stories"), PXML, ControlNumber(9)>
Friend ReadOnly Property GetStories As PropertyValue Friend ReadOnly Property GetStories As PropertyValue
<PropertyOption(ControlText:="Get tagged photos"), PXML, ControlNumber(9)> <PropertyOption(ControlText:="Get tagged photos"), PXML, ControlNumber(10)>
Friend ReadOnly Property GetTagged As PropertyValue Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr &
"-1 to disable"), PXML, ControlNumber(11)>
Friend ReadOnly Property TaggedNotifyLimit As PropertyValue
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region #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
@@ -98,8 +152,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
@@ -129,24 +186,23 @@ Namespace API.Instagram
End With End With
End Sub End Sub
#End Region #End Region
Friend Overrides ReadOnly Property Responser As WEB.Response Private Initialized As Boolean = False
#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
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_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
.CookiesDomain = "instagram.com"
.SaveSettings()
End If End If
End With End With
@@ -154,9 +210,9 @@ 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))
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))
@@ -164,48 +220,33 @@ Namespace API.Instagram
RequestsWaitTimerProvider = New TimersChecker(100) RequestsWaitTimerProvider = New TimersChecker(100)
RequestsWaitTimerTaskCount = New PropertyValue(1) RequestsWaitTimerTaskCount = New PropertyValue(1)
RequestsWaitTimerTaskCountProvider = New TimersChecker(1) RequestsWaitTimerTaskCountProvider = New TimersChecker(1)
SleepTimerOnPostsLimit = New PropertyValue(6000) SleepTimerOnPostsLimit = New PropertyValue(60000)
SleepTimerOnPostsLimitProvider = New TimersChecker(10000) SleepTimerOnPostsLimitProvider = New TimersChecker(10000)
GetStories = New PropertyValue(False) GetStories = New PropertyValue(False)
GetTagged = New PropertyValue(False) GetTagged = New PropertyValue(False)
TaggedNotifyLimit = New PropertyValue(200)
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(__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 Friend Overrides Sub BeginInit()
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
Private Const Header_IG_APP_ID As String = "x-ig-app-id"
Private Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
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
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
Friend Overrides Sub EndInit()
Initialized = True
MyBase.EndInit()
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
@@ -231,24 +272,58 @@ Namespace API.Instagram
Return False Return False
End If End If
End Function End Function
Friend Overrides Sub BeginInit() <PropertiesDataChecker({NameOf(TaggedNotifyLimit)})>
End Sub Private Function CheckNotifyLimit(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() Dim pi% = p.ListIndexOf(Function(pp) pp.Name = NameOf(TaggedNotifyLimit))
End Sub If pi >= 0 Then
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean Dim v% = AConvert(Of Integer)(p(pi).Value, -10)
Return ActiveJobs < 2 AndAlso ReadyForDownload If v > 0 Then
Return True
ElseIf v = -1 Then
Return MsgBoxE({"You turn off notifications for tagged posts. This is highly undesirable. Do you still want to do it?",
"Disabling tagged notification limits"}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes
Else
Return False
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 Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If ActiveJobs < 2 AndAlso ReadyForDownload AndAlso BaseAuthExists Then
Select Case What
Case Download.Main : Return ACheck(Hash.Value)
Case Download.SavedPosts : Return ACheck(HashSavedPosts.Value)
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
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)
With DirectCast(User, UserData) With DirectCast(User, UserData)
If What = Download.Main Then .WaitNotificationMode = _NextWNM If What = Download.Main Then
.WaitNotificationMode = _NextWNM
.TaggedCheckSession = _NextTagged
End If
If LastDownloadDate.Value.AddMinutes(60) > Now Then If LastDownloadDate.Value.AddMinutes(60) > Now Then
.RequestsCount = LastRequestsCount .RequestsCount = LastRequestsCount
Else Else
@@ -261,49 +336,20 @@ Namespace API.Instagram
With DirectCast(User, UserData) With DirectCast(User, UserData)
_NextWNM = .WaitNotificationMode _NextWNM = .WaitNotificationMode
If _NextWNM = UserData.WNM.SkipTemp Or _NextWNM = UserData.WNM.SkipCurrent Then _NextWNM = UserData.WNM.Notify If _NextWNM = UserData.WNM.SkipTemp Or _NextWNM = UserData.WNM.SkipCurrent Then _NextWNM = UserData.WNM.Notify
_NextTagged = .TaggedCheckSession
LastDownloadDate.Value = Now LastDownloadDate.Value = Now
LastRequestsCount.Value = .RequestsCount LastRequestsCount.Value = .RequestsCount
End With End With
End Sub End Sub
Friend Overrides Sub DownloadDone(ByVal What As Download) Friend Overrides Sub DownloadDone(ByVal What As Download)
_NextWNM = UserData.WNM.Notify _NextWNM = UserData.WNM.Notify
_NextTagged = True
LastDownloadDate.Value = Now LastDownloadDate.Value = Now
ActiveJobs -= 1 ActiveJobs -= 1
If HashUpdateRequired Then MyMainLOG = "Check your Instagram credentials"
End Sub End Sub
#End Region #End Region
<PropertyUpdater(NameOf(Hash))>
Friend Function GatherInstaHash() As Boolean
Try
If Not Responser.Cookies.ListExists Then Throw New Exception("Instagram cookies does not set")
Dim rs As New RParams("=""([^""]+?ConsumerLibCommons[^""]+?.js)""", Nothing, 1) With {.MatchTimeOut = 10}
Dim r$ = Responser.GetResponse("https://instagram.com",, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim hStr$ = RegexReplace(r, rs)
If Not hStr.IsEmptyString Then
Do While Left(hStr, 1) = "/" : hStr = Right(hStr, hStr.Length - 1) : Loop
hStr = $"https://instagram.com/{hStr}"
r = Responser.GetResponse(hStr,, EDP.ThrowException)
If Not r.IsEmptyString Then
rs = New RParams("generatePaginationActionCreators.+?.profilePosts.byUserId.get.+?queryId:.([\d\w\S]+?)""", Nothing, 1) With {.MatchTimeOut = 10}
Dim h$ = RegexReplace(r, rs)
If Not h.IsEmptyString Then
Hash.Value = h
HashUpdateRequired.Value = False
Return True
End If
End If
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) Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return UserData.GetVideoInfo(URL, Responser) 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)
@@ -311,5 +357,6 @@ 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
#End Region
End Class End Class
End Namespace End Namespace

View File

@@ -12,17 +12,20 @@ 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.Net
Imports System.Threading
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)
@@ -33,6 +36,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
@@ -44,6 +49,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)
@@ -61,7 +68,13 @@ 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 Class ExitException : Inherits Exception
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)
Try Try
_InstaHash = String.Empty _InstaHash = String.Empty
@@ -79,7 +92,8 @@ Namespace API.Instagram
If FirstLoadingDone Then LastCursor = String.Empty If FirstLoadingDone Then LastCursor = String.Empty
If IsSavedPosts Then If IsSavedPosts Then
DownloadPosts(Token) DownloadPosts(Token)
ElseIf MySiteSettings.StoriesAndTaggedReady Then ElseIf MySiteSettings.BaseAuthExists Then
DownloadedTags = 0
If GetStories Then DownloadData(String.Empty, Sections.Stories, Token) If GetStories Then DownloadData(String.Empty, Sections.Stories, Token)
If GetTaggedData Then DownloadData(String.Empty, Sections.Tagged, Token) If GetTaggedData Then DownloadData(String.Empty, Sections.Tagged, Token)
End If End If
@@ -90,12 +104,11 @@ Namespace API.Instagram
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 : End Enum
Timeline Private Const StoriesFolder As String = "Stories"
Tagged Private Const TaggedFolder As String = "Tagged"
Stories
End Enum
#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
@@ -138,7 +151,7 @@ Namespace API.Instagram
End Function End Function
Private Sub ReconfigureAwaiter() Private Sub ReconfigureAwaiter()
If WaitNotificationMode = WNM.SkipTemp Then WaitNotificationMode = WNM.Notify If WaitNotificationMode = WNM.SkipTemp Then WaitNotificationMode = WNM.Notify
If Caught429 Then Caught429 = False ': RequestsCount = 0 If Caught429 Then Caught429 = False
ProgressTempSet = False ProgressTempSet = False
End Sub End Sub
Private Sub NextRequest(ByVal StartWait As Boolean) Private Sub NextRequest(ByVal StartWait As Boolean)
@@ -148,9 +161,77 @@ Namespace API.Instagram
End With End With
End Sub End Sub
#End Region #End Region
Private Const StoriesFolder As String = "Stories" #Region "Tags"
Private Const TaggedFolder As String = "Tagged"
Private TaggedChecked As Boolean = False Private TaggedChecked As Boolean = False
Friend TaggedCheckSession As Boolean = True
Private DownloadedTags As Integer = 0
Private DownloadTagsLimit As Integer? = Nothing
Private ReadOnly Property TaggedLimitsNotifications(Optional ByVal v As Integer? = Nothing) As Boolean
Get
Return Not TaggedChecked AndAlso TaggedCheckSession AndAlso
CInt(MySiteSettings.TaggedNotifyLimit.Value) > 0 AndAlso
(Not v.HasValue OrElse v.Value > CInt(MySiteSettings.TaggedNotifyLimit.Value))
End Get
End Property
Private Function SetTagsLimit(ByVal Max As Integer, ByVal p As ANumbers) As DialogResult
Dim v%?
Dim aStr$ = $"Enter the number of posts from user {ToString()} that you want to download{vbCr}" &
$"(Max: {Max.NumToString(p)}; Requests: {(Max / 12).RoundUp.NumToString(p)})"
Dim tryBtt As New MsgBoxButton("Try again") With {.ToolTip = "You will be asked again about the limit"}
Dim cancelBtt As New MsgBoxButton("Cancel") With {.ToolTip = "Cancel tagged posts download operation"}
Dim selectBtt As New MsgBoxButton("Other options") With {.ToolTip = "The main message with options will be displayed again"}
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}
Do
v = AConvert(Of Integer)(InputBoxE(aStr, "Tagged posts download limit", CInt(MySiteSettings.TaggedNotifyLimit.Value)), AModes.Var, Nothing)
If v.HasValue Then
mh.Text = $"You have entered a limit of {v.Value.NumToString(p)} posts"
Select Case MsgBoxE(mh).Index
Case 0 : DownloadTagsLimit = v : Return DialogResult.OK
Case 1 : v = Nothing
Case 2 : Return DialogResult.Retry
Case 3 : Return DialogResult.Cancel
End Select
Else
Select Case MsgBoxE(m).Index
Case 1 : Return DialogResult.Retry
Case 2 : Return DialogResult.Cancel
End Select
End If
Loop While Not v.HasValue
Return DialogResult.Retry
End Function
Private Function TaggedContinue(ByVal TaggedCount As Integer) As DialogResult
Dim agi As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
Dim msg As New MMessage($"The number of tagged posts by user [{ToString()}] is {TaggedCount.NumToString(agi)}" & vbCr &
$"This is about {(TaggedCount / 12).RoundUp.NumToString(agi)} requests." & vbCr &
"The tagged data download operation can take a long time.",
"Too much tagged data",
{
"Continue",
New MsgBoxButton("Continue unnotified") With {
.ToolTip = "Continue downloading and cancel further notifications in the current downloading session."},
New MsgBoxButton("Limit") With {
.ToolTip = "Enter the limit of posts you want to download."},
New MsgBoxButton("Disable and cancel") With {
.ToolTip = "Disable downloading tagged data and cancel downloading tagged data."},
"Cancel"
}, MsgBoxStyle.Exclamation) With {.DefaultButton = 0, .CancelButton = 4, .ButtonsPerRow = 2}
Do
Select Case MsgBoxE(msg).Index
Case 0 : Return DialogResult.OK
Case 1 : TaggedCheckSession = False : Return DialogResult.OK
Case 2
Select Case SetTagsLimit(TaggedCount, agi)
Case DialogResult.OK : Return DialogResult.OK
Case DialogResult.Cancel : Return DialogResult.Cancel
End Select
Case 3 : GetTaggedData = False : Return DialogResult.Cancel
Case 4 : Return DialogResult.Cancel
End Select
Loop
End Function
#End Region
Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Section As Sections, ByVal Token As CancellationToken) Private Overloads Sub DownloadData(ByVal Cursor As String, ByVal Section As Sections, ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Dim StoriesList As List(Of String) = Nothing Dim StoriesList As List(Of String) = Nothing
@@ -174,8 +255,7 @@ 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")
@@ -193,6 +273,7 @@ Namespace API.Instagram
Case Sections.Stories Case Sections.Stories
If Not StoriesRequested Then If Not StoriesRequested Then
StoriesList = GetStoriesList() StoriesList = GetStoriesList()
StoriesRequested = True
MySiteSettings.TooManyRequests(False) MySiteSettings.TooManyRequests(False)
RequestsCount += 1 RequestsCount += 1
ThrowAny(Token) ThrowAny(Token)
@@ -236,13 +317,16 @@ Namespace API.Instagram
If IsSavedPosts Then If IsSavedPosts Then
PostID = node.Value("shortcode") PostID = node.Value("shortcode")
If Not PostID.IsEmptyString Then If Not PostID.IsEmptyString Then
If _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete) Else _SavedPostsIDs.Add(PostID) If _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete) 'Else _SavedPostsIDs.Add(PostID)
End If End If
End If
PostID = node.Value("id")
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp")
If IsSavedPosts Then
_SavedPostsIDs.Add(PostID)
Else Else
PostID = node.Value("id")
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp")
If Not CheckDatesLimit(PostDate, DateProvider) Then Throw New ExitException(_DownloadComplete) If Not CheckDatesLimit(PostDate, DateProvider) Then Throw New ExitException(_DownloadComplete)
ObtainMedia(node, PostID, PostDate, SpecFolder) ObtainMedia(node, PostID, PostDate, SpecFolder)
End If End If
@@ -256,31 +340,20 @@ Namespace API.Instagram
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete) If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID) _TempPostsList.Add(PostID)
ObtainMedia2(nn, PostID, SpecFolder) ObtainMedia2(nn, PostID, SpecFolder)
DownloadedTags += 1
If DownloadTagsLimit.HasValue AndAlso DownloadedTags >= DownloadTagsLimit.Value Then Throw New ExitException(_DownloadComplete)
Next Next
If Not TaggedChecked Then If TaggedLimitsNotifications Then
TaggedCount = j.Value("total_count").FromXML(Of Integer)(0) TaggedCount = j.Value("total_count").FromXML(Of Integer)(0)
TaggedChecked = True TaggedChecked = True
If TaggedCount > 200 Then If TaggedLimitsNotifications(TaggedCount) AndAlso
Dim a% = MsgBoxE({$"The number of tagged posts is {TaggedCount.NumToString(New ANumbers With { TaggedContinue(TaggedCount) = DialogResult.Cancel Then Throw New ExitException(_DownloadComplete)
.FormatOptions = ANumbers.Options.GroupIntegral})}" & vbCr &
"The tagged data download operation can take a long time.", "Too much tagged data"}, vbExclamation,,,
{"Continue",
New MsgBoxButton("Disable and cancel") With {
.ToolTip = "Disable downloading tagged data and cancel downloading tagged data."},
"Cancel"})
If a > 0 Then
If a = 1 Then GetTaggedData = False
Throw New ExitException(_DownloadComplete)
End If
End If
End If End If
End Select End Select
Else Else
If j.Value("status") = "ok" AndAlso j({"data", "user"}).XmlIfNothing.Count = 0 AndAlso _TempMediaList.Count = 0 Then If j.Value("status") = "ok" AndAlso j({"data", "user"}).XmlIfNothing.Count = 0 AndAlso
MySiteSettings.HashUpdateRequired.Value = True _TempMediaList.Count = 0 AndAlso Section = Sections.Timeline Then _
UserExists = False UserExists = False : Throw New ExitException(_DownloadComplete)
Throw New ExitException(_DownloadComplete)
End If
End If End If
End Using End Using
Else Else
@@ -288,9 +361,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
@@ -298,7 +368,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}]") = 1 Then Continue Do Else Exit Do If DownloadingException(ex, $"data downloading error [{URL}]", Section, False) = 1 Then Continue Do Else Exit Do
End Try End Try
Loop Loop
Catch eex2 As ExitException Catch eex2 As ExitException
@@ -327,7 +397,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)
@@ -371,6 +442,26 @@ Namespace API.Instagram
End Try End Try
End Sub End Sub
#End Region #End Region
#Region "Code ID converters"
Friend 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) =
@@ -390,11 +481,30 @@ Namespace API.Instagram
CreateMedia(node) CreateMedia(node)
End If End If
End Sub End Sub
Private Sub ObtainMedia2(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing) Private Sub ObtainMedia2(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj As String = Nothing)
Try Try
Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0 Dim img As Predicate(Of EContainer) = Function(_img) Not _img.Name.IsEmptyString AndAlso _img.Name.StartsWith("image_versions") AndAlso _img.Count > 0
Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0 Dim vid As Predicate(Of EContainer) = Function(_vid) Not _vid.Name.IsEmptyString AndAlso _vid.Name.StartsWith("video_versions") AndAlso _vid.Count > 0
Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url")) Dim ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url"))
Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String
If elem.Contains("taken_at") Then
Return elem.Value("taken_at")
ElseIf elem.Contains("imported_taken_at") Then
Return elem.Value("imported_taken_at")
Else
Dim ev$ = elem.Value("device_timestamp")
If Not ev.IsEmptyString Then
If ev.Length > 10 Then
Return elem.Value("device_timestamp").Substring(0, 10)
Else
Return ev
End If
Else
Return String.Empty
End If
End If
End Function
If n.Count > 0 Then If n.Count > 0 Then
Dim l As New List(Of Sizes) Dim l As New List(Of Sizes)
Dim d As EContainer Dim d As EContainer
@@ -408,6 +518,7 @@ Namespace API.Instagram
Case 1 Case 1
If n.Contains(img) Then If n.Contains(img) Then
t = n.Value("media_type").FromXML(Of Integer)(-1) t = n.Value("media_type").FromXML(Of Integer)(-1)
DateObj = mDate(n)
If t >= 0 Then If t >= 0 Then
With n.ItemF({img, "candidates"}).XmlIfNothing With n.ItemF({img, "candidates"}).XmlIfNothing
If .Count > 0 Then If .Count > 0 Then
@@ -415,7 +526,7 @@ Namespace API.Instagram
l.ListAddList(.Select(ss), LNC) l.ListAddList(.Select(ss), LNC)
If l.Count > 0 Then If l.Count > 0 Then
l.Sort() l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, Nothing, SpecialFolder), LNC) _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, l.First.Data, PostID, DateObj, SpecialFolder), LNC)
l.Clear() l.Clear()
End If End If
End If End If
@@ -424,22 +535,24 @@ Namespace API.Instagram
End If End If
Case 2 Case 2
If n.Contains(vid) Then If n.Contains(vid) Then
DateObj = mDate(n)
With n.ItemF({vid}).XmlIfNothing With n.ItemF({vid}).XmlIfNothing
If .Count > 0 Then If .Count > 0 Then
l.Clear() l.Clear()
l.ListAddList(.Select(ss), LNC) l.ListAddList(.Select(ss), LNC)
If l.Count > 0 Then If l.Count > 0 Then
l.Sort() l.Sort()
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, Nothing, SpecialFolder), LNC) _TempMediaList.ListAddValue(MediaFromData(UTypes.Video, l.First.Data, PostID, DateObj, SpecialFolder), LNC)
l.Clear() l.Clear()
End If End If
End If End If
End With End With
End If End If
Case 8 Case 8
DateObj = mDate(n)
With n("carousel_media").XmlIfNothing With n("carousel_media").XmlIfNothing
If .Count > 0 Then If .Count > 0 Then
For Each d In .Self : ObtainMedia2(d, PostID, SpecialFolder) : Next For Each d In .Self : ObtainMedia2(d, PostID, SpecialFolder, DateObj) : Next
End If End If
End With End With
End Select End Select
@@ -451,7 +564,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
@@ -467,18 +581,35 @@ 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}"
Dim tmpList As IEnumerable(Of String) Dim tmpList As IEnumerable(Of String)
Dim qStr$, r$, sFolder$, storyID$ Dim qStr$, r$, sFolder$, storyID$, pid$
Dim i% = -1 Dim i% = -1
Dim jj As EContainer, s As EContainer Dim jj As EContainer, s As EContainer
ThrowAny(Token) ThrowAny(Token)
If StoriesList.ListExists Then If StoriesList.ListExists Then
tmpList = StoriesList.Take(5) tmpList = StoriesList.Take(5)
If tmpList.ListExists Then If tmpList.ListExists Then
qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids=highlight:{q}").ListToString(, "&")) qStr = String.Format(ReqUrl, tmpList.Select(Function(q) $"reel_ids=highlight:{q}").ListToString("&"))
r = Responser.GetResponse(qStr,, EDP.ThrowException) r = Responser.GetResponse(qStr,, EDP.ThrowException)
ThrowAny(Token) ThrowAny(Token)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -486,7 +617,7 @@ Namespace API.Instagram
If j.Contains("reels") Then If j.Contains("reels") Then
For Each jj In j("reels") For Each jj In j("reels")
i += 1 i += 1
sFolder = jj.Value("title") sFolder = jj.Value("title").StringRemoveWinForbiddenSymbols
storyID = jj.Value("id").Replace("highlight:", String.Empty) storyID = jj.Value("id").Replace("highlight:", String.Empty)
If sFolder.IsEmptyString Then sFolder = $"Story_{storyID}" If sFolder.IsEmptyString Then sFolder = $"Story_{storyID}"
If sFolder.IsEmptyString Then sFolder = $"Story_{i}" If sFolder.IsEmptyString Then sFolder = $"Story_{i}"
@@ -494,7 +625,14 @@ Namespace API.Instagram
If Not storyID.IsEmptyString Then storyID &= ":" If Not storyID.IsEmptyString Then storyID &= ":"
With jj("items").XmlIfNothing With jj("items").XmlIfNothing
If .Count > 0 Then If .Count > 0 Then
For Each s In .Self : ThrowAny(Token) : ObtainMedia2(s, storyID & s.Value("id"), sFolder) : Next For Each s In .Self
pid = storyID & s.Value("id")
If Not _TempPostsList.Contains(pid) Then
ThrowAny(Token)
ObtainMedia2(s, pid, sFolder)
_TempPostsList.Add(pid)
End If
Next
End If End If
End With End With
Next Next
@@ -515,27 +653,32 @@ Namespace API.Instagram
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
DownloadingException(ex, "API.Instagram.GetStoriesList") DownloadingException(ex, "API.Instagram.GetStoriesList", Sections.Stories, False)
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"
''' <summary> ''' <summary>
''' <inheritdoc cref="UserDataBase.DownloadingException(Exception, String)"/><br/> ''' <inheritdoc cref="UserDataBase.DownloadingException(Exception, String)"/><br/>
''' 1 - continue ''' 1 - continue
''' </summary> ''' </summary>
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer Protected Overloads Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
Return DownloadingException(ex, Message, Sections.Timeline, FromPE)
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" MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
MySiteSettings.HashUpdateRequired.Value = True ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then
Return 3
ElseIf Responser.StatusCode = 429 Then ElseIf Responser.StatusCode = 429 Then
With MySiteSettings With MySiteSettings
Dim WaiterExists As Boolean = .LastApplyingValue.HasValue Dim WaiterExists As Boolean = .LastApplyingValue.HasValue
@@ -546,12 +689,14 @@ Namespace API.Instagram
MyMainLOG = $"Number of requests before error 429: {RequestsCount}" MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1 Return 1
Else Else
MySiteSettings.HashUpdateRequired.Value = True MyMainLOG = $"Instagram hash requested [{CInt(Responser.StatusCode)}]: {ToString()} [{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
#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))
@@ -561,12 +706,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) As IEnumerable(Of UserMedia) #End Region
#Region "Standalone downloader"
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal r As Response, ByVal _Settings As SiteSettings) 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.Responser = New Response t.Responser = New Response
t.Responser.Copy(r) t.Responser.Copy(r)
t._SavedPostsIDs.Add(PID) t._SavedPostsIDs.Add(PID)
@@ -580,9 +729,12 @@ Namespace API.Instagram
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")
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

@@ -9,12 +9,15 @@
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 View = SCrawler.API.Reddit.IRedditView.View
Imports Period = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit Namespace API.Reddit
Friend Class Channel : Implements ICollection(Of UserPost), IEquatable(Of Channel), IComparable(Of Channel), Friend Class Channel : Implements ICollection(Of UserPost), IEquatable(Of Channel), IComparable(Of Channel),
IRangeSwitcherContainer(Of UserPost), ILoaderSaver, IMyEnumerator(Of UserPost), IChannelLimits, IDisposable IRangeSwitcherContainer(Of UserPost), ILoaderSaver, IMyEnumerator(Of UserPost), IChannelLimits, IRedditView, IDisposable
#Region "XML Nodes' Names" #Region "XML Nodes' Names"
Private Const Name_Name As String = "Name" Private Const Name_Name As String = "Name"
Private Const Name_ID As String = "ID" Private Const Name_ID As String = "ID"
@@ -35,15 +38,18 @@ Namespace API.Reddit
End Property End Property
Friend ReadOnly Property PostsLatest As List(Of UserPost) Friend ReadOnly Property PostsLatest As List(Of UserPost)
Friend ReadOnly Property Posts As List(Of UserPost) Friend ReadOnly Property Posts As List(Of UserPost)
Friend ReadOnly Property PostsNames As List(Of String)
Friend ReadOnly Property PostsAll As List(Of UserPost) Friend ReadOnly Property PostsAll As List(Of UserPost)
Get Get
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
@@ -57,6 +63,14 @@ Namespace API.Reddit
Return $"{ChannelsCollection.ChannelsPath.PathWithSeparator}{ID}.xml" Return $"{ChannelsCollection.ChannelsPath.PathWithSeparator}{ID}.xml"
End Get End Get
End Property End Property
Private ReadOnly Property FilePosts As SFile
Get
Dim f As SFile = File
f.Name &= "_Posts"
f.Extension = "txt"
Return f
End Get
End Property
Friend ReadOnly Property CachePath As SFile Friend ReadOnly Property CachePath As SFile
Get Get
Return $"{ChannelsCollection.ChannelsPathCache.PathWithSeparator}{ID}\" Return $"{ChannelsCollection.ChannelsPathCache.PathWithSeparator}{ID}\"
@@ -72,7 +86,14 @@ Namespace API.Reddit
Return Posts(Index) Return Posts(Index)
End Get End Get
End Property End Property
Private ReadOnly Property Range As RangeSwitcher(Of UserPost) Friend Property ViewMode As View = View.New Implements IRedditView.ViewMode
Friend Property ViewPeriod As Period = Period.All Implements IRedditView.ViewPeriod
Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView
If Not Options Is Nothing Then
ViewMode = Options.ViewMode
ViewPeriod = Options.ViewPeriod
End If
End Sub
#Region "Statistics support" #Region "Statistics support"
Private ReadOnly CountOfAddedUsers As List(Of Integer) Private ReadOnly CountOfAddedUsers As List(Of Integer)
Private ReadOnly CountOfLoadedPostsPerSession As List(Of Integer) Private ReadOnly CountOfLoadedPostsPerSession As List(Of Integer)
@@ -91,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
@@ -118,16 +139,20 @@ Namespace API.Reddit
Private _DownloadLimitCount As Integer? = Nothing Private _DownloadLimitCount As Integer? = Nothing
Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount
Get Get
If AutoGetLimits Then If Not ViewMode = View.New And AutoGetLimits Then
If LatestParsedDate.HasValue OrElse Not DownloadLimitPost.IsEmptyString Then
Return Nothing
ElseIf _DownloadLimitCount.HasValue Then
Return _DownloadLimitCount
Else
Return DefaultDownloadLimitCount
End If
Else
Return _DownloadLimitCount Return _DownloadLimitCount
Else
If AutoGetLimits Then
If LatestParsedDate.HasValue OrElse Not DownloadLimitPost.IsEmptyString Then
Return Nothing
ElseIf _DownloadLimitCount.HasValue Then
Return _DownloadLimitCount
Else
Return DefaultDownloadLimitCount
End If
Else
Return _DownloadLimitCount
End If
End If End If
End Get End Get
Set(ByVal NewLimit As Integer?) Set(ByVal NewLimit As Integer?)
@@ -137,11 +162,15 @@ Namespace API.Reddit
Private _DownloadLimitPost As String = String.Empty Private _DownloadLimitPost As String = String.Empty
Friend Property DownloadLimitPost As String Implements IChannelLimits.DownloadLimitPost Friend Property DownloadLimitPost As String Implements IChannelLimits.DownloadLimitPost
Get Get
Dim PID$ = ListAddList(Nothing, Posts, LAP.NotContainsOnly).ListAddList(PostsLatest, LAP.NotContainsOnly).ListSort.FirstOrDefault.ID If Not ViewMode = View.New And AutoGetLimits Then
If AutoGetLimits And Not PID.IsEmptyString Then
Return PID
Else
Return _DownloadLimitPost Return _DownloadLimitPost
Else
Dim PID$ = ListAddList(Nothing, Posts, LNC).ListAddList(PostsLatest, LNC).ListSort.FirstOrDefault.ID
If AutoGetLimits And Not PID.IsEmptyString Then
Return PID
Else
Return _DownloadLimitPost
End If
End If End If
End Get End Get
Set(ByVal NewLimit As String) Set(ByVal NewLimit As String)
@@ -151,10 +180,14 @@ Namespace API.Reddit
Private _DownloadLimitDate As Date? = Nothing Private _DownloadLimitDate As Date? = Nothing
Friend Property DownloadLimitDate As Date? Implements IChannelLimits.DownloadLimitDate Friend Property DownloadLimitDate As Date? Implements IChannelLimits.DownloadLimitDate
Get Get
If AutoGetLimits And LatestParsedDate.HasValue Then If Not ViewMode = View.New And AutoGetLimits Then
Return LatestParsedDate
Else
Return _DownloadLimitDate Return _DownloadLimitDate
Else
If AutoGetLimits And LatestParsedDate.HasValue Then
Return LatestParsedDate
Else
Return _DownloadLimitDate
End If
End If End If
End Get End Get
Set(ByVal NewLimit As Date?) Set(ByVal NewLimit As Date?)
@@ -174,6 +207,11 @@ Namespace API.Reddit
DownloadLimitDate = .DownloadLimitDate DownloadLimitDate = .DownloadLimitDate
AutoGetLimits = .AutoGetLimits AutoGetLimits = .AutoGetLimits
End With End With
If Not ViewMode = View.New And AutoGetLimits Then
DownloadLimitDate = Nothing
DownloadLimitCount = Nothing
DownloadLimitPost = String.Empty
End If
End Sub End Sub
Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits Friend Property AutoGetLimits As Boolean = True Implements IChannelLimits.AutoGetLimits
#End Region #End Region
@@ -181,7 +219,7 @@ Namespace API.Reddit
Friend Sub New() Friend Sub New()
Posts = New List(Of UserPost) Posts = New List(Of UserPost)
PostsLatest = New List(Of UserPost) PostsLatest = New List(Of UserPost)
Range = New RangeSwitcher(Of UserPost)(Me) PostsNames = New List(Of String)
CountOfAddedUsers = New List(Of Integer) CountOfAddedUsers = New List(Of Integer)
CountOfLoadedPostsPerSession = New List(Of Integer) CountOfLoadedPostsPerSession = New List(Of Integer)
ChannelExistentUserNames = New List(Of String) ChannelExistentUserNames = New List(Of String)
@@ -195,14 +233,11 @@ 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) File.Delete(, SFODelete.DeleteToRecycleBin)
FilePosts.Delete(, SFODelete.DeleteToRecycleBin)
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)
@@ -214,12 +249,15 @@ Namespace API.Reddit
.SkipExistsUsers = SkipExists, .SkipExistsUsers = SkipExists,
.ChannelInfo = Me .ChannelInfo = Me
} }
d.SetEnvironment(HOST, CUser, False) With d
d.RemoveUpdateHandlers() .SetEnvironment(HOST, CUser, False)
d.SetLimit(Me) .RemoveUpdateHandlers()
d.DownloadData(Token) .SetLimit(Me)
.SetView(Me)
.DownloadData(Token)
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)
@@ -298,6 +336,9 @@ Namespace API.Reddit
Dim lc As New ListAddParams(LAP.ClearBeforeAdd) Dim lc As New ListAddParams(LAP.ClearBeforeAdd)
Name = x.Value(Name_Name) Name = x.Value(Name_Name)
ID = x.Value(Name_ID) ID = x.Value(Name_ID)
ViewMode = x.Value(Name_ViewMode).FromXML(Of Integer)(CInt(View.[New]))
ViewPeriod = x.Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(Period.All))
If FilePosts.Exists Then PostsNames.ListAddList(FilePosts.GetText.StringToList(Of String)("|"), LNC)
LatestParsedDate = AConvert(Of Date)(x.Value(Name_Date), XMLDateProvider, Nothing) LatestParsedDate = AConvert(Of Date)(x.Value(Name_Date), XMLDateProvider, Nothing)
CountOfAddedUsers.ListAddList(x.Value(Name_UsersAdded).StringToList(Of Integer)("|"), lc) CountOfAddedUsers.ListAddList(x.Value(Name_UsersAdded).StringToList(Of Integer)("|"), lc)
CountOfLoadedPostsPerSession.ListAddList(x.Value(Name_PostsDownloaded).StringToList(Of Integer)("|"), lc) CountOfLoadedPostsPerSession.ListAddList(x.Value(Name_PostsDownloaded).StringToList(Of Integer)("|"), lc)
@@ -317,9 +358,20 @@ Namespace API.Reddit
Friend Overloads Function Save(Optional ByVal f As SFile = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements ILoaderSaver.Save Friend Overloads Function Save(Optional ByVal f As SFile = Nothing, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Implements ILoaderSaver.Save
Dim XMLDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime) Dim XMLDateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
UpdateUsersStats() UpdateUsersStats()
If Not ViewMode = View.New Then
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), LNC)
l.ListAddList(PostsNames, LNC)
If l.Count > 0 Then TextSaver.SaveTextToFile(l.ListToString("|"), FilePosts, True,, EDP.SendInLog)
End If
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Channel"} Using x As New XmlFile With {.AllowSameNames = True, .Name = "Channel"}
x.Add(Name_Name, Name) x.Add(Name_Name, Name)
x.Add(Name_ID, ID) x.Add(Name_ID, ID)
x.Add(Name_ViewMode, CInt(ViewMode))
x.Add(Name_ViewPeriod, CInt(ViewPeriod))
x.Add(Name_UsersAdded, CountOfAddedUsers.ListToString("|"))
x.Add(Name_PostsDownloaded, CountOfLoadedPostsPerSession.ListToString("|"))
x.Add(Name_UsersExistent, ChannelExistentUserNames.ListToString("|"))
If Posts.Count > 0 Or PostsLatest.Count > 0 Then If Posts.Count > 0 Or PostsLatest.Count > 0 Then
Dim tmpPostList As List(Of UserPost) = Nothing Dim tmpPostList As List(Of UserPost) = Nothing
tmpPostList.ListAddList(Posts).ListAddList(PostsLatest) tmpPostList.ListAddList(Posts).ListAddList(PostsLatest)
@@ -327,9 +379,6 @@ Namespace API.Reddit
LatestParsedDate = tmpPostList.FirstOrDefault(Function(pd) pd.Date.HasValue).Date LatestParsedDate = tmpPostList.FirstOrDefault(Function(pd) pd.Date.HasValue).Date
x.Add(Name_Date, AConvert(Of String)(LatestParsedDate, XMLDateProvider, String.Empty)) x.Add(Name_Date, AConvert(Of String)(LatestParsedDate, XMLDateProvider, String.Empty))
x.Add(Name_PostsNode, String.Empty) x.Add(Name_PostsNode, String.Empty)
x.Add(Name_UsersAdded, CountOfAddedUsers.ListToString(, "|"))
x.Add(Name_PostsDownloaded, CountOfLoadedPostsPerSession.ListToString(, "|"))
x.Add(Name_UsersExistent, ChannelExistentUserNames.ListToString(, "|"))
With x(Name_PostsNode) With x(Name_PostsNode)
tmpPostList.Take(200).ToList.ForEach(Sub(p) .Add(New EContainer("Post", tmpPostList.Take(200).ToList.ForEach(Sub(p) .Add(New EContainer("Post",
String.Empty, String.Empty,
@@ -354,9 +403,9 @@ Namespace API.Reddit
If disposing Then If disposing Then
Posts.Clear() Posts.Clear()
PostsLatest.Clear() PostsLatest.Clear()
PostsNames.Clear()
CountOfAddedUsers.Clear() CountOfAddedUsers.Clear()
CountOfLoadedPostsPerSession.Clear() CountOfLoadedPostsPerSession.Clear()
Range.Dispose()
ChannelExistentUserNames.Clear() ChannelExistentUserNames.Clear()
CachePath.Delete(SFO.Path, SFODelete.None, EDP.SendInLog) CachePath.Delete(SFO.Path, SFODelete.None, EDP.SendInLog)
End If End If

View File

@@ -12,8 +12,16 @@ Imports SCrawler.API.Base
Imports System.Threading 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 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 +50,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 +105,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

@@ -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

@@ -0,0 +1,40 @@
' 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.Reddit
Friend Interface IRedditView
Enum View As Integer
[New] = 0
Hot = 1
Top = 2
End Enum
Enum Period As Integer
All = 0
Hour = 1
Day = 2
Week = 3
Month = 4
Year = 5
End Enum
Property ViewMode As View
Property ViewPeriod As Period
Sub SetView(ByVal Options As IRedditView)
End Interface
Friend Class RedditViewExchange : Implements IRedditView
Friend Const Name_ViewMode As String = "ViewMode"
Friend Const Name_ViewPeriod As String = "ViewPeriod"
Friend Property ViewMode As IRedditView.View Implements IRedditView.ViewMode
Friend Property ViewPeriod As IRedditView.Period Implements IRedditView.ViewPeriod
Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView
If Not Options Is Nothing Then
ViewMode = Options.ViewMode
ViewPeriod = Options.ViewPeriod
End If
End Sub
End Class
End Namespace

View File

@@ -14,23 +14,30 @@ Namespace API.Reddit
Namespace M3U8_Declarations Namespace M3U8_Declarations
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)
Friend ReadOnly PlayListRegEx_1 As RParams = RParams.DM("(#EXT-X-STREAM-INF)(.+)(RESOLUTION=)(\d+)(.+?[\r\n]{1,2})(.+?)([\r\n]{1,2})", 0, ''' <summary>Video</summary>
RegexReturn.List, EDP.SendInLog, EDP.ReturnValue) 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)
Friend ReadOnly PlayListRegEx_2 As RParams = RParams.DM("(?<=#EXT-X-BYTERANGE.+?[\r\n]{1,2})(.+)(?=[\r\n]{0,2})", 0, ''' <summary>Audio, Video</summary>
RegexReturn.List, EDP.SendInLog, EDP.ReturnValue) Friend ReadOnly PlayListRegEx_2 As RParams = RParams.DM("(?<=#EXT-X-BYTERANGE.+?[\r\n]{1,2})(.+)(?=[\r\n]{0,2})", 0, RegexReturn.List)
Friend ReadOnly PlayListAudioRegEx As RParams = RParams.DM("(HLS_AUDIO_(\d+)[^""]+)", 0, RegexReturn.List)
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
Friend NotInheritable Class M3U8 Friend NotInheritable Class M3U8 : Implements IDisposable
Private Sub New() #Region "Declarations"
End Sub Private Enum Types : Video : Audio : End Enum
Private Structure Resolution : Implements IRegExCreator, IComparable(Of Resolution) Private Structure Resolution : Implements IRegExCreator, IComparable(Of Resolution)
Friend File As String Friend File As String
Friend Resolution As Integer Friend Resolution As Integer
Friend HasError As Boolean
Friend Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray Friend Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ArrayExists Then If ParamsArray.ArrayExists Then
File = ParamsArray(0) File = ParamsArray(0)
If ParamsArray.Length > 1 Then Resolution = AConvert(Of Integer)(ParamsArray(1), 0) Try
If ParamsArray.Length > 1 Then Resolution = AConvert(Of Integer)(ParamsArray(1), EDP.ThrowException)
Catch ex As Exception
HasError = True
Resolution = 0
End Try
End If End If
Return Me Return Me
End Function End Function
@@ -38,21 +45,60 @@ Namespace API.Reddit
Return Resolution.CompareTo(Other.Resolution) * -1 Return Resolution.CompareTo(Other.Resolution) * -1
End Function End Function
End Structure End Structure
Private Shared Function GetPlaylistUrls(ByVal PlayListURL As String, ByVal BaseUrl As String) As List(Of String) Private ReadOnly PlayListURL As String
Private ReadOnly BaseURL As String
Private ReadOnly Video As List(Of String)
Private ReadOnly Audio As List(Of String)
Private OutFile As SFile
Private VideoFile As SFile
Private AudioFile As SFile
Private CachePath As SFile
#End Region
Private Sub New(ByVal URL As String, ByVal OutFile As SFile)
PlayListURL = URL
BaseURL = RegexReplace(URL, BaseUrlPattern)
Video = New List(Of String)
Audio = New List(Of String)
Me.OutFile = OutFile
Me.OutFile.Name = "PlayListFile"
Me.OutFile.Extension = "mp4"
CachePath = $"{OutFile.PathWithSeparator}_Cache\{SFile.GetDirectories($"{OutFile.PathWithSeparator}_Cache\",,, EDP.ReturnValue).ListIfNothing.Count + 1}\"
End Sub
#Region "Internal functions"
#Region "GetPlaylistUrls"
Private Overloads Sub GetPlaylistUrls()
Video.ListAddList(GetPlaylistUrls(PlayListURL, Types.Video))
Audio.ListAddList(GetPlaylistUrls(PlayListURL, Types.Audio))
End Sub
Private Overloads Function GetPlaylistUrls(ByVal PlayListURL As String, ByVal Type As Types) As List(Of String)
Try Try
If Not BaseUrl.IsEmptyString Then If Not BaseURL.IsEmptyString Then
Using w As New WebClient Using w As New WebClient
Dim r$ = w.DownloadString(PlayListURL) Dim r$ = w.DownloadString(PlayListURL)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim l As List(Of Resolution) = FNF.RegexFields(Of Resolution)(r, {PlayListRegEx_1}, {6, 4}) Dim l As New List(Of Resolution)
If Type = Types.Video Then
l = RegexFields(Of Resolution)(r, {PlayListRegEx_1}, {6, 4})
Else
Try
l = RegexFields(Of Resolution)(r, {PlayListAudioRegEx}, {1, 2})
Catch anull As RegexFieldsTextBecameNullException
l.Clear()
End Try
End If
If l.ListExists Then If l.ListExists Then
Dim plError As Predicate(Of Resolution) = Function(lr) lr.HasError
If l.Exists(plError) Then
l.RemoveAll(plError)
If l.Count = 0 Then Return New List(Of String)
End If
l.Sort() l.Sort()
Dim pls$ = $"{BaseUrl}/{l.First.File}" Dim pls$ = $"{BaseURL}/{l.First.File}"
r = w.DownloadString(pls) r = w.DownloadString(pls)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim lp As New ListAddParams(LAP.NotContainsOnly) With { Dim lp As New ListAddParams(LAP.NotContainsOnly) With {
.Converter = Function(input) $"{BaseUrl}/{input}", .Converter = Function(input) $"{BaseURL}/{input}",
.e = New ErrorsDescriber(False, False, True, New List(Of String))} .Error = New ErrorsDescriber(False, False, True, New List(Of String))}
Return ListAddList(Of String, List(Of String))(Nothing, DirectCast(RegexReplace(r, PlayListRegEx_2), List(Of String)), lp).ListIfNothing Return ListAddList(Of String, List(Of String))(Nothing, DirectCast(RegexReplace(r, PlayListRegEx_2), List(Of String)), lp).ListIfNothing
End If End If
End If End If
@@ -61,47 +107,94 @@ Namespace API.Reddit
End If End If
Return New List(Of String) Return New List(Of String)
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(DPED, ex, "[M3U8.GetPlaylistUrls]", New List(Of String)) Return ErrorsDescriber.Execute(DPED, ex, $"[M3U8.GetPlaylistUrls({Type}): {PlayListURL}]", New List(Of String))
End Try End Try
End Function End Function
Private Shared Function Save(ByVal URLs As List(Of String), ByVal f As SFile) As SFile #End Region
Dim CachePath As SFile = Nothing #Region "ConcatData"
Private Overloads Sub ConcatData()
ConcatData(Video, Types.Video, VideoFile)
ConcatData(Audio, Types.Audio, AudioFile)
MergeFiles()
End Sub
Private Overloads Sub ConcatData(ByVal Urls As List(Of String), ByVal Type As Types, ByRef TFile As SFile)
Try Try
If URLs.ListExists Then If Urls.ListExists Then
Dim ConcatFile As SFile = f Dim ConcatFile As SFile = OutFile
ConcatFile.Name = "PlayListFile" If Type = Types.Audio Then
ConcatFile.Extension = "mp4" ConcatFile.Name &= "_AUDIO"
CachePath = $"{f.PathWithSeparator}_Cache\{SFile.GetDirectories($"{f.PathWithSeparator}_Cache\",,, EDP.ReturnValue).ListIfNothing.Count + 1}\" ConcatFile.Extension = "aac"
Else
If Audio.Count > 0 Then ConcatFile.Name &= "_VIDEO"
ConcatFile.Extension = "mp4"
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.ReturnValue) ConcatFile = SFile.Indexed_IndexFile(ConcatFile,, p, EDP.ThrowException) 'EDP.ReturnValue
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
dFile.Extension = New SFile(URLs(0)).Extension dFile.Extension = New SFile(Urls(0)).Extension
If dFile.Extension.IsEmptyString Then dFile.Extension = "ts" If dFile.Extension.IsEmptyString Then dFile.Extension = "ts"
Using w As New WebClient Using w As New WebClient
For i = 0 To URLs.Count - 1 For i = 0 To Urls.Count - 1
dFile.Name = $"ConPart_{i}" dFile.Name = $"ConPart_{i}"
w.DownloadFile(URLs(i), dFile) w.DownloadFile(Urls(i), dFile)
eFiles.Add(dFile) eFiles.Add(dFile)
Next Next
End Using End Using
f = FFMPEG.ConcatenateFiles(eFiles, Settings.FfmpegFile, ConcatFile, p, DPED) TFile = FFMPEG.ConcatenateFiles(eFiles, Settings.FfmpegFile, ConcatFile, p, DPED)
eFiles.Clear() eFiles.Clear()
Return f
End If End If
End If End If
Return Nothing
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(DPED, ex, "[M3U8.Save]", New SFile) ErrorsDescriber.Execute(DPED, ex, $"[M3U8.Save({Type})]")
Finally
CachePath.Delete(SFO.Path, SFODelete.None, DPED)
End Try End Try
End Sub
#End Region
Private Sub MergeFiles()
Try
If Not VideoFile.IsEmptyString And Not AudioFile.IsEmptyString Then
Dim p As New SFileNumbers(OutFile.Name,, RParams.DMS("PlayListFile_(\d*)", 1), New ANumbers With {.Format = ANumbers.Formats.General})
OutFile = FFMPEG.MergeFiles({VideoFile, AudioFile}, Settings.FfmpegFile, OutFile, p, DPED)
Else
OutFile = VideoFile
End If
Catch ex As Exception
ErrorsDescriber.Execute(DPED, ex, $"[M3U8.MergeFiles]")
End Try
End Sub
Friend Function Download() As SFile
GetPlaylistUrls()
ConcatData()
Return OutFile
End Function End Function
#End Region
#Region "Statics"
Friend Shared Function Download(ByVal URL As String, ByVal f As SFile) As SFile Friend Shared Function Download(ByVal URL As String, ByVal f As SFile) As SFile
Dim BaseUrl$ = RegexReplace(URL, BaseUrlPattern) Using m As New M3U8(URL, f) : Return m.Download() : End Using
Return Save(GetPlaylistUrls(URL, BaseUrl), f)
End Function End Function
#End Region
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Private Overloads Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then
Video.Clear()
Audio.Clear()
CachePath.Delete(SFO.Path, SFODelete.None, DPED)
End If
disposedValue = True
End If
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class End Class
End Namespace End Namespace

View File

@@ -0,0 +1,301 @@
' 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.Reddit
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class RedditViewSettingsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim TP_VIEW_MODE As System.Windows.Forms.TableLayoutPanel
Dim LBL_VIEW_MODE 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_HOT = New System.Windows.Forms.RadioButton()
Me.OPT_VIEW_MODE_TOP = New System.Windows.Forms.RadioButton()
Me.TP_PERIOD = New System.Windows.Forms.TableLayoutPanel()
Me.OPT_PERIOD_ALL = New System.Windows.Forms.RadioButton()
Me.OPT_PERIOD_HOUR = New System.Windows.Forms.RadioButton()
Me.OPT_PERIOD_DAY = New System.Windows.Forms.RadioButton()
Me.OPT_PERIOD_WEEK = New System.Windows.Forms.RadioButton()
Me.OPT_PERIOD_MONTH = New System.Windows.Forms.RadioButton()
Me.OPT_PERIOD_YEAR = New System.Windows.Forms.RadioButton()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TP_VIEW_MODE = New System.Windows.Forms.TableLayoutPanel()
LBL_VIEW_MODE = New System.Windows.Forms.Label()
LBL_PERIOD = New System.Windows.Forms.Label()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
TP_VIEW_MODE.SuspendLayout()
Me.TP_PERIOD.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(477, 87)
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(477, 112)
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.Controls.Add(TP_VIEW_MODE, 0, 0)
TP_MAIN.Controls.Add(Me.TP_PERIOD, 0, 1)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 3
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 56.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_MAIN.Size = New System.Drawing.Size(477, 87)
TP_MAIN.TabIndex = 0
'
'TP_VIEW_MODE
'
TP_VIEW_MODE.ColumnCount = 4
TP_VIEW_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
TP_VIEW_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
TP_VIEW_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
TP_VIEW_MODE.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
TP_VIEW_MODE.Controls.Add(LBL_VIEW_MODE, 0, 0)
TP_VIEW_MODE.Controls.Add(Me.OPT_VIEW_MODE_NEW, 1, 0)
TP_VIEW_MODE.Controls.Add(Me.OPT_VIEW_MODE_HOT, 2, 0)
TP_VIEW_MODE.Controls.Add(Me.OPT_VIEW_MODE_TOP, 3, 0)
TP_VIEW_MODE.Dock = System.Windows.Forms.DockStyle.Fill
TP_VIEW_MODE.Location = New System.Drawing.Point(1, 1)
TP_VIEW_MODE.Margin = New System.Windows.Forms.Padding(0)
TP_VIEW_MODE.Name = "TP_VIEW_MODE"
TP_VIEW_MODE.RowCount = 1
TP_VIEW_MODE.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_VIEW_MODE.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_VIEW_MODE.Size = New System.Drawing.Size(475, 28)
TP_VIEW_MODE.TabIndex = 0
'
'LBL_VIEW_MODE
'
LBL_VIEW_MODE.AutoSize = True
LBL_VIEW_MODE.Dock = System.Windows.Forms.DockStyle.Fill
LBL_VIEW_MODE.Location = New System.Drawing.Point(3, 0)
LBL_VIEW_MODE.Name = "LBL_VIEW_MODE"
LBL_VIEW_MODE.Size = New System.Drawing.Size(112, 28)
LBL_VIEW_MODE.TabIndex = 0
LBL_VIEW_MODE.Text = "View"
LBL_VIEW_MODE.TextAlign = System.Drawing.ContentAlignment.MiddleRight
'
'OPT_VIEW_MODE_NEW
'
Me.OPT_VIEW_MODE_NEW.AutoSize = True
Me.OPT_VIEW_MODE_NEW.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_VIEW_MODE_NEW.Location = New System.Drawing.Point(121, 3)
Me.OPT_VIEW_MODE_NEW.Name = "OPT_VIEW_MODE_NEW"
Me.OPT_VIEW_MODE_NEW.Size = New System.Drawing.Size(112, 22)
Me.OPT_VIEW_MODE_NEW.TabIndex = 1
Me.OPT_VIEW_MODE_NEW.TabStop = True
Me.OPT_VIEW_MODE_NEW.Text = "New"
Me.OPT_VIEW_MODE_NEW.UseVisualStyleBackColor = True
'
'OPT_VIEW_MODE_HOT
'
Me.OPT_VIEW_MODE_HOT.AutoSize = True
Me.OPT_VIEW_MODE_HOT.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_VIEW_MODE_HOT.Location = New System.Drawing.Point(239, 3)
Me.OPT_VIEW_MODE_HOT.Name = "OPT_VIEW_MODE_HOT"
Me.OPT_VIEW_MODE_HOT.Size = New System.Drawing.Size(112, 22)
Me.OPT_VIEW_MODE_HOT.TabIndex = 2
Me.OPT_VIEW_MODE_HOT.TabStop = True
Me.OPT_VIEW_MODE_HOT.Text = "Hot"
Me.OPT_VIEW_MODE_HOT.UseVisualStyleBackColor = True
'
'OPT_VIEW_MODE_TOP
'
Me.OPT_VIEW_MODE_TOP.AutoSize = True
Me.OPT_VIEW_MODE_TOP.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_VIEW_MODE_TOP.Location = New System.Drawing.Point(357, 3)
Me.OPT_VIEW_MODE_TOP.Name = "OPT_VIEW_MODE_TOP"
Me.OPT_VIEW_MODE_TOP.Size = New System.Drawing.Size(115, 22)
Me.OPT_VIEW_MODE_TOP.TabIndex = 3
Me.OPT_VIEW_MODE_TOP.TabStop = True
Me.OPT_VIEW_MODE_TOP.Text = "Top"
Me.OPT_VIEW_MODE_TOP.UseVisualStyleBackColor = True
'
'TP_PERIOD
'
Me.TP_PERIOD.ColumnCount = 4
Me.TP_PERIOD.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
Me.TP_PERIOD.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
Me.TP_PERIOD.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
Me.TP_PERIOD.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.0!))
Me.TP_PERIOD.Controls.Add(LBL_PERIOD, 0, 0)
Me.TP_PERIOD.Controls.Add(Me.OPT_PERIOD_ALL, 1, 0)
Me.TP_PERIOD.Controls.Add(Me.OPT_PERIOD_HOUR, 2, 0)
Me.TP_PERIOD.Controls.Add(Me.OPT_PERIOD_DAY, 3, 0)
Me.TP_PERIOD.Controls.Add(Me.OPT_PERIOD_WEEK, 1, 1)
Me.TP_PERIOD.Controls.Add(Me.OPT_PERIOD_MONTH, 2, 1)
Me.TP_PERIOD.Controls.Add(Me.OPT_PERIOD_YEAR, 3, 1)
Me.TP_PERIOD.Dock = System.Windows.Forms.DockStyle.Fill
Me.TP_PERIOD.Location = New System.Drawing.Point(1, 30)
Me.TP_PERIOD.Margin = New System.Windows.Forms.Padding(0)
Me.TP_PERIOD.Name = "TP_PERIOD"
Me.TP_PERIOD.RowCount = 2
Me.TP_PERIOD.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
Me.TP_PERIOD.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 50.0!))
Me.TP_PERIOD.Size = New System.Drawing.Size(475, 56)
Me.TP_PERIOD.TabIndex = 2
'
'LBL_PERIOD
'
LBL_PERIOD.AutoSize = True
LBL_PERIOD.Dock = System.Windows.Forms.DockStyle.Fill
LBL_PERIOD.Location = New System.Drawing.Point(3, 0)
LBL_PERIOD.Name = "LBL_PERIOD"
LBL_PERIOD.Size = New System.Drawing.Size(112, 28)
LBL_PERIOD.TabIndex = 0
LBL_PERIOD.Text = "Period"
LBL_PERIOD.TextAlign = System.Drawing.ContentAlignment.MiddleRight
'
'OPT_PERIOD_ALL
'
Me.OPT_PERIOD_ALL.AutoSize = True
Me.OPT_PERIOD_ALL.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_PERIOD_ALL.Location = New System.Drawing.Point(121, 3)
Me.OPT_PERIOD_ALL.Name = "OPT_PERIOD_ALL"
Me.OPT_PERIOD_ALL.Size = New System.Drawing.Size(112, 22)
Me.OPT_PERIOD_ALL.TabIndex = 1
Me.OPT_PERIOD_ALL.TabStop = True
Me.OPT_PERIOD_ALL.Text = "All"
Me.OPT_PERIOD_ALL.UseVisualStyleBackColor = True
'
'OPT_PERIOD_HOUR
'
Me.OPT_PERIOD_HOUR.AutoSize = True
Me.OPT_PERIOD_HOUR.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_PERIOD_HOUR.Location = New System.Drawing.Point(239, 3)
Me.OPT_PERIOD_HOUR.Name = "OPT_PERIOD_HOUR"
Me.OPT_PERIOD_HOUR.Size = New System.Drawing.Size(112, 22)
Me.OPT_PERIOD_HOUR.TabIndex = 2
Me.OPT_PERIOD_HOUR.TabStop = True
Me.OPT_PERIOD_HOUR.Text = "Hour"
Me.OPT_PERIOD_HOUR.UseVisualStyleBackColor = True
'
'OPT_PERIOD_DAY
'
Me.OPT_PERIOD_DAY.AutoSize = True
Me.OPT_PERIOD_DAY.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_PERIOD_DAY.Location = New System.Drawing.Point(357, 3)
Me.OPT_PERIOD_DAY.Name = "OPT_PERIOD_DAY"
Me.OPT_PERIOD_DAY.Size = New System.Drawing.Size(115, 22)
Me.OPT_PERIOD_DAY.TabIndex = 3
Me.OPT_PERIOD_DAY.TabStop = True
Me.OPT_PERIOD_DAY.Text = "Day"
Me.OPT_PERIOD_DAY.UseVisualStyleBackColor = True
'
'OPT_PERIOD_WEEK
'
Me.OPT_PERIOD_WEEK.AutoSize = True
Me.OPT_PERIOD_WEEK.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_PERIOD_WEEK.Location = New System.Drawing.Point(121, 31)
Me.OPT_PERIOD_WEEK.Name = "OPT_PERIOD_WEEK"
Me.OPT_PERIOD_WEEK.Size = New System.Drawing.Size(112, 22)
Me.OPT_PERIOD_WEEK.TabIndex = 4
Me.OPT_PERIOD_WEEK.TabStop = True
Me.OPT_PERIOD_WEEK.Text = "Week"
Me.OPT_PERIOD_WEEK.UseVisualStyleBackColor = True
'
'OPT_PERIOD_MONTH
'
Me.OPT_PERIOD_MONTH.AutoSize = True
Me.OPT_PERIOD_MONTH.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_PERIOD_MONTH.Location = New System.Drawing.Point(239, 31)
Me.OPT_PERIOD_MONTH.Name = "OPT_PERIOD_MONTH"
Me.OPT_PERIOD_MONTH.Size = New System.Drawing.Size(112, 22)
Me.OPT_PERIOD_MONTH.TabIndex = 5
Me.OPT_PERIOD_MONTH.TabStop = True
Me.OPT_PERIOD_MONTH.Text = "Month"
Me.OPT_PERIOD_MONTH.UseVisualStyleBackColor = True
'
'OPT_PERIOD_YEAR
'
Me.OPT_PERIOD_YEAR.AutoSize = True
Me.OPT_PERIOD_YEAR.Dock = System.Windows.Forms.DockStyle.Fill
Me.OPT_PERIOD_YEAR.Location = New System.Drawing.Point(357, 31)
Me.OPT_PERIOD_YEAR.Name = "OPT_PERIOD_YEAR"
Me.OPT_PERIOD_YEAR.Size = New System.Drawing.Size(115, 22)
Me.OPT_PERIOD_YEAR.TabIndex = 6
Me.OPT_PERIOD_YEAR.TabStop = True
Me.OPT_PERIOD_YEAR.Text = "Year"
Me.OPT_PERIOD_YEAR.UseVisualStyleBackColor = True
'
'RedditViewSettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(477, 112)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(493, 151)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(493, 151)
Me.Name = "RedditViewSettingsForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Options"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
TP_VIEW_MODE.ResumeLayout(False)
TP_VIEW_MODE.PerformLayout()
Me.TP_PERIOD.ResumeLayout(False)
Me.TP_PERIOD.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents OPT_VIEW_MODE_NEW As RadioButton
Private WithEvents OPT_VIEW_MODE_HOT As RadioButton
Private WithEvents OPT_VIEW_MODE_TOP As RadioButton
Private WithEvents OPT_PERIOD_ALL As RadioButton
Private WithEvents OPT_PERIOD_HOUR As RadioButton
Private WithEvents OPT_PERIOD_DAY As RadioButton
Private WithEvents OPT_PERIOD_WEEK As RadioButton
Private WithEvents OPT_PERIOD_MONTH As RadioButton
Private WithEvents OPT_PERIOD_YEAR As RadioButton
Private WithEvents TP_PERIOD As TableLayoutPanel
End Class
End Namespace

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,84 @@
' 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 PersonalUtilities.Forms
Imports CView = SCrawler.API.Reddit.IRedditView.View
Imports CPeriod = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit
Friend Class RedditViewSettingsForm
Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property MyOptions As IRedditView
Friend Sub New(ByRef opt As IRedditView)
InitializeComponent()
MyOptions = opt
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
Private Sub ChannelSettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try
Dim n$ = String.Empty
If TypeOf MyOptions Is Channel Then
n = $"Channel [{DirectCast(MyOptions, Channel).Name}]"
ElseIf TypeOf MyOptions Is Base.IUserData Then
n = $"User [{DirectCast(MyOptions, Base.IUserData).Name}]"
End If
If Not n.IsEmptyString Then Text = n
With MyDefs
.MyViewInitialize(True)
.AddOkCancelToolbar()
Select Case MyOptions.ViewMode
Case CView.Hot : OPT_VIEW_MODE_HOT.Checked = True
Case CView.Top : OPT_VIEW_MODE_TOP.Checked = True
Case Else : OPT_VIEW_MODE_NEW.Checked = True
End Select
Select Case MyOptions.ViewPeriod
Case CPeriod.Hour : OPT_PERIOD_HOUR.Checked = True
Case CPeriod.Day : OPT_PERIOD_DAY.Checked = True
Case CPeriod.Week : OPT_PERIOD_WEEK.Checked = True
Case CPeriod.Month : OPT_PERIOD_MONTH.Checked = True
Case CPeriod.Year : OPT_PERIOD_YEAR.Checked = True
Case Else : OPT_PERIOD_ALL.Checked = True
End Select
ChangePeriodEnabled()
.EndLoaderOperations()
End With
Catch ex As Exception
MyDefs.InvokeLoaderError(ex)
End Try
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With MyOptions
Select Case True
Case OPT_VIEW_MODE_HOT.Checked : .ViewMode = CView.Hot
Case OPT_VIEW_MODE_TOP.Checked : .ViewMode = CView.Top
Case Else : .ViewMode = CView.New
End Select
Select Case True
Case OPT_PERIOD_HOUR.Checked : .ViewPeriod = CPeriod.Hour
Case OPT_PERIOD_DAY.Checked : .ViewPeriod = CPeriod.Day
Case OPT_PERIOD_WEEK.Checked : .ViewPeriod = CPeriod.Week
Case OPT_PERIOD_MONTH.Checked : .ViewPeriod = CPeriod.Month
Case OPT_PERIOD_YEAR.Checked : .ViewPeriod = CPeriod.Year
Case Else : .ViewPeriod = CPeriod.All
End Select
End With
MyDefs.CloseForm()
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
End Sub
End Class
End Namespace

View File

@@ -9,12 +9,12 @@
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.Tools.WEB
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> <Manifest(RedditSiteKey), UseClassAsIs, 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
@@ -28,21 +28,16 @@ Namespace API.Reddit
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
Friend Overrides ReadOnly Property Responser As WEB.Response <PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos"), PXML>
Friend ReadOnly Property UseM3U8 As PropertyValue
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)
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 = "redgifs"
@@ -53,7 +48,10 @@ Namespace API.Reddit
Case Download.Channel : Return New UserData With {.SaveToCache = False, .SkipExistsUsers = False, .AutoGetLimits = True} Case Download.Channel : Return New UserData With {.SaveToCache = False, .SkipExistsUsers = False, .AutoGetLimits = True}
Case Download.SavedPosts Case Download.SavedPosts
Dim u As New UserData With {.IsSavedPosts = True} Dim u As New UserData With {.IsSavedPosts = True}
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))} DirectCast(u, UserDataBase).User = New UserInfo With {
.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty)),
.IsChannel = True
}
Return u Return u
End Select End Select
Return Nothing Return Nothing
@@ -72,17 +70,21 @@ Namespace API.Reddit
Next Next
Return Nothing Return Nothing
End Function End Function
Friend Overrides Function Available(ByVal What As Download) As Boolean Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
Try Try
Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("reddit") Dim dl As List(Of DownDetector.Data) = DownDetector.GetData("reddit")
If dl.ListExists Then If dl.ListExists Then
dl = dl.Take(4).ToList dl = dl.Take(4).ToList
Dim avg% = dl.Average(Function(d) d.Value) Dim avg% = dl.Average(Function(d) d.Value)
If avg > 100 Then If avg > 100 Then
Return MsgBoxE({"Over the past hour, Reddit has received an average of " & If Silent Then
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr & Return False
dl.ListToString(, vbCr) & vbCr & vbCr & Else
"Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes Return MsgBoxE({"Over the past hour, Reddit has received an average of " &
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
dl.ListToString(vbCr) & vbCr & vbCr &
"Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes
End If
End If End If
End If End If
Return True Return True
@@ -93,5 +95,14 @@ Namespace API.Reddit
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia) Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return UserData.GetVideoInfo(URL, Responser) Return UserData.GetVideoInfo(URL, Responser)
End Function End Function
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 OpenForm Then
Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using
End If
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

@@ -14,10 +14,13 @@ Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports System.Net Imports System.Net
Imports System.Threading Imports System.Threading
Imports SCrawler.API.Base 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 CPeriod = SCrawler.API.Reddit.IRedditView.Period
Namespace API.Reddit Namespace API.Reddit
Friend Class UserData : Inherits UserDataBase : Implements IChannelData Friend Class UserData : Inherits UserDataBase : Implements IChannelData, IRedditView
Private ReadOnly Property MySiteSettings As SiteSettings Private ReadOnly Property MySiteSettings As SiteSettings
Get Get
Return DirectCast(HOST.Source, SiteSettings) Return DirectCast(HOST.Source, SiteSettings)
@@ -28,6 +31,11 @@ Namespace API.Reddit
Return If(IsChannel, DateProviderChannel, DateProvider) Return If(IsChannel, DateProviderChannel, DateProvider)
End Get End Get
End Property End Property
Private ReadOnly Property UseM3U8 As Boolean
Get
Return Settings.UseM3U8 And CBool(DirectCast(HOST.Source, SiteSettings).UseM3U8.Value)
End Get
End Property
#Region "Channels Support" #Region "Channels Support"
#Region "IChannelLimits Support" #Region "IChannelLimits Support"
Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount Friend Property DownloadLimitCount As Integer? Implements IChannelLimits.DownloadLimitCount
@@ -50,7 +58,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
@@ -60,6 +68,41 @@ Namespace API.Reddit
Select c.Post) Else Return Nothing Select c.Post) Else Return Nothing
End Function End Function
#End Region #End Region
#Region "IRedditView Support"
Friend Property ViewMode As CView Implements IRedditView.ViewMode
Friend Property ViewPeriod As CPeriod Implements IRedditView.ViewPeriod
Friend Sub SetView(ByVal Options As IRedditView) Implements IRedditView.SetView
If Not Options Is Nothing Then
ViewMode = Options.ViewMode
ViewPeriod = Options.ViewPeriod
End If
End Sub
Private ReadOnly Property View As String
Get
Select Case ViewMode
Case CView.Hot : Return "hot"
Case CView.Top : Return "top"
Case Else : Return "new"
End Select
End Get
End Property
Private ReadOnly Property Period As String
Get
If ViewMode = CView.Top Then
Select Case ViewPeriod
Case CPeriod.Hour : Return "hour"
Case CPeriod.Day : Return "day"
Case CPeriod.Week : Return "week"
Case CPeriod.Month : Return "month"
Case CPeriod.Year : Return "year"
Case Else : Return "all"
End Select
Else
Return "all"
End If
End Get
End Property
#End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
ChannelPostsNames = New List(Of String) ChannelPostsNames = New List(Of String)
@@ -69,6 +112,21 @@ Namespace API.Reddit
#End Region #End Region
#Region "Load and Update user info" #Region "Load and Update user info"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
If Loading Then
ViewMode = .Value(Name_ViewMode).FromXML(Of Integer)(CInt(CView.New))
ViewPeriod = .Value(Name_ViewPeriod).FromXML(Of Integer)(CInt(CPeriod.All))
Else
.Add(Name_ViewMode, CInt(ViewMode))
.Add(Name_ViewPeriod, CInt(ViewPeriod))
End If
End With
End Sub
Friend Overrides Function ExchangeOptionsGet() As Object
Return New RedditViewExchange With {.ViewMode = ViewMode, .ViewPeriod = ViewPeriod}
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is IRedditView Then SetView(DirectCast(Obj, IRedditView))
End Sub End Sub
#End Region #End Region
#Region "Download Overrides" #Region "Download Overrides"
@@ -80,6 +138,7 @@ Namespace API.Reddit
Responser = New Response Responser = New Response
Responser.Copy(MySiteSettings.Responser) Responser.Copy(MySiteSettings.Responser)
ChannelPostsNames.ListAddList(ChannelInfo.PostsAll.Select(Function(p) p.ID), LNC) ChannelPostsNames.ListAddList(ChannelInfo.PostsAll.Select(Function(p) p.ID), LNC)
If Not ViewMode = CView.New Then ChannelPostsNames.ListAddList(ChannelInfo.PostsNames, LNC)
If SkipExistsUsers Then _ExistsUsersNames.ListAddList(Settings.UsersList.Select(Function(p) p.Name), LNC) If SkipExistsUsers Then _ExistsUsersNames.ListAddList(Settings.UsersList.Select(Function(p) p.Name), LNC)
DownloadDataF(Token) DownloadDataF(Token)
ReparseVideo(Token) ReparseVideo(Token)
@@ -91,6 +150,7 @@ Namespace API.Reddit
End Sub End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TotalPostsDownloaded = 0 _TotalPostsDownloaded = 0
'If Not IsSavedPosts AndAlso (Not IsChannel OrElse ChannelInfo Is Nothing) Then ReparseMissing(Token)
If IsSavedPosts Then If IsSavedPosts Then
DownloadDataChannel(String.Empty, Token) DownloadDataChannel(String.Empty, Token)
ElseIf IsChannel Then ElseIf IsChannel Then
@@ -133,7 +193,7 @@ Namespace API.Reddit
Dim UPicType As Func(Of String, UTypes) = Function(input) IIf(input = "image", UTypes.Picture, UTypes.GIF) Dim UPicType As Func(Of String, UTypes) = Function(input) IIf(input = "image", UTypes.Picture, UTypes.GIF)
Dim _PostID As Func(Of String) = Function() IIf(PostTmp.IsEmptyString, PostID, PostTmp) Dim _PostID As Func(Of String) = Function() IIf(PostTmp.IsEmptyString, PostID, PostTmp)
URL = $"https://gateway.reddit.com/desktopapi/v1/user/{Name}/posts?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort=new&t=all&layout=classic" URL = $"https://gateway.reddit.com/desktopapi/v1/user/{Name}/posts?rtj=only&allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
ThrowAny(Token) ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException) Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -188,9 +248,12 @@ Namespace API.Reddit
added = False added = False
End If End If
Case "video" Case "video"
If Settings.UseM3U8 AndAlso s("hlsUrl").XmlIfNothingValue("/").ToLower.Contains("m3u8") Then If UseM3U8 AndAlso s("hlsUrl").XmlIfNothingValue("/").ToLower.Contains("m3u8") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, s.Value("hlsUrl"), _TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, s.Value("hlsUrl"),
_PostID(), PostDate,, IsChannel), LNC) _PostID(), PostDate,, IsChannel), LNC)
ElseIf Not UseM3U8 AndAlso s("fallback_url").XmlIfNothingValue("/").ToLower.Contains("mp4") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, s.Value("fallback_url"),
_PostID(), PostDate,, IsChannel), LNC)
Else Else
added = False added = False
End If End If
@@ -241,7 +304,7 @@ Namespace API.Reddit
If IsSavedPosts Then If IsSavedPosts Then
URL = $"https://www.reddit.com/user/{Name}/saved.json?after={POST}" URL = $"https://www.reddit.com/user/{Name}/saved.json?after={POST}"
Else Else
URL = $"https://reddit.com/r/{Name}/new.json?allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort=new&t=all&layout=classic" URL = $"https://reddit.com/r/{Name}/{View}.json?allow_quarantined=true&allow_over18=1&include=identity&after={POST}&dist=25&sort={View}&t={Period}&layout=classic"
End If End If
ThrowAny(Token) ThrowAny(Token)
@@ -258,10 +321,13 @@ Namespace API.Reddit
PostID = s.Value("name") PostID = s.Value("name")
If PostID.IsEmptyString AndAlso s.Contains("id") Then PostID = s("id").Value If PostID.IsEmptyString AndAlso s.Contains("id") Then PostID = s("id").Value
If ChannelPostsNames.Contains(PostID) Then ExistsDetected = True : Continue For 'Exit Sub If ChannelPostsNames.Contains(PostID) Then
If ViewMode = CView.New Then ExistsDetected = True Else NewPostDetected = True 'bypass
Continue For 'Exit Sub
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
If DownloadLimitDate.HasValue AndAlso _TempMediaList.Count > 0 Then If ViewMode = CView.New AndAlso DownloadLimitDate.HasValue AndAlso _TempMediaList.Count > 0 Then
With (From __u In _TempMediaList Where __u.Post.Date.HasValue Select __u.Post.Date.Value) With (From __u In _TempMediaList Where __u.Post.Date.HasValue Select __u.Post.Date.Value)
If .Count > 0 Then lDate = .Min Else lDate = Nothing If .Count > 0 Then lDate = .Min Else lDate = Nothing
End With End With
@@ -283,7 +349,7 @@ Namespace API.Reddit
If s.Contains("created") Then PostDate = s("created").Value Else PostDate = String.Empty If s.Contains("created") Then PostDate = s("created").Value Else PostDate = String.Empty
_UserID = s.Value("author") _UserID = s.Value("author")
If SkipExistsUsers AndAlso _ExistsUsersNames.Count > 0 AndAlso If Not IsSavedPosts AndAlso SkipExistsUsers AndAlso _ExistsUsersNames.Count > 0 AndAlso
Not _UserID.IsEmptyString AndAlso _ExistsUsersNames.Contains(_UserID) Then Not _UserID.IsEmptyString AndAlso _ExistsUsersNames.Contains(_UserID) Then
If Not IsSavedPosts AndAlso Not ChannelInfo Is Nothing Then _ If Not IsSavedPosts AndAlso Not ChannelInfo Is Nothing Then _
ChannelInfo.ChannelExistentUserNames.ListAddValue(_UserID, LNC) ChannelInfo.ChannelExistentUserNames.ListAddValue(_UserID, LNC)
@@ -291,7 +357,7 @@ Namespace API.Reddit
End If End If
tmpUrl = s.Value("url") tmpUrl = s.Value("url")
If Not tmpUrl.IsEmptyString AndAlso tmpUrl.Contains("redgifs.com") Then If Not tmpUrl.IsEmptyString AndAlso tmpUrl.StringContains({"redgifs.com", "gfycat.com"}) Then
If SaveToCache Then If SaveToCache Then
tmpUrl = s.Value({"media", "oembed"}, "thumbnail_url") tmpUrl = s.Value({"media", "oembed"}, "thumbnail_url")
If Not tmpUrl.IsEmptyString Then If Not tmpUrl.IsEmptyString Then
@@ -310,8 +376,12 @@ Namespace API.Reddit
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC) _TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1 _TotalPostsDownloaded += 1
End If End If
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"),
PostID, PostDate, _UserID, IsChannel), LNC)
Else Else
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre + UTypes.m3u8, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC) '_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre + UTypes.m3u8, 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
ElseIf CreateImgurMedia(tmpUrl, PostID, PostDate, _UserID, IsChannel) Then ElseIf CreateImgurMedia(tmpUrl, PostID, PostDate, _UserID, IsChannel) Then
@@ -366,6 +436,8 @@ Namespace API.Reddit
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, _URL.Replace(".gifv", ".mp4"), _TempMediaList.ListAddValue(MediaFromData(UTypes.Video, _URL.Replace(".gifv", ".mp4"),
PostID, PostDate, _UserID, IsChannel), LNC) PostID, PostDate, _UserID, IsChannel), LNC)
End If End If
ElseIf _URL.Contains(".mp4") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
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
@@ -436,6 +508,72 @@ Namespace API.Reddit
ProcessException(ex, Token, "video reparsing error", False) ProcessException(ex, Token, "video reparsing error", False)
End Try End Try
End Sub End Sub
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
If _ContentList.Exists(MissingFinder) Then
Dim m As UserMedia
Dim j As EContainer, ss As EContainer
Dim r$, tmpUrl$, PostDate$, _UserID$
Dim err As New ErrorsDescriber(EDP.ReturnValue)
Dim node As Object() = {"data", "children", 0, "data"}
Dim eCount As Predicate(Of EContainer) = Function(e) e.Count > 0
Dim cItems As Predicate(Of EContainer) = Function(e) If(e.ItemF(node)?.Count, 0) > 0
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
r = Responser.GetResponse($"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json",, err)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, err)
If Not j Is Nothing Then
If j.Contains(cItems) Then
With j.ItemF({cItems}).ItemF(node)
If .Contains("created") Then PostDate = .Item("created").Value Else PostDate = String.Empty
_UserID = .Value("author")
tmpUrl = .Value("url")
If Not tmpUrl.IsEmptyString AndAlso tmpUrl.StringContains({"redgifs.com", "gfycat.com"}) Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, m.Post.ID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
ElseIf Not .Value({"media", "reddit_video"}, "fallback_url").IsEmptyString Then
tmpUrl = .Value({"media", "reddit_video"}, "fallback_url")
If UseM3U8 AndAlso Not .Value({"media", "reddit_video"}, "hls_url").IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, .Value({"media", "reddit_video"}, "hls_url"),
m.Post.ID, PostDate, _UserID, IsChannel), LNC)
Else
'_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre + UTypes.m3u8, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, tmpUrl, m.Post.ID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
ElseIf CreateImgurMedia(tmpUrl, m.Post.ID, PostDate, _UserID, IsChannel) Then
_TotalPostsDownloaded += 1
ElseIf If(.Item("media_metadata")?.Count, 0) > 0 Then
DownloadGallery(.Self, m.Post.ID, PostDate, _UserID, SaveToCache)
_TotalPostsDownloaded += 1
ElseIf .Contains("preview") Then
ss = .ItemF({"preview", "images", eCount, "source", "url"}).XmlIfNothing
If Not ss.Value.IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, ss.Value, m.Post.ID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
End If
End With
End If
j.Dispose()
End If
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "missing data downloading error")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try
End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response) As IEnumerable(Of UserMedia) Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response) As IEnumerable(Of UserMedia)
Try Try
If Not URL.IsEmptyString AndAlso URL.Contains("redgifs") Then If Not URL.IsEmptyString AndAlso URL.Contains("redgifs") Then
@@ -490,6 +628,8 @@ Namespace API.Reddit
_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 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
@@ -558,7 +698,7 @@ Namespace API.Reddit
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 SFileShares.SFileExists($"{MyDir}\Video\", 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)
@@ -580,6 +720,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
@@ -593,6 +734,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
@@ -623,7 +765,7 @@ 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 And Not IsImgurStuff And MissingErrorsAdd Then ErrorDownloading(f, v.URL)
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
@@ -643,6 +785,7 @@ Namespace API.Reddit
End Using End Using
End If End If
End If End If
Catch iex As IndexOutOfRangeException When Disposed
Catch oex As OperationCanceledException When Token.IsCancellationRequested Catch oex As OperationCanceledException When Token.IsCancellationRequested
Catch dex As ObjectDisposedException When Disposed Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception Catch ex As Exception
@@ -656,9 +799,10 @@ Namespace API.Reddit
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden Then ElseIf Responser.StatusCode = HttpStatusCode.Forbidden Then
UserSuspended = True UserSuspended = True
ElseIf Responser.StatusCode = HttpStatusCode.BadGateway Or ElseIf Responser.StatusCode = HttpStatusCode.BadGateway Or
Responser.StatusCode = HttpStatusCode.ServiceUnavailable Or Responser.StatusCode = HttpStatusCode.ServiceUnavailable Then
Responser.StatusCode = HttpStatusCode.GatewayTimeout Then MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})"
MyMainLOG = "Reddit is currently unavailable" ElseIf Responser.StatusCode = HttpStatusCode.GatewayTimeout Then
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

View File

@@ -9,15 +9,6 @@
Namespace API.RedGifs Namespace API.RedGifs
Friend Module Declarations Friend Module Declarations
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 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, 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

@@ -13,6 +13,16 @@ Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.RedGifs Namespace API.RedGifs
<Manifest("AndyProgram_RedGifs"), UseClassAsIs> <Manifest("AndyProgram_RedGifs"), UseClassAsIs>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.RedGifsIcon
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.RedGifsPic32
End Get
End Property
Friend Sub New() Friend Sub New()
MyBase.New(RedGifsSite, "redgifs.com") MyBase.New(RedGifsSite, "redgifs.com")
UrlPatternUser = "https://www.redgifs.com/users/{0}/" UrlPatternUser = "https://www.redgifs.com/users/{0}/"
@@ -25,5 +35,11 @@ Namespace API.RedGifs
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia) Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return Reddit.UserData.GetVideoInfo(URL, Nothing) Return Reddit.UserData.GetVideoInfo(URL, Nothing)
End Function 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 Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return False
End Function
End Class End Class
End Namespace End Namespace

View File

@@ -9,10 +9,11 @@
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.Threading
Imports System.Net Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base 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 Sub New()
@@ -20,6 +21,7 @@ Namespace API.RedGifs
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
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
ReparseMissing(Token)
DownloadData(1, Token) DownloadData(1, Token)
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)
@@ -29,8 +31,6 @@ Namespace API.RedGifs
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException) Dim r$ = Responser.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
@@ -40,21 +40,7 @@ Namespace API.RedGifs
If Not CheckDatesLimit(postDate, DateProvider) Then Exit Sub If Not CheckDatesLimit(postDate, DateProvider) Then Exit Sub
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
@@ -64,16 +50,84 @@ Namespace API.RedGifs
ProcessException(ex, Token, $"data downloading error [{URL}]") ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try End Try
End Sub End Sub
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken) 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)
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
If Not ut = UTypes.Undefined Then _TempMediaList.ListAddValue(MediaFromData(ut, u, PostID, PostDateStr, PostDateDate, State))
End If
End If
End With
End Sub
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 = $"https://api.redgifs.com/v2/gifs/{u.Post.ID}?views=yes&users=yes"
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")
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 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
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String) As UserMedia 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)) : m.URL_BASE = m.URL
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 Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer

View File

@@ -6,13 +6,13 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports SCrawler.API.Base
Namespace API.Twitter Namespace API.Twitter
<Manifest("AndyProgram_Twitter"), UseClassAsIs> <Manifest("AndyProgram_Twitter"), SavedPosts, UseClassAsIs>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Const Header_Authorization As String = "authorization" Friend Const Header_Authorization As String = "authorization"
Friend Const Header_Token As String = "x-csrf-token" Friend Const Header_Token As String = "x-csrf-token"
@@ -31,16 +31,19 @@ Namespace API.Twitter
Private ReadOnly Property Auth As PropertyValue Private ReadOnly Property Auth As PropertyValue
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Set token from [x-csrf-token] response header")> <PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Set token from [x-csrf-token] response header")>
Private ReadOnly Property Token As PropertyValue Private ReadOnly Property Token As PropertyValue
Friend Overrides ReadOnly Property Responser As WEB.Response <PropertyOption(ControlText:="Saved posts user name", ControlToolTip:="Personal profile username", LeftOffset:=120), PXML>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend Overrides ReadOnly Property Responser As Response
Friend Sub New() Friend Sub New()
MyBase.New(TwitterSite) MyBase.New(TwitterSite)
Responser = New WEB.Response($"{SettingsFolderName}\Responser_{Site}.xml") Responser = New Response($"{SettingsFolderName}\Responser_{Site}.xml")
Dim a$ = String.Empty Dim a$ = String.Empty
Dim t$ = String.Empty Dim t$ = String.Empty
With Responser With Responser
If .File.Exists Then If .File.Exists Then
If EncryptCookies.CookiesEncrypted Then .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.LoadSettings() .LoadSettings()
With .Headers With .Headers
If .ContainsKey(Header_Authorization) Then a = .Item(Header_Authorization) If .ContainsKey(Header_Authorization) Then a = .Item(Header_Authorization)
@@ -50,11 +53,11 @@ Namespace API.Twitter
.ContentType = "application/json" .ContentType = "application/json"
.Accept = "*/*" .Accept = "*/*"
.CookiesDomain = "twitter.com" .CookiesDomain = "twitter.com"
.Cookies = New CookieKeeper(.CookiesDomain) With {.EncryptKey = SettingsCLS.CookieEncryptKey}
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.Decoders.Add(SymbolsConverter.Converters.Unicode) .Decoders.Add(SymbolsConverter.Converters.Unicode)
With .Headers With .Headers
.Add("sec-ch-ua", " Not;A Brand" & Chr(34) & ";v=" & Chr(34) & "99" & Chr(34) & ", " & Chr(34) & .Add("sec-ch-ua", " Not;A Brand"";v=""99"", ""Google Chrome"";v=""91"", ""Chromium"";v=""91""")
"Google Chrome" & Chr(34) & ";v=" & Chr(34) & "91" & Chr(34) & ", " & Chr(34) & "Chromium" &
Chr(34) & ";v=" & Chr(34) & "91" & Chr(34))
.Add("sec-ch-ua-mobile", "?0") .Add("sec-ch-ua-mobile", "?0")
.Add("sec-fetch-dest", "empty") .Add("sec-fetch-dest", "empty")
.Add("sec-fetch-mode", "cors") .Add("sec-fetch-mode", "cors")
@@ -70,6 +73,7 @@ Namespace API.Twitter
Auth = New PropertyValue(a, GetType(String), Sub(v) ChangeResponserFields(NameOf(Auth), v)) Auth = New PropertyValue(a, GetType(String), Sub(v) ChangeResponserFields(NameOf(Auth), v))
Token = New PropertyValue(t, GetType(String), Sub(v) ChangeResponserFields(NameOf(Token), v)) Token = New PropertyValue(t, GetType(String), Sub(v) ChangeResponserFields(NameOf(Token), v))
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
UserRegex = RParams.DMS("[htps:/]{7,8}.*?twitter.com/([^/]+)", 1) UserRegex = RParams.DMS("[htps:/]{7,8}.*?twitter.com/([^/]+)", 1)
UrlPatternUser = "https://twitter.com/{0}" UrlPatternUser = "https://twitter.com/{0}"
@@ -90,10 +94,17 @@ Namespace API.Twitter
End If End If
End Sub End Sub
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 If What = ISiteSettings.Download.SavedPosts Then
Return New UserData With {.IsSavedPosts = True, .User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}}
Else
Return New UserData
End If
End Function End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia) Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return UserData.GetVideoInfo(URL, Responser) Return UserData.GetVideoInfo(URL, Responser)
End Function End Function
Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
Return $"https://twitter.com/{UserID}/status/{PostID}"
End Function
End Class End Class
End Namespace End Namespace

View File

@@ -13,6 +13,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
Imports System.Net Imports System.Net
Imports System.Threading Imports System.Threading
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Twitter Namespace API.Twitter
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
#Region "Declarations" #Region "Declarations"
@@ -27,39 +28,60 @@ Namespace API.Twitter
End Sub End Sub
#Region "Download functions" #Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly) If IsSavedPosts Then
DownloadData(String.Empty, Token) If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.Post.ID), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData(String.Empty, Token)
Else
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData(String.Empty, Token)
'ReparseMissing(Token)
End If
End Sub End Sub
Private Overloads Sub DownloadData(ByVal POST As String, ByVal Token As CancellationToken) Private Overloads Sub DownloadData(ByVal POST As String, ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
Dim NextCursor$ = String.Empty
Dim __NextCursor As Predicate(Of EContainer) = Function(e) e.Value({"content", "operation", "cursor"}, "cursorType") = "Bottom"
Dim PostID$ = String.Empty Dim PostID$ = String.Empty
Dim PostDate$, dName$ Dim PostDate$ ', dName$
Dim m As EContainer, nn As EContainer, s As EContainer Dim nn As EContainer, s As EContainer ', m As EContainer
Dim NewPostDetected As Boolean = False Dim NewPostDetected As Boolean = False
Dim ExistsDetected As Boolean = False Dim ExistsDetected As Boolean = False
Dim PicNode As Predicate(Of EContainer) = Function(e) e.Count > 0 AndAlso e.Contains("media_url") Dim PicNode As Predicate(Of EContainer) = Function(e) e.Count > 0 AndAlso e.Contains("media_url")
Dim UID As Func(Of EContainer, String) = Function(e) e.XmlIfNothing.Item({"user", "id"}).XmlIfNothingValue Dim UID As Func(Of EContainer, String) = Function(e) e.XmlIfNothing.Item({"user", "id"}).XmlIfNothingValue
URL = $"https://api.twitter.com/1.1/statuses/user_timeline.json?screen_name={Name}&count=200&exclude_replies=false&include_rts=1&tweet_mode=extended" If IsSavedPosts Then
If Not POST.IsEmptyString Then URL &= $"&max_id={POST}" If Name.IsEmptyString Then Throw New ArgumentNullException With {.HelpLink = 1}
URL = $"https://api.twitter.com/2/timeline/bookmark.json?screen_name={Name}&count=200" &
"&tweet_mode=extended&include_entities=true&include_user_entities=true&include_ext_media_availability=true"
If Not POST.IsEmptyString Then URL &= $"&cursor={SymbolsConverter.ASCII.EncodeSymbolsOnly(POST)}"
Else
URL = $"https://api.twitter.com/1.1/statuses/user_timeline.json?screen_name={Name}&count=200&exclude_replies=false&include_rts=1&tweet_mode=extended"
If Not POST.IsEmptyString Then URL &= $"&max_id={POST}"
End If
ThrowAny(Token) ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException) Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r) Using w As EContainer = JsonDocument.Parse(r)
If Not w Is Nothing AndAlso w.Count > 0 Then If w.ListExists Then
For Each nn In w For Each nn In If(IsSavedPosts, w({"globalObjects", "tweets"}).XmlIfNothing, w)
ThrowAny(Token) ThrowAny(Token)
If nn.Count > 0 Then If nn.Count > 0 Then
PostID = nn.Value("id") If IsSavedPosts Then
If ID.IsEmptyString Then PostID = nn.Value
ID = UID(nn) If PostID.IsEmptyString Then PostID = nn.Value("id_str")
If Not ID.IsEmptyString Then UpdateUserInformation() Else
PostID = nn.Value("id")
If ID.IsEmptyString Then
ID = UID(nn)
If Not ID.IsEmptyString Then UpdateUserInformation()
End If
End If End If
If UserDescriptionNeedToUpdate() AndAlso nn.Value({"user"}, "screen_name") = Name Then UserDescriptionUpdate(nn.Value({"user"}, "description")) If Not IsSavedPosts AndAlso UserDescriptionNeedToUpdate() AndAlso nn.Value({"user"}, "screen_name") = Name Then _
UserDescriptionUpdate(nn.Value({"user"}, "description"))
'Date Pattern: 'Date Pattern:
'Sat Jan 01 01:10:15 +0000 2000 'Sat Jan 01 01:10:15 +0000 2000
@@ -74,34 +96,102 @@ Namespace API.Twitter
Continue For Continue For
End If End If
If Not ParseUserMediaOnly OrElse (Not nn.Contains("retweeted_status") OrElse If IsSavedPosts OrElse Not ParseUserMediaOnly OrElse (Not nn.Contains("retweeted_status") OrElse
(Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then (Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then
If Not CheckVideoNode(nn, PostID, PostDate) Then 'If Not CheckVideoNode(nn, PostID, PostDate) Then
s = nn.ItemF({"extended_entities", "media"}) ' s = nn.ItemF({"extended_entities", "media"})
If s Is Nothing OrElse s.Count = 0 Then s = nn.ItemF({"retweeted_status", "extended_entities", "media"}) ' If s Is Nothing OrElse s.Count = 0 Then s = nn.ItemF({"retweeted_status", "extended_entities", "media"})
If Not s Is Nothing AndAlso s.Count > 0 Then ' If Not s Is Nothing AndAlso s.Count > 0 Then
For Each m In s ' For Each m In s
If m.Count > 0 AndAlso m.Contains("media_url") Then ' If m.Count > 0 AndAlso m.Contains("media_url") Then
dName = UrlFile(m("media_url").Value) ' dName = UrlFile(m("media_url").Value)
If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then ' If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then
_DataNames.Add(dName) ' _DataNames.Add(dName)
_TempMediaList.ListAddValue(MediaFromData(m("media_url").Value, ' _TempMediaList.ListAddValue(MediaFromData(m("media_url").Value,
PostID, PostDate, GetPictureOption(m)), LNC) ' PostID, PostDate, GetPictureOption(m)), LNC)
End If ' End If
End If ' End If
Next ' Next
End If ' End If
End If 'End If
ObtainMedia(nn, PostID, PostDate)
End If End If
End If End If
Next Next
If IsSavedPosts Then
s = w.ItemF({"timeline", "instructions", 0, "addEntries", "entries"}).XmlIfNothing
If s.Count > 0 Then NextCursor = If(s.ItemF({__NextCursor})?.Value({"content", "operation", "cursor"}, "value"), String.Empty)
End If
End If End If
End Using End Using
If POST.IsEmptyString And ExistsDetected Then Exit Sub
If Not PostID.IsEmptyString And NewPostDetected Then DownloadData(PostID, Token) If IsSavedPosts Then
If Not NextCursor.IsEmptyString And Not NextCursor = POST Then DownloadData(NextCursor, Token)
Else
If POST.IsEmptyString And ExistsDetected Then Exit Sub
If Not PostID.IsEmptyString And NewPostDetected Then DownloadData(PostID, Token)
End If
End If
Catch ane As ArgumentNullException When ane.HelpLink = 1
MyMainLOG = "Username not set for saved Twitter posts"
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error{IIf(IsSavedPosts, " (Saved Posts)", String.Empty)} [{URL}]")
End Try
End Sub
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown)
If Not CheckVideoNode(e, PostID, PostDate) Then
Dim s As EContainer = e.ItemF({"extended_entities", "media"})
If s Is Nothing OrElse s.Count = 0 Then s = e.ItemF({"retweeted_status", "extended_entities", "media"})
If If(s?.Count, 0) > 0 Then
For Each m In s
If m.Contains("media_url") Then
Dim dName$ = UrlFile(m("media_url").Value)
If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then
_DataNames.Add(dName)
_TempMediaList.ListAddValue(MediaFromData(m("media_url").Value,
PostID, PostDate, GetPictureOption(m), State), LNC)
End If
End If
Next
End If
End If
End Sub
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
Try
If ContentMissingExists Then
Dim m As UserMedia
Dim r$, PostDate$
Dim j As EContainer
For i% = 0 To _ContentList.Count - 1
If _ContentList(i).State = UStates.Missing Then
m = _ContentList(i)
If Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
URL = $"https://api.twitter.com/1.1/statuses/show.json?id={m.Post.ID}"
r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
PostDate = String.Empty
If j.Contains("created_at") Then PostDate = j("created_at").Value Else PostDate = String.Empty
ObtainMedia(j, m.Post.ID, PostDate, UStates.Missing)
rList.Add(i)
End If
End If
End If
End If
Next
End If End If
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]") ProcessException(ex, Token, $"ReparseMissing error [{URL}]")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(i) : Next
rList.Clear()
End If
End Try End Try
End Sub End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response) As IEnumerable(Of UserMedia) Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response) As IEnumerable(Of UserMedia)
@@ -109,8 +199,7 @@ Namespace API.Twitter
If URL.Contains("twitter") Then If URL.Contains("twitter") Then
Dim PostID$ = RegexReplace(URL, RParams.DM("(?<=/)\d+", 0)) Dim PostID$ = RegexReplace(URL, RParams.DM("(?<=/)\d+", 0))
If Not PostID.IsEmptyString Then If Not PostID.IsEmptyString Then
Dim r$ = DirectCast(resp.Copy(), Response). Dim r$ = DirectCast(resp.Copy(), Response).GetResponse($"https://api.twitter.com/1.1/statuses/show.json?id={PostID}",, EDP.ReturnValue)
GetResponse($"https://api.twitter.com/1.1/statuses/show.json?id={PostID}",, EDP.ReturnValue)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r) Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then If j.ListExists Then
@@ -128,20 +217,34 @@ Namespace API.Twitter
End Function End Function
#Region "Picture options" #Region "Picture options"
Private Function GetPictureOption(ByVal w As EContainer) As String Private Function GetPictureOption(ByVal w As EContainer) As String
Const P4K As String = "4096x4096"
Try Try
Dim ww As EContainer = w("sizes") Dim ww As EContainer = w("sizes")
If Not ww Is Nothing AndAlso ww.Count > 0 Then If ww.ListExists Then
Dim l As New List(Of Sizes) Dim l As New List(Of Sizes)
Dim Orig As Sizes? = New Sizes(w.Value({"original_info"}, "height").FromXML(Of Integer)(-1), P4K)
If Orig.Value.Value = -1 Then Orig = Nothing
Dim LargeContained As Boolean = ww.Contains("large") Dim LargeContained As Boolean = ww.Contains("large")
For Each v As EContainer In ww For Each v As EContainer In ww
If v.Count > 0 AndAlso v.Contains("h") Then l.Add(New Sizes(v.Value("h"), v.Name)) If v.Count > 0 AndAlso v.Contains("h") Then l.Add(New Sizes(v.Value("h"), v.Name))
Next Next
If l.Count > 0 Then If l.Count > 0 Then
l.Sort() l.Sort()
If l(0).Data.IsEmptyString And LargeContained Then Return "large" Else Return l(0).Data If Orig.HasValue AndAlso l(0).Value < Orig.Value.Value Then
Return P4K
ElseIf l(0).Data.IsEmptyString Then
Return P4K
Else
Return l(0).Data
End If
Else
Return P4K
End If End If
ElseIf Not w.Value({"original_info"}, "height").IsEmptyString Then
Return P4K
Else
Return String.Empty
End If End If
Return String.Empty
Catch ex As Exception Catch ex As Exception
LogError(ex, "[API.Twitter.UserData.GetPictureOption]") LogError(ex, "[API.Twitter.UserData.GetPictureOption]")
Return String.Empty Return String.Empty
@@ -151,6 +254,7 @@ Namespace API.Twitter
#Region "Video options" #Region "Video options"
Private Function CheckVideoNode(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String) As Boolean Private Function CheckVideoNode(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String) As Boolean
Try Try
If CheckForGif(w, PostID, PostDate) Then Return True
Dim URL$ = GetVideoNodeURL(w) Dim URL$ = GetVideoNodeURL(w)
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
Dim f$ = UrlFile(URL) Dim f$ = UrlFile(URL)
@@ -166,9 +270,44 @@ Namespace API.Twitter
Return False Return False
End Try End Try
End Function End Function
Private Function CheckForGif(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String) As Boolean
Try
Dim gifUrl As Predicate(Of EContainer) = Function(e) Not e.Value("content_type").IsEmptyString AndAlso
e.Value("content_type").Contains("mp4") AndAlso
Not e.Value("url").IsEmptyString
Dim url$, ff$
Dim f As SFile
Dim m As UserMedia
With w({"extended_entities", "media"})
If .ListExists Then
For Each n As EContainer In .Self
If n.Value("type") = "animated_gif" Then
With n({"video_info", "variants"}).XmlIfNothing.ItemF({gifUrl}).XmlIfNothing
url = .Value("url")
ff = UrlFile(url)
If Not ff.IsEmptyString Then
If Not _DataNames.Contains(ff) Then
m = MediaFromData(url, PostID, PostDate)
f = m.File
If Not f.IsEmptyString Then f.Name = $"GIF_{f.Name}" : m.File = f
_TempMediaList.ListAddValue(m, LNC)
End If
Return True
End If
End With
End If
Next
End If
End With
Return False
Catch ex As Exception
LogError(ex, "[API.Twitter.UserData.CheckForGif]")
Return False
End Try
End Function
Private Shared Function GetVideoNodeURL(ByVal w As EContainer) As String Private Shared Function GetVideoNodeURL(ByVal w As EContainer) As String
Dim v As EContainer = w.GetNode(VideoNode) Dim v As EContainer = w.GetNode(VideoNode)
If Not v Is Nothing AndAlso v.Count > 0 Then If v.ListExists Then
Dim l As New List(Of Sizes) Dim l As New List(Of Sizes)
Dim u$ Dim u$
Dim nn As EContainer Dim nn As EContainer
@@ -187,8 +326,6 @@ Namespace API.Twitter
End If End If
Return String.Empty Return String.Empty
End Function End Function
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
Private Function UrlFile(ByVal URL As String) As String Private Function UrlFile(ByVal URL As String) As String
Try Try
Dim f As SFile = CStr(RegexReplace(LinkFormatterSecure(RegexReplace(URL.Replace("\", String.Empty), LinkPattern)), FilesPattern)) Dim f As SFile = CStr(RegexReplace(LinkFormatterSecure(RegexReplace(URL.Replace("\", String.Empty), LinkPattern)), FilesPattern))
@@ -199,7 +336,8 @@ Namespace API.Twitter
End Function End Function
#End Region #End Region
Private Shared Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String, Private Shared Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _PictureOption As String = "") As UserMedia Optional ByVal _PictureOption As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern)) _URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL) With {.PictureOption = _PictureOption, .Post = New UserPost With {.ID = PostID}} Dim m As New UserMedia(_URL) With {.PictureOption = _PictureOption, .Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern)) If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
@@ -207,6 +345,7 @@ Namespace API.Twitter
m.URL_BASE = $"{m.URL.Replace($".{m.File.Extension}", String.Empty)}?format={m.File.Extension}&name={m.PictureOption}" m.URL_BASE = $"{m.URL.Replace($".{m.File.Extension}", String.Empty)}?format={m.File.Extension}&name={m.PictureOption}"
End If End If
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, Declarations.DateProvider, Nothing) Else m.Post.Date = Nothing If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, Declarations.DateProvider, Nothing) Else m.Post.Date = Nothing
m.State = State
Return m Return m
End Function End Function
#End Region #End Region
@@ -220,6 +359,8 @@ Namespace API.Twitter
UserSuspended = True UserSuspended = True
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
MyMainLOG = "Twitter has invalid credentials" MyMainLOG = "Twitter has invalid credentials"
ElseIf Responser.StatusCode = HttpStatusCode.ServiceUnavailable Then
MyMainLOG = $"Twitter is currently unavailable ({ToString()})"
Else Else
If Not FromPE Then LogError(ex, Message) : HasError = True If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0 Return 0

View File

@@ -79,7 +79,7 @@ Namespace API
If Count > 0 Then If Count > 0 Then
Return Collections(0).GetPicture Return Collections(0).GetPicture
Else Else
Return GetNullPicture(Settings.MaxLargeImageHeigh) Return GetNullPicture(Settings.MaxLargeImageHeight)
End If End If
End Function End Function
#End Region #End Region
@@ -92,6 +92,11 @@ Namespace API
End If End If
End Get End Get
End Property End Property
Friend Overrides ReadOnly Property ContentMissingExists As Boolean
Get
Return Count > 0 AndAlso Collections.Exists(Function(c) DirectCast(c, UserDataBase).ContentMissingExists)
End Get
End Property
Friend ReadOnly Property Count As Integer Implements ICollection(Of IUserData).Count, IMyEnumerator(Of IUserData).MyEnumeratorCount Friend ReadOnly Property Count As Integer Implements ICollection(Of IUserData).Count, IMyEnumerator(Of IUserData).MyEnumeratorCount
Get Get
If Collections Is Nothing Then If Collections Is Nothing Then
@@ -191,10 +196,10 @@ Namespace API
Friend Overrides Property LastUpdated As Date? Friend Overrides Property LastUpdated As Date?
Get Get
If Count > 0 Then If Count > 0 Then
With If((From c As IUserData In Collections With (From c As IUserData In Collections
Where DirectCast(c, UserDataBase).LastUpdated.HasValue Where DirectCast(c, UserDataBase).LastUpdated.HasValue
Select DirectCast(c, UserDataBase).LastUpdated.Value).ToList, New List(Of Date)) Select DirectCast(c, UserDataBase).LastUpdated.Value).ToList
If .Count > 0 Then Return .Max If .ListExists Then Return .Max
End With End With
End If End If
Return Nothing Return Nothing
@@ -207,6 +212,18 @@ Namespace API
Return Count > 0 AndAlso Collections.Exists(Function(c) c.FitToAddParams) Return Count > 0 AndAlso Collections.Exists(Function(c) c.FitToAddParams)
End Get End Get
End Property End Property
Friend Overrides Property ScriptUse As Boolean
Get
Return Count > 0 AndAlso Collections.Exists(Function(c) c.ScriptUse)
End Get
Set(ByVal u As Boolean)
If Count > 0 Then Collections.ForEach(Sub(ByVal c As IUserData)
Dim b As Boolean = c.ScriptUse = u
c.ScriptUse = u
If Not b Then c.UpdateUserInformation()
End Sub)
End Set
End Property
#Region "Context buttons" #Region "Context buttons"
Friend ReadOnly Property ContextDown As ToolStripMenuItem() Friend ReadOnly Property ContextDown As ToolStripMenuItem()
Get Get
@@ -255,6 +272,7 @@ Namespace API
End Property End Property
#End Region #End Region
#End Region #End Region
#Region "Initializers"
Friend Sub New() Friend Sub New()
_IsCollection = True _IsCollection = True
Collections = New List(Of IUserData) Collections = New List(Of IUserData)
@@ -264,17 +282,21 @@ Namespace API
Me.New Me.New
CollectionName = _Name CollectionName = _Name
End Sub End Sub
#End Region
#Region "Load, Update"
Friend Overrides Sub LoadUserInformation() Friend Overrides Sub LoadUserInformation()
If Count > 0 Then Collections.ForEach(Sub(c) c.LoadUserInformation()) If Count > 0 Then Collections.ForEach(Sub(c) c.LoadUserInformation())
End Sub End Sub
Friend Overrides Sub UpdateUserInformation() Friend Overrides Sub UpdateUserInformation()
If Count > 0 Then Collections.ForEach(Sub(c) c.UpdateUserInformation()) If Count > 0 Then Collections.ForEach(Sub(c) c.UpdateUserInformation())
End Sub End Sub
Friend Overrides Sub LoadContentInformation() Friend Overrides Sub LoadContentInformation(Optional ByVal Force As Boolean = False)
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).LoadContentInformation()) If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).LoadContentInformation(Force))
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)
End Sub End Sub
#End Region
#Region "Download"
Friend Overrides Property DownloadTopCount As Integer? Friend Overrides Property DownloadTopCount As Integer?
Get Get
If Count > 0 Then If Count > 0 Then
@@ -292,16 +314,16 @@ Namespace API
End Sub End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
End Sub End Sub
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
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) As Integer
Return 0 Return 0
End Function End Function
Private Sub User_OnUserUpdated(ByVal User As IUserData) Private Sub User_OnUserUpdated(ByVal User As IUserData)
RaiseEvent_OnUserUpdated() OnUserUpdated()
End Sub End Sub
#End Region
#Region "Open site, folder"
Friend Overrides Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing) Friend Overrides Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing)
If Not e.Exists Then e = New ErrorsDescriber(EDP.SendInLog) If Not e.Exists Then e = New ErrorsDescriber(EDP.SendInLog)
If Count > 0 Then Collections.ForEach(Sub(c) c.OpenSite(e)) If Count > 0 Then Collections.ForEach(Sub(c) c.OpenSite(e))
@@ -309,9 +331,10 @@ Namespace API
Friend Overrides Sub OpenFolder() Friend Overrides Sub OpenFolder()
Try Try
If Count > 0 Then GlobalOpenPath(Collections(0).File.CutPath(2)) If Count > 0 Then GlobalOpenPath(Collections(0).File.CutPath(2))
Catch ex As Exception Catch
End Try End Try
End Sub End Sub
#End Region
#Region "ICollection Support" #Region "ICollection Support"
Default Friend ReadOnly Property Item(ByVal Index As Integer) As IUserData Implements IMyEnumerator(Of IUserData).MyEnumeratorObject Default Friend ReadOnly Property Item(ByVal Index As Integer) As IUserData Implements IMyEnumerator(Of IUserData).MyEnumeratorObject
Get Get
@@ -336,11 +359,12 @@ Namespace API
.Favorite = Favorite .Favorite = Favorite
.ReadyForDownload = ReadyForDownload .ReadyForDownload = ReadyForDownload
ConsolidateLabels() ConsolidateLabels()
ConsolidateScripts()
.UpdateUserInformation() .UpdateUserInformation()
End If End If
ImageHandler(_Item, False) MainFrameObj.ImageHandler(_Item, False)
AddRemoveBttDeleteHandler(.Self, True) AddRemoveBttDeleteHandler(.Self, True)
AddHandler .Self.OnUserUpdated, AddressOf User_OnUserUpdated AddHandler .Self.UserUpdated, AddressOf User_OnUserUpdated
End With End With
Else Else
Throw New InvalidOperationException("User data was not moved to the collection folder") Throw New InvalidOperationException("User data was not moved to the collection folder")
@@ -354,7 +378,7 @@ Namespace API
With Collections.Last With Collections.Last
If _CollectionName.IsEmptyString Then _CollectionName = .CollectionName If _CollectionName.IsEmptyString Then _CollectionName = .CollectionName
AddRemoveBttDeleteHandler(.Self, True) AddRemoveBttDeleteHandler(.Self, True)
AddHandler .OnUserUpdated, AddressOf User_OnUserUpdated AddHandler .UserUpdated, AddressOf User_OnUserUpdated
End With End With
Else Else
Collections.RemoveAt(Count - 1) Collections.RemoveAt(Count - 1)
@@ -381,8 +405,11 @@ Namespace API
Collections.ForEach(Sub(c) c.Labels.ListAddList(l, lp)) Collections.ForEach(Sub(c) c.Labels.ListAddList(l, lp))
End If End If
End Sub End Sub
Private Sub ConsolidateScripts()
If Count > 1 AndAlso ScriptUse Then Collections.ForEach(Sub(c) c.ScriptUse = True)
End Sub
Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData)) Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData))
If Not _Items Is Nothing AndAlso _Items.Count > 0 Then If _Items.ListExists Then
For i% = 0 To _Items.Count - 1 : Add(_Items(i)) : Next For i% = 0 To _Items.Count - 1 : Add(_Items(i)) : Next
End If End If
End Sub End Sub
@@ -417,7 +444,7 @@ Namespace API
Collections.ListClearDispose Collections.ListClearDispose
End Sub End Sub
Friend Function Contains(ByVal _Item As IUserData) As Boolean Implements ICollection(Of IUserData).Contains Friend Function Contains(ByVal _Item As IUserData) As Boolean Implements ICollection(Of IUserData).Contains
Return Collections.Contains(_Item) Return Count > 0 AndAlso Collections.Contains(_Item)
End Function End Function
Private Sub CopyTo(ByVal _Array() As IUserData, ByVal _ArrayIndex As Integer) Implements ICollection(Of IUserData).CopyTo Private Sub CopyTo(ByVal _Array() As IUserData, ByVal _ArrayIndex As Integer) Implements ICollection(Of IUserData).CopyTo
Throw New NotImplementedException("[CopyTo] method does not supported in collections context") Throw New NotImplementedException("[CopyTo] method does not supported in collections context")
@@ -430,7 +457,7 @@ Namespace API
Return False Return False
Else Else
DirectCast(_Item, UserDataBase).MoveFiles(String.Empty) DirectCast(_Item, UserDataBase).MoveFiles(String.Empty)
ImageHandler(_Item) MainFrameObj.ImageHandler(_Item)
AddRemoveBttDeleteHandler(_Item, False) AddRemoveBttDeleteHandler(_Item, False)
RaiseEvent OnUserRemoved(_Item) RaiseEvent OnUserRemoved(_Item)
Return Collections.Remove(_Item) Return Collections.Remove(_Item)
@@ -445,7 +472,7 @@ Namespace API
Settings.Users.Remove(Me) Settings.Users.Remove(Me)
Collections.ForEach(Sub(c) c.Delete()) Collections.ForEach(Sub(c) c.Delete())
Downloader.UserRemove(Me) Downloader.UserRemove(Me)
ImageHandler(Me, False) MainFrameObj.ImageHandler(Me, False)
Collections.ListClearDispose Collections.ListClearDispose
Dispose(False) Dispose(False)
f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog) f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog)
@@ -463,12 +490,12 @@ Namespace API
Settings.Users.Remove(Me) Settings.Users.Remove(Me)
Collections.ForEach(Sub(c) Collections.ForEach(Sub(c)
c.MoveFiles(String.Empty) c.MoveFiles(String.Empty)
ImageHandler(c) MainFrameObj.ImageHandler(c)
End Sub) End Sub)
Collections.Clear() Collections.Clear()
f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog) f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog)
Downloader.UserRemove(Me) Downloader.UserRemove(Me)
ImageHandler(Me, False) MainFrameObj.ImageHandler(Me, False)
Dispose(False) Dispose(False)
Return 3 Return 3
Else Else
@@ -487,7 +514,7 @@ Namespace API
Dim RemoveMeIfNull As Action = Sub() Dim RemoveMeIfNull As Action = Sub()
If Count = 0 Then If Count = 0 Then
Settings.Users.Remove(Me) Settings.Users.Remove(Me)
ImageHandler(Me, False) MainFrameObj.ImageHandler(Me, False)
RaiseEvent OnCollectionSelfRemoved(Me) RaiseEvent OnCollectionSelfRemoved(Me)
Dispose(False) Dispose(False)
End If End If

View File

@@ -15,8 +15,6 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
Private Sub InitializeComponent() Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container() Me.components = New System.ComponentModel.Container()
Dim SEP_1 As System.Windows.Forms.ToolStripSeparator Dim SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim SEP_3 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_1 As System.Windows.Forms.ToolStripSeparator Dim CONTEXT_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_2 As System.Windows.Forms.ToolStripSeparator Dim CONTEXT_SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(ChannelViewForm)) Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(ChannelViewForm))
@@ -34,11 +32,9 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
Me.BTT_C_OPEN_POST = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_C_OPEN_POST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_C_OPEN_PICTURE = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_C_OPEN_PICTURE = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_C_OPEN_FOLDER = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_C_OPEN_FOLDER = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_C_ADD_TO_BLACKLIST = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_C_REMOVE_FROM_SELECTED = New System.Windows.Forms.ToolStripMenuItem() Me.BTT_C_REMOVE_FROM_SELECTED = New System.Windows.Forms.ToolStripMenuItem()
Me.BTT_C_ADD_TO_BLACKLIST = New System.Windows.Forms.ToolStripMenuItem()
SEP_1 = New System.Windows.Forms.ToolStripSeparator() SEP_1 = New System.Windows.Forms.ToolStripSeparator()
SEP_2 = New System.Windows.Forms.ToolStripSeparator()
SEP_3 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator() CONTEXT_SEP_1 = New System.Windows.Forms.ToolStripSeparator()
CONTEXT_SEP_2 = New System.Windows.Forms.ToolStripSeparator() CONTEXT_SEP_2 = New System.Windows.Forms.ToolStripSeparator()
Me.ToolbarTOP.SuspendLayout() Me.ToolbarTOP.SuspendLayout()
@@ -51,25 +47,20 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
SEP_1.Name = "SEP_1" SEP_1.Name = "SEP_1"
SEP_1.Size = New System.Drawing.Size(6, 25) SEP_1.Size = New System.Drawing.Size(6, 25)
' '
'SEP_2
'
SEP_2.Name = "SEP_2"
SEP_2.Size = New System.Drawing.Size(6, 25)
'
'SEP_3
'
SEP_3.Name = "SEP_3"
SEP_3.Size = New System.Drawing.Size(6, 25)
'
'CONTEXT_SEP_1 'CONTEXT_SEP_1
' '
CONTEXT_SEP_1.Name = "CONTEXT_SEP_1" CONTEXT_SEP_1.Name = "CONTEXT_SEP_1"
CONTEXT_SEP_1.Size = New System.Drawing.Size(302, 6) CONTEXT_SEP_1.Size = New System.Drawing.Size(302, 6)
' '
'CONTEXT_SEP_2
'
CONTEXT_SEP_2.Name = "CONTEXT_SEP_2"
CONTEXT_SEP_2.Size = New System.Drawing.Size(302, 6)
'
'ToolbarTOP 'ToolbarTOP
' '
Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden Me.ToolbarTOP.GripStyle = System.Windows.Forms.ToolStripGripStyle.Hidden
Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_DOWNLOAD, Me.BTT_STOP, SEP_1, Me.BTT_ADD_USERS, SEP_2, SEP_3}) Me.ToolbarTOP.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_DOWNLOAD, Me.BTT_STOP, SEP_1, Me.BTT_ADD_USERS})
Me.ToolbarTOP.Location = New System.Drawing.Point(0, 0) Me.ToolbarTOP.Location = New System.Drawing.Point(0, 0)
Me.ToolbarTOP.Name = "ToolbarTOP" Me.ToolbarTOP.Name = "ToolbarTOP"
Me.ToolbarTOP.Size = New System.Drawing.Size(744, 25) Me.ToolbarTOP.Size = New System.Drawing.Size(744, 25)
@@ -138,7 +129,7 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
' '
Me.LCONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_C_OPEN_USER, Me.BTT_C_OPEN_POST, Me.BTT_C_OPEN_PICTURE, Me.BTT_C_OPEN_FOLDER, CONTEXT_SEP_1, Me.BTT_C_REMOVE_FROM_SELECTED, CONTEXT_SEP_2, Me.BTT_C_ADD_TO_BLACKLIST}) Me.LCONTEXT.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.BTT_C_OPEN_USER, Me.BTT_C_OPEN_POST, Me.BTT_C_OPEN_PICTURE, Me.BTT_C_OPEN_FOLDER, CONTEXT_SEP_1, Me.BTT_C_REMOVE_FROM_SELECTED, CONTEXT_SEP_2, Me.BTT_C_ADD_TO_BLACKLIST})
Me.LCONTEXT.Name = "LCONTEXT" Me.LCONTEXT.Name = "LCONTEXT"
Me.LCONTEXT.Size = New System.Drawing.Size(306, 170) Me.LCONTEXT.Size = New System.Drawing.Size(306, 148)
' '
'BTT_C_OPEN_USER 'BTT_C_OPEN_USER
' '
@@ -164,17 +155,6 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
Me.BTT_C_OPEN_FOLDER.Size = New System.Drawing.Size(305, 22) Me.BTT_C_OPEN_FOLDER.Size = New System.Drawing.Size(305, 22)
Me.BTT_C_OPEN_FOLDER.Text = "Open folder" Me.BTT_C_OPEN_FOLDER.Text = "Open folder"
' '
'BTT_C_ADD_TO_BLACKLIST
'
Me.BTT_C_ADD_TO_BLACKLIST.Name = "BTT_C_ADD_TO_BLACKLIST"
Me.BTT_C_ADD_TO_BLACKLIST.Size = New System.Drawing.Size(305, 22)
Me.BTT_C_ADD_TO_BLACKLIST.Text = "Add/Remove this user to/from the BlackList"
'
'CONTEXT_SEP_2
'
CONTEXT_SEP_2.Name = "CONTEXT_SEP_2"
CONTEXT_SEP_2.Size = New System.Drawing.Size(302, 6)
'
'BTT_C_REMOVE_FROM_SELECTED 'BTT_C_REMOVE_FROM_SELECTED
' '
Me.BTT_C_REMOVE_FROM_SELECTED.AutoToolTip = True Me.BTT_C_REMOVE_FROM_SELECTED.AutoToolTip = True
@@ -183,6 +163,12 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
Me.BTT_C_REMOVE_FROM_SELECTED.Text = "Remove user from selected" Me.BTT_C_REMOVE_FROM_SELECTED.Text = "Remove user from selected"
Me.BTT_C_REMOVE_FROM_SELECTED.ToolTipText = "Remove this user from selected users if user was added to" Me.BTT_C_REMOVE_FROM_SELECTED.ToolTipText = "Remove this user from selected users if user was added to"
' '
'BTT_C_ADD_TO_BLACKLIST
'
Me.BTT_C_ADD_TO_BLACKLIST.Name = "BTT_C_ADD_TO_BLACKLIST"
Me.BTT_C_ADD_TO_BLACKLIST.Size = New System.Drawing.Size(305, 22)
Me.BTT_C_ADD_TO_BLACKLIST.Text = "Add/Remove this user to/from the BlackList"
'
'ChannelViewForm 'ChannelViewForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)

View File

@@ -120,15 +120,12 @@
<metadata name="SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> <metadata name="SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </metadata>
<metadata name="SEP_2.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="SEP_3.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="CONTEXT_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> <metadata name="CONTEXT_SEP_1.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value> <value>False</value>
</metadata> </metadata>
<metadata name="CONTEXT_SEP_2.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> <metadata name="TT_MAIN.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>241, 17</value> <value>241, 17</value>
</metadata> </metadata>
@@ -141,9 +138,6 @@
<metadata name="LCONTEXT.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> <metadata name="LCONTEXT.TrayLocation" type="System.Drawing.Point, System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
<value>342, 17</value> <value>342, 17</value>
</metadata> </metadata>
<metadata name="CONTEXT_SEP_2.GenerateMember" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>False</value>
</metadata>
<assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" /> <assembly alias="System.Drawing" name="System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" />
<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>

View File

@@ -16,11 +16,11 @@ Imports System.Threading
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.API.Reddit Imports SCrawler.API.Reddit
Imports SCrawler.Plugin.Hosts Imports SCrawler.Plugin.Hosts
Imports CmbDefaultButtons = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Imports RButton = PersonalUtilities.Tools.RangeSwitcherButton.Types Imports RButton = PersonalUtilities.Forms.Toolbars.RangeSwitcherToolbar.ControlItem
Friend Class ChannelViewForm : Implements IChannelLimits Friend Class ChannelViewForm : Implements IChannelLimits
Friend Event OnUsersAdded(ByVal StartIndex As Integer) Friend Event OnUsersAdded(ByVal StartIndex As Integer)
Friend Event OnDownloadDone(ByVal Message As String) Friend Event OnDownloadDone As NotificationEventHandler
#Region "Appended user structure" #Region "Appended user structure"
Private Structure PendingUser Private Structure PendingUser
Friend ID As String Friend ID As String
@@ -49,7 +49,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End Structure End Structure
#End Region #End Region
#Region "Declarations" #Region "Declarations"
Private ReadOnly MyDefs As DefaultFormProps Private ReadOnly MyDefs As DefaultFormOptions
#Region "Controls" #Region "Controls"
Private WithEvents CMB_CHANNELS As ComboBoxExtended Private WithEvents CMB_CHANNELS As ComboBoxExtended
Private WithEvents CH_HIDE_EXISTS_USERS As CheckBox Private WithEvents CH_HIDE_EXISTS_USERS As CheckBox
@@ -125,7 +125,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Private ReadOnly HOST As SettingsHost Private ReadOnly HOST As SettingsHost
Private ReadOnly PendingUsers As List(Of PendingUser) Private ReadOnly PendingUsers As List(Of PendingUser)
Private ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly) Private ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly)
Private WithEvents MyRange As RangeSwitcher(Of UserPost) Private WithEvents MyRange As RangeSwitcherToolbar(Of UserPost)
Private ReadOnly SelectorExpression As Predicate(Of UserPost) = Function(ByVal Post As UserPost) As Boolean Private ReadOnly SelectorExpression As Predicate(Of UserPost) = Function(ByVal Post As UserPost) As Boolean
If Post.UserID.ToLower = "[deleted]" Or Settings.BlackList.Contains(Post.UserID) Then If Post.UserID.ToLower = "[deleted]" Or Settings.BlackList.Contains(Post.UserID) Then
Return False Return False
@@ -141,8 +141,8 @@ Friend Class ChannelViewForm : Implements IChannelLimits
#Region "Initializer and form methods" #Region "Initializer and form methods"
Friend Sub New() Friend Sub New()
InitializeComponent() InitializeComponent()
MyDefs = New DefaultFormProps MyDefs = New DefaultFormOptions
CProgress = New MyProgress(ToolbarBOTTOM, PR_CN, LBL_STATUS, "Downloading data") With {.PerformMod = 10, .DropCurrentProgressOnTotalChange = False} CProgress = New MyProgress(ToolbarBOTTOM, PR_CN, LBL_STATUS, "Downloading data") With {.PerformMod = 10, .ResetProgressOnMaximumChanges = False}
CProvider = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral} CProvider = New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
LimitProvider = New ADateTime("dd.MM.yyyy HH:mm") LimitProvider = New ADateTime("dd.MM.yyyy HH:mm")
PendingUsers = New List(Of PendingUser) PendingUsers = New List(Of PendingUser)
@@ -157,10 +157,10 @@ Friend Class ChannelViewForm : Implements IChannelLimits
.ListMaxDropDownItems = 15, .ListMaxDropDownItems = 15,
.CaptionPadding = New Padding(0, 3, 0, 0) .CaptionPadding = New Padding(0, 3, 0, 0)
} }
CMB_CHANNELS.Buttons.AddRange({CmbDefaultButtons.Refresh, CmbDefaultButtons.Add, CmbDefaultButtons.Delete, CMB_CHANNELS.Buttons.AddRange({ADB.Refresh, ADB.Add, ADB.Delete,
New ActionButton(CmbDefaultButtons.Up) With {.ToolTipText = "Previous item (F1)"}, New ActionButton(ADB.Up) With {.ToolTipText = "Previous item (F1)"},
New ActionButton(CmbDefaultButtons.Down) With {.ToolTipText = "Next item (F4)"}, New ActionButton(ADB.Down) With {.ToolTipText = "Next item (F4)"},
CmbDefaultButtons.Info}) ADB.Edit, ADB.Info})
TXT_LIMIT = New TextBoxExtended With { TXT_LIMIT = New TextBoxExtended With {
.CaptionText = "Limit", .CaptionText = "Limit",
.Margin = New Padding(2), .Margin = New Padding(2),
@@ -186,6 +186,17 @@ Friend Class ChannelViewForm : Implements IChannelLimits
TT_MAIN.SetToolTip(CH_HIDE_EXISTS_USERS, "Hide users which already exists in collection") TT_MAIN.SetToolTip(CH_HIDE_EXISTS_USERS, "Hide users which already exists in collection")
TT_MAIN.SetToolTip(OPT_LIMITS_COUNT, "Total posts count limit") TT_MAIN.SetToolTip(OPT_LIMITS_COUNT, "Total posts count limit")
TT_MAIN.SetToolTip(OPT_LIMITS_POST, "Looking limit till post(-s) (comma separated)") TT_MAIN.SetToolTip(OPT_LIMITS_POST, "Looking limit till post(-s) (comma separated)")
MyRange = New RangeSwitcherToolbar(Of UserPost)(ToolbarTOP)
With MyRange
.Switcher = New RangeSwitcher(Of UserPost) With {.Selector = SelectorExpression}
.Buttons = {RButton.First, RButton.Previous, RButton.Label, RButton.Next, RButton.Last, RButton.Separator}
.AutoToolTip = True
.ButtonKey(RButton.Previous) = Keys.F2
.ButtonKey(RButton.Next) = Keys.F3
.LabelNumbersProvider = CProvider
.Limit = ImagesInRow * ImagesRows
.AddThisToolbar()
End With
ToolbarTOP.Items.AddRange({CMB_CHANNELS.GetControlHost, ToolbarTOP.Items.AddRange({CMB_CHANNELS.GetControlHost,
New ToolStripSeparator, New ToolStripSeparator,
LBL_LIMITS, LBL_LIMITS,
@@ -198,16 +209,6 @@ Friend Class ChannelViewForm : Implements IChannelLimits
New ToolStripSeparator, New ToolStripSeparator,
New ToolStripControlHost(CH_HIDE_EXISTS_USERS), New ToolStripControlHost(CH_HIDE_EXISTS_USERS),
BTT_SHOW_STATS}) BTT_SHOW_STATS})
MyRange = New RangeSwitcher(Of UserPost) With {.Selector = SelectorExpression}
With MyRange
.Limit = ImagesInRow * ImagesRows
.InsertButtons(ToolbarTOP, {RButton.Previous, RButton.Next}, 5)
.SetButtonKey(RButton.Previous, Keys.F2)
.SetButtonKey(RButton.Next, Keys.F3)
.BindForm(Me)
.LabelNumbersProvider = CProvider
.UpdateControls()
End With
AddHandler Settings.ChannelsImagesColumns.OnValueChanged, AddressOf ImagesCountChanged AddHandler Settings.ChannelsImagesColumns.OnValueChanged, AddressOf ImagesCountChanged
AddHandler Settings.ChannelsImagesRows.OnValueChanged, AddressOf ImagesCountChanged AddHandler Settings.ChannelsImagesRows.OnValueChanged, AddressOf ImagesCountChanged
End Sub End Sub
@@ -215,14 +216,16 @@ Friend Class ChannelViewForm : Implements IChannelLimits
MyDefs.MyViewInitialize(Me, Settings.Design) MyDefs.MyViewInitialize(Me, Settings.Design)
RefillChannels(Settings.LatestSelectedChannel.Value) RefillChannels(Settings.LatestSelectedChannel.Value)
ChangeComboIndex(0) ChangeComboIndex(0)
CMB_CHANNELS_ActionOnCheckedChange(CMB_CHANNELS.Checked) MyRange.LabelText = String.Empty
CMB_CHANNELS_ActionOnCheckedChange(Nothing, Nothing, CMB_CHANNELS.Checked)
With LIST_POSTS With LIST_POSTS
Dim s As Size = GetImageSize() Dim s As Size = GetImageSize()
.LargeImageList = New ImageList With {.ColorDepth = ColorDepth.Depth32Bit, .ImageSize = s} .LargeImageList = New ImageList With {.ColorDepth = ColorDepth.Depth32Bit, .ImageSize = s}
.SmallImageList = New ImageList With {.ColorDepth = ColorDepth.Depth32Bit, .ImageSize = s} .SmallImageList = New ImageList With {.ColorDepth = ColorDepth.Depth32Bit, .ImageSize = s}
End With End With
CMB_CHANNELS.Enabled(False) = Not CMB_CHANNELS.Checked CMB_CHANNELS.Enabled(False) = Not CMB_CHANNELS.Checked
MyDefs.EndLoaderOperations() MyDefs.DelegateClosingChecker = False
MyDefs.EndLoaderOperations(False)
SetLimitsByChannel(, False) SetLimitsByChannel(, False)
End Sub End Sub
Private Sub ChannelViewForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing Private Sub ChannelViewForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
@@ -279,11 +282,10 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End With End With
CMB_CHANNELS.EndUpdate() CMB_CHANNELS.EndUpdate()
End Sub End Sub
#Region "Images refill methods"
Private Sub AppendPendingUsers() Private Sub AppendPendingUsers()
If LIST_POSTS.CheckedIndices.Count > 0 Then If LIST_POSTS.CheckedIndices.Count > 0 Then
Dim c As Channel = GetCurrentChannel(False) Dim c As Channel = GetCurrentChannel(False)
Dim lp As New ListAddParams(LAP.NotContainsOnly) With {.OnAddAction = Sub(ByVal u As PendingUser) u.ChannelUserAdded()} Dim lp As New ListAddParams(LAP.NotContainsOnly) With {.OnProcessAction = Sub(ByVal u As PendingUser) u.ChannelUserAdded()}
PendingUsers.ListAddList((From p As ListViewItem In LIST_POSTS.Items PendingUsers.ListAddList((From p As ListViewItem In LIST_POSTS.Items
Where p.Checked Where p.Checked
Select New PendingUser(p.Text, c, GetPostBySelected(CStr(p.Tag)).CachedFile)), lp) Select New PendingUser(p.Text, c, GetPostBySelected(CStr(p.Tag)).CachedFile)), lp)
@@ -295,8 +297,8 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Const mhw% = 256 Const mhw% = 256
Dim s As Size = LIST_POSTS.Size Dim s As Size = LIST_POSTS.Size
With LIST_POSTS With LIST_POSTS
s.Width -= (.Margin.Left + .Margin.Right) s.Width -= .Margin.Horizontal
s.Height -= (.Margin.Top + .Margin.Bottom) s.Height -= .Margin.Vertical
s.Width = s.Width / ImagesInRow - .Padding.Left * ImagesInRow - .Padding.Right * ImagesInRow s.Width = s.Width / ImagesInRow - .Padding.Left * ImagesInRow - .Padding.Right * ImagesInRow
s.Height = s.Height / ImagesRows - .Padding.Top * ImagesRows - .Padding.Bottom * ImagesRows s.Height = s.Height / ImagesRows - .Padding.Top * ImagesRows - .Padding.Bottom * ImagesRows
If s.Width = 0 Then s.Width = 50 If s.Width = 0 Then s.Width = 50
@@ -311,7 +313,6 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End With End With
Return s Return s
End Function End Function
#End Region
#Region "Toolbar controls" #Region "Toolbar controls"
#Region "Downloader" #Region "Downloader"
Private TokenSource As CancellationTokenSource Private TokenSource As CancellationTokenSource
@@ -326,12 +327,12 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Private Async Sub BTT_DOWNLOAD_Click(sender As Object, e As EventArgs) Handles BTT_DOWNLOAD.Click Private Async Sub BTT_DOWNLOAD_Click(sender As Object, e As EventArgs) Handles BTT_DOWNLOAD.Click
Try Try
AppendPendingUsers() AppendPendingUsers()
If Not TokenSource Is Nothing OrElse Not HOST.Source.Available(Plugin.ISiteSettings.Download.Channel) Then Exit Sub If Not TokenSource Is Nothing OrElse Not HOST.Source.Available(Plugin.ISiteSettings.Download.Channel, False) Then Exit Sub
Dim InvokeToken As Action = Sub() Dim InvokeToken As Action = Sub()
If TokenSource Is Nothing Then If TokenSource Is Nothing Then
CProgress.TotalCount = 0 CProgress.Maximum = 0
CProgress.CurrentCounter = 0 CProgress.Value = 0
CProgress.Enabled = True CProgress.Visible = True
TokenSource = New CancellationTokenSource TokenSource = New CancellationTokenSource
Token = TokenSource.Token Token = TokenSource.Token
BTT_DOWNLOAD.Enabled = False BTT_DOWNLOAD.Enabled = False
@@ -343,8 +344,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
CH_HIDE_EXISTS_USERS.Enabled = False CH_HIDE_EXISTS_USERS.Enabled = False
CMB_CHANNELS.Enabled(True) = False CMB_CHANNELS.Enabled(True) = False
BTT_SHOW_STATS.Enabled = False BTT_SHOW_STATS.Enabled = False
MyRange.EnableButton(RButton.Previous, False) MyRange.Enabled = False
MyRange.EnableButton(RButton.Next, False)
End If End If
End Sub End Sub
Dim c As Channel Dim c As Channel
@@ -373,7 +373,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End If End If
If Not c Is Nothing Then If Not c Is Nothing Then
SetLimitsByChannel(c) SetLimitsByChannel(c)
MyRange.ChangeSource(c) MyRange.Source = c
End If End If
Else Else
MsgBoxE("No one channels detected", MsgBoxStyle.Exclamation) MsgBoxE("No one channels detected", MsgBoxStyle.Exclamation)
@@ -389,7 +389,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Finally Finally
If Not TokenSource Is Nothing AndAlso Not Settings.Channels.Downloading Then If Not TokenSource Is Nothing AndAlso Not Settings.Channels.Downloading Then
TokenSource = Nothing TokenSource = Nothing
CProgress.Enabled = False CProgress.Visible = False
BTT_DOWNLOAD.Enabled = True BTT_DOWNLOAD.Enabled = True
BTT_STOP.Enabled = False BTT_STOP.Enabled = False
_CollectionDownloading = False _CollectionDownloading = False
@@ -401,11 +401,9 @@ Friend Class ChannelViewForm : Implements IChannelLimits
CH_HIDE_EXISTS_USERS.Enabled = True CH_HIDE_EXISTS_USERS.Enabled = True
CMB_CHANNELS.Enabled(True) = True CMB_CHANNELS.Enabled(True) = True
BTT_SHOW_STATS.Enabled = True BTT_SHOW_STATS.Enabled = True
CMB_CHANNELS_ActionOnCheckedChange(CMB_CHANNELS.Checked) CMB_CHANNELS_ActionOnCheckedChange(Nothing, Nothing, CMB_CHANNELS.Checked)
With MyRange MyRange.Enabled = True
.EnableButton(RButton.Previous, .Count > 0 AndAlso .CurrentIndex > 0) MyRange.UpdateControls()
.EnableButton(RButton.Next, .Count > 0 AndAlso .CurrentIndex < .Max)
End With
End If End If
End Try End Try
End Sub End Sub
@@ -543,55 +541,76 @@ Friend Class ChannelViewForm : Implements IChannelLimits
LBL_LIMIT_TEXT.Text = String.Empty LBL_LIMIT_TEXT.Text = String.Empty
If Not c Is Nothing Then If Not c Is Nothing Then
Settings.LatestSelectedChannel.Value = c.ID Settings.LatestSelectedChannel.Value = c.ID
With c.PostsAll Dim d As Date?
If .Count > 0 Then If c.ViewMode = IRedditView.View.New Then
OPT_LIMITS_DEFAULT.Checked = True With c.PostsAll
Dim d As Date? = .FirstOrDefault(Function(p) p.Date.HasValue).Date If .Count > 0 Then
If d.HasValue Then OPT_LIMITS_DEFAULT.Checked = True
LBL_LIMIT_TEXT.Text = $"to date {AConvert(Of String)(d, ADateTime.Formats.BaseDateTime, String.Empty)}" d = .FirstOrDefault(Function(p) p.Date.HasValue).Date
If d.HasValue Then
LBL_LIMIT_TEXT.Text = $"to date {AConvert(Of String)(d, ADateTime.Formats.BaseDateTime, String.Empty)}"
Else
LBL_LIMIT_TEXT.Text = $"to post [{c.FirstOrDefault(Function(p) Not p.ID.IsEmptyString).ID}]"
End If
Else Else
LBL_LIMIT_TEXT.Text = $"to post [{c.First(Function(p) Not p.ID.IsEmptyString).ID}]" OPT_LIMITS_COUNT.Checked = True
If TXT_LIMIT.Text.IsEmptyString Then TXT_LIMIT.Value = Channel.DefaultDownloadLimitCount
LBL_LIMIT_TEXT.Text = $"first {TXT_LIMIT.Text} posts"
End If End If
Else End With
OPT_LIMITS_COUNT.Checked = True Else
If TXT_LIMIT.Text.IsEmptyString Then TXT_LIMIT.Value = Channel.DefaultDownloadLimitCount OPT_LIMITS_DEFAULT.Checked = True
LBL_LIMIT_TEXT.Text = $"first {TXT_LIMIT.Text} posts" d = c.LatestParsedDate
End If Dim per$ = IIf(c.ViewMode = IRedditView.View.Top, c.ViewPeriod.ToString, String.Empty)
End With If Not per.IsEmptyString Then per = $" ({per})"
LBL_LIMIT_TEXT.Text = $"[{c.ViewMode}{per}] to date {AConvert(Of String)(d, ADateTime.Formats.BaseDateTime, String.Empty)}"
End If
End If End If
End Sub End Sub
Private Sub CMB_CHANNELS_ActionSelectedItemChanged(ByVal _Item As ListViewItem) Handles CMB_CHANNELS.ActionSelectedItemChanged Private Sub CMB_CHANNELS_ActionSelectedItemChanged(ByVal _Item As ListViewItem) Handles CMB_CHANNELS.ActionSelectedItemChanged
SetLimitsByChannel() SetLimitsByChannel()
Dim c As Channel = GetCurrentChannel() Dim c As Channel = GetCurrentChannel()
If Not c Is Nothing Then MyRange.ChangeSource(c, EDP.SendInLog) If Not c Is Nothing Then MyRange.Source = c
End Sub End Sub
Private Sub CMB_CHANNELS_ActionOnButtonClick(ByVal Sender As ActionButton) Handles CMB_CHANNELS.ActionOnButtonClick Private Sub CMB_CHANNELS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles CMB_CHANNELS.ActionOnButtonClick
Dim c As Channel Dim c As Channel
Select Case Sender.DefaultButton Select Case Sender.DefaultButton
Case CmbDefaultButtons.Refresh : RefillChannels() Case ADB.Refresh : RefillChannels()
Case CmbDefaultButtons.Add : AddNewChannel() Case ADB.Add : AddNewChannel()
Case CmbDefaultButtons.Delete Case ADB.Delete
Try Try
c = GetCurrentChannel() c = GetCurrentChannel()
If Not c Is Nothing AndAlso MsgBoxE($"Do you really want to delete channel [{c}]?", MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo) = 0 Then If Not c Is Nothing AndAlso MsgBoxE($"Are you sure you want to delete the channel [{c}]?", vbExclamation + vbYesNo) = vbYes Then
Settings.Channels.Remove(c) Settings.Channels.Remove(c)
RefillChannels() RefillChannels()
End If End If
Catch ex As Exception Catch del_ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error on trying to delete channel") ErrorsDescriber.Execute(EDP.LogMessageValue, del_ex, "An error occurred while trying to delete a channel")
End Try End Try
Case CmbDefaultButtons.Up : ChangeComboIndex(-1) Case ADB.Up : ChangeComboIndex(-1)
Case CmbDefaultButtons.Down : ChangeComboIndex(1) Case ADB.Down : ChangeComboIndex(1)
Case CmbDefaultButtons.Info Case ADB.Edit
Try
c = GetCurrentChannel()
If Not c Is Nothing Then
Using f As New RedditViewSettingsForm(c)
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then c.Save()
End Using
End If
Catch edit_ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, edit_ex, "An error occurred while trying to edit a channel")
End Try
Case ADB.Info
Try Try
c = GetCurrentChannel() c = GetCurrentChannel()
If Not c Is Nothing Then MsgBoxE({c.GetChannelStats(True), "Channel statistics"}) If Not c Is Nothing Then MsgBoxE({c.GetChannelStats(True), "Channel statistics"})
Catch info_ex As Exception Catch info_ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, info_ex, "Error on trying to show channel info") ErrorsDescriber.Execute(EDP.LogMessageValue, info_ex, "An error occurred while trying to display channel information")
End Try End Try
End Select End Select
End Sub End Sub
Private Sub CMB_CHANNELS_ActionOnCheckedChange(ByVal Mode As Boolean) Handles CMB_CHANNELS.ActionOnCheckedChange Private Sub CMB_CHANNELS_ActionOnCheckedChange(ByVal Sender As Object, ByVal e As EventArgs, ByVal Checked As Boolean) Handles CMB_CHANNELS.ActionOnCheckedChange
Dim OneChannel As Boolean = Not CMB_CHANNELS.Checked Dim OneChannel As Boolean = Not CMB_CHANNELS.Checked
CMB_CHANNELS.Enabled(False) = OneChannel CMB_CHANNELS.Enabled(False) = OneChannel
If OneChannel Then If OneChannel Then
@@ -599,8 +618,8 @@ Friend Class ChannelViewForm : Implements IChannelLimits
LBL_LIMIT_TEXT.Text = String.Empty LBL_LIMIT_TEXT.Text = String.Empty
ChangeComboIndex(0) ChangeComboIndex(0)
Else Else
CMB_CHANNELS.Button(ActionButton.BTT_UP_NAME).Enabled = False CMB_CHANNELS.Button(ADB.Up).Enabled = False
CMB_CHANNELS.Button(ActionButton.BTT_DOWN_NAME).Enabled = False CMB_CHANNELS.Button(ADB.Down).Enabled = False
SetLimitsByChannel() SetLimitsByChannel()
End If End If
End Sub End Sub
@@ -639,8 +658,8 @@ Friend Class ChannelViewForm : Implements IChannelLimits
_ComboUpEnabled = i > 0 And c > 0 _ComboUpEnabled = i > 0 And c > 0
_ComboDownEnabled = i < c And c > 0 _ComboDownEnabled = i < c And c > 0
End If End If
CMB_CHANNELS.Button(ActionButton.BTT_UP_NAME).Enabled = _ComboUpEnabled CMB_CHANNELS.Button(ADB.Up).Enabled = _ComboUpEnabled
CMB_CHANNELS.Button(ActionButton.BTT_DOWN_NAME).Enabled = _ComboDownEnabled CMB_CHANNELS.Button(ADB.Down).Enabled = _ComboDownEnabled
Catch ex As Exception Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "ComboBox index changing") ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "ComboBox index changing")
End Try End Try
@@ -665,7 +684,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Try Try
If Not p.UserID.IsEmptyString Then Process.Start($"https://www.reddit.com/user/{p.UserID}") If Not p.UserID.IsEmptyString Then Process.Start($"https://www.reddit.com/user/{p.UserID}")
Catch ex As Exception Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, $"Error on opening user by [https://www.reddit.com/user/{p.UserID}]") ErrorsDescriber.Execute(EDP.LogMessageValue, ex, $"Error opening user by [https://www.reddit.com/user/{p.UserID}]")
End Try End Try
End Sub End Sub
Private Sub BTT_C_OPEN_POST_Click(sender As Object, e As EventArgs) Handles BTT_C_OPEN_POST.Click Private Sub BTT_C_OPEN_POST_Click(sender As Object, e As EventArgs) Handles BTT_C_OPEN_POST.Click
@@ -675,7 +694,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
URL = $"https://www.reddit.com/r/{CMB_CHANNELS.Value}/comments/{p.ID.Split("_").Last}" URL = $"https://www.reddit.com/r/{CMB_CHANNELS.Value}/comments/{p.ID.Split("_").Last}"
If Not p.ID.IsEmptyString Then Process.Start(URL) If Not p.ID.IsEmptyString Then Process.Start(URL)
Catch ex As Exception Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, $"Error on opening post by [{URL}]") ErrorsDescriber.Execute(EDP.LogMessageValue, ex, $"Error opening post by [{URL}]")
End Try End Try
End Sub End Sub
Private Sub BTT_C_OPEN_PICTURE_Click(sender As Object, e As EventArgs) Handles BTT_C_OPEN_PICTURE.Click Private Sub BTT_C_OPEN_PICTURE_Click(sender As Object, e As EventArgs) Handles BTT_C_OPEN_PICTURE.Click
@@ -716,14 +735,14 @@ Friend Class ChannelViewForm : Implements IChannelLimits
MsgBoxE("User does not selected", MsgBoxStyle.Exclamation) MsgBoxE("User does not selected", MsgBoxStyle.Exclamation)
End If End If
Catch ex As Exception Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error on removing user from selected") ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Error removing user from selected")
End Try End Try
End Sub End Sub
Private Sub BTT_C_ADD_TO_BLACKLIST_Click(sender As Object, e As EventArgs) Handles BTT_C_ADD_TO_BLACKLIST.Click Private Sub BTT_C_ADD_TO_BLACKLIST_Click(sender As Object, e As EventArgs) Handles BTT_C_ADD_TO_BLACKLIST.Click
Try Try
Dim u$ = GetPostBySelected().UserID Dim u$ = GetPostBySelected().UserID
If Not u.IsEmptyString Then If Not u.IsEmptyString Then
Dim result% = MsgBoxE(New MMessage($"Do you really want to add user [{u}] to the BlackList?", Dim result% = MsgBoxE(New MMessage($"Are you sure you want to add user [{u}] to the BlackList?",
"Adding user to the BlackList", "Adding user to the BlackList",
{"Add", "Add and update ranges", {"Add", "Add and update ranges",
"Add with the reason", "Add with the reason and update ranges", "Add with the reason", "Add with the reason and update ranges",
@@ -753,7 +772,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
#End Region #End Region
Private Sub OpenPostPicture() Private Sub OpenPostPicture()
Dim f As SFile = GetPostBySelected().CachedFile Dim f As SFile = GetPostBySelected().CachedFile
If f.Exists Then f.Open() Else MsgBoxE($"Picture file [{f}] does not found", MsgBoxStyle.Critical) If f.Exists Then f.Open() Else MsgBoxE($"Picture file [{f}] not found", MsgBoxStyle.Critical)
End Sub End Sub
Private Function GetPostBySelected(Optional ByVal SpecificTag As String = Nothing) As UserPost Private Function GetPostBySelected(Optional ByVal SpecificTag As String = Nothing) As UserPost
Dim p As UserPost = Nothing Dim p As UserPost = Nothing
@@ -777,10 +796,10 @@ Friend Class ChannelViewForm : Implements IChannelLimits
#Region "MyRange" #Region "MyRange"
Private Sub ImagesCountChanged(ByVal Sender As Object, ByVal _Name As String, ByVal _Value As Object) Private Sub ImagesCountChanged(ByVal Sender As Object, ByVal _Name As String, ByVal _Value As Object)
AppendPendingUsers() AppendPendingUsers()
MyRange.Update(ImagesInRow * ImagesRows) MyRange.Limit = ImagesInRow * ImagesRows
MyRange.GoTo(0, EDP.SendInLog) MyRange.GoTo(0)
End Sub End Sub
Private Sub MyRange_IndexChanged(ByVal Index As Integer) Handles MyRange.IndexChanged Private Sub MyRange_IndexChanged(ByVal Sender As Object, ByVal e As EventArgs) Handles MyRange.IndexChanged
Try Try
If MyDefs.Initializing Then Exit Sub If MyDefs.Initializing Then Exit Sub
AppendPendingUsers() AppendPendingUsers()
@@ -810,8 +829,8 @@ Friend Class ChannelViewForm : Implements IChannelLimits
ErrorsDescriber.Execute(EDP.LogMessageValue, ex) ErrorsDescriber.Execute(EDP.LogMessageValue, ex)
End Try End Try
End Sub End Sub
Private Sub MyRange_RangesChanged(ByVal Sender As RangeSwitcher(Of UserPost)) Handles MyRange.RangesChanged Private Sub MyRange_RangesChanged(ByVal Sender As IRangeSwitcherProvider, ByVal e As EventArgs) Handles MyRange.RangesChanged
If Sender.Count > 0 Then MyRange_IndexChanged(0) If Sender.Count > 0 Then Sender.CurrentIndex = 0
End Sub End Sub
#End Region #End Region
End Class End Class

View File

@@ -55,15 +55,12 @@ Partial Friend Class ChannelsStatsForm : Inherits System.Windows.Forms.Form
'CMB_CHANNELS 'CMB_CHANNELS
' '
ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image) ActionButton1.BackgroundImage = CType(resources.GetObject("ActionButton1.BackgroundImage"), System.Drawing.Image)
ActionButton1.Index = 0 ActionButton1.Name = "Clear"
ActionButton1.Name = "BTT_COMBOBOX_ARROW"
ActionButton1.Visible = False
ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image) ActionButton2.BackgroundImage = CType(resources.GetObject("ActionButton2.BackgroundImage"), System.Drawing.Image)
ActionButton2.Index = 1 ActionButton2.Name = "Delete"
ActionButton2.Name = "BTT_CLEAR"
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image) ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Index = 2 ActionButton3.Name = "ArrowDown"
ActionButton3.Name = "BTT_DELETE" ActionButton3.Visible = False
Me.CMB_CHANNELS.Buttons.Add(ActionButton1) Me.CMB_CHANNELS.Buttons.Add(ActionButton1)
Me.CMB_CHANNELS.Buttons.Add(ActionButton2) Me.CMB_CHANNELS.Buttons.Add(ActionButton2)
Me.CMB_CHANNELS.Buttons.Add(ActionButton3) Me.CMB_CHANNELS.Buttons.Add(ActionButton3)

View File

@@ -122,6 +122,43 @@
</metadata> </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="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> <data name="ActionButton1.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGPC/xhBQAAABl0RVh0U29m
dHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVoSURBVEhLhZVrTJNXGMdfrtNSQIoadKRz2o0CorU3
WkDIVBRaaGNbwAteh+AARRQlitEYTTRekiX7sH3YPmyZH9wtziybigLRCWTaCW5sCBWhlrb0Ci9zSxbo
2f+UliGX7SS/tO85z/k9T57zXhhCCPO7Wh3VIhB83JKQ0Nu4bNlHm5YseZ1hmHC69n+Y5HLFcz7/ft/S
pY+vr1hhwL4oEBJcZ0x793If5uZ+1VNfT/qvXCHP6+p8tzMymqRxcW8hMGKqbDo9MlmWddu2AfbiRTJ6
+TIZKC52fyAUVi2JiYkLJmGaBYIPnx4+TPrOnCH9p08TC4LNx46RWwrF/ZXR0W/PleRZZuY669atZvbS
JcJiL9vQQEZPnSKmwkLPjcTE97GPB8KZlvh4C5X31dWRgRMniAVBtvPnyWB9ve+2XP7jmtjYpOlJTOnp
G60lJRZaOZWPQs4ePUpGUZh3xw7SnJDQhT0KEM3c5fOv9paVkX4kMAPL8ePEig1D584RG9rVpFS2rY6J
EQaTmKTSjbbiYsvIhQuERTGjKIrFvtHaWjK8fz9plsudexYu/BLxKsBj9ALBGzel0vt9e/b4XiBoENhQ
zRDOxIWWOY4cIS0KRZs4Nja5QyLJtRoM1pGzZ/0tYVExi/ayNTVkBPJ76enuJA7nM4j3gVWAHjgTIYqL
E96SStvMu3YR64EDxF5dTYYOHSJOJPNA5Kiu9rUrlZ1mrdbCnjzpr5jFGotYtqpqQi6TuVM4nKvwlYHU
gDzU31OMSGl8fPJtsbjVsn27z15RQRzAVVlJ3BB4kcx78CAZQbUjVIxrFtd+OdrbmpHhEXG5VE4rTwHz
wMRdFDw4jEgFj5dyRyRqsxYVEcfu3cQFPPv2ES8qHEbCYRzgsFZLvO+8Q7xKJXGDVoXCK46Ovob95YBW
Ph/8+xwE/wSTyHi81OZVq9qsGs2Ye8sW4srPJy6JhDgTE4kzOpo4IyKIMyyMOLhcX9Py5R4lj0cPtAKs
BBwwKfc7p174J5BEhHY9FIk6bBDaIRuiQkDFfsLDSbdU+pdBKPwe8e+BNDBD7vdNn6BYd+6stK5da7bP
nz9TDujcoEAw1lJY+CyFz9dCHDubnDJjwltRccS5fr3TjurnlIMBYE5NJY8Nhq7SrCwREsz6xL9y4S4v
b3Bt2uSyR0XNkDvQe9ouKu8HvaGh5FfQIxL5OgyG30qUStqmGUkm/3jKy0+48vLcs1XuiI8nL/Ly/rYl
JfmovCcgN4JW+l8iGe8oKuoqzcyckSQob3CpVB47l+sXv9KWxYtJt0r1x9ns7HZjQYHNnJxMfoH0EXgA
7oFm0CmTjRsNhs6Na9bQF+Tkq57xlJXVu9Rqz9Bs8kWLSG9BwcsqieQONlXnpaaWdul0z7rR+6C8CTSC
m8Aol4+36/XGT7VaevCRIIRx6/WWoQULZq2cyveLxY0IrAT0IHm1OTmZT3Q6U2da2qT8B/Ad+BZ05OSM
GXW6p4hdBiIZZ1FRt5vPn6vyuwiqCsj9Xyq6qXbDBkWnXm/6OS3NN1X+dUgIeZSdPXZPoxlEXC6IY9pL
S7faNBqXC9Iplf95YBb5ZF+RpGbdunQcbO/D1avJ9YC8LT19/Iv8/BeqpKRPEDORAGNeY3HxSYtG43Eq
FL5etfpljUzWhPlZ5VOTlGVliR+hHUbs+0mpHP9GpRqM5XAuY20zmGgRRohYKIx9rNd/3qfTOa7l5uLu
C63BvARw6fp0eRCMyBslJe8+2bx58EFhoVMlFNJvgQ4kgggQEgykvV0ApEAd+J3z8Z8KxmuA3pr0zikA
b4LJZ2FqYBigFdOPNf0NC679Fxi0OPr+XxiAJgwURph/AJfOQQebMR8TAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value> <value>
iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE65JREFUeF7t iVBORw0KGgoAAAANSUhEUgAAAgAAAAIACAYAAAD0eNT6AAAABGdBTUEAALGPC/xhBQAAE65JREFUeF7t
3X2sJWddB/DdLi2lQG2hdOHuvfM887J7Cxca4ELTQMDWKigIFpBAEAgi9g+CJpJo9Q8NJhgBiYZIYspL 3X2sJWddB/DdLi2lQG2hdOHuvfM887J7Cxca4ELTQMDWKigIFpBAEAgi9g+CJpJo9Q8NJhgBiYZIYspL
@@ -209,43 +246,6 @@
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA6LEtW/4flgYiLD1qeX0A AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA6LEtW/4flgYiLD1qeX0A
AAAASUVORK5CYII= AAAASUVORK5CYII=
</value>
</data>
<data name="ActionButton2.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xhBQAAAAlwSFlzAAAO
xAAADsQBlSsOGwAAAIZJREFUOE+1j10KwCAMgz2b755xl/IsvnaL2K20UfbDAmEako+ZROSTafjE12Go
tbbB43rK5xSAQq1VYFtmeQBoqZTSreVZvgTknM8yyyjA/qodsDF9gspD2Bj6B+DH+NqzhQQAG+POMnSX
AFuc5QFgn6ClHh5iOQVAKNixyucB8NY0vG9JOzzyhrdq5IRgAAAAAElFTkSuQmCC
</value>
</data>
<data name="ActionButton3.BackgroundImage" type="System.Drawing.Bitmap, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>
iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAABGdBTUEAALGPC/xhBQAAABl0RVh0U29m
dHdhcmUAQWRvYmUgSW1hZ2VSZWFkeXHJZTwAAAVoSURBVEhLhZVrTJNXGMdfrtNSQIoadKRz2o0CorU3
WkDIVBRaaGNbwAteh+AARRQlitEYTTRekiX7sH3YPmyZH9wtziybigLRCWTaCW5sCBWhlrb0Ci9zSxbo
2f+UliGX7SS/tO85z/k9T57zXhhCCPO7Wh3VIhB83JKQ0Nu4bNlHm5YseZ1hmHC69n+Y5HLFcz7/ft/S
pY+vr1hhwL4oEBJcZ0x793If5uZ+1VNfT/qvXCHP6+p8tzMymqRxcW8hMGKqbDo9MlmWddu2AfbiRTJ6
+TIZKC52fyAUVi2JiYkLJmGaBYIPnx4+TPrOnCH9p08TC4LNx46RWwrF/ZXR0W/PleRZZuY669atZvbS
JcJiL9vQQEZPnSKmwkLPjcTE97GPB8KZlvh4C5X31dWRgRMniAVBtvPnyWB9ve+2XP7jmtjYpOlJTOnp
G60lJRZaOZWPQs4ePUpGUZh3xw7SnJDQhT0KEM3c5fOv9paVkX4kMAPL8ePEig1D584RG9rVpFS2rY6J
EQaTmKTSjbbiYsvIhQuERTGjKIrFvtHaWjK8fz9plsudexYu/BLxKsBj9ALBGzel0vt9e/b4XiBoENhQ
zRDOxIWWOY4cIS0KRZs4Nja5QyLJtRoM1pGzZ/0tYVExi/ayNTVkBPJ76enuJA7nM4j3gVWAHjgTIYqL
E96SStvMu3YR64EDxF5dTYYOHSJOJPNA5Kiu9rUrlZ1mrdbCnjzpr5jFGotYtqpqQi6TuVM4nKvwlYHU
gDzU31OMSGl8fPJtsbjVsn27z15RQRzAVVlJ3BB4kcx78CAZQbUjVIxrFtd+OdrbmpHhEXG5VE4rTwHz
wMRdFDw4jEgFj5dyRyRqsxYVEcfu3cQFPPv2ES8qHEbCYRzgsFZLvO+8Q7xKJXGDVoXCK46Ovob95YBW
Ph/8+xwE/wSTyHi81OZVq9qsGs2Ye8sW4srPJy6JhDgTE4kzOpo4IyKIMyyMOLhcX9Py5R4lj0cPtAKs
BBwwKfc7p174J5BEhHY9FIk6bBDaIRuiQkDFfsLDSbdU+pdBKPwe8e+BNDBD7vdNn6BYd+6stK5da7bP
nz9TDujcoEAw1lJY+CyFz9dCHDubnDJjwltRccS5fr3TjurnlIMBYE5NJY8Nhq7SrCwREsz6xL9y4S4v
b3Bt2uSyR0XNkDvQe9ouKu8HvaGh5FfQIxL5OgyG30qUStqmGUkm/3jKy0+48vLcs1XuiI8nL/Ly/rYl
JfmovCcgN4JW+l8iGe8oKuoqzcyckSQob3CpVB47l+sXv9KWxYtJt0r1x9ns7HZjQYHNnJxMfoH0EXgA
7oFm0CmTjRsNhs6Na9bQF+Tkq57xlJXVu9Rqz9Bs8kWLSG9BwcsqieQONlXnpaaWdul0z7rR+6C8CTSC
m8Aol4+36/XGT7VaevCRIIRx6/WWoQULZq2cyveLxY0IrAT0IHm1OTmZT3Q6U2da2qT8B/Ad+BZ05OSM
GXW6p4hdBiIZZ1FRt5vPn6vyuwiqCsj9Xyq6qXbDBkWnXm/6OS3NN1X+dUgIeZSdPXZPoxlEXC6IY9pL
S7faNBqXC9Iplf95YBb5ZF+RpGbdunQcbO/D1avJ9YC8LT19/Iv8/BeqpKRPEDORAGNeY3HxSYtG43Eq
FL5etfpljUzWhPlZ5VOTlGVliR+hHUbs+0mpHP9GpRqM5XAuY20zmGgRRohYKIx9rNd/3qfTOa7l5uLu
C63BvARw6fp0eRCMyBslJe8+2bx58EFhoVMlFNJvgQ4kgggQEgykvV0ApEAd+J3z8Z8KxmuA3pr0zikA
b4LJZ2FqYBigFdOPNf0NC679Fxi0OPr+XxiAJgwURph/AJfOQQebMR8TAAAAAElFTkSuQmCC
</value> </value>
</data> </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">

View File

@@ -6,38 +6,22 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.ComponentModel
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls.Base Imports PersonalUtilities.Forms.Controls.Base
Imports PersonalUtilities.Forms.Toolbars Friend Class ChannelsStatsForm
Friend Class ChannelsStatsForm : Implements IOkCancelDeleteToolbar Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly MyDefs As DefaultFormProps
Friend Property DeletedChannels As Integer = 0 Friend Property DeletedChannels As Integer = 0
Friend Sub New() Friend Sub New()
InitializeComponent() InitializeComponent()
MyDefs = New DefaultFormProps MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub End Sub
Private Sub ChannelsStatsForm_Load(sender As Object, e As EventArgs) Handles Me.Load Private Sub ChannelsStatsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
Try With MyDefs
With MyDefs .MyViewInitialize()
.MyViewInitialize(Me, Settings.Design) .AddOkCancelToolbar()
.AddOkCancelToolbar() If Settings.Channels.Count > 0 Then RefillList() Else MsgBoxE("Channels not found", vbExclamation)
.DelegateClosingChecker() .EndLoaderOperations()
.MyOkCancel.EnableDelete = False End With
If Settings.Channels.Count > 0 Then
RefillList()
Else
MsgBoxE("Channels not found", vbExclamation)
End If
.AppendDetectors()
.EndLoaderOperations()
End With
Catch ex As Exception
MyDefs.InvokeLoaderError(ex)
End Try
End Sub
Private Sub ChannelsStatsForm_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
MyDefs.Dispose()
End Sub End Sub
Private Sub RefillList() Private Sub RefillList()
CMB_CHANNELS.Items.Clear() CMB_CHANNELS.Items.Clear()
@@ -47,19 +31,13 @@ Friend Class ChannelsStatsForm : Implements IOkCancelDeleteToolbar
CMB_CHANNELS.EndUpdate() CMB_CHANNELS.EndUpdate()
End If End If
End Sub End Sub
Private Sub ToolbarBttOK() Implements IOkCancelToolbar.ToolbarBttOK Private Sub MyDefs_ButtonDeleteClickOC(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonDeleteClickOC
MyDefs.CloseForm()
End Sub
Private Sub ToolbarBttCancel() Implements IOkCancelToolbar.ToolbarBttCancel
MyDefs.CloseForm(DialogResult.Cancel)
End Sub
Private Sub ToolbarBttDelete() Implements IOkCancelDeleteToolbar.ToolbarBttDelete
Try Try
Dim c As List(Of String) = CMB_CHANNELS.Items.CheckedItems.Select(Function(cc) CStr(cc.Value(1))).ListIfNothing Dim c As List(Of String) = CMB_CHANNELS.Items.CheckedItems.Select(Function(cc) CStr(cc.Value(1))).ListIfNothing
If c.ListExists Then If c.ListExists Then
If MsgBoxE({$"The following channels will be deleted:{vbCr}{c.ListToString(, vbCr)}", "Deleting channels"}, vbExclamation,,, {"Confirm", "Cancel"}) = 0 Then If MsgBoxE({$"The following channels will be deleted:{vbCr}{c.ListToString(vbCr)}", "Deleting channels"}, vbExclamation,,, {"Confirm", "Cancel"}) = 0 Then
For Each CID$ In c : Settings.Channels.Remove(Settings.Channels.Find(CID)) : Next For Each CID$ In c : Settings.Channels.Remove(Settings.Channels.Find(CID)) : Next
MyMainLOG = $"Deleted channels:{vbNewLine}{c.ListToString(, vbNewLine)}" MyMainLOG = $"Deleted channels:{vbNewLine}{c.ListToString(vbNewLine)}"
MsgBoxE("Channels deleted") MsgBoxE("Channels deleted")
DeletedChannels += c.Count DeletedChannels += c.Count
c.Clear() c.Clear()
@@ -78,7 +56,7 @@ Friend Class ChannelsStatsForm : Implements IOkCancelDeleteToolbar
Private Sub CMB_CHANNELS_ActionOnChangeDetected(ByVal c As Boolean) Handles CMB_CHANNELS.ActionOnChangeDetected Private Sub CMB_CHANNELS_ActionOnChangeDetected(ByVal c As Boolean) Handles CMB_CHANNELS.ActionOnChangeDetected
If Not MyDefs.Initializing Then MyDefs.MyOkCancel.EnableDelete = CMB_CHANNELS.ListCheckedIndexes.Count > 0 If Not MyDefs.Initializing Then MyDefs.MyOkCancel.EnableDelete = CMB_CHANNELS.ListCheckedIndexes.Count > 0
End Sub End Sub
Private Sub CMB_CHANNELS_ActionOnButtonClearClick() Handles CMB_CHANNELS.ActionOnButtonClearClick Private Sub CMB_CHANNELS_ActionOnButtonClick(ByVal Sender As ActionButton, ByVal e As EventArgs) Handles CMB_CHANNELS.ActionOnButtonClick
CMB_CHANNELS.ListCheckedIndexes = Nothing If Sender.DefaultButton = ActionButton.DefaultButtons.Clear Then CMB_CHANNELS.ListCheckedIndexes = Nothing
End Sub End Sub
End Class End Class

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 345 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 7.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 490 B

View File

@@ -36,8 +36,8 @@ Namespace DownloadObjects
Me.TP_MAIN.Location = New System.Drawing.Point(0, 0) Me.TP_MAIN.Location = New System.Drawing.Point(0, 0)
Me.TP_MAIN.Name = "TP_MAIN" Me.TP_MAIN.Name = "TP_MAIN"
Me.TP_MAIN.RowCount = 1 Me.TP_MAIN.RowCount = 1
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 62.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 64.0!))
Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 62.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 64.0!))
Me.TP_MAIN.Size = New System.Drawing.Size(434, 61) Me.TP_MAIN.Size = New System.Drawing.Size(434, 61)
Me.TP_MAIN.TabIndex = 0 Me.TP_MAIN.TabIndex = 0
' '

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