Compare commits

...

29 Commits

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

2
.gitignore vendored
View File

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

View File

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

View File

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

22
FAQ.md
View File

@@ -18,7 +18,7 @@ A: https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-set-up-cookies
#### Q: **I can't copy cookies.**
A: Use the mouse. Don't use ```Ctrl``` + ```A```!
A: Use the mouse. Don't use ```Ctrl+A```!
----
@@ -44,6 +44,8 @@ A: How to request a new site you can read [here](CONTRIBUTING.md#how-to-request-
A: Check your credentials. Both of these sites require cookies. Check your [Twitter tokens](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-twitter-tokens) and [Instagram settings](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram-settings). If all settings are set, but nothing works, go to [create a new issue](https://github.com/AAndyProgram/SCrawler/issues). Don't forget to attach the LOG.
**[SITES REQUIREMENTS](https://github.com/AAndyProgram/SCrawler/wiki/Settings#sites-requirements)**
----
#### Q: **I have set credentials but still nothing is downloading**
@@ -94,6 +96,24 @@ A: Just add that user back to the program. In the dialog box that opens, click o
----
#### Q: **Why don't you answer how it works**
A: Because **I don't want to**. I don't want to waste my time explaining things that are already covered in the **[GUIDE](https://github.com/AAndyProgram/SCrawler/wiki)**! If you didn't bother to read the guide, why would I waste my time?! ALL FUNCTIONALITY IS DESCRIBED IN THE GUIDE. Before publishing a new release, I update the guide. If you don't respect my work, I don't waste my time.
----
#### Q: **You lost me. Your program is too complicated.**
A: **I'm fine with that**. If the program is difficult for you or you can't configure it, I can only suggest you find another (easier) program. I really don't mind! The program is free. I am develop SCrawler for myself and publish on GitHub because people found my program useful. If someone can't use it or doesn't like it, I'm fine.
----
#### Q: **I can't configure something**
A: I can only [suggest](#q-you-lost-me-your-program-is-too-complicated) you find another (easier) program.
----
#### Q: **Can you add a step-by-step guide or video on how to use the program?**
A: **NO**! I will not do it. If you want, you can create a video tutorial and send it to me. Then I add it. All options and what each option does described on the wiki. The wiki also contains a description of all settings and how-to configure them. For complex settings, there is a steep-by-steep guide. Read the [main](README.md) information and [GUIDE](https://github.com/AAndyProgram/SCrawler/wiki/) and you won't have any problems. I have developed a program with an intuitive interface. There is a Settings button, download buttons, a context menu that drops down when a user is clicked, and other controls. Anyone can use it.

View File

@@ -1,7 +1,7 @@
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:
- **Bitcoin**: bitcoin:BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET
- **Bitcoin**: BC1Q0NH839FT5TA44DD7L7RLR97XDQAG9V8D6N7XET
- :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)
- :speech_balloon: tell your friends about the program

View File

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

Binary file not shown.

After

Width:  |  Height:  |  Size: 483 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.7 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 7.4 KiB

After

Width:  |  Height:  |  Size: 9.2 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 369 KiB

After

Width:  |  Height:  |  Size: 363 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 379 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 15 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.5 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.4 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 7.7 KiB

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.6 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 KiB

After

Width:  |  Height:  |  Size: 18 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 19 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 KiB

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 9.3 KiB

After

Width:  |  Height:  |  Size: 11 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 11 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 10 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 26 KiB

After

Width:  |  Height:  |  Size: 26 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 15 KiB

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 15 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.6 KiB

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
@@ -32,6 +32,10 @@ Namespace Plugin.Attributes
Public Property AllowNull As Boolean = True
''' <summary>Offset the control from the left border of the form.<br/>Default: 100</summary>
Public Property LeftOffset As Integer = 100
''' <summary>This control is an information label.<br/>Default: <see langword="False"/></summary>
Public Property IsInformationLabel As Boolean = False
''' <summary>Label text alignment.<br/>Default: <see cref="Drawing.ContentAlignment.TopCenter"/></summary>
Public Property LabelTextAlign As Drawing.ContentAlignment = Drawing.ContentAlignment.TopCenter
''' <summary>This is an authorization property</summary>
Public Property IsAuth As Boolean = False
''' <summary>Initialize a new property option attribute</summary>
@@ -49,6 +53,9 @@ Namespace Plugin.Attributes
ElementName = XMLElementName
End Sub
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>
<AttributeUsage(AttributeTargets.Method, AllowMultiple:=True, Inherited:=False)> Public NotInheritable Class PropertyUpdater : Inherits Attribute
Public ReadOnly Name As String
@@ -125,13 +132,26 @@ Namespace Plugin.Attributes
''' Predefined task counter.<br/>
''' <see cref="TaskCounter"/> will take precedence if it is defined.
''' </param>
Public Sub New(Optional ByVal JobsCount As Integer = -1)
TasksCount = JobsCount
Public Sub New(Optional ByVal TasksCount As Integer = -1)
Me.TasksCount = TasksCount
End Sub
End Class
''' <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
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>
<AttributeUsage(AttributeTargets.Class, AllowMultiple:=False, Inherited:=False)> Public NotInheritable Class SavedPosts : Inherits Attribute
End Class

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
@@ -17,16 +17,17 @@ Namespace Plugin
Property ID As String
Property ParseUserMediaOnly As Boolean
Property UserDescription As String
Property ExistingContentList As List(Of PluginUserMedia)
Property ExistingContentList As List(Of IUserMedia)
Property TempPostsList As List(Of String)
Property TempMediaList As List(Of PluginUserMedia)
Property TempMediaList As List(Of IUserMedia)
Property UserExists As Boolean
Property UserSuspended As Boolean
Property IsSavedPosts As Boolean
Property SeparateVideoFolder As Boolean
Property DataPath As String
Property PostsNumberLimit As Integer?
Property PostsDateLimit As Date?
Property DownloadDateFrom As Date?
Property DownloadDateTo As Date?
Function ExchangeOptionsGet() As Object
Sub ExchangeOptionsSet(ByVal Obj As Object)
Sub XmlFieldsSet(ByVal Fields As List(Of KeyValuePair(Of String, String)))

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
@@ -7,24 +7,46 @@
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace Plugin
Public Structure PluginUserMedia
Enum Types As Integer
Undefined = 0
[Picture] = 1
[Video] = 2
[Text] = 3
VideoPre = 10
GIF = 50
m3u8 = 100
End Enum
Enum States As Integer : Unknown = 0 : Tried = 1 : Downloaded = 2 : Skipped = 3 : End Enum
Public ContentType As Integer
Public URL As String
Public MD5 As String
Public File As String
Public DownloadState As Integer
Public PostID As String
Public PostDate As Date?
Public SpecialFolder As String
Public Enum UserMediaTypes As Integer
Undefined = 0
[Picture] = 1
[Video] = 2
[Text] = 3
VideoPre = 10
GIF = 50
m3u8 = 100
End Enum
Public Enum UserMediaStates As Integer
Unknown = 0
Tried = 1
Downloaded = 2
Skipped = 3
Missing = 4
End Enum
Public Structure PluginUserMedia : Implements IUserMedia
Public Property ContentType As Integer Implements IUserMedia.ContentType
Public Property URL As String Implements IUserMedia.URL
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
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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

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

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

View File

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

View File

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

File diff suppressed because it is too large Load Diff

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),
.DesignXMLNode = 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

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

View File

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

View File

@@ -1,36 +0,0 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports Sections = SCrawler.API.Instagram.UserData.Sections
Namespace API.Instagram
Friend Class AuthNullException : Inherits ArgumentNullException
Public Overrides ReadOnly Property ParamName As String
Public Overrides ReadOnly Property Message As String
Friend Sub New(ByVal s As Sections, ByVal IsSavedPosts As Boolean)
If IsSavedPosts Then
ParamName = "HashSavedPosts"
ElseIf s = Sections.Timeline Then
ParamName = "Hash"
Else
ParamName = "IG_APP_ID, IG_WWW_CLAIM"
End If
Message = $"Instagram auth for [{s}] is not set"
End Sub
Friend Shared Sub ThrowIfNull(ByVal s As Sections, ByVal IsSavedPosts As Boolean, ByVal Host As SiteSettings)
Dim b As Boolean = False
If IsSavedPosts Then
If Not ACheck(Host.HashSavedPosts.Value) Then b = True
ElseIf s = Sections.Timeline Then
If Not ACheck(Host.Hash.Value) Then Host.HashUpdateRequired.Value = True : b = True
Else
If Not Host.StoriesAndTaggedReady Then b = True
End If
If b Then Throw New AuthNullException(s, IsSavedPosts)
End Sub
End Class
End Namespace

View File

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

View File

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

View File

@@ -1,15 +0,0 @@
' Copyright (C) 2022 Andy
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Instagram
Friend Class ExitException : Inherits Exception
Friend Sub New(ByRef CompleteArg As Boolean)
CompleteArg = True
End Sub
End Class
End Namespace

View File

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

View File

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

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
@@ -10,23 +10,25 @@ Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Cookies
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Instagram
<Manifest("AndyProgram_Instagram"), UseClassAsIs, SeparatedTasks(1), SavedPosts, SpecialForm(False)>
<Manifest(InstagramSiteKey), SeparatedTasks(1), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Interface Declarations"
#Region "Declarations"
#Region "Images"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.InstagramIcon
Return My.Resources.SiteResources.InstagramIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.InstagramPic76
Return My.Resources.SiteResources.InstagramPic_76
End Get
End Property
#End Region
@@ -54,7 +56,7 @@ Namespace API.Instagram
Return Nothing
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException()
Throw New NotImplementedException("[GetFormat] is not available in the context of [TimersChecker]")
End Function
End Class
Private Class TaggedNotifyLimitChecker : Implements IFieldsCheckerProvider
@@ -72,59 +74,78 @@ Namespace API.Instagram
End If
End Function
Private Function GetFormat(ByVal FormatType As Type) As Object Implements IFormatProvider.GetFormat
Throw New NotImplementedException()
Throw New NotImplementedException("[GetFormat] is not available in the context of [TaggedNotifyLimitChecker]")
End Function
End Class
#End Region
#Region "Authorization properties"
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)>
Friend ReadOnly Property Hash As PropertyValue
<PropertyOption(ControlText:="Hash 2", 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), ControlNumber(2)>
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash for tagged posts", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)>
Friend ReadOnly Property HashTagged As PropertyValue
<PropertyOption(ControlText:="x-csrftoken", IsAuth:=True, AllowNull:=False), ControlNumber(2)>
Friend ReadOnly Property CSRF_TOKEN As PropertyValue
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True), ControlNumber(3)>
<PropertyOption(ControlText:="x-ig-app-id", IsAuth:=True, AllowNull:=False), ControlNumber(3)>
Friend Property IG_APP_ID As PropertyValue
<PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True), ControlNumber(4)>
<PropertyOption(ControlText:="x-ig-www-claim", IsAuth:=True, AllowNull:=False), ControlNumber(4)>
Friend Property IG_WWW_CLAIM As PropertyValue
<PropertyOption(ControlText:="Saved posts user", IsAuth:=True), PXML("SavedPostsUserName"), ControlNumber(5)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend ReadOnly Property StoriesAndTaggedReady As Boolean
Get
Return ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value)
End Get
End Property
Friend Overrides Function BaseAuthExists() As Boolean
Return Responser.CookiesExists And ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value)
End Function
Private Const Header_IG_APP_ID As String = "x-ig-app-id"
Friend Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Friend Const Header_CSRF_TOKEN As String = "x-csrftoken"
Private _FieldsChangerSuspended As Boolean = False
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not _FieldsChangerSuspended And Not PropName.IsEmptyString Then
Dim f$ = String.Empty
Select Case PropName
Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID
Case NameOf(IG_WWW_CLAIM) : f = Header_IG_WWW_CLAIM
Case NameOf(CSRF_TOKEN) : f = Header_CSRF_TOKEN
End Select
If Not f.IsEmptyString Then
Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
Responser.SaveSettings()
End If
End If
End Sub
#End Region
#Region "Download properties"
Friend ReadOnly Property HashUpdateRequired As XMLValue(Of Boolean)
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(6)>
<PropertyOption(ControlText:="Request timer", AllowNull:=False), PXML("RequestsWaitTimer"), ControlNumber(8)>
Friend ReadOnly Property RequestsWaitTimer As PropertyValue
<Provider(NameOf(RequestsWaitTimer), FieldsChecker:=True)>
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(9)>
Friend ReadOnly Property RequestsWaitTimerTaskCount As PropertyValue
<Provider(NameOf(RequestsWaitTimerTaskCount), FieldsChecker:=True)>
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(10)>
Friend ReadOnly Property SleepTimerOnPostsLimit As PropertyValue
<Provider(NameOf(SleepTimerOnPostsLimit), FieldsChecker:=True)>
Private ReadOnly Property SleepTimerOnPostsLimitProvider As IFormatProvider
<PropertyOption(ControlText:="Get stories"), PXML, ControlNumber(9)>
<PropertyOption(ControlText:="Get stories"), PXML, ControlNumber(11)>
Friend ReadOnly Property GetStories As PropertyValue
<PropertyOption(ControlText:="Get tagged photos"), PXML, ControlNumber(10)>
<PropertyOption(ControlText:="Get tagged photos"), PXML, ControlNumber(12)>
Friend ReadOnly Property GetTagged As PropertyValue
<PropertyOption(ControlText:="Tagged notify limit",
ControlToolTip:="If the number of tagged posts exceeds this number you will be notified." & vbCr &
"-1 to disable"), PXML, ControlNumber(11)>
"-1 to disable"), PXML, ControlNumber(13)>
Friend ReadOnly Property TaggedNotifyLimit As PropertyValue
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region
#Region "Download ready"
<PropertyOption(ControlText:="Download timeline", ControlToolTip:="Download timeline, stories and saved posts"), PXML, ControlNumber(6)>
Friend ReadOnly Property DownloadTimeline As PropertyValue
<PropertyOption(ControlText:="Download tagged", ControlToolTip:="Download tagged posts"), PXML, ControlNumber(7)>
Friend ReadOnly Property DownloadTagged As PropertyValue
#End Region
#Region "429 bypass"
Friend ReadOnly Property DownloadingErrorDate As XMLValue(Of Date)
Private ReadOnly Property DownloadingErrorDate As XMLValue(Of Date)
Friend Property LastApplyingValue As Integer? = Nothing
Friend ReadOnly Property ReadyForDownload As Boolean
Get
If SkipUntilNextSession Then Return False
With DownloadingErrorDate
If .ValueF.Exists Then
Return .ValueF.Value.AddMinutes(If(LastApplyingValue, 10)) < Now
@@ -134,8 +155,11 @@ Namespace API.Instagram
End With
End Get
End Property
Friend ReadOnly Property LastDownloadDate As XMLValue(Of Date)
Friend ReadOnly Property LastRequestsCount As XMLValue(Of Integer)
Private ReadOnly Property LastDownloadDate As XMLValue(Of Date)
Private ReadOnly Property LastRequestsCount As XMLValue(Of Integer)
<PropertyOption(IsInformationLabel:=True), ControlNumber(100)>
Private Property LastRequestsCountLabel As PropertyValue
Private ReadOnly LastRequestsCountLabelStr As Func(Of Integer, String) = Function(r) $"Number of spent requests: {r.NumToGroupIntegral}"
Private TooManyRequestsReadyForCatch As Boolean = True
Friend Function GetWaitDate() As Date
With DownloadingErrorDate
@@ -155,7 +179,7 @@ Namespace API.Instagram
LastApplyingValue = If(LastApplyingValue, 0) + 10
TooManyRequestsReadyForCatch = False
MyMainLOG = $"Instagram downloading error: too many requests. Try again after {If(LastApplyingValue, 10)} minutes..."
End If
End If
End If
Else
.ValueF = Nothing
@@ -165,40 +189,40 @@ Namespace API.Instagram
End With
End Sub
#End Region
Friend Overrides ReadOnly Property Responser As WEB.Response
#End Region
#Region "Initializer"
Friend Sub New(ByRef _XML As XmlFile, ByVal GlobalPath As SFile)
MyBase.New(InstagramSite)
Responser = New WEB.Response($"{SettingsFolderName}\Responser_{Site}.xml")
MyBase.New(InstagramSite, "instagram.com")
Dim app_id$ = String.Empty
Dim www_claim$ = String.Empty
Dim token$ = String.Empty
With Responser
If .File.Exists Then
.LoadSettings()
With .Headers
If .ContainsKey(Header_CSRF_TOKEN) Then token = .Item(Header_CSRF_TOKEN)
If .ContainsKey(Header_IG_APP_ID) Then app_id = .Item(Header_IG_APP_ID)
If .ContainsKey(Header_IG_WWW_CLAIM) Then www_claim = .Item(Header_IG_WWW_CLAIM)
End With
Else
.CookiesDomain = "instagram.com"
.SaveSettings()
If .Headers.Count > 0 Then
token = .Headers.Value(Header_CSRF_TOKEN)
app_id = .Headers.Value(Header_IG_APP_ID)
www_claim = .Headers.Value(Header_IG_WWW_CLAIM)
End If
.CookiesExtractMode = Responser.CookiesExtractModes.Response
.CookiesUpdateMode = CookieKeeper.UpdateModes.ReplaceByNameAll
.CookiesExtractedAutoSave = False
If Not .Cookies Is Nothing Then
.Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False
End If
End With
Dim n() As String = {SettingsCLS.Name_Node_Sites, Site.ToString}
SavedPostsUserName = New PropertyValue(String.Empty, GetType(String))
HashUpdateRequired = New XMLValue(Of Boolean)("InstaHashUpdateRequired", True, _XML, n)
Hash = New PropertyValue(String.Empty, GetType(String))
HashSavedPosts = New PropertyValue(String.Empty, GetType(String))
HashTagged = New PropertyValue(String.Empty, GetType(String))
CSRF_TOKEN = New PropertyValue(token, GetType(String), Sub(v) ChangeResponserFields(NameOf(CSRF_TOKEN), v))
IG_APP_ID = New PropertyValue(app_id, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_APP_ID), v))
IG_WWW_CLAIM = New PropertyValue(www_claim, GetType(String), Sub(v) ChangeResponserFields(NameOf(IG_WWW_CLAIM), v))
DownloadTimeline = New PropertyValue(True)
DownloadTagged = New PropertyValue(False)
RequestsWaitTimer = New PropertyValue(1000)
RequestsWaitTimerProvider = New TimersChecker(100)
RequestsWaitTimerTaskCount = New PropertyValue(1)
@@ -211,69 +235,61 @@ Namespace API.Instagram
TaggedNotifyLimit = New PropertyValue(200)
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, vv) AConvert(Of String)(vv, AModes.Var, Nothing))}
DownloadingErrorDate.SetExtended("InstagramDownloadingErrorDate", Now.AddYears(-10), _XML, n)
LastDownloadDate = New XMLValue(Of Date)("LastDownloadDate", Now.AddDays(-1), _XML, n)
LastRequestsCount = New XMLValue(Of Integer)("LastRequestsCount", 0, _XML, n)
LastRequestsCountLabel = New PropertyValue(LastRequestsCountLabelStr.Invoke(LastRequestsCount.Value))
AddHandler LastRequestsCount.OnValueChanged, Sub(sender, __name, __value) LastRequestsCountLabel.Value = LastRequestsCountLabelStr.Invoke(DirectCast(__value, Existable(Of Integer)).Value)
UrlPatternUser = "https://www.instagram.com/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?instagram.com/([^/]+)", 1)
ImageVideoContains = "instagram.com"
End Sub
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
Select Case What
Case Download.Main : Return New UserData
Case Download.SavedPosts
Dim u As New UserData
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = CStr(AConvert(Of String)(SavedPostsUserName.Value, String.Empty))}
Return u
End Select
Return Nothing
End Function
Private Const Header_IG_APP_ID As String = "x-ig-app-id"
Private Const Header_IG_WWW_CLAIM As String = "x-ig-www-claim"
Private Const Header_CSRF_TOKEN As String = "x-csrftoken"
Private Sub ChangeResponserFields(ByVal PropName As String, ByVal Value As Object)
If Not PropName.IsEmptyString Then
Dim f$ = String.Empty
Select Case PropName
Case NameOf(IG_APP_ID) : f = Header_IG_APP_ID
Case NameOf(IG_WWW_CLAIM) : f = Header_IG_WWW_CLAIM
Case NameOf(CSRF_TOKEN) : f = Header_CSRF_TOKEN
End Select
If Not f.IsEmptyString Then
If Responser.Headers.Count > 0 AndAlso Responser.Headers.ContainsKey(f) Then Responser.Headers.Remove(f)
If Not CStr(Value).IsEmptyString Then Responser.Headers.Add(f, CStr(Value))
Responser.SaveSettings()
End If
End If
Private Structure LatestValues
Friend Hash 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)(.HashTagged.Value, String.Empty)
With .Responser
Token = .Headers.Value(Header_CSRF_TOKEN)
AppID = .Headers.Value(Header_IG_APP_ID)
WwwClaim = .Headers.Value(Header_IG_WWW_CLAIM)
End With
End With
End Sub
End Structure
Private LV As LatestValues = Nothing
Friend Overrides Sub BeginEdit()
LV = New LatestValues(Me)
MyBase.BeginEdit()
End Sub
<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
Friend Overrides Sub EndEdit()
LV = Nothing
MyBase.EndEdit()
End Sub
Friend Overloads 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) And Responser.CookiesExists
Dim _tokensChanged As Boolean = (Not __lv.Token.IsEmptyString And Not __lv.WwwClaim.IsEmptyString And Not __lv.AppID.IsEmptyString) And
(Not LV.Token = __lv.Token Or Not LV.WwwClaim = __lv.WwwClaim Or Not LV.AppID = __lv.AppID)
If _cookiesChanged Or _tokensChanged Then DownloadTimeline.Value = True
If Not __lv.Hash.IsEmptyString And (_cookiesChanged Or _tokensChanged Or Not LV.Hash = __lv.Hash) Then DownloadTagged.Value = True
End If
Else
Return False
End If
End Function
LV = Nothing
If Not Responser.Cookies Is Nothing Then Responser.Cookies.Changed = False
MyBase.Update()
End Sub
#End Region
#Region "PropertiesDataChecker"
<PropertiesDataChecker({NameOf(TaggedNotifyLimit)})>
Private Function CheckNotifyLimit(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists Then
@@ -284,7 +300,7 @@ Namespace API.Instagram
Return True
ElseIf v = -1 Then
Return MsgBoxE({"You turn off notifications for tagged posts. This is highly undesirable. Do you still want to do it?",
"Disabling tagged notification limits "}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes
"Disabling tagged notification limits"}, MsgBoxStyle.YesNo) = MsgBoxResult.Yes
Else
Return False
End If
@@ -292,20 +308,27 @@ Namespace API.Instagram
End If
Return False
End Function
Friend Overrides Sub BeginInit()
End Sub
Friend Overrides Sub EndInit()
If (CStr(Hash.Value).IsEmptyString Or HashUpdateRequired) AndAlso Responser.Cookies.ListExists Then GatherInstaHash()
End Sub
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
Return ActiveJobs < 2 AndAlso ReadyForDownload
#End Region
#Region "Plugin functions"
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
Select Case What
Case Download.Main : Return New UserData
Case Download.SavedPosts
Dim u As New UserData
DirectCast(u, UserDataBase).User = New UserInfo With {.Name = Site}
Return u
End Select
Return Nothing
End Function
#Region "Downloading"
Friend Property SkipUntilNextSession As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
Return ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() AndAlso DownloadTimeline.Value
End Function
Private ActiveJobs As Integer = 0
Private _NextWNM As UserData.WNM = UserData.WNM.Notify
Private _NextTagged As Boolean = True
Friend Overrides Sub DownloadStarted(ByVal What As Download)
If CStr(Hash.Value).IsEmptyString Or HashUpdateRequired Then GatherInstaHash()
ActiveJobs += 1
End Sub
Friend Overrides Sub BeforeStartDownload(ByVal User As Object, ByVal What As Download)
@@ -329,6 +352,10 @@ Namespace API.Instagram
_NextTagged = .TaggedCheckSession
LastDownloadDate.Value = Now
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 Sub
Friend Overrides Sub DownloadDone(ByVal What As Download)
@@ -336,42 +363,11 @@ Namespace API.Instagram
_NextTagged = True
LastDownloadDate.Value = Now
ActiveJobs -= 1
If HashUpdateRequired Then MyMainLOG = "Check your Instagram credentials"
SkipUntilNextSession = False
End Sub
#End Region
<PropertyUpdater(NameOf(Hash))>
Friend Function GatherInstaHash() As Boolean
Try
If Not Responser.Cookies.ListExists Then Throw New Exception("Instagram cookies does not set")
Dim rs As New RParams("preload"" href=""(https://static.cdninstagram.com/rsrc.php/[^""]+?.js[^""]*)""", Nothing, 1, RegexReturn.List) With {.MatchTimeOut = 10}
Dim h$
Dim r$ = Responser.GetResponse("https://www.instagram.com",, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim JsUrls As List(Of String) = RegexReplace(r, rs)
If JsUrls.ListExists Then
rs = New RParams("\{.+?var h=""([\w\d\S]+?)"".+?\)\.generatePaginationActionCreators", Nothing, 1) With {.MatchTimeOut = 10}
For Each url$ In JsUrls
r = Responser.GetResponse(url,, EDP.ReturnValue)
If Not r.IsEmptyString Then
h = RegexReplace(r, rs)
If Not h.IsEmptyString AndAlso h.Length > 30 Then
Hash.Value = h
HashUpdateRequired.Value = False
Return True
End If
End If
Next
End If
End If
Return False
Catch ex As Exception
HashUpdateRequired.Value = True
Hash.Value = String.Empty
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[SiteSettings.GaterInstaHash]", False)
End Try
End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return UserData.GetVideoInfo(URL, Responser, Me)
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
Return UserData.GetVideoInfo(URL, Responser)
End Function
Friend Overrides 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)
@@ -379,5 +375,14 @@ Namespace API.Instagram
Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
Friend Overrides Function GetUserPostUrl(ByVal User As UserDataBase, ByVal Media As UserMedia) As String
Try
Dim code$ = DirectCast(User, UserData).GetPostCodeById(Media.Post.ID)
If Not code.IsEmptyString Then Return $"https://instagram.com/p/{code}/" Else Return String.Empty
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, "Can't open user's post", String.Empty)
End Try
End Function
#End Region
End Class
End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
@@ -6,34 +6,74 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Net
Imports System.Threading
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.Messaging
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports PersonalUtilities.Tools.Web.Clients
Imports PersonalUtilities.Tools.Web.Documents.JSON
Imports SCrawler.API.Base
Imports System.Threading
Imports System.Net
Imports System.Reflection
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Instagram
Friend Class UserData : Inherits UserDataBase
Private Const MaxPostsCount As Integer = 200
#Region "XML Names"
Private Const Name_LastCursor As String = "LastCursor"
Private Const Name_FirstLoadingDone As String = "FirstLoadingDone"
Private Const Name_GetStories As String = "GetStories"
Private Const Name_GetTagged As String = "GetTaggedData"
Private Const Name_TaggedChecked As String = "TaggedChecked"
#End Region
#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
Get
Return DirectCast(HOST.Source, SiteSettings)
End Get
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 FirstLoadingDone As Boolean = False
Friend Property GetStories As Boolean
Friend Property GetTaggedData As Boolean
#End Region
#Region "Exchange options"
Friend Overrides Function ExchangeOptionsGet() As Object
Return New EditorExchangeOptions(HOST.Source) With {.GetStories = GetStories, .GetTagged = GetTaggedData}
End Function
@@ -45,7 +85,11 @@ Namespace API.Instagram
End With
End If
End Sub
#End Region
#Region "Initializer, loader"
Friend Sub New()
PostsKVIDs = New List(Of PostKV)
PostsToReparse = New List(Of PostKV)
End Sub
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then
@@ -62,44 +106,143 @@ Namespace API.Instagram
Container.Add(Name_TaggedChecked, TaggedChecked.BoolToInteger)
End If
End Sub
#End Region
#Region "Download data"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Private E560Thrown As Boolean = False
Private Class ExitException : Inherits Exception
Friend Shared Sub Throw560(ByRef Source As UserData)
If Not Source.E560Thrown Then
MyMainLOG = $"{Source.ToStringForLog}: (560) Download skipped until next session"
Source.E560Thrown = True
End If
Throw New ExitException
End Sub
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
_InstaHash = String.Empty
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)
Dim s As Sections = Sections.Timeline
Dim errorFound As Boolean = False
Try
LoadSavePostsKV(True)
_DownloadingInProgress = True
AddHandler Responser.ResponseReceived, AddressOf Responser_ResponseReceived
ThrowAny(Token)
HasError = False
If Not LastCursor.IsEmptyString Then
DownloadData(LastCursor, Sections.Timeline, Token)
If CBool(MySiteSettings.DownloadTimeline.Value) And Not LastCursor.IsEmptyString Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(LastCursor, s, Token)
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If Not HasError Then
DownloadData(String.Empty, Sections.Timeline, Token)
If CBool(MySiteSettings.DownloadTimeline.Value) And Not HasError Then
s = IIf(IsSavedPosts, Sections.SavedPosts, Sections.Timeline)
DownloadData(String.Empty, s, Token)
ThrowAny(Token)
If Not HasError Then FirstLoadingDone = True
End If
If FirstLoadingDone Then LastCursor = String.Empty
If IsSavedPosts Then
DownloadPosts(Token)
ElseIf MySiteSettings.StoriesAndTaggedReady Then
DownloadedTags = 0
If GetStories Then DownloadData(String.Empty, Sections.Stories, Token)
If GetTaggedData Then DownloadData(String.Empty, Sections.Tagged, Token)
If MySiteSettings.BaseAuthExists() Then
If CBool(MySiteSettings.DownloadTimeline.Value) And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token)
If CBool(MySiteSettings.DownloadTagged.Value) And ACheck(MySiteSettings.HashTagged.Value) And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token)
End If
If WaitNotificationMode = WNM.SkipTemp Or WaitNotificationMode = WNM.SkipCurrent Then WaitNotificationMode = WNM.Notify
Catch eex As ExitException
Catch ex As Exception
ProcessException(ex, Token, "[API.Instagram.UserData.DownloadDataF", False)
errorFound = True
Throw ex
Finally
E560Thrown = False
UpdateResponser()
If Not errorFound Then LoadSavePostsKV(False)
End Try
End Sub
Private _InstaHash As String = String.Empty
Friend Enum Sections
Timeline
Tagged
Stories
End Enum
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 Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass"
Private Const MaxPostsCount As Integer = 200
Friend Property RequestsCount As Integer = 0
Friend Enum WNM As Integer
Notify = 0
@@ -120,7 +263,7 @@ Namespace API.Instagram
"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 (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("Wait (disable all)") With {.ToolTip = "Wait and skip future prompts while downloading the current session."}
},
@@ -155,13 +298,11 @@ Namespace API.Instagram
#Region "Tags"
Private TaggedChecked As Boolean = False
Friend TaggedCheckSession As Boolean = True
Private DownloadedTags As Integer = 0
Private DownloadTagsLimit As Integer? = Nothing
Private ReadOnly Property TaggedLimitsNotifications(Optional ByVal v As Integer? = Nothing) As Boolean
Private ReadOnly Property TaggedLimitsNotifications(ByVal v As Integer) As Boolean
Get
Return Not TaggedChecked AndAlso TaggedCheckSession AndAlso
CInt(MySiteSettings.TaggedNotifyLimit.Value) > 0 AndAlso
(Not v.HasValue OrElse v.Value > CInt(MySiteSettings.TaggedNotifyLimit.Value))
CInt(MySiteSettings.TaggedNotifyLimit.Value) > 0 AndAlso v > CInt(MySiteSettings.TaggedNotifyLimit.Value)
End Get
End Property
Private Function SetTagsLimit(ByVal Max As Integer, ByVal p As ANumbers) As DialogResult
@@ -174,7 +315,7 @@ Namespace API.Instagram
Dim m As New MMessage("You have not entered a valid posts limit", "Tagged posts download limit", {tryBtt, selectBtt, cancelBtt})
Dim mh As New MMessage("", "Tagged posts download limit", {"Confirm", tryBtt, selectBtt, cancelBtt}) With {.ButtonsPerRow = 2}
Do
v = AConvert(Of Integer)(InputBoxE(aStr, "Tagged posts download limit", CInt(MySiteSettings.TaggedNotifyLimit.Value)), Nothing)
v = AConvert(Of Integer)(InputBoxE(aStr, "Tagged posts download limit", CInt(MySiteSettings.TaggedNotifyLimit.Value)), AModes.Var, Nothing)
If v.HasValue Then
mh.Text = $"You have entered a limit of {v.Value.NumToString(p)} posts"
Select Case MsgBoxE(mh).Index
@@ -194,8 +335,9 @@ Namespace API.Instagram
End Function
Private Function TaggedContinue(ByVal TaggedCount As Integer) As DialogResult
Dim agi As New ANumbers With {.FormatOptions = ANumbers.Options.GroupIntegral}
Dim msg As New MMessage($"The number of tagged posts by user [{ToString()}] is {TaggedCount.NumToString(agi)}" & vbCr &
$"This is about {(TaggedCount / 12).RoundUp.NumToString(agi)} requests." & vbCr &
Dim msg As New MMessage($"The number of already downloaded tagged posts by user [{ToString()}] is {TaggedCount.NumToString(agi)}" & 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.",
"Too much tagged data",
{
@@ -227,40 +369,46 @@ Namespace API.Instagram
Dim URL$ = String.Empty
Dim StoriesList As List(Of String) = Nothing
Dim StoriesRequested As Boolean = False
Dim _DownloadComplete As Boolean = False
Dim dValue% = 1
LastCursor = Cursor
Try
Do While Not _DownloadComplete
Do While dValue = 1
ThrowAny(Token)
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter()
Try
Dim n As EContainer, nn As EContainer, node As EContainer
Dim n As EContainer, nn As EContainer
Dim HasNextPage As Boolean = False
Dim EndCursor$ = String.Empty
Dim PostID$ = String.Empty, PostDate$ = String.Empty, SpecFolder$ = String.Empty
Dim TaggedCount%
Dim PostIDKV As PostKV
Dim ENode() As Object = Nothing
NextRequest(True)
'Check environment
If Cursor.IsEmptyString And _InstaHash.IsEmptyString Then _
_InstaHash = CStr(If(IsSavedPosts, MySiteSettings.HashSavedPosts, MySiteSettings.Hash).Value)
AuthNullException.ThrowIfNull(Section, IsSavedPosts, MySiteSettings)
If ID.IsEmptyString Then GetUserId()
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
If Not IsSavedPosts Then
If ID.IsEmptyString Then GetUserId()
If ID.IsEmptyString Then Throw New ArgumentException("User ID is not detected", "ID")
End If
'Create query
Select Case Section
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 & """}"
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}
Case Sections.Tagged
URL = $"https://i.instagram.com/api/v1/usertags/{ID}/feed/?count=50&max_id={Cursor}"
ENode = {"items"}
SpecFolder = TaggedFolder
Case Sections.Stories
If Not StoriesRequested Then
@@ -278,7 +426,7 @@ Namespace API.Instagram
If StoriesList.ListExists Then
Continue Do
Else
Throw New ExitException(_DownloadComplete)
Throw New ExitException
End If
End Select
@@ -288,80 +436,76 @@ Namespace API.Instagram
RequestsCount += 1
ThrowAny(Token)
'Data
'Parsing
If Not r.IsEmptyString Then
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
Select Case Section
Case Sections.Timeline
If n.Contains("page_info") Then
With n("page_info")
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
EndCursor = .Value("end_cursor")
End With
End If
n = n("edges").XmlIfNothing
If n.Count > 0 Then
For Each nn In n
ThrowAny(Token)
node = nn(0).XmlIfNothing
If IsSavedPosts Then
PostID = node.Value("shortcode")
If Not PostID.IsEmptyString Then
If _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete) Else _SavedPostsIDs.Add(PostID)
End If
Else
PostID = node.Value("id")
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID)
PostDate = node.Value("taken_at_timestamp")
If Not CheckDatesLimit(PostDate, DateProvider) Then Throw New ExitException(_DownloadComplete)
ObtainMedia(node, PostID, PostDate, SpecFolder)
End If
Next
End If
With n
HasNextPage = .Value("more_available").FromXML(Of Boolean)(False)
EndCursor = .Value("next_max_id")
If If(.Item("items")?.Count, 0) > 0 Then
If Not DefaultParser(.Item("items"), Section, Token) Then Throw New ExitException
Else
HasNextPage = False
End If
End With
Case Sections.Tagged
HasNextPage = j.Value("more_available").FromXML(Of Boolean)(False)
EndCursor = j.Value("next_max_id")
For Each nn In n
PostID = $"Tagged_{nn.Value("id")}"
If Not PostID.IsEmptyString And _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
_TempPostsList.Add(PostID)
ObtainMedia2(nn, PostID, SpecFolder)
DownloadedTags += 1
If DownloadTagsLimit.HasValue AndAlso DownloadedTags >= DownloadTagsLimit.Value Then _
Throw New ExitException(_DownloadComplete)
Next
If TaggedLimitsNotifications Then
TaggedCount = j.Value("total_count").FromXML(Of Integer)(0)
With n
If .Contains("page_info") Then
With .Item("page_info")
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
EndCursor = .Value("end_cursor")
End With
Else
HasNextPage = False
End If
If If(.Item("edges")?.Count, 0) > 0 Then
For Each nn In .Item("edges")
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
If TaggedLimitsNotifications(TaggedCount) AndAlso
TaggedContinue(TaggedCount) = DialogResult.Cancel Then Throw New ExitException(_DownloadComplete)
If TaggedContinue(PostsToReparse.Count) = DialogResult.Cancel Then Throw New ExitException
End If
End Select
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 _
UserExists = False : Throw New ExitException(_DownloadComplete)
UserExists = False : Throw New ExitException
End If
End Using
Else
Throw New ExitException(_DownloadComplete)
Throw New ExitException
End If
_DownloadComplete = True
dValue = 0
If HasNextPage And Not EndCursor.IsEmptyString Then DownloadData(EndCursor, Section, Token)
Catch iane As AuthNullException
ErrorsDescriber.Execute(EDP.SendInLog, iane)
Throw New ExitException(_DownloadComplete)
Catch eex As ExitException
Throw eex
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Exit Do
Catch dex As ObjectDisposedException When Disposed
Exit Do
Catch ex As Exception
If DownloadingException(ex, $"data downloading error [{URL}]", Section, False) = 1 Then Continue Do Else Exit Do
dValue = ProcessException(ex, Token, $"data downloading error [{URL}]",, Section, False)
End Try
Loop
Catch eex2 As ExitException
@@ -369,15 +513,15 @@ Namespace API.Instagram
Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted
If oex2.HelpLink = InstAborted Then HasError = True
Catch DoEx As Exception
ProcessException(DoEx, Token, $"data downloading error [{URL}]")
ProcessException(DoEx, Token, $"data downloading error [{URL}]",, Section)
End Try
End Sub
Private Sub DownloadPosts(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Dim _DownloadComplete As Boolean = False
Dim dValue% = 1
Dim _Index% = 0
Try
Do While Not _DownloadComplete
Do While dValue = 1
ThrowAny(Token)
If Not Ready() Then Thread.Sleep(10000) : ThrowAny(Token) : Continue Do
ReconfigureAwaiter()
@@ -385,12 +529,11 @@ Namespace API.Instagram
Try
Dim r$
Dim j As EContainer, jj As EContainer
Dim _MediaObtained As Boolean
If _SavedPostsIDs.Count > 0 And _Index <= _SavedPostsIDs.Count - 1 Then
If PostsToReparse.Count > 0 And _Index <= PostsToReparse.Count - 1 Then
Dim e As New ErrorsDescriber(EDP.ThrowException)
For i% = _Index To _SavedPostsIDs.Count - 1
For i% = _Index To PostsToReparse.Count - 1
_Index = i
URL = $"https://instagram.com/p/{_SavedPostsIDs(i)}/?__a=1"
URL = $"https://www.instagram.com/api/v1/media/{PostsToReparse(i).ID}/info/"
ThrowAny(Token)
NextRequest(((i + 1) Mod 5) = 0)
ThrowAny(Token)
@@ -400,17 +543,9 @@ Namespace API.Instagram
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
_MediaObtained = False
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
If If(j("items")?.Count, 0) > 0 Then
With j("items")
If .Count > 0 Then
For Each jj In .Self : ObtainMedia2(jj, _SavedPostsIDs(i)) : Next
End If
For Each jj In .Self : ObtainMedia(jj, PostsToReparse(i).ID) : Next
End With
End If
j.Dispose()
@@ -418,48 +553,109 @@ Namespace API.Instagram
End If
Next
End If
_DownloadComplete = True
Catch oex As OperationCanceledException When Token.IsCancellationRequested
Exit Do
Catch dex As ObjectDisposedException When Disposed
Exit Do
dValue = 0
Catch eex As ExitException
Throw eex
Catch ex As Exception
If DownloadingException(ex, $"downloading saved posts error [{URL}]") = 1 Then Continue Do Else Exit Do
dValue = ProcessException(ex, Token, $"downloading posts error [{URL}]",, Sections.Tagged, False)
End Try
Loop
Catch eex2 As ExitException
Catch oex2 As OperationCanceledException When Token.IsCancellationRequested Or oex2.HelpLink = InstAborted
If oex2.HelpLink = InstAborted Then HasError = True
Catch DoEx As Exception
ProcessException(DoEx, Token, $"downloading saved posts error [{URL}]")
ProcessException(DoEx, Token, $"downloading posts error [{URL}]",, Sections.Tagged)
End Try
End Sub
#End Region
#Region "Obtain Media"
Private Sub ObtainMedia(ByVal node As EContainer, ByVal PostID As String, ByVal PostDate As String, ByVal SpecFolder As String)
Dim CreateMedia As Action(Of EContainer) =
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")
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
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 Using
End If
End Sub
Private Sub ObtainMedia2(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
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) And Not Pinned Then Return False
_TempPostsList.Add(PostIDKV.ID)
PostsKVIDs.ListAddValue(PostIDKV, LAP.NotContainsOnly)
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 With
Next
Return True
Else
Return False
End If
End Function
#End Region
#Region "Code ID converters"
Private Shared Function CodeToID(ByVal Code As String) As String
Const CodeSymbols$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
Try
If Not Code.IsEmptyString Then
Dim c As Char
Dim id& = 0
For i% = 0 To Code.Length - 1
c = Code(i)
id = (id * 64) + CodeSymbols.IndexOf(c)
Next
Return id
Else
Return String.Empty
End If
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.Instagram.UserData.CodeToID({Code})", String.Empty)
End Try
End Function
#End Region
#Region "Obtain Media"
Private Sub ObtainMedia(ByVal n As EContainer, ByVal PostID As String, Optional ByVal SpecialFolder As String = Nothing,
Optional ByVal DateObj As String = Nothing)
Try
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 ss As Func(Of EContainer, Sizes) = Function(_ss) New Sizes(_ss.Value("width"), _ss.Value("url"))
Dim mDate As Func(Of EContainer, String) = Function(ByVal elem As EContainer) As String
If Not DateObj.IsEmptyString Then Return DateObj
If elem.Contains("taken_at") Then
Return elem.Value("taken_at")
ElseIf elem.Contains("imported_taken_at") Then
@@ -468,7 +664,7 @@ Namespace API.Instagram
Dim ev$ = elem.Value("device_timestamp")
If Not ev.IsEmptyString Then
If ev.Length > 10 Then
Return elem.Value("device_timestamp").Substring(0, 10)
Return ev.Substring(0, 10)
Else
Return ev
End If
@@ -524,7 +720,7 @@ Namespace API.Instagram
DateObj = mDate(n)
With n("carousel_media").XmlIfNothing
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 With
End Select
@@ -536,12 +732,13 @@ Namespace API.Instagram
End Try
End Sub
#End Region
#Region "GetUserId"
Private Sub GetUserId()
Try
Dim r$ = Responser.GetResponse($"https://www.instagram.com/{Name}/?__a=1",, 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
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
ID = j({"graphql", "user"}, "id").XmlIfNothingValue
ID = j({"data", "user"}, "id").XmlIfNothingValue
End Using
End If
Catch ex As Exception
@@ -552,6 +749,7 @@ Namespace API.Instagram
End If
End Try
End Sub
#End Region
#Region "Pinned stories"
Private Sub GetStoriesData(ByRef StoriesList As List(Of String), ByVal Token As CancellationToken)
Const ReqUrl$ = "https://i.instagram.com/api/v1/feed/reels_media/?{0}"
@@ -583,7 +781,7 @@ Namespace API.Instagram
pid = storyID & s.Value("id")
If Not _TempPostsList.Contains(pid) Then
ThrowAny(Token)
ObtainMedia2(s, pid, sFolder)
ObtainMedia(s, pid, sFolder)
_TempPostsList.Add(pid)
End If
Next
@@ -607,30 +805,35 @@ Namespace API.Instagram
End If
Return Nothing
Catch ex As Exception
DownloadingException(ex, "API.Instagram.GetStoriesList", Sections.Stories, False)
DownloadingException(ex, "API.Instagram.GetStoriesList", False, Sections.Stories)
Return Nothing
End Try
End Function
#End Region
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
#Region "Download content"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
#End Region
#Region "Exceptions"
''' <exception cref="ExitException"></exception>
''' <inheritdoc cref="UserDataBase.ThrowAny(CancellationToken)"/>
Friend Overrides Sub ThrowAny(ByVal Token As CancellationToken)
If MySiteSettings.SkipUntilNextSession Then ExitException.Throw560(Me)
MyBase.ThrowAny(Token)
End Sub
''' <summary>
''' <inheritdoc cref="UserDataBase.DownloadingException(Exception, String)"/><br/>
''' <inheritdoc cref="UserDataBase.DownloadingException(Exception, String, Boolean, Object)"/><br/>
''' 1 - continue
''' </summary>
Protected Overloads Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
Return DownloadingException(ex, Message, Sections.Timeline, FromPE)
End Function
Private Overloads Function DownloadingException(ByVal ex As Exception, ByVal Message As String, ByVal s As Sections, ByVal FromPE As Boolean) As Integer
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal s As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.BadRequest Then
HasError = True
MyMainLOG = $"Instagram credentials have expired: {ToString()} [{s}]"
MySiteSettings.HashUpdateRequired.Value = True
MyMainLOG = $"Instagram credentials have expired [{CInt(Responser.StatusCode)}]: {ToStringForLog()} [{s}]"
DisableSection(s)
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then
Return 3
ElseIf Responser.StatusCode = 429 Then
@@ -642,14 +845,28 @@ Namespace API.Instagram
Caught429 = True
MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1
ElseIf Responser.StatusCode = 560 Then
MySiteSettings.SkipUntilNextSession = True
Else
MySiteSettings.HashUpdateRequired.Value = True
MyMainLOG = $"Instagram hash requested: {ToString()} [{s}]"
MyMainLOG = $"Instagram hash requested [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
DisableSection(s)
If Not FromPE Then LogError(ex, Message) : HasError = True
Return 0
End If
Return 2
End Function
Private Sub DisableSection(ByVal Section As Object)
If Not IsNothing(Section) AndAlso TypeOf Section Is Sections Then
Dim s As Sections = DirectCast(Section, Sections)
Select Case s
Case Sections.Timeline : MySiteSettings.DownloadTimeline.Value = False
Case Else : MySiteSettings.DownloadTagged.Value = False
End Select
MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper
End If
End Sub
#End Region
#Region "Create media"
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal SpecialFolder As String = Nothing) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
@@ -659,16 +876,19 @@ Namespace API.Instagram
m.SpecialFolder = SpecialFolder
Return m
End Function
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal r As Response, ByVal _Settings As SiteSettings) As IEnumerable(Of UserMedia)
#End Region
#Region "Standalone downloader"
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal r As Responser) As IEnumerable(Of UserMedia)
Try
If Not URL.IsEmptyString AndAlso URL.Contains("instagram.com") Then
Dim PID$ = RegexReplace(URL, RParams.DMS(".*?instagram.com/p/([_\w\d]+)", 1))
If Not PID.IsEmptyString AndAlso Not ACheck(Of Long)(PID) Then PID = CodeToID(PID)
If Not PID.IsEmptyString Then
Using t As New UserData
t.SetEnvironment(Settings(_Settings.GetType.GetCustomAttribute(Of Plugin.Attributes.Manifest)().GUID), Nothing, False, False)
t.Responser = New Response
t.SetEnvironment(Settings(InstagramSiteKey), Nothing, False, False)
t.Responser = New Responser
t.Responser.Copy(r)
t._SavedPostsIDs.Add(PID)
t.PostsToReparse.Add(New PostKV With {.ID = PID})
t.DownloadPosts(Nothing)
Return ListAddList(Nothing, t._TempMediaList)
End Using
@@ -676,12 +896,21 @@ Namespace API.Instagram
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Instagram standalone downloader: fetch media error")
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, $"Instagram standalone downloader: fetch media error ({URL})")
End Try
End Function
#End Region
#Region "IDisposable Support"
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)
End Sub
#End Region
End Class
End Namespace

View File

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

View File

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

View File

@@ -0,0 +1,105 @@
' 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 UTypes = SCrawler.API.Base.UserMedia.Types
Imports Converters = PersonalUtilities.Functions.SymbolsConverter.Converters
Namespace API.LPSG
Friend Class UserData : Inherits UserDataBase
Private Const Name_LatestPage As String = "LatestPage"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
If Loading Then
LatestPage = Container.Value(Name_LatestPage)
Else
Container.Add(Name_LatestPage, LatestPage)
End If
End Sub
Private Property LatestPage As String = String.Empty
Private Enum Mode : Internal : External : End Enum
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
Responser.DeclaredError = EDP.ThrowException
Dim NextPage$
Dim r$
Dim _LPage As Func(Of String) = Function() If(LatestPage.IsEmptyString, String.Empty, $"page-{LatestPage}")
Do
URL = $"https://www.lpsg.com/threads/{Name}/{_LPage.Invoke}"
r = Responser.GetResponse(URL)
UserExists = True
UserSuspended = False
ThrowAny(Token)
If Not r.IsEmptyString Then
NextPage = RegexReplace(r, NextPageRegex)
UpdateMediaList(RegexReplace(r, PhotoRegEx), Mode.Internal)
UpdateMediaList(RegexReplace(r, PhotoRegExExt), Mode.External)
If NextPage = LatestPage Or NextPage.IsEmptyString Then Exit Do Else LatestPage = NextPage
Else
Exit Do
End If
Loop
If _TempMediaList.ListExists And _ContentList.ListExists Then _
_TempMediaList.RemoveAll(Function(m) _ContentList.Exists(Function(mm) mm.URL = m.URL))
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Private Sub UpdateMediaList(ByVal l As List(Of String), ByVal m As Mode)
If l.ListExists Then
Dim f As SFile
Dim u$
Dim exists As Boolean
Dim r As RParams
Dim ude As New ErrorsDescriber(EDP.ReturnValue)
For Each url$ In l
If Not url.IsEmptyString Then u = SymbolsConverter.Decode(url, {Converters.HTML, Converters.ASCII}, ude) Else u = String.Empty
If Not u.IsEmptyString Then
exists = Not IsEmptyString(RegexReplace(u, FileExistsRegEx))
If m = Mode.Internal Then
r = FileRegEx
Else
r = FileRegExExt
If Not exists Then
r = FileRegExExt2
exists = Not IsEmptyString(RegexReplace(u, FileRegExExt2))
End If
End If
If exists Then
f = CStr(RegexReplace(u, r))
f.Path = MyFile.CutPath.PathNoSeparator
f.Separator = "\"
If f.Extension.IsEmptyString Then f.Extension = "jpg"
_TempMediaList.ListAddValue(New UserMedia With {.Type = UTypes.Picture, .URL = url, .File = f}, TempListAddParams)
End If
End If
Next
End If
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
With Responser : .Mode = Responser.Modes.WebClient : .ResetStatus() : End With
UseResponserClient = True
DownloadContentDefault(Token)
End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = Net.HttpStatusCode.ServiceUnavailable Then
MyMainLOG = $"{ToStringForLog()}: LPSG not available"
Return 1
Else
Return 0
End If
End Function
End Class
End Namespace

View File

@@ -0,0 +1,44 @@
' 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)
Friend ReadOnly HtmlConverter As Func(Of String, String) = Function(Input) SymbolsConverter.HTML.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

@@ -0,0 +1,118 @@
' 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
<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()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Me.CH_DOWN_GIFS = New System.Windows.Forms.CheckBox()
Me.CH_DOWN_PHOTO_MODELHUB = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(278, 52)
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(278, 77)
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.CH_DOWN_PHOTO_MODELHUB, 0, 1)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 3
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 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(278, 52)
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.Size = New System.Drawing.Size(270, 19)
Me.CH_DOWN_GIFS.TabIndex = 0
Me.CH_DOWN_GIFS.Text = "Download gifs"
Me.CH_DOWN_GIFS.UseVisualStyleBackColor = True
'
'CH_DOWN_PHOTO_MODELHUB
'
Me.CH_DOWN_PHOTO_MODELHUB.AutoSize = True
Me.CH_DOWN_PHOTO_MODELHUB.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_PHOTO_MODELHUB.Location = New System.Drawing.Point(4, 30)
Me.CH_DOWN_PHOTO_MODELHUB.Name = "CH_DOWN_PHOTO_MODELHUB"
Me.CH_DOWN_PHOTO_MODELHUB.Size = New System.Drawing.Size(270, 19)
Me.CH_DOWN_PHOTO_MODELHUB.TabIndex = 1
Me.CH_DOWN_PHOTO_MODELHUB.Text = "Download photo only from ModelHub"
Me.CH_DOWN_PHOTO_MODELHUB.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(278, 77)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteResources.InstagramIcon_32
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(294, 116)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(294, 116)
Me.Name = "OptionsForm"
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()
Me.ResumeLayout(False)
End Sub
Private WithEvents CH_DOWN_GIFS As CheckBox
Private WithEvents CH_DOWN_PHOTO_MODELHUB As CheckBox
End Class
End Namespace

View File

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

View File

@@ -0,0 +1,34 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Forms
Namespace API.PornHub
Friend Class OptionsForm
Private WithEvents MyDefs As DefaultFormOptions
Private ReadOnly MyExchangeOptions As UserExchangeOptions
Friend Sub New(ByRef ExchangeOptions As UserExchangeOptions)
InitializeComponent()
MyExchangeOptions = ExchangeOptions
MyDefs = New DefaultFormOptions(Me, Settings.Design)
End Sub
Private Sub MyForm_Load(sender As Object, e As EventArgs) Handles Me.Load
With MyDefs
.MyViewInitialize(True)
.AddOkCancelToolbar()
CH_DOWN_GIFS.Checked = MyExchangeOptions.DownloadGifs
CH_DOWN_PHOTO_MODELHUB.Checked = MyExchangeOptions.DownloadPhotoOnlyFromModelHub
.EndLoaderOperations()
End With
End Sub
Private Sub MyDefs_ButtonOkClick(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonOkClick
MyExchangeOptions.DownloadGifs = CH_DOWN_GIFS.Checked
MyExchangeOptions.DownloadPhotoOnlyFromModelHub = CH_DOWN_PHOTO_MODELHUB.Checked
MyDefs.CloseForm()
End Sub
End Class
End Namespace

View File

@@ -0,0 +1,120 @@
' 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"
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 = HtmlConverter(ParamsArray(1)).StringRemoveWinForbiddenSymbols.StringTrim
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
Private _FriendlyName As String = String.Empty
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
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 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 = HtmlConverter(l3(1)).StringRemoveWinForbiddenSymbols.StringTrim
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 = HtmlConverter(albumName).StringRemoveWinForbiddenSymbols.StringTrim
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

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

View File

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

View File

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

View File

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

View File

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

View File

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

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