Compare commits

...

19 Commits

Author SHA1 Message Date
Andy
85d8df96ca 2023.3.1.0
Add 'Path' plugin
UserDataBase: changed file names for saved posts; removed 'Self' property; add 'MyFileSettings' field; added UserSiteName; changed download envir algo
Twitter: added MD5 comparison; duplicate images removal option; UserSiteName parsing; download icon and banner
Instagram: added a new option for token 'www_claim'; removed requirement of token 'www_claim'; UserSiteName parsing; download icon
Reddit: UserSiteName parsing; download icon and banner
PornHub: fixed unicode titles
XHamster: added channels
ffmpeg: fixed max input length error during files combining; fixed encoding issue
Feed: added images centering; added BackColor and ForeColor change
MainFrame: added BackColor, ForeColor, and BackgroungImage change; added 'UpdateLogButton' when load completed
ListImagesLoader: fixed wrong notification when no users found
SettingsCLS: updated users loading algo
2023-03-01 20:35:52 +03:00
Andy
6ca90f0489 Update names 2023-02-25 10:19:18 +03:00
Andy
2a780a3acf Update README.md 2023-02-13 11:44:00 +03:00
Andy
290b5c4586 2023.2.5.0
Update to library environment
GlobalSettings: add UserAgent
Gfycat: fix RedGifs urls issue
2023-02-05 20:58:02 +03:00
Andy
f5e68a7032 Update Changelog.md 2023-01-28 05:50:07 +03:00
Andy
ece573dd40 Update README.md 2023-01-28 05:48:54 +03:00
Andy
1f1148020c 2023.1.27.0
Plugins: added 'Interaction' to 'Provider' attribute; added 'IPropertyProvider' interface
Hosts: update classes to work with new options
Instagram: fixed pinned post reload
Twitter: advanced options for GIFs
UserCreatorForm: change icon based on the selected site
UserSearchForm: change search function
2023-01-27 16:43:57 +03:00
Andy
fc226d549a 2023.1.24.1
Some Imgur albums won't download
Added icon for standalone downloader
2023-01-24 16:13:46 +03:00
Andy
602771d982 2023.1.24.0
Imgur albums not downloading
Collections: users in the collection are not banned
2023-01-24 06:05:40 +03:00
Andy
3e472b4f2b Update HowToSupport.md 2023-01-13 00:21:48 +03:00
Andy
30c3fe3b68 Update info
Update info
2023-01-12 07:38:17 +03:00
Andy
38c81b7a0b 2022.1.2.0
Redgifs: added token refresh interval; reduced interval value
Updated labels collection
PornHub: fixed bugs
Notifications: pressing any button opens SCrawler
User list loader finished
2023-01-02 18:53:24 +03:00
Andy
0fb6add751 Update UserData.vb 2022-12-27 15:19:40 +03:00
Andy
5d64b8c7ce 2022.12.27.0
XVideos: added 'Quickies'; fixed downloading.
Instagram: added more enable/disable options.
2022-12-27 15:04:56 +03:00
Andy
aabf6d62ab 2022.12.26.0
UserMedia: fixed plugin bugs
Instagram: updated algo and settings; update responser settings based on site response
PornHub: fixed bug in SiteSettings; fixed typos
RedGis: fixed downloading user profiles
XVideos: fixed user profile opening
UserDataBind: fixed multiple collection removing issue
DownloadedInfoForm: fixed user focusing
UserCreatorForm: add user name to form header if user exists
ListImagesLoader: changed loading algo
MainFrame: added channels button to tray context menu
Added ffmpeg fox x86
Fixed typos
2022-12-26 17:37:25 +03:00
Andy
03487185c5 Update names
Updated library objects
2022-12-24 15:45:12 +03:00
Andy
f0686bbc8e Fixes
Fixed typo
Added label icon to context menu
Fixed PornHub bug
Added 'Object' to IUserMedia
2022-12-24 15:18:04 +03:00
Andy
bdc7321331 2022.11.16.0
Add sites: PornHub, XHamster
Add saved xvideos posts downloading
PluginProvider: added TaskGroup attribute; added IUserMedia inteface; changed PluginUserMedia to IUserMedia in interface declarations; changed 'User' String to IPluginContentProvider in ISiteSettings sinterface
Added update the 'LOG' button at the end of the ProfileSaved download function
API.Base: added 'IUserMedia' compatibility for 'UserMedia'; moved 'GetImage' from 'UserPost' to 'ChannelsViewForm'; update constants in UserDataBase; updated UserDataBase to new UserInfo environment.
API.Instagram.UserData: fixed date issue
API.Reddit.SiteSettings: update user patterns
API.Twitter.Declarations: moved provider here from MainFrame
UserDataBind: updated to new UserInfo environment
ActiveDownloadingProgress: updated form rendering
AutoDownloader: added SpecialDelay
TDownloader: added 'Suspended' option; updated for TaskGroups
CollectionEditorForm: fixed order bug
LabelsForm: remove old stuff
UserEditorForm: added collection editing
MainFrame: improve label selection
Add import users
Added the ability to create a virtual collection and add a virtual user to a real collection
SettingsCLS: improve users loading
2022-11-16 13:41:45 +03:00
Andy
7d169acebc 2022.10.23.0
PluginProvider: added 'DoNotUse' attribute.
Channels: copying a channel to the 'ChannelsDeleted' folder before deleting.
Twitter: updated status codes.
AutoDownloader: removed base parameters initialization; updated 'ToEContainer' function; 'StartupDelay' default value = 1; added IIndexable; fixed NextExecutionDate; added task delay based on index and tasks count; updated user selections algorithms.
MainFrame: coloring the button 'Download All' depending on the pause; updated user selections algorithms.
DownloadGroups: added LabelsExcluded, Sites and SitesExcluded; updated initialization; updated ToEContainer function; updated user selections algorithms
IGroup, GroupParameters: added LabelsExcluded, Sites and SitesExcluded; added Import and Export functions
Removed TrayIcon notifications. All notifications are now ToastNotifications.
SettingsHost: 'DoNotUse' attribute
Settings: added 'GetUsers' predicate function
2022-10-23 16:39:01 +03:00
152 changed files with 7416 additions and 2355 deletions

1
.gitignore vendored
View File

@@ -34,6 +34,7 @@ bld/
[Ll]og/ [Ll]og/
[Ll]ogs/ [Ll]ogs/
ffmpeg/ ffmpeg/
cURL/
Info/ Info/
Hidden/ Hidden/

View File

@@ -8,14 +8,16 @@ I welcome requests! Follow these steps to contribute:
1. If you have a code change suggestion, you can post a replacement code block. I also accept pull requests. 1. If you have a code change suggestion, you can post a replacement code block. I also accept pull requests.
# How to build from source # How to build from source
1. Delete the "PersonalUtilities" project from the solution. 1. Delete the ```PersonalUtilities``` project from the solution.
1. Delete the "PersonalUtilities.Notifications" project from the solution. 1. Delete the ```PersonalUtilities.Notifications``` project from the solution.
1. Delete the ```cURL``` folder from the solution.
1. Delete the ```ffmpeg.exe``` from the solution.
1. The following libraries must be added to project references with the '**Copy to output folder**' option: 1. The following libraries must be added to project references with the '**Copy to output folder**' option:
- ```PersonalUtilities.dll``` - ```PersonalUtilities.dll```
- ```PersonalUtilities.Notifications.dll``` - ```PersonalUtilities.Notifications.dll```
- ```Microsoft.Toolkit.Uwp.Notifications.dll``` - ```Microsoft.Toolkit.Uwp.Notifications.dll```
- ```System.ValueTuple.dll``` - ```System.ValueTuple.dll```
1. Import PersonalUtilities.Functions for the whole project. 1. Import ```PersonalUtilities.Functions``` for the whole project.
**Always use the correct libraries. You must download libraries from the same release date as the code commit date.** **Always use the correct libraries. You must download libraries from the same release date as the code commit date.**

View File

@@ -1,3 +1,166 @@
# 2023.3.1.0
*2023-03-01*
- Added
- **Path plugin.** Now you can add paths. *This may be suitable if you want to add a collection of media data to a specific user collection.*
- MainWindow: setting a background image
- MainWindow: setting background color and font color
- Feed: setting background color and font color
- Feed: (Request #108) center the image in the feed grid
- Users: the ability to use user site name (if it exists) as a friendly name (on supported sites: Reddit, Twitter, Instagram)
- Users: the ability to update user site name every time
- Twitter: ability to download images using MD5 comparison to protect against duplicate downloads *(this may be suitable for the users who post the same image many times)*
- Twitter: one-time duplicate image removal option
- XHamster: (Request #107) added channels downloading
- Updated
- Updated ffmpeg to version [5.1.2](https://github.com/GyanD/codexffmpeg/releases/tag/5.1.2)
- Fixed
- PornHub: (Issue #106) unicode titles
- (Issue #106) problem with non-Latin characters
- ffmpeg: maximum input length error when merging parts of files
# 2023.2.5.0
*2023-02-05*
- Added
- The ability to configure UserAgent
- Fixed
- (Issue #101) Failed download Gfycat video in some cases
# 2023.1.27.0
*2023-01-27*
- Added
- Advanced Twitter options for GIFs
- Changing the icon of the user creation form based on the selected site
- Fixed
- Pinned Instagram posts reload every time
- Plugins
- Added
- `Interaction` option to the `Provider` attribute
- `IPropertyProvider` interface
# 2023.1.24.1
*2023-01-24*
- Added
- Icon for standalone downloader
- Fixed
- (Issue #100) some Imgur albums won't download
# 2023.1.24.0
*2023-01-24*
- Fixed
- (Issue #100) Imgur albums not downloading
- When deleting a collection with the 'ban' option, users in the collection are not banned
# 2023.1.2.0
*2023-01-02*
- Added
- RedGifs: an ability to customize token refresh interval
- RedGifs: token refresh interval changed from 24 hours to 12 hours
- Updated labels collection
- Fixed
- PornHub: bug in the downloader
- PornHub: download additional non-user videos
- Reddit: bug in standalone downloader
- Fixed a bug in the user list loading algorithm
- Notifications: pressing any button opens SCrawler
# 2022.12.27.0
*2022-12-27*
- Added
- XVideos: added downloading 'Quickies'
- Instagram: added more enable/disable options
- Fixed
- XVideos not downloading (sorry, I broke it in a previous release)
# 2022.12.26.0
*2022-12-26*
**ATTENTION!**
**Instagram requirements changed. Headers and cookies are now required to download Timeline, Stories and Saved posts; hash to download tagged posts. Please update your credentials.**
**Instagram tagged posts no longer provide the total amount of tagged posts. I've corrected the tagged posts notification, but now I can't tell how many requests will be spent on downloading tagged posts. And from now on, one request will be spent on downloading each tagged post, because Instagram doesn't provide complete information about the tagged post with the site's response. In this case, if the number of tagged posts is 1000, 1000 requests will be spent. Be careful when downloading them. I highly recommend that you forcefully disable the downloading of tagged posts for a while.**
- Added
- Updated user loading algorithm
- Channels button to tray context menu
- (Request #96) Add FFmpeg to x86 version
- Fixed
- PornHub wrong behavior when downloading images
- Unable open XVideos user profile
- Cannot delete multiple collections at once
- Can't focus user from the download info form
- Instagram downloader not working
- (Issue #69) **RedGifs data is not downloading**. Again.
- Minor bugs
# 2022.11.16.0
*2022-11-16*
**ATTENTION! This version makes changes to the base SCrawler user configuration file. Since you started using this version, you still can downgrade. BUT! Once you add a virtual collection or a virtual user to a collection, you won't be able to downgrade without losing data.**
- Added
- **PornHub**
- **XHamster**
- An ability to download saved XVIDEOS posts
- Download indicator. While downloading, the rainbow tray icon changed to a blue arrow.
- Collections: the ability to edit a collection using a form
- Collections: the ability to create a **`virtual collection`** and add a **`virtual user`** to a real collection
- Collections: an easier way to added users to a collection
- Collections: an easier way to create collections
- Added icons for channels form context menu buttons
- More convenient change of user labels from the context menu of the user list
- Notifications: complete transition from default notifications to ToastNotifications
- Notifications: when you click on the notification that some of the channels are downloaded, the channels form opens
- Notifications: when you click on the notification that all users are downloaded, the main window form opens
- Notifications: when you click on the notification that the saved posts are downloaded, the saved posts form opens
- Import users
- Minor improvements
- Plugins
- Added
- `TaskGroup` attribute
- `IUserMedia` interface
- Changed
- `GetUserUrl` and `GetUserPostUrl` functions: `String UserName` and `String UserID` changed to ` IPluginContentProvider User`
- Fixed
- Collections editor: new added collections are still not added to the top of the collections list
- Users search form doesn't remember last size
- Minor bugs
# 2022.10.23.0
*2022-10-23*
- Added
- RedGifs token Auto-Renewal
- Download groups: ability to select sites
- Download groups: ability to exclude labels and sites
- AutoDownloader: ability to exclude labels and sites in ```All```, ```Default``` and ```Specified``` modes
- The ```Download All``` button turns blue when pause is enabled
- Updated Twitter status codes
- Minor improvements
- Fixed
- Updated Twitter status codes
- AutoDownloader: incorrect next run date in scheduler task information
- AutoDownloader: minor bugs
- (Issue #69) **RedGifs data is not downloading**. Requires token.
- Minor bugs
# 2022.10.18.0 # 2022.10.18.0
*2022-10-18* *2022-10-18*

2
FAQ.md
View File

@@ -42,7 +42,7 @@ A: How to request a new site you can read [here](CONTRIBUTING.md#how-to-request-
#### Q: **Twitter/Instagram download failed.** #### Q: **Twitter/Instagram download failed.**
A: Check your credentials. Both of these sites require cookies. Check your [Twitter tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) and [Instagram settings](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram-settings). If all settings are set, but nothing works, go to [create a new issue](https://github.com/AAndyProgram/SCrawler/issues). Don't forget to attach the LOG. A: Check your credentials. Both of these sites require cookies. Check your [Twitter tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) and [Instagram settings](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram). If all settings are set, but nothing works, go to [create a new issue](https://github.com/AAndyProgram/SCrawler/issues). Don't forget to attach the LOG.
**[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)** **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**

View File

@@ -1,11 +1,12 @@
Your support is very valuable to me. Any support is greatly appreciated. Your support encourages me to make new features, update the program, add new sites, etc. Your support is very valuable to me. Any support is greatly appreciated. Your support encourages me to make new features, update the program, add new sites, etc.
You can support the program by: You can support the program by:
- **Bitcoin**: bitcoin:BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET - **Bitcoin**: BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET
- :heavy_dollar_sign: make a donation 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/
- :heart: like the program on this site: https://www.softpedia.com/get/Internet/Download-Managers/Social-networks-crawler.shtml
- 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:

Binary file not shown.

Before

Width:  |  Height:  |  Size: 7.4 KiB

After

Width:  |  Height:  |  Size: 9.2 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 7.7 KiB

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 23 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 11 KiB

After

Width:  |  Height:  |  Size: 11 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 17 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 11 KiB

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 28 KiB

After

Width:  |  Height:  |  Size: 27 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 5.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 20 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 15 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 6.9 KiB

After

Width:  |  Height:  |  Size: 6.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 7.0 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 3.6 KiB

After

Width:  |  Height:  |  Size: 4.3 KiB

View File

@@ -68,7 +68,7 @@ https://github.com/RipMeApp/ripme
| **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 10+ | 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 | 6 internal and any site using plugins | 86+ sites (declared) | | Suported sites | 9 internal and any site using plugins | 86+ sites (declared) |
| Other sites support | **Yes** | No | | Other sites support | **Yes** | No |
| Still supported | **Yes** | **No (last release date May 4, 2021)** | | Still supported | **Yes** | **No (last release date May 4, 2021)** |

View File

@@ -2,49 +2,53 @@
[![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest) [![GitHub release (latest by date)](https://img.shields.io/github/v/release/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/releases/latest)
[![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE) [![GitHub license](https://img.shields.io/github/license/AAndyProgram/SCrawler)](https://github.com/AAndyProgram/SCrawler/blob/main/LICENSE)
[![GitHub all releases](https://img.shields.io/github/downloads/aandyprogram/scrawler/total?label=Total%20downloads)](https://github.com/AAndyProgram/SCrawler/releases)
[![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)
A program to download photo and video from [any site](#supported-sites) (e.g. Reddit, Twitter, Instagram, TikTok, RedGifs, XVIDEOS, LPSG). A program to download photo and video from [any site](#supported-sites) (e.g. Reddit, Twitter, Instagram, TikTok, RedGifs, PornHub, XHamster, XVIDEOS, LPSG).
**If you like SCrawler, please like the program on [this site]( https://alternativeto.net/software/scrawler/about/)** **If you like SCrawler, please like the program on [this site](https://alternativeto.net/software/scrawler/about/) and/or [this](https://www.softpedia.com/get/Internet/Download-Managers/Social-networks-crawler.shtml)**
Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush: Do you like this program? Consider adding to my coffee fund by making a donation to show your support. :blush:
[![ko-fi](https://www.ko-fi.com/img/githubbutton_sm.svg)](https://ko-fi.com/andyprogram) [![ko-fi](https://www.ko-fi.com/img/githubbutton_sm.svg)](https://ko-fi.com/andyprogram)
**Bitcoin**: bitcoin:BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET **Bitcoin**: BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET
![Main window](ProgramScreenshots/MainWindow.png) ![Main window](ProgramScreenshots/MainWindow.png)
![Channels window](ProgramScreenshots/Channels.png) ![Channels window](ProgramScreenshots/Channels.png)
# What can program do: # What can program do:
- Download pictures and videos from users' profiles and subreddits: - Download pictures and videos from users' profiles and subreddits:
- Reddit images, galleries of images, videos (downloading Reddit hosted video is going through ffmpeg (**ffmpeg only works with the x64 program**)); - Reddit images, galleries of images, videos, saved posts;
- Redgifs videos (https://www.redgifs.com/); - Redgifs videos (https://www.redgifs.com/);
- Twitter images and videos; - Twitter images and videos, saved (bookmarked) posts;
- Instagram images and videos, tagged posts, stories; - Instagram images and videos, tagged posts, stories, saved posts;
- TikTok videos ([limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits)); - TikTok videos ([limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits));
- Imgur images, galleries and videos; - Imgur images, galleries and videos;
- Gfycat videos; - Gfycat videos;
- PornHub images, videos, save (liked) posts;
- XHamster images, videos, saved posts;
- XVIDEOS 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, Twitter 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**
- **Automation** (downloading data automatically every ```X``` minutes) - **Automation** ([downloading data automatically](https://github.com/AAndyProgram/SCrawler/wiki/Settings#automation) every ```X``` minutes)
- **Feed** (feed of downloaded media files) - **Feed** ([feed](https://github.com/AAndyProgram/SCrawler/wiki#feed) of downloaded media files)
- Labeling users - Labeling users
- Create download groups - Create [download groups](https://github.com/AAndyProgram/SCrawler/wiki/Settings#download-groups)
- Adding users to favorites and temporary - Adding users to favorites and temporary
- Filter exists users by label or group - [Filter exists users](https://github.com/AAndyProgram/SCrawler/wiki#view) 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](https://github.com/AAndyProgram/SCrawler/wiki#download-separate-video), image or gallery
- Making collections (grouping users into collections) - Making [collections](https://github.com/AAndyProgram/SCrawler/wiki#collections) (grouping users into collections)
- Specifying a user folder (for downloading data to another location) - Specifying a user folder (for downloading data to another location)
- Changing user icons - Changing user icons
- Changing view modes - Changing [view modes](https://github.com/AAndyProgram/SCrawler/wiki#view)
- ...and many others... - ...and many others...
# Supported sites # Supported sites
@@ -57,7 +61,9 @@ Do you like this program? Consider adding to my coffee fund by making a donation
- Imgur - Imgur
- Gfycat - Gfycat
- LPSG - LPSG
- XVIDEOS - **PornHub**
- **XHamster**
- **XVIDEOS**
- [Other sites](Plugins.md) - [Other sites](Plugins.md)
**[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)** **[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
@@ -68,11 +74,11 @@ First, the program downloads the full profile. After the program downloads only
## Reddit ## Reddit
The program parses all user posts, obtain MD5 images hash and compares them with existing ones to remove duplicates. Then the media will be downloaded. The program parses user posts, obtain MD5 images hash and compares them with existing ones to remove duplicates. Then the media will be downloaded.
## Other sites ## Other sites
The program parses all user posts and compares file names with existing ones to remove duplicates. Then the media will be downloaded. The program parses user posts and compares file names with existing ones to remove duplicates. Then the media will be downloaded.
## How to request a new site ## How to request a new site
@@ -105,6 +111,8 @@ Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about
- [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram) - [Instagram](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram)
- [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok) - [TikTok](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok)
- [RedGifs](https://github.com/AAndyProgram/SCrawler/wiki/Settings#redgifs) - [RedGifs](https://github.com/AAndyProgram/SCrawler/wiki/Settings#redgifs)
- [PornHub](https://github.com/AAndyProgram/SCrawler/wiki/Settings#pornhub)
- [XHamster](https://github.com/AAndyProgram/SCrawler/wiki/Settings#xhamster)
- [XVIDEOS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#xvideos) - [XVIDEOS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#xvideos)
- [LPSG](https://github.com/AAndyProgram/SCrawler/wiki/Settings#lpsg) - [LPSG](https://github.com/AAndyProgram/SCrawler/wiki/Settings#lpsg)
@@ -112,7 +120,7 @@ Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about
# Installation # Installation
**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: **Just download the [latest release](https://github.com/AAndyProgram/SCrawler/releases/latest), unzip the program archive to any folder and enjoy.** :blush:
**Don't put program in the ```Program Files``` system folder (this is portable program and program settings are stored in the program folder)** **Don't put program in the ```Program Files``` system folder (this is portable program and program settings are stored in the program folder)**
@@ -120,17 +128,11 @@ Read [here](CONTRIBUTING.md#how-to-request-a-new-site) about
Just download [latest](https://github.com/AAndyProgram/SCrawler/releases/latest) version and unpack it into the program folder. **Before starting a new version, I recommend making a backup copy of the program settings folder.** Just download [latest](https://github.com/AAndyProgram/SCrawler/releases/latest) version and unpack it into the program folder. **Before starting a new version, I recommend making a backup copy of the program settings folder.**
# How to build from source # [How to build from source](CONTRIBUTING.md#how-to-build-from-source)
Read about how to build from source [here](CONTRIBUTING.md#how-to-build-from-source) # [How to make a plugin](https://github.com/AAndyProgram/SCrawler/wiki/Plugins)
# How to make a plugin # [How to support](HowToSupport.md)
Read about how to make plugin [here](https://github.com/AAndyProgram/SCrawler/wiki/Plugins).
# How to support
Read more about how to support the program [here](HowToSupport.md).
# Settings and usage # Settings and usage
@@ -150,4 +152,10 @@ Create a shortcut for the program. Open shortcut properties. In the ```Shortcut`
Example: ```D:\Programs\SCrawler\SCrawler.exe v``` Example: ```D:\Programs\SCrawler\SCrawler.exe v```
![Separate video downloader](ProgramScreenshots/SeparateVideoDownloader.png) ![Separate video downloader](ProgramScreenshots/SeparateVideoDownloader.png)
# Contact me
[![matrix](https://img.shields.io/badge/Matrix-%40andyprogram%3Amatrix.org-informational)](https://matrix.to/#/@andyprogram:matrix.org)
[![discord](https://img.shields.io/badge/discord-AndyProgram%233804-yellowgreen)](https://discordapp.com/users/1012768226679206009) AndyProgram#3804

View File

@@ -53,6 +53,9 @@ Namespace Plugin.Attributes
ElementName = XMLElementName ElementName = XMLElementName
End Sub End Sub
End Class End Class
''' <summary>Attribute to disable some properties for host use</summary>
<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class DoNotUse : Inherits Attribute
End Class
''' <summary>Special property updater</summary> ''' <summary>Special property updater</summary>
<AttributeUsage(AttributeTargets.Method, AllowMultiple:=True, Inherited:=False)> Public NotInheritable Class PropertyUpdater : Inherits Attribute <AttributeUsage(AttributeTargets.Method, AllowMultiple:=True, Inherited:=False)> Public NotInheritable Class PropertyUpdater : Inherits Attribute
Public ReadOnly Name As String Public ReadOnly Name As String
@@ -97,6 +100,8 @@ Namespace Plugin.Attributes
''' <see langword="False"/> - only for conversion ''' <see langword="False"/> - only for conversion
''' </summary> ''' </summary>
Public FieldsChecker As Boolean = False Public FieldsChecker As Boolean = False
''' <summary>Interaction with changing text field. Default: <see langword="False"/></summary>
Public Interaction As Boolean = False
''' <summary>Initialize a new Provider attribute. <see cref="IFormatProvider"/> is only allowed</summary> ''' <summary>Initialize a new Provider attribute. <see cref="IFormatProvider"/> is only allowed</summary>
''' <param name="PropertyName">The name of the property for which this provider is used</param> ''' <param name="PropertyName">The name of the property for which this provider is used</param>
Public Sub New(ByVal PropertyName As String) Public Sub New(ByVal PropertyName As String)
@@ -129,13 +134,26 @@ Namespace Plugin.Attributes
''' Predefined task counter.<br/> ''' Predefined task counter.<br/>
''' <see cref="TaskCounter"/> will take precedence if it is defined. ''' <see cref="TaskCounter"/> will take precedence if it is defined.
''' </param> ''' </param>
Public Sub New(Optional ByVal JobsCount As Integer = -1) Public Sub New(Optional ByVal TasksCount As Integer = -1)
TasksCount = JobsCount Me.TasksCount = TasksCount
End Sub End Sub
End Class End Class
''' <summary>A property attribute that specifies how many users should be downloaded at the same time in one thread</summary> ''' <summary>A property attribute that specifies how many users should be downloaded at the same time in one thread</summary>
<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class TaskCounter : Inherits Attribute <AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class TaskCounter : Inherits Attribute
End Class End Class
''' <remarks>
''' This attribute cannot be combined with <see cref="SeparatedTasks"/>.
''' If set to <see cref="SeparatedTasks"/>, this attribute will be ignored
''' </remarks>
''' <inheritdoc cref="SeparatedTasks"/>
<AttributeUsage(AttributeTargets.Class, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class TaskGroup : Inherits Attribute
Public ReadOnly Name As String
''' <summary>Initialize a new TaskGroup attribute.</summary>
''' <param name="Name">Group name</param>
Public Sub New(ByVal Name As String)
Me.Name = Name
End Sub
End Class
''' <summary>This attribute indicates that the plugin has a SavedPosts environment</summary> ''' <summary>This attribute indicates that the plugin has a SavedPosts environment</summary>
<AttributeUsage(AttributeTargets.Class, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class SavedPosts : Inherits Attribute <AttributeUsage(AttributeTargets.Class, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class SavedPosts : Inherits Attribute
End Class End Class

View File

@@ -17,9 +17,9 @@ Namespace Plugin
Property ID As String Property ID As String
Property ParseUserMediaOnly As Boolean Property ParseUserMediaOnly As Boolean
Property UserDescription As String Property UserDescription As String
Property ExistingContentList As List(Of PluginUserMedia) Property ExistingContentList As List(Of IUserMedia)
Property TempPostsList As List(Of String) Property TempPostsList As List(Of String)
Property TempMediaList As List(Of PluginUserMedia) Property TempMediaList As List(Of IUserMedia)
Property UserExists As Boolean Property UserExists As Boolean
Property UserSuspended As Boolean Property UserSuspended As Boolean
Property IsSavedPosts As Boolean Property IsSavedPosts As Boolean

View File

@@ -18,12 +18,12 @@ Namespace Plugin
ReadOnly Property Image As Image ReadOnly Property Image As Image
ReadOnly Property Site As String ReadOnly Property Site As String
Property Logger As ILogProvider Property Logger As ILogProvider
Function GetUserUrl(ByVal UserName As String, ByVal Channel As Boolean) As String Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
Function IsMyUser(ByVal UserURL As String) As ExchangeOptions Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
Function GetInstance(ByVal What As Download) As IPluginContentProvider Function GetInstance(ByVal What As Download) As IPluginContentProvider
Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String Function GetUserPostUrl(ByVal User As IPluginContentProvider, ByVal Media As IUserMedia) 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

View File

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

View File

@@ -0,0 +1,13 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace Plugin
Public Interface IPropertyProvider : Inherits IFormatProvider
Property PropertyName As String
End Interface
End Namespace

View File

@@ -7,25 +7,46 @@
' 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
Namespace Plugin Namespace Plugin
Public Structure PluginUserMedia Public Enum UserMediaTypes As Integer
Enum Types As Integer Undefined = 0
Undefined = 0 [Picture] = 1
[Picture] = 1 [Video] = 2
[Video] = 2 [Text] = 3
[Text] = 3 VideoPre = 10
VideoPre = 10 GIF = 50
GIF = 50 m3u8 = 100
m3u8 = 100 End Enum
End Enum Public Enum UserMediaStates As Integer
Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : Missing = 4 : End Enum Unknown = 0
Public ContentType As Integer Tried = 1
Public URL As String Downloaded = 2
Public MD5 As String Skipped = 3
Public File As String Missing = 4
Public DownloadState As Integer End Enum
Public PostID As String Public Structure PluginUserMedia : Implements IUserMedia
Public PostDate As Date? Public Property ContentType As Integer Implements IUserMedia.ContentType
Public SpecialFolder As String Public Property URL As String Implements IUserMedia.URL
Public Attempts As Integer Public Property URL_BASE As String Implements IUserMedia.URL_BASE
Public Property MD5 As String Implements IUserMedia.MD5
Public Property File As String Implements IUserMedia.File
Public Property DownloadState As Integer Implements IUserMedia.DownloadState
Public Property PostID As String Implements IUserMedia.PostID
Public Property PostDate As Date? Implements IUserMedia.PostDate
Public Property SpecialFolder As String Implements IUserMedia.SpecialFolder
Public Property Attempts As Integer Implements IUserMedia.Attempts
Public Property [Object] As Object Implements IUserMedia.Object
End Structure End Structure
Public Interface IUserMedia
Property ContentType As Integer
Property URL As String
Property URL_BASE As String
Property MD5 As String
Property File As String
Property DownloadState As Integer
Property PostID As String
Property PostDate As Date?
Property SpecialFolder As String
Property Attempts As Integer
Property [Object] As Object
End Interface
End Namespace End Namespace

View File

@@ -102,6 +102,7 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Attributes\Attributes.vb" /> <Compile Include="Attributes\Attributes.vb" />
<Compile Include="ObjectInterfaces\IPropertyProvider.vb" />
<Compile Include="Objects\ExchangeOptions.vb" /> <Compile Include="Objects\ExchangeOptions.vb" />
<Compile Include="ObjectInterfaces\ILogProvider.vb" /> <Compile Include="ObjectInterfaces\ILogProvider.vb" />
<Compile Include="Interfaces\IPluginContentProvider.vb" /> <Compile Include="Interfaces\IPluginContentProvider.vb" />

View File

@@ -9,5 +9,8 @@
Namespace API.Base Namespace API.Base
Friend Module Declarations Friend Module Declarations
Friend ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly) Friend ReadOnly LNC As New ListAddParams(LAP.NotContainsOnly)
Friend ReadOnly TitleHtmlConverter As Func(Of String, String) =
Function(Input) SymbolsConverter.HTML.Decode(SymbolsConverter.Convert(Input, EDP.ReturnValue), EDP.ReturnValue).
StringRemoveWinForbiddenSymbols().StringTrim()
End Module End Module
End Namespace End Namespace

View File

@@ -0,0 +1,64 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web
Imports PersonalUtilities.Tools.Web.Clients
Namespace API.Base
Namespace M3U8Declarations
Friend Module M3U8Defaults
Friend ReadOnly TsFilesRegEx As RParams = RParams.DM(".+?\.ts[^\r\n]*", 0, RegexReturn.List)
End Module
End Namespace
Friend NotInheritable Class M3U8Base
Private Sub New()
End Sub
Friend Shared Function CreateUrl(ByVal Appender As String, ByVal File As String) As String
File = File.StringTrimStart("/")
If File.StartsWith("http") Then
Return File
Else
If File.StartsWith("hls/") And Appender.Contains("hls/") Then _
Appender = LinkFormatterSecure(Appender.Replace("https://", String.Empty).Split("/").First)
Return $"{Appender.StringTrimEnd("/")}/{File}"
End If
End Function
Friend Shared Function Download(ByVal URLs As List(Of String), ByVal DestinationFile As SFile, Optional ByVal Responser As Responser = Nothing) As SFile
Dim CachePath As SFile = Nothing
Try
If URLs.ListExists Then
Dim ConcatFile As SFile = DestinationFile
If ConcatFile.Name.IsEmptyString Then ConcatFile.Name = "PlayListFile"
ConcatFile.Extension = "mp4"
CachePath = $"{DestinationFile.PathWithSeparator}_Cache\{SFile.GetDirectories($"{DestinationFile.PathWithSeparator}_Cache\",,, EDP.ReturnValue).ListIfNothing.Count + 1}\"
If CachePath.Exists(SFO.Path) Then
Dim p As New SFileNumbers(ConcatFile.Name,,, New ANumbers With {.Format = ANumbers.Formats.General})
ConcatFile = SFile.Indexed_IndexFile(ConcatFile,, p, EDP.ReturnValue)
Dim i%
Dim eFiles As New List(Of SFile)
Dim dFile As SFile = CachePath
dFile.Extension = "ts"
Using w As New DownloadObjects.WebClient2(Responser)
For i = 0 To URLs.Count - 1
dFile.Name = $"ConPart_{i}"
w.DownloadFile(URLs(i), dFile)
eFiles.Add(dFile)
Next
End Using
DestinationFile = FFMPEG.ConcatenateFiles(eFiles, Settings.FfmpegFile, ConcatFile, p, EDP.ThrowException)
eFiles.Clear()
Return DestinationFile
End If
End If
Return Nothing
Finally
CachePath.Delete(SFO.Path, SFODelete.None, EDP.None)
End Try
End Function
End Class
End Namespace

View File

@@ -7,8 +7,8 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Threading Imports System.Threading
Imports PersonalUtilities.Forms.Toolbars
Imports SCrawler.Plugin.Hosts Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Forms.Toolbars
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
@@ -52,6 +52,7 @@ Namespace API.Base
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.Base.ProfileSaved.Download({HOST.Key})]") ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.Base.ProfileSaved.Download({HOST.Key})]")
Finally Finally
HOST.DownloadDone(PDownload.SavedPosts) HOST.DownloadDone(PDownload.SavedPosts)
MainFrameObj.UpdateLogButton()
End Try End Try
End Sub End Sub
End Class End Class

View File

@@ -7,7 +7,8 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Base Namespace API.Base
@@ -16,8 +17,8 @@ Namespace API.Base
Friend Overridable ReadOnly Property Icon As Icon Implements ISiteSettings.Icon Friend Overridable ReadOnly Property Icon As Icon Implements ISiteSettings.Icon
Friend Overridable ReadOnly Property Image As Image 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 Responser
Private Property IResponserContainer_Responser As Response Implements IResponserContainer.Responser Private Property IResponserContainer_Responser As Responser Implements IResponserContainer.Responser
Get Get
Return Responser Return Responser
End Get End Get
@@ -29,17 +30,17 @@ Namespace API.Base
End Sub End Sub
Friend Sub New(ByVal SiteName As String, ByVal CookiesDomain As String) Friend Sub New(ByVal SiteName As String, ByVal CookiesDomain As String)
Site = SiteName Site = SiteName
Responser = New Response($"{SettingsFolderName}\Responser_{Site}.xml") Responser = New Responser($"{SettingsFolderName}\Responser_{Site}.xml")
With Responser With Responser
If .File.Exists Then If .File.Exists Then
If EncryptCookies.CookiesEncrypted Then .CookiesEncryptKey = SettingsCLS.CookieEncryptKey If EncryptCookies.CookiesEncrypted Then .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.LoadSettings() .LoadSettings()
Else Else
.CookiesDomain = CookiesDomain .CookiesDomain = CookiesDomain
.Cookies = New CookieKeeper(.CookiesDomain) With {.EncryptKey = SettingsCLS.CookieEncryptKey}
.CookiesEncryptKey = SettingsCLS.CookieEncryptKey .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.SaveSettings() .SaveSettings()
End If End If
If .CookiesDomain.IsEmptyString Then .CookiesDomain = CookiesDomain
End With End With
End Sub End Sub
#Region "XML" #Region "XML"
@@ -51,6 +52,7 @@ Namespace API.Base
End Sub End Sub
Friend Overridable Sub EndInit() Implements ISiteSettings.EndInit Friend Overridable Sub EndInit() Implements ISiteSettings.EndInit
EncryptCookies.ValidateCookiesEncrypt(Responser) EncryptCookies.ValidateCookiesEncrypt(Responser)
If Not DefaultUserAgent.IsEmptyString And Not Responser Is Nothing Then Responser.UserAgent = DefaultUserAgent
End Sub End Sub
Friend Overridable Sub BeginUpdate() Implements ISiteSettings.BeginUpdate Friend Overridable Sub BeginUpdate() Implements ISiteSettings.BeginUpdate
End Sub End Sub
@@ -74,15 +76,18 @@ Namespace API.Base
#Region "User info" #Region "User info"
Protected UrlPatternUser As String = String.Empty Protected UrlPatternUser As String = String.Empty
Protected UrlPatternChannel As String = String.Empty Protected UrlPatternChannel As String = String.Empty
Friend Overridable Function GetUserUrl(ByVal UserName As String, ByVal Channel As Boolean) As String Implements ISiteSettings.GetUserUrl Friend Overridable Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String Implements ISiteSettings.GetUserUrl
If Channel Then If Channel Then
If Not UrlPatternChannel.IsEmptyString Then Return String.Format(UrlPatternChannel, UserName) If Not UrlPatternChannel.IsEmptyString Then Return String.Format(UrlPatternChannel, User.Name)
Else Else
If Not UrlPatternUser.IsEmptyString Then Return String.Format(UrlPatternUser, UserName) If Not UrlPatternUser.IsEmptyString Then Return String.Format(UrlPatternUser, User.Name)
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 Private Function ISiteSettings_GetUserPostUrl(ByVal User As IPluginContentProvider, ByVal Media As IUserMedia) As String Implements ISiteSettings.GetUserPostUrl
Return GetUserPostUrl(User, Media)
End Function
Friend Overridable Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return String.Empty Return String.Empty
End Function End Function
Protected UserRegex As RParams = Nothing Protected UserRegex As RParams = Nothing
@@ -94,7 +99,7 @@ Namespace API.Base
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"[API.Base.SiteSettingsBase.IsMyUser({UserURL})]") Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"[API.Base.SiteSettingsBase.IsMyUser({UserURL})]", New ExchangeOptions)
End Try End Try
End Function End Function
Protected ImageVideoContains As String = String.Empty Protected ImageVideoContains As String = String.Empty

View File

@@ -6,12 +6,13 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin
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
Namespace API.Base Namespace API.Base
Friend Module Structures Friend Module Structures
Friend Structure UserMedia : Implements IEquatable(Of UserMedia), IEContainerProvider Friend Structure UserMedia : Implements IUserMedia, IEquatable(Of UserMedia), IEContainerProvider
#Region "XML Names" #Region "XML Names"
Friend Const Name_MediaNode As String = "MediaData" Friend Const Name_MediaNode As String = "MediaData"
Private Const Name_MediaType As String = "Type" Private Const Name_MediaType As String = "Type"
@@ -48,6 +49,97 @@ Namespace API.Base
''' SomeFolder\SomeFolder2 ''' SomeFolder\SomeFolder2
''' </summary> ''' </summary>
Friend SpecialFolder As String Friend SpecialFolder As String
Friend [Object] As Object
#Region "Interface Support"
Private Property IUserMedia_Type As Integer Implements IUserMedia.ContentType
Get
Return Type
End Get
Set(ByVal Type As Integer)
Me.Type = Type
End Set
End Property
Private Property IUserMedia_URL_BASE As String Implements IUserMedia.URL_BASE
Get
Return URL_BASE
End Get
Set(ByVal URL_BASE As String)
Me.URL_BASE = URL_BASE
End Set
End Property
Private Property IUserMedia_URL As String Implements IUserMedia.URL
Get
Return URL
End Get
Set(ByVal URL As String)
Me.URL = URL
End Set
End Property
Private Property IUserMedia_MD5 As String Implements IUserMedia.MD5
Get
Return MD5
End Get
Set(ByVal MD5 As String)
Me.MD5 = MD5
End Set
End Property
Private Property IUserMedia_File As String Implements IUserMedia.File
Get
Return File
End Get
Set(ByVal File As String)
Me.File = File
End Set
End Property
Private Property IUserMedia_State As Integer Implements IUserMedia.DownloadState
Get
Return State
End Get
Set(ByVal State As Integer)
Me.State = State
End Set
End Property
Private Property IUserMedia_PostID As String Implements IUserMedia.PostID
Get
Return Post.ID
End Get
Set(ByVal PostID As String)
Post = New UserPost(PostID, Post.Date)
End Set
End Property
Private Property IUserMedia_PostDate As Date? Implements IUserMedia.PostDate
Get
Return Post.Date
End Get
Set(ByVal PostDate As Date?)
Post = New UserPost(Post.ID, PostDate)
End Set
End Property
Private Property IUserMedia_SpecialFolder As String Implements IUserMedia.SpecialFolder
Get
Return SpecialFolder
End Get
Set(ByVal SpecialFolder As String)
Me.SpecialFolder = SpecialFolder
End Set
End Property
Private Property IUserMedia_Attempts As Integer Implements IUserMedia.Attempts
Get
Return Attempts
End Get
Set(ByVal Attempts As Integer)
Me.Attempts = Attempts
End Set
End Property
Private Property IUserMedia_Object As Object Implements IUserMedia.Object
Get
Return Me.Object
End Get
Set(ByVal Obj As Object)
Me.Object = Obj
End Set
End Property
#End Region
Friend Sub New(ByVal URL As String) Friend Sub New(ByVal URL As String)
Me.URL = URL Me.URL = URL
URL_BASE = URL URL_BASE = URL
@@ -58,16 +150,17 @@ Namespace API.Base
Me.New(URL) Me.New(URL)
Me.Type = Type Me.Type = Type
End Sub End Sub
Friend Sub New(ByVal m As Plugin.PluginUserMedia) Friend Sub New(ByVal m As IUserMedia)
[Type] = m.ContentType [Type] = m.ContentType
URL = m.URL URL = m.URL
URL_BASE = URL URL_BASE = m.URL_BASE
MD5 = m.MD5 MD5 = m.MD5
File = m.File File = m.File
Post = New UserPost With {.ID = m.PostID, .[Date] = m.PostDate} Post = New UserPost With {.ID = m.PostID, .[Date] = m.PostDate}
State = m.DownloadState State = m.DownloadState
SpecialFolder = m.SpecialFolder SpecialFolder = m.SpecialFolder
Attempts = m.Attempts Attempts = m.Attempts
Me.Object = m.Object
End Sub End Sub
Friend Sub New(ByVal e As EContainer, ByVal UserInstance As IUserData) Friend Sub New(ByVal e As EContainer, ByVal UserInstance As IUserData)
Type = e.Attribute(Name_MediaType).Value.FromXML(Of Integer)(CInt(Types.Undefined)) Type = e.Attribute(Name_MediaType).Value.FromXML(Of Integer)(CInt(Types.Undefined))
@@ -94,7 +187,7 @@ Namespace API.Base
Post = New UserPost With { Post = New UserPost With {
.ID = e.Attribute(Name_MediaPostID).Value, .ID = e.Attribute(Name_MediaPostID).Value,
.[Date] = AConvert(Of Date)(e.Attribute(Name_MediaPostDate).Value, ParsersDataDateProvider, Nothing) .[Date] = AConvert(Of Date)(e.Attribute(Name_MediaPostDate).Value, DateTimeDefaultProvider, Nothing)
} }
End Sub End Sub
Public Shared Widening Operator CType(ByVal _URL As String) As UserMedia Public Shared Widening Operator CType(ByVal _URL As String) As UserMedia
@@ -117,19 +210,6 @@ Namespace API.Base
Public Overrides Function ToString() As String Public Overrides Function ToString() As String
Return URL Return URL
End Function End Function
Friend Function PluginUserMedia() As Plugin.PluginUserMedia
Return New Plugin.PluginUserMedia With {
.ContentType = Type,
.DownloadState = State,
.File = File,
.MD5 = MD5,
.URL = URL,
.SpecialFolder = SpecialFolder,
.PostID = Post.ID,
.PostDate = Post.Date,
.Attempts = Attempts
}
End Function
Friend Overloads Function Equals(ByVal Other As UserMedia) As Boolean Implements IEquatable(Of UserMedia).Equals Friend Overloads Function Equals(ByVal Other As UserMedia) As Boolean Implements IEquatable(Of UserMedia).Equals
Return URL = Other.URL Return URL = Other.URL
End Function End Function
@@ -145,7 +225,7 @@ Namespace API.Base
New EAttribute(Name_MediaFile, File.File), New EAttribute(Name_MediaFile, File.File),
New EAttribute(Name_SpecialFolder, SpecialFolder), New EAttribute(Name_SpecialFolder, SpecialFolder),
New EAttribute(Name_MediaPostID, Post.ID), New EAttribute(Name_MediaPostID, Post.ID),
New EAttribute(Name_MediaPostDate, AConvert(Of String)(Post.Date, ParsersDataDateProvider, String.Empty)) New EAttribute(Name_MediaPostDate, AConvert(Of String)(Post.Date, DateTimeDefaultProvider, String.Empty))
} }
) )
End Function End Function
@@ -154,17 +234,31 @@ Namespace API.Base
''' <summary>Post ID</summary> ''' <summary>Post ID</summary>
Friend ID As String Friend ID As String
Friend [Date] As Date? Friend [Date] As Date?
#Region "Channel compatible fields"
Friend UserID As String Friend UserID As String
Friend CachedFile As SFile Friend CachedFile As SFile
#Region "Initializers"
Public Sub New(ByVal ID As String)
Me.ID = ID
End Sub
Public Sub New(ByVal [Date] As Date?)
Me.Date = [Date]
End Sub
Public Sub New(ByVal ID As String, ByVal [Date] As Date?)
Me.ID = ID
Me.Date = [Date]
End Sub
Public Shared Widening Operator CType(ByVal ID As String) As UserPost
Return New UserPost(ID)
End Operator
Public Shared Widening Operator CType(ByVal Post As UserPost) As String
Return Post.ID
End Operator
#End Region #End Region
Friend Function GetImage(ByVal s As Size, ByVal e As ErrorsDescriber, ByVal NullArg As Image) As Image #Region "ToString"
If Not CachedFile.IsEmptyString Then Public Overrides Function ToString() As String
Return If(PersonalUtilities.Tools.ImageRenderer.GetImage(SFile.GetBytes(CachedFile), s, e), NullArg.Clone) Return ID
Else
Return NullArg.Clone
End If
End Function End Function
#End Region
#Region "IEquatable, IComparable Support" #Region "IEquatable, IComparable Support"
Friend Overloads Function Equals(ByVal Other As UserPost) As Boolean Implements IEquatable(Of UserPost).Equals Friend Overloads Function Equals(ByVal Other As UserPost) As Boolean Implements IEquatable(Of UserPost).Equals
Return ID = Other.ID Return ID = Other.ID

View File

@@ -6,16 +6,18 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.WEB
Imports System.IO Imports System.IO
Imports System.Net Imports System.Net
Imports System.Threading Imports System.Threading
Imports System.Runtime.CompilerServices
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Hosts Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Objects
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Web.Clients
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
Namespace API.Base Namespace API.Base
@@ -94,12 +96,20 @@ Namespace API.Base
End Sub End Sub
#End Region #End Region
#Region "XML Declarations" #Region "XML Declarations"
Private Const Name_Site As String = "Site" Private Const Name_Site As String = UserInfo.Name_Site
Private Const Name_IsChannel As String = "IsChannel" Private Const Name_Plugin As String = UserInfo.Name_Plugin
Private Const Name_UserName As String = "UserName" Private Const Name_IsChannel As String = UserInfo.Name_IsChannel
Friend Const Name_UserName As String = "UserName"
Private Const Name_Model_User As String = UserInfo.Name_Model_User
Private Const Name_Model_Collection As String = UserInfo.Name_Model_Collection
Private Const Name_Merged As String = UserInfo.Name_Merged
Private Const Name_SpecialPath As String = UserInfo.Name_SpecialPath
Private Const Name_SpecialCollectionPath As String = UserInfo.Name_SpecialCollectionPath
Private Const Name_UserExists As String = "UserExists" Private Const Name_UserExists As String = "UserExists"
Private Const Name_UserSuspended As String = "UserSuspended" Private Const Name_UserSuspended As String = "UserSuspended"
Private Const Name_FriendlyName As String = "FriendlyName" Private Const Name_FriendlyName As String = "FriendlyName"
Private Const Name_UserSiteName As String = "UserSiteName"
Private Const Name_UserID As String = "UserID" Private Const Name_UserID As String = "UserID"
Private Const Name_Description As String = "Description" Private Const Name_Description As String = "Description"
Private Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly" Private Const Name_ParseUserMediaOnly As String = "ParseUserMediaOnly"
@@ -108,8 +118,8 @@ Namespace API.Base
Private Const Name_CreatedByChannel As String = "CreatedByChannel" Private Const Name_CreatedByChannel As String = "CreatedByChannel"
Private Const Name_SeparateVideoFolder As String = "SeparateVideoFolder" Private Const Name_SeparateVideoFolder As String = "SeparateVideoFolder"
Private Const Name_CollectionName As String = "Collection" Private Const Name_CollectionName As String = UserInfo.Name_Collection
Private Const Name_LabelsName As String = "Labels" Friend Const Name_LabelsName As String = "Labels"
Private Const Name_ReadyForDownload As String = "ReadyForDownload" Private Const Name_ReadyForDownload As String = "ReadyForDownload"
Private Const Name_DownloadImages As String = "DownloadImages" Private Const Name_DownloadImages As String = "DownloadImages"
@@ -122,7 +132,7 @@ Namespace API.Base
Private Const Name_ScriptUse As String = "ScriptUse" Private Const Name_ScriptUse As String = "ScriptUse"
Private Const Name_ScriptData As String = "ScriptData" Private Const Name_ScriptData As String = "ScriptData"
Private Const Name_DataMerging As String = "DataMerging" <Obsolete("Use 'Name_Merged'", False)> Friend Const Name_DataMerging As String = "DataMerging"
#End Region #End Region
#Region "Declarations" #Region "Declarations"
#Region "Host, Site, Progress, Self" #Region "Host, Site, Progress, Self"
@@ -133,17 +143,30 @@ Namespace API.Base
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 #End Region
#Region "User name, ID, exist, suspend" #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 Private _UserExists As Boolean = True
Friend Overridable Property UserSuspended As Boolean = False Implements IUserData.Suspended, IPluginContentProvider.UserSuspended Friend Overridable Property UserExists As Boolean Implements IUserData.Exists, IPluginContentProvider.UserExists
Get
Return _UserExists
End Get
Set(ByVal _UserExists As Boolean)
If Not Me._UserExists = _UserExists Then EnvirChanged(_UserExists)
Me._UserExists = _UserExists
End Set
End Property
Private _UserSuspended As Boolean = False
Friend Overridable Property UserSuspended As Boolean Implements IUserData.Suspended, IPluginContentProvider.UserSuspended
Get
Return _UserSuspended
End Get
Set(ByVal _UserSuspended As Boolean)
If Not Me._UserSuspended = _UserSuspended Then EnvirChanged(_UserSuspended)
Me._UserSuspended = _UserSuspended
End Set
End Property
Friend Overridable Property Name As String Implements IContentProvider.Name, IPluginContentProvider.Name Friend Overridable Property Name As String Implements IContentProvider.Name, IPluginContentProvider.Name
Get Get
Return User.Name Return User.Name
@@ -155,7 +178,61 @@ Namespace API.Base
End Set End Set
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 Protected _FriendlyName As String = String.Empty
Friend Overridable Property FriendlyName As String Implements IContentProvider.FriendlyName
Get
If Settings.UserSiteNameAsFriendly Then
Return _FriendlyName.IfNullOrEmpty(UserSiteName)
Else
Return _FriendlyName
End If
End Get
Set(ByVal n As String)
_FriendlyName = n
End Set
End Property
Friend ReadOnly Property FriendlyNameOrig As String
Get
Return _FriendlyName
End Get
End Property
Friend ReadOnly Property FriendlyNameIsSiteName As Boolean
Get
If Settings.UserSiteNameAsFriendly Then
Return Not FriendlyName.IsEmptyString And Not _FriendlyName = UserSiteName And FriendlyName = UserSiteName
Else
Return False
End If
End Get
End Property
Private _UserSiteName As String = String.Empty
Friend Property UserSiteName As String
Get
Return _UserSiteName
End Get
Set(ByVal _UserSiteName As String)
If Not Me._UserSiteName = _UserSiteName Then EnvirChanged(_UserSiteName)
Me._UserSiteName = _UserSiteName
End Set
End Property
Protected Sub UserSiteNameUpdate(ByVal NewName As String)
If Not NewName.IsEmptyString And (UserSiteName.IsEmptyString Or Settings.UserSiteNameUpdateEveryTime) Then UserSiteName = NewName
End Sub
Friend ReadOnly Property UserModel As UsageModel Implements IUserData.UserModel
Get
Return User.UserModel
End Get
End Property
Friend Overridable ReadOnly Property CollectionModel As UsageModel Implements IUserData.CollectionModel
Get
Return User.CollectionModel
End Get
End Property
Friend Overridable ReadOnly Property IsVirtual As Boolean Implements IUserData.IsVirtual
Get
Return UserModel = UsageModel.Virtual
End Get
End Property
#End Region #End Region
#Region "Description" #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
@@ -174,10 +251,6 @@ Namespace API.Base
_DescriptionChecked = True _DescriptionChecked = True
End If End If
End Sub End Sub
Protected Sub UserDescriptionReset()
_DescriptionChecked = False
_DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime
End Sub
#End Region #End Region
#Region "Favorite, Temporary" #Region "Favorite, Temporary"
Protected _Favorite As Boolean = False Protected _Favorite As Boolean = False
@@ -223,15 +296,15 @@ Namespace API.Base
Friend Overridable Sub SetPicture(ByVal f As SFile) Implements IUserData.SetPicture Friend Overridable Sub SetPicture(ByVal f As SFile) Implements IUserData.SetPicture
Try Try
If f.Exists Then If f.Exists Then
Using p As New UserImage(f, User.File) : p.Save() : End Using Using p As New UserImage(f, MyFile) : p.Save() : End Using
End If End If
Catch 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 XMLValue(Of Integer)) As Bitmap
Return New Bitmap(CInt(DivideWithZeroChecking(MaxHeigh.Value, 100) * 75), MaxHeigh.Value) Return New Bitmap(CInt(DivideWithZeroChecking(MaxHeigh.Value, 100) * 75), MaxHeigh.Value)
End Function End Function
Protected Function GetPicture(Of T)(Optional ByVal ReturnNullImageOnNothing As Boolean = True, Optional ByVal GetToast As Boolean = False) As T Friend Function GetPicture(Of T)(Optional ByVal ReturnNullImageOnNothing As Boolean = True, Optional ByVal GetToast As Boolean = False) As T
Dim rsfile As Boolean = GetType(T) Is GetType(SFile) Dim rsfile As Boolean = GetType(T) Is GetType(SFile)
Dim f As SFile = Nothing Dim f As SFile = Nothing
Dim p As UserImage = Nothing Dim p As UserImage = Nothing
@@ -335,7 +408,7 @@ BlockNullPicture:
Friend Overridable Sub ChangeCollectionName(ByVal NewName As String, ByVal UpdateSettings As Boolean) Friend Overridable Sub ChangeCollectionName(ByVal NewName As String, ByVal UpdateSettings As Boolean)
Dim u As UserInfo = User Dim u As UserInfo = User
u.CollectionName = NewName u.CollectionName = NewName
u.IncludedInCollection = Not NewName.IsEmptyString u.UpdateUserFile()
User = u User = u
If UpdateSettings Then Settings.UpdateUsersList(User) If UpdateSettings Then Settings.UpdateUsersList(User)
End Sub End Sub
@@ -386,13 +459,18 @@ BlockNullPicture:
#Region "Files" #Region "Files"
Friend Overridable Property MyFile As SFile Implements IUserData.File Friend Overridable Property MyFile As SFile Implements IUserData.File
Get Get
Return User.File If IsSavedPosts Then
Return MyFileSettings
Else
Return User.File
End If
End Get End Get
Set(ByVal f As SFile) Set(ByVal f As SFile)
User.File = f User.File = f
Settings.UpdateUsersList(User) Settings.UpdateUsersList(User)
End Set End Set
End Property End Property
Protected MyFileSettings As SFile
Protected MyFileData As SFile Protected MyFileData As SFile
Protected MyFilePosts As SFile Protected MyFilePosts As SFile
Friend Overridable Property FileExists As Boolean = False Implements IUserData.FileExists Friend Overridable Property FileExists As Boolean = False Implements IUserData.FileExists
@@ -455,7 +533,10 @@ BlockNullPicture:
End Property End Property
Friend Overridable Function GetUserInformation() As String Friend Overridable Function GetUserInformation() As String
Dim OutStr$ = $"User: {Name} (site: {Site}" Dim OutStr$ = $"User: {Name} (site: {Site}"
If IncludedInCollection Then OutStr &= $"; collection: {CollectionName}" If IncludedInCollection Then
OutStr &= $"; collection: {CollectionName}"
If CollectionModel = UsageModel.Default And UserModel = UsageModel.Virtual Then OutStr &= "; virtual"
End If
OutStr &= ")" OutStr &= ")"
OutStr.StringAppendLine($"Labels: {Labels.ListToString}") OutStr.StringAppendLine($"Labels: {Labels.ListToString}")
OutStr.StringAppendLine($"Path: {MyFile.CutPath.Path}") OutStr.StringAppendLine($"Path: {MyFile.CutPath.Path}")
@@ -494,9 +575,9 @@ BlockNullPicture:
Private Property IPluginContentProvider_Thrower As IThrower Implements IPluginContentProvider.Thrower Private Property IPluginContentProvider_Thrower As IThrower Implements IPluginContentProvider.Thrower
Private Property IPluginContentProvider_LogProvider As ILogProvider Implements IPluginContentProvider.LogProvider Private Property IPluginContentProvider_LogProvider As ILogProvider Implements IPluginContentProvider.LogProvider
Friend Property ExternalPlugin As IPluginContentProvider Friend Property ExternalPlugin As IPluginContentProvider
Private Property IPluginContentProvider_ExistingContentList As List(Of PluginUserMedia) Implements IPluginContentProvider.ExistingContentList Private Property IPluginContentProvider_ExistingContentList As List(Of IUserMedia) Implements IPluginContentProvider.ExistingContentList
Private Property IPluginContentProvider_TempPostsList As List(Of String) Implements IPluginContentProvider.TempPostsList Private Property IPluginContentProvider_TempPostsList As List(Of String) Implements IPluginContentProvider.TempPostsList
Private Property IPluginContentProvider_TempMediaList As List(Of PluginUserMedia) Implements IPluginContentProvider.TempMediaList Private Property IPluginContentProvider_TempMediaList As List(Of IUserMedia) Implements IPluginContentProvider.TempMediaList
Private Property IPluginContentProvider_SeparateVideoFolder As Boolean Implements IPluginContentProvider.SeparateVideoFolder Private Property IPluginContentProvider_SeparateVideoFolder As Boolean Implements IPluginContentProvider.SeparateVideoFolder
Private Property IPluginContentProvider_DataPath As String Implements IPluginContentProvider.DataPath Private Property IPluginContentProvider_DataPath As String Implements IPluginContentProvider.DataPath
Private Sub IPluginContentProvider_XmlFieldsSet(ByVal Fields As List(Of KeyValuePair(Of String, String))) Implements IPluginContentProvider.XmlFieldsSet Private Sub IPluginContentProvider_XmlFieldsSet(ByVal Fields As List(Of KeyValuePair(Of String, String))) Implements IPluginContentProvider.XmlFieldsSet
@@ -620,7 +701,7 @@ BlockNullPicture:
With DirectCast(u, UserDataBase) With DirectCast(u, UserDataBase)
If Not .User.Plugin.IsEmptyString Then If Not .User.Plugin.IsEmptyString Then
uName = .User.Name uName = .User.Name
Return Settings(.User.Plugin).GetUserPostUrl(.ID, PostData.Post.ID) Return Settings(.User.Plugin).GetUserPostUrl(.Self, PostData)
End If End If
End With End With
End If End If
@@ -635,14 +716,16 @@ BlockNullPicture:
Private _UserInformationLoaded As Boolean = False Private _UserInformationLoaded As Boolean = False
Friend Overridable Sub LoadUserInformation() Implements IUserData.LoadUserInformation Friend Overridable Sub LoadUserInformation() Implements IUserData.LoadUserInformation
Try Try
If MyFile.Exists Then UpdateDataFiles(, True)
If MyFileSettings.Exists Then
FileExists = True FileExists = True
Using x As New XmlFile(MyFile) With {.XmlReadOnly = True} Using x As New XmlFile(MyFileSettings) With {.XmlReadOnly = True}
If User.Name.IsEmptyString Then User.Name = x.Value(Name_UserName) If User.Name.IsEmptyString Then User.Name = x.Value(Name_UserName)
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)
FriendlyName = x.Value(Name_FriendlyName) _FriendlyName = x.Value(Name_FriendlyName)
UserSiteName = x.Value(Name_UserSiteName)
UserDescription = x.Value(Name_Description) UserDescription = x.Value(Name_Description)
ParseUserMediaOnly = x.Value(Name_ParseUserMediaOnly).FromXML(Of Boolean)(False) ParseUserMediaOnly = x.Value(Name_ParseUserMediaOnly).FromXML(Of Boolean)(False)
Temporary = x.Value(Name_Temporary).FromXML(Of Boolean)(False) Temporary = x.Value(Name_Temporary).FromXML(Of Boolean)(False)
@@ -657,7 +740,14 @@ BlockNullPicture:
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) ScriptUse = x.Value(Name_ScriptUse).FromXML(Of Boolean)(False)
ScriptData = x.Value(Name_ScriptData) ScriptData = x.Value(Name_ScriptData)
DataMerging = x.Value(Name_DataMerging).FromXML(Of Boolean)(False) 'TODELETE: UserDataBase remove old 'merge' constant
#Disable Warning BC40000
If x.Contains(Name_DataMerging) Then
DataMerging = x.Value(Name_DataMerging).FromXML(Of Boolean)(False)
Else
DataMerging = x.Value(Name_Merged).FromXML(Of Boolean)(False)
End If
#Enable Warning
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)
LoadUserInformation_OptionalFields(x, True) LoadUserInformation_OptionalFields(x, True)
@@ -672,14 +762,22 @@ BlockNullPicture:
End Sub End Sub
Friend Overridable Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation Friend Overridable Sub UpdateUserInformation() Implements IUserData.UpdateUserInformation
Try Try
MyFile.Exists(SFO.Path) UpdateDataFiles(True)
MyFileSettings.Exists(SFO.Path)
Using x As New XmlFile With {.Name = "User"} Using x As New XmlFile With {.Name = "User"}
x.Add(Name_Site, Site) x.Add(Name_Site, Site)
x.Add(Name_Plugin, HOST.Key)
x.Add(Name_UserName, User.Name) x.Add(Name_UserName, User.Name)
x.Add(Name_IsChannel, IsChannel.BoolToInteger)
x.Add(Name_Model_User, CInt(UserModel))
x.Add(Name_Model_Collection, CInt(CollectionModel))
x.Add(Name_SpecialPath, User.SpecialPath)
x.Add(Name_SpecialCollectionPath, User.SpecialCollectionPath)
x.Add(Name_UserExists, UserExists.BoolToInteger) x.Add(Name_UserExists, UserExists.BoolToInteger)
x.Add(Name_UserSuspended, UserSuspended.BoolToInteger) x.Add(Name_UserSuspended, UserSuspended.BoolToInteger)
x.Add(Name_UserID, ID) x.Add(Name_UserID, ID)
x.Add(Name_FriendlyName, FriendlyName) x.Add(Name_FriendlyName, _FriendlyName)
x.Add(Name_UserSiteName, UserSiteName)
x.Add(Name_Description, UserDescription) x.Add(Name_Description, UserDescription)
x.Add(Name_ParseUserMediaOnly, ParseUserMediaOnly.BoolToInteger) x.Add(Name_ParseUserMediaOnly, ParseUserMediaOnly.BoolToInteger)
x.Add(Name_Temporary, Temporary.BoolToInteger) x.Add(Name_Temporary, Temporary.BoolToInteger)
@@ -700,11 +798,11 @@ BlockNullPicture:
x.Add(Name_ScriptData, ScriptData) 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_Merged, DataMerging.BoolToInteger)
LoadUserInformation_OptionalFields(x, False) LoadUserInformation_OptionalFields(x, False)
x.Save(MyFile) x.Save(MyFileSettings)
End Using End Using
If Not IsSavedPosts Then Settings.UpdateUsersList(User) If Not IsSavedPosts Then Settings.UpdateUsersList(User)
Catch ex As Exception Catch ex As Exception
@@ -717,7 +815,7 @@ BlockNullPicture:
#Region "User data" #Region "User data"
Friend Overridable Overloads Sub LoadContentInformation(Optional ByVal Force As Boolean = False) Friend Overridable Overloads Sub LoadContentInformation(Optional ByVal Force As Boolean = False)
Try Try
UpdateDataFiles() UpdateDataFiles(, True)
If Not MyFileData.Exists Or (_DataLoaded And Not Force) 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()
@@ -732,7 +830,7 @@ BlockNullPicture:
End Sub End Sub
Friend Sub UpdateContentInformation() Friend Sub UpdateContentInformation()
Try Try
UpdateDataFiles() UpdateDataFiles(True, True)
If MyFileData.IsEmptyString Then Exit Sub If MyFileData.IsEmptyString Then Exit Sub
MyFileData.Exists(SFO.Path) MyFileData.Exists(SFO.Path)
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Data"} Using x As New XmlFile With {.AllowSameNames = True, .Name = "Data"}
@@ -748,7 +846,7 @@ BlockNullPicture:
#Region "Open site, folder" #Region "Open site, folder"
Friend Overridable Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing) Implements IContentProvider.OpenSite Friend Overridable Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing) Implements IContentProvider.OpenSite
Try Try
Dim URL$ = HOST.Source.GetUserUrl(Name, IsChannel) Dim URL$ = HOST.Source.GetUserUrl(Me, IsChannel)
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)
@@ -806,28 +904,58 @@ BlockNullPicture:
End Function End Function
#End Region #End Region
#Region "Download functions and options" #Region "Download functions and options"
Protected Responser As Response Protected Responser As Responser
Protected UseResponserClient As Boolean = False Protected UseResponserClient As Boolean = False
Protected _ForceSaveUserData As Boolean = False
Protected _ForceSaveUserInfo As Boolean = False
Private _DownloadInProgress As Boolean = False
Private _EnvirUserExists As Boolean
Private _EnvirUserSuspended As Boolean
Private _EnvirChanged As Boolean = False
Private _PictureExists As Boolean
Private _EnvirInvokeUserUpdated As Boolean = False
Protected Sub EnvirDownloadSet()
UpdateDataFiles(, True)
_DownloadInProgress = True
_DescriptionChecked = False
_DescriptionEveryTime = Settings.UpdateUserDescriptionEveryTime
_ForceSaveUserData = False
_ForceSaveUserInfo = False
_EnvirUserExists = UserExists
_EnvirUserSuspended = UserSuspended
_EnvirChanged = False
UserExists = True
UserSuspended = False
DownloadedPictures(False) = 0
DownloadedVideos(False) = 0
_PictureExists = Settings.ViewModeIsPicture AndAlso Not GetPicture(Of Image)(False) Is Nothing
_EnvirInvokeUserUpdated = False
End Sub
Private Sub EnvirChanged(ByVal NewValue As Object, <CallerMemberName> Optional ByVal Caller As String = Nothing)
If _DownloadInProgress Then
Select Case Caller
Case NameOf(UserExists) : If Not _EnvirUserExists = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
Case NameOf(UserSuspended) : If Not _EnvirUserSuspended = CBool(NewValue) Then _EnvirChanged = True : _EnvirInvokeUserUpdated = True
Case Else : _EnvirChanged = True
End Select
End If
End Sub
Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData
Dim Canceled As Boolean = False Dim Canceled As Boolean = False
_ExternalCompatibilityToken = Token _ExternalCompatibilityToken = Token
Try Try
UpdateDataFiles() EnvirDownloadSet()
UserDescriptionReset()
If Not Responser Is Nothing Then Responser.Dispose() If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Response Responser = New Responser
If Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser) If Not HOST.Responser Is Nothing Then Responser.Copy(HOST.Responser)
'TODO: UserDataBase remove [Responser.DecodersError]
Responser.DecodersError = New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue) With {
.DeclaredMessage = New MMessage($"SymbolsConverter error: [{ToStringForLog()}]", ToStringForLog())}
Dim UpPic As Boolean = Settings.ViewModeIsPicture AndAlso GetPicture(Of Image)(False) Is Nothing
Dim sEnvir() As Boolean = {UserExists, 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 Dim _downContent As Func(Of UserMedia, Boolean) = Function(c) c.State = UStates.Downloaded
UserExists = True
UserSuspended = False
DownloadedPictures(False) = 0
DownloadedVideos(False) = 0
_TempMediaList.Clear() _TempMediaList.Clear()
_TempPostsList.Clear() _TempPostsList.Clear()
LatestData.Clear()
Dim __SaveData As Boolean = Not CreatedByChannel Or Not Settings.FromChannelDownloadTopUse Dim __SaveData As Boolean = Not CreatedByChannel Or Not Settings.FromChannelDownloadTopUse
LoadContentInformation() LoadContentInformation()
@@ -853,22 +981,23 @@ BlockNullPicture:
ReparseVideo(Token) ReparseVideo(Token)
ThrowAny(Token) ThrowAny(Token)
If IsSavedPosts Then UpdateDataFiles(True)
If _TempPostsList.Count > 0 And Not DownloadMissingOnly And __SaveData Then _ If _TempPostsList.Count > 0 And Not DownloadMissingOnly And __SaveData Then _
TextSaver.SaveTextToFile(_TempPostsList.ListToString(Environment.NewLine), MyFilePosts, True,, EDP.None) 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()
LatestData.ListAddList(_ContentNew.Where(_downContent), LNC) If IncludeInTheFeed Then LatestData.ListAddList(_ContentNew.Where(_downContent), LNC)
Dim mcb& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0) Dim mcb& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
_ContentList.ListAddList(_ContentNew.Where(Function(c) _downContent(c) Or MissingFinder(c)), LNC) _ContentList.ListAddList(_ContentNew.Where(Function(c) _downContent(c) Or MissingFinder(c)), LNC)
Dim mca& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0) Dim mca& = If(ContentMissingExists, _ContentList.LongCount(Function(c) MissingFinder(c)), 0)
If DownloadedTotal(False) > 0 Or EnvirChanged.Invoke Or Not mcb = mca Then If DownloadedTotal(False) > 0 Or _EnvirChanged Or Not mcb = mca Or _ForceSaveUserData Then
If __SaveData Then If __SaveData Then
LastUpdated = Now LastUpdated = Now
RunScript() RunScript()
DownloadedPictures(True) = SFile.GetFiles(User.File.CutPath, "*.jpg|*.jpeg|*.png|*.gif|*.webm",, EDP.ReturnValue).Count DownloadedPictures(True) = SFile.GetFiles(MyFile.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(MyFile.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)
UpdateContentInformation() UpdateContentInformation()
Else Else
@@ -879,12 +1008,14 @@ BlockNullPicture:
End If End If
If Not UserExists Then ReadyForDownload = False If Not UserExists Then ReadyForDownload = False
UpdateUserInformation() UpdateUserInformation()
If _CollectionButtonsExists AndAlso EnvirChanged.Invoke Then UpdateButtonsColor() If _CollectionButtonsExists AndAlso _EnvirChanged Then UpdateButtonsColor()
ElseIf _ForceSaveUserInfo Then
UpdateUserInformation()
End If End If
ThrowIfDisposed() ThrowIfDisposed()
If UpPic Or EnvirChanged.Invoke Then OnUserUpdated() If Not _PictureExists Or _EnvirInvokeUserUpdated Then OnUserUpdated()
Catch oex As OperationCanceledException When Token.IsCancellationRequested Catch oex As OperationCanceledException When Token.IsCancellationRequested
MyMainLOG = $"{Site} - {Name}: downloading canceled" MyMainLOG = $"{ToStringForLog()}: downloading canceled"
Canceled = True Canceled = True
Catch dex As ObjectDisposedException When Disposed Catch dex As ObjectDisposedException When Disposed
Canceled = True Canceled = True
@@ -895,17 +1026,32 @@ BlockNullPicture:
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 If Not Canceled Then _DataParsed = True
_ContentNew.Clear() _ContentNew.Clear()
_DownloadInProgress = False
DownloadTopCount = Nothing DownloadTopCount = Nothing
DownloadDateFrom = Nothing DownloadDateFrom = Nothing
DownloadDateTo = Nothing DownloadDateTo = Nothing
DownloadMissingOnly = False DownloadMissingOnly = False
_ForceSaveUserData = False
_ForceSaveUserInfo = False
End Try End Try
End Sub End Sub
Protected Sub UpdateDataFiles() Protected Sub UpdateDataFiles(Optional ByVal ForceSaved As Boolean = False, Optional ByVal ValidateContetnt As Boolean = False)
'TODELETE: saved posts name compatibility 2023.2.5.0
Dim __validateSaved As Func(Of Boolean) = Function() MyFileData.Exists Or MyFilePosts.Exists
If Not User.File.IsEmptyString Then If Not User.File.IsEmptyString Then
MyFileData = User.File MyFileSettings = Nothing
If IsSavedPosts Then
Dim u As UserInfo = User
u.Name = "SavedPosts"
u.UpdateUserFile()
Dim mfp As SFile = u.File
mfp.Name &= "_Posts"
If (ValidateContetnt AndAlso mfp.Exists) Or (Not ValidateContetnt AndAlso u.File.Exists) Or ForceSaved Then MyFileSettings = u.File
End If
If MyFileSettings.IsEmptyString Then MyFileSettings = User.File
MyFileData = MyFileSettings
MyFileData.Name &= "_Data" MyFileData.Name &= "_Data"
MyFilePosts = User.File MyFilePosts = MyFileSettings
MyFilePosts.Name &= "_Posts" MyFilePosts.Name &= "_Posts"
MyFilePosts.Extension = "txt" MyFilePosts.Extension = "txt"
Else Else
@@ -923,11 +1069,7 @@ BlockNullPicture:
Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken) Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken)
End Sub End Sub
Protected MustOverride Sub DownloadContent(ByVal Token As CancellationToken) Protected MustOverride Sub DownloadContent(ByVal Token As CancellationToken)
Private NotInheritable Class OptionalWebClient : Implements IDisposable Private NotInheritable Class OptionalWebClient : Inherits DownloadObjects.WebClient2
Private ReadOnly WC As WebClient
Private ReadOnly RC As Response
Private ReadOnly RCERROR As New ErrorsDescriber(EDP.ThrowException)
Private ReadOnly UseResponserClient As Boolean
Friend Sub New(ByRef Source As UserDataBase) Friend Sub New(ByRef Source As UserDataBase)
UseResponserClient = Source.UseResponserClient UseResponserClient = Source.UseResponserClient
If UseResponserClient Then If UseResponserClient Then
@@ -936,28 +1078,6 @@ BlockNullPicture:
WC = New WebClient WC = New WebClient
End If End If
End Sub End Sub
Friend Sub DownloadFile(ByVal URL As String, ByVal File As String)
If UseResponserClient Then
RC.DownloadFile(URL, File, RCERROR)
Else
WC.DownloadFile(URL, File)
End If
End Sub
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing And Not WC Is Nothing Then WC.Dispose()
disposedValue = True
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class End Class
Protected Sub DownloadContentDefault(ByVal Token As CancellationToken) Protected Sub DownloadContentDefault(ByVal Token As CancellationToken)
Try Try
@@ -976,7 +1096,7 @@ BlockNullPicture:
Dim v As UserMedia Dim v As UserMedia
Using w As New OptionalWebClient(Me) Using w As New OptionalWebClient(Me)
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path) If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path)
Progress.Maximum += _ContentNew.Count Progress.Maximum += _ContentNew.Count
For i = 0 To _ContentNew.Count - 1 For i = 0 To _ContentNew.Count - 1
ThrowAny(Token) ThrowAny(Token)
@@ -1007,12 +1127,14 @@ BlockNullPicture:
End If End If
If Not v.SpecialFolder.IsEmptyString Then If Not v.SpecialFolder.IsEmptyString Then
f.Path = $"{f.PathWithSeparator}{v.SpecialFolder}\".CSFileP.Path f.Path = $"{f.PathWithSeparator}{v.SpecialFolder.StringTrimEnd("*")}\".CSFileP.Path
f.Exists(SFO.Path) f.Exists(SFO.Path)
End If End If
If __isVideo And vsf Then If __isVideo And vsf Then
f.Path = $"{f.PathWithSeparator}Video" If v.SpecialFolder.IsEmptyString OrElse Not v.SpecialFolder.EndsWith("*") Then
If Not v.SpecialFolder.IsEmptyString Then f.Exists(SFO.Path) f.Path = $"{f.PathWithSeparator}Video"
If Not v.SpecialFolder.IsEmptyString Then f.Exists(SFO.Path)
End If
End If End If
If v.Type = UTypes.m3u8 And UseInternalM3U8Function Then If v.Type = UTypes.m3u8 And UseInternalM3U8Function Then
@@ -1065,9 +1187,12 @@ BlockNullPicture:
Protected Overridable Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile Protected Overridable Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
Return Nothing Return Nothing
End Function End Function
Protected Const EXCEPTION_OPERATION_CANCELED As Integer = -1
''' <param name="RDE">Request DownloadingException</param> ''' <param name="RDE">Request DownloadingException</param>
''' <returns>0 - exit</returns> ''' <returns>0 - exit</returns>
Protected Function ProcessException(ByVal ex As Exception, ByVal Token As CancellationToken, ByVal Message As String, Optional ByVal RDE As Boolean = True, Optional ByVal EObj As Object = Nothing) As Integer Protected Function ProcessException(ByVal ex As Exception, ByVal Token As CancellationToken, ByVal Message As String,
Optional ByVal RDE As Boolean = True, Optional ByVal EObj As Object = Nothing,
Optional ByVal ThrowEx As Boolean = True) As Integer
If Not ((TypeOf ex Is OperationCanceledException And Token.IsCancellationRequested) Or If Not ((TypeOf ex Is OperationCanceledException And Token.IsCancellationRequested) Or
(TypeOf ex Is ObjectDisposedException And Disposed)) Then (TypeOf ex Is ObjectDisposedException And Disposed)) Then
If RDE Then If RDE Then
@@ -1075,6 +1200,8 @@ BlockNullPicture:
If v = 0 Then LogError(ex, Message) : HasError = True If v = 0 Then LogError(ex, Message) : HasError = True
Return v Return v
End If End If
Else
If ThrowEx Then Throw ex Else Return EXCEPTION_OPERATION_CANCELED
End If End If
Return 0 Return 0
End Function End Function
@@ -1121,7 +1248,7 @@ BlockNullPicture:
End Sub End Sub
#End Region #End Region
#Region "Delete, Move, Merge, Copy" #Region "Delete, Move, Merge, Copy"
Friend Overridable Function Delete(Optional ByVal Multiple As Boolean = False) As Integer Implements IUserData.Delete Friend Overridable Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer Implements IUserData.Delete
Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path) Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then
If Not IncludedInCollection Then MainFrameObj.ImageHandler(Me, False) If Not IncludedInCollection Then MainFrameObj.ImageHandler(Me, False)
@@ -1135,44 +1262,51 @@ BlockNullPicture:
Return 0 Return 0
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, ByVal __SpecialCollectionPath As SFile) As Boolean Implements IUserData.MoveFiles
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
Dim v As Boolean = IsVirtual
If IncludedInCollection Then If IncludedInCollection Then
Settings.Users.Add(Me) Settings.Users.Add(Me)
Removed = False Removed = False
User.CollectionName = String.Empty User.CollectionName = String.Empty
User.IncludedInCollection = False User.SpecialCollectionPath = String.Empty
User.UserModel = UsageModel.Default
User.CollectionModel = UsageModel.Default
Else Else
Settings.Users.Remove(Me) Settings.Users.Remove(Me)
Removed = True Removed = True
User.CollectionName = __CollectionName User.CollectionName = __CollectionName
User.IncludedInCollection = True User.SpecialCollectionPath = __SpecialCollectionPath
User.SpecialPath = Nothing If Not IsVirtual Then User.SpecialPath = Nothing
End If End If
_TurnBack = True _TurnBack = True
User.UpdateUserFile() User.UpdateUserFile()
f = User.File.CutPath(, EDP.ThrowException)
If f.Exists(SFO.Path, False) Then If Not v Then
If If(SFile.GetFiles(f,, SearchOption.AllDirectories), New List(Of SFile)).Count > 0 AndAlso f = User.File.CutPath(, EDP.ThrowException)
MsgBoxE({$"Destination directory [{f.Path}] already exists and contains files!" & vbCr & If f.Exists(SFO.Path, False) Then
"By continuing, this directory and all files will be deleted", If If(SFile.GetFiles(f,, SearchOption.AllDirectories), New List(Of SFile)).Count > 0 AndAlso
"Destination directory is not empty!"}, MsgBoxStyle.Exclamation,,, {"Delete", "Cancel"}) = 1 Then MsgBoxE({$"Destination directory [{f.Path}] already exists and contains files!" & vbCr &
MsgBoxE("Operation canceled", MsgBoxStyle.Exclamation) "By continuing, this directory and all files will be deleted",
User = UserBefore "Destination directory is not empty!"}, MsgBoxStyle.Exclamation,,, {"Delete", "Cancel"}) = 1 Then
If Removed Then Settings.Users.Add(Me) Else Settings.Users.Remove(Me) MsgBoxE("Operation canceled", MsgBoxStyle.Exclamation)
_TurnBack = False User = UserBefore
Return False If Removed Then Settings.Users.Add(Me) Else Settings.Users.Remove(Me)
_TurnBack = False
Return False
End If
f.Delete(SFO.Path, Settings.DeleteMode, EDP.ThrowException)
End If End If
f.Delete(SFO.Path, Settings.DeleteMode, EDP.ThrowException) f.CutPath.Exists(SFO.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)
End If End If
f.CutPath.Exists(SFO.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()
@@ -1261,7 +1395,7 @@ BlockNullPicture:
Else Else
pOffset = 1 pOffset = 1
End If End If
fSource = User.File.CutPath(pOffset).Path.CSFileP fSource = MyFile.CutPath(pOffset).Path.CSFileP
Dim OptPath$ = String.Empty Dim OptPath$ = String.Empty
If IncludedInCollection Then If IncludedInCollection Then
@@ -1408,6 +1542,7 @@ BlockNullPicture:
End Sub End Sub
#End Region #End Region
End Class End Class
#Region "Base interfaces"
Friend Interface IContentProvider Friend Interface IContentProvider
ReadOnly Property Site As String ReadOnly Property Site As String
Property Name As String Property Name As String
@@ -1430,6 +1565,9 @@ BlockNullPicture:
ReadOnly Property IsCollection As Boolean ReadOnly Property IsCollection As Boolean
Property CollectionName As String Property CollectionName As String
ReadOnly Property IncludedInCollection As Boolean ReadOnly Property IncludedInCollection As Boolean
ReadOnly Property UserModel As UsageModel
ReadOnly Property CollectionModel As UsageModel
ReadOnly Property IsVirtual As Boolean
ReadOnly Property Labels As List(Of String) ReadOnly Property Labels As List(Of String)
#End Region #End Region
ReadOnly Property IsChannel As Boolean ReadOnly Property IsChannel As Boolean
@@ -1461,11 +1599,10 @@ BlockNullPicture:
''' 2 - Collection removed<br/> ''' 2 - Collection removed<br/>
''' 3 - Collection split ''' 3 - Collection split
''' </summary> ''' </summary>
Function Delete(Optional ByVal Multiple As Boolean = False) As Integer Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer
Function MoveFiles(ByVal CollectionName As String) As Boolean Function MoveFiles(ByVal CollectionName As String, ByVal SpecialCollectionPath As SFile) As Boolean
Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Sub OpenFolder() Sub OpenFolder()
ReadOnly Property Self As IUserData
Property DownloadTopCount As Integer? Property DownloadTopCount As Integer?
Property DownloadDateFrom As Date? Property DownloadDateFrom As Date?
Property DownloadDateTo As Date? Property DownloadDateTo As Date?
@@ -1485,4 +1622,5 @@ BlockNullPicture:
Property SkipExistsUsers As Boolean Property SkipExistsUsers As Boolean
Property SaveToCache As Boolean Property SaveToCache As Boolean
End Interface End Interface
#End Region
End Namespace End Namespace

View File

@@ -0,0 +1,86 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Namespace API.BaseObjects
Friend Interface IDomainContainer
ReadOnly Property Icon As Icon
ReadOnly Property Site As String
ReadOnly Property Domains As List(Of String)
ReadOnly Property DomainsTemp As List(Of String)
ReadOnly Property DomainsDefault As String
ReadOnly Property DomainsSettingProp As Plugin.PropertyValue
Property DomainsChanged As Boolean
Property Initialized As Boolean
Property DomainsUpdateInProgress As Boolean
Property DomainsUpdatedBySite As Boolean
Sub UpdateDomains()
End Interface
Friend NotInheritable Class DomainContainer
Private Sub New()
End Sub
Friend Shared Sub EndInit(ByVal s As IDomainContainer)
If ACheck(s.DomainsSettingProp.Value) Then s.Domains.ListAddList(CStr(s.DomainsSettingProp.Value).Split("|"), LAP.NotContainsOnly)
End Sub
Friend Overloads Shared Sub UpdateDomains(ByVal s As IDomainContainer)
UpdateDomains(s, Nothing, True)
End Sub
Friend Overloads Shared Sub UpdateDomains(ByVal s As IDomainContainer, ByVal NewDomains As IEnumerable(Of String), ByVal Internal As Boolean)
With s
If Not .Initialized Or (.DomainsUpdatedBySite And Not Internal) Then Exit Sub
If Not .DomainsUpdateInProgress Then
.DomainsUpdateInProgress = True
.Domains.ListAddList(.DomainsDefault.Split("|"), LAP.NotContainsOnly)
.Domains.ListAddList(NewDomains, LAP.NotContainsOnly)
.DomainsSettingProp.Value = .Domains.ListToString("|")
If Not Internal Then .DomainsUpdatedBySite = True
.DomainsUpdateInProgress = False
End If
End With
End Sub
Friend Shared Sub Update(ByVal s As IDomainContainer)
With s
If .DomainsChanged Then
.Domains.Clear()
.Domains.ListAddList(.DomainsTemp, LAP.NotContainsOnly)
.UpdateDomains()
End If
End With
End Sub
Friend Shared Sub EndEdit(ByVal s As IDomainContainer)
s.DomainsTemp.ListAddList(s.Domains, LAP.ClearBeforeAdd, LAP.NotContainsOnly)
s.DomainsChanged = False
End Sub
Friend Shared Sub OpenSettingsForm(ByVal s As IDomainContainer)
Dim __add As EventHandler(Of SimpleListFormEventArgs) = Sub(sender, e) e.ValueNew = InputBoxE($"Enter a new domain using the pattern [{s.Site}.com]:", "New domain").IfNullOrEmptyE(Nothing)
Dim __delete As EventHandler(Of SimpleListFormEventArgs) = Sub(sender, e)
Dim n$ = AConvert(Of String)(e.ValueCurrent, AModes.Var, String.Empty)
e.Result = MsgBoxE({$"Are you sure you want to delete the [{n}] domain?",
"Removing domains"}, vbYesNo) = vbYes
End Sub
Using f As New SimpleListForm(Of String)(If(s.DomainsChanged, s.DomainsTemp, s.Domains), Settings.Design) With {
.Buttons = {ADB.Add, ADB.Delete},
.Mode = SimpleListFormModes.Remaining,
.FormText = s.Site,
.Icon = s.Icon,
.LocationOnly = True,
.Size = New Size(400, 330),
.DesignXMLNodeName = s.Site
}
AddHandler f.AddClick, __add
AddHandler f.DeleteClick, __delete
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then
s.DomainsChanged = True
s.DomainsTemp.ListAddList(f.DataResult, LAP.ClearBeforeAdd, LAP.NotContainsOnly)
End If
End Using
End Sub
End Class
End Namespace

View File

@@ -17,7 +17,18 @@ Namespace API.Gfycat
Try Try
Dim r$ Dim r$
Using w As New WebClient : r = w.DownloadString(URL) : End Using Using w As New WebClient : r = w.DownloadString(URL) : End Using
If Not r.IsEmptyString Then Return RegexReplace(r, RParams.DMS("contentUrl.:.(http.?://[^""]+?\.mp4)", 1)) Else Return String.Empty If Not r.IsEmptyString Then
Dim _url$ = RegexReplace(r, RParams.DMS("contentUrl.:.(http.?://[^""]+?\.mp4)", 1, EDP.ReturnValue))
If Not _url.IsEmptyString Then
If _url.Contains("redgifs.com") Then
_url = RegexReplace(_url, RParams.DMS("([^/-]+)[-\w]*\.mp4", 1, EDP.ReturnValue))
If Not _url.IsEmptyString Then Return $"https://www.redgifs.com/watch/{_url}"
Else
Return _url
End If
End If
End If
Return String.Empty
Catch ex As Exception Catch ex As Exception
Dim e As EDP = EDP.ReturnValue Dim e As EDP = EDP.ReturnValue
If TypeOf ex Is WebException Then If TypeOf ex Is WebException Then

View File

@@ -11,11 +11,11 @@ Imports SCrawler.API.Base
Imports SCrawler.API.Imgur.Declarations Imports SCrawler.API.Imgur.Declarations
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WebDocuments.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Namespace API.Imgur Namespace API.Imgur
Namespace Declarations Namespace Declarations
Friend Module Imgur_Declarations Friend Module Imgur_Declarations
Friend ReadOnly PostRegex As RParams = RParams.DMS("/([\w\d]+?)(|\.[\w]{0,4})\Z", 1) Friend ReadOnly PostRegex As RParams = RParams.DMS("/([^/]+?)(|#.*?|\.[\w]{0,4})(|\?.*?)\Z", 1)
End Module End Module
End Namespace End Namespace
Friend NotInheritable Class Envir Friend NotInheritable Class Envir
@@ -70,11 +70,12 @@ Namespace API.Imgur
Friend Shared Function GetVideoInfo(ByVal URL As String, Optional ByVal e As ErrorsDescriber = Nothing) As IEnumerable(Of UserMedia) Friend Shared Function GetVideoInfo(ByVal URL As String, Optional ByVal e As ErrorsDescriber = Nothing) As IEnumerable(Of UserMedia)
Try Try
If Not URL.IsEmptyString AndAlso URL.ToLower.Contains("imgur") AndAlso Not Settings.ImgurClientID.IsEmptyString Then If Not URL.IsEmptyString AndAlso URL.ToLower.Contains("imgur") AndAlso Not Settings.ImgurClientID.IsEmptyString Then
Dim img$ = GetImage(URL, EDP.ReturnValue) Dim imgList As List(Of String) = GetGallery(URL, EDP.ReturnValue)
If Not img.IsEmptyString Then If imgList.ListExists Then
Return {New UserMedia(img)} Return imgList.Select(Function(u) New UserMedia(u))
Else Else
Return GetGallery(URL, EDP.ReturnValue).ListIfNothing.Select(Function(u) New UserMedia(u)) Dim img$ = GetImage(URL, EDP.ReturnValue)
If Not img.IsEmptyString Then Return {New UserMedia(img)}
End If End If
End If End If
Return Nothing Return Nothing

View File

@@ -7,11 +7,49 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Clients.EventArguments
Imports PersonalUtilities.Tools.Web.Cookies
Namespace API.Instagram Namespace API.Instagram
Friend Module Declarations Friend Module Declarations
Friend Const InstagramSite As String = "Instagram" Friend Const InstagramSite As String = "Instagram"
Friend Const InstagramSiteKey As String = "AndyProgram_Instagram" Friend Const InstagramSiteKey As String = "AndyProgram_Instagram"
Friend ReadOnly FilesPattern As RParams = RParams.DMS(".+?([^/\?]+?\.[\w\d]{3,4})(?=(\?|\Z))", 1, EDP.ReturnValue) Friend ReadOnly FilesPattern As RParams = RParams.DMS(".+?([^/\?]+?\.[\w\d]{3,4})(?=(\?|\Z))", 1, EDP.ReturnValue)
Friend ReadOnly Property DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v)) Friend ReadOnly Property DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v))
Friend Sub UpdateResponser(ByVal Source As IResponse, ByRef Destination As Responser)
Const r_wwwClaimName$ = "x-ig-set-www-claim"
Const r_tokenName$ = "csrftoken"
If Not Source Is Nothing Then
Dim isInternal As Boolean = TypeOf Source Is WebDataResponse
Dim wwwClaimName$, tokenName$
If isInternal Then
wwwClaimName = r_wwwClaimName
tokenName = r_tokenName
Else
wwwClaimName = SiteSettings.Header_IG_WWW_CLAIM
tokenName = SiteSettings.Header_CSRF_TOKEN
End If
Dim wwwClaim$ = String.Empty
Dim token$ = String.Empty
With Source
If isInternal Then
If .HeadersExists Then wwwClaim = .Headers.Value(wwwClaimName)
If .CookiesExists Then token = If(.Cookies.FirstOrDefault(Function(c) c.Name = tokenName)?.Value, String.Empty)
Else
If .HeadersExists Then
wwwClaim = .Headers.Value(wwwClaimName)
token = .Headers.Value(tokenName)
End If
End If
End With
If Not wwwClaim.IsEmptyString Then Destination.Headers.Add(SiteSettings.Header_IG_WWW_CLAIM, wwwClaim)
If Not token.IsEmptyString Then Destination.Headers.Add(SiteSettings.Header_CSRF_TOKEN, token)
If Not isInternal Then
Destination.Cookies.Update(Source.Cookies, CookieKeeper.UpdateModes.ReplaceByNameAll, False, EDP.SendInLog)
Destination.SaveSettings()
End If
End If
End Sub
End Module End Module
End Namespace End Namespace

View File

@@ -9,10 +9,12 @@
Imports SCrawler.Plugin Imports SCrawler.Plugin
Namespace API.Instagram Namespace API.Instagram
Friend Class EditorExchangeOptions Friend Class EditorExchangeOptions
Friend Property GetTimeline As Boolean
Friend Property GetStories As Boolean Friend Property GetStories As Boolean
Friend Property GetTagged As Boolean Friend Property GetTagged As Boolean
Friend Sub New(ByVal h As ISiteSettings) Friend Sub New(ByVal h As ISiteSettings)
With DirectCast(h, SiteSettings) With DirectCast(h, SiteSettings)
GetTimeline = CBool(.GetTimeline.Value)
GetStories = CBool(.GetStories.Value) GetStories = CBool(.GetStories.Value)
GetTagged = CBool(.GetTagged.Value) GetTagged = CBool(.GetTagged.Value)
End With End With

View File

@@ -26,6 +26,7 @@ Namespace API.Instagram
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Me.CH_GET_STORIES = New System.Windows.Forms.CheckBox() Me.CH_GET_STORIES = New System.Windows.Forms.CheckBox()
Me.CH_GET_TAGGED = New System.Windows.Forms.CheckBox() Me.CH_GET_TAGGED = New System.Windows.Forms.CheckBox()
Me.CH_GET_TIMELINE = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer() CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel() TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout() CONTAINER_MAIN.ContentPanel.SuspendLayout()
@@ -39,13 +40,13 @@ Namespace API.Instagram
'CONTAINER_MAIN.ContentPanel 'CONTAINER_MAIN.ContentPanel
' '
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN) CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(260, 53) CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(260, 79)
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)
CONTAINER_MAIN.Name = "CONTAINER_MAIN" CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(260, 78) CONTAINER_MAIN.Size = New System.Drawing.Size(260, 104)
CONTAINER_MAIN.TabIndex = 0 CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False CONTAINER_MAIN.TopToolStripPanelVisible = False
' '
@@ -54,26 +55,28 @@ Namespace API.Instagram
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single] TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1 TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Controls.Add(Me.CH_GET_STORIES, 0, 0) TP_MAIN.Controls.Add(Me.CH_GET_STORIES, 0, 1)
TP_MAIN.Controls.Add(Me.CH_GET_TAGGED, 0, 1) TP_MAIN.Controls.Add(Me.CH_GET_TAGGED, 0, 2)
TP_MAIN.Controls.Add(Me.CH_GET_TIMELINE, 0, 0)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0) TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN" TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 3 TP_MAIN.RowCount = 4
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(260, 53) TP_MAIN.Size = New System.Drawing.Size(260, 79)
TP_MAIN.TabIndex = 0 TP_MAIN.TabIndex = 0
' '
'CH_GET_STORIES 'CH_GET_STORIES
' '
Me.CH_GET_STORIES.AutoSize = True Me.CH_GET_STORIES.AutoSize = True
Me.CH_GET_STORIES.Dock = System.Windows.Forms.DockStyle.Fill Me.CH_GET_STORIES.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_GET_STORIES.Location = New System.Drawing.Point(4, 4) Me.CH_GET_STORIES.Location = New System.Drawing.Point(4, 30)
Me.CH_GET_STORIES.Name = "CH_GET_STORIES" Me.CH_GET_STORIES.Name = "CH_GET_STORIES"
Me.CH_GET_STORIES.Size = New System.Drawing.Size(252, 19) Me.CH_GET_STORIES.Size = New System.Drawing.Size(252, 19)
Me.CH_GET_STORIES.TabIndex = 0 Me.CH_GET_STORIES.TabIndex = 1
Me.CH_GET_STORIES.Text = "Get stories" Me.CH_GET_STORIES.Text = "Get stories"
Me.CH_GET_STORIES.UseVisualStyleBackColor = True Me.CH_GET_STORIES.UseVisualStyleBackColor = True
' '
@@ -81,26 +84,37 @@ Namespace API.Instagram
' '
Me.CH_GET_TAGGED.AutoSize = True Me.CH_GET_TAGGED.AutoSize = True
Me.CH_GET_TAGGED.Dock = System.Windows.Forms.DockStyle.Fill Me.CH_GET_TAGGED.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_GET_TAGGED.Location = New System.Drawing.Point(4, 30) Me.CH_GET_TAGGED.Location = New System.Drawing.Point(4, 56)
Me.CH_GET_TAGGED.Name = "CH_GET_TAGGED" Me.CH_GET_TAGGED.Name = "CH_GET_TAGGED"
Me.CH_GET_TAGGED.Size = New System.Drawing.Size(252, 19) Me.CH_GET_TAGGED.Size = New System.Drawing.Size(252, 19)
Me.CH_GET_TAGGED.TabIndex = 1 Me.CH_GET_TAGGED.TabIndex = 2
Me.CH_GET_TAGGED.Text = "Get tagged data" Me.CH_GET_TAGGED.Text = "Get tagged data"
Me.CH_GET_TAGGED.UseVisualStyleBackColor = True Me.CH_GET_TAGGED.UseVisualStyleBackColor = True
' '
'CH_GET_TIMELINE
'
Me.CH_GET_TIMELINE.AutoSize = True
Me.CH_GET_TIMELINE.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_GET_TIMELINE.Location = New System.Drawing.Point(4, 4)
Me.CH_GET_TIMELINE.Name = "CH_GET_TIMELINE"
Me.CH_GET_TIMELINE.Size = New System.Drawing.Size(252, 19)
Me.CH_GET_TIMELINE.TabIndex = 0
Me.CH_GET_TIMELINE.Text = "Get Timeline"
Me.CH_GET_TIMELINE.UseVisualStyleBackColor = True
'
'OptionsForm 'OptionsForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(260, 78) Me.ClientSize = New System.Drawing.Size(260, 104)
Me.Controls.Add(CONTAINER_MAIN) Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteResources.InstagramIcon_32 Me.Icon = Global.SCrawler.My.Resources.SiteResources.InstagramIcon_32
Me.KeyPreview = True Me.KeyPreview = True
Me.MaximizeBox = False Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(276, 117) Me.MaximumSize = New System.Drawing.Size(276, 143)
Me.MinimizeBox = False Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(276, 117) Me.MinimumSize = New System.Drawing.Size(276, 143)
Me.Name = "OptionsForm" Me.Name = "OptionsForm"
Me.ShowInTaskbar = False Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
@@ -116,5 +130,6 @@ Namespace API.Instagram
Private WithEvents CH_GET_STORIES As CheckBox Private WithEvents CH_GET_STORIES As CheckBox
Private WithEvents CH_GET_TAGGED As CheckBox Private WithEvents CH_GET_TAGGED As CheckBox
Private WithEvents CH_GET_TIMELINE As CheckBox
End Class End Class
End Namespace End Namespace

View File

@@ -21,6 +21,7 @@ Namespace API.Instagram
.MyViewInitialize(True) .MyViewInitialize(True)
.AddOkCancelToolbar() .AddOkCancelToolbar()
With MyExchangeOptions With MyExchangeOptions
CH_GET_TIMELINE.Checked = .GetTimeline
CH_GET_STORIES.Checked = .GetStories CH_GET_STORIES.Checked = .GetStories
CH_GET_TAGGED.Checked = .GetTagged CH_GET_TAGGED.Checked = .GetTagged
End With End With
@@ -29,6 +30,7 @@ Namespace API.Instagram
End Sub End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With MyExchangeOptions With MyExchangeOptions
.GetTimeline = CH_GET_TIMELINE.Checked
.GetStories = CH_GET_STORIES.Checked .GetStories = CH_GET_STORIES.Checked
.GetTagged = CH_GET_TAGGED.Checked .GetTagged = CH_GET_TAGGED.Checked
End With End With

View File

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

View File

@@ -11,11 +11,14 @@ Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Objects
Imports PersonalUtilities.Functions.XML.Base Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports Download = SCrawler.Plugin.ISiteSettings.Download Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Instagram Namespace API.Instagram
<Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False), SpecialForm(True)> <Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations" #Region "Declarations"
#Region "Images" #Region "Images"
@@ -77,28 +80,23 @@ Namespace API.Instagram
End Class End Class
#End Region #End Region
#Region "Authorization properties" #Region "Authorization properties"
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash", IsAuth:=True, AllowNull:=False), PXML("InstaHash"), ControlNumber(0)> <PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash for tagged posts", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)>
Friend ReadOnly Property Hash As PropertyValue Friend ReadOnly Property HashTagged As PropertyValue
Private Const HashSavedPosts_Text As String = "Hash 2" <PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(2)>
<PropertyOption(ControlText:=HashSavedPosts_Text, ControlToolTip:="Instagram session hash for saved posts", IsAuth:=True), PXML("InstaHashSavedPosts"), ControlNumber(1)>
Friend ReadOnly Property HashSavedPosts As PropertyValue
<PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Instagram token for tagged data", IsAuth:=True, AllowNull:=False), ControlNumber(2)>
Friend ReadOnly Property CSRF_TOKEN As PropertyValue Friend ReadOnly Property CSRF_TOKEN As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3)> <PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3)>
Friend Property IG_APP_ID As PropertyValue Friend Property IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=False), ControlNumber(4)> <PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=True), ControlNumber(4)>
Friend Property IG_WWW_CLAIM As PropertyValue Friend Property IG_WWW_CLAIM As PropertyValue
Private Const SavedPostsUserName_Text As String = "Saved posts user"
<PropertyOption(ControlText:=SavedPostsUserName_Text, IsAuth:=True), PXML("SavedPostsUserName"), ControlNumber(5)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend Overrides Function BaseAuthExists() As Boolean Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 And ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value) Return Responser.CookiesExists And ACheck(IG_APP_ID.Value) And ACheck(CSRF_TOKEN.Value)
End Function End Function
Private Const Header_IG_APP_ID As String = "x-ig-app-id" Private Const Header_IG_APP_ID As String = "x-ig-app-id"
Private Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim" Friend Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Private Const Header_CSRF_TOKEN As String = "x-csrftoken" Friend Const Header_CSRF_TOKEN As String = "x-csrftoken"
Private _FieldsChangerSuspended As Boolean = False
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object) Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then If Not _FieldsChangerSuspended And Not PropName.IsEmptyString Then
Dim f$ = String.Empty Dim f$ = String.Empty
Select Case PropName Select Case PropName
Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID
@@ -106,7 +104,7 @@ Namespace API.Instagram
Case NameOf(CSRF_TOKEN) : f = Header_CSRF_TOKEN Case NameOf(CSRF_TOKEN) : f = Header_CSRF_TOKEN
End Select End Select
If Not f.IsEmptyString Then If Not f.IsEmptyString Then
If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f) Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value)) If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
Responser.SaveSettings() Responser.SaveSettings()
End If End If
@@ -114,33 +112,38 @@ Namespace API.Instagram
End Sub End Sub
#End Region #End Region
#Region "Download properties" #Region "Download properties"
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(6)> <PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(20)>
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(7)> <PropertyOption(ControlText:="Request timer counter", AllowNull:=False, LeftOffset:=120), PXML("RequestsWaitTimerTaskCount"), ControlNumber(21)>
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(8)> <PropertyOption(ControlText:="Posts limit timer", AllowNull:=False), PXML("SleepTimerOnPostsLimit"), ControlNumber(22)>
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(9)> <PropertyOption(ControlText:="Get timeline", ControlToolTip:="Default value for new users"), PXML, ControlNumber(23)>
Friend ReadOnly Property GetTimeline As PropertyValue
<PropertyOption(ControlText:="Get stories", ControlToolTip:="Default value for new users"), PXML, ControlNumber(24)>
Friend ReadOnly Property GetStories As PropertyValue Friend ReadOnly Property GetStories As PropertyValue
<PropertyOption(ControlText:="Get tagged photos"), PXML, ControlNumber(10)> <PropertyOption(ControlText:="Get tagged photos", ControlToolTip:="Default value for new users"), PXML, ControlNumber(25)>
Friend ReadOnly Property GetTagged As PropertyValue Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit", <PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr & ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr &
"-1 to disable"), PXML, ControlNumber(11)> "-1 to disable"), PXML, ControlNumber(26)>
Friend ReadOnly Property TaggedNotifyLimit As PropertyValue Friend ReadOnly Property TaggedNotifyLimit As PropertyValue
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)> <Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region #End Region
#Region "Download ready" #Region "Download ready"
Friend ReadOnly Property DownloadTimeline As XMLValue(Of Boolean) <PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline"), PXML, ControlNumber(10)>
Friend ReadOnly Property DownloadStoriesTagged As XMLValue(Of Boolean) Friend ReadOnly Property DownloadTimeline As PropertyValue
Friend ReadOnly Property DownloadSaved As XMLValue(Of Boolean) <PropertyOption(ControlText:="Download stories", ControlToolTip:="Download stories"), PXML, ControlNumber(11)>
Friend ReadOnly Property DownloadStories As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(12)>
Friend ReadOnly Property DownloadTagged As PropertyValue
#End Region #End Region
#Region "429 bypass" #Region "429 bypass"
Private ReadOnly Property DownloadingErrorDate As XMLValue(Of Date) Private ReadOnly Property DownloadingErrorDate As XMLValue(Of Date)
@@ -202,31 +205,25 @@ Namespace API.Instagram
With Responser With Responser
If .Headers.Count > 0 Then If .Headers.Count > 0 Then
With .Headers token = .Headers.Value(Header_CSRF_TOKEN)
If .ContainsKey(Header_CSRF_TOKEN) Then token = .Item(Header_CSRF_TOKEN) app_id = .Headers.Value(Header_IG_APP_ID)
If .ContainsKey(Header_IG_APP_ID) Then app_id = .Item(Header_IG_APP_ID) www_claim = .Headers.Value(Header_IG_WWW_CLAIM)
If .ContainsKey(Header_IG_WWW_CLAIM) Then www_claim = .Item(Header_IG_WWW_CLAIM)
End With
End If
If Not .Cookies Is Nothing Then
.Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False
End If End If
.CookiesExtractMode = Responser.CookiesExtractModes.Response
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
.CookiesExtractedAutoSave = False
End With End With
Dim n() As String = {SettingsCLS.Name_Node_Sites, Site.ToString} Dim n() As String = {SettingsCLS.Name_Node_Sites, Site.ToString}
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String)) HashTagged = New PropertyValue(String.Empty, GetType(String))
Hash = New PropertyValue(String.Empty, GetType(String))
HashSavedPosts = New PropertyValue(String.Empty, GetType(String))
CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(CSRF_TOKEN), v)) CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(CSRF_TOKEN), v))
IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_APP_ID), v)) IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_APP_ID), v))
IG_WWW_CLAIM = New PropertyValue(www_claim, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_WWW_CLAIM), v)) IG_WWW_CLAIM = New PropertyValue(www_claim.IfNullOrEmpty(0), GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_WWW_CLAIM), v))
DownloadTimeline = New XMLValue(Of Boolean)("DownloadTimeline", True, _XML, n) DownloadTimeline = New PropertyValue(True)
DownloadStoriesTagged = New XMLValue(Of Boolean)("DownloadStoriesTagged", True, _XML, n) DownloadStories = New PropertyValue(True)
DownloadSaved = New XMLValue(Of Boolean)("DownloadSaved", True, _XML, n) DownloadTagged = New PropertyValue(False)
RequestsWaitTimer = New PropertyValue(1000) RequestsWaitTimer = New PropertyValue(1000)
RequestsWaitTimerProvider = New TimersChecker(100) RequestsWaitTimerProvider = New TimersChecker(100)
@@ -235,106 +232,25 @@ Namespace API.Instagram
SleepTimerOnPostsLimit = New PropertyValue(60000) SleepTimerOnPostsLimit = New PropertyValue(60000)
SleepTimerOnPostsLimitProvider = New TimersChecker(10000) SleepTimerOnPostsLimitProvider = New TimersChecker(10000)
GetTimeline = New PropertyValue(True)
GetStories = New PropertyValue(False) GetStories = New PropertyValue(False)
GetTagged = New PropertyValue(False) GetTagged = New PropertyValue(False)
TaggedNotifyLimit = New PropertyValue(200) TaggedNotifyLimit = New PropertyValue(200)
TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker TaggedNotifyLimitProvider = New TaggedNotifyLimitChecker
DownloadingErrorDate = New XMLValue(Of Date) With {.Provider = New XMLValueConversionProvider(Function(ss, vv) AConvert(Of String)(vv, AModes.Var, Nothing))} DownloadingErrorDate = New XMLValue(Of Date) With {.Provider = New XMLValueConversionProvider(Function(ss, nn, vv, dd) 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)) LastRequestsCountLabel = New PropertyValue(LastRequestsCountLabelStr.Invoke(LastRequestsCount.Value))
AddHandler LastRequestsCount.OnValueChanged, Sub(sender, __name, __value) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(DirectCast(__value, Existable(Of Integer)).Value) AddHandler LastRequestsCount.ValueChanged, Sub(sender, e) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(DirectCast(sender, XMLValue(Of Integer)).ValueF.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
Private Structure LatestValues
Friend Hash As String
Friend Hash2 As String
Friend Token As String
Friend AppID As String
Friend WwwClaim As String
Friend Exists As Boolean
Friend Sub New(ByVal Source As SiteSettings)
Exists = True
With Source
Hash = AConvert(Of String)(.Hash.Value, String.Empty)
Hash2 = AConvert(Of String)(.HashSavedPosts.Value, String.Empty)
With .Responser.Headers
If .ContainsKey(Header_CSRF_TOKEN) Then Token = .Item(Header_CSRF_TOKEN)
If .ContainsKey(Header_IG_APP_ID) Then AppID = .Item(Header_IG_APP_ID)
If .ContainsKey(Header_IG_WWW_CLAIM) Then WwwClaim = .Item(Header_IG_WWW_CLAIM)
End With
End With
End Sub
End Structure
Private LV As LatestValues = Nothing
Private ASO As SettingsExchangeOptions = Nothing
Friend Overrides Sub BeginEdit()
LV = New LatestValues(Me)
ASO = Nothing
MyBase.BeginEdit()
End Sub
Friend Overrides Sub EndEdit()
LV = Nothing
ASO = Nothing
MyBase.EndEdit()
End Sub
Friend Overrides Sub Update()
If LV.Exists Then
Dim __lv As New LatestValues(Me)
If If(Responser.Cookies?.Count, 0) > 0 Then
Dim _cookiesChanged As Boolean = If(Responser.Cookies?.Changed, False)
If Not DownloadTimeline AndAlso (_cookiesChanged Or
(Not LV.Hash = __lv.Hash And Not __lv.Hash.IsEmptyString)) Then DownloadTimeline.Value = True
If Not DownloadSaved AndAlso (_cookiesChanged Or (Not LV.Hash2 = __lv.Hash2 And Not __lv.Hash2.IsEmptyString)) Then DownloadSaved.Value = True
If Not DownloadStoriesTagged AndAlso (
_cookiesChanged Or (
(Not LV.Hash = __lv.Hash Or Not LV.Token = __lv.Token Or Not LV.AppID = __lv.AppID Or Not LV.WwwClaim = __lv.WwwClaim) And
(Not __lv.Hash.IsEmptyString And Not __lv.Token.IsEmptyString And Not __lv.AppID.IsEmptyString And Not __lv.WwwClaim.IsEmptyString)
)) Then DownloadStoriesTagged.Value = True
End If
End If
If ASO.Changed Then
DownloadTimeline.Value = ASO.DownloadTimeline
DownloadStoriesTagged.Value = ASO.DownloadStoriesTagged
DownloadSaved.Value = ASO.DownloadSaved
End If
LV = Nothing
ASO = Nothing
If Not Responser.Cookies Is Nothing Then Responser.Cookies.Changed = False
MyBase.Update()
End Sub
#End Region #End Region
#Region "PropertiesDataChecker" #Region "PropertiesDataChecker"
<PropertiesDataChecker({NameOf(Hash), NameOf(HashSavedPosts)})>
Private Function CheckHashControls(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists(2) Then
Dim h$ = String.Empty
Dim hsp$ = String.Empty
For Each pp As PropertyData In p
Select Case pp.Name
Case NameOf(Hash) : h = AConvert(Of String)(pp.Value, String.Empty)
Case NameOf(HashSavedPosts) : hsp = AConvert(Of String)(pp.Value, String.Empty)
End Select
Next
If h.IsEmptyString And hsp.IsEmptyString Then
Return True
Else
If h = hsp Then
MsgBoxE({"InstaHash for saved posts must be different from InstaHash!", "InstaHash are equal"}, vbCritical)
Return False
Else
Return True
End If
End If
Else
Return False
End If
End Function
<PropertiesDataChecker({NameOf(TaggedNotifyLimit)})> <PropertiesDataChecker({NameOf(TaggedNotifyLimit)})>
Private Function CheckNotifyLimit(ByVal p As IEnumerable(Of PropertyData)) As Boolean Private Function CheckNotifyLimit(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists Then If p.ListExists Then
@@ -353,37 +269,6 @@ Namespace API.Instagram
End If End If
Return False Return False
End Function End Function
<PropertiesDataChecker({NameOf(HashSavedPosts), NameOf(SavedPostsUserName)})>
Private Function CheckSavedOptions(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists Then
Const MsgTitle$ = "Saved posts credentials"
Dim __hash$ = String.Empty
Dim __name$ = String.Empty
Dim _OptionlErrorText$ = $"For download saved posts, you must to set both [{HashSavedPosts_Text}] and [{SavedPostsUserName_Text}]."
For i% = 0 To p.Count - 1
Select Case p(i).Name
Case NameOf(HashSavedPosts) : __hash = p(i).Value
Case NameOf(SavedPostsUserName) : __name = p(i).Value
End Select
Next
If __hash = __name Then
If __hash.IsEmptyString Then
Return True
Else
MsgBoxE({$"[{HashSavedPosts_Text}] and [{SavedPostsUserName_Text}] for saved posts cannot be equal!", MsgTitle}, vbCritical)
End If
Else
If __hash.IsEmptyString Then
MsgBoxE({$"[{HashSavedPosts_Text}] not set.{vbCr}{_OptionlErrorText}", MsgTitle}, vbCritical)
ElseIf __name.IsEmptyString Then
MsgBoxE({$"[{SavedPostsUserName_Text}] not set.{vbCr}{_OptionlErrorText}", MsgTitle}, vbCritical)
Else
Return True
End If
End If
End If
Return False
End Function
#End Region #End Region
#Region "Plugin functions" #Region "Plugin functions"
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
@@ -391,7 +276,7 @@ Namespace API.Instagram
Case Download.Main : Return New UserData Case Download.Main : Return New UserData
Case Download.SavedPosts Case Download.SavedPosts
Dim u As New UserData Dim u As New UserData
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))} DirectCast(u, UserDataBase).User = New UserInfo With {.Name = Site}
Return u Return u
End Select End Select
Return Nothing Return Nothing
@@ -399,19 +284,14 @@ Namespace API.Instagram
#Region "Downloading" #Region "Downloading"
Friend Property SkipUntilNextSession As Boolean = False Friend Property SkipUntilNextSession As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() Then Return ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso DownloadTimeline.Value
Select Case What
Case Download.Main : Return ACheck(Hash.Value) And DownloadTimeline
Case Download.SavedPosts : Return ACheck(HashSavedPosts.Value) And DownloadSaved
End Select
End If
Return False
End Function End Function
Private ActiveJobs As Integer = 0 Private ActiveJobs As Integer = 0
Private _NextWNM As UserData.WNM = UserData.WNM.Notify Private _NextWNM As UserData.WNM = UserData.WNM.Notify
Private _NextTagged As Boolean = True Private _NextTagged As Boolean = True
Friend Overrides Sub DownloadStarted(ByVal What As Download) Friend Overrides Sub DownloadStarted(ByVal What As Download)
ActiveJobs += 1 ActiveJobs += 1
If LastDownloadDate.Value.AddMinutes(120) < Now Or Not ACheck(IG_WWW_CLAIM.Value) Then IG_WWW_CLAIM.Value = "0"
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)
@@ -434,6 +314,10 @@ Namespace API.Instagram
_NextTagged = .TaggedCheckSession _NextTagged = .TaggedCheckSession
LastDownloadDate.Value = Now LastDownloadDate.Value = Now
LastRequestsCount.Value = .RequestsCount LastRequestsCount.Value = .RequestsCount
_FieldsChangerSuspended = True
IG_WWW_CLAIM.Value = Responser.Headers.Value(Header_IG_WWW_CLAIM)
CSRF_TOKEN.Value = Responser.Headers.Value(Header_CSRF_TOKEN)
_FieldsChangerSuspended = False
End With End With
End Sub End Sub
Friend Overrides Sub DownloadDone(ByVal What As Download) Friend Overrides Sub DownloadDone(ByVal What As Download)
@@ -453,12 +337,14 @@ Namespace API.Instagram
Using f As New OptionsForm(Options) : f.ShowDialog() : End Using Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If End If
End Sub End Sub
Friend Overrides Sub OpenSettingsForm() Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Using f As New AdditionalSettingsForm(If(ASO.Changed, ASO, New SettingsExchangeOptions(Me))) Try
f.ShowDialog() Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID)
If f.DialogResult = DialogResult.OK Then ASO = f.MyParameters If Not code.IsEmptyString Then Return $"https://instagram.com/p/{code}/" Else Return String.Empty
End Using Catch ex As Exception
End Sub Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "Can't open user's post", String.Empty)
End Try
End Function
#End Region #End Region
End Class End Class
End Namespace End Namespace

View File

@@ -9,10 +9,11 @@
Imports System.Net Imports System.Net
Imports System.Threading Imports System.Threading
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.Messaging Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.WebDocuments.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Instagram Namespace API.Instagram
@@ -20,29 +21,68 @@ Namespace API.Instagram
#Region "XML Names" #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_GetTimeline As String = "GetTimeline"
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 #End Region
#Region "Declarations" #Region "Declarations"
Private Structure PostKV : Implements IEContainerProvider
Private Const Name_Code As String = "Code"
Private Const Name_Section As String = "Section"
Friend Code As String
Friend ID As String
Friend Section As Sections
Friend Sub New(ByVal _Section As Sections)
Section = _Section
End Sub
Friend Sub New(ByVal _Code As String, ByVal _ID As String, ByVal _Section As Sections)
Code = _Code
ID = _ID
Section = _Section
End Sub
Private Sub New(ByVal e As EContainer)
Code = e.Attribute(Name_Code)
Section = e.Attribute(Name_Section)
ID = e.Value
End Sub
Public Shared Widening Operator CType(ByVal e As EContainer) As PostKV
Return New PostKV(e)
End Operator
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
If Not IsNothing(Obj) AndAlso TypeOf Obj Is PostKV Then
With DirectCast(Obj, PostKV)
Return Code = .Code And ID = .ID And Section = .Section
End With
Else
Return False
End If
End Function
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return New EContainer("Post", ID, {New EAttribute(Name_Section, CInt(Section)), New EAttribute(Name_Code, Code)})
End Function
End Structure
Private ReadOnly Property MySiteSettings As SiteSettings Private ReadOnly Property MySiteSettings As SiteSettings
Get Get
Return DirectCast(HOST.Source, SiteSettings) Return DirectCast(HOST.Source, SiteSettings)
End Get End Get
End Property End Property
Private ReadOnly _SavedPostsIDs As New List(Of String) Private ReadOnly PostsKVIDs As List(Of PostKV)
Private ReadOnly PostsToReparse As List(Of PostKV)
Private LastCursor As String = String.Empty Private LastCursor As String = String.Empty
Private FirstLoadingDone As Boolean = False Private FirstLoadingDone As Boolean = False
Friend Property GetTimeline As Boolean = True
Friend Property GetStories As Boolean Friend Property GetStories As Boolean
Friend Property GetTaggedData As Boolean Friend Property GetTaggedData As Boolean
#End Region #End Region
#Region "Exchange options" #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 {.GetTimeline = GetTimeline, .GetStories = GetStories, .GetTagged = GetTaggedData}
End Function End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object) Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions) With DirectCast(Obj, EditorExchangeOptions)
GetTimeline = .GetTimeline
GetStories = .GetStories GetStories = .GetStories
GetTaggedData = .GetTagged GetTaggedData = .GetTagged
End With End With
@@ -51,17 +91,21 @@ Namespace API.Instagram
#End Region #End Region
#Region "Initializer, loader" #Region "Initializer, loader"
Friend Sub New() Friend Sub New()
PostsKVIDs = New List(Of PostKV)
PostsToReparse = New List(Of PostKV)
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)
If Loading Then If Loading Then
LastCursor = Container.Value(Name_LastCursor) LastCursor = Container.Value(Name_LastCursor)
FirstLoadingDone = Container.Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False) FirstLoadingDone = Container.Value(Name_FirstLoadingDone).FromXML(Of Boolean)(False)
GetTimeline = Container.Value(Name_GetTimeline).FromXML(Of Boolean)(CBool(MySiteSettings.GetTimeline.Value))
GetStories = Container.Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value)) GetStories = Container.Value(Name_GetStories).FromXML(Of Boolean)(CBool(MySiteSettings.GetStories.Value))
GetTaggedData = Container.Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value)) GetTaggedData = Container.Value(Name_GetTagged).FromXML(Of Boolean)(CBool(MySiteSettings.GetTagged.Value))
TaggedChecked = Container.Value(Name_TaggedChecked).FromXML(Of Boolean)(False) TaggedChecked = Container.Value(Name_TaggedChecked).FromXML(Of Boolean)(False)
Else Else
Container.Add(Name_LastCursor, LastCursor) Container.Add(Name_LastCursor, LastCursor)
Container.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger) Container.Add(Name_FirstLoadingDone, FirstLoadingDone.BoolToInteger)
Container.Add(Name_GetTimeline, GetTimeline.BoolToInteger)
Container.Add(Name_GetStories, GetStories.BoolToInteger) Container.Add(Name_GetStories, GetStories.BoolToInteger)
Container.Add(Name_GetTagged, GetTaggedData.BoolToInteger) Container.Add(Name_GetTagged, GetTaggedData.BoolToInteger)
Container.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger) Container.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
@@ -78,48 +122,128 @@ Namespace API.Instagram
End If End If
Throw New ExitException Throw New ExitException
End Sub End Sub
Friend Sub New()
End Sub
Friend Sub New(ByRef CompleteArg As Boolean)
CompleteArg = True
End Sub
End Class End Class
Private Sub LoadSavePostsKV(ByVal Load As Boolean)
Dim x As XmlFile
Dim f As SFile = MyFilePosts
If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
If Load Then
PostsKVIDs.Clear()
x = New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
If x.Count > 0 Then PostsKVIDs.ListAddList(x, LAP.IgnoreICopier)
x.Dispose()
Else
x = New XmlFile With {.AllowSameNames = True}
x.AddRange(PostsKVIDs)
x.Name = "Posts"
x.Save(f, EDP.SendInLog)
x.Dispose()
End If
End If
End Sub
Private Overloads Function PostKvExists(ByVal pkv As PostKV) As Boolean
Return PostKvExists(pkv.ID, False, pkv.Section) OrElse PostKvExists(pkv.Code, True, pkv.Section)
End Function
Private Overloads Function PostKvExists(ByVal PostCodeId As String, ByVal IsCode As Boolean, ByVal Section As Sections) As Boolean
If Not PostCodeId.IsEmptyString And PostsKVIDs.Count > 0 Then
If PostsKVIDs.FindIndex(Function(p) p.Section = Section AndAlso If(IsCode, p.Code = PostCodeId, p.ID = PostCodeId)) >= 0 Then
Return True
ElseIf Not IsCode Then
Return _TempPostsList.Contains(GetPostIdBySection(PostCodeId, Section)) Or
_TempPostsList.Contains(PostCodeId.Replace($"_{ID}", String.Empty)) Or
_TempPostsList.Contains(GetPostIdBySection(PostCodeId.Replace($"_{ID}", String.Empty), Section))
End If
End If
Return False
End Function
Friend Function GetPostCodeById(ByVal PostID As String) As String
Try
If Not PostID.IsEmptyString Then
Dim f As SFile = MyFilePosts
If Not f.IsEmptyString Then
f.Name &= "_KV"
f.Extension = "xml"
Dim l As List(Of PostKV) = Nothing
Using x As New XmlFile(f, Protector.Modes.All, False) With {.AllowSameNames = True, .XmlReadOnly = True}
x.LoadData()
l.ListAddList(x, LAP.IgnoreICopier)
End Using
Dim code$ = String.Empty
If l.ListExists Then
Dim i% = l.FindIndex(Function(p) p.ID = PostID)
If i >= 0 Then code = l(i).Code
l.Clear()
End If
Return code
End If
End If
Return String.Empty
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"{ToStringForLog()}: Cannot find post code by ID ({PostID})", String.Empty)
End Try
End Function
Private Function GetPostIdBySection(ByVal ID As String, ByVal Section As Sections) As String
If Section = Sections.Timeline Then
Return ID
Else
Return $"{Section}_{ID}"
End If
End Function
Private _DownloadingInProgress As Boolean = False
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim s As Sections = Sections.Timeline Dim s As Sections = Sections.Timeline
Dim errorFound As Boolean = False
Try Try
LoadSavePostsKV(True)
_DownloadingInProgress = True
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
ThrowAny(Token) ThrowAny(Token)
_InstaHash = String.Empty
HasError = False HasError = False
Dim fc As Boolean = IIf(IsSavedPosts, MySiteSettings.DownloadSaved.Value, MySiteSettings.DownloadTimeline.Value) Dim dt As Func(Of Boolean) = Function() (CBool(MySiteSettings.DownloadTimeline.Value) And GetTimeline) Or IsSavedPosts
If fc And Not LastCursor.IsEmptyString Then If dt.Invoke And Not LastCursor.IsEmptyString Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline) s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(LastCursor, s, Token) DownloadData(LastCursor, s, Token)
ThrowAny(Token) ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True If Not HasError Then FirstLoadingDone = True
End If End If
If fc And Not HasError Then If dt.Invoke And Not HasError Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline) s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(String.Empty, s, Token) DownloadData(String.Empty, s, Token)
ThrowAny(Token) ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True If Not HasError Then FirstLoadingDone = True
End If End If
If FirstLoadingDone Then LastCursor = String.Empty If FirstLoadingDone Then LastCursor = String.Empty
If IsSavedPosts Then If Not IsSavedPosts AndAlso MySiteSettings.BaseAuthExists() Then
If MySiteSettings.DownloadSaved Then s = Sections.SavedPosts : DownloadPosts(Token) If CBool(MySiteSettings.DownloadStories.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token)
ElseIf MySiteSettings.BaseAuthExists() Then If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token)
DownloadedTags = 0
If MySiteSettings.DownloadStoriesTagged And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token)
If MySiteSettings.DownloadStoriesTagged And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token)
End If End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
Catch eex As ExitException Catch eex As ExitException
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, "[API.Instagram.UserData.DownloadDataF]", False, s) errorFound = True
Throw ex
Finally Finally
E560Thrown = False E560Thrown = False
UpdateResponser()
If Not errorFound Then LoadSavePostsKV(False)
End Try End Try
End Sub End Sub
Private _InstaHash As String = String.Empty Private Sub UpdateResponser()
Try
If _DownloadingInProgress AndAlso Not Responser Is Nothing AndAlso Not Responser.Disposed Then
_DownloadingInProgress = False
RemoveHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
Declarations.UpdateResponser(Responser, MySiteSettings.Responser)
End If
Catch
End Try
End Sub
Private Sub Responser_ResponseReceived(ByVal Sender As Object, ByVal e As EventArguments.WebDataResponse)
Declarations.UpdateResponser(e, Responser)
End Sub
Private Enum Sections : Timeline : Tagged : Stories : SavedPosts : End Enum Private Enum Sections : Timeline : Tagged : Stories : SavedPosts : End Enum
Private Const StoriesFolder As String = "Stories" Private Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged" Private Const TaggedFolder As String = "Tagged"
@@ -145,7 +269,7 @@ Namespace API.Instagram
"What do you want to do?", "Waiting for Instagram download...", "What do you want to do?", "Waiting for Instagram download...",
{ {
New MsgBoxButton("Wait") With {.ToolTip = "Wait and ask again when the error is found."}, New MsgBoxButton("Wait") With {.ToolTip = "Wait and ask again when the error is found."},
New MsgBoxButton("Wait (disable current") With {.ToolTip = "Wait and skip future prompts while downloading the current profile."}, New MsgBoxButton("Wait (disable current)") With {.ToolTip = "Wait and skip future prompts while downloading the current profile."},
New MsgBoxButton("Abort") With {.ToolTip = "Abort operation"}, New MsgBoxButton("Abort") With {.ToolTip = "Abort operation"},
New MsgBoxButton("Wait (disable all)") With {.ToolTip = "Wait and skip future prompts while downloading the current session."} New MsgBoxButton("Wait (disable all)") With {.ToolTip = "Wait and skip future prompts while downloading the current session."}
}, },
@@ -157,7 +281,7 @@ Namespace API.Instagram
Case Else : WaitNotificationMode = WNM.SkipTemp Case Else : WaitNotificationMode = WNM.SkipTemp
End Select End Select
End If End If
If Not ProgressTempSet Then Progress.InformationTemporary = $"Waiting until { .GetWaitDate().ToString(ParsersDataDateProvider)}" If Not ProgressTempSet Then Progress.InformationTemporary = $"Waiting until { .GetWaitDate().ToString(DateTimeDefaultProvider)}"
ProgressTempSet = True ProgressTempSet = True
Return False Return False
Else Else
@@ -180,13 +304,11 @@ Namespace API.Instagram
#Region "Tags" #Region "Tags"
Private TaggedChecked As Boolean = False Private TaggedChecked As Boolean = False
Friend TaggedCheckSession As Boolean = True Friend TaggedCheckSession As Boolean = True
Private DownloadedTags As Integer = 0
Private DownloadTagsLimit As Integer? = Nothing Private DownloadTagsLimit As Integer? = Nothing
Private ReadOnly Property TaggedLimitsNotifications(Optional ByVal v As Integer? = Nothing) As Boolean Private ReadOnly Property TaggedLimitsNotifications(ByVal v As Integer) As Boolean
Get Get
Return Not TaggedChecked AndAlso TaggedCheckSession AndAlso Return Not TaggedChecked AndAlso TaggedCheckSession AndAlso
CInt(MySiteSettings.TaggedNotifyLimit.Value) > 0 AndAlso CInt(MySiteSettings.TaggedNotifyLimit.Value) > 0 AndAlso v > CInt(MySiteSettings.TaggedNotifyLimit.Value)
(Not v.HasValue OrElse v.Value > CInt(MySiteSettings.TaggedNotifyLimit.Value))
End Get End Get
End Property End Property
Private Function SetTagsLimit(ByVal Max As Integer, ByVal p As ANumbers) As DialogResult Private Function SetTagsLimit(ByVal Max As Integer, ByVal p As ANumbers) As DialogResult
@@ -219,8 +341,9 @@ Namespace API.Instagram
End Function End Function
Private Function TaggedContinue(ByVal TaggedCount As Integer) As DialogResult Private Function TaggedContinue(ByVal TaggedCount As Integer) As DialogResult
Dim agi As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral} 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 & Dim msg As New MMessage($"The number of already downloaded tagged posts by user [{ToString()}] is {TaggedCount.NumToString(agi)}" & vbCr &
$"This is about {(TaggedCount / 12).RoundUp.NumToString(agi)} requests." & vbCr & "There is currently no way to know how many posts exist." & vbCr &
"One request will be spent per post." & vbCr &
"The tagged data download operation can take a long time.", "The tagged data download operation can take a long time.",
"Too much tagged data", "Too much tagged data",
{ {
@@ -252,40 +375,45 @@ Namespace API.Instagram
Dim URL$ = String.Empty Dim URL$ = String.Empty
Dim StoriesList As List(Of String) = Nothing Dim StoriesList As List(Of String) = Nothing
Dim StoriesRequested As Boolean = False Dim StoriesRequested As Boolean = False
Dim _DownloadComplete As Boolean = False Dim dValue% = 1
LastCursor = Cursor LastCursor = Cursor
Try Try
Do While Not _DownloadComplete Do While dValue = 1
ThrowAny(Token) ThrowAny(Token)
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter() ReconfigureAwaiter()
Try Try
Dim n As EContainer, nn As EContainer, node As EContainer Dim n As EContainer, nn As EContainer
Dim HasNextPage As Boolean = False Dim HasNextPage As Boolean = False
Dim Pinned As Boolean
Dim EndCursor$ = String.Empty Dim EndCursor$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty
Dim TaggedCount% Dim PostIDKV As PostKV
Dim ENode() As Object = Nothing Dim ENode() As Object = Nothing
NextRequest(True) NextRequest(True)
'Check environment 'Check environment
If Cursor.IsEmptyString And _InstaHash.IsEmptyString Then _ If Not IsSavedPosts Then
_InstaHash = CStr(If(IsSavedPosts, MySiteSettings.HashSavedPosts, MySiteSettings.Hash).Value) 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") End If
'Create query 'Create query
Select Case Section Select Case Section
Case Sections.Timeline, Sections.SavedPosts Case Sections.Timeline
URL = $"https://www.instagram.com/api/v1/feed/user/{Name}/username/?count=50" &
If(Cursor.IsEmptyString, String.Empty, $"&max_id={Cursor}")
ENode = Nothing
Case Sections.SavedPosts
SavedPostsDownload(String.Empty, Token)
Exit Sub
Case Sections.Tagged
Dim h$ = AConvert(Of String)(MySiteSettings.HashTagged.Value, String.Empty)
If h.IsEmptyString Then Throw New ExitException
Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}" Dim vars$ = "{""id"":" & ID & ",""first"":50,""after"":""" & Cursor & """}"
vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars) vars = SymbolsConverter.ASCII.EncodeSymbolsOnly(vars)
URL = $"https://www.instagram.com/graphql/query/?query_hash={_InstaHash}&variables={vars}" URL = $"https://www.instagram.com/graphql/query/?query_hash={h}&variables={vars}"
ENode = {"data", "user", 0} ENode = {"data", "user", 0}
Case Sections.Tagged
URL = $"https://i.instagram.com/api/v1/usertags/{ID}/feed/?count=50&max_id={Cursor}"
ENode = {"items"}
SpecFolder = TaggedFolder SpecFolder = TaggedFolder
Case Sections.Stories Case Sections.Stories
If Not StoriesRequested Then If Not StoriesRequested Then
@@ -303,7 +431,7 @@ Namespace API.Instagram
If StoriesList.ListExists Then If StoriesList.ListExists Then
Continue Do Continue Do
Else Else
Throw New ExitException(_DownloadComplete) Throw New ExitException
End If End If
End Select End Select
@@ -316,78 +444,74 @@ Namespace API.Instagram
'Parsing 'Parsing
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
n = j.ItemF(ENode).XmlIfNothing n = If(ENode Is Nothing, j, j.ItemF(ENode)).XmlIfNothing
If n.Count > 0 Then If n.Count > 0 Then
Select Case Section Select Case Section
Case Sections.Timeline, Sections.SavedPosts Case Sections.Timeline
If n.Contains("page_info") Then With n
With n("page_info") HasNextPage = .Value("more_available").FromXML(Of Boolean)(False)
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False) EndCursor = .Value("next_max_id")
EndCursor = .Value("end_cursor") If If(.Item("items")?.Count, 0) > 0 Then
End With UserSiteNameUpdate(.ItemF({"items", 0, "user", "full_name"}).XmlIfNothingValue)
End If If Not DefaultParser(.Item("items"), Section, Token) Then Throw New ExitException
n = n("edges").XmlIfNothing Else
If n.Count > 0 Then HasNextPage = False
For Each nn In n End If
ThrowAny(Token) End With
node = nn(0).XmlIfNothing
If IsSavedPosts Then
PostID = node.Value("shortcode")
If Not PostID.IsEmptyString AndAlso _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
End If
PostID = node.Value("id")
Pinned = CBool(If(node("pinned_for_users")?.Count, 0))
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) And Not Pinned Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp")
If IsSavedPosts Then
_SavedPostsIDs.Add(PostID)
Else
Select Case CheckDatesLimit(PostDate, DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : If Not Pinned Then Throw New ExitException(_DownloadComplete)
End Select
ObtainMedia(node, PostID, PostDate, SpecFolder)
End If
Next
End If
Case Sections.Tagged Case Sections.Tagged
HasNextPage = j.Value("more_available").FromXML(Of Boolean)(False) With n
EndCursor = j.Value("next_max_id") If .Contains("page_info") Then
For Each nn In n With .Item("page_info")
PostID = $"Tagged_{nn.Value("id")}" HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete) EndCursor = .Value("end_cursor")
_TempPostsList.Add(PostID) End With
ObtainMedia2(nn, PostID, SpecFolder) Else
DownloadedTags += 1 HasNextPage = False
If DownloadTagsLimit.HasValue AndAlso DownloadedTags >= DownloadTagsLimit.Value Then Throw New ExitException(_DownloadComplete) End If
Next If If(.Item("edges")?.Count, 0) > 0 Then
If TaggedLimitsNotifications Then For Each nn In .Item("edges")
TaggedCount = j.Value("total_count").FromXML(Of Integer)(0) PostIDKV = New PostKV(Section)
If nn.Count > 0 AndAlso nn(0).Count > 0 Then
With nn(0)
PostIDKV = New PostKV(.Value("shortcode"), .Value("id"), Section)
If PostKvExists(PostIDKV) Then
Throw New ExitException
Else
If Not DownloadTagsLimit.HasValue OrElse PostsToReparse.Count + 1 < DownloadTagsLimit.Value Then
_TempPostsList.Add(GetPostIdBySection(PostIDKV.ID, Section))
PostsKVIDs.ListAddValue(PostIDKV, LAP.NotContainsOnly)
PostsToReparse.ListAddValue(PostIDKV, LNC)
ElseIf DownloadTagsLimit.HasValue OrElse PostsToReparse.Count + 1 >= DownloadTagsLimit.Value Then
Throw New ExitException
End If
End If
End With
End If
Next
Else
HasNextPage = False
End If
End With
If TaggedLimitsNotifications(PostsToReparse.Count) Then
TaggedChecked = True TaggedChecked = True
If TaggedLimitsNotifications(TaggedCount) AndAlso If TaggedContinue(PostsToReparse.Count) = DialogResult.Cancel Then Throw New ExitException
TaggedContinue(TaggedCount) = DialogResult.Cancel Then Throw New ExitException(_DownloadComplete)
End If End If
End Select End Select
Else Else
If j.Value("status") = "ok" AndAlso j({"data", "user"}).XmlIfNothing.Count = 0 AndAlso If j.Value("status") = "ok" AndAlso If(j("items")?.Count, 0) = 0 AndAlso
_TempMediaList.Count = 0 AndAlso Section = Sections.Timeline Then _ _TempMediaList.Count = 0 AndAlso Section = Sections.Timeline Then _
UserExists = False : Throw New ExitException(_DownloadComplete) UserExists = False : Throw New ExitException
End If End If
End Using End Using
Else Else
Throw New ExitException(_DownloadComplete) Throw New ExitException
End If End If
_DownloadComplete = True dValue = 0
If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Section, Token) If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Section, Token)
Catch eex As ExitException Catch eex As ExitException
Throw eex Throw eex
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Exit Do
Catch dex As ObjectDisposedException When Disposed
Exit Do
Catch ex As Exception Catch ex As Exception
If DownloadingException(ex, $"data downloading error [{URL}]", False, Section) = 1 Then Continue Do Else Exit Do dValue = ProcessException(ex, Token, $"data downloading error [{URL}]",, Section, False)
End Try End Try
Loop Loop
Catch eex2 As ExitException Catch eex2 As ExitException
@@ -400,10 +524,10 @@ Namespace API.Instagram
End Sub End Sub
Private Sub DownloadPosts(ByVal Token As CancellationToken) Private Sub DownloadPosts(ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Dim _DownloadComplete As Boolean = False Dim dValue% = 1
Dim _Index% = 0 Dim _Index% = 0
Try Try
Do While Not _DownloadComplete Do While dValue = 1
ThrowAny(Token) ThrowAny(Token)
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter() ReconfigureAwaiter()
@@ -411,13 +535,11 @@ Namespace API.Instagram
Try Try
Dim r$ Dim r$
Dim j As EContainer, jj As EContainer Dim j As EContainer, jj As EContainer
Dim _MediaObtained As Boolean If PostsToReparse.Count > 0 And _Index <= PostsToReparse.Count - 1 Then
If _SavedPostsIDs.Count > 0 And _Index <= _SavedPostsIDs.Count - 1 Then
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 PostsToReparse.Count - 1
_Index = i _Index = i
'URL = $"https://instagram.com/p/{_SavedPostsIDs(i)}/?__a=1" URL = $"https://www.instagram.com/api/v1/media/{PostsToReparse(i).ID}/info/"
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)
@@ -427,17 +549,9 @@ Namespace API.Instagram
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
j = JsonDocument.Parse(r) j = JsonDocument.Parse(r)
If Not j Is Nothing Then If Not j Is Nothing Then
_MediaObtained = False If If(j("items")?.Count, 0) > 0 Then
If j.Contains({"graphql", "shortcode_media"}) Then
With j({"graphql", "shortcode_media"}).XmlIfNothing
If .Count > 0 Then ObtainMedia(.Self, _SavedPostsIDs(i), String.Empty, String.Empty) : _MediaObtained = True
End With
End If
If Not _MediaObtained AndAlso j.Contains("items") Then
With j("items") With j("items")
If .Count > 0 Then For Each jj In .Self : ObtainMedia(jj, PostsToReparse(i).ID) : Next
For Each jj In .Self : ObtainMedia2(jj, _SavedPostsIDs(i)) : Next
End If
End With End With
End If End If
j.Dispose() j.Dispose()
@@ -445,24 +559,82 @@ Namespace API.Instagram
End If End If
Next Next
End If End If
_DownloadComplete = True dValue = 0
Catch eex As ExitException Catch eex As ExitException
Throw eex Throw eex
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Exit Do
Catch dex As ObjectDisposedException When Disposed
Exit Do
Catch ex As Exception Catch ex As Exception
If DownloadingException(ex, $"downloading saved posts error [{URL}]", False, Sections.SavedPosts) = 1 Then Continue Do Else Exit Do dValue = ProcessException(ex, Token, $"downloading posts error [{URL}]",, Sections.Tagged, False)
End Try End Try
Loop Loop
Catch eex2 As ExitException Catch eex2 As ExitException
Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted
If oex2.HelpLink = InstAborted Then HasError = True If oex2.HelpLink = InstAborted Then HasError = True
Catch DoEx As Exception Catch DoEx As Exception
ProcessException(DoEx, Token, $"downloading saved posts error [{URL}]",, Sections.SavedPosts) ProcessException(DoEx, Token, $"downloading posts error [{URL}]",, Sections.Tagged)
End Try End Try
End Sub End Sub
Private Sub SavedPostsDownload(ByVal Cursor As String, ByVal Token As CancellationToken)
Dim URL$ = $"https://www.instagram.com/api/v1/feed/saved/posts/?max_id={Cursor}"
Dim HasNextPage As Boolean = False
Dim NextCursor$ = String.Empty
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
Dim nodes As IEnumerable(Of EContainer) = Nothing
If Not r.IsEmptyString Then
Using e As EContainer = JsonDocument.Parse(r)
If If(e?.Count, 0) > 0 Then
With e
HasNextPage = .Value("more_available").FromXML(Of Boolean)(False)
NextCursor = .Value("next_max_id")
If .Contains("items") Then nodes = (From ee As EContainer In .Item("items") Where ee.Count > 0 Select ee(0))
End With
If nodes.ListExists Then
DefaultParser(nodes, Sections.SavedPosts, Token)
If HasNextPage And Not NextCursor.IsEmptyString Then SavedPostsDownload(NextCursor, Token)
End If
End If
End Using
End If
End Sub
Private Function DefaultParser(ByVal Items As IEnumerable(Of EContainer), ByVal Section As Sections, ByVal Token As CancellationToken,
Optional ByVal SpecFolder As String = Nothing) As Boolean
ThrowAny(Token)
If Items.Count > 0 Then
Dim PostIDKV As PostKV
Dim Pinned As Boolean
Dim PostDate$
If SpecFolder.IsEmptyString Then
Select Case Section
Case Sections.Tagged : SpecFolder = TaggedFolder
Case Sections.Stories : SpecFolder = StoriesFolder
Case Else : SpecFolder = String.Empty
End Select
End If
For Each nn In Items
With nn
PostIDKV = New PostKV(.Value("code"), .Value("id"), Section)
Pinned = .Contains("timeline_pinned_user_ids")
If PostKvExists(PostIDKV) Then
If Not Pinned Then Return False
Else
_TempPostsList.Add(PostIDKV.ID)
PostsKVIDs.ListAddValue(PostIDKV, LNC)
PostDate = .Value("taken_at")
If Not IsSavedPosts Then
Select Case CheckDatesLimit(PostDate, DateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : If Not Pinned Then Return False
End Select
End If
ObtainMedia(.Self, PostIDKV.ID, SpecFolder, PostDate)
End If
End With
Next
Return True
Else
Return False
End If
End Function
#End Region #End Region
#Region "Code ID converters" #Region "Code ID converters"
Private Shared Function CodeToID(ByVal Code As String) As String Private Shared Function CodeToID(ByVal Code As String) As String
@@ -485,31 +657,14 @@ Namespace API.Instagram
End Function End Function
#End Region #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 n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Dim CreateMedia As Action(Of EContainer) =
Sub(ByVal e As EContainer)
Dim t As UTypes = If(e.Value("is_video").FromXML(Of Boolean)(False), UTypes.Video, UTypes.Picture)
Dim tmpValue$
If t = UTypes.Picture Then
tmpValue = e.Value("display_url")
Else
tmpValue = e.Value("video_url")
End If
If Not tmpValue.IsEmptyString Then _TempMediaList.ListAddValue(MediaFromData(t, tmpValue, PostID, PostDate, SpecFolder), LNC)
End Sub
If node.Contains({"edge_sidecar_to_children", "edges"}) Then
For Each edge As EContainer In node({"edge_sidecar_to_children", "edges"}) : CreateMedia(edge("node").XmlIfNothing) : Next
Else
CreateMedia(node)
End If
End Sub
Private Sub ObtainMedia2(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj 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 Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String
If Not DateObj.IsEmptyString Then Return DateObj
If elem.Contains("taken_at") Then If elem.Contains("taken_at") Then
Return elem.Value("taken_at") Return elem.Value("taken_at")
ElseIf elem.Contains("imported_taken_at") Then ElseIf elem.Contains("imported_taken_at") Then
@@ -518,7 +673,7 @@ Namespace API.Instagram
Dim ev$ = elem.Value("device_timestamp") Dim ev$ = elem.Value("device_timestamp")
If Not ev.IsEmptyString Then If Not ev.IsEmptyString Then
If ev.Length > 10 Then If ev.Length > 10 Then
Return elem.Value("device_timestamp").Substring(0, 10) Return ev.Substring(0, 10)
Else Else
Return ev Return ev
End If End If
@@ -574,7 +729,7 @@ Namespace API.Instagram
DateObj = mDate(n) 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, DateObj) : Next For Each d In .Self : ObtainMedia(d, PostID, SpecialFolder, DateObj) : Next
End If End If
End With End With
End Select End Select
@@ -587,35 +742,41 @@ Namespace API.Instagram
End Sub End Sub
#End Region #End Region
#Region "GetUserId" #Region "GetUserId"
<Obsolete> Private Sub GetUserId_Old()
Try
Dim r$ = Responser.GetResponse($"https://www.instagram.com/{Name}/?__a=1",, EDP.ThrowException)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
ID = j({"graphql", "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
Private Sub GetUserId() Private Sub GetUserId()
Dim __idFound As Boolean = False
Try Try
Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/users/web_profile_info/?username={Name}",, EDP.ThrowException) Dim r$ = Responser.GetResponse($"https://i.instagram.com/api/v1/users/web_profile_info/?username={Name}",, EDP.ThrowException)
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)
ID = j({"data", "user"}, "id").XmlIfNothingValue If Not j Is Nothing AndAlso j.Contains({"data", "user"}) Then
With j({"data", "user"})
ID = .Value("id")
__idFound = True
UserSiteNameUpdate(.Value("full_name"))
Dim descr$ = .Value("biography")
If If(.Item("bio_links")?.Count, 0) > 0 Then descr.StringAppend(.Item("bio_links").Select(Function(bl) bl.Value("url")).ListToString(vbNewLine), vbNewLine)
Dim eUrl$ = .Value("external_url")
If Not eUrl.IsEmptyString AndAlso (descr.IsEmptyString OrElse Not descr.Contains(eUrl)) Then descr.StringAppendLine(eUrl)
UserDescriptionUpdate(descr)
Dim f As New SFile With {.Path = MyFile.CutPath.Path, .Name = "ProfilePicture", .Extension = "jpg"}
If Not f.Exists Then
Dim profilePicture$ = .Value("profile_pic_url_hd")
If profilePicture.IsEmptyString OrElse Not GetWebFile(profilePicture, f, EDP.ReturnValue) Then
profilePicture = .Value("profile_pic_url")
If Not profilePicture.IsEmptyString Then GetWebFile(profilePicture, f, EDP.ReturnValue)
End If
End If
End With
End If
End Using End Using
End If End If
Catch ex As Exception Catch ex As Exception
If Responser.StatusCode = HttpStatusCode.NotFound Or Responser.StatusCode = HttpStatusCode.BadRequest Then If Not __idFound Then
Throw ex If Responser.StatusCode = HttpStatusCode.NotFound Or Responser.StatusCode = HttpStatusCode.BadRequest Then
Else Throw ex
LogError(ex, "get Instagram user id") Else
LogError(ex, "get Instagram user id")
End If
End If End If
End Try End Try
End Sub End Sub
@@ -651,7 +812,7 @@ Namespace API.Instagram
pid = storyID & s.Value("id") pid = storyID & s.Value("id")
If Not _TempPostsList.Contains(pid) Then If Not _TempPostsList.Contains(pid) Then
ThrowAny(Token) ThrowAny(Token)
ObtainMedia2(s, pid, sFolder) ObtainMedia(s, pid, sFolder)
_TempPostsList.Add(pid) _TempPostsList.Add(pid)
End If End If
Next Next
@@ -702,7 +863,7 @@ Namespace API.Instagram
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 [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]" MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
DisableSection(s) DisableSection(s)
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then
Return 3 Return 3
@@ -730,8 +891,7 @@ Namespace API.Instagram
Dim s As Sections = DirectCast(Section, Sections) Dim s As Sections = DirectCast(Section, Sections)
Select Case s Select Case s
Case Sections.Timeline : MySiteSettings.DownloadTimeline.Value = False Case Sections.Timeline : MySiteSettings.DownloadTimeline.Value = False
Case Sections.SavedPosts : MySiteSettings.DownloadSaved.Value = False Case Else : MySiteSettings.DownloadTagged.Value = False
Case Else : MySiteSettings.DownloadStoriesTagged.Value = False
End Select End Select
MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper
End If End If
@@ -749,7 +909,7 @@ Namespace API.Instagram
End Function End Function
#End Region #End Region
#Region "Standalone downloader" #Region "Standalone downloader"
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal r As Response) As IEnumerable(Of UserMedia) Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal r As Responser) 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))
@@ -757,9 +917,9 @@ Namespace API.Instagram
If Not PID.IsEmptyString Then If Not PID.IsEmptyString Then
Using t As New UserData Using t As New UserData
t.SetEnvironment(Settings(InstagramSiteKey), Nothing, False, False) t.SetEnvironment(Settings(InstagramSiteKey), Nothing, False, False)
t.Responser = New Response t.Responser = New Responser
t.Responser.Copy(r) t.Responser.Copy(r)
t._SavedPostsIDs.Add(PID) t.PostsToReparse.Add(New PostKV With {.ID = PID})
t.DownloadPosts(Nothing) t.DownloadPosts(Nothing)
Return ListAddList(Nothing, t._TempMediaList) Return ListAddList(Nothing, t._TempMediaList)
End Using End Using
@@ -773,7 +933,13 @@ Namespace API.Instagram
#End Region #End Region
#Region "IDisposable Support" #Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _SavedPostsIDs.Clear() If Not disposedValue Then
UpdateResponser()
If disposing Then
PostsKVIDs.Clear()
PostsToReparse.Clear()
End If
End If
MyBase.Dispose(disposing) MyBase.Dispose(disposing)
End Sub End Sub
#End Region #End Region

View File

@@ -31,7 +31,7 @@ Namespace API.LPSG
Return New UserData Return New UserData
End Function End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 Return Responser.CookiesExists
End Function End Function
End Class End Class
End Namespace End Namespace

View File

@@ -10,6 +10,7 @@ Imports System.Threading
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports Converters = PersonalUtilities.Functions.SymbolsConverter.Converters Imports Converters = PersonalUtilities.Functions.SymbolsConverter.Converters
Namespace API.LPSG Namespace API.LPSG
@@ -27,7 +28,7 @@ Namespace API.LPSG
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
Responser.Error = EDP.ThrowException Responser.DeclaredError = EDP.ThrowException
Dim NextPage$ Dim NextPage$
Dim r$ Dim r$
@@ -87,7 +88,7 @@ Namespace API.LPSG
End If End If
End Sub End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
With Responser : .UseWebClient = True : .UseWebClientCookies = True : .ResetError() : End With With Responser : .Mode = Responser.Modes.WebClient : .ResetStatus() : End With
UseResponserClient = True UseResponserClient = True
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub

View File

@@ -0,0 +1,14 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.PathPlugin
Friend Module Declarations
Friend Const PluginKey As String = "AndyProgram_PathPlugin"
Friend Const PluginName As String = "Path"
End Module
End Namespace

View File

@@ -0,0 +1,49 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Namespace API.PathPlugin
<Manifest(PluginKey)>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
Return PersonalUtilities.Tools.ImageRenderer.GetIcon(PersonalUtilities.My.Resources.FolderOpenPic_Orange_16, EDP.ReturnValue)
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return PersonalUtilities.My.Resources.FolderOpenPic_Orange_16
End Get
End Property
Friend Sub New()
MyBase.New(PluginName)
End Sub
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim f As SFile = UserURL
If Not f.IsEmptyString AndAlso f.PathNoSeparator = UserURL.StringTrimEnd("\") AndAlso (f.Location = SFOLocation.Local Or f.Location = SFOLocation.Network) Then
Return New ExchangeOptions(Site, f)
Else
Return Nothing
End If
End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return False
End Function
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
Return Nothing
End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
Return String.Empty
End Function
End Class
End Namespace

View File

@@ -0,0 +1,45 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Namespace API.PathPlugin
Friend Class UserData : Inherits UserDataBase
Private Const DOWNLOAD_ERROR As String = "The path plugin only provides user paths."
Friend Overrides Property UserExists As Boolean
Get
Return FileExists
End Get
Set(ByVal e As Boolean)
MyBase.UserExists = e
End Set
End Property
Friend Overrides Property UserSuspended As Boolean
Get
Return False
End Get
Set(ByVal s As Boolean)
MyBase.UserSuspended = s
End Set
End Property
Friend Overrides Sub OpenSite(Optional ByVal e As ErrorsDescriber = Nothing)
OpenFolder()
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XML.XmlFile, ByVal Loading As Boolean)
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As Threading.CancellationToken)
Throw New InvalidOperationException(DOWNLOAD_ERROR)
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As Threading.CancellationToken)
Throw New InvalidOperationException(DOWNLOAD_ERROR)
End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
Throw New InvalidOperationException(DOWNLOAD_ERROR)
End Function
End Class
End Namespace

View File

@@ -0,0 +1,43 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.PornHub
Friend Module Declarations
#Region "Converters"
Private ReadOnly UnicodeHexConverter As Func(Of String, String) = Function(Input) SymbolsConverter.UnicodeHex.Decode(Input, EDP.ReturnValue)
#End Region
#Region "Declarations video"
Friend ReadOnly RegexVideo_FlashVarsBlock As RParams = RParams.DM("(?<=flashvars_\['[nN]ext[vV]ideo'\];[\r\n]*?)(.+?)(?=;flashvars_\d+?)", 0, EDP.ReturnValue)
Friend ReadOnly RegexVideo_FlashVars_Vars As RParams = RParams.DM("var ([\w\d]{10,})=("".+?)(?=(;|\Z))", 0, RegexReturn.List)
Friend ReadOnly RegexVideo_FlashVars_Compiler As RParams = RParams.DM("(?<=\*/)([\w\d\S]{10,})", 0, RegexReturn.List)
Friend ReadOnly RegexVideo_Video_All As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""",
0, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter)
Friend ReadOnly RegexVideo_Video_Wrong As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""[\w\W\s\r\n]+?(?=\<div class=""videoUploaderBlock)",
0, RegexReturn.List, EDP.ReturnValue, UnicodeHexConverter)
Private ReadOnly RegexVideo_Video_Wrong_Option As RParams = RParams.DM("div class=""thumbnail-info-wrapper clearfix.+?[\r\n\s]*?\<span class=""title.+?[\r\n\s]*?\<a href=""([^""]+?)""[\s]+?title=""([^""]*?)""[\w\W\s\r\n]+?", 0, RegexReturn.ListByMatch)
Friend ReadOnly RegexVideo_Video_Wrong_Fields As RField() = {New RField(New RFieldOption(1, RegexVideo_Video_Wrong_Option)), New RField(New RFieldOption(2, RegexVideo_Video_Wrong_Option))}
Friend ReadOnly RegexVideo_Video_VideoKey As RParams = RParams.DMS("viewkey=([\w\d]+)", 1, EDP.ReturnValue)
#End Region
#Region "Declarations M3U8"
Friend ReadOnly Regex_M3U8_FirstFileRegEx As RParams = RParams.DM(".+?m3u8.*", 0)
Friend ReadOnly Regex_M3U8_FileUrl As RParams = RParams.DMS("((https://([^/]+)/.+?)([^/]+?m3u8))(.*)", 2, EDP.ReturnValue)
#End Region
#Region "Declarations GIF"
Friend ReadOnly Regex_Gif_Array As RParams = RParams.DM("\<li id=""(gif\d+)"" class=""gifLi.gifVideoBlock""\>", 0, RegexReturn.List, EDP.ReturnValue)
Friend ReadOnly Regex_Gif_UrlName As RParams = RParams.DMS("""name"":.*?""([^""]*)""[^\}]+?""contentUrl"":.*?""([^""]+)""", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
#End Region
#Region "Declarations photo"
Friend ReadOnly Regex_Photo_ModelHub_PhotoBlocks As RParams = RParams.DM("var PHOTOS_ARRAY_(\d+) = \{[\r\n\s]*?(urls:.*?\[[^]]*\])", 0, RegexReturn.List, EDP.ReturnValue)
Friend ReadOnly Regex_Photo_PornHub_PhotoBlocks As RParams = RParams.DM("photoAlbumListContainer[\r\n\s\S]+?title=""([^""]+)""[\r\n\s\S]+?a href=""(/album/\d+)""", 0, RegexReturn.List)
Friend ReadOnly Regex_Photo_PornHub_AlbumPhotoArr As RParams = RParams.DMS("\<a href=""(/photo/\d+)""", 1, RegexReturn.List, EDP.ReturnValue,
CType(Function(Input$) If(Input.IsEmptyString, String.Empty, $"https://www.pornhub.com{Input.Trim}"), Func(Of String, String)))
Friend ReadOnly Regex_Photo_PornHub_SinglePhoto As RParams = RParams.DMS("(?<!thumbImage.+?)<img src=""(https://[^""]+\d+[^""]+)""", 1, EDP.ReturnValue)
#End Region
End Module
End Namespace

View File

@@ -0,0 +1,42 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.API.Base.M3U8Declarations
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Namespace API.PornHub
Friend NotInheritable Class M3U8
Private Sub New()
End Sub
Private Shared Function GetUrlsList(ByVal URL As String, ByVal Responser As Responser) As List(Of String)
Dim appender$ = RegexReplace(URL, Regex_M3U8_FileUrl)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Dim file$ = RegexReplace(r, Regex_M3U8_FirstFileRegEx)
If Not file.IsEmptyString Then
Dim NewUrl$ = M3U8Base.CreateUrl(appender, file)
If Not NewUrl.IsEmptyString Then
r = Responser.GetResponse(NewUrl)
If Not r.IsEmptyString Then
Dim l As List(Of String) = RegexReplace(r, TsFilesRegEx)
If l.ListExists Then
For i% = 0 To l.Count - 1 : l(i) = M3U8Base.CreateUrl(appender, l(i)) : Next
Return l
End If
End If
End If
End If
End If
Return Nothing
End Function
Friend Shared Function Download(ByVal URL As String, ByVal Responser As Responser, ByVal Destination As SFile) As SFile
Return M3U8Base.Download(GetUrlsList(URL, Responser), Destination, Responser)
End Function
End Class
End Namespace

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
Namespace API.Instagram Namespace API.PornHub
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> <Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class AdditionalSettingsForm : Inherits System.Windows.Forms.Form Partial Friend Class OptionsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()> <System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try Try
@@ -24,9 +24,8 @@ Namespace API.Instagram
Private Sub InitializeComponent() Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Me.CH_DOWN_TIME = New System.Windows.Forms.CheckBox() Me.CH_DOWN_GIFS = New System.Windows.Forms.CheckBox()
Me.CH_DOWN_TAG = New System.Windows.Forms.CheckBox() Me.CH_DOWN_PHOTO_MODELHUB = New System.Windows.Forms.CheckBox()
Me.CH_DOWN_SAVED = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer() CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel() TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout() CONTAINER_MAIN.ContentPanel.SuspendLayout()
@@ -40,13 +39,13 @@ Namespace API.Instagram
'CONTAINER_MAIN.ContentPanel 'CONTAINER_MAIN.ContentPanel
' '
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN) CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(234, 78) CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(278, 52)
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)
CONTAINER_MAIN.Name = "CONTAINER_MAIN" CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(234, 103) CONTAINER_MAIN.Size = New System.Drawing.Size(278, 77)
CONTAINER_MAIN.TabIndex = 0 CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False CONTAINER_MAIN.TopToolStripPanelVisible = False
' '
@@ -55,71 +54,56 @@ Namespace API.Instagram
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single] TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1 TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!)) TP_MAIN.Controls.Add(Me.CH_DOWN_GIFS, 0, 0)
TP_MAIN.Controls.Add(Me.CH_DOWN_TIME, 0, 0) TP_MAIN.Controls.Add(Me.CH_DOWN_PHOTO_MODELHUB, 0, 1)
TP_MAIN.Controls.Add(Me.CH_DOWN_TAG, 0, 1)
TP_MAIN.Controls.Add(Me.CH_DOWN_SAVED, 0, 2)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0) TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN" TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 4 TP_MAIN.RowCount = 3
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!)) TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!)) TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(234, 78) TP_MAIN.Size = New System.Drawing.Size(278, 52)
TP_MAIN.TabIndex = 0 TP_MAIN.TabIndex = 0
' '
'CH_DOWN_TIME 'CH_DOWN_GIFS
' '
Me.CH_DOWN_TIME.AutoSize = True Me.CH_DOWN_GIFS.AutoSize = True
Me.CH_DOWN_TIME.Dock = System.Windows.Forms.DockStyle.Fill Me.CH_DOWN_GIFS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_TIME.Location = New System.Drawing.Point(4, 4) Me.CH_DOWN_GIFS.Location = New System.Drawing.Point(4, 4)
Me.CH_DOWN_TIME.Name = "CH_DOWN_TIME" Me.CH_DOWN_GIFS.Name = "CH_DOWN_GIFS"
Me.CH_DOWN_TIME.Size = New System.Drawing.Size(226, 19) Me.CH_DOWN_GIFS.Size = New System.Drawing.Size(270, 19)
Me.CH_DOWN_TIME.TabIndex = 0 Me.CH_DOWN_GIFS.TabIndex = 0
Me.CH_DOWN_TIME.Text = "Download Timeline" Me.CH_DOWN_GIFS.Text = "Download gifs"
Me.CH_DOWN_TIME.UseVisualStyleBackColor = True Me.CH_DOWN_GIFS.UseVisualStyleBackColor = True
' '
'CH_DOWN_TAG 'CH_DOWN_PHOTO_MODELHUB
' '
Me.CH_DOWN_TAG.AutoSize = True Me.CH_DOWN_PHOTO_MODELHUB.AutoSize = True
Me.CH_DOWN_TAG.Dock = System.Windows.Forms.DockStyle.Fill Me.CH_DOWN_PHOTO_MODELHUB.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_TAG.Location = New System.Drawing.Point(4, 30) Me.CH_DOWN_PHOTO_MODELHUB.Location = New System.Drawing.Point(4, 30)
Me.CH_DOWN_TAG.Name = "CH_DOWN_TAG" Me.CH_DOWN_PHOTO_MODELHUB.Name = "CH_DOWN_PHOTO_MODELHUB"
Me.CH_DOWN_TAG.Size = New System.Drawing.Size(226, 19) Me.CH_DOWN_PHOTO_MODELHUB.Size = New System.Drawing.Size(270, 19)
Me.CH_DOWN_TAG.TabIndex = 1 Me.CH_DOWN_PHOTO_MODELHUB.TabIndex = 1
Me.CH_DOWN_TAG.Text = "Download Stories and Tagged data" Me.CH_DOWN_PHOTO_MODELHUB.Text = "Download photo only from ModelHub"
Me.CH_DOWN_TAG.UseVisualStyleBackColor = True Me.CH_DOWN_PHOTO_MODELHUB.UseVisualStyleBackColor = True
' '
'CH_DOWN_SAVED 'OptionsForm
'
Me.CH_DOWN_SAVED.AutoSize = True
Me.CH_DOWN_SAVED.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_SAVED.Location = New System.Drawing.Point(4, 56)
Me.CH_DOWN_SAVED.Name = "CH_DOWN_SAVED"
Me.CH_DOWN_SAVED.Size = New System.Drawing.Size(226, 19)
Me.CH_DOWN_SAVED.TabIndex = 2
Me.CH_DOWN_SAVED.Text = "Download saved posts"
Me.CH_DOWN_SAVED.UseVisualStyleBackColor = True
'
'AdditionalSettingsForm
' '
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(234, 103) Me.ClientSize = New System.Drawing.Size(278, 77)
Me.Controls.Add(CONTAINER_MAIN) Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteResources.InstagramIcon_32 Me.Icon = Global.SCrawler.My.Resources.SiteResources.InstagramIcon_32
Me.KeyPreview = True Me.KeyPreview = True
Me.MaximizeBox = False Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(250, 142) Me.MaximumSize = New System.Drawing.Size(294, 116)
Me.MinimizeBox = False Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(250, 142) Me.MinimumSize = New System.Drawing.Size(294, 116)
Me.Name = "AdditionalSettingsForm" Me.Name = "OptionsForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Additional settings" Me.Text = "Options"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False) CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False) CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout() CONTAINER_MAIN.PerformLayout()
@@ -128,8 +112,7 @@ Namespace API.Instagram
Me.ResumeLayout(False) Me.ResumeLayout(False)
End Sub End Sub
Private WithEvents CH_DOWN_TIME As CheckBox Private WithEvents CH_DOWN_GIFS As CheckBox
Private WithEvents CH_DOWN_TAG As CheckBox Private WithEvents CH_DOWN_PHOTO_MODELHUB As CheckBox
Private WithEvents CH_DOWN_SAVED As CheckBox
End Class End Class
End Namespace End Namespace

View File

@@ -7,34 +7,27 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms Imports PersonalUtilities.Forms
Namespace API.Instagram Namespace API.PornHub
Friend Class AdditionalSettingsForm Friend Class OptionsForm
Private WithEvents MyDefs As DefaultFormOptions Private WithEvents MyDefs As DefaultFormOptions
Friend Property MyParameters As SettingsExchangeOptions Private ReadOnly MyExchangeOptions As UserExchangeOptions
Friend Sub New(ByVal Parameters As SettingsExchangeOptions) Friend Sub New(ByRef ExchangeOptions As UserExchangeOptions)
InitializeComponent() InitializeComponent()
MyParameters = Parameters MyExchangeOptions = ExchangeOptions
MyDefs = New DefaultFormOptions(Me, Settings.Design) MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub End Sub
Private Sub MyForm_Load(sender As Object, e As EventArgs) Handles Me.Load Private Sub MyForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs With MyDefs
.MyViewInitialize(True) .MyViewInitialize(True)
.AddOkCancelToolbar() .AddOkCancelToolbar()
With MyParameters CH_DOWN_GIFS.Checked = MyExchangeOptions.DownloadGifs
CH_DOWN_TIME.Checked = .DownloadTimeline CH_DOWN_PHOTO_MODELHUB.Checked = MyExchangeOptions.DownloadPhotoOnlyFromModelHub
CH_DOWN_TAG.Checked = .DownloadStoriesTagged
CH_DOWN_SAVED.Checked = .DownloadSaved
End With
.EndLoaderOperations() .EndLoaderOperations()
End With End With
End Sub End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
MyParameters = New SettingsExchangeOptions With { MyExchangeOptions.DownloadGifs = CH_DOWN_GIFS.Checked
.DownloadTimeline = CH_DOWN_TIME.Checked, MyExchangeOptions.DownloadPhotoOnlyFromModelHub = CH_DOWN_PHOTO_MODELHUB.Checked
.DownloadStoriesTagged = CH_DOWN_TAG.Checked,
.DownloadSaved = CH_DOWN_SAVED.Checked,
.Changed = True
}
MyDefs.CloseForm() MyDefs.CloseForm()
End Sub End Sub
End Class End Class

View File

@@ -0,0 +1,121 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Namespace API.PornHub
<Manifest("AndyProgram_PornHub"), SavedPosts, SpecialForm(False), SeparatedTasks(1)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.PornHubIcon_16
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.PornHubPic_16
End Get
End Property
Private ReadOnly Property CurlPathExists As Boolean
<PropertyOption(ControlText:="Download GIF", ControlToolTip:="Default for new users", ThreeStates:=True), PXML>
Friend ReadOnly Property DownloadGifs As PropertyValue
<PropertyOption(ControlText:="Download GIFs as mp4", ControlToolTip:="Download gifs in 'mp4' format instead of native 'webm'"), PXML>
Friend ReadOnly Property DownloadGifsAsMp4 As PropertyValue
<PropertyOption(ControlText:="Photo ModelHub only",
ControlToolTip:="Download photo only from ModelHub. Prornstar photos hosted on PornHub itself will not be downloaded." & vbCr &
"Attention! Downloading photos hosted on PornHub is a very heavy job."), PXML>
Friend ReadOnly Property DownloadPhotoOnlyFromModelHub As PropertyValue
<PropertyOption(ControlText:="Saved posts user", ControlToolTip:="Personal profile username"), PXML>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
#End Region
#Region "Initializer"
Friend Sub New()
MyBase.New("PornHub", "pornhub.com")
Responser.CurlPath = $"cURL\curl.exe"
Responser.CurlArgumentsRight = "--ssl-no-revoke"
CurlPathExists = Responser.CurlPath.Exists
Responser.DeclaredError = EDP.ThrowException
DownloadGifsAsMp4 = New PropertyValue(True)
DownloadGifs = New PropertyValue(CInt(CheckState.Indeterminate), GetType(Integer))
DownloadPhotoOnlyFromModelHub = New PropertyValue(True)
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
UrlPatternUser = "https://www.pornhub.com/{0}/{1}"
UserRegex = RParams.DMS("pornhub.com/([^/]+)/([^/]+).*?", 0, RegexReturn.ListByMatch)
ImageVideoContains = "pornhub"
End Sub
#End Region
#Region "GetInstance, GetSpecialData"
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
If What = ISiteSettings.Download.SavedPosts Then
Return New UserData With {
.IsSavedPosts = True,
.VideoPageModel = UserData.VideoPageModels.Favorite,
.PersonType = UserData.PersonTypeUser,
.User = New UserInfo With {.Name = $"{UserData.PersonTypeUser}_{CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}"}
}
Else
Return New UserData
End If
End Function
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
If Available(ISiteSettings.Download.Main, True) Then
Using resp As Responser = Responser.Copy
Dim spf$ = String.Empty
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
Dim m As UserMedia = UserData.GetVideoInfo(URL, resp, f)
If m.State = UserMedia.States.Downloaded Then
m.SpecialFolder = f
Return {m}
End If
End Using
End If
Return Nothing
End Function
#End Region
#Region "Downloading"
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return Settings.UseM3U8 And CurlPathExists And (Not What = ISiteSettings.Download.SavedPosts OrElse ACheck(SavedPostsUserName.Value))
End Function
#End Region
#Region "IsMyUser"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Try
If Not UserURL.IsEmptyString Then
Dim alist As List(Of String) = RegexReplace(UserURL.ToLower, UserRegex)
If alist.ListExists(3) Then Return New ExchangeOptions(Site, $"{alist(1)}_{alist(2)}")
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"[API.PornHub.SiteSettings.IsMyUser({UserURL})]", New ExchangeOptions)
End Try
End Function
#End Region
#Region "GetUserUrl, GetUserPostUrl"
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
With DirectCast(User, UserData) : Return String.Format(UrlPatternUser, .PersonType, .NameTrue) : End With
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return Media.URL_BASE
End Function
#End Region
#Region "User options"
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is UserExchangeOptions Then Options = New UserExchangeOptions(Me)
If OpenForm Then
Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,656 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.PornHub
Friend Class UserData : Inherits UserDataBase
Private Const UrlPattern As String = "https://www.pornhub.com/{0}"
#Region "Declarations"
#Region "XML names"
Private Const Name_PersonType As String = "PersonType"
Private Const Name_NameTrue As String = "NameTrue"
Private Const Name_VideoPageModel As String = "VideoPageModel"
Private Const Name_PhotoPageModel As String = "PhotoPageModel"
Private Const Name_DownloadGifs As String = "DownloadGifs"
Private Const Name_DownloadPhotoOnlyFromModelHub As String = "DownloadPhotoOnlyFromModelHub"
#End Region
#Region "Structures"
Private Structure FlashVar : Implements IRegExCreator
Friend Name As String
Friend Value As String
Public Shared Widening Operator CType(ByVal Name As String) As FlashVar
Return New FlashVar With {.Name = Name}
End Operator
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists(2) Then
Name = ParamsArray(0)
Value = ParamsArray(1)
If Not Value.IsEmptyString Then Value = Value.Replace(""" + """, String.Empty).Replace("""", String.Empty).StringTrim
End If
Return Me
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
Return CType(Obj, FlashVar).Name = Name
End Function
End Structure
Private Structure UserVideo : Implements IRegExCreator
Friend URL As String
Friend ID As String
Friend Title As String
Friend Function ToUserMedia() As UserMedia
Return New UserMedia(URL, UTypes.VideoPre) With {
.File = If(Title.IsEmptyString, .File, New SFile($"{Title}.mp4")),
.Post = ID
}
End Function
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists Then
URL = ParamsArray(0)
ID = RegexReplace(URL, RegexVideo_Video_VideoKey)
URL = String.Format(UrlPattern, URL.TrimStart("/"))
Title = TitleHtmlConverter(ParamsArray(1))
End If
Return Me
End Function
Public Overrides Function Equals(ByVal Obj As Object) As Boolean
Return DirectCast(Obj, UserVideo).URL = URL
End Function
End Structure
Private Structure PhotoBlock : Implements IRegExCreator
Friend AlbumID As String
Friend Data As String
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists(2) Then
AlbumID = ParamsArray(0)
Data = ParamsArray(1).StringTrim
End If
Return Me
End Function
End Structure
#End Region
#Region "Enums"
Friend Enum VideoPageModels As Integer
[Default] = 0
ConcatPage = 1
Favorite = 2
Undefined = -1
End Enum
Private Enum PhotoPageModels As Integer
Undefined = 0
PornHubPage = 1
ModelHubPage = 2
End Enum
#End Region
#Region "Constants"
Private Const PersonTypeModel As String = "model"
Friend Const PersonTypeUser As String = "users"
#End Region
#Region "Person"
Friend Property PersonType As String
Friend Property NameTrue As String
Friend Overrides Property FriendlyName As String
Get
If _FriendlyName.IsEmptyString Then Return NameTrue Else Return _FriendlyName
End Get
Set(ByVal n As String)
_FriendlyName = n
End Set
End Property
#End Region
#Region "Advanced fields"
Friend Property VideoPageModel As VideoPageModels = VideoPageModels.Undefined
Private Property PhotoPageModel As PhotoPageModels = PhotoPageModels.Undefined
Friend Property DownloadGifs As Boolean
Friend Property DownloadPhotoOnlyFromModelHub As Boolean = True
#End Region
#Region "ExchangeOptions"
Friend Overrides Function ExchangeOptionsGet() As Object
Return New UserExchangeOptions(Me)
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is UserExchangeOptions Then
With DirectCast(Obj, UserExchangeOptions)
DownloadGifs = .DownloadGifs
DownloadPhotoOnlyFromModelHub = .DownloadPhotoOnlyFromModelHub
End With
End If
End Sub
#End Region
Private ReadOnly Property MySettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
#End Region
#Region "Initializer, loader"
Friend Sub New()
UseInternalM3U8Function = True
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
With Container
Dim SetNames As Action = Sub()
If Not Name.IsEmptyString And NameTrue.IsEmptyString Then
Dim n$() = Name.Split("_")
If n.ListExists(2) Then
NameTrue = Name.Replace($"{n(0)}_", String.Empty)
PersonType = n(0)
If (PersonType = PersonTypeModel Or PersonType = PersonTypeUser) And
VideoPageModel = VideoPageModels.Undefined Then VideoPageModel = VideoPageModels.Default
End If
End If
End Sub
If Loading Then
PersonType = .Value(Name_PersonType)
NameTrue = .Value(Name_NameTrue)
VideoPageModel = .Value(Name_VideoPageModel).FromXML(Of Integer)(VideoPageModels.Undefined)
PhotoPageModel = .Value(Name_PhotoPageModel).FromXML(Of Integer)(PhotoPageModels.Undefined)
DownloadGifs = .Value(Name_DownloadGifs).FromXML(Of Integer)(False)
DownloadPhotoOnlyFromModelHub = .Value(Name_DownloadPhotoOnlyFromModelHub).FromXML(Of Boolean)(True)
SetNames.Invoke()
Else
SetNames.Invoke()
.Add(Name_PersonType, PersonType)
.Add(Name_NameTrue, NameTrue)
.Add(Name_VideoPageModel, CInt(VideoPageModel))
.Add(Name_PhotoPageModel, CInt(PhotoPageModel))
.Add(Name_DownloadGifs, DownloadGifs.BoolToInteger)
.Add(Name_DownloadPhotoOnlyFromModelHub, DownloadPhotoOnlyFromModelHub.BoolToInteger)
End If
End With
End Sub
#End Region
#Region "Downloading"
#Region "Download override"
Private Const DataDownloaded As Integer = -10
Private Const DataDownloaded_NotFound As Integer = -20
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Try
Responser.ResetStatus()
If PersonType = PersonTypeUser Then Responser.Mode = Responser.Modes.Curl
If IsSavedPosts Then VideoPageModel = VideoPageModels.Favorite
Dim page% = 1
Dim __continue As Boolean = True
Dim __videoDone As Boolean = False
Dim d%
If DownloadVideos Then
If PersonType = PersonTypeUser Then Responser.Mode = Responser.Modes.Curl : Responser.Method = "POST"
If VideoPageModel = VideoPageModels.Undefined Then
__continue = False
d = DownloadUserVideos(page, Token)
Select Case d
Case DataDownloaded : __continue = True : page += 1
Case 1 : VideoPageModel = VideoPageModels.ConcatPage
Case EXCEPTION_OPERATION_CANCELED : ThrowAny(Token)
Case DataDownloaded_NotFound : __videoDone = True
End Select
If Not __continue And Not __videoDone Then
d = DownloadUserVideos(page, Token)
Select Case d
Case DataDownloaded : __continue = True : page += 1
Case 1 : VideoPageModel = VideoPageModels.Undefined
Case EXCEPTION_OPERATION_CANCELED : ThrowAny(Token)
Case DataDownloaded_NotFound : __videoDone = True
End Select
End If
End If
If __continue And Not __videoDone Then
Do While DownloadUserVideos(page, Token) = DataDownloaded And page < 100 : page += 1 : Loop
End If
If _TempMediaList.Count > 0 Then _TempMediaList.RemoveAll(Function(m) Not m.Type = UTypes.m3u8 And Not m.Type = UTypes.VideoPre)
End If
Responser.Method = "GET"
If DownloadGifs And Not IsSavedPosts Then DownloadUserGifs(Token)
If DownloadImages Then DownloadUserPhotos(Token)
Finally
Responser.Mode = Responser.Modes.Default
Responser.Method = "GET"
End Try
End Sub
#End Region
#Region "Download video"
Private ReadOnly Property VideoPageType As String
Get
Select Case VideoPageModel
Case VideoPageModels.Default : Return "/videos/upload"
Case VideoPageModels.Favorite : Return "/videos/favorites/"
Case Else : Return String.Empty
End Select
End Get
End Property
Private ReadOnly Property VideoPageAppender As String
Get
Return If(PersonType = PersonTypeUser, "ajax?o=newest&page=", String.Empty)
End Get
End Property
Private Overloads Function DownloadUserVideos(ByVal Page As Integer, ByVal Token As CancellationToken) As Integer
Const VideoUrlPattern$ = "https://www.pornhub.com/{0}/{1}{2}{3}"
Const HtmlPageNotFoundVideo$ = "<span>Error Page Not Found</span>"
Dim URL$ = String.Empty
Try
Dim p$
If PersonType = PersonTypeUser Then
p = Page
Else
p = IIf(Page = 1, String.Empty, $"?page={Page}")
End If
URL = $"{String.Format(VideoUrlPattern, PersonType, NameTrue, VideoPageType, VideoPageAppender)}{p}"
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
If PersonType = PersonTypeUser And r.Contains(HtmlPageNotFoundVideo) Then Return DataDownloaded_NotFound
Dim l As List(Of UserVideo) = RegexFields(Of UserVideo)(r, {RegexVideo_Video_All}, {1, 2})
Dim lw As List(Of UserVideo) = Nothing
If Not PersonType = PersonTypeUser Then lw = RegexFields(Of UserVideo)(r, {RegexVideo_Video_Wrong}, RegexVideo_Video_Wrong_Fields)
If l.ListExists Then
If lw.ListExists Then l.ListWithRemove(lw)
If l.Count > 0 Then
Dim lBefore% = l.Count
l.RemoveAll(Function(ByVal uv As UserVideo) As Boolean
If Not _TempPostsList.Contains(uv.ID) Then
_TempPostsList.Add(uv.ID)
Return False
Else
Return True
End If
End Function)
If l.Count > 0 Then _TempMediaList.ListAddList(l.Select(Function(uv) uv.ToUserMedia))
If l.Count = lBefore And l.Count > 0 Then Return DataDownloaded
End If
End If
End If
Return DataDownloaded_NotFound
Catch regex_ex As RegexFieldsTextBecameNullException
If PersonType = PersonTypeUser Or IsSavedPosts Then
Return DataDownloaded_NotFound
Else
Return ProcessException(regex_ex, Token, $"videos downloading error [{URL}]")
End If
Catch ex As Exception
Return ProcessException(ex, Token, $"videos downloading error [{URL}]")
End Try
End Function
#End Region
#Region "Download GIF"
Private Sub DownloadUserGifs(ByVal Token As CancellationToken)
Dim URL$ = $"https://www.pornhub.com/{PersonType}/{NameTrue}/gifs"
Try
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Dim n$
Dim m As UserMedia = Nothing
Dim l As List(Of RegexMatchStruct) = RegexFields(Of RegexMatchStruct)(r, {Regex_Gif_Array}, {1})
Dim l2 As List(Of String) = Nothing
Dim l3 As List(Of String) = Nothing
If l.ListExists Then l2 = l.Select(Function(ll) $"gif/{ll.Arr(0).Replace("gif", String.Empty)}").ToList
If l2.ListExists Then
For Each gif$ In l2
If Not _TempPostsList.Contains(gif) Then
_TempPostsList.Add(gif)
URL = $"https://www.pornhub.com/{gif}"
m = New UserMedia(URL, UTypes.Video) With {.Post = gif, .SpecialFolder = "GIFs\"}
ThrowAny(Token)
Try
r = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
If l3.ListExists Then l3.Clear() : l3 = Nothing
l3 = RegexReplace(r, Regex_Gif_UrlName)
If l3.ListExists(3) Then
m.URL = l3(2)
m.File = m.URL
n = TitleHtmlConverter(l3(1))
If MySettings.DownloadGifsAsMp4.Value Then m.File.Extension = "mp4"
If Not n.IsEmptyString Then m.File.Name = n
End If
End If
Catch gif_down_ex As Exception
m.State = UserMedia.States.Missing
End Try
_TempMediaList.ListAddValue(m)
End If
Next
End If
If l.ListExists Then l.Clear()
If l2.ListExists Then l2.Clear()
If l3.ListExists Then l3.Clear()
End If
Catch ex As Exception
ProcessException(ex, Token, $"gifs downloading error [{URL}]")
End Try
End Sub
#End Region
#Region "Download photo"
Private Const PhotoUrlPattern_ModelHub As String = "https://www.modelhub.com/{0}/photos"
Private Const PhotoUrlPattern_PornHub As String = "https://www.pornhub.com/{0}/{1}/photos"
Private Sub DownloadUserPhotos(ByVal Token As CancellationToken)
Try
If IsSavedPosts Then
DownloadUserPhotos_SavedPosts(Token)
ElseIf PersonType = PersonTypeModel Then
If PhotoPageModel = PhotoPageModels.Undefined Then
If DownloadUserPhotos_ModelHub(Token) Then PhotoPageModel = PhotoPageModels.ModelHubPage
ThrowAny(Token)
If PhotoPageModel = PhotoPageModels.Undefined AndAlso Not DownloadPhotoOnlyFromModelHub AndAlso
DownloadUserPhotos_PornHub(Token) Then PhotoPageModel = PhotoPageModels.PornHubPage
Else
Select Case PhotoPageModel
Case PhotoPageModels.ModelHubPage : DownloadUserPhotos_ModelHub(Token)
Case PhotoPageModels.PornHubPage : If Not DownloadPhotoOnlyFromModelHub Then DownloadUserPhotos_PornHub(Token)
End Select
End If
ElseIf Not DownloadPhotoOnlyFromModelHub Then
DownloadUserPhotos_PornHub(Token)
End If
ThrowAny(Token)
Catch ex As Exception
ProcessException(ex, Token, "photos downloading error")
End Try
End Sub
Private Function DownloadUserPhotos_ModelHub(ByVal Token As CancellationToken) As Boolean
Dim URL$ = String.Empty
Try
Dim jErr As New ErrorsDescriber(EDP.SendInLog + EDP.ReturnValue)
Dim albumName$
If PersonType = PersonTypeModel Then
URL = String.Format(PhotoUrlPattern_ModelHub, NameTrue)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_ModelHub_PhotoBlocks}, {1, 2})
If l.ListExists Then l.RemoveAll(Function(ll) ll.Data.IsEmptyString)
If l.ListExists Then
Dim albumRegex As RParams = RParams.DMS("", 1, EDP.ReturnValue)
For Each block As PhotoBlock In l
If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For
albumRegex.Pattern = "<li id=""" & block.AlbumID & """ class=""modelBox"">[\r\n\s]*?<div class=""modelPhoto"">[\r\n\s]*?\<[^\>]*?alt=""([^""]*)"""
albumName = StringTrim(RegexReplace(r, albumRegex))
If albumName.IsEmptyString Then albumName = block.AlbumID
Using j As EContainer = JsonDocument.Parse("{" & block.Data & "}", jErr)
If Not j Is Nothing Then
If If(j("urls")?.Count, 0) > 0 Then
_TempMediaList.ListAddList(j("urls").Select(Function(jj) _
New UserMedia(jj.ItemF({0}).XmlIfNothingValue, UTypes.Picture) With {
.SpecialFolder = $"Albums\{albumName}\"}), LNC)
End If
End If
End Using
Next
l.Clear()
End If
End If
End If
Return True
Catch ex As Exception
ThrowAny(Token)
Return False
End Try
End Function
Private Overloads Function DownloadUserPhotos_PornHub(ByVal Token As CancellationToken) As Boolean
Try
Dim albumName$
Dim page%
Dim r$ = Responser.GetResponse(String.Format(PhotoUrlPattern_PornHub, PersonType, NameTrue))
If Not r.IsEmptyString Then
Dim l As List(Of PhotoBlock) = RegexFields(Of PhotoBlock)(r, {Regex_Photo_PornHub_PhotoBlocks}, {2, 1})
If l.ListExists Then l.RemoveAll(Function(ll) ll.AlbumID.IsEmptyString)
If l.ListExists Then
For Each block As PhotoBlock In l
If Not _TempPostsList.Contains(block.AlbumID) Then _TempPostsList.Add(block.AlbumID) Else Continue For
albumName = block.Data
If albumName.IsEmptyString Then
albumName = block.AlbumID.Split("/").LastOrDefault.StringTrim
Else
albumName = TitleHtmlConverter(albumName)
End If
page = 1
Do While DownloadUserPhotos_PornHub(page, block.AlbumID, albumName, Token) : page += 1 : Loop
Next
l.Clear()
End If
End If
Return True
Catch ex As Exception
ThrowAny(Token)
Return False
End Try
End Function
Private Overloads Function DownloadUserPhotos_PornHub(ByVal Page As Integer, ByVal AlbumID As String, ByVal AlbumName As String,
ByVal Token As CancellationToken) As Boolean
Try
Dim r$ = Responser.GetResponse($"https://www.pornhub.com{AlbumID}{IIf(Page = 1, String.Empty, $"?page={Page}")}")
If Not r.IsEmptyString Then
Dim l As List(Of String) = RegexReplace(r, Regex_Photo_PornHub_AlbumPhotoArr)
If l.ListExists Then l.RemoveAll(Function(_url) _url.IsEmptyString)
If l.ListExists Then
For Each url$ In l
ThrowAny(Token)
Try
r = Responser.GetResponse(url)
If Not r.IsEmptyString Then
url = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto)
If Not url.IsEmptyString Then _
_TempMediaList.ListAddValue(New UserMedia(url, UTypes.Picture) With {.SpecialFolder = $"Albums\{AlbumName}\"}, LNC)
End If
Catch
End Try
Next
l.Clear()
Return True
End If
End If
Return False
Catch ex As Exception
ThrowAny(Token)
Return False
End Try
End Function
Private Function DownloadUserPhotos_SavedPosts(ByVal Token As CancellationToken) As Boolean
Const HtmlPageNotFoundPhoto$ = "Page Not Found"
Dim URL$ = $"https://www.pornhub.com/{PersonType}/{NameTrue}/photos/favorites"
Try
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
If r.Contains(HtmlPageNotFoundPhoto) Then Return False
Dim urls As List(Of String) = RegexReplace(r, Regex_Photo_PornHub_AlbumPhotoArr)
If urls.ListExists Then
Dim NewUrl$
Dim m As UserMedia
Dim l2 As List(Of UserMedia) = urls.Select(Function(__url) New UserMedia(__url, UTypes.Picture) With {
.Post = __url.Split("/").LastOrDefault}).ToList
urls.Clear()
If l2.ListExists Then l2.RemoveAll(Function(media) media.URL.IsEmptyString)
If l2.ListExists Then
Dim lBefore% = l2.Count
If _TempPostsList.Count > 0 Then l2.RemoveAll(Function(media) _TempPostsList.Contains(media.Post.ID))
If l2.Count > 0 Then
For i% = 0 To l2.Count - 1
m = l2(i)
ThrowAny(Token)
Try
r = Responser.GetResponse(m.URL)
If Not r.IsEmptyString Then
NewUrl = RegexReplace(r, Regex_Photo_PornHub_SinglePhoto)
If Not NewUrl.IsEmptyString Then
m.URL = NewUrl
m.File = NewUrl
_TempPostsList.ListAddValue(m.Post.ID, LNC)
Else
Throw New Exception
End If
End If
Catch
m.State = UserMedia.States.Missing
End Try
_TempMediaList.ListAddValue(m, LNC)
Next
End If
Return l2.Count = lBefore
End If
End If
End If
Return False
Catch ex As Exception
Return ProcessException(ex, Token, $"photos downloading error [{URL}]")
End Try
End Function
#End Region
#End Region
#Region "ReparseVideo"
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
Const ERR_NEW_URL$ = "ERR_NEW_URL"
Dim URL$ = String.Empty
Try
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
Dim m As UserMedia
Dim r$, NewUrl$
For i% = _TempMediaList.Count - 1 To 0 Step -1
If _TempMediaList(i).Type = UTypes.VideoPre Then
m = _TempMediaList(i)
ThrowAny(Token)
Try
URL = m.URL
r = Responser.Curl(URL)
If Not r.IsEmptyString Then
NewUrl = CreateVideoURL(r)
If NewUrl.IsEmptyString Then
Throw New Exception With {.HelpLink = ERR_NEW_URL}
Else
m.URL = NewUrl
m.Type = UTypes.m3u8
_TempMediaList(i) = m
End If
Else
_TempMediaList.RemoveAt(i)
End If
Catch mid_ex As Exception
If mid_ex.HelpLink = ERR_NEW_URL OrElse DownloadingException(mid_ex, "") = 1 Then
m.State = UserMedia.States.Missing
_TempMediaList(i) = m
Else
_TempMediaList.RemoveAt(i)
End If
End Try
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "video reparsing error", False)
End Try
End Sub
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
If ContentMissingExists Then
Dim m As UserMedia
Dim r$
Dim eCurl As New ErrorsDescriber(EDP.ReturnValue)
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
r = Responser.Curl(m.URL_BASE, eCurl)
If Not r.IsEmptyString Then
Dim NewUrl$ = CreateVideoURL(r)
If Not NewUrl.IsEmptyString Then
m.URL = NewUrl
_TempMediaList.ListAddValue(m, LNC)
rList.Add(i)
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
#End Region
#Region "Download content"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
Return M3U8.Download(URL, Responser, DestinationFile)
End Function
#End Region
#Region "CreateVideoURL"
Private Shared Function CreateVideoURL(ByVal r As String) As String
Try
Dim OutStr$ = String.Empty
If Not r.IsEmptyString Then
Dim _VarBlock$ = RegexReplace(r, RegexVideo_FlashVarsBlock)
If Not _VarBlock.IsEmptyString Then
Dim vars As List(Of FlashVar) = RegexFields(Of FlashVar)(_VarBlock, {RegexVideo_FlashVars_Vars}, {1, 2})
Dim compiler As List(Of String) = RegexReplace(_VarBlock, RegexVideo_FlashVars_Compiler)
If vars.ListExists And compiler.ListExists Then
Dim v$
Dim i%
For Each var$ In compiler
i = vars.IndexOf(var)
If i >= 0 Then
v = vars(i).Value
If Not v.IsEmptyString Then OutStr &= v
End If
Next
End If
End If
End If
Return OutStr
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.PornHub.UserData.CreateVideoURL]", String.Empty)
End Try
End Function
#End Region
#Region "Standalone downloader"
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal Responser As Responser, ByVal Destination As SFile) As UserMedia
Try
Dim r$ = Responser.Curl(URL)
If Not r.IsEmptyString Then
Dim NewUrl$ = CreateVideoURL(r)
If Not NewUrl.IsEmptyString Then
Dim f As SFile = M3U8.Download(NewUrl, Responser, Destination)
If Not f.IsEmptyString Then Return New UserMedia With {.State = UserMedia.States.Downloaded}
End If
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"PornHub standalone download error: [{URL}]", New UserMedia)
End Try
End Function
#End Region
#Region "Exceptions"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String,
Optional ByVal FromPE As Boolean = False, Optional ByVal EObj As Object = Nothing) As Integer
If Responser.Status = Net.WebExceptionStatus.ConnectionClosed Then
Return 1
ElseIf Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
Return 2
Else
Return 0
End If
End Function
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,23 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.PornHub
Friend Class UserExchangeOptions
Friend Property DownloadGifs As Boolean
Friend Property DownloadPhotoOnlyFromModelHub As Boolean
Friend Sub New(ByVal u As UserData)
DownloadGifs = u.DownloadGifs
DownloadPhotoOnlyFromModelHub = u.DownloadPhotoOnlyFromModelHub
End Sub
Friend Sub New(ByVal s As SiteSettings)
Dim v As CheckState = CInt(s.DownloadGifs.Value)
DownloadGifs = Not v = CheckState.Unchecked
DownloadPhotoOnlyFromModelHub = s.DownloadPhotoOnlyFromModelHub.Value
End Sub
End Class
End Namespace

View File

@@ -236,8 +236,19 @@ Namespace API.Reddit
Return If(Name.IsEmptyString, ID, Name) Return If(Name.IsEmptyString, ID, Name)
End Function End Function
Friend Sub Delete() Friend Sub Delete()
File.Delete(, SFODelete.DeleteToRecycleBin) Dim f As SFile = ChannelsCollection.ChannelsDeletedPath
FilePosts.Delete(, SFODelete.DeleteToRecycleBin) With File
f.Name = .Name
f.Extension = .Extension
.Copy(f,, True, SFODelete.DeleteToRecycleBin)
.Delete(, SFODelete.DeleteToRecycleBin)
End With
With FilePosts
f.Name = .Name
f.Extension = .Extension
.Copy(f,, True, SFODelete.DeleteToRecycleBin)
.Delete(, SFODelete.DeleteToRecycleBin)
End With
End Sub End Sub
Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True, Friend Sub DownloadData(ByVal Token As CancellationToken, Optional ByVal SkipExists As Boolean = True,
Optional ByVal p As MyProgress = Nothing) Optional ByVal p As MyProgress = Nothing)

View File

@@ -17,6 +17,11 @@ Namespace API.Reddit
Return $"{SettingsFolderName}\Channels\" Return $"{SettingsFolderName}\Channels\"
End Get End Get
End Property End Property
Friend Shared ReadOnly Property ChannelsDeletedPath As SFile
Get
Return $"{SettingsFolderName}\ChannelsDeleted\"
End Get
End Property
Friend Shared ReadOnly Property ChannelsPathCache As SFile Friend Shared ReadOnly Property ChannelsPathCache As SFile
Get Get
Return $"{Settings.GlobalPath.Value.PathWithSeparator}_CachedData\" Return $"{Settings.GlobalPath.Value.PathWithSeparator}_CachedData\"

View File

@@ -8,7 +8,7 @@
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Net Imports System.Net
Imports SCrawler.API.Reddit.M3U8_Declarations Imports SCrawler.API.Reddit.M3U8_Declarations
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.Web
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Reddit Namespace API.Reddit
Namespace M3U8_Declarations Namespace M3U8_Declarations

View File

@@ -25,21 +25,23 @@ Namespace API.Reddit
Return My.Resources.SiteResources.RedditPic_512 Return My.Resources.SiteResources.RedditPic_512
End Get End Get
End Property End Property
<PropertyOption(ControlText:="Saved posts user"), PXML("SavedPostsUserName")> <PropertyOption(ControlText:="Saved posts user", ControlToolTip:="Personal profile username"), PXML>
Friend ReadOnly Property SavedPostsUserName As PropertyValue Friend ReadOnly Property SavedPostsUserName As PropertyValue
<PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos"), PXML> <PropertyOption(ControlText:="Use M3U8", ControlToolTip:="Use M3U8 or mp4 for Reddit videos"), PXML>
Friend ReadOnly Property UseM3U8 As PropertyValue Friend ReadOnly Property UseM3U8 As PropertyValue
Friend Sub New() Friend Sub New()
MyBase.New(RedditSite, "reddit.com") MyBase.New(RedditSite, "reddit.com")
With Responser With Responser
If .Decoders.Count = 0 OrElse Not .Decoders.Contains(SymbolsConverter.Converters.Unicode) Then _ Dim d% = .Decoders.Count
.Decoders.Add(SymbolsConverter.Converters.Unicode) : .SaveSettings() .Decoders.ListAddList({SymbolsConverter.Converters.Unicode, SymbolsConverter.Converters.HTML}, LAP.NotContainsOnly)
If d <> .Decoders.Count Then .SaveSettings()
End With End With
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String)) SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
UseM3U8 = New PropertyValue(True) UseM3U8 = New PropertyValue(True)
UrlPatternUser = "https://www.reddit.com/user/{0}/" UrlPatternUser = "https://www.reddit.com/user/{0}/"
UrlPatternChannel = "https://www.reddit.com/r/{0}/" UrlPatternChannel = "https://www.reddit.com/r/{0}/"
ImageVideoContains = "reddit.com" ImageVideoContains = "reddit.com"
UserRegex = RParams.DM("[htps:/]{7,8}.*?reddit.com/([user]{1,4})/([^/]+)", 0, RegexReturn.ListByMatch, EDP.ReturnValue)
End Sub End Sub
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
Select Case What Select Case What
@@ -55,19 +57,9 @@ Namespace API.Reddit
End Select End Select
Return Nothing Return Nothing
End Function End Function
Private ReadOnly RedditRegEx1 As RParams = RParams.DMS("[htps:/]{7,8}.*?reddit.com/user/([^/]+)", 1)
Private ReadOnly RedditRegEx2 As RParams = RParams.DMS(".?u/([^/]+)", 1)
Private ReadOnly RedditChannelRegEx1 As RParams = RParams.DMS("[htps:/]{7,8}.*?reddit.com/r/([^/]+)", 1)
Private ReadOnly RedditChannelRegEx2 As RParams = RParams.DMS(".?r/([^/]+)", 1)
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
Dim s$ Dim l As List(Of String) = RegexReplace(UserURL, UserRegex)
Dim c% = 0 If l.ListExists(3) Then Return New ExchangeOptions(Site, l(2), l(1) = "r") Else Return Nothing
For Each r As RParams In {RedditRegEx1, RedditRegEx2, RedditChannelRegEx1, RedditChannelRegEx2}
s = RegexReplace(UserURL, r)
If Not s.IsEmptyString Then Return New ExchangeOptions(Site, s, c > 1)
c += 1
Next
Return Nothing
End Function End Function
Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean Friend Overrides Function Available(ByVal What As Download, ByVal Silent As Boolean) As Boolean
Try Try
@@ -79,18 +71,27 @@ Namespace API.Reddit
If Silent Then If Silent Then
Return False Return False
Else Else
Return MsgBoxE({"Over the past hour, Reddit has received an average of " & If MsgBoxE({"Over the past hour, Reddit has received an average of " &
avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr & avg.NumToString(New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}) & " outage reports:" & vbCr &
dl.ListToString(vbCr) & vbCr & vbCr & dl.ListToString(vbCr) & vbCr & vbCr &
"Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes "Do you want to continue parsing Reddit data?", "There are outage reports on Reddit"}, vbYesNo) = vbYes Then
UpdateRedGifsToken()
Return True
Else
Return False
End If
End If End If
End If End If
End If End If
UpdateRedGifsToken()
Return True Return True
Catch ex As Exception Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True) Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True)
End Try End Try
End Function End Function
Private Sub UpdateRedGifsToken()
DirectCast(Settings(RedGifs.RedGifsSiteKey).Source, RedGifs.SiteSettings).UpdateTokenIfRequired()
End Sub
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
Dim spf$ = String.Empty Dim spf$ = String.Empty
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf) Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
@@ -103,8 +104,8 @@ Namespace API.Reddit
Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using Using f As New RedditViewSettingsForm(Options) : f.ShowDialog() : End Using
End If End If
End Sub End Sub
Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return $"https://www.reddit.com/comments/{PostID.Split("_").LastOrDefault}/" Return $"https://www.reddit.com/comments/{Media.Post.ID.Split("_").LastOrDefault}/"
End Function End Function
End Class End Class
End Namespace End Namespace

View File

@@ -14,8 +14,8 @@ Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.ImageRenderer Imports PersonalUtilities.Tools.ImageRenderer
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.WebDocuments.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports CView = SCrawler.API.Reddit.IRedditView.View Imports CView = SCrawler.API.Reddit.IRedditView.View
@@ -132,11 +132,11 @@ Namespace API.Reddit
#End Region #End Region
#Region "Download Overrides" #Region "Download Overrides"
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken) Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
UserDescriptionReset()
_CrossPosts.Clear() _CrossPosts.Clear()
If Not IsSavedPosts AndAlso (IsChannel AndAlso Not ChannelInfo Is Nothing) Then If Not IsSavedPosts AndAlso (IsChannel AndAlso Not ChannelInfo Is Nothing) Then
EnvirDownloadSet()
If Not Responser Is Nothing Then Responser.Dispose() If Not Responser Is Nothing Then Responser.Dispose()
Responser = New Response Responser = New Responser
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 Not ViewMode = CView.New Then ChannelPostsNames.ListAddList(ChannelInfo.PostsNames, LNC)
@@ -152,6 +152,8 @@ Namespace API.Reddit
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TotalPostsDownloaded = 0 _TotalPostsDownloaded = 0
If IsSavedPosts Then If IsSavedPosts Then
'TODO: Reddit saved posts: remove Unicode converter?
Responser.DecodersError = EDP.ReturnValue
DownloadDataChannel(String.Empty, Token) DownloadDataChannel(String.Empty, Token)
ElseIf IsChannel Then ElseIf IsChannel Then
If ChannelInfo Is Nothing Then If ChannelInfo Is Nothing Then
@@ -163,12 +165,15 @@ Namespace API.Reddit
End With End With
End If End If
If DownloadTopCount.HasValue Then DownloadLimitCount = DownloadTopCount If DownloadTopCount.HasValue Then DownloadLimitCount = DownloadTopCount
Else
GetUserInfo()
End If End If
If SaveToCache AndAlso Not Responser.Decoders.Contains(SymbolsConverter.Converters.HTML) Then _ If SaveToCache AndAlso Not Responser.Decoders.Contains(SymbolsConverter.Converters.HTML) Then _
Responser.Decoders.Add(SymbolsConverter.Converters.HTML) Responser.Decoders.Add(SymbolsConverter.Converters.HTML)
DownloadDataChannel(String.Empty, Token) DownloadDataChannel(String.Empty, Token)
If ChannelInfo Is Nothing Then _TempPostsList.ListAddList(_TempMediaList.Select(Function(m) m.Post.ID), LNC) If ChannelInfo Is Nothing Then _TempPostsList.ListAddList(_TempMediaList.Select(Function(m) m.Post.ID), LNC)
Else Else
GetUserInfo()
DownloadDataUser(String.Empty, Token) DownloadDataUser(String.Empty, Token)
End If End If
End Sub End Sub
@@ -203,7 +208,8 @@ Namespace API.Reddit
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing Using w As EContainer = JsonDocument.Parse(r).XmlIfNothing
If w.Count > 0 Then If w.Count > 0 Then
If UserDescriptionNeedToUpdate() Then UserDescriptionUpdate(w.ItemF({"subredditAboutInfo", 0, "publicDescription"}).XmlIfNothingValue) 'TODELETE: moved to 'GetUserInfo' 2023.2.5.0
'If UserDescriptionNeedToUpdate() Then UserDescriptionUpdate(w.ItemF({"subredditAboutInfo", 0, "publicDescription"}).XmlIfNothingValue)
n = w.GetNode(JsonNodesJson) n = w.GetNode(JsonNodesJson)
If Not n Is Nothing AndAlso n.Count > 0 Then If Not n Is Nothing AndAlso n.Count > 0 Then
For Each nn In n For Each nn In n
@@ -414,6 +420,37 @@ Namespace API.Reddit
ProcessException(ex, Token, $"channel data downloading error [{URL}]") ProcessException(ex, Token, $"channel data downloading error [{URL}]")
End Try End Try
End Sub End Sub
Private Sub GetUserInfo()
Try
If Not IsSavedPosts And ChannelInfo Is Nothing Then
Dim r$ = Responser.GetResponse($"https://reddit.com/{IIf(IsChannel, "r", "user")}/{Name}/about.json",, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing AndAlso j.Contains({"data", "subreddit"}) Then
With j({"data", "subreddit"})
UserSiteNameUpdate(.Value("title"))
UserDescriptionUpdate(.Value("public_description"))
Dim dir As SFile = MyFile.CutPath
Dim __getFile As Action(Of String) = Sub(ByVal img As String)
If Not img.IsEmptyString Then
Dim f As SFile = UrlToFile(img)
If Not f.Name.IsEmptyString Then
If f.Extension.IsEmptyString Then f.Extension = "jpg"
f.Path = dir.Path
If Not f.Exists Then GetWebFile(img, f, EDP.ReturnValue)
End If
End If
End Sub
__getFile.Invoke(.Value("icon_img"))
__getFile.Invoke(.Value("banner_img"))
End With
End If
End Using
End If
End If
Catch ex As Exception
End Try
End Sub
#End Region #End Region
#Region "Download Base Functions" #Region "Download Base Functions"
Private Function CreateImgurMedia(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String, Private Function CreateImgurMedia(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
@@ -522,7 +559,7 @@ Namespace API.Reddit
End Try End Try
End Function End Function
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken) Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
Dim RedGifsResponser As Response = Nothing Dim RedGifsResponser As Responser = Nothing
Try Try
ThrowAny(Token) ThrowAny(Token)
Const v2 As UTypes = UTypes.VideoPre + UTypes.m3u8 Const v2 As UTypes = UTypes.VideoPre + UTypes.m3u8
@@ -531,31 +568,36 @@ Namespace API.Reddit
Dim e As New ErrorsDescriber(EDP.ReturnValue) Dim e As New ErrorsDescriber(EDP.ReturnValue)
Dim m As UserMedia, m2 As UserMedia Dim m As UserMedia, m2 As UserMedia
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey) Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey)
Dim _repeatForRedgifs As Boolean
RedGifsResponser = RedGifsHost.Responser.Copy RedGifsResponser = RedGifsHost.Responser.Copy
For i% = _TempMediaList.Count - 1 To 0 Step -1 For i% = _TempMediaList.Count - 1 To 0 Step -1
ThrowAny(Token) ThrowAny(Token)
If _TempMediaList(i).Type = UTypes.VideoPre Or _TempMediaList(i).Type = v2 Then If _TempMediaList(i).Type = UTypes.VideoPre Or _TempMediaList(i).Type = v2 Then
m = _TempMediaList(i) m = _TempMediaList(i)
If _TempMediaList(i).Type = UTypes.VideoPre Then If _TempMediaList(i).Type = UTypes.VideoPre Then
If m.URL.Contains($"{SiteGfycatKey}.com") Then Do
r = Gfycat.Envir.GetVideo(m.URL) _repeatForRedgifs = False
ElseIf m.URL.Contains(SiteRedGifsKey) Then If m.URL.Contains($"{SiteGfycatKey}.com") Then
m2 = RedGifs.UserData.GetDataFromUrlId(m.URL, False, RedGifsResponser, RedGifsHost) r = Gfycat.Envir.GetVideo(m.URL)
If m2.State = UStates.Missing Then If Not r.IsEmptyString AndAlso r.Contains("redgifs.com") Then m.URL = r : _repeatForRedgifs = True
m.State = UStates.Missing ElseIf m.URL.Contains(SiteRedGifsKey) Then
_ContentList.Add(m) m2 = RedGifs.UserData.GetDataFromUrlId(m.URL, False, RedGifsResponser, RedGifsHost)
_TempMediaList.RemoveAt(i) If m2.State = UStates.Missing Then
ElseIf m2.State = RedGifs.UserData.DataGone Then m.State = UStates.Missing
_TempMediaList.RemoveAt(i) _ContentList.Add(m)
_TempMediaList.RemoveAt(i)
ElseIf m2.State = RedGifs.UserData.DataGone Then
_TempMediaList.RemoveAt(i)
Else
m2.URL_BASE = m.URL
m2.Post = m.Post
_TempMediaList(i) = m2
End If
Continue For
Else Else
m2.URL_BASE = m.URL r = Responser.GetResponse(m.URL,, e)
m2.Post = m.Post
_TempMediaList(i) = m2
End If End If
Continue For Loop While _repeatForRedgifs
Else
r = Responser.GetResponse(m.URL,, e)
End If
Else Else
r = m.URL r = m.URL
End If End If
@@ -579,7 +621,7 @@ Namespace API.Reddit
End Sub End Sub
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken) Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer) Dim rList As New List(Of Integer)
Dim RedGifsResponser As Response = Nothing Dim RedGifsResponser As Responser = Nothing
Try Try
If Not ChannelInfo Is Nothing Or SaveToCache Then Exit Sub If Not ChannelInfo Is Nothing Or SaveToCache Then Exit Sub
If ContentMissingExists Then If ContentMissingExists Then
@@ -656,11 +698,12 @@ Namespace API.Reddit
Public Overrides Sub Perform(Optional ByVal Value As Double = 1) Public Overrides Sub Perform(Optional ByVal Value As Double = 1)
End Sub End Sub
End Class End Class
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response, ByVal f As SFile, ByVal SpecialFolder As String) As IEnumerable(Of UserMedia) Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Responser, ByVal f As SFile, ByVal SpecialFolder As String) As IEnumerable(Of UserMedia)
Try Try
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
Using r As New UserData Using r As New UserData
r.Responser = New Response r.SetEnvironment(Settings(RedditSiteKey), Nothing, False, False)
r.Responser = New Responser
r.Responser.Copy(resp) r.Responser.Copy(resp)
r.ParsePost(URL) r.ParsePost(URL)
If r._TempMediaList.Count > 0 Then If r._TempMediaList.Count > 0 Then
@@ -711,7 +754,7 @@ Namespace API.Reddit
End Function End Function
#End Region #End Region
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
Dim RedGifsResponser As Response = Nothing Dim RedGifsResponser As Responser = Nothing
Try Try
Const _RFN$ = "RedditVideo" Const _RFN$ = "RedditVideo"
Const RFN$ = _RFN & "{0}" Const RFN$ = _RFN & "{0}"
@@ -793,7 +836,7 @@ Namespace API.Reddit
End Function End Function
Dim m$ Dim m$
Using w As New WebClient Using w As New WebClient
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path) If vsf Then CSFileP($"{MyDir}\Video\").Exists(SFO.Path)
Progress.Maximum += _ContentNew.Count Progress.Maximum += _ContentNew.Count
For i = 0 To _ContentNew.Count - 1 For i = 0 To _ContentNew.Count - 1
ThrowAny(Token) ThrowAny(Token)
@@ -850,7 +893,7 @@ Namespace API.Reddit
End If End If
If Not v.Type = UTypes.m3u8 Or Not f.IsEmptyString Then If Not v.Type = UTypes.m3u8 Or Not f.IsEmptyString Then
Select Case v.Type Select Case v.Type
Case UTypes.Picture : DownloadedPictures(False) += 1 Case UTypes.Picture, UTypes.GIF : DownloadedPictures(False) += 1
Case UTypes.Video, UTypes.m3u8 : DownloadedVideos(False) += 1 Case UTypes.Video, UTypes.m3u8 : DownloadedVideos(False) += 1
End Select End Select
If Not IsChannel Or Not SaveToCache Then If Not IsChannel Or Not SaveToCache Then
@@ -897,19 +940,20 @@ Namespace API.Reddit
End Sub End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then With Responser
UserExists = False If .StatusCode = HttpStatusCode.NotFound Then
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden Then UserExists = False
UserSuspended = True ElseIf .StatusCode = HttpStatusCode.Forbidden Then
ElseIf Responser.StatusCode = HttpStatusCode.BadGateway Or UserSuspended = True
Responser.StatusCode = HttpStatusCode.ServiceUnavailable Then ElseIf .StatusCode = HttpStatusCode.BadGateway Or .StatusCode = HttpStatusCode.ServiceUnavailable Then
MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})" MyMainLOG = $"[{CInt(Responser.StatusCode)}] Reddit is currently unavailable ({ToString()})"
ElseIf Responser.StatusCode = HttpStatusCode.GatewayTimeout Then ElseIf .StatusCode = HttpStatusCode.GatewayTimeout Then
Return 1 Return 1
Else Else
If Not FromPE Then LogError(ex, Message) : HasError = True If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0 Return 0
End If End If
End With
Return 1 Return 1
End Function End Function
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)

View File

@@ -14,6 +14,6 @@ Namespace API.RedGifs
Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v, n, e)) Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v, n, e))
Friend ReadOnly WatchIDRegex As RParams = RParams.DMS(".+?watch/([^\?&""/]+)", 1, EDP.ReturnValue) Friend ReadOnly WatchIDRegex As RParams = RParams.DMS(".+?watch/([^\?&""/]+)", 1, EDP.ReturnValue)
Friend ReadOnly ThumbsIDRegex As RParams = RParams.DMS("([^/\?&""]+?)(-\w+?|)\.(mp4|jpg)", 1, EDP.ReturnValue, Friend ReadOnly ThumbsIDRegex As RParams = RParams.DMS("([^/\?&""]+?)(-\w+?|)\.(mp4|jpg)", 1, EDP.ReturnValue,
Function(v) If(CStr(v).IsEmptyString, String.Empty, CStr(v).ToLower.Trim)) CType(Function(Input$) Input.StringToLower.StringTrim, Func(Of String, String)))
End Module End Module
End Namespace End Namespace

View File

@@ -9,13 +9,17 @@
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.RedGifs Namespace API.RedGifs
<Manifest(RedGifsSiteKey)> <Manifest(RedGifsSiteKey)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon Friend Overrides ReadOnly Property Icon As Icon
Get Get
Return My.Resources.SiteResources.RedGifsIcon_32 Return My.Resources.SiteResources.RedGifsIcon_32
@@ -26,37 +30,120 @@ Namespace API.RedGifs
Return My.Resources.SiteResources.RedGifsPic_32 Return My.Resources.SiteResources.RedGifsPic_32
End Get End Get
End Property End Property
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Bearer token")> <PropertyOption(ControlToolTip:="Bearer token", AllowNull:=False), ControlNumber(1)>
Friend Property Token As PropertyValue Friend ReadOnly Property Token As PropertyValue
<PXML> Friend ReadOnly Property TokenLastDateUpdated As PropertyValue
Private Const TokenName As String = "authorization" Private Const TokenName As String = "authorization"
#Region "TokenUpdateInterval"
<PropertyOption(ControlText:="Token refresh interval", ControlToolTip:="Interval (in minutes) to refresh the token", AllowNull:=False, LeftOffset:=120),
PXML, ControlNumber(0)>
Friend ReadOnly Property TokenUpdateInterval As PropertyValue
Private Class TokenIntervalProvider : 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
TypeError = False
ErrorMessage = String.Empty
If Not ACheck(Of Integer)(Value) Then
TypeError = True
ElseIf CInt(Value) > 0 Then
Return Value
Else
ErrorMessage = $"The value of [{Name}] field must be greater than or equal to 1"
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 [TokenIntervalProvider]")
End Function
End Class
<Provider(NameOf(TokenUpdateInterval), FieldsChecker:=True)>
Private ReadOnly Property TokenUpdateIntervalProvider As IFormatProvider
#End Region
#End Region
#Region "Initializer"
Friend Sub New() Friend Sub New()
MyBase.New(RedGifsSite, "redgifs.com") MyBase.New(RedGifsSite, "redgifs.com")
Dim t$ = String.Empty Dim t$ = String.Empty
With Responser With Responser
Dim b As Boolean = Not .UseWebClient Or Not .UseWebClientCookies Or Not .UseWebClientAdditionalHeaders Dim b As Boolean = Not .Mode = Responser.Modes.WebClient
.UseWebClient = True .Mode = Responser.Modes.WebClient
.UseWebClientCookies = True t = .Headers.Value(TokenName)
.UseWebClientAdditionalHeaders = True
If .Headers.Count > 0 AndAlso .Headers.ContainsKey(TokenName) Then t = .Headers(TokenName)
If b Then .SaveSettings() If b Then .SaveSettings()
End With End With
Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v)) Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v))
TokenLastDateUpdated = New PropertyValue(Now.AddYears(-1), GetType(Date))
TokenUpdateInterval = New PropertyValue(60 * 12, GetType(Integer))
TokenUpdateIntervalProvider = New TokenIntervalProvider
UrlPatternUser = "https://www.redgifs.com/users/{0}/" UrlPatternUser = "https://www.redgifs.com/users/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1) UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1)
ImageVideoContains = "redgifs" ImageVideoContains = "redgifs"
End Sub End Sub
#End Region
#Region "Response updater"
Private Sub UpdateResponse(ByVal Value As String) Private Sub UpdateResponse(ByVal Value As String)
With Responser.Headers Responser.Headers.Add(TokenName, Value)
If .Count = 0 OrElse Not .ContainsKey(TokenName) Then .Add(TokenName, Value) Else .Item(TokenName) = Value Responser.SaveSettings()
Responser.SaveSettings()
End With
End Sub End Sub
#End Region
#Region "Token updaters"
Friend Function UpdateTokenIfRequired() As Boolean
Dim d As Date? = AConvert(Of Date)(TokenLastDateUpdated.Value, AModes.Var, Nothing)
If Not d.HasValue OrElse d.Value < Now.AddMinutes(-CInt(TokenUpdateInterval.Value)) Then
Return UpdateToken()
Else
Return True
End If
End Function
<PropertyUpdater(NameOf(Token))>
Friend Function UpdateToken() As Boolean
Try
Dim r$
Dim NewToken$ = String.Empty
Using resp As New Responser : r = resp.GetResponse("https://api.redgifs.com/v2/auth/temporary",, EDP.ThrowException) : End Using
If Not r.IsEmptyString Then
Dim j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing Then
NewToken = j.Value("token")
j.Dispose()
End If
End If
If Not NewToken.IsEmptyString Then
Token.Value = $"Bearer {NewToken}"
TokenLastDateUpdated.Value = Now
Return True
Else
Return False
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "[API.RedGifs.SiteSettings.UpdateToken]", False)
End Try
End Function
#End Region
#Region "Update settings"
Private _LastTokenValue As String = String.Empty
Friend Overrides Sub BeginEdit()
_LastTokenValue = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
MyBase.BeginEdit()
End Sub
Friend Overrides Sub Update()
Dim NewToken$ = AConvert(Of String)(Token.Value, AModes.Var, String.Empty)
If Not _LastTokenValue = NewToken Then TokenLastDateUpdated.Value = Now
MyBase.Update()
End Sub
Friend Overrides Sub EndEdit()
_LastTokenValue = String.Empty
MyBase.EndEdit()
End Sub
#End Region
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData Return New UserData
End Function End Function
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
If BaseAuthExists() Then If BaseAuthExists() Then
Using resp As Response = Responser.Copy Using resp As Responser = Responser.Copy
Dim m As UserMedia = UserData.GetDataFromUrlId(URL, False, resp, Settings(RedGifsSiteKey)) Dim m As UserMedia = UserData.GetDataFromUrlId(URL, False, resp, Settings(RedGifsSiteKey))
If Not m.State = UStates.Missing And Not m.State = UserData.DataGone And (m.Type = UTypes.Picture Or m.Type = UTypes.Video) Then If Not m.State = UStates.Missing And Not m.State = UserData.DataGone And (m.Type = UTypes.Picture Or m.Type = UTypes.Video) Then
Try Try
@@ -80,11 +167,11 @@ Namespace API.RedGifs
End If End If
Return Nothing Return Nothing
End Function End Function
Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return $"https://www.redgifs.com/watch/{PostID}" Return $"https://www.redgifs.com/watch/{Media.Post.ID}"
End Function End Function
Friend Overrides Function BaseAuthExists() As Boolean Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 AndAlso ACheck(Token.Value) Return UpdateTokenIfRequired() AndAlso ACheck(Token.Value)
End Function End Function
End Class End Class
End Namespace End Namespace

View File

@@ -11,8 +11,8 @@ Imports System.Threading
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.WebDocuments.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.RedGifs Namespace API.RedGifs
@@ -20,6 +20,11 @@ Namespace API.RedGifs
Friend Const DataGone As HttpStatusCode = HttpStatusCode.Gone Friend Const DataGone As HttpStatusCode = HttpStatusCode.Gone
Private Const PostDataUrl As String = "https://api.redgifs.com/v2/gifs/{0}?views=yes&users=yes" Private Const PostDataUrl As String = "https://api.redgifs.com/v2/gifs/{0}?views=yes&users=yes"
#Region "Base declarations" #Region "Base declarations"
Private ReadOnly Property MySettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub End Sub
#End Region #End Region
@@ -30,14 +35,14 @@ Namespace API.RedGifs
#End Region #End Region
#Region "Download functions" #Region "Download functions"
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)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent&page={Page}" Dim _page As Func(Of String) = Function() If(Page = 1, String.Empty, $"&page={Page}")
Dim r$ = Responser.DownloadString(URL, EDP.ThrowException) URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent{_page.Invoke}"
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
Dim postDate$, postID$ Dim postDate$, postID$
Dim pTotal% = 0 Dim pTotal% = 0
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
@@ -51,7 +56,7 @@ Namespace API.RedGifs
Case DateResult.Exit : Exit Sub Case DateResult.Exit : Exit Sub
End Select End Select
postID = g.Value("id") postID = g.Value("id")
If Not _TempPostsList.Contains(postID) Then _TempPostsList.Add(postID) Else Exit For If Not _TempPostsList.Contains(postID) Then _TempPostsList.Add(postID) Else Exit Sub
ObtainMedia(g, postID, postDate) ObtainMedia(g, postID, postDate)
Next Next
End If End If
@@ -129,7 +134,7 @@ Namespace API.RedGifs
End If End If
Catch dex As ObjectDisposedException When Disposed Catch dex As ObjectDisposedException When Disposed
Catch ex As Exception Catch ex As Exception
ProcessException(ex, Token, $"missing data downloading error") ProcessException(ex, Token, $"missing data downloading error",, False)
Finally Finally
If Not Disposed And rList.Count > 0 Then If Not Disposed And rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
@@ -155,7 +160,7 @@ Namespace API.RedGifs
Return String.Empty Return String.Empty
End If End If
End Function End Function
Friend Shared Function GetDataFromUrlId(ByVal Obj As String, ByVal ObjIsID As Boolean, ByVal Responser As Response, Friend Shared Function GetDataFromUrlId(ByVal Obj As String, ByVal ObjIsID As Boolean, ByVal Responser As Responser,
ByVal Host As Plugin.Hosts.SettingsHost) As UserMedia ByVal Host As Plugin.Hosts.SettingsHost) As UserMedia
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
@@ -168,7 +173,7 @@ Namespace API.RedGifs
If Host.Source.Available(Plugin.ISiteSettings.Download.Main, True) Then If Host.Source.Available(Plugin.ISiteSettings.Download.Main, True) Then
If Responser Is Nothing Then Responser = Host.Responser.Copy If Responser Is Nothing Then Responser = Host.Responser.Copy
URL = String.Format(PostDataUrl, Obj.ToLower) URL = String.Format(PostDataUrl, Obj.ToLower)
Dim r$ = Responser.DownloadString(URL, EDP.ThrowException) Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r) Using j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing Then If Not j Is Nothing Then
@@ -192,9 +197,19 @@ Namespace API.RedGifs
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
If Not Responser Is Nothing AndAlso Responser.Client.StatusCode = DataGone Then _ If Not Responser Is Nothing AndAlso (Responser.Client.StatusCode = DataGone Or Responser.Client.StatusCode = HttpStatusCode.NotFound) Then
Return New UserMedia With {.State = DataGone} Return New UserMedia With {.State = DataGone}
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.RedGifs.UserData.GetDataFromUrlId({URL})]", New UserMedia) Else
Dim m As New UserMedia With {.State = UStates.Missing}
Dim _errText$ = "API.RedGifs.UserData.GetDataFromUrlId({0})"
If Responser.Client.StatusCode = HttpStatusCode.Unauthorized Then
_errText = $"RedGifs credentials have expired [{CInt(Responser.Client.StatusCode)}]: {_errText}"
MyMainLOG = String.Format(_errText, URL)
Return m
Else
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, String.Format(_errText, URL), m)
End If
End If
End Try End Try
End Function End Function
#End Region #End Region
@@ -218,8 +233,12 @@ Namespace API.RedGifs
#Region "Exception" #Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then Dim s As WebExceptionStatus = Responser.Client.Status
Dim sc As HttpStatusCode = Responser.Client.StatusCode
If sc = HttpStatusCode.NotFound Or s = DataGone Then
UserExists = False UserExists = False
ElseIf sc = HttpStatusCode.Unauthorized Then
MyMainLOG = $"RedGifs credentials have expired [{CInt(sc)}]: {ToStringForLog()}"
Else Else
If Not FromPE Then LogError(ex, Message) : HasError = True If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0 Return 0

View File

@@ -36,7 +36,7 @@ Namespace API.TikTok
Return UserData.GetVideoInfo(URL, Responser) Return UserData.GetVideoInfo(URL, Responser)
End Function End Function
Friend Overrides Function BaseAuthExists() As Boolean Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 Return Responser.CookiesExists
End Function End Function
End Class End Class
End Namespace End Namespace

View File

@@ -10,7 +10,7 @@ Imports System.Threading
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.Web.Clients
Namespace API.TikTok Namespace API.TikTok
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
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)
@@ -52,7 +52,7 @@ Namespace API.TikTok
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken) Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal Responser As Response, Optional ByVal e As ErrorsDescriber = Nothing) As IEnumerable(Of UserMedia) Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal Responser As Responser, Optional ByVal e As ErrorsDescriber = Nothing) As IEnumerable(Of UserMedia)
Try Try
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
Dim PostId$ = String.Empty Dim PostId$ = String.Empty
@@ -61,7 +61,7 @@ Namespace API.TikTok
Dim r$ Dim r$
PostId = RegexEnvir.ExtractPostID(URL) PostId = RegexEnvir.ExtractPostID(URL)
If Not PostId.IsEmptyString Then If Not PostId.IsEmptyString Then
Using resp As Response = Responser.Copy() : r = resp.GetResponse(URL,, EDP.ThrowException) : End Using Using resp As Responser = Responser.Copy() : r = resp.GetResponse(URL,, EDP.ThrowException) : End Using
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
If RegexEnvir.GetVideoData(r, PostId, PostURL, PostDate) Then Return {MediaFromData(PostURL, PostId, PostDate)} If RegexEnvir.GetVideoData(r, PostId, PostURL, PostDate) Then Return {MediaFromData(PostURL, PostId, PostDate)}
End If End If

View File

@@ -6,14 +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.Globalization
Imports PersonalUtilities.Functions.XML.Base Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Twitter Namespace API.Twitter
Friend Module Declarations Friend Module Declarations
Friend Const TwitterSite As String = "Twitter" Friend Const TwitterSite As String = "Twitter"
Friend DateProvider As New ADateTime(ADateTime.Formats.BaseDateTime) Friend Const TwitterSiteKey As String = "AndyProgram_Twitter"
Friend ReadOnly DateProvider As ADateTime = GetDateProvider()
Friend ReadOnly VideoNode As NodeParams() = {New NodeParams("video_info", True, True, True, True, 10)} Friend ReadOnly VideoNode As NodeParams() = {New NodeParams("video_info", True, True, True, True, 10)}
Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue) Friend ReadOnly VideoSizeRegEx As RParams = RParams.DMS("\d+x(\d+)", 1, EDP.ReturnValue)
Friend ReadOnly UserIdRegEx As RParams = RParams.DMS("user_id.:.(\d+)", 1, EDP.ReturnValue) Friend ReadOnly UserIdRegEx As RParams = RParams.DMS("user_id.:.(\d+)", 1, EDP.ReturnValue)
Private Function GetDateProvider() As ADateTime
Dim n As DateTimeFormatInfo = CultureInfo.GetCultureInfo("en-us").DateTimeFormat.Clone
n.FullDateTimePattern = "ddd MMM dd HH:mm:ss +ffff yyyy"
n.TimeSeparator = String.Empty
Return New ADateTime(DirectCast(n.Clone, DateTimeFormatInfo)) With {.DateTimeStyle = DateTimeStyles.AssumeUniversal}
End Function
End Module End Module
End Namespace End Namespace

View File

@@ -0,0 +1,32 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Twitter
Friend Class EditorExchangeOptions
Friend Property GifsDownload As Boolean
Friend Property GifsSpecialFolder As String
Friend Property GifsPrefix As String
Friend Property UseMD5Comparison As Boolean = False
Friend Property RemoveExistingDuplicates As Boolean = False
Friend Sub New()
End Sub
Friend Sub New(ByVal s As SiteSettings)
GifsDownload = s.GifsDownload.Value
GifsSpecialFolder = s.GifsSpecialFolder.Value
GifsPrefix = s.GifsPrefix.Value
UseMD5Comparison = s.UseMD5Comparison.Value
End Sub
Friend Sub New(ByVal u As UserData)
GifsDownload = u.GifsDownload
GifsSpecialFolder = u.GifsSpecialFolder
GifsPrefix = u.GifsPrefix
UseMD5Comparison = u.UseMD5Comparison
RemoveExistingDuplicates = u.RemoveExistingDuplicates
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,185 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Twitter
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class OptionsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Dim ActionButton3 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(OptionsForm))
Dim ActionButton4 As PersonalUtilities.Forms.Controls.Base.ActionButton = New PersonalUtilities.Forms.Controls.Base.ActionButton()
Dim TT_MAIN As System.Windows.Forms.ToolTip
Me.CH_DOWN_GIFS = New System.Windows.Forms.CheckBox()
Me.TXT_GIF_FOLDER = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.TXT_GIF_PREFIX = New PersonalUtilities.Forms.Controls.TextBoxExtended()
Me.CH_USE_MD5 = New System.Windows.Forms.CheckBox()
Me.CH_REMOVE_EXISTING_DUP = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
CType(Me.TXT_GIF_FOLDER, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.TXT_GIF_PREFIX, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(304, 161)
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(304, 161)
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(Me.CH_DOWN_GIFS, 0, 0)
TP_MAIN.Controls.Add(Me.TXT_GIF_FOLDER, 0, 1)
TP_MAIN.Controls.Add(Me.TXT_GIF_PREFIX, 0, 2)
TP_MAIN.Controls.Add(Me.CH_USE_MD5, 0, 3)
TP_MAIN.Controls.Add(Me.CH_REMOVE_EXISTING_DUP, 0, 4)
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 = 6
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 28.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(304, 161)
TP_MAIN.TabIndex = 0
'
'CH_DOWN_GIFS
'
Me.CH_DOWN_GIFS.AutoSize = True
Me.CH_DOWN_GIFS.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_GIFS.Location = New System.Drawing.Point(4, 4)
Me.CH_DOWN_GIFS.Name = "CH_DOWN_GIFS"
Me.CH_DOWN_GIFS.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
Me.CH_DOWN_GIFS.Size = New System.Drawing.Size(296, 19)
Me.CH_DOWN_GIFS.TabIndex = 0
Me.CH_DOWN_GIFS.Text = "Download GIFs"
Me.CH_DOWN_GIFS.UseVisualStyleBackColor = True
'
'TXT_GIF_FOLDER
'
ActionButton3.BackgroundImage = CType(resources.GetObject("ActionButton3.BackgroundImage"), System.Drawing.Image)
ActionButton3.Name = "Clear"
ActionButton3.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_GIF_FOLDER.Buttons.Add(ActionButton3)
Me.TXT_GIF_FOLDER.CaptionText = "GIFs special folder"
Me.TXT_GIF_FOLDER.CaptionToolTipText = "Put the GIFs in a special folder"
Me.TXT_GIF_FOLDER.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_GIF_FOLDER.Location = New System.Drawing.Point(4, 30)
Me.TXT_GIF_FOLDER.Name = "TXT_GIF_FOLDER"
Me.TXT_GIF_FOLDER.Size = New System.Drawing.Size(296, 22)
Me.TXT_GIF_FOLDER.TabIndex = 1
'
'TXT_GIF_PREFIX
'
ActionButton4.BackgroundImage = CType(resources.GetObject("ActionButton4.BackgroundImage"), System.Drawing.Image)
ActionButton4.Name = "Clear"
ActionButton4.Tag = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons.Clear
Me.TXT_GIF_PREFIX.Buttons.Add(ActionButton4)
Me.TXT_GIF_PREFIX.CaptionText = "GIF prefix"
Me.TXT_GIF_PREFIX.CaptionToolTipText = "This prefix will be added to the beginning of the filename"
Me.TXT_GIF_PREFIX.Dock = System.Windows.Forms.DockStyle.Fill
Me.TXT_GIF_PREFIX.Location = New System.Drawing.Point(4, 59)
Me.TXT_GIF_PREFIX.Name = "TXT_GIF_PREFIX"
Me.TXT_GIF_PREFIX.Size = New System.Drawing.Size(296, 22)
Me.TXT_GIF_PREFIX.TabIndex = 2
'
'CH_USE_MD5
'
Me.CH_USE_MD5.AutoSize = True
Me.CH_USE_MD5.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_USE_MD5.Location = New System.Drawing.Point(4, 88)
Me.CH_USE_MD5.Name = "CH_USE_MD5"
Me.CH_USE_MD5.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
Me.CH_USE_MD5.Size = New System.Drawing.Size(296, 19)
Me.CH_USE_MD5.TabIndex = 3
Me.CH_USE_MD5.Text = "Use MD5 comparison"
TT_MAIN.SetToolTip(Me.CH_USE_MD5, "Each image will be checked for existence using MD5")
Me.CH_USE_MD5.UseVisualStyleBackColor = True
'
'CH_REMOVE_EXISTING_DUP
'
Me.CH_REMOVE_EXISTING_DUP.AutoSize = True
Me.CH_REMOVE_EXISTING_DUP.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_REMOVE_EXISTING_DUP.Location = New System.Drawing.Point(4, 114)
Me.CH_REMOVE_EXISTING_DUP.Name = "CH_REMOVE_EXISTING_DUP"
Me.CH_REMOVE_EXISTING_DUP.Padding = New System.Windows.Forms.Padding(100, 0, 0, 0)
Me.CH_REMOVE_EXISTING_DUP.Size = New System.Drawing.Size(296, 19)
Me.CH_REMOVE_EXISTING_DUP.TabIndex = 4
Me.CH_REMOVE_EXISTING_DUP.Text = "Remove existing duplicates"
TT_MAIN.SetToolTip(Me.CH_REMOVE_EXISTING_DUP, "Existing files will be checked for duplicates and duplicates removed." & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "Works only" &
" on the first activation 'Use MD5 comparison'.")
Me.CH_REMOVE_EXISTING_DUP.UseVisualStyleBackColor = True
'
'OptionsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(304, 161)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteResources.TwitterIcon_32
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(320, 200)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(320, 200)
Me.Name = "OptionsForm"
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_MAIN.PerformLayout()
CType(Me.TXT_GIF_FOLDER, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.TXT_GIF_PREFIX, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Private WithEvents CH_DOWN_GIFS As CheckBox
Private WithEvents TXT_GIF_FOLDER As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents TXT_GIF_PREFIX As PersonalUtilities.Forms.Controls.TextBoxExtended
Private WithEvents CH_USE_MD5 As CheckBox
Private WithEvents CH_REMOVE_EXISTING_DUP As CheckBox
End Class
End Namespace

View File

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

View File

@@ -0,0 +1,81 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Controls
Namespace API.Twitter
Friend Class OptionsForm
Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property MyExchangeOptions As EditorExchangeOptions
Private ReadOnly MyGifTextProvider As SiteSettings.GifStringProvider
Friend Sub New(ByRef ExchangeOptions As EditorExchangeOptions)
InitializeComponent()
MyExchangeOptions = ExchangeOptions
MyGifTextProvider = New SiteSettings.GifStringProvider
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
Private Sub OptionsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize(True)
.AddOkCancelToolbar()
With MyExchangeOptions
CH_DOWN_GIFS.Checked = .GifsDownload
TXT_GIF_FOLDER.Text = .GifsSpecialFolder
TXT_GIF_FOLDER.Tag = NameOf(SiteSettings.GifsSpecialFolder)
TXT_GIF_PREFIX.Text = .GifsPrefix
TXT_GIF_PREFIX.Tag = NameOf(SiteSettings.GifsPrefix)
CH_USE_MD5.Checked = .UseMD5Comparison
CH_REMOVE_EXISTING_DUP.Checked = .RemoveExistingDuplicates
Try
Dim p As PropertyOption
With Settings(TwitterSiteKey)
p = .PropList.Find(Function(pp) pp.Name = TXT_GIF_FOLDER.Tag).Options
If Not p Is Nothing Then
TXT_GIF_FOLDER.CaptionText = p.ControlText
TXT_GIF_FOLDER.CaptionToolTipText = p.ControlToolTip
TXT_GIF_FOLDER.CaptionToolTipEnabled = Not TXT_GIF_FOLDER.CaptionToolTipText.IsEmptyString
End If
p = .PropList.Find(Function(pp) pp.Name = TXT_GIF_PREFIX.Tag).Options
If Not p Is Nothing Then
TXT_GIF_PREFIX.CaptionText = p.ControlText
TXT_GIF_PREFIX.CaptionToolTipText = p.ControlToolTip
TXT_GIF_PREFIX.CaptionToolTipEnabled = Not TXT_GIF_PREFIX.CaptionToolTipText.IsEmptyString
End If
End With
Catch
End Try
End With
.EndLoaderOperations()
End With
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
With MyExchangeOptions
.GifsDownload = CH_DOWN_GIFS.Checked
.GifsSpecialFolder = TXT_GIF_FOLDER.Text
.GifsPrefix = TXT_GIF_PREFIX.Text
.UseMD5Comparison = CH_USE_MD5.Checked
.RemoveExistingDuplicates = CH_REMOVE_EXISTING_DUP.Checked
End With
MyDefs.CloseForm()
End Sub
Private Sub TXT_ActionOnTextChanged(ByVal Sender As TextBoxExtended, ByVal e As EventArgs) Handles TXT_GIF_FOLDER.ActionOnTextChanged,
TXT_GIF_PREFIX.ActionOnTextChanged
If Not MyDefs.Initializing Then
With Sender
MyGifTextProvider.PropertyName = .Tag
Dim s% = .SelectionStart
Dim t$ = AConvert(Of String)(.Text, String.Empty, MyGifTextProvider)
If Not .Text = t Then .Text = t : .Select(s, 0)
End With
End If
End Sub
End Class
End Namespace

View File

@@ -9,13 +9,15 @@
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.WEB
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Namespace API.Twitter Namespace API.Twitter
<Manifest("AndyProgram_Twitter"), SavedPosts> <Manifest(TwitterSiteKey), SavedPosts, SpecialForm(False)>
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"
#Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon Friend Overrides ReadOnly Property Icon As Icon
Get Get
Return My.Resources.SiteResources.TwitterIcon_32 Return My.Resources.SiteResources.TwitterIcon_32
@@ -26,47 +28,83 @@ Namespace API.Twitter
Return My.Resources.SiteResources.TwitterPic_400 Return My.Resources.SiteResources.TwitterPic_400
End Get End Get
End Property End Property
<PropertyOption(AllowNull:=False, ControlText:="Authorization", #Region "Auth"
<PropertyOption(AllowNull:=False, IsAuth:=True, ControlText:="Authorization",
ControlToolTip:="Set authorization from [authorization] response header. This field must start from [Bearer] key word")> ControlToolTip:="Set authorization from [authorization] response header. This field must start from [Bearer] key word")>
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, IsAuth:=True, ControlText:="Token", ControlToolTip:="Set token from [x-csrf-token] response header")>
Private ReadOnly Property Token As PropertyValue Private ReadOnly Property Token As PropertyValue
<PropertyOption(ControlText:="Saved posts user name", ControlToolTip:="Personal profile username", LeftOffset:=120), PXML> <PropertyOption(IsAuth:=True, ControlText:="Saved posts user", ControlToolTip:="Personal profile username"), PXML>
Friend ReadOnly Property SavedPostsUserName As PropertyValue Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend Overrides ReadOnly Property Responser As Response #End Region
#Region "Other properties"
<PropertyOption(IsAuth:=False, ControlText:="Download GIFs"), PXML>
Friend ReadOnly Property GifsDownload As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:="GIFs special folder",
ControlToolTip:="Put the GIFs in a special folder" & vbCr &
"This is a folder name, not an absolute path." & vbCr &
"This folder(s) will be created relative to the user's root folder." & vbCr &
"Examples:" & vbCr & "SomeFolderName" & vbCr & "SomeFolderName\SomeFolderName2"), PXML>
Friend ReadOnly Property GifsSpecialFolder As PropertyValue
<PropertyOption(IsAuth:=False, ControlText:="GIF prefix", ControlToolTip:="This prefix will be added to the beginning of the filename"), PXML>
Friend ReadOnly Property GifsPrefix As PropertyValue
<Provider(NameOf(GifsSpecialFolder), Interaction:=True), Provider(NameOf(GifsPrefix), Interaction:=True)>
Private ReadOnly Property GifStringChecker As IFormatProvider
Friend Class GifStringProvider : Implements ICustomProvider, IPropertyProvider
Friend Property PropertyName As String Implements IPropertyProvider.PropertyName
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 String)(Value, String.Empty)
If Not v.IsEmptyString Then
If PropertyName = NameOf(GifsPrefix) Then
v = v.StringRemoveWinForbiddenSymbols
Else
v = v.StringReplaceSymbols(GetWinForbiddenSymbols.ToList.ListWithRemove("\").ToArray, String.Empty, EDP.ReturnValue)
v = v.StringTrim("\")
End If
End If
Return v
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
<PropertyOption(IsAuth:=False, ControlText:="Use MD5 comparison", ControlToolTip:="Each image will be checked for existence using MD5"), PXML>
Friend ReadOnly Property UseMD5Comparison As PropertyValue
#End Region
Friend Overrides ReadOnly Property Responser As Responser
#End Region
Friend Sub New() Friend Sub New()
MyBase.New(TwitterSite) MyBase.New(TwitterSite)
Responser = New Response($"{SettingsFolderName}\Responser_{Site}.xml") Responser = New Responser($"{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
Dim b As Boolean = .CookiesDomain.IsEmptyString
If EncryptCookies.CookiesEncrypted Then .CookiesEncryptKey = SettingsCLS.CookieEncryptKey If EncryptCookies.CookiesEncrypted Then .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.LoadSettings() .LoadSettings()
With .Headers a = .Headers.Value(Header_Authorization)
If .ContainsKey(Header_Authorization) Then a = .Item(Header_Authorization) t = .Headers.Value(Header_Token)
If .ContainsKey(Header_Token) Then t = .Item(Header_Token) .CookiesDomain = "twitter.com"
End With If b Then .SaveSettings()
Else Else
.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 .CookiesEncryptKey = SettingsCLS.CookieEncryptKey
.Decoders.Add(SymbolsConverter.Converters.Unicode) .Decoders.Add(SymbolsConverter.Converters.Unicode)
With .Headers .Headers.Add("sec-ch-ua", " Not;A Brand"";v=""99"", ""Google Chrome"";v=""91"", ""Chromium"";v=""91""")
.Add("sec-ch-ua", " Not;A Brand"";v=""99"", ""Google Chrome"";v=""91"", ""Chromium"";v=""91""") .Headers.Add("sec-ch-ua-mobile", "?0")
.Add("sec-ch-ua-mobile", "?0") .Headers.Add("sec-fetch-dest", "empty")
.Add("sec-fetch-dest", "empty") .Headers.Add("sec-fetch-mode", "cors")
.Add("sec-fetch-mode", "cors") .Headers.Add("sec-fetch-site", "same-origin")
.Add("sec-fetch-site", "same-origin") .Headers.Add(Header_Token, String.Empty)
.Add(Header_Token, String.Empty) .Headers.Add("x-twitter-active-user", "yes")
.Add("x-twitter-active-user", "yes") .Headers.Add("x-twitter-auth-type", "OAuth2Session")
.Add("x-twitter-auth-type", "OAuth2Session") .Headers.Add(Header_Authorization, String.Empty)
.Add(Header_Authorization, String.Empty)
End With
.SaveSettings() .SaveSettings()
End If End If
End With End With
@@ -75,6 +113,12 @@ Namespace API.Twitter
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)) SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
GifsDownload = New PropertyValue(True)
GifsSpecialFolder = New PropertyValue(String.Empty, GetType(String))
GifsPrefix = New PropertyValue("GIF_")
GifStringChecker = New GifStringProvider
UseMD5Comparison = New PropertyValue(False)
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}"
ImageVideoContains = "twitter" ImageVideoContains = "twitter"
@@ -87,7 +131,7 @@ Namespace API.Twitter
Case NameOf(Token) : f = Header_Token Case NameOf(Token) : f = Header_Token
End Select End Select
If Not f.IsEmptyString Then If Not f.IsEmptyString Then
If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f) Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value)) If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
Responser.SaveSettings() Responser.SaveSettings()
End If End If
@@ -103,11 +147,17 @@ Namespace API.Twitter
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
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 Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return $"https://twitter.com/{UserID}/status/{PostID}" Return $"https://twitter.com/{User.Name}/status/{Media.Post.ID}"
End Function End Function
Friend Overrides Function BaseAuthExists() As Boolean Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 And ACheck(Token.Value) And ACheck(Auth.Value) Return Responser.CookiesExists And ACheck(Token.Value) And ACheck(Auth.Value)
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 EditorExchangeOptions Then Options = New EditorExchangeOptions(Me)
If OpenForm Then
Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
End Class End Class
End Namespace End Namespace

View File

@@ -7,25 +7,77 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Net Imports System.Net
Imports System.Drawing
Imports System.Threading Imports System.Threading
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.WebDocuments.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports PersonalUtilities.Tools.ImageRenderer
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Twitter Namespace API.Twitter
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
Private Const SinglePostUrl As String = "https://api.twitter.com/1.1/statuses/show.json?id={0}&tweet_mode=extended" Private Const SinglePostUrl As String = "https://api.twitter.com/1.1/statuses/show.json?id={0}&tweet_mode=extended"
#Region "XML names"
Private Const Name_GifsDownload As String = "GifsDownload"
Private Const Name_GifsSpecialFolder As String = "GifsSpecialFolder"
Private Const Name_GifsPrefix As String = "GifsPrefix"
Private Const Name_UseMD5Comparison As String = "UseMD5Comparison"
Private Const Name_RemoveExistingDuplicates As String = "RemoveExistingDuplicates"
Private Const Name_StartMD5Checked As String = "StartMD5Checked"
#End Region
#Region "Declarations" #Region "Declarations"
Friend Property GifsDownload As Boolean
Friend Property GifsSpecialFolder As String
Friend Property GifsPrefix As String
Private ReadOnly _DataNames As List(Of String) Private ReadOnly _DataNames As List(Of String)
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean) Friend Property UseMD5Comparison As Boolean = False
Private StartMD5Checked As Boolean = False
Friend Property RemoveExistingDuplicates As Boolean = False
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptions(Me)
End Function
Friend Overrides Sub ExchangeOptionsSet(ByVal Obj As Object)
If Not Obj Is Nothing AndAlso TypeOf Obj Is EditorExchangeOptions Then
With DirectCast(Obj, EditorExchangeOptions)
GifsDownload = .GifsDownload
GifsSpecialFolder = .GifsSpecialFolder
GifsPrefix = .GifsPrefix
UseMD5Comparison = .UseMD5Comparison
RemoveExistingDuplicates = .RemoveExistingDuplicates
End With
End If
End Sub End Sub
#End Region #End Region
#Region "Initializer" #Region "Initializer, loader"
Friend Sub New() Friend Sub New()
_DataNames = New List(Of String) _DataNames = New List(Of String)
End Sub End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then
GifsDownload = Container.Value(Name_GifsDownload).FromXML(Of Boolean)(True)
GifsSpecialFolder = Container.Value(Name_GifsSpecialFolder)
If Not Container.Contains(Name_GifsPrefix) Then
GifsPrefix = "GIF_"
Else
GifsPrefix = Container.Value(Name_GifsPrefix)
End If
UseMD5Comparison = Container.Value(Name_UseMD5Comparison).FromXML(Of Boolean)(False)
RemoveExistingDuplicates = Container.Value(Name_RemoveExistingDuplicates).FromXML(Of Boolean)(False)
StartMD5Checked = Container.Value(Name_StartMD5Checked).FromXML(Of Boolean)(False)
Else
Container.Add(Name_GifsDownload, GifsDownload.BoolToInteger)
Container.Add(Name_GifsSpecialFolder, GifsSpecialFolder)
Container.Add(Name_GifsPrefix, GifsPrefix)
Container.Add(Name_UseMD5Comparison, UseMD5Comparison.BoolToInteger)
Container.Add(Name_RemoveExistingDuplicates, RemoveExistingDuplicates.BoolToInteger)
Container.Add(Name_StartMD5Checked, StartMD5Checked.BoolToInteger)
End If
End Sub
#End Region #End Region
#Region "Download functions" #Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
@@ -35,6 +87,7 @@ Namespace API.Twitter
Else Else
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly) If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData(String.Empty, Token) DownloadData(String.Empty, Token)
If UseMD5Comparison Then ValidateMD5(Token)
End If 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)
@@ -65,6 +118,30 @@ Namespace API.Twitter
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 w.ListExists Then If w.ListExists Then
If Not IsSavedPosts And POST.IsEmptyString And Not w.ItemF({0, "user"}) Is Nothing Then
With w.ItemF({0, "user"})
If .Value("screen_name").StringToLower = Name Then
UserSiteNameUpdate(.Value("name"))
UserDescriptionUpdate(.Value("description"))
Dim __getImage As Action(Of String) = Sub(ByVal img As String)
If Not img.IsEmptyString Then
Dim __imgFile As SFile = UrlFile(img, True)
If Not __imgFile.Name.IsEmptyString Then
If __imgFile.Extension.IsEmptyString Then __imgFile.Extension = "jpg"
__imgFile.Path = MyFile.CutPath.Path
If Not __imgFile.Exists Then GetWebFile(img, __imgFile, EDP.None)
End If
End If
End Sub
Dim icon$ = .Value("profile_image_url_https")
If Not icon.IsEmptyString Then icon = icon.Replace("_normal", String.Empty)
__getImage.Invoke(.Value("profile_banner_url"))
__getImage.Invoke(icon)
End If
End With
End If
For Each nn In If(IsSavedPosts, w({"globalObjects", "tweets"}).XmlIfNothing, 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
@@ -79,9 +156,6 @@ Namespace API.Twitter
End If End If
End If End If
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
If nn.Contains("created_at") Then PostDate = nn("created_at").Value Else PostDate = String.Empty If nn.Contains("created_at") Then PostDate = nn("created_at").Value Else PostDate = String.Empty
@@ -139,7 +213,7 @@ Namespace API.Twitter
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), State), LNC) PostID, PostDate, GetPictureOption(m), State, UTypes.Picture), LNC)
End If End If
End If End If
Next Next
@@ -155,7 +229,7 @@ Namespace API.Twitter
Dim f$ = UrlFile(URL) Dim f$ = UrlFile(URL)
If Not f.IsEmptyString AndAlso Not _DataNames.Contains(f) Then If Not f.IsEmptyString AndAlso Not _DataNames.Contains(f) Then
_DataNames.Add(f) _DataNames.Add(f)
_TempMediaList.ListAddValue(MediaFromData(URL, PostID, PostDate,, State), LNC) _TempMediaList.ListAddValue(MediaFromData(URL, PostID, PostDate,, State, UTypes.Video), LNC)
End If End If
Return True Return True
End If End If
@@ -182,10 +256,11 @@ Namespace API.Twitter
url = .Value("url") url = .Value("url")
ff = UrlFile(url) ff = UrlFile(url)
If Not ff.IsEmptyString Then If Not ff.IsEmptyString Then
If Not _DataNames.Contains(ff) Then If GifsDownload And Not _DataNames.Contains(ff) Then
m = MediaFromData(url, PostID, PostDate,, State) m = MediaFromData(url, PostID, PostDate,, State, UTypes.Video)
f = m.File f = m.File
If Not f.IsEmptyString Then f.Name = $"GIF_{f.Name}" : m.File = f If Not f.IsEmptyString And Not GifsPrefix.IsEmptyString Then f.Name = $"{GifsPrefix}{f.Name}" : m.File = f
If Not GifsSpecialFolder.IsEmptyString Then m.SpecialFolder = $"{GifsSpecialFolder}*"
_TempMediaList.ListAddValue(m, LNC) _TempMediaList.ListAddValue(m, LNC)
End If End If
Return True Return True
@@ -262,19 +337,144 @@ Namespace API.Twitter
End Try End Try
End Sub End Sub
#End Region #End Region
#Region "MD5 support"
Private Const VALIDATE_MD5_ERROR As String = "VALIDATE_MD5_ERROR"
Private Sub ValidateMD5(ByVal Token As CancellationToken)
Try
Dim missingMD5 As Predicate(Of UserMedia) = Function(d) (d.Type = UTypes.GIF Or d.Type = UTypes.Picture) And d.MD5.IsEmptyString
If UseMD5Comparison And _TempMediaList.Exists(missingMD5) Then
Dim i%
Dim data As UserMedia = Nothing
Dim hashList As New Dictionary(Of String, SFile)
Dim f As SFile
Dim ErrMD5 As New ErrorsDescriber(EDP.ReturnValue)
Dim __getMD5 As Func(Of UserMedia, Boolean, String) =
Function(ByVal __data As UserMedia, ByVal IsUrl As Boolean) As String
Try
Dim ImgFormat As Imaging.ImageFormat = Nothing
Dim hash$ = String.Empty
Dim __isGif As Boolean = False
If __data.Type = UTypes.GIF Then
ImgFormat = Imaging.ImageFormat.Gif
__isGif = True
ElseIf Not __data.File.IsEmptyString Then
ImgFormat = GetImageFormat(__data.File)
End If
If ImgFormat Is Nothing Then ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL_BASE.IfNullOrEmpty(__data.URL), ErrMD5), ImgFormat, ErrMD5))
Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If
If hash.IsEmptyString And Not __isGif Then
If ImgFormat Is Imaging.ImageFormat.Jpeg Then ImgFormat = Imaging.ImageFormat.Png Else ImgFormat = Imaging.ImageFormat.Jpeg
If IsUrl Then
hash = ByteArrayToString(GetMD5(SFile.GetBytesFromNet(__data.URL_BASE.IfNullOrEmpty(__data.URL), ErrMD5), ImgFormat, ErrMD5))
Else
hash = ByteArrayToString(GetMD5(SFile.GetBytes(__data.File, ErrMD5), ImgFormat, ErrMD5))
End If
End If
Return hash
Catch
Return String.Empty
End Try
End Function
If Not StartMD5Checked Then
StartMD5Checked = True
If _ContentList.Exists(missingMD5) Then
Dim existingFiles As List(Of SFile) = SFile.GetFiles(MyFileSettings.CutPath, "*.jpg|*.jpeg|*.png|*.gif",, EDP.ReturnValue).ListIfNothing
Dim eIndx%
Dim eFinder As Predicate(Of SFile) = Function(ff) ff.File = data.File.File
If RemoveExistingDuplicates Then
RemoveExistingDuplicates = False
_ForceSaveUserInfo = True
If existingFiles.Count > 0 Then
Dim h$
For i = existingFiles.Count - 1 To 0 Step -1
h = __getMD5(New UserMedia With {.File = existingFiles(i)}, False)
If Not h.IsEmptyString Then
If hashList.ContainsKey(h) Then
MyMainLOG = $"[{ToStringForLog()}]: Removed image [{existingFiles(i).File}] (duplicate of [{hashList(h).File}])"
existingFiles(i).Delete(SFO.File, SFODelete.DeleteToRecycleBin, ErrMD5)
existingFiles.RemoveAt(i)
Else
hashList.Add(h, existingFiles(i))
End If
End If
Next
End If
End If
For i = 0 To _ContentList.Count - 1
data = _ContentList(i)
If (data.Type = UTypes.GIF Or data.Type = UTypes.Picture) Then
If data.MD5.IsEmptyString Then
ThrowAny(Token)
eIndx = existingFiles.FindIndex(eFinder)
If eIndx >= 0 Then
data.MD5 = __getMD5(New UserMedia With {.File = existingFiles(eIndx)}, False)
If Not data.MD5.IsEmptyString Then _ContentList(i) = data : _ForceSaveUserData = True
End If
End If
existingFiles.RemoveAll(eFinder)
End If
Next
If existingFiles.Count > 0 Then
For i = 0 To existingFiles.Count - 1
f = existingFiles(i)
data = New UserMedia(f.File) With {
.State = UStates.Downloaded,
.Type = IIf(f.Extension = "gif", UTypes.GIF, UTypes.Picture),
.File = f
}
ThrowAny(Token)
data.MD5 = __getMD5(data, False)
If Not data.MD5.IsEmptyString Then _ContentList.Add(data) : _ForceSaveUserData = True
Next
existingFiles.Clear()
End If
End If
End If
If _ContentList.Count > 0 Then
With _ContentList.Select(Function(d) d.MD5)
If .ListExists Then .ToList.ForEach(Sub(md5value) If Not hashList.ContainsKey(md5value) Then hashList.Add(md5value, New SFile))
End With
End If
For i = _TempMediaList.Count - 1 To 0 Step -1
data = _TempMediaList(i)
If missingMD5(data) Then
ThrowAny(Token)
data.MD5 = __getMD5(data, True)
If Not data.MD5.IsEmptyString Then
If hashList.ContainsKey(data.MD5) Then
_TempMediaList.RemoveAt(i)
Else
hashList.Add(data.MD5, New SFile)
_TempMediaList(i) = data
End If
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "ValidateMD5",, VALIDATE_MD5_ERROR)
End Try
End Sub
#End Region
#Region "Get video static" #Region "Get video static"
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 Responser) As IEnumerable(Of UserMedia)
Try Try
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$ Dim r$
Using rc As Response = resp.Copy() : r = rc.GetResponse(String.Format(SinglePostUrl, PostID),, EDP.ReturnValue) : End Using Using rc As Responser = resp.Copy() : r = rc.GetResponse(String.Format(SinglePostUrl, PostID),, EDP.ReturnValue) : End Using
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
Dim u$ = GetVideoNodeURL(j) Dim u$ = GetVideoNodeURL(j)
If Not u.IsEmptyString Then Return {MediaFromData(u, PostID, String.Empty)} If Not u.IsEmptyString Then Return {MediaFromData(u, PostID, String.Empty,,, UTypes.Video)}
End If End If
End Using End Using
End If End If
@@ -323,10 +523,17 @@ Namespace API.Twitter
End Function End Function
#End Region #End Region
#Region "UrlFile" #Region "UrlFile"
Private Function UrlFile(ByVal URL As String) As String Private Function UrlFile(ByVal URL As String, Optional ByVal GetWithoutExtension As Boolean = False) As String
Try Try
Dim f As SFile = CStr(RegexReplace(LinkFormatterSecure(RegexReplace(URL.Replace("\", String.Empty), LinkPattern)), FilesPattern)) If Not URL.IsEmptyString Then
If Not f.IsEmptyString Then Return f.File Else Return String.Empty Dim f As SFile = CStr(RegexReplace(LinkFormatterSecure(RegexReplace(URL.Replace("\", String.Empty), LinkPattern)), FilesPattern))
If f.IsEmptyString And GetWithoutExtension Then
URL = LinkFormatterSecure(RegexReplace(URL.Replace("\", String.Empty), LinkPattern))
If Not URL.IsEmptyString Then f = New SFile With {.Name = URL.Split("/").LastOrDefault}
End If
If Not f.IsEmptyString Then Return f.File
End If
Return String.Empty
Catch ex As Exception Catch ex As Exception
Return String.Empty Return String.Empty
End Try End Try
@@ -335,9 +542,10 @@ Namespace API.Twitter
#Region "Create media" #Region "Create media"
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 = Nothing, Optional ByVal _PictureOption As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown) As UserMedia Optional ByVal State As UStates = UStates.Unknown,
Optional ByVal Type As UTypes = UTypes.Undefined) 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}, .Type = Type}
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))
If Not m.PictureOption.IsEmptyString And Not m.File.IsEmptyString And Not m.URL.IsEmptyString Then If Not m.PictureOption.IsEmptyString And Not m.File.IsEmptyString And Not m.URL.IsEmptyString Then
m.URL = $"{m.URL.Replace($".{m.File.Extension}", String.Empty)}?format={m.File.Extension}&name={m.PictureOption}" m.URL = $"{m.URL.Replace($".{m.File.Extension}", String.Empty)}?format={m.File.Extension}&name={m.PictureOption}"
@@ -355,17 +563,24 @@ Namespace API.Twitter
#Region "Exception" #Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then If AEquals(EObj, VALIDATE_MD5_ERROR) Then
UserExists = False If Not FromPE Then LogError(ex, Message)
ElseIf Responser.StatusCode = HttpStatusCode.Unauthorized Then
UserSuspended = True
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
MyMainLOG = "Twitter has invalid credentials"
ElseIf Responser.StatusCode = HttpStatusCode.ServiceUnavailable Then
MyMainLOG = $"Twitter is currently unavailable ({ToString()})"
Else
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0 Return 0
Else
With Responser
If .StatusCode = HttpStatusCode.NotFound Then
UserExists = False
ElseIf .StatusCode = HttpStatusCode.Unauthorized Then
UserSuspended = True
ElseIf .StatusCode = HttpStatusCode.BadRequest Then
MyMainLOG = "Twitter has invalid credentials"
ElseIf .StatusCode = HttpStatusCode.ServiceUnavailable Or .StatusCode = HttpStatusCode.InternalServerError Then
MyMainLOG = $"[{CInt(.StatusCode)}] Twitter is currently unavailable ({ToString()})"
Else
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0
End If
End With
End If End If
Return 1 Return 1
End Function End Function

View File

@@ -8,9 +8,10 @@
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Threading Imports System.Threading
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports PersonalUtilities.Tools Imports PersonalUtilities.Forms
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.Messaging Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Tools
Namespace API Namespace API
Friend Class UserDataBind : Inherits UserDataBase : Implements ICollection(Of IUserData), IMyEnumerator(Of IUserData) Friend Class UserDataBind : Inherits UserDataBase : Implements ICollection(Of IUserData), IMyEnumerator(Of IUserData)
#Region "Events" #Region "Events"
@@ -20,6 +21,17 @@ Namespace API
#Region "Declarations" #Region "Declarations"
Friend ReadOnly Property Collections As List(Of IUserData) Friend ReadOnly Property Collections As List(Of IUserData)
#Region "Base class overrides" #Region "Base class overrides"
Friend Overrides ReadOnly Property IsVirtual As Boolean
Get
Return CollectionModel = UsageModel.Virtual
End Get
End Property
Friend Overrides ReadOnly Property CollectionModel As UsageModel
Get
If Count > 0 Then Return Item(0).CollectionModel Else Return UsageModel.Default
End Get
End Property
Friend Property CurrentlyEdited As Boolean = False
Private _CollectionName As String = String.Empty Private _CollectionName As String = String.Empty
Friend Overrides Property CollectionName As String Friend Overrides Property CollectionName As String
Get Get
@@ -80,10 +92,13 @@ Namespace API
End Sub End Sub
Friend Overrides Function GetUserPicture() As Image Friend Overrides Function GetUserPicture() As Image
If Count > 0 Then If Count > 0 Then
Return Collections(0).GetPicture Dim img As Image
Else For Each u As UserDataBase In Collections
Return GetNullPicture(Settings.MaxLargeImageHeight) img = u.GetPicture(Of Image)(False)
If Not img Is Nothing Then Return img
Next
End If End If
Return GetNullPicture(If(Settings.ViewMode.Value = ViewModes.IconLarge, Settings.MaxLargeImageHeight, Settings.MaxSmallImageHeight))
End Function End Function
#End Region #End Region
Friend Overrides ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer Friend Overrides ReadOnly Property DownloadedTotal(Optional ByVal Total As Boolean = True) As Integer
@@ -102,7 +117,15 @@ Namespace API
End Property End Property
Friend Overrides Property MyFile As SFile Friend Overrides Property MyFile As SFile
Get Get
If Count > 0 Then Return Collections(0).File Else Return Nothing If Count > 0 Then
If IsVirtual Then
Return GetRealUserFile.IfNullOrEmpty(Collections(0).File)
Else
Return Collections(0).File
End If
Else
Return Nothing
End If
End Get End Get
Set(ByVal NewFile As SFile) Set(ByVal NewFile As SFile)
End Set End Set
@@ -120,8 +143,8 @@ Namespace API
End Property End Property
Friend Overrides Property DataMerging As Boolean Friend Overrides Property DataMerging As Boolean
Get Get
If Count > 0 Then If Count > 0 AndAlso Collections.Exists(RealUser) Then
Return DirectCast(Collections(0), UserDataBase).DataMerging Return DirectCast(Collections.Find(RealUser), UserDataBase).DataMerging
Else Else
Return False Return False
End If End If
@@ -184,6 +207,7 @@ Namespace API
End Property End Property
Friend Overrides Function GetUserInformation() As String Friend Overrides Function GetUserInformation() As String
Dim OutStr$ = String.Empty Dim OutStr$ = String.Empty
If IsVirtual Then OutStr = "This is a virtual collection."
If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c, UserDataBase).GetUserInformation(), vbNewLine.StringDup(2))) If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c, UserDataBase).GetUserInformation(), vbNewLine.StringDup(2)))
Return OutStr Return OutStr
End Function End Function
@@ -346,12 +370,36 @@ Namespace API
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))
End Sub End Sub
Private ReadOnly RealUser As Predicate(Of IUserData) = Function(u) u.UserModel = UsageModel.Default And Not u.HOST.Key = PathPlugin.PluginKey
Friend Overrides Sub OpenFolder() Friend Overrides Sub OpenFolder()
Try Try
If Count > 0 Then GlobalOpenPath(Collections(0).File.CutPath(2)) If Count > 0 Then
Dim i% = Collections.FindIndex(RealUser)
If i = -1 Then i = 0
If i >= 0 Then
If IsVirtual Or Collections(i).UserModel = UsageModel.Virtual Then
Collections(i).OpenFolder()
Else
GlobalOpenPath(Collections(i).File.CutPath(2))
End If
End If
End If
Catch Catch
End Try End Try
End Sub End Sub
Friend Function GetRealUserFile() As SFile
Dim i% = -1
If Count > 0 Then i = Collections.FindIndex(RealUser)
If i >= 0 Then Return Collections(i).File Else Return Nothing
End Function
Friend Function GetRealUserSpecialCollectionPath()
Dim _SpecialCollectionPath As SFile = Nothing
If Count > 0 And Not IsVirtual Then
Dim _RealUser As UserDataBase = Collections.Find(RealUser)
If Not _RealUser Is Nothing Then _SpecialCollectionPath = _RealUser.User.SpecialCollectionPath
End If
Return _SpecialCollectionPath
End Function
#End Region #End Region
#Region "ICollection Support" #Region "ICollection Support"
Private ReadOnly Property IsReadOnly As Boolean Implements ICollection(Of IUserData).IsReadOnly Private ReadOnly Property IsReadOnly As Boolean Implements ICollection(Of IUserData).IsReadOnly
@@ -386,8 +434,8 @@ Namespace API
''' <exception cref="InvalidOperationException"></exception> ''' <exception cref="InvalidOperationException"></exception>
Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add Friend Overloads Sub Add(ByVal _Item As IUserData) Implements ICollection(Of IUserData).Add
With _Item With _Item
If .MoveFiles(CollectionName) Then If .MoveFiles(CollectionName, GetRealUserSpecialCollectionPath()) Then
If DataMerging Then DirectCast(.Self, UserDataBase).MergeData() If Not _Item.IsVirtual And DataMerging Then DirectCast(.Self, UserDataBase).MergeData()
Collections.Add(_Item) Collections.Add(_Item)
With Collections.Last With Collections.Last
If Count > 1 Then If Count > 1 Then
@@ -445,14 +493,9 @@ Namespace API
Private Sub ConsolidateScripts() Private Sub ConsolidateScripts()
If Count > 1 AndAlso ScriptUse Then Collections.ForEach(Sub(c) c.ScriptUse = True) If Count > 1 AndAlso ScriptUse Then Collections.ForEach(Sub(c) c.ScriptUse = True)
End Sub End Sub
Friend Sub AddRange(ByVal _Items As IEnumerable(Of IUserData))
If _Items.ListExists Then
For i% = 0 To _Items.Count - 1 : Add(_Items(i)) : Next
End If
End Sub
#End Region #End Region
#Region "Move, Merge" #Region "Move, Merge"
Friend Overrides Function MoveFiles(ByVal __CollectionName As String) As Boolean Friend Overrides Function MoveFiles(ByVal __CollectionName As String, ByVal __SpecialCollectionPath As SFile) As Boolean
Throw New NotImplementedException("Move files is not available in the collection context") Throw New NotImplementedException("Move files is not available in the collection context")
End Function End Function
Friend Overloads Sub MergeData(ByVal Merging As Boolean) Friend Overloads Sub MergeData(ByVal Merging As Boolean)
@@ -488,52 +531,73 @@ Namespace API
"Operation canceled", MsgBoxStyle.Critical) "Operation canceled", MsgBoxStyle.Critical)
Return False Return False
Else Else
DirectCast(_Item, UserDataBase).MoveFiles(String.Empty) _Item.MoveFiles(String.Empty, Nothing)
MainFrameObj.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)
End If End If
End Function End Function
Friend Overrides Function Delete(Optional ByVal Multiple As Boolean = False) As Integer Friend Overrides Function Delete(Optional ByVal Multiple As Boolean = False, Optional ByVal CollectionValue As Integer = -1) As Integer
If Count > 0 Then If Count > 0 Then
Const MsgTitle$ = "Deleting a collection" Const MsgTitle$ = "Deleting a collection"
Dim f As SFile Dim f As SFile = Nothing
If Not IsVirtual Then
f = GetRealUserFile()
If Not f.IsEmptyString Then f = f.CutPath(IIf(DataMerging, 1, 2))
End If
Dim m As New MMessage($"Collection [{CollectionName} (number of profiles: {Count})] may contain data" & vbCr & Dim m As New MMessage($"Collection [{CollectionName} (number of profiles: {Count})] may contain data" & vbCr &
"Are you sure you want to delete the collection and all of its files?", MsgTitle, "Are you sure you want to delete the collection and all of its files?", MsgTitle,
{New MsgBoxButton("Delete") With {.ToolTip = "Delete the collection and all files"}, {New MsgBoxButton("Delete") With {.ToolTip = "Delete the collection and all files", .KeyCode = Keys.Enter},
New MsgBoxButton("Split") With { New MsgBoxButton("Split") With {
.ToolTip = "Users will be removed from the collection and will be displayed in the program as separate users." & vbCr & .ToolTip = "Users will be removed from the collection and will be displayed in the program as separate users." & vbCr &
"All user data will remain."}, "All user data will remain.",
.KeyCode = New ButtonKey(Keys.Enter, True)},
"Cancel"}, vbExclamation) "Cancel"}, vbExclamation)
Select Case If(Multiple, 0, MsgBoxE(m).Index) Dim v%
If CollectionValue >= 0 Then
Select Case CollectionValue
Case 2 : v = 0
Case 3 : v = 1
Case Else : v = MsgBoxE(m)
End Select
ElseIf Multiple Then
v = 0
Else
v = MsgBoxE(m)
End If
Select Case v
Case 0 Case 0
f = Collections(0).File.CutPath(IIf(DataMerging, 1, 2)).PathWithSeparator
Settings.Users.Remove(Me)
Collections.ForEach(Sub(c) c.Delete()) Collections.ForEach(Sub(c) c.Delete())
Downloader.UserRemove(Me) If Collections.All(Function(c As UserDataBase) c.Disposed) Then
MainFrameObj.ImageHandler(Me, False) Settings.Users.Remove(Me)
Collections.ListClearDispose Downloader.UserRemove(Me)
Dispose(False) MainFrameObj.ImageHandler(Me, False)
f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog) Collections.ListClearDispose
Return 2 Dispose(False)
If Not f.IsEmptyString Then f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog)
Return 2
End If
Case 1 Case 1
If DataMerging Then If DataMerging Then
MsgBoxE({$"Collection [{CollectionName}] data merged{vbCr}Unable to split merged collection{vbCr}Operation canceled", MsgTitle}, vbExclamation) MsgBoxE({$"Collection [{CollectionName}] data merged{vbCr}Unable to split merged collection{vbCr}Operation canceled", MsgTitle}, vbExclamation)
Return 0 Return 0
Else Else
f = Collections(0).File.CutPath(2) Collections.ForEach(Sub(ByVal c As IUserData)
Settings.Users.Remove(Me) If c.MoveFiles(String.Empty, Nothing) Then
Collections.ForEach(Sub(c) UserListLoader.UpdateUser(Settings.GetUser(c), True)
c.MoveFiles(String.Empty) MainFrameObj.ImageHandler(c)
MainFrameObj.ImageHandler(c) End If
End Sub) End Sub)
Collections.Clear() If Collections.All(Function(c) c.CollectionName.IsEmptyString) Then
f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog) Settings.Users.Remove(Me)
Downloader.UserRemove(Me) Collections.Clear()
MainFrameObj.ImageHandler(Me, False) If Not f.IsEmptyString Then f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog)
Dispose(False) Downloader.UserRemove(Me)
Return 3 MainFrameObj.ImageHandler(Me, False)
Dispose(False)
Return 3
End If
End If End If
Case Else : If Not Multiple Then MsgBoxE({"Operation canceled", MsgTitle}) Case Else : If Not Multiple Then MsgBoxE({"Operation canceled", MsgTitle})
End Select End Select
@@ -562,9 +626,11 @@ Namespace API
"Deleting a user"}, vbExclamation,,, "Deleting a user"}, vbExclamation,,,
{ {
New MsgBoxButton("Remove") With { New MsgBoxButton("Remove") With {
.ToolTip = "Remove a user from the collection only. All its data will remain. The user will appear in the program."}, .ToolTip = "Remove a user from the collection only. All its data will remain. The user will appear in the program.",
.KeyCode = Keys.Enter},
New MsgBoxButton("Delete") With { New MsgBoxButton("Delete") With {
.ToolTip = "Delete a user from the collection and erase their data."}, .ToolTip = "Delete a user from the collection and erase their data.",
.KeyCode = New ButtonKey(Keys.Enter, True)},
"Cancel" "Cancel"
}).Index }).Index
Case 0 Case 0

View File

@@ -6,14 +6,17 @@
' '
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.XVIDEOS Namespace API.XVIDEOS
Friend Module Declarations Friend Module Declarations
Friend Const XvideosSiteKey As String = "AndyProgram_XVIDEOS" Friend Const XvideosSiteKey As String = "AndyProgram_XVIDEOS"
Friend ReadOnly Property M3U8Regex As RParams = RParams.DM("http.+?.m3u8.*?(?=')", 0) Friend ReadOnly Regex_M3U8 As RParams = RParams.DM("http.+?.m3u8.*?(?=')", 0)
Friend ReadOnly Property VideoTitleRegex As RParams = RParams.DMS("html5player.setVideoTitle\('(.+)(?='\);)", 1) Friend ReadOnly Regex_VideoTitle As RParams = RParams.DMS("html5player.setVideoTitle\('(.+)(?='\);)", 1, EDP.ReturnValue, TitleHtmlConverter)
Friend ReadOnly Property VideoID As RParams = RParams.DMS(".*?www.xvideos.com/(video\d+).*", 1) Friend ReadOnly Regex_VideoID As RParams = RParams.DMS(".*?www.xvideos.com/(video\d+).*", 1)
Friend ReadOnly Property M3U8Reparse As RParams = RParams.DM("NAME=""(\d+).*?""[\r\n]*?(.+)(?=(|[\r\n]+?))", 0, RegexReturn.List) Friend ReadOnly Regex_M3U8_Reparse As RParams = RParams.DM("NAME=""(\d+).*?""[\r\n]*?(.+)(?=(|[\r\n]+?))", 0, RegexReturn.List)
Friend ReadOnly Property M3U8Appender As RParams = RParams.DM("(.+)(?=/.+?\.m3u8.*?)", 0) Friend ReadOnly Regex_M3U8_Appender As RParams = RParams.DM("(.+)(?=/.+?\.m3u8.*?)", 0)
Friend ReadOnly Regex_SavedVideosPlaylist As RParams = RParams.DM("<div id=""video.+?data-id=""(\d+).+?a href=""([^""]+)"".+?title=""([^""]*)""",
0, RegexReturn.List, EDP.ReturnValue, TitleHtmlConverter)
End Module End Module
End Namespace End Namespace

View File

@@ -7,44 +7,11 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Net Imports System.Net
Imports PersonalUtilities.Tools.WEB
Namespace API.XVIDEOS Namespace API.XVIDEOS
Friend NotInheritable Class M3U8 Friend NotInheritable Class M3U8
Private Sub New() Private Sub New()
End Sub End Sub
Private Shared Function Save(ByVal URLs As List(Of String), ByVal ffmpegFile As SFile, ByVal f As SFile) As SFile Friend Shared Function Download(ByVal URL As String, ByVal Appender As String, ByVal f As SFile) As SFile
Dim CachePath As SFile = Nothing
Try
If URLs.ListExists Then
Dim ConcatFile As SFile = f
If ConcatFile.Name.IsEmptyString Then ConcatFile.Name = "PlayListFile"
ConcatFile.Extension = "mp4"
CachePath = $"{f.PathWithSeparator}_Cache\{SFile.GetDirectories($"{f.PathWithSeparator}_Cache\",,, EDP.ReturnValue).ListIfNothing.Count + 1}\"
If CachePath.Exists(SFO.Path) Then
Dim p As New SFileNumbers(ConcatFile.Name,,, New ANumbers With {.Format = ANumbers.Formats.General})
ConcatFile = SFile.Indexed_IndexFile(ConcatFile,, p, EDP.ReturnValue)
Dim i%
Dim eFiles As New List(Of SFile)
Dim dFile As SFile = CachePath
dFile.Extension = "ts"
Using w As New WebClient
For i = 0 To URLs.Count - 1
dFile.Name = $"ConPart_{i}"
w.DownloadFile(URLs(i), dFile)
eFiles.Add(dFile)
Next
End Using
f = FFMPEG.ConcatenateFiles(eFiles, ffmpegFile, ConcatFile, p, EDP.ThrowException)
eFiles.Clear()
Return f
End If
End If
Return Nothing
Finally
CachePath.Delete(SFO.Path, SFODelete.None, EDP.None)
End Try
End Function
Friend Shared Function Download(ByVal URL As String, ByVal Appender As String, ByVal ffmpegFile As SFile, ByVal f As SFile) As SFile
Try Try
If Not URL.IsEmptyString Then If Not URL.IsEmptyString Then
Using w As New WebClient Using w As New WebClient
@@ -52,13 +19,13 @@ Namespace API.XVIDEOS
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim l As List(Of String) = ListAddList(Nothing, r.StringFormatLines.StringToList(Of String)(vbNewLine).ListWithRemove(Function(v) v.Trim.StartsWith("#")), Dim l As List(Of String) = ListAddList(Nothing, r.StringFormatLines.StringToList(Of String)(vbNewLine).ListWithRemove(Function(v) v.Trim.StartsWith("#")),
New ListAddParams With {.Converter = Function(Input) $"{Appender}/{Input.ToString.Trim}"}) New ListAddParams With {.Converter = Function(Input) $"{Appender}/{Input.ToString.Trim}"})
If l.ListExists Then Return Save(l, ffmpegFile, f) If l.ListExists Then Return Base.M3U8Base.Download(l, f)
End If End If
End Using End Using
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[M3U8.Download({URL}, {Appender}, {ffmpegFile}, {f})]") ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[M3U8.Download({URL}, {Appender}, {f})]")
Throw ex Throw ex
End Try End Try
End Function End Function

View File

@@ -1,80 +0,0 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.XVIDEOS
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class SettingsForm : 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
Me.LIST_DOMAINS = New System.Windows.Forms.ListBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.LIST_DOMAINS)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(384, 241)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(384, 291)
CONTAINER_MAIN.TabIndex = 0
'
'LIST_DOMAINS
'
Me.LIST_DOMAINS.Dock = System.Windows.Forms.DockStyle.Fill
Me.LIST_DOMAINS.FormattingEnabled = True
Me.LIST_DOMAINS.Location = New System.Drawing.Point(0, 0)
Me.LIST_DOMAINS.Name = "LIST_DOMAINS"
Me.LIST_DOMAINS.Size = New System.Drawing.Size(384, 241)
Me.LIST_DOMAINS.TabIndex = 0
'
'SettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(384, 291)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteResources.XvideosIcon_48
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(400, 330)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(400, 330)
Me.Name = "SettingsForm"
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Settings"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents LIST_DOMAINS As Windows.Forms.ListBox
End Class
End Namespace

View File

@@ -1,70 +0,0 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Namespace API.XVIDEOS
Friend Class SettingsForm
Private Const SettingsDesignXmlNode As String = "XvideosSettingsForm"
Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly Property Source As SiteSettings
Friend Sub New(ByRef s As SiteSettings)
InitializeComponent()
Source = s
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
Private Sub SettingsForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
If Not Settings.Design.Contains(SettingsDesignXmlNode) Then Settings.Design.Add(SettingsDesignXmlNode, String.Empty)
.MyViewInitialize(Me, Settings.Design(SettingsDesignXmlNode), True)
.AddEditToolbar()
.AddOkCancelToolbar()
If Source.Domains.Count > 0 Then Source.Domains.ForEach(Sub(d) LIST_DOMAINS.Items.Add(d))
.EndLoaderOperations()
End With
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
Source.Domains.Clear()
With LIST_DOMAINS
If .Items.Count > 0 Then
For Each i In .Items : Source.Domains.Add(i.ToString) : Next
End If
End With
Source.UpdateDomains()
MyDefs.CloseForm()
End Sub
Private Sub MyDefs_ButtonAddClick(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonAddClick
Dim nd$ = InputBoxE("Enter a new domain using the pattern [xvideos.com]:", "New domain")
If Not nd.IsEmptyString Then
If Not LIST_DOMAINS.Items.Contains(nd) Then
LIST_DOMAINS.Items.Add(nd)
Else
MsgBoxE($"The domain [{nd}] already added")
End If
End If
End Sub
Private Sub MyDefs_ButtonDeleteClickE(ByVal Sender As Object, ByVal e As EditToolbarEventArgs) Handles MyDefs.ButtonDeleteClickE
Const MsgTitle$ = "Removing domains"
If _LatestSelected.ValueBetween(0, LIST_DOMAINS.Items.Count - 1) Then
Dim n$ = LIST_DOMAINS.Items(_LatestSelected)
If MsgBoxE({$"Are you sure you want to delete the [{n}] domain?", MsgTitle}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
LIST_DOMAINS.Items.RemoveAt(_LatestSelected)
MsgBoxE({$"Domain [{n}] removed", MsgTitle})
Else
MsgBoxE({"Operation canceled", MsgTitle})
End If
Else
MsgBoxE({"No domain selected", MsgTitle}, vbExclamation)
End If
End Sub
Private _LatestSelected As Integer = -1
Private Sub LIST_DOMENS_SelectedIndexChanged(sender As Object, e As EventArgs) Handles LIST_DOMAINS.SelectedIndexChanged
_LatestSelected = LIST_DOMAINS.SelectedIndex
End Sub
End Class
End Namespace

View File

@@ -7,15 +7,16 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.API.BaseObjects
Imports SCrawler.Plugin Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.Web.Clients
Namespace API.XVIDEOS Namespace API.XVIDEOS
<Manifest(XvideosSiteKey), SpecialForm(True)> <Manifest(XvideosSiteKey), SavedPosts, SpecialForm(True), TaskGroup(SettingsCLS.TaskStackNamePornSite)>
Friend Class SiteSettings : Inherits SiteSettingsBase Friend Class SiteSettings : Inherits SiteSettingsBase : Implements IDomainContainer
#Region "Images" #Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon Friend Overrides ReadOnly Property Icon As Icon Implements IDomainContainer.Icon
Get Get
Return My.Resources.SiteResources.XvideosIcon_48 Return My.Resources.SiteResources.XvideosIcon_48
End Get End Get
@@ -25,58 +26,92 @@ Namespace API.XVIDEOS
Return My.Resources.SiteResources.XvideosPic_32 Return My.Resources.SiteResources.XvideosPic_32
End Get End Get
End Property End Property
#Region "Domains"
Private ReadOnly Property IDomainContainer_Site As String Implements IDomainContainer.Site
Get
Return Site
End Get
End Property
<PXML("Domains")> Private ReadOnly Property SiteDomains As PropertyValue Implements IDomainContainer.DomainsSettingProp
Friend ReadOnly Property Domains As List(Of String) Implements IDomainContainer.Domains
Private ReadOnly Property DomainsTemp As List(Of String) Implements IDomainContainer.DomainsTemp
Private Property DomainsChanged As Boolean = False Implements IDomainContainer.DomainsChanged
Private ReadOnly Property DomainsDefault As String = "xvideos.com|xnxx.com" Implements IDomainContainer.DomainsDefault
#End Region #End Region
#Region "Declarations"
<PXML("Domains")> Private Property SiteDomains As PropertyValue
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML> <PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML>
Public Property DownloadUHD As PropertyValue Friend Property DownloadUHD As PropertyValue
Friend ReadOnly Property Domains As List(Of String) Private Property Initialized As Boolean = False Implements IDomainContainer.Initialized
Private Const DomainsDefault As String = "xvideos.com|xnxx.com" <PropertyOption(ControlText:="Playlist of saved videos",
Private _Initialized As Boolean = False ControlToolTip:="Your personal videos playlist to download as 'saved posts'. " & vbCr &
"This playlist must be private (Visibility = 'Only me'). It also required cookies." & vbCr &
"This playlist must be entered by pattern: https://www.xvideos.com/favorite/01234567/playlistname.",
LeftOffset:=130), PXML>
Friend ReadOnly Property SavedVideosPlaylist As PropertyValue
#End Region #End Region
#Region "Initializer" #Region "Initializer"
Friend Sub New() Friend Sub New()
MyBase.New("XVIDEOS", "www.xvideos.com") MyBase.New("XVIDEOS", "www.xvideos.com")
Responser.DeclaredError = EDP.ThrowException
Domains = New List(Of String) Domains = New List(Of String)
DomainsTemp = New List(Of String)
SiteDomains = New PropertyValue(DomainsDefault, GetType(String), Sub(s) UpdateDomains()) SiteDomains = New PropertyValue(DomainsDefault, GetType(String), Sub(s) UpdateDomains())
DownloadUHD = New PropertyValue(False) DownloadUHD = New PropertyValue(False)
SavedVideosPlaylist = New PropertyValue(String.Empty, GetType(String))
UrlPatternUser = "https://xvideos.com/{0}"
End Sub End Sub
Friend Overrides Sub EndInit() Friend Overrides Sub EndInit()
_Initialized = True Initialized = True
UpdateDomains() DomainContainer.EndInit(Me)
DomainsTemp.ListAddList(Domains)
MyBase.EndInit()
End Sub End Sub
#End Region #End Region
#Region "Update" #Region "Edit"
Private _DomainsUpdateInProgress As Boolean = False Private Property DomainsUpdateInProgress As Boolean = False Implements IDomainContainer.DomainsUpdateInProgress
Friend Sub UpdateDomains() Private Property DomainsUpdatedBySite As Boolean = False Implements IDomainContainer.DomainsUpdatedBySite
If Not _Initialized Then Exit Sub Friend Sub UpdateDomains() Implements IDomainContainer.UpdateDomains
If Not _DomainsUpdateInProgress Then DomainContainer.UpdateDomains(Me)
_DomainsUpdateInProgress = True
If Not ACheck(SiteDomains.Value) Then SiteDomains.Value = DomainsDefault
Domains.ListAddList(CStr(SiteDomains.Value).Split("|"), LAP.NotContainsOnly, LAP.ClearBeforeAdd)
Domains.ListAddList(DomainsDefault.Split("|"), LAP.NotContainsOnly)
SiteDomains.Value = Domains.ListToString("|")
_DomainsUpdateInProgress = False
End If
End Sub End Sub
Friend Overrides Sub Update() Friend Overrides Sub Update()
UpdateDomains() DomainContainer.Update(Me)
Responser.SaveSettings() Responser.SaveSettings()
End Sub End Sub
Friend Overrides Sub EndEdit()
DomainContainer.EndEdit(Me)
MyBase.EndEdit()
End Sub
Friend Overrides Sub OpenSettingsForm()
DomainContainer.OpenSettingsForm(Me)
End Sub
#End Region #End Region
#Region "Download" #Region "Download"
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 = "XVIDEOS"}}
Else
Return New UserData
End If
End Function End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
Return Settings.UseM3U8 If Settings.UseM3U8 Then
If What = ISiteSettings.Download.SavedPosts Then
Return ACheck(SavedVideosPlaylist.Value) And Responser.CookiesExists
Else
Return True
End If
Else
Return False
End If
End Function End Function
#End Region #End Region
#Region "User: get, check" #Region "User: get, check"
Friend Overrides Function GetUserUrl(ByVal UserName As String, ByVal Channel As Boolean) As String Friend Function GetUserUrlPart(ByVal User As UserData) As String
Dim user$ = UserName.Split("_").FirstOrDefault Dim __user$ = User.Name.Split("_").FirstOrDefault
user &= $"/{UserName.Replace($"{user}_", String.Empty)}" __user &= $"/{User.Name.Replace($"{__user}_", String.Empty)}"
Return user Return __user
End Function
Friend Overrides Function GetUserUrl(ByVal User As IPluginContentProvider, ByVal Channel As Boolean) As String
Return String.Format(UrlPatternUser, GetUserUrlPart(User))
End Function End Function
Private Const UserRegexDefault As String = "/(profiles|[\w]*?[-]{0,1}channels)/([^/]+)(\Z|.*?)" Private Const UserRegexDefault As String = "/(profiles|[\w]*?[-]{0,1}channels)/([^/]+)(\Z|.*?)"
Private Const URD As String = ".*?{0}{1}" Private Const URD As String = ".*?{0}{1}"
@@ -84,9 +119,10 @@ Namespace API.XVIDEOS
If Not UserURL.IsEmptyString Then If Not UserURL.IsEmptyString Then
If Domains.Count > 0 Then If Domains.Count > 0 Then
Dim uName$, uOpt$, fStr$ Dim uName$, uOpt$, fStr$
Dim uErr As New ErrorsDescriber(EDP.ReturnValue)
For i% = 0 To Domains.Count - 1 For i% = 0 To Domains.Count - 1
fStr = String.Format(URD, Domains(i), UserRegexDefault) fStr = String.Format(URD, Domains(i), UserRegexDefault)
uName = RegexReplace(UserURL, RParams.DMS(fStr, 2)) uName = RegexReplace(UserURL, RParams.DMS(fStr, 2, uErr))
If Not uName.IsEmptyString Then If Not uName.IsEmptyString Then
uOpt = RegexReplace(UserURL, RParams.DMS(fStr, 1)) uOpt = RegexReplace(UserURL, RParams.DMS(fStr, 1))
If Not uOpt.IsEmptyString Then Return New ExchangeOptions(Site, $"{uOpt}_{uName}") If Not uOpt.IsEmptyString Then Return New ExchangeOptions(Site, $"{uOpt}_{uName}")
@@ -97,11 +133,6 @@ Namespace API.XVIDEOS
Return Nothing Return Nothing
End Function End Function
#End Region #End Region
#Region "Settings"
Friend Overrides Sub OpenSettingsForm()
Using f As New SettingsForm(Me) : f.ShowDialog() : End Using
End Sub
#End Region
#Region "Get special data" #Region "Get special data"
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
If Not URL.IsEmptyString And Domains.Count > 0 Then If Not URL.IsEmptyString And Domains.Count > 0 Then
@@ -115,7 +146,7 @@ Namespace API.XVIDEOS
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf) Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
f.Name = "video" f.Name = "video"
f.Extension = "mp4" f.Extension = "mp4"
Using resp As Response = Responser.Copy Using resp As Responser = Responser.Copy
Using user As New UserData With {.HOST = Settings(XvideosSiteKey)} Using user As New UserData With {.HOST = Settings(XvideosSiteKey)}
DirectCast(user, UserDataBase).User.File = f DirectCast(user, UserDataBase).User.File = f
Dim p As UserMedia = user.Download(URL, resp, DownloadUHD.Value, String.Empty) Dim p As UserMedia = user.Download(URL, resp, DownloadUHD.Value, String.Empty)

View File

@@ -10,12 +10,29 @@ Imports System.Threading
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.WebDocuments.JSON Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UStates = SCrawler.API.Base.UserMedia.States Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.XVIDEOS Namespace API.XVIDEOS
Friend Class UserData : Inherits UserDataBase Friend Class UserData : Inherits UserDataBase
Private Structure PlayListVideo : Implements IRegExCreator
Friend ID As String
Friend URL As String
Friend Title As String
Private Function CreateFromArray(ByVal ParamsArray() As String) As Object Implements IRegExCreator.CreateFromArray
If ParamsArray.ListExists(3) Then
ID = ParamsArray(0)
URL = ParamsArray(1)
If Not URL.IsEmptyString Then URL = $"https://www.xvideos.com/{URL.StringTrimStart("/")}"
Title = ParamsArray(2)
End If
Return Me
End Function
Friend Function ToUserMedia() As UserMedia
Return New UserMedia(URL, UTypes.VideoPre) With {.Object = Me, .PictureOption = Title, .Post = ID}
End Function
End Structure
Private ReadOnly Property MySettings As SiteSettings Private ReadOnly Property MySettings As SiteSettings
Get Get
Return DirectCast(HOST.Source, SiteSettings) Return DirectCast(HOST.Source, SiteSettings)
@@ -28,71 +45,81 @@ Namespace API.XVIDEOS
UseInternalM3U8Function = True UseInternalM3U8Function = True
End Sub End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken) Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If Not Settings.UseM3U8 Then MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found" : Exit Sub
If IsSavedPosts Then
If Not ACheck(MySettings.SavedVideosPlaylist.Value) Then Throw New ArgumentNullException("SavedVideosPlaylist", "Playlist of saved videos cannot be null")
DownloadSavedVideos(Token)
Else
DownloadUserVideo(Token)
End If
End Sub
Private Sub DownloadUserVideo(ByVal Token As CancellationToken)
Dim URL$ = String.Empty Dim URL$ = String.Empty
Try Try
If Not Settings.UseM3U8 Then Dim NextPage%, d%
If Not Settings.OS64 Then Dim limit% = If(DownloadTopCount, -1)
MyMainLOG = $"XVIDEOS [{ToStringForLog()}]: The plugin only works with x64 OS." Dim r$, n$
Else Dim j As EContainer = Nothing
MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found"
End If
Exit Sub
End If
Dim NextPage% = 0
Dim r$
Dim jj As EContainer Dim jj As EContainer
Dim e As ErrorsDescriber = EDP.ThrowException Dim user$ = MySettings.GetUserUrlPart(Me)
Dim user$ = MySettings.GetUserUrl(Name, False)
Dim p As UserMedia Dim p As UserMedia
Dim EnvirSet As Boolean = False Dim EnvirSet As Boolean = False
Do If ID.IsEmptyString Then GetUserID()
ThrowAny(Token) For i% = 0 To 1
URL = $"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}" If i = 1 And ID.IsEmptyString Then Exit For
r = Responser.GetResponse(URL,, e) NextPage = 0
If Not r.IsEmptyString Then d = 0
If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True n = IIf(i = 0, "u", "url")
With JsonDocument.Parse(r).XmlIfNothing Do
If .Contains("videos") Then ThrowAny(Token)
With .Item("videos") If i = 0 Then
If .Count > 0 Then URL = $"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}"
NextPage += 1 Else 'Quickies
For Each jj In .Self URL = $"https://www.xvideos.com/quickies-api/profilevideos/all/none/N/{ID}/{NextPage}"
p = New UserMedia With { End If
.Post = New UserPost With {.ID = jj.Value("id")}, r = Responser.GetResponse(URL,, EDP.ReturnValue)
.URL = $"https://www.xvideos.com{jj.Value("u")}" If Not r.IsEmptyString Then
} If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True
If Not p.Post.ID.IsEmptyString And Not jj.Value("u").IsEmptyString Then j = JsonDocument.Parse(r).XmlIfNothing
If Not _TempPostsList.Contains(p.Post.ID) Then With j
_TempPostsList.Add(p.Post.ID) If .Contains("videos") Then
_TempMediaList.Add(p) With .Item("videos")
Else If .Count > 0 Then
.Dispose() NextPage += 1
Exit Do For Each jj In .Self
p = New UserMedia With {
.Post = jj.Value("id"),
.URL = $"https://www.xvideos.com/{jj.Value(n).StringTrimStart("/")}"
}
If Not p.Post.ID.IsEmptyString And Not jj.Value(n).IsEmptyString Then
If Not _TempPostsList.Contains(p.Post.ID) Then
_TempPostsList.Add(p.Post.ID)
_TempMediaList.Add(p)
d += 1
If limit > 0 And d = limit Then Exit Do
Else
Exit Do
End If
End If End If
End If Next
Next Continue Do
Else End If
.Dispose() End With
Exit Do End If
End If End With
End With End If
Else If Not j Is Nothing Then j.Dispose()
.Dispose()
Exit Do
End If
.Dispose()
End With
Else
Exit Do Exit Do
End If Loop While NextPage < 100
Loop Next
If Not j Is Nothing Then j.Dispose()
If _TempMediaList.Count > 0 Then If _TempMediaList.Count > 0 Then
For i% = 0 To _TempMediaList.Count - 1 For i% = 0 To _TempMediaList.Count - 1
ThrowAny(Token) ThrowAny(Token)
With _TempMediaList(i) : _TempMediaList(i) = GetVideoData(.URL, Responser, MySettings.DownloadUHD.Value, .Post.ID) : End With _TempMediaList(i) = GetVideoData(_TempMediaList(i), Responser, MySettings.DownloadUHD.Value)
Next Next
_TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString) _TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End If End If
@@ -108,38 +135,84 @@ Namespace API.XVIDEOS
If _TempMediaList.ListExists Then _TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString) If _TempMediaList.ListExists Then _TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End Try End Try
End Sub End Sub
Private Function GetVideoData(ByVal URL As String, ByVal resp As Response, ByVal DownloadUHD As Boolean, ByVal ID As String) As UserMedia Private Sub GetUserID()
Dim r$ = Responser.GetResponse($"https://www.xvideos.com/{MySettings.GetUserUrlPart(Me)}",, EDP.ReturnValue)
If Not r.IsEmptyString Then ID = RegexReplace(r, RParams.DMS("""id_user"":(\d+)", 1, EDP.ReturnValue))
End Sub
Private Sub DownloadSavedVideos(ByVal Token As CancellationToken)
Dim URL$ = MySettings.SavedVideosPlaylist.Value
Try Try
If Not URL.IsEmptyString Then Dim NextPage% = 0
Dim r$ = resp.GetResponse(URL,, EDP.ThrowException) Dim __continue As Boolean = True
Dim r$
Dim data As List(Of PlayListVideo)
Dim i%
Do
ThrowAny(Token)
URL = $"{MySettings.SavedVideosPlaylist.Value}{If(NextPage = 0, String.Empty, $"/{NextPage}")}"
r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Responser.HasError Then
If Responser.StatusCode = Net.HttpStatusCode.NotFound And NextPage > 0 Then Exit Do
Throw New Exception(Responser.ErrorText, Responser.ErrorException)
End If
NextPage += 1
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim m$ = RegexReplace(r, M3U8Regex) data = RegexFields(Of PlayListVideo)(r, {Regex_SavedVideosPlaylist}, {1, 2, 3}, EDP.ReturnValue)
If Not m.IsEmptyString Then If data.ListExists Then
Dim appender$ = RegexReplace(m, M3U8Appender) If data.RemoveAll(Function(d) _TempPostsList.Contains(d.ID)) > 0 Then __continue = False
Dim t$ = RegexReplace(r, VideoTitleRegex) If data.ListExists Then
r = resp.GetResponse(m,, EDP.ThrowException) _TempPostsList.ListAddList(data.Select(Function(d) d.ID), LNC)
i = _TempMediaList.Count
_TempMediaList.ListAddList(data.Select(Function(d) d.ToUserMedia()), LNC)
If _TempMediaList.Count = i Or Not __continue Then Exit Do Else Continue Do
End If
End If
End If
Exit Do
Loop While NextPage < 100 And __continue
If _TempMediaList.Count > 0 Then
For i% = 0 To _TempMediaList.Count - 1
ThrowAny(Token)
_TempMediaList(i) = GetVideoData(_TempMediaList(i), Responser, MySettings.DownloadUHD.Value)
Next
_TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End If
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Private Function GetVideoData(ByVal Media As UserMedia, ByVal resp As Responser, ByVal DownloadUHD As Boolean) As UserMedia
Try
If Not Media.URL.IsEmptyString Then
Dim r$ = resp.GetResponse(Media.URL)
If Not r.IsEmptyString Then
Dim NewUrl$ = RegexReplace(r, Regex_M3U8)
If Not NewUrl.IsEmptyString Then
Dim appender$ = RegexReplace(NewUrl, Regex_M3U8_Appender)
Dim t$ = If(Media.PictureOption.IsEmptyString, RegexReplace(r, Regex_VideoTitle), Media.PictureOption)
r = resp.GetResponse(NewUrl)
If Not r.IsEmptyString Then If Not r.IsEmptyString Then
Dim ls As List(Of Sizes) = RegexFields(Of Sizes)(r, {M3U8Reparse}, {1, 2}) Dim ls As List(Of Sizes) = RegexFields(Of Sizes)(r, {Regex_M3U8_Reparse}, {1, 2})
If ls.ListExists And Not DownloadUHD Then ls.RemoveAll(Function(v) Not v.Value.ValueBetween(1, 1080)) If ls.ListExists And Not DownloadUHD Then ls.RemoveAll(Function(v) Not v.Value.ValueBetween(1, 1080))
If ls.ListExists Then If ls.ListExists Then
ls.Sort() ls.Sort()
m = $"{appender}/{ls(0).Data}" NewUrl = $"{appender}/{ls(0).Data.StringTrimStart("/")}"
ls.Clear() ls.Clear()
Dim pID$ = ID Dim pID$ = Media.Post.ID
If pID.IsEmptyString Then pID = RegexReplace(r, VideoID) If pID.IsEmptyString Then pID = RegexReplace(r, Regex_VideoID)
If pID.IsEmptyString Then pID = "0" If pID.IsEmptyString Then pID = "0"
If Not t.IsEmptyString Then t = t.StringRemoveWinForbiddenSymbols(" ") t = t.StringRemoveWinForbiddenSymbols.StringTrim
If t.IsEmptyString Then If t.IsEmptyString Then
t = pID t = pID
Else Else
If t.Length > 100 Then t = Left(t, 100) If t.Length > 100 Then t = Left(t, 100)
End If End If
If Not m.IsEmptyString Then If Not NewUrl.IsEmptyString Then
Return New UserMedia With { Return New UserMedia(NewUrl, UTypes.m3u8) With {
.Type = UTypes.m3u8, .Post = pID,
.Post = New UserPost With {.ID = pID}, .URL_BASE = Media.URL,
.URL = m,
.File = $"{t}.mp4", .File = $"{t}.mp4",
.PictureOption = appender .PictureOption = appender
} }
@@ -151,18 +224,18 @@ Namespace API.XVIDEOS
End If End If
Return Nothing Return Nothing
Catch ex As Exception Catch ex As Exception
LogError(ex, $"[XVIDEOS.UserData.GetVideoData({URL})]") LogError(ex, $"[XVIDEOS.UserData.GetVideoData({Media.URL})]")
Return Nothing Return Nothing
End Try End Try
End Function End Function
Friend Function Download(ByVal URL As String, ByVal resp As Response, ByVal DownloadUHD As Boolean, ByVal ID As String) Friend Function Download(ByVal URL As String, ByVal resp As Responser, ByVal DownloadUHD As Boolean, ByVal ID As String)
Dim m As UserMedia = GetVideoData(URL, resp, DownloadUHD, ID) Dim m As UserMedia = GetVideoData(New UserMedia(URL, UTypes.VideoPre) With {.Post = ID}, resp, DownloadUHD)
If Not m.URL.IsEmptyString Then If Not m.URL.IsEmptyString Then
Dim f As SFile = m.File Dim f As SFile = m.File
f.Path = MyFile.PathNoSeparator f.Path = MyFile.PathNoSeparator
m.State = UStates.Tried m.State = UStates.Tried
Try Try
f = M3U8.Download(m.URL, m.PictureOption, Settings.FfmpegFile, f) f = M3U8.Download(m.URL, m.PictureOption, f)
m.File = f m.File = f
m.State = UStates.Downloaded m.State = UStates.Downloaded
Catch ex As Exception Catch ex As Exception
@@ -175,7 +248,7 @@ Namespace API.XVIDEOS
DownloadContentDefault(Token) DownloadContentDefault(Token)
End Sub End Sub
Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile Protected Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
Return M3U8.Download(Media.URL, Media.PictureOption, Settings.FfmpegFile, DestinationFile) Return M3U8.Download(Media.URL, Media.PictureOption, DestinationFile)
End Function End Function
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer Optional ByVal EObj As Object = Nothing) As Integer

View File

@@ -0,0 +1,19 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
'Imports System.Globalization
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Xhamster
Friend Module Declarations
Friend Const XhamsterSiteKey As String = "AndyProgram_XHamster"
Friend ReadOnly HtmlScript As RParams = RParams.DMS("\<script id='initials-script'\>window.initials=(\{.+?\});\</script\>", 1, EDP.ReturnValue,
CType(Function(Input$) Input.StringTrim, Func(Of String, String)))
Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v))
Friend ReadOnly FirstM3U8FileRegEx As RParams = RParams.DM("RESOLUTION=\d+x(\d+).*?[\r\n]+?([^#]*?\.m3u8.*)", 0, RegexReturn.List)
End Module
End Namespace

View File

@@ -0,0 +1,79 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.API.Base.M3U8Declarations
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Namespace API.Xhamster
Friend NotInheritable Class M3U8
Private Sub New()
End Sub
Private Shared Function ParseFirstM3U8(ByVal URL As String, ByVal Responser As Responser, ByVal UHD As Boolean) As String
Dim r$, d$
Dim _DataObtained As Boolean = False
For i% = 0 To 1
Try
Responser.UseGZipStream = i
r = Responser.GetResponse(URL.Replace("\", String.Empty))
If Not r.IsEmptyString Then
r = r.StringFormatLines
Dim sList As List(Of Sizes) = RegexFields(Of Sizes)(r, {FirstM3U8FileRegEx}, {1, 2})
If sList.ListExists Then _DataObtained = True : sList.RemoveAll(Function(sv) sv.HasError Or sv.Data.IsEmptyString Or
sv.Value = 0 Or (Not UHD And sv.Value > 1080))
If sList.ListExists Then
sList.Sort()
d = sList.First.Data.Trim
If Not d.IsEmptyString Then Return d
End If
End If
Catch
End Try
If _DataObtained Then Exit For
Next
Return String.Empty
End Function
Private Shared Function ParseSecondM3U8(ByVal URL As String, ByVal Responser As Responser, ByVal Appender As String) As List(Of String)
Dim r$
Dim l As List(Of String)
For i% = 0 To 1
Try
Responser.UseGZipStream = i
r = Responser.GetResponse(URL)
If Not r.IsEmptyString Then
l = RegexReplace(r, TsFilesRegEx)
If l.ListExists Then
For indx% = 0 To l.Count - 1 : l(indx) = M3U8Base.CreateUrl(Appender, l(indx)) : Next
Return l
End If
End If
Catch
End Try
Next
Return Nothing
End Function
Private Shared Function ObtainUrls(ByVal URL As String, ByVal Responser As Responser, ByVal UHD As Boolean) As List(Of String)
Try
Dim file$ = ParseFirstM3U8(URL, Responser, UHD)
If Not file.IsEmptyString Then
Responser.UseGZipStream = False
Dim appender$ = URL.Replace(URL.Split("/").LastOrDefault, String.Empty)
URL = M3U8Base.CreateUrl(appender, file)
Dim l As List(Of String) = ParseSecondM3U8(URL, Responser, appender)
If l.ListExists Then Return l
End If
Return Nothing
Finally
Responser.UseGZipStream = False
End Try
End Function
Friend Shared Function Download(ByVal Media As UserMedia, ByVal Responser As Responser, ByVal UHD As Boolean) As SFile
Return M3U8Base.Download(ObtainUrls(Media.URL, Responser, UHD), Media.File, Responser)
End Function
End Class
End Namespace

View File

@@ -0,0 +1,150 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports SCrawler.API.Base
Imports SCrawler.API.BaseObjects
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Namespace API.Xhamster
<Manifest(XhamsterSiteKey), SavedPosts, SpecialForm(True), TaskGroup(SettingsCLS.TaskStackNamePornSite)>
Friend Class SiteSettings : Inherits SiteSettingsBase : Implements IDomainContainer
#Region "Declarations"
Friend Overrides ReadOnly Property Icon As Icon Implements IDomainContainer.Icon
Get
Return My.Resources.SiteResources.XhamsterIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.XhamsterPic_32
End Get
End Property
#Region "Domains"
Private ReadOnly Property IDomainContainer_Site As String Implements IDomainContainer.Site
Get
Return Site
End Get
End Property
<PXML("Domains")> Private ReadOnly Property SiteDomains As PropertyValue Implements IDomainContainer.DomainsSettingProp
Friend ReadOnly Property Domains As List(Of String) Implements IDomainContainer.Domains
Private ReadOnly Property DomainsTemp As List(Of String) Implements IDomainContainer.DomainsTemp
Private Property DomainsChanged As Boolean = False Implements IDomainContainer.DomainsChanged
Friend ReadOnly Property DomainsUpdated As Boolean
Get
Return DomainsUpdatedBySite
End Get
End Property
Private ReadOnly Property DomainsDefault As String = "xhamster.com" Implements IDomainContainer.DomainsDefault
#End Region
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML>
Friend Property DownloadUHD As PropertyValue
Private Property Initialized As Boolean = False Implements IDomainContainer.Initialized
#End Region
#Region "Initializer"
Friend Sub New()
MyBase.New("XHamster", "xhamster.com")
Responser.DeclaredError = EDP.ThrowException
Domains = New List(Of String)
DomainsTemp = New List(Of String)
SiteDomains = New PropertyValue(DomainsDefault, GetType(String), Sub(s) UpdateDomains())
DownloadUHD = New PropertyValue(False)
UrlPatternUser = "https://xhamster.com/users/{0}"
UrlPatternChannel = "https://xhamster.com/channels/{0}"
UserRegex = RParams.DMS($"/({UserOption}|{ChannelOption})/([^/]+)(\Z|.*)", 0, RegexReturn.ListByMatch)
ImageVideoContains = "xhamster"
End Sub
Friend Overrides Sub EndInit()
Initialized = True
DomainContainer.EndInit(Me)
DomainsTemp.ListAddList(Domains)
MyBase.EndInit()
End Sub
#End Region
#Region "UpdateDomains"
Private Property DomainsUpdateInProgress As Boolean = False Implements IDomainContainer.DomainsUpdateInProgress
Private Property DomainsUpdatedBySite As Boolean = False Implements IDomainContainer.DomainsUpdatedBySite
Friend Overloads Sub UpdateDomains() Implements IDomainContainer.UpdateDomains
DomainContainer.UpdateDomains(Me)
End Sub
Friend Overloads Sub UpdateDomains(ByVal NewDomains As IEnumerable(Of String), ByVal Internal As Boolean)
DomainContainer.UpdateDomains(Me, NewDomains, Internal)
End Sub
#End Region
#Region "Edit"
Friend Overrides Sub Update()
DomainContainer.Update(Me)
Responser.SaveSettings()
MyBase.Update()
End Sub
Friend Overrides Sub EndEdit()
DomainContainer.EndEdit(Me)
MyBase.EndEdit()
End Sub
Friend Overrides Sub OpenSettingsForm()
DomainContainer.OpenSettingsForm(Me)
End Sub
#End Region
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
If What = ISiteSettings.Download.SavedPosts Then
Return New UserData With {.IsSavedPosts = True, .User = New UserInfo With {.Name = "xhamster"}}
Else
Return New UserData
End If
End Function
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
If Available(ISiteSettings.Download.Main, True) Then
Using resp As Responser = Responser.Copy
Dim spf$ = String.Empty
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
Dim m As UserMedia = UserData.GetVideoInfo(URL, resp, f)
If m.State = UserMedia.States.Downloaded Then
m.SpecialFolder = f
Return {m}
End If
End Using
End If
Return Nothing
End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
If Settings.UseM3U8 AndAlso MyBase.Available(What, Silent) Then
If What = ISiteSettings.Download.SavedPosts Then
Return Responser.CookiesExists
Else
Return True
End If
Else
Return False
End If
End Function
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Return Media.URL_BASE
End Function
#Region "Is my user/data"
Private Const ChannelOption As String = "channels"
Private Const UserOption As String = "users"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
If Not UserURL.IsEmptyString AndAlso Domains.Count > 0 AndAlso Domains.Exists(Function(d) UserURL.ToLower.Contains(d.ToLower)) Then
Dim data As List(Of String) = RegexReplace(UserURL, UserRegex)
If data.ListExists(3) AndAlso Not data(2).IsEmptyString Then Return New ExchangeOptions(Site, data(2), data(1) = ChannelOption)
End If
Return Nothing
End Function
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
If Not URL.IsEmptyString And Domains.Count > 0 Then
If Domains.Exists(Function(d) URL.Contains(d)) Then Return New ExchangeOptions With {.UserName = URL, .Exists = True}
End If
Return Nothing
End Function
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,349 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Xhamster
Friend Class UserData : Inherits UserDataBase
#Region "Declarations"
Private ReadOnly Property MySettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
Private Structure ExchObj
Friend IsPhoto As Boolean
End Structure
Private ReadOnly _TempPhotoData As List(Of UserMedia)
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
#Region "Initializer"
Friend Sub New()
UseInternalM3U8Function = True
_TempPhotoData = New List(Of UserMedia)
End Sub
#End Region
#Region "Download base functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TempPhotoData.Clear()
If DownloadVideos Then DownloadData(1, True, Token)
If Not IsChannel And DownloadImages Then
DownloadData(1, False, Token)
ReparsePhoto(Token)
End If
End Sub
Private Overloads Sub DownloadData(ByVal Page As Integer, ByVal IsVideo As Boolean, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
Dim MaxPage% = -1
Dim Type As UTypes = IIf(IsVideo, UTypes.VideoPre, UTypes.Picture)
Dim mPages$ = IIf(IsVideo, "maxVideoPages", "maxPhotoPages")
Dim listNode$()
Dim skipped As Boolean = False
Dim cBefore% = _TempMediaList.Count
Dim m As UserMedia
If IsSavedPosts Then
URL = $"https://xhamster.com/my/favorites/{IIf(IsVideo, "videos", "photos-and-galleries")}{IIf(Page = 1, String.Empty, $"/{Page}")}"
listNode = If(IsVideo, {"favoriteVideoListComponent", "models"}, {"favoritesGalleriesAndPhotosCollection"})
ElseIf IsChannel Then
URL = $"https://xhamster.com/channels/{Name}/newest{IIf(Page = 1, String.Empty, $"/{Page}")}"
listNode = {"trendingVideoListComponent", "models"}
Else
URL = $"https://xhamster.com/users/{Name}/{IIf(IsVideo, "videos", "photos")}{IIf(Page = 1, String.Empty, $"/{Page}")}"
listNode = {If(IsVideo, "userVideoCollection", "userGalleriesCollection")}
End If
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then r = RegexReplace(r, HtmlScript)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Count > 0 Then
If Not MySettings.DomainsUpdated AndAlso j.Contains("trustURLs") Then _
MySettings.UpdateDomains(j("trustURLs").Select(Function(d) d(0).XmlIfNothingValue), False)
MaxPage = j.Value(mPages).FromXML(Of Integer)(-1)
With j(listNode)
If .ListExists Then
For Each e As EContainer In .Self
m = ExtractMedia(e, Type)
If Not m.URL.IsEmptyString Then
If m.File.IsEmptyString Then Continue For
If m.Post.Date.HasValue Then
Select Case CheckDatesLimit(m.Post.Date.Value, Nothing)
Case DateResult.Skip : skipped = True : Continue For
Case DateResult.Exit : Exit Sub
End Select
End If
If IsVideo AndAlso Not _TempPostsList.Contains(m.Post.ID) Then
_TempPostsList.Add(m.Post.ID)
_TempMediaList.ListAddValue(m, LNC)
ElseIf Not IsVideo Then
If DirectCast(m.Object, ExchObj).IsPhoto Then
If Not m.Post.ID.IsEmptyString AndAlso Not _TempPostsList.Contains(m.Post.ID) Then
_TempPostsList.Add(m.Post.ID)
_TempMediaList.ListAddValue(m, LNC)
End If
Else
_TempPhotoData.ListAddValue(m, LNC)
End If
Else
Exit Sub
End If
End If
Next
End If
End With
End If
End Using
End If
If (Not _TempMediaList.Count = cBefore Or skipped) And (IsChannel Or (MaxPage > 0 And Page < MaxPage)) Then DownloadData(Page + 1, IsVideo, Token)
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
#End Region
#Region "Reparse video, photo"
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(tm) tm.Type = UTypes.VideoPre) Then
Dim m As UserMedia, m2 As UserMedia
For i% = _TempMediaList.Count - 1 To 0 Step -1
If _TempMediaList(i).Type = UTypes.VideoPre Then
m = _TempMediaList(i)
If Not m.URL_BASE.IsEmptyString Then
m2 = Nothing
If GetM3U8(m2, m.URL_BASE, Responser) Then
m2.URL_BASE = m.URL_BASE
_TempMediaList(i) = m2
Else
m.State = UserMedia.States.Missing
_TempMediaList(i) = m
End If
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, "video reparsing error", False)
End Try
End Sub
Private Overloads Sub ReparsePhoto(ByVal Token As CancellationToken)
If _TempPhotoData.Count > 0 Then
For i% = 0 To _TempPhotoData.Count - 1 : ReparsePhoto(i, 1, Token) : Next
_TempPhotoData.Clear()
End If
End Sub
Private Overloads Sub ReparsePhoto(ByVal Index As Integer, ByVal Page As Integer, ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
Dim MaxPage% = -1
Dim m As UserMedia
Dim sm As UserMedia = _TempPhotoData(Index)
URL = $"{sm.URL}{IIf(Page = 1, String.Empty, $"/{Page}")}"
ThrowAny(Token)
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then r = RegexReplace(r, HtmlScript)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
If j.Count > 0 Then
MaxPage = j.Value({"pagination"}, "maxPage").FromXML(Of Integer)(-1)
With j({"photosGalleryModel"}, "photos")
If .ListExists Then
For Each e In .Self
m = ExtractMedia(e, UTypes.Picture, "imageURL", False, sm.Post.Date)
m.URL_BASE = sm.URL
If Not m.URL.IsEmptyString Then
m.Post.ID = $"{sm.Post.ID}_{m.Post.ID}"
m.SpecialFolder = sm.SpecialFolder
If Not _TempPostsList.Contains(m.Post.ID) Then
_TempPostsList.Add(m.Post.ID)
_TempMediaList.ListAddValue(m, LNC)
Else
Exit Sub
End If
End If
Next
End If
End With
End If
End Using
End If
If MaxPage > 0 AndAlso Page < MaxPage Then ReparsePhoto(Index, Page + 1, Token)
Catch ex As Exception
ProcessException(ex, Token, "photo reparsing error", False)
End Try
End Sub
#End Region
#Region "Reparse missing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
If ContentMissingExists Then
Dim m As UserMedia, m2 As UserMedia
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
If m.State = UserMedia.States.Missing AndAlso Not m.URL_BASE.IsEmptyString Then
ThrowAny(Token)
m2 = Nothing
If GetM3U8(m2, m.URL_BASE, Responser) Then
m2.URL_BASE = m.URL_BASE
_TempMediaList.ListAddValue(m2, LNC)
rList.Add(i)
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
#End Region
#Region "GetM3U8"
Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal URL As String, ByVal Responser As Responser,
Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Try
If Not URL.IsEmptyString Then
Dim r$ = Responser.GetResponse(URL)
If Not r.IsEmptyString Then r = RegexReplace(r, HtmlScript)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
m = ExtractMedia(j("videoModel"), UTypes.VideoPre)
m.URL_BASE = URL
Return GetM3U8(m, j)
End If
End Using
End If
End If
Return False
Catch ex As Exception
If Not e.Exists Then e = EDP.ReturnValue
Return ErrorsDescriber.Execute(e, ex, $"[{ToStringForLog()}]: API.Xhamster.GetM3U8({URL})", False)
End Try
End Function
Private Overloads Function GetM3U8(ByRef m As UserMedia, ByVal j As EContainer) As Boolean
Dim url$ = j.Value({"xplayerSettings", "sources", "hls"}, "url")
If Not url.IsEmptyString Then m.URL = url : m.Type = UTypes.m3u8 : Return True
Return False
End Function
#End Region
#Region "Standalone downloader"
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal Responser As Responser, ByVal Path As SFile) As UserMedia
Try
Using u As New UserData With {.Responser = Responser, .HOST = Settings(XhamsterSiteKey)}
Dim m As UserMedia = Nothing
If u.GetM3U8(m, URL, Responser, EDP.ThrowException) Then
m.File.Path = Path.Path
Dim f As SFile = u.DownloadM3U8(m.URL, m, m.File)
If Not f.IsEmptyString Then
m.File = f
m.State = UserMedia.States.Downloaded
Return m
End If
End If
End Using
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, $"XHamster standalone download error: [{URL}]", New UserMedia)
End Try
End Function
#End Region
#Region "Download data"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
Protected Overloads Overrides Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
Media.File = DestinationFile
Return M3U8.Download(Media, Responser, MySettings.DownloadUHD.Value)
End Function
#End Region
#Region "Create media"
Private Shared Function ExtractMedia(ByVal j As EContainer, ByVal t As UTypes, Optional ByVal UrlNode As String = "pageURL",
Optional ByVal DetectGalery As Boolean = True, Optional ByVal PostDate As Date? = Nothing) As UserMedia
If Not j Is Nothing Then
Dim m As New UserMedia(j.Value(UrlNode).Replace("\", String.Empty), t) With {
.Post = New UserPost With {
.ID = j.Value("id"),
.Date = AConvert(Of Date)(j.Value("created"), DateProvider, Nothing)
},
.PictureOption = TitleHtmlConverter(j.Value("title")),
.Object = New ExchObj
}
If PostDate.HasValue Then m.Post.Date = PostDate
Dim setSpecialFolder As Boolean = False
Dim processFile As Boolean = True
Dim ext$ = "mp4"
If t = UTypes.Picture Then
ext = "jpg"
If (Not DetectGalery OrElse j.Contains("galleryId")) AndAlso Not j.Value("imageURL").IsEmptyString Then
m.Object = New ExchObj With {.IsPhoto = True}
m.URL = j.Value("imageURL")
m.URL_BASE = m.URL
If DetectGalery Then m.Post.ID = $"{j.Value("galleryId")}_{m.Post.ID}"
m.File = m.URL
m.File.Separator = "\"
processFile = m.File.File.IsEmptyString
Else
setSpecialFolder = True
End If
End If
If Not m.URL.IsEmptyString Then
If m.Post.ID.IsEmptyString Then m.Post.ID = m.URL.Split("/").LastOrDefault
If m.PictureOption.IsEmptyString Then m.PictureOption = TitleHtmlConverter(j.Value("titleLocalized"))
If m.PictureOption.IsEmptyString Then m.PictureOption = m.Post.ID
If setSpecialFolder Then m.SpecialFolder = m.PictureOption
If processFile Then
If Not m.PictureOption.IsEmptyString Then
m.File = $"{m.PictureOption}.{ext}"
ElseIf Not m.Post.ID.IsEmptyString Then
m.File = $"{m.Post.ID}.{ext}"
End If
End If
m.File.Separator = "\"
End If
Return m
Else
Return Nothing
End If
End Function
#End Region
#Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
Return If(Responser.Status = Net.WebExceptionStatus.ConnectionClosed, 1, 0)
End Function
#End Region
#Region "IDisposable support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _TempPhotoData.Clear()
MyBase.Dispose(disposing)
End Sub
#End Region
End Class
End Namespace

View File

@@ -140,24 +140,28 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
' '
'BTT_C_OPEN_USER 'BTT_C_OPEN_USER
' '
Me.BTT_C_OPEN_USER.Image = Global.SCrawler.My.Resources.Resources.GlobePic_32
Me.BTT_C_OPEN_USER.Name = "BTT_C_OPEN_USER" Me.BTT_C_OPEN_USER.Name = "BTT_C_OPEN_USER"
Me.BTT_C_OPEN_USER.Size = New System.Drawing.Size(305, 22) Me.BTT_C_OPEN_USER.Size = New System.Drawing.Size(305, 22)
Me.BTT_C_OPEN_USER.Text = "Open user" Me.BTT_C_OPEN_USER.Text = "Open user"
' '
'BTT_C_OPEN_POST 'BTT_C_OPEN_POST
' '
Me.BTT_C_OPEN_POST.Image = Global.SCrawler.My.Resources.Resources.GlobePic_32
Me.BTT_C_OPEN_POST.Name = "BTT_C_OPEN_POST" Me.BTT_C_OPEN_POST.Name = "BTT_C_OPEN_POST"
Me.BTT_C_OPEN_POST.Size = New System.Drawing.Size(305, 22) Me.BTT_C_OPEN_POST.Size = New System.Drawing.Size(305, 22)
Me.BTT_C_OPEN_POST.Text = "Open post" Me.BTT_C_OPEN_POST.Text = "Open post"
' '
'BTT_C_OPEN_PICTURE 'BTT_C_OPEN_PICTURE
' '
Me.BTT_C_OPEN_PICTURE.Image = Global.SCrawler.My.Resources.Resources.PicturePic_32
Me.BTT_C_OPEN_PICTURE.Name = "BTT_C_OPEN_PICTURE" Me.BTT_C_OPEN_PICTURE.Name = "BTT_C_OPEN_PICTURE"
Me.BTT_C_OPEN_PICTURE.Size = New System.Drawing.Size(305, 22) Me.BTT_C_OPEN_PICTURE.Size = New System.Drawing.Size(305, 22)
Me.BTT_C_OPEN_PICTURE.Text = "Open picture" Me.BTT_C_OPEN_PICTURE.Text = "Open picture"
' '
'BTT_C_OPEN_FOLDER 'BTT_C_OPEN_FOLDER
' '
Me.BTT_C_OPEN_FOLDER.Image = Global.SCrawler.My.Resources.Resources.FolderPic_32
Me.BTT_C_OPEN_FOLDER.Name = "BTT_C_OPEN_FOLDER" Me.BTT_C_OPEN_FOLDER.Name = "BTT_C_OPEN_FOLDER"
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"
@@ -165,6 +169,7 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
'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
Me.BTT_C_REMOVE_FROM_SELECTED.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_C_REMOVE_FROM_SELECTED.Name = "BTT_C_REMOVE_FROM_SELECTED" Me.BTT_C_REMOVE_FROM_SELECTED.Name = "BTT_C_REMOVE_FROM_SELECTED"
Me.BTT_C_REMOVE_FROM_SELECTED.Size = New System.Drawing.Size(305, 22) Me.BTT_C_REMOVE_FROM_SELECTED.Size = New System.Drawing.Size(305, 22)
Me.BTT_C_REMOVE_FROM_SELECTED.Text = "Remove user from selected" Me.BTT_C_REMOVE_FROM_SELECTED.Text = "Remove user from selected"
@@ -172,6 +177,7 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
' '
'BTT_C_ADD_TO_BLACKLIST 'BTT_C_ADD_TO_BLACKLIST
' '
Me.BTT_C_ADD_TO_BLACKLIST.Image = Global.SCrawler.My.Resources.Resources.DBPic_32
Me.BTT_C_ADD_TO_BLACKLIST.Name = "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.Size = New System.Drawing.Size(305, 22)
Me.BTT_C_ADD_TO_BLACKLIST.Text = "Add/Remove this user to/from the BlackList" Me.BTT_C_ADD_TO_BLACKLIST.Text = "Add/Remove this user to/from the BlackList"

View File

@@ -211,8 +211,8 @@ 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})
AddHandler Settings.ChannelsImagesColumns.OnValueChanged, AddressOf ImagesCountChanged AddHandler Settings.ChannelsImagesColumns.ValueChanged, AddressOf ImagesCountChanged
AddHandler Settings.ChannelsImagesRows.OnValueChanged, AddressOf ImagesCountChanged AddHandler Settings.ChannelsImagesRows.ValueChanged, AddressOf ImagesCountChanged
End Sub End Sub
#End Region #End Region
#Region "Form handlers" #Region "Form handlers"
@@ -398,7 +398,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End With End With
Return s Return s
End Function End Function
Private Sub ImagesCountChanged(ByVal Sender As Object, ByVal _Name As String, ByVal _Value As Object) Private Sub ImagesCountChanged(ByVal Sender As Object, ByVal e As EventArgs)
AppendPendingUsers() AppendPendingUsers()
MyRange.Limit = ImagesInRow * ImagesRows MyRange.Limit = ImagesInRow * ImagesRows
MyRange.GoTo(0) MyRange.GoTo(0)
@@ -581,7 +581,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End If 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 Sender As Object, ByVal e As EventArgs, 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.Source = c If Not c Is Nothing Then MyRange.Source = c
@@ -814,6 +814,14 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End Sub End Sub
#End Region #End Region
#Region "MyRange" #Region "MyRange"
Private ReadOnly GetListImage_Error As New ErrorsDescriber(EDP.ReturnValue)
Private Function GetListImage(ByVal Post As UserPost, ByVal s As Size, ByVal NullArg As Image) As Image
If Not Post.CachedFile.IsEmptyString Then
Return If(ImageRenderer.GetImage(SFile.GetBytes(Post.CachedFile), s, GetListImage_Error), NullArg.Clone)
Else
Return NullArg.Clone
End If
End Function
Private Sub MyRange_IndexChanged(ByVal Sender As Object, ByVal e As EventArgs) 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
@@ -825,11 +833,10 @@ Friend Class ChannelViewForm : Implements IChannelLimits
If .Count > 0 Then If .Count > 0 Then
Dim s As Size = GetImageSize() Dim s As Size = GetImageSize()
Dim NullImage As Image = New Bitmap(s.Width, s.Height) Dim NullImage As Image = New Bitmap(s.Width, s.Height)
Dim ie As New ErrorsDescriber(EDP.ReturnValue)
For i% = 0 To .Count - 1 For i% = 0 To .Count - 1
p = .Item(i) p = .Item(i)
With p With p
LIST_POSTS.LargeImageList.Images.Add(.GetImage(s, ie, NullImage)) LIST_POSTS.LargeImageList.Images.Add(GetListImage(p, s, NullImage))
LIST_POSTS.Items.Add(New ListViewItem(.UserID, i) With {.Tag = p.ID}) LIST_POSTS.Items.Add(New ListViewItem(.UserID, i) With {.Tag = p.ID})
With LIST_POSTS.Items(LIST_POSTS.Items.Count - 1) With LIST_POSTS.Items(LIST_POSTS.Items.Count - 1)
If PendingUsers.Contains(.Text) Then .Checked = True If PendingUsers.Contains(.Text) Then .Checked = True

View File

@@ -20,6 +20,7 @@ Friend Class ChannelsStatsForm
.MyViewInitialize() .MyViewInitialize()
.AddOkCancelToolbar() .AddOkCancelToolbar()
If Settings.Channels.Count > 0 Then RefillList() Else MsgBoxE("Channels not found", vbExclamation) If Settings.Channels.Count > 0 Then RefillList() Else MsgBoxE("Channels not found", vbExclamation)
.DelegateClosingChecker = False
.EndLoaderOperations() .EndLoaderOperations()
End With End With
End Sub End Sub

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 15 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 764 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.1 KiB

View File

@@ -22,7 +22,6 @@ Namespace DownloadObjects
Private components As System.ComponentModel.IContainer Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()> <System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent() Private Sub InitializeComponent()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(ActiveDownloadingProgress))
Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel() Me.TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
Me.SuspendLayout() Me.SuspendLayout()
' '
@@ -36,8 +35,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, 64.0!)) Me.TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 66.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, 66.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
' '
@@ -47,12 +46,13 @@ Namespace DownloadObjects
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(434, 61) Me.ClientSize = New System.Drawing.Size(434, 61)
Me.Controls.Add(Me.TP_MAIN) Me.Controls.Add(Me.TP_MAIN)
Me.Icon = Global.SCrawler.My.Resources.ArrowDownIcon_Blue_24 Me.Icon = Global.SCrawler.My.Resources.Resources.ArrowDownIcon_Blue_24
Me.KeyPreview = True Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(450, 100) Me.MinimumSize = New System.Drawing.Size(450, 100)
Me.Name = "ActiveDownloadingProgress" Me.Name = "ActiveDownloadingProgress"
Me.Text = "Active downloading progress" Me.Text = "Active downloading progress"
Me.ResumeLayout(False) Me.ResumeLayout(False)
End Sub End Sub
Private WithEvents TP_MAIN As TableLayoutPanel Private WithEvents TP_MAIN As TableLayoutPanel
End Class End Class

View File

@@ -42,6 +42,7 @@ Namespace DownloadObjects
End Sub End Sub
Private Sub Downloader_Reconfigured() Private Sub Downloader_Reconfigured()
Const RowHeight% = 30 Const RowHeight% = 30
Const LowestValue% = 39
Dim a As Action = Sub() Dim a As Action = Sub()
With TP_MAIN With TP_MAIN
If .Controls.Count > 0 Then If .Controls.Count > 0 Then
@@ -65,13 +66,18 @@ Namespace DownloadObjects
.Controls.Add(JobsList.Last.Get, 0, .RowStyles.Count - 1) .Controls.Add(JobsList.Last.Get, 0, .RowStyles.Count - 1)
End With End With
Next Next
TP_MAIN.RowStyles.Add(New RowStyle(SizeType.Percent, 100)) TP_MAIN.RowStyles.Add(New RowStyle(SizeType.AutoSize))
TP_MAIN.RowCount += 1 TP_MAIN.RowCount += 1
Dim s As Size = Size
Dim ss As Size = Screen.PrimaryScreen.WorkingArea.Size
Dim c% = TP_MAIN.RowStyles.Count - 1
s.Height = c * RowHeight + LowestValue + (PaddingE.GetOf({TP_MAIN}).Vertical(c) / c).RoundDown - c
If s.Height > ss.Height Then s.Height = ss.Height
MinimumSize = Nothing
Size = s
MinimumSize = New Size(MinWidth, s.Height)
End If End If
Dim s As Size = Size
s.Height = TP_MAIN.RowStyles.Count * RowHeight + PaddingE.GetOf({TP_MAIN}).Vertical(TP_MAIN.RowStyles.Count) - TP_MAIN.RowStyles.Count * 2
MinimumSize = New Size(MinWidth, s.Height)
Size = s
End With End With
TP_MAIN.Refresh() TP_MAIN.Refresh()
End Sub End Sub

View File

@@ -7,7 +7,6 @@
' This program is distributed in the hope that it will be useful, ' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY ' but WITHOUT ANY WARRANTY
Imports System.Threading Imports System.Threading
Imports SCrawler.API
Imports SCrawler.API.Base Imports SCrawler.API.Base
Imports SCrawler.DownloadObjects.Groups Imports SCrawler.DownloadObjects.Groups
Imports PersonalUtilities.Functions.XML Imports PersonalUtilities.Functions.XML
@@ -15,7 +14,7 @@ Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Tools Imports PersonalUtilities.Tools
Imports PersonalUtilities.Tools.Notifications Imports PersonalUtilities.Tools.Notifications
Namespace DownloadObjects Namespace DownloadObjects
Friend Class AutoDownloader : Inherits GroupParameters : Implements IEContainerProvider Friend Class AutoDownloader : Inherits GroupParameters : Implements IIndexable, IEContainerProvider
Friend Event PauseDisabled() Friend Event PauseDisabled()
Private Shared ReadOnly Property CachePath As SFile Private Shared ReadOnly Property CachePath As SFile
Get Get
@@ -135,15 +134,17 @@ Namespace DownloadObjects
ErrorsDescriber.Execute(EDP.SendInLog, ex, "[AutoDownloader.NotifiedUser.ShowNotification]") ErrorsDescriber.Execute(EDP.SendInLog, ex, "[AutoDownloader.NotifiedUser.ShowNotification]")
If Not User Is Nothing Then If Not User Is Nothing Then
MainFrameObj.ShowNotification(SettingsCLS.NotificationObjects.AutoDownloader, MainFrameObj.ShowNotification(SettingsCLS.NotificationObjects.AutoDownloader,
$"Downloaded: {User.DownloadedPictures(False)} images, {User.DownloadedVideos(False)} videos", User.ToString & vbNewLine &
User.ToString, IIf(User.HasError, ToolTipIcon.Warning, ToolTipIcon.Info)) $"Downloaded: {User.DownloadedPictures(False)} images, {User.DownloadedVideos(False)} videos" &
If(User.HasError, vbNewLine & "With errors", String.Empty))
End If End If
End Try End Try
End Sub End Sub
''' <returns>True to activate</returns> ''' <returns>True to activate</returns>
Friend Function Open(ByVal _Key As String) As Boolean Friend Function Open(ByVal _Key As String) As Boolean
If Not User Is Nothing Then If Not User Is Nothing Then
If Key = _Key Then If KeyDismiss = _Key Then
ElseIf Key = _Key Then
Return True Return True
ElseIf KeyFolder = _Key Then ElseIf KeyFolder = _Key Then
User.OpenFolder() User.OpenFolder()
@@ -152,6 +153,8 @@ Namespace DownloadObjects
ElseIf Images.ContainsKey(_Key) Then ElseIf Images.ContainsKey(_Key) Then
Images(_Key).Open(, EDP.None) Images(_Key).Open(, EDP.None)
End If End If
Else
Return True
End If End If
Return False Return False
End Function End Function
@@ -182,7 +185,6 @@ Namespace DownloadObjects
#Region "XML Names" #Region "XML Names"
Private Const Name_Mode As String = "Mode" Private Const Name_Mode As String = "Mode"
Private Const Name_Groups As String = "Groups" Private Const Name_Groups As String = "Groups"
Private Const Name_Labels As String = "Labels"
Private Const Name_Timer As String = "Timer" Private Const Name_Timer As String = "Timer"
Private Const Name_StartupDelay As String = "StartupDelay" Private Const Name_StartupDelay As String = "StartupDelay"
Private Const Name_LastDownloadDate As String = "LastDownloadDate" Private Const Name_LastDownloadDate As String = "LastDownloadDate"
@@ -205,11 +207,16 @@ Namespace DownloadObjects
End Property End Property
Friend ReadOnly Property Groups As List(Of String) Friend ReadOnly Property Groups As List(Of String)
Friend Property Timer As Integer = DefaultTimer Friend Property Timer As Integer = DefaultTimer
Friend Property StartupDelay As Integer = 0 Friend Property StartupDelay As Integer = 1
Friend Property ShowNotifications As Boolean = True Friend Property ShowNotifications As Boolean = True
Friend Property ShowPictureDownloaded As Boolean = True Friend Property ShowPictureDownloaded As Boolean = True
Friend Property ShowPictureUser As Boolean = True Friend Property ShowPictureUser As Boolean = True
Friend Property ShowSimpleNotification As Boolean = False Friend Property ShowSimpleNotification As Boolean = False
Private Property Index As Integer = -1 Implements IIndexable.Index
Private Function SetIndex(ByVal Obj As Object, ByVal Index As Integer) As Object Implements IIndexable.SetIndex
DirectCast(Obj, AutoDownloader).Index = Index
Return Obj
End Function
#Region "Date" #Region "Date"
Private ReadOnly LastDownloadDateXML As Date? = Nothing Private ReadOnly LastDownloadDateXML As Date? = Nothing
Private _LastDownloadDate As Date = Now.AddYears(-1) Private _LastDownloadDate As Date = Now.AddYears(-1)
@@ -223,20 +230,25 @@ Namespace DownloadObjects
If Not Initialization Then _LastDownloadDateChanged = True If Not Initialization Then _LastDownloadDateChanged = True
End Set End Set
End Property End Property
Private ReadOnly Property NextExecutionDate As Date
Get
If _PauseValue.HasValue Then
Return {LastDownloadDate.AddMinutes(Timer), _StartTime.AddMinutes(StartupDelay), _PauseValue.Value}.Max
Else
Return {LastDownloadDate.AddMinutes(Timer), _StartTime.AddMinutes(StartupDelay)}.Max
End If
End Get
End Property
Private ReadOnly DateProvider As New ADateTime(ADateTime.Formats.BaseDateTime) Private ReadOnly DateProvider As New ADateTime(ADateTime.Formats.BaseDateTime)
Private Function GetLastDateString() As String Private Function GetLastDateString() As String
If LastDownloadDateXML.HasValue Or _LastDownloadDateChanged Then If LastDownloadDateXML.HasValue Or _LastDownloadDateChanged Then
Return LastDownloadDate.ToStringDate(ADateTime.Formats.BaseDateTime) Return LastDownloadDate.ToStringDate(DateProvider)
Else Else
Return "never" Return "never"
End If End If
End Function End Function
Private Function GetNextDateString() As String Private Function GetNextDateString() As String
If _LastDownloadDateChanged Then Return NextExecutionDate.ToStringDate(DateProvider)
Return LastDownloadDate.AddMinutes(Timer).ToStringDate(ADateTime.Formats.BaseDateTime)
Else
Return _StartTime.AddMinutes(StartupDelay).ToStringDate(ADateTime.Formats.BaseDateTime)
End If
End Function End Function
#End Region #End Region
#Region "Information" #Region "Information"
@@ -287,14 +299,11 @@ Namespace DownloadObjects
End Sub End Sub
Friend Sub New(ByVal x As EContainer) Friend Sub New(ByVal x As EContainer)
Me.New Me.New
Name = x.Value(Name_Name).FromXML(Of String)("Default")
Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None) Mode = x.Value(Name_Mode).FromXML(Of Integer)(Modes.None)
Import(x)
If Name.IsEmptyString Then Name = "Default"
Groups.ListAddList(x.Value(Name_Groups).StringToList(Of String)("|"), LAP.NotContainsOnly) Groups.ListAddList(x.Value(Name_Groups).StringToList(Of String)("|"), LAP.NotContainsOnly)
Labels.ListAddList(x.Value(Name_Labels).StringToList(Of String)("|"), LAP.NotContainsOnly)
Temporary = x.Value(Name_Temporary).FromXML(Of Integer)(CheckState.Indeterminate)
Favorite = x.Value(Name_Favorite).FromXML(Of Integer)(CheckState.Indeterminate)
ReadyForDownload = x.Value(Name_ReadyForDownload).FromXML(Of Boolean)(True)
ReadyForDownloadIgnore = x.Value(Name_ReadyForDownloadIgnore).FromXML(Of Boolean)(False)
Timer = x.Value(Name_Timer).FromXML(Of Integer)(DefaultTimer) Timer = x.Value(Name_Timer).FromXML(Of Integer)(DefaultTimer)
If Timer <= 0 Then Timer = DefaultTimer If Timer <= 0 Then Timer = DefaultTimer
StartupDelay = x.Value(Name_StartupDelay).FromXML(Of Integer)(0) StartupDelay = x.Value(Name_StartupDelay).FromXML(Of Integer)(0)
@@ -331,24 +340,18 @@ Namespace DownloadObjects
If Not Source Is Nothing Then Source.Update() If Not Source Is Nothing Then Source.Update()
End Sub End Sub
Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer Private Function ToEContainer(Optional ByVal e As ErrorsDescriber = Nothing) As EContainer Implements IEContainerProvider.ToEContainer
Return New EContainer(Scheduler.Name_Plan, String.Empty) From { Return Export(New EContainer(Scheduler.Name_Plan, String.Empty) From {
New EContainer(Name_Name, Name), New EContainer(Name_Mode, CInt(Mode)),
New EContainer(Name_Mode, CInt(Mode)), New EContainer(Name_Groups, Groups.ListToString("|")),
New EContainer(Name_Groups, Groups.ListToString("|")), New EContainer(Name_Timer, Timer),
New EContainer(Name_Labels, Labels.ListToString("|")), New EContainer(Name_StartupDelay, StartupDelay),
New EContainer(Name_Temporary, CInt(Temporary)), New EContainer(Name_ShowNotifications, ShowNotifications.BoolToInteger),
New EContainer(Name_Favorite, CInt(Favorite)), New EContainer(Name_ShowPictureDown, ShowPictureDownloaded.BoolToInteger),
New EContainer(Name_ReadyForDownload, ReadyForDownload.BoolToInteger), New EContainer(Name_ShowPictureUser, ShowPictureUser.BoolToInteger),
New EContainer(Name_ReadyForDownloadIgnore, ReadyForDownloadIgnore.BoolToInteger), New EContainer(Name_ShowSimpleNotification, ShowSimpleNotification.BoolToInteger),
New EContainer(Name_Timer, Timer), New EContainer(Name_LastDownloadDate, CStr(AConvert(Of String)(If(LastDownloadDateXML.HasValue Or _LastDownloadDateChanged,
New EContainer(Name_StartupDelay, StartupDelay), CObj(LastDownloadDate), Nothing), DateProvider, String.Empty)))
New EContainer(Name_ShowNotifications, ShowNotifications.BoolToInteger), })
New EContainer(Name_ShowPictureDown, ShowPictureDownloaded.BoolToInteger),
New EContainer(Name_ShowPictureUser, ShowPictureUser.BoolToInteger),
New EContainer(Name_ShowSimpleNotification, ShowSimpleNotification.BoolToInteger),
New EContainer(Name_LastDownloadDate, CStr(AConvert(Of String)(If(LastDownloadDateXML.HasValue Or _LastDownloadDateChanged,
CObj(LastDownloadDate), Nothing), DateProvider, String.Empty)))
}
End Function End Function
#End Region #End Region
#Region "Execution" #Region "Execution"
@@ -420,11 +423,33 @@ Namespace DownloadObjects
LastDownloadDate = LastDownloadDate.AddMinutes(Timer) LastDownloadDate = LastDownloadDate.AddMinutes(Timer)
End If End If
End Sub End Sub
Private _SpecialDelayUse As Boolean = False
Private _SpecialDelayTime As Date? = Nothing
Private Sub Checker() Private Sub Checker()
Try Try
Dim _StartDownload As Boolean
While (Not _StopRequested Or Downloader.Working) And Not Mode = Modes.None While (Not _StopRequested Or Downloader.Working) And Not Mode = Modes.None
If LastDownloadDate.AddMinutes(Timer) < Now And _StartTime.AddMinutes(StartupDelay) < Now And If LastDownloadDate.AddMinutes(Timer) < Now And _StartTime.AddMinutes(StartupDelay) < Now And
Not Downloader.Working And Not IsPaused And Not _StopRequested And Not Mode = Modes.None Then Download() Not IsPaused And Not _StopRequested And Not Mode = Modes.None Then
If Downloader.Working Then
_SpecialDelayUse = True
Else
If _SpecialDelayUse And Not _SpecialDelayTime.HasValue Then _SpecialDelayTime = Now.AddSeconds(10)
If Not _SpecialDelayUse OrElse (_SpecialDelayTime.HasValue AndAlso _SpecialDelayTime.Value < Now) Then
_SpecialDelayUse = False
_SpecialDelayTime = Nothing
_StartDownload = False
If Settings.Automation.Count = 1 Then
_StartDownload = True
ElseIf Index = -1 Then
_StartDownload = True
Else
_StartDownload = NextExecutionDate.AddMilliseconds(1000 * (Index + 1)).Ticks <= Now.Ticks
End If
If _StartDownload Then Download()
End If
End If
End If
Thread.Sleep(500) Thread.Sleep(500)
End While End While
Catch ex As Exception Catch ex As Exception
@@ -447,24 +472,41 @@ Namespace DownloadObjects
Dim GName$ Dim GName$
Dim i% Dim i%
Dim DownloadedUsersCount% = 0 Dim DownloadedUsersCount% = 0
Dim l As New ListAddParams(LAP.IgnoreICopier + LAP.NotContainsOnly)
Dim simple As Boolean = ShowSimpleNotification And ShowNotifications Dim simple As Boolean = ShowSimpleNotification And ShowNotifications
Dim notify As Action = Sub() Dim notify As Action = Sub()
With Downloader.Downloaded Try
If ShowNotifications And .Count > 0 Then .ForEach(Sub(ByVal u As IUserData) With Downloader.Downloaded
If Keys.Contains(u.Key) Then If ShowNotifications And .Count > 0 Then
If simple Then For indx% = 0 To .Count - 1
DownloadedUsersCount += 1 With .Item(indx)
Else If Keys.Contains(.Key) Then
ShowNotification(u) If simple Then
End If DownloadedUsersCount += 1
Keys.Remove(u.Key) Else
End If ShowNotification(.Self)
End Sub) End If
End With Keys.Remove(.Key)
End If
End With
Next
End If
End With
Catch n_ex As Exception
End Try
End Sub End Sub
Select Case Mode Select Case Mode
Case Modes.All : users.ListAddList(Settings.Users.Where(Function(u) u.Exists)) Case Modes.All
Dim CheckLabels As Predicate(Of IUserData) = Function(ByVal u As IUserData) As Boolean
If LabelsExcluded.Count = 0 Then
Return True
ElseIf u.Labels.Count = 0 Then
Return True
Else
Return Not u.Labels.ListContains(LabelsExcluded)
End If
End Function
Dim CheckSites As Predicate(Of IUserData) = Function(u) SitesExcluded.Count = 0 OrElse Not SitesExcluded.Contains(u.Site)
users.ListAddList(Settings.GetUsers(Function(u) UserExistsPredicate(u) And CheckLabels.Invoke(u) And CheckSites.Invoke(u)))
Case Modes.Default Case Modes.Default
Using g As New GroupParameters : users.ListAddList(DownloadGroup.GetUsers(g, True)) : End Using Using g As New GroupParameters : users.ListAddList(DownloadGroup.GetUsers(g, True)) : End Using
Case Modes.Specified : users.ListAddList(DownloadGroup.GetUsers(Me, True)) Case Modes.Specified : users.ListAddList(DownloadGroup.GetUsers(Me, True))
@@ -472,24 +514,12 @@ Namespace DownloadObjects
If Groups.Count > 0 And Settings.Groups.Count > 0 Then If Groups.Count > 0 And Settings.Groups.Count > 0 Then
For Each GName In Groups For Each GName In Groups
i = Settings.Groups.IndexOf(GName) i = Settings.Groups.IndexOf(GName)
If i >= 0 Then users.ListAddList(Settings.Groups(i).GetUsers, l) If i >= 0 Then users.ListAddList(Settings.Groups(i).GetUsers, LAP.IgnoreICopier, LAP.NotContainsOnly)
Next Next
End If End If
End Select End Select
If users.Count > 0 Then If users.Count > 0 Then
Keys.ListAddList(users.SelectMany(Of String)(Function(ByVal user As IUserData) As IEnumerable(Of String) Keys.ListAddList(users.Select(Function(u) u.Key))
If user.IsCollection Then
With DirectCast(user, UserDataBind)
If .Count > 0 Then
Return .Collections.Select(Function(u) u.Key)
Else
Return New String() {}
End If
End With
Else
Return {user.Key}
End If
End Function))
With Downloader With Downloader
.AutoDownloaderWorking = True .AutoDownloaderWorking = True
If .Downloaded.Count > 0 Then .Downloaded.RemoveAll(Function(u) Keys.Contains(u.Key)) : .InvokeDownloadsChangeEvent() If .Downloaded.Count > 0 Then .Downloaded.RemoveAll(Function(u) Keys.Contains(u.Key)) : .InvokeDownloadsChangeEvent()
@@ -499,7 +529,7 @@ Namespace DownloadObjects
notify.Invoke notify.Invoke
If simple And DownloadedUsersCount > 0 Then _ If simple And DownloadedUsersCount > 0 Then _
MainFrameObj.ShowNotification(SettingsCLS.NotificationObjects.AutoDownloader, MainFrameObj.ShowNotification(SettingsCLS.NotificationObjects.AutoDownloader,
$"{DownloadedUsersCount} user(s) downloaded with scheduler plan '{Name}'", $"Scheduler plan '{Name}'") $"{DownloadedUsersCount} user(s) downloaded with scheduler plan '{Name}'")
End With End With
End If End If
Catch ex As Exception Catch ex As Exception
@@ -521,10 +551,12 @@ Namespace DownloadObjects
UserKeys.Last.ShowNotification() UserKeys.Last.ShowNotification()
End If End If
End Sub End Sub
Friend Function NotificationClicked(ByVal Key As String) As Boolean Friend Function NotificationClicked(ByVal Key As String, ByRef Found As Boolean, ByRef ActivateForm As Boolean) As Boolean
Dim i% = UserKeys.IndexOf(Key) Dim i% = UserKeys.IndexOf(Key)
If i >= 0 Then If i >= 0 Then
MainFrameObj.FocusUser(UserKeys(i).IUserDataKey, UserKeys(i).Open(Key)) Found = True
ActivateForm = UserKeys(i).Open(Key)
MainFrameObj.FocusUser(UserKeys(i).IUserDataKey, ActivateForm)
Return True Return True
Else Else
Return False Return False

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