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
This commit is contained in:
Andy
2022-10-18 12:05:31 +03:00
parent d91ee72eaa
commit f5c156b8e5
194 changed files with 6229 additions and 11329 deletions

1
.gitignore vendored
View File

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

View File

@@ -8,7 +8,6 @@ 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. 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:
@@ -21,7 +20,6 @@ I welcome requests! Follow these steps to contribute:
**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).
@@ -38,16 +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)
[![discord](https://img.shields.io/badge/discord-AndyProgram%233804-yellowgreen)](https://discordapp.com/users/1012768226679206009) AndyProgram#3804
- Tumblr

View File

@@ -1,3 +1,38 @@
# 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*

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,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.

Before

Width:  |  Height:  |  Size: 574 KiB

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: 370 KiB

After

Width:  |  Height:  |  Size: 363 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 381 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 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: 3.6 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: 10 KiB

After

Width:  |  Height:  |  Size: 11 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 15 KiB

After

Width:  |  Height:  |  Size: 16 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 10 KiB

After

Width:  |  Height:  |  Size: 11 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 10 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 7.6 KiB

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 27 KiB

After

Width:  |  Height:  |  Size: 28 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 5.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 13 KiB

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.6 KiB

View File

@@ -6,7 +6,7 @@
[![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, XVIDEOS, LPSG).
**If you like SCrawler, please like the program on [this site]( https://alternativeto.net/software/scrawler/about/)**
@@ -21,14 +21,11 @@ Do you like this program? Consider adding to my coffee fund by making a donation
# 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**));
- Redgifs videos (https://www.redgifs.com/);
- Twitter images and videos;
- Instagram images and videos;
- Instagram tagged posts;
- Instagram stories;
- Instagram images and videos, tagged posts, stories;
- TikTok videos ([limited](https://github.com/AAndyProgram/SCrawler/wiki/Settings#tiktok-limits));
- Imgur images, galleries and videos;
- Gfycat videos;
- [Other](#supported-sites) supported sites
@@ -55,6 +52,7 @@ 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
@@ -62,7 +60,9 @@ Do you like this program? Consider adding to my coffee fund by making a donation
- 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.
@@ -74,8 +74,6 @@ The program parses all user posts, obtain MD5 images hash and compares them wit
The program parses all user posts and compares file names with existing ones to remove duplicates. Then the media will be downloaded.
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
@@ -83,12 +81,33 @@ 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)
- [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
@@ -117,22 +136,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), [Hash](https://github.com/AAndyProgram/SCrawler/wiki/Settings#instagram) and [authorization headers](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-instagram-authorization-headers) for **Instagram** (if you want to download data from Instagram), [Hash 2](https://github.com/AAndyProgram/SCrawler/wiki/Settings#how-to-find-instagram-hash-2) for **saved Instagram posts**
**[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)
@@ -145,9 +151,3 @@ 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)
[![discord](https://img.shields.io/badge/discord-AndyProgram%233804-yellowgreen)](https://discordapp.com/users/1012768226679206009) AndyProgram#3804

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
@@ -21,7 +21,7 @@ Namespace Plugin
Function GetUserUrl(ByVal UserName As String, 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 UserID As String, ByVal PostID As String) As String
#Region "XML Support"
@@ -32,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.9.17.0")>
<Assembly: AssemblyFileVersion("2022.9.17.0")>
<Assembly: AssemblyVersion("2022.10.18.0")>
<Assembly: AssemblyFileVersion("2022.10.18.0")>
<Assembly: NeutralResourcesLanguage("en")>

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

@@ -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
@@ -25,7 +25,7 @@ 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)
With .User : u.IsChannel = .IsChannel : u.UpdateUserFile() : End With
@@ -45,7 +45,7 @@ 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"

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
@@ -56,6 +56,10 @@ Namespace API.Base
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
@@ -90,7 +94,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})]")
End Try
End Function
Protected ImageVideoContains As String = String.Empty
@@ -101,17 +105,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,24 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Base
Friend Module Structures
Friend Structure UserMedia : Implements IEquatable(Of UserMedia)
Friend Structure UserMedia : Implements IEquatable(Of UserMedia), IEContainerProvider
#Region "XML Names"
Friend Const Name_MediaNode As String = "MediaData"
Private Const Name_MediaType As String = "Type"
Private Const Name_MediaState As String = "State"
Private Const Name_MediaAttempts As String = "Attempts"
Private Const Name_MediaURL As String = "URL"
Private Const Name_MediaHash As String = "Hash"
Private Const Name_MediaFile As String = "File"
Private Const Name_MediaPostID As String = "ID"
Private Const Name_MediaPostDate As String = "Date"
Private Const Name_SpecialFolder As String = "SpecialFolder"
#End Region
Friend Enum Types As Integer
Undefined = 0
[Picture] = 1
@@ -33,27 +48,54 @@ Namespace API.Base
''' SomeFolder\SomeFolder2
''' </summary>
Friend SpecialFolder As String
Friend Sub New(ByVal _URL As String)
URL = _URL
URL_BASE = _URL
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
Attempts = m.Attempts
[Type] = m.ContentType
URL = m.URL
URL_BASE = URL
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
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)
@@ -61,6 +103,17 @@ 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
@@ -83,6 +136,19 @@ Namespace API.Base
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>
@@ -116,7 +182,7 @@ Namespace API.Base
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
@@ -128,6 +194,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

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
@@ -51,14 +51,12 @@ Namespace API.Base
#Region "Collection buttons"
Private _CollectionButtonsExists As Boolean = False
Private _CollectionButtonsColorsSet As Boolean = False
Friend InternalCollectionIndex As Integer = -1
Friend WithEvents BTT_CONTEXT_DOWN As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_DOWN As ToolStripKeyMenuItem
Friend WithEvents BTT_CONTEXT_EDIT As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_DELETE As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_OPEN_PATH As ToolStripMenuItem
Friend WithEvents BTT_CONTEXT_OPEN_SITE As ToolStripMenuItem
Friend Sub CreateButtons(ByVal CollectionIndex As Integer)
InternalCollectionIndex = CollectionIndex
Friend Sub CreateButtons()
Dim tn$ = $"[{Site}] - {Name}"
Dim _tn$ = $"{Site}{Name}"
Dim tnn As Func(Of String, String) = Function(Input) $"{Input}{_tn}"
@@ -70,11 +68,11 @@ Namespace API.Base
i = .Image
End If
End With
BTT_CONTEXT_DOWN = New ToolStripMenuItem(tn, i) With {.Name = tnn("DOWN"), .Tag = CollectionIndex}
BTT_CONTEXT_EDIT = New ToolStripMenuItem(tn, i) With {.Name = tnn("EDIT"), .Tag = CollectionIndex}
BTT_CONTEXT_DELETE = New ToolStripMenuItem(tn, i) With {.Name = tnn("DELETE"), .Tag = CollectionIndex}
BTT_CONTEXT_OPEN_PATH = New ToolStripMenuItem(tn, i) With {.Name = tnn("PATH"), .Tag = CollectionIndex}
BTT_CONTEXT_OPEN_SITE = New ToolStripMenuItem(tn, i) With {.Name = tnn("SITE"), .Tag = CollectionIndex}
BTT_CONTEXT_DOWN = New ToolStripKeyMenuItem(tn, i) With {.Name = tnn("DOWN"), .Tag = Me}
BTT_CONTEXT_EDIT = New ToolStripMenuItem(tn, i) With {.Name = tnn("EDIT"), .Tag = Me}
BTT_CONTEXT_DELETE = New ToolStripMenuItem(tn, i) With {.Name = tnn("DELETE"), .Tag = Me}
BTT_CONTEXT_OPEN_PATH = New ToolStripMenuItem(tn, i) With {.Name = tnn("PATH"), .Tag = Me}
BTT_CONTEXT_OPEN_SITE = New ToolStripMenuItem(tn, i) With {.Name = tnn("SITE"), .Tag = Me}
UpdateButtonsColor()
_CollectionButtonsExists = True
If _UserInformationLoaded Then _CollectionButtonsColorsSet = True
@@ -125,16 +123,6 @@ Namespace API.Base
Private Const Name_ScriptData As String = "ScriptData"
Private Const Name_DataMerging As String = "DataMerging"
#Region "Downloaded data"
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"
#End Region
#End Region
#Region "Declarations"
#Region "Host, Site, Progress, Self"
@@ -320,7 +308,7 @@ BlockNullPicture:
Friend Property SeparateVideoFolder As Boolean?
Protected ReadOnly Property SeparateVideoFolderF As Boolean
Get
Return (SeparateVideoFolder.HasValue AndAlso SeparateVideoFolder.Value) OrElse Settings.SeparateVideoFolder.Value
Return If(SeparateVideoFolder, Settings.SeparateVideoFolder.Value)
End Get
End Property
#End Region
@@ -466,7 +454,10 @@ BlockNullPicture:
End Get
End Property
Friend Overridable Function GetUserInformation() As String
Dim OutStr$ = $"User: {Name}"
Dim OutStr$ = $"User: {Name} (site: {Site}"
If IncludedInCollection Then OutStr &= $"; collection: {CollectionName}"
OutStr &= ")"
OutStr.StringAppendLine($"Labels: {Labels.ListToString}")
OutStr.StringAppendLine($"Path: {MyFile.CutPath.Path}")
OutStr.StringAppendLine($"Total downloaded ({DownloadedTotal(True).NumToString(ANumbers.Formats.Number, 3)}):")
OutStr.StringAppendLine($"Pictures: {DownloadedPictures(True).NumToString(ANumbers.Formats.Number, 3)}")
@@ -731,25 +722,7 @@ BlockNullPicture:
Using x As New XmlFile(MyFileData, Protector.Modes.All, False) With {.XmlReadOnly = True, .AllowSameNames = True}
x.LoadData()
If x.Count > 0 Then
Dim fs$ = MyFile.CutPath.PathWithSeparator
Dim gfn As Func(Of String, String) = Function(Input) If(Input.IsEmptyString, String.Empty,
If(Input.Contains("\"), Input.CSFile.File, Input))
For Each v As EContainer In x
_ContentList.Add(New UserMedia With {
.Type = v.Attribute(Name_MediaType).Value.FromXML(Of Integer)(CInt(UTypes.Undefined)),
.State = v.Attribute(Name_MediaState).Value.FromXML(Of Integer)(CInt(UStates.Downloaded)),
.Attempts = v.Attribute(Name_MediaAttempts).Value.FromXML(Of Integer)(0),
.URL = v.Attribute(Name_MediaURL).Value,
.URL_BASE = v.Value,
.MD5 = v.Attribute(Name_MediaHash).Value,
.File = fs & gfn.Invoke(v.Attribute(Name_MediaFile).Value),
.Post = New UserPost With {
.ID = v.Attribute(Name_MediaPostID).Value,
.[Date] = AConvert(Of Date)(v.Attribute(Name_MediaPostDate).Value, ParsersDataDateProvider, Nothing)
}
})
Next
For Each v As EContainer In x : _ContentList.Add(New UserMedia(v, Me)) : Next
End If
_DataLoaded = True
End Using
@@ -763,21 +736,7 @@ BlockNullPicture:
If MyFileData.IsEmptyString Then Exit Sub
MyFileData.Exists(SFO.Path)
Using x As New XmlFile With {.AllowSameNames = True, .Name = "Data"}
If _ContentList.Count > 0 Then
For Each i As UserMedia In _ContentList
x.Add(New EContainer("MediaData", i.URL_BASE, {New EAttribute(Name_MediaType, CInt(i.Type)),
New EAttribute(Name_MediaState, CInt(i.State)),
New EAttribute(Name_MediaAttempts, i.Attempts),
New EAttribute(Name_MediaURL, i.URL),
New EAttribute(Name_MediaHash, i.MD5),
New EAttribute(Name_MediaFile, i.File.File),
New EAttribute(Name_MediaPostID, i.Post.ID),
New EAttribute(Name_MediaPostDate, AConvert(Of String)(i.Post.Date, ParsersDataDateProvider, String.Empty))
}
)
)
Next
End If
If _ContentList.Count > 0 Then x.AddRange(_ContentList)
x.Save(MyFileData)
End Using
Catch ex As Exception
@@ -803,6 +762,7 @@ BlockNullPicture:
#Region "Download limits"
Protected Enum DateResult : [Continue] : [Skip] : [Exit] : End Enum
Friend Overridable Property DownloadTopCount As Integer? = Nothing Implements IUserData.DownloadTopCount, IPluginContentProvider.PostsNumberLimit
Friend Overridable Property IncludeInTheFeed As Boolean = True
Private _DownloadDateFrom As Date? = Nothing
Private _DownloadDateFromF As Date
Friend Overridable Property DownloadDateFrom As Date? Implements IUserData.DownloadDateFrom, IPluginContentProvider.DownloadDateFrom
@@ -825,10 +785,10 @@ BlockNullPicture:
If _DownloadDateTo.HasValue Then _DownloadDateToF = _DownloadDateTo.Value Else _DownloadDateToF = Date.MaxValue.Date
End Set
End Property
Protected Function CheckDatesLimit(ByVal DateString As String, ByVal DateProvider As IFormatProvider) As DateResult
Protected Function CheckDatesLimit(ByVal DateObj As Object, ByVal DateProvider As IFormatProvider) As DateResult
Try
If (DownloadDateFrom.HasValue Or DownloadDateTo.HasValue) And Not DateString.IsEmptyString Then
Dim td As Date? = AConvert(Of Date)(DateString, DateProvider, Nothing)
If (DownloadDateFrom.HasValue Or DownloadDateTo.HasValue) AndAlso ACheck(DateObj) Then
Dim td As Date? = AConvert(Of Date)(DateObj, DateProvider, Nothing)
If td.HasValue Then
If td.Value.ValueBetween(_DownloadDateFromF, _DownloadDateToF) Then
Return DateResult.Continue
@@ -841,12 +801,13 @@ BlockNullPicture:
End If
Return DateResult.Continue
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[UserDataBase.CheckDatesLimit({DateString})]", DateResult.Continue)
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[UserDataBase.CheckDatesLimit({If(TypeOf DateObj Is String, CStr(DateObj), "?")})]", DateResult.Continue)
End Try
End Function
#End Region
#Region "Download functions and options"
Protected Responser As Response
Protected UseResponserClient As Boolean = False
Friend Overridable Sub DownloadData(ByVal Token As CancellationToken) Implements IContentProvider.DownloadData
Dim Canceled As Boolean = False
_ExternalCompatibilityToken = Token
@@ -878,11 +839,10 @@ BlockNullPicture:
ThrowAny(Token)
DownloadDataF(Token)
ThrowAny(Token)
If Settings.ReparseMissingInTheRoutine Then ReparseMissing(Token) : ThrowAny(Token)
Else
'PENDING: UserDataBase ReparseMissing (DownloadDataF)
'ReparseMissing(Token)
ReparseMissing(Token)
End If
'_TempMediaList.ListAddList(ContentMissing, LNC)
If _TempMediaList.Count > 0 Then
If Not DownloadImages Then _TempMediaList.RemoveAll(Function(m) m.Type = UTypes.GIF Or m.Type = UTypes.Picture)
@@ -893,7 +853,8 @@ BlockNullPicture:
ReparseVideo(Token)
ThrowAny(Token)
If _TempPostsList.Count > 0 And __SaveData Then TextSaver.SaveTextToFile(_TempPostsList.ListToString(Environment.NewLine), MyFilePosts, True,, EDP.None)
If _TempPostsList.Count > 0 And Not DownloadMissingOnly And __SaveData Then _
TextSaver.SaveTextToFile(_TempPostsList.ListToString(Environment.NewLine), MyFilePosts, True,, EDP.None)
_ContentNew.ListAddList(_TempMediaList, LAP.ClearBeforeAdd)
DownloadContent(Token)
ThrowIfDisposed()
@@ -954,9 +915,50 @@ BlockNullPicture:
Protected MustOverride Sub DownloadDataF(ByVal Token As CancellationToken)
Protected Overridable Sub ReparseVideo(ByVal Token As CancellationToken)
End Sub
''' <summary>
''' Missing posts must be collected from [<see cref="_ContentList"/>].<br/>
''' Reparsed post must be added to [<see cref="_TempMediaList"/>].<br/>
''' At the end of the function, reparsed posts must be removed from [<see cref="_ContentList"/>].
''' </summary>
Protected Overridable Sub ReparseMissing(ByVal Token As CancellationToken)
End Sub
Protected MustOverride Sub DownloadContent(ByVal Token As CancellationToken)
Private NotInheritable Class OptionalWebClient : Implements IDisposable
Private ReadOnly WC As WebClient
Private ReadOnly RC As Response
Private ReadOnly RCERROR As New ErrorsDescriber(EDP.ThrowException)
Private ReadOnly UseResponserClient As Boolean
Friend Sub New(ByRef Source As UserDataBase)
UseResponserClient = Source.UseResponserClient
If UseResponserClient Then
RC = Source.Responser
Else
WC = New WebClient
End If
End Sub
Friend Sub DownloadFile(ByVal URL As String, ByVal File As String)
If UseResponserClient Then
RC.DownloadFile(URL, File, RCERROR)
Else
WC.DownloadFile(URL, File)
End If
End Sub
#Region "IDisposable Support"
Private disposedValue As Boolean = False
Protected Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing And Not WC Is Nothing Then WC.Dispose()
disposedValue = True
End Sub
Protected Overrides Sub Finalize()
Dispose(False)
MyBase.Finalize()
End Sub
Friend Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
Protected Sub DownloadContentDefault(ByVal Token As CancellationToken)
Try
Dim i%
@@ -972,7 +974,8 @@ BlockNullPicture:
Dim __isVideo As Boolean
Dim f As SFile
Dim v As UserMedia
Using w As New WebClient
Using w As New OptionalWebClient(Me)
If vsf Then SFileShares.SFileExists($"{MyDir}\Video\", SFO.Path)
Progress.Maximum += _ContentNew.Count
For i = 0 To _ContentNew.Count - 1
@@ -989,7 +992,7 @@ BlockNullPicture:
If v.URL_BASE.IsEmptyString Then v.URL_BASE = v.URL
If Not v.File.IsEmptyString And Not v.URL_BASE.IsEmptyString Then
If Not v.File.IsEmptyString And Not v.URL.IsEmptyString Then
Try
__isVideo = v.Type = UTypes.Video Or f.Extension = "mp4"
@@ -1011,7 +1014,13 @@ BlockNullPicture:
f.Path = $"{f.PathWithSeparator}Video"
If Not v.SpecialFolder.IsEmptyString Then f.Exists(SFO.Path)
End If
w.DownloadFile(v.URL_BASE, f.ToString)
If v.Type = UTypes.m3u8 And UseInternalM3U8Function Then
f = DownloadM3U8(v.URL, v, f)
If f.IsEmptyString Then Throw New Exception("M3U8 download failed")
Else
w.DownloadFile(v.URL, f.ToString)
End If
If __isVideo Then
v.Type = UTypes.Video
@@ -1027,7 +1036,7 @@ BlockNullPicture:
Catch wex As Exception
v.Attempts += 1
v.State = UStates.Missing
If MissingErrorsAdd Then ErrorDownloading(f, v.URL_BASE)
If MissingErrorsAdd Then ErrorDownloading(f, v.URL)
End Try
Else
v.State = UStates.Skipped
@@ -1052,15 +1061,25 @@ BlockNullPicture:
HasError = True
End Try
End Sub
Protected UseInternalM3U8Function As Boolean = False
Protected Overridable Function DownloadM3U8(ByVal URL As String, ByVal Media As UserMedia, ByVal DestinationFile As SFile) As SFile
Return Nothing
End Function
''' <param name="RDE">Request DownloadingException</param>
Protected Sub ProcessException(ByVal ex As Exception, ByVal Token As CancellationToken, ByVal Message As String, Optional ByVal RDE As Boolean = True)
''' <returns>0 - exit</returns>
Protected Function ProcessException(ByVal ex As Exception, ByVal Token As CancellationToken, ByVal Message As String, Optional ByVal RDE As Boolean = True, Optional ByVal EObj As Object = Nothing) As Integer
If Not ((TypeOf ex Is OperationCanceledException And Token.IsCancellationRequested) Or
(TypeOf ex Is ObjectDisposedException And Disposed)) Then
If RDE AndAlso DownloadingException(ex, Message, True) = 0 Then LogError(ex, Message) : HasError = True
If RDE Then
Dim v% = DownloadingException(ex, Message, True, EObj)
If v = 0 Then LogError(ex, Message) : HasError = True
Return v
End If
End If
End Sub
Return 0
End Function
''' <summary>0 - Execute LogError and set HasError</summary>
Protected MustOverride Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
Protected MustOverride Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False, Optional ByVal EObj As Object = Nothing) As Integer
Protected Function ChangeFileNameByProvider(ByVal f As SFile, ByVal m As UserMedia) As SFile
Dim ff As SFile = Nothing
Try
@@ -1102,7 +1121,7 @@ BlockNullPicture:
End Sub
#End Region
#Region "Delete, Move, Merge, Copy"
Friend Overridable Function Delete() As Integer Implements IUserData.Delete
Friend Overridable Function Delete(Optional ByVal Multiple As Boolean = False) As Integer Implements IUserData.Delete
Dim f As SFile = SFile.GetPath(MyFile.CutPath.Path)
If f.Exists(SFO.Path, False) AndAlso (User.Merged OrElse f.Delete(SFO.Path, Settings.DeleteMode)) Then
If Not IncludedInCollection Then MainFrameObj.ImageHandler(Me, False)
@@ -1270,7 +1289,7 @@ BlockNullPicture:
#End Region
#Region "Errors functions"
Protected Sub LogError(ByVal ex As Exception, ByVal Message As String)
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"{IIf(IncludedInCollection, $"{CollectionName}-", String.Empty)}{Site} - {Name}: {Message}")
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"{ToStringForLog()}: {Message}")
End Sub
Protected Sub ErrorDownloading(ByVal f As SFile, ByVal URL As String)
If Not f.Exists Then MyMainLOG = $"Error downloading from [{URL}] to [{f}]"
@@ -1285,11 +1304,14 @@ BlockNullPicture:
End Sub
''' <exception cref="OperationCanceledException"></exception>
''' <exception cref="ObjectDisposedException"></exception>
Friend Overloads Sub ThrowAny(ByVal Token As CancellationToken)
Friend Overridable Overloads Sub ThrowAny(ByVal Token As CancellationToken)
Token.ThrowIfCancellationRequested()
ThrowIfDisposed()
End Sub
#End Region
Protected Function ToStringForLog() As String
Return $"{IIf(IncludedInCollection, $"[{CollectionName}] - ", String.Empty)}[{Site}] - {Name}"
End Function
Public Overrides Function ToString() As String
If IsCollection Then
Return CollectionName
@@ -1308,8 +1330,8 @@ BlockNullPicture:
Return hcStr.GetHashCode
End Function
#Region "Buttons actions"
Private Sub BTT_CONTEXT_DOWN_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_DOWN.Click
Downloader.Add(Me)
Private Sub BTT_CONTEXT_DOWN_KeyClick(sender As Object, e As MyKeyEventArgs) Handles BTT_CONTEXT_DOWN.KeyClick
Downloader.Add(Me, e.IncludeInTheFeed)
End Sub
Private Sub BTT_CONTEXT_EDIT_Click(sender As Object, e As EventArgs) Handles BTT_CONTEXT_EDIT.Click
Using f As New Editors.UserCreatorForm(Me)
@@ -1439,7 +1461,7 @@ BlockNullPicture:
''' 2 - Collection removed<br/>
''' 3 - Collection split
''' </summary>
Function Delete() As Integer
Function Delete(Optional ByVal Multiple As Boolean = False) As Integer
Function MoveFiles(ByVal CollectionName As String) As Boolean
Function CopyFiles(ByVal DestinationPath As SFile, Optional ByVal e As ErrorsDescriber = Nothing) As Boolean
Sub OpenFolder()

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 PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WebDocuments.JSON
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
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 + EDP.ReturnValue, 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

@@ -0,0 +1,135 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Namespace API.Instagram
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class AdditionalSettingsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Private components As System.ComponentModel.IContainer
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim CONTAINER_MAIN As System.Windows.Forms.ToolStripContainer
Dim TP_MAIN As System.Windows.Forms.TableLayoutPanel
Me.CH_DOWN_TIME = New System.Windows.Forms.CheckBox()
Me.CH_DOWN_TAG = New System.Windows.Forms.CheckBox()
Me.CH_DOWN_SAVED = New System.Windows.Forms.CheckBox()
CONTAINER_MAIN = New System.Windows.Forms.ToolStripContainer()
TP_MAIN = New System.Windows.Forms.TableLayoutPanel()
CONTAINER_MAIN.ContentPanel.SuspendLayout()
CONTAINER_MAIN.SuspendLayout()
TP_MAIN.SuspendLayout()
Me.SuspendLayout()
'
'CONTAINER_MAIN
'
'
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(TP_MAIN)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(234, 78)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
CONTAINER_MAIN.Name = "CONTAINER_MAIN"
CONTAINER_MAIN.RightToolStripPanelVisible = False
CONTAINER_MAIN.Size = New System.Drawing.Size(234, 103)
CONTAINER_MAIN.TabIndex = 0
CONTAINER_MAIN.TopToolStripPanelVisible = False
'
'TP_MAIN
'
TP_MAIN.CellBorderStyle = System.Windows.Forms.TableLayoutPanelCellBorderStyle.[Single]
TP_MAIN.ColumnCount = 1
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Absolute, 20.0!))
TP_MAIN.Controls.Add(Me.CH_DOWN_TIME, 0, 0)
TP_MAIN.Controls.Add(Me.CH_DOWN_TAG, 0, 1)
TP_MAIN.Controls.Add(Me.CH_DOWN_SAVED, 0, 2)
TP_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
TP_MAIN.Location = New System.Drawing.Point(0, 0)
TP_MAIN.Name = "TP_MAIN"
TP_MAIN.RowCount = 4
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Absolute, 25.0!))
TP_MAIN.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 100.0!))
TP_MAIN.Size = New System.Drawing.Size(234, 78)
TP_MAIN.TabIndex = 0
'
'CH_DOWN_TIME
'
Me.CH_DOWN_TIME.AutoSize = True
Me.CH_DOWN_TIME.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_TIME.Location = New System.Drawing.Point(4, 4)
Me.CH_DOWN_TIME.Name = "CH_DOWN_TIME"
Me.CH_DOWN_TIME.Size = New System.Drawing.Size(226, 19)
Me.CH_DOWN_TIME.TabIndex = 0
Me.CH_DOWN_TIME.Text = "Download Timeline"
Me.CH_DOWN_TIME.UseVisualStyleBackColor = True
'
'CH_DOWN_TAG
'
Me.CH_DOWN_TAG.AutoSize = True
Me.CH_DOWN_TAG.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_TAG.Location = New System.Drawing.Point(4, 30)
Me.CH_DOWN_TAG.Name = "CH_DOWN_TAG"
Me.CH_DOWN_TAG.Size = New System.Drawing.Size(226, 19)
Me.CH_DOWN_TAG.TabIndex = 1
Me.CH_DOWN_TAG.Text = "Download Stories and Tagged data"
Me.CH_DOWN_TAG.UseVisualStyleBackColor = True
'
'CH_DOWN_SAVED
'
Me.CH_DOWN_SAVED.AutoSize = True
Me.CH_DOWN_SAVED.Dock = System.Windows.Forms.DockStyle.Fill
Me.CH_DOWN_SAVED.Location = New System.Drawing.Point(4, 56)
Me.CH_DOWN_SAVED.Name = "CH_DOWN_SAVED"
Me.CH_DOWN_SAVED.Size = New System.Drawing.Size(226, 19)
Me.CH_DOWN_SAVED.TabIndex = 2
Me.CH_DOWN_SAVED.Text = "Download saved posts"
Me.CH_DOWN_SAVED.UseVisualStyleBackColor = True
'
'AdditionalSettingsForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(234, 103)
Me.Controls.Add(CONTAINER_MAIN)
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
Me.Icon = Global.SCrawler.My.Resources.SiteResources.InstagramIcon_32
Me.KeyPreview = True
Me.MaximizeBox = False
Me.MaximumSize = New System.Drawing.Size(250, 142)
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(250, 142)
Me.Name = "AdditionalSettingsForm"
Me.ShowInTaskbar = False
Me.SizeGripStyle = System.Windows.Forms.SizeGripStyle.Hide
Me.Text = "Additional settings"
CONTAINER_MAIN.ContentPanel.ResumeLayout(False)
CONTAINER_MAIN.ResumeLayout(False)
CONTAINER_MAIN.PerformLayout()
TP_MAIN.ResumeLayout(False)
TP_MAIN.PerformLayout()
Me.ResumeLayout(False)
End Sub
Private WithEvents CH_DOWN_TIME As CheckBox
Private WithEvents CH_DOWN_TAG As CheckBox
Private WithEvents CH_DOWN_SAVED As CheckBox
End Class
End Namespace

View File

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

View File

@@ -1,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,6 +10,7 @@ Imports PersonalUtilities.Functions.RegularExpressions
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 CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v))
End Module

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

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

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' 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,24 +10,23 @@ Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.XML.Base
Imports PersonalUtilities.Functions.RegularExpressions
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), SpecialForm(True)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#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
@@ -78,23 +77,23 @@ Namespace API.Instagram
End Class
#End Region
#Region "Authorization properties"
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash", IsAuth:=True), PXML("InstaHash"), ControlNumber(0)>
<PropertyOption(ControlText:="Hash", ControlToolTip:="Instagram session hash", IsAuth:=True, AllowNull:=False), PXML("InstaHash"), ControlNumber(0)>
Friend ReadOnly Property Hash As PropertyValue
<PropertyOption(ControlText:="Hash 2", ControlToolTip:="Instagram session hash for saved posts", IsAuth:=True), PXML("InstaHashSavedPosts"), ControlNumber(1)>
Private Const HashSavedPosts_Text As String = "Hash 2"
<PropertyOption(ControlText:=HashSavedPosts_Text, ControlToolTip:="Instagram session hash for saved posts", IsAuth:=True), PXML("InstaHashSavedPosts"), ControlNumber(1)>
Friend ReadOnly Property HashSavedPosts As PropertyValue
<PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Instagram token for tagged data", IsAuth:=True), ControlNumber(2)>
<PropertyOption(ControlText:="x-csrftoken", ControlToolTip:="Instagram token for tagged data", IsAuth:=True, AllowNull:=False), ControlNumber(2)>
Friend ReadOnly Property CSRF_TOKEN As PropertyValue
<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)>
Private Const SavedPostsUserName_Text As String = "Saved posts user"
<PropertyOption(ControlText:=SavedPostsUserName_Text, IsAuth:=True), PXML("SavedPostsUserName"), ControlNumber(5)>
Friend ReadOnly Property SavedPostsUserName As PropertyValue
Friend ReadOnly Property BaseAuthExists As Boolean
Get
Return Responser.Cookies.Count > 0 And ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value)
End Get
End Property
Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 And ACheck(IG_APP_ID.Value) And ACheck(IG_WWW_CLAIM.Value) And ACheck(CSRF_TOKEN.Value)
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"
@@ -138,11 +137,17 @@ Namespace API.Instagram
<Provider(NameOf(TaggedNotifyLimit), FieldsChecker:=True)>
Private ReadOnly Property TaggedNotifyLimitProvider As IFormatProvider
#End Region
#Region "Download ready"
Friend ReadOnly Property DownloadTimeline As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadStoriesTagged As XMLValue(Of Boolean)
Friend ReadOnly Property DownloadSaved As XMLValue(Of Boolean)
#End Region
#Region "429 bypass"
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
@@ -186,7 +191,6 @@ Namespace API.Instagram
End With
End Sub
#End Region
Private Initialized As Boolean = False
#End Region
#Region "Initializer"
Friend Sub New(ByRef _XML As XmlFile, ByVal GlobalPath As SFile)
@@ -204,6 +208,10 @@ Namespace API.Instagram
If .ContainsKey(Header_IG_WWW_CLAIM) Then www_claim = .Item(Header_IG_WWW_CLAIM)
End With
End If
If Not .Cookies Is Nothing Then
.Cookies.ChangedAllowInternalDrop = False
.Cookies.Changed = False
End If
End With
Dim n() As String = {SettingsCLS.Name_Node_Sites, Site.ToString}
@@ -216,6 +224,10 @@ Namespace API.Instagram
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 XMLValue(Of Boolean)("DownloadTimeline", True, _XML, n)
DownloadStoriesTagged = New XMLValue(Of Boolean)("DownloadStoriesTagged", True, _XML, n)
DownloadSaved = New XMLValue(Of Boolean)("DownloadSaved", True, _XML, n)
RequestsWaitTimer = New PropertyValue(1000)
RequestsWaitTimerProvider = New TimersChecker(100)
RequestsWaitTimerTaskCount = New PropertyValue(1)
@@ -239,11 +251,62 @@ Namespace API.Instagram
UserRegex = RParams.DMS("[htps:/]{7,8}.*?instagram.com/([^/]+)", 1)
ImageVideoContains = "instagram.com"
End Sub
Friend Overrides Sub BeginInit()
Private Structure LatestValues
Friend Hash As String
Friend Hash2 As String
Friend Token As String
Friend AppID As String
Friend WwwClaim As String
Friend Exists As Boolean
Friend Sub New(ByVal Source As SiteSettings)
Exists = True
With Source
Hash = AConvert(Of String)(.Hash.Value, String.Empty)
Hash2 = AConvert(Of String)(.HashSavedPosts.Value, String.Empty)
With .Responser.Headers
If .ContainsKey(Header_CSRF_TOKEN) Then Token = .Item(Header_CSRF_TOKEN)
If .ContainsKey(Header_IG_APP_ID) Then AppID = .Item(Header_IG_APP_ID)
If .ContainsKey(Header_IG_WWW_CLAIM) Then WwwClaim = .Item(Header_IG_WWW_CLAIM)
End With
End With
End Sub
End Structure
Private LV As LatestValues = Nothing
Private ASO As SettingsExchangeOptions = Nothing
Friend Overrides Sub BeginEdit()
LV = New LatestValues(Me)
ASO = Nothing
MyBase.BeginEdit()
End Sub
Friend Overrides Sub EndInit()
Initialized = True
MyBase.EndInit()
Friend Overrides Sub EndEdit()
LV = Nothing
ASO = Nothing
MyBase.EndEdit()
End Sub
Friend Overrides Sub Update()
If LV.Exists Then
Dim __lv As New LatestValues(Me)
If If(Responser.Cookies?.Count, 0) > 0 Then
Dim _cookiesChanged As Boolean = If(Responser.Cookies?.Changed, False)
If Not DownloadTimeline AndAlso (_cookiesChanged Or
(Not LV.Hash = __lv.Hash And Not __lv.Hash.IsEmptyString)) Then DownloadTimeline.Value = True
If Not DownloadSaved AndAlso (_cookiesChanged Or (Not LV.Hash2 = __lv.Hash2 And Not __lv.Hash2.IsEmptyString)) Then DownloadSaved.Value = True
If Not DownloadStoriesTagged AndAlso (
_cookiesChanged Or (
(Not LV.Hash = __lv.Hash Or Not LV.Token = __lv.Token Or Not LV.AppID = __lv.AppID Or Not LV.WwwClaim = __lv.WwwClaim) And
(Not __lv.Hash.IsEmptyString And Not __lv.Token.IsEmptyString And Not __lv.AppID.IsEmptyString And Not __lv.WwwClaim.IsEmptyString)
)) Then DownloadStoriesTagged.Value = True
End If
End If
If ASO.Changed Then
DownloadTimeline.Value = ASO.DownloadTimeline
DownloadStoriesTagged.Value = ASO.DownloadStoriesTagged
DownloadSaved.Value = ASO.DownloadSaved
End If
LV = Nothing
ASO = Nothing
If Not Responser.Cookies Is Nothing Then Responser.Cookies.Changed = False
MyBase.Update()
End Sub
#End Region
#Region "PropertiesDataChecker"
@@ -290,6 +353,37 @@ Namespace API.Instagram
End If
Return False
End Function
<PropertiesDataChecker({NameOf(HashSavedPosts), NameOf(SavedPostsUserName)})>
Private Function CheckSavedOptions(ByVal p As IEnumerable(Of PropertyData)) As Boolean
If p.ListExists Then
Const MsgTitle$ = "Saved posts credentials"
Dim __hash$ = String.Empty
Dim __name$ = String.Empty
Dim _OptionlErrorText$ = $"For download saved posts, you must to set both [{HashSavedPosts_Text}] and [{SavedPostsUserName_Text}]."
For i% = 0 To p.Count - 1
Select Case p(i).Name
Case NameOf(HashSavedPosts) : __hash = p(i).Value
Case NameOf(SavedPostsUserName) : __name = p(i).Value
End Select
Next
If __hash = __name Then
If __hash.IsEmptyString Then
Return True
Else
MsgBoxE({$"[{HashSavedPosts_Text}] and [{SavedPostsUserName_Text}] for saved posts cannot be equal!", MsgTitle}, vbCritical)
End If
Else
If __hash.IsEmptyString Then
MsgBoxE({$"[{HashSavedPosts_Text}] not set.{vbCr}{_OptionlErrorText}", MsgTitle}, vbCritical)
ElseIf __name.IsEmptyString Then
MsgBoxE({$"[{SavedPostsUserName_Text}] not set.{vbCr}{_OptionlErrorText}", MsgTitle}, vbCritical)
Else
Return True
End If
End If
End If
Return False
End Function
#End Region
#Region "Plugin functions"
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
@@ -303,11 +397,12 @@ Namespace API.Instagram
Return Nothing
End Function
#Region "Downloading"
Friend Property SkipUntilNextSession As Boolean = False
Friend Overrides Function ReadyToDownload(ByVal What As Download) As Boolean
If ActiveJobs < 2 AndAlso ReadyForDownload AndAlso BaseAuthExists Then
If ActiveJobs < 2 AndAlso Not SkipUntilNextSession AndAlso ReadyForDownload AndAlso BaseAuthExists() Then
Select Case What
Case Download.Main : Return ACheck(Hash.Value)
Case Download.SavedPosts : Return ACheck(HashSavedPosts.Value)
Case Download.Main : Return ACheck(Hash.Value) And DownloadTimeline
Case Download.SavedPosts : Return ACheck(HashSavedPosts.Value) And DownloadSaved
End Select
End If
Return False
@@ -346,10 +441,11 @@ Namespace API.Instagram
_NextTagged = True
LastDownloadDate.Value = Now
ActiveJobs -= 1
SkipUntilNextSession = False
End Sub
#End Region
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)
@@ -357,6 +453,12 @@ Namespace API.Instagram
Using f As New OptionsForm(Options) : f.ShowDialog() : End Using
End If
End Sub
Friend Overrides Sub OpenSettingsForm()
Using f As New AdditionalSettingsForm(If(ASO.Changed, ASO, New SettingsExchangeOptions(Me)))
f.ShowDialog()
If f.DialogResult = DialogResult.OK Then ASO = f.MyParameters
End Using
End Sub
#End Region
End Class
End 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,15 +6,14 @@
'
' 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.Messaging
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports SCrawler.API.Base
Imports System.Net
Imports System.Threading
Imports System.Reflection
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.Instagram
Friend Class UserData : Inherits UserDataBase
@@ -70,41 +69,58 @@ Namespace API.Instagram
End Sub
#End Region
#Region "Download data"
Private E560Thrown As Boolean = False
Private Class ExitException : Inherits Exception
Friend Shared Sub Throw560(ByRef Source As UserData)
If Not Source.E560Thrown Then
MyMainLOG = $"{Source.ToStringForLog}: (560) Download skipped until next session"
Source.E560Thrown = True
End If
Throw New ExitException
End Sub
Friend Sub New()
End Sub
Friend Sub New(ByRef CompleteArg As Boolean)
CompleteArg = True
End Sub
End Class
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim s As Sections = Sections.Timeline
Try
ThrowAny(Token)
_InstaHash = String.Empty
HasError = False
If Not LastCursor.IsEmptyString Then
DownloadData(LastCursor, Sections.Timeline, Token)
Dim fc As Boolean = IIf(IsSavedPosts, MySiteSettings.DownloadSaved.Value, MySiteSettings.DownloadTimeline.Value)
If fc 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 fc 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.BaseAuthExists Then
If MySiteSettings.DownloadSaved Then s = Sections.SavedPosts : DownloadPosts(Token)
ElseIf MySiteSettings.BaseAuthExists() Then
DownloadedTags = 0
If GetStories Then DownloadData(String.Empty, Sections.Stories, Token)
If GetTaggedData Then DownloadData(String.Empty, Sections.Tagged, Token)
If MySiteSettings.DownloadStoriesTagged And GetStories Then s = Sections.Stories : DownloadData(String.Empty, s, Token)
If MySiteSettings.DownloadStoriesTagged And GetTaggedData Then s = Sections.Tagged : DownloadData(String.Empty, s, Token)
End If
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)
ProcessException(ex, Token, "[API.Instagram.UserData.DownloadDataF]", False, s)
Finally
E560Thrown = False
End Try
End Sub
Private _InstaHash As String = String.Empty
Private Enum Sections : Timeline : Tagged : Stories : End Enum
Private Enum Sections : Timeline : Tagged : Stories : SavedPosts : End Enum
Private Const StoriesFolder As String = "Stories"
Private Const TaggedFolder As String = "Tagged"
#Region "429 bypass"
@@ -262,7 +278,7 @@ Namespace API.Instagram
'Create query
Select Case Section
Case Sections.Timeline
Case Sections.Timeline, Sections.SavedPosts
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}"
@@ -303,7 +319,7 @@ Namespace API.Instagram
n = j.ItemF(ENode).XmlIfNothing
If n.Count > 0 Then
Select Case Section
Case Sections.Timeline
Case Sections.Timeline, Sections.SavedPosts
If n.Contains("page_info") Then
With n("page_info")
HasNextPage = .Value("has_next_page").FromXML(Of Boolean)(False)
@@ -317,9 +333,7 @@ Namespace API.Instagram
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
If Not PostID.IsEmptyString AndAlso _TempPostsList.Contains(PostID) Then Throw New ExitException(_DownloadComplete)
End If
PostID = node.Value("id")
Pinned = CBool(If(node("pinned_for_users")?.Count, 0))
@@ -373,7 +387,7 @@ Namespace API.Instagram
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
If DownloadingException(ex, $"data downloading error [{URL}]", False, Section) = 1 Then Continue Do Else Exit Do
End Try
Loop
Catch eex2 As ExitException
@@ -381,7 +395,7 @@ 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)
@@ -432,23 +446,26 @@ Namespace API.Instagram
Next
End If
_DownloadComplete = True
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, $"downloading saved posts error [{URL}]") = 1 Then Continue Do Else Exit Do
If DownloadingException(ex, $"downloading saved posts error [{URL}]", False, Sections.SavedPosts) = 1 Then Continue Do Else Exit Do
End Try
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 saved posts error [{URL}]",, Sections.SavedPosts)
End Try
End Sub
#End Region
#Region "Code ID converters"
Friend Shared Function CodeToID(ByVal Code As String) As String
Private Shared Function CodeToID(ByVal Code As String) As String
Const CodeSymbols$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"
Try
If Not Code.IsEmptyString Then
@@ -658,7 +675,7 @@ 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
@@ -669,19 +686,24 @@ Namespace API.Instagram
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 [{CInt(Responser.StatusCode)}]: {ToString()} [{s}]"
DisableSection(s)
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden And s = Sections.Tagged Then
Return 3
ElseIf Responser.StatusCode = 429 Then
@@ -693,13 +715,27 @@ Namespace API.Instagram
Caught429 = True
MyMainLOG = $"Number of requests before error 429: {RequestsCount}"
Return 1
ElseIf Responser.StatusCode = 560 Then
MySiteSettings.SkipUntilNextSession = True
Else
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 Sections.SavedPosts : MySiteSettings.DownloadSaved.Value = False
Case Else : MySiteSettings.DownloadStoriesTagged.Value = False
End Select
MyMainLOG = $"[{s}] downloading is disabled until you update your credentials".ToUpper
End If
End Sub
#End Region
#Region "Create media"
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
@@ -713,14 +749,14 @@ Namespace API.Instagram
End Function
#End Region
#Region "Standalone downloader"
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal r As Response, ByVal _Settings As SiteSettings) As IEnumerable(Of UserMedia)
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal r As Response) 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.SetEnvironment(Settings(InstagramSiteKey), Nothing, False, False)
t.Responser = New Response
t.Responser.Copy(r)
t._SavedPostsIDs.Add(PID)
@@ -731,7 +767,7 @@ 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

View File

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

View File

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

View File

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

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' 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,10 +6,10 @@
'
' 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

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
@@ -130,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)

File diff suppressed because it is too large Load Diff

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
@@ -68,16 +68,7 @@ Namespace API.Reddit
End With
MyDefs.CloseForm()
End Sub
Private Sub OPT_VIEW_MODE_NEW_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_VIEW_MODE_NEW.CheckedChanged
ChangePeriodEnabled()
End Sub
Private Sub OPT_VIEW_MODE_HOT_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_VIEW_MODE_HOT.CheckedChanged
ChangePeriodEnabled()
End Sub
Private Sub OPT_VIEW_MODE_TOP_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_VIEW_MODE_TOP.CheckedChanged
ChangePeriodEnabled()
End Sub
Private Sub ChangePeriodEnabled()
Private Sub ChangePeriodEnabled() Handles OPT_VIEW_MODE_NEW.CheckedChanged, OPT_VIEW_MODE_HOT.CheckedChanged, OPT_VIEW_MODE_TOP.CheckedChanged
TP_PERIOD.Enabled = OPT_VIEW_MODE_TOP.Checked
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
@@ -9,21 +9,20 @@
Imports SCrawler.API.Base
Imports SCrawler.Plugin
Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Functions.RegularExpressions
Imports DownDetector = SCrawler.API.Base.DownDetector
Imports Download = SCrawler.Plugin.ISiteSettings.Download
Namespace API.Reddit
<Manifest(RedditSiteKey), UseClassAsIs, SavedPosts, SpecialForm(False)>
<Manifest(RedditSiteKey), SavedPosts, SpecialForm(False)>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.RedditIcon
Return My.Resources.SiteResources.RedditIcon_128
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.RedditPic512
Return My.Resources.SiteResources.RedditPic_512
End Get
End Property
<PropertyOption(ControlText:="Saved posts user"), PXML("SavedPostsUserName")>
@@ -40,7 +39,7 @@ Namespace API.Reddit
UseM3U8 = New PropertyValue(True)
UrlPatternUser = "https://www.reddit.com/user/{0}/"
UrlPatternChannel = "https://www.reddit.com/r/{0}/"
ImageVideoContains = "redgifs"
ImageVideoContains = "reddit.com"
End Sub
Friend Overrides Function GetInstance(ByVal What As Download) As IPluginContentProvider
Select Case What
@@ -92,8 +91,11 @@ Namespace API.Reddit
Return ErrorsDescriber.Execute(EDP.SendInLog + EDP.ReturnValue, ex, "[API.Reddit.SiteSettings.Available]", True)
End Try
End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return UserData.GetVideoInfo(URL, Responser)
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
Dim spf$ = String.Empty
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
f = $"{f.PathWithSeparator}OptionalPath\"
Return UserData.GetVideoInfo(URL, Responser, f, spf)
End Function
Friend Overrides Sub UserOptions(ByRef Options As Object, ByVal OpenForm As Boolean)
If Options Is Nothing OrElse Not TypeOf Options Is RedditViewExchange Then Options = New RedditViewExchange

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,15 +6,16 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.Reddit.RedditViewExchange
Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.ImageRenderer
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.Reddit.RedditViewExchange
Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports CView = SCrawler.API.Reddit.IRedditView.View
@@ -150,8 +151,6 @@ Namespace API.Reddit
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
_TotalPostsDownloaded = 0
'PENDING: Reddit ReparseMissing (DownloadDataF)
'If Not IsSavedPosts AndAlso (Not IsChannel OrElse ChannelInfo Is Nothing) Then ReparseMissing(Token)
If IsSavedPosts Then
DownloadDataChannel(String.Empty, Token)
ElseIf IsChannel Then
@@ -177,6 +176,8 @@ Namespace API.Reddit
#Region "Download Functions (User, Channel)"
Private _TotalPostsDownloaded As Integer = 0
Private ReadOnly _CrossPosts As List(Of String)
Private Const SiteGfycatKey As String = "gfycat"
Private Const SiteRedGifsKey As String = "redgifs"
Private Sub DownloadDataUser(ByVal POST As String, ByVal Token As CancellationToken)
Const CPRI$ = "crosspostRootId"
Const CPPI$ = "crosspostParentId"
@@ -239,7 +240,7 @@ Namespace API.Reddit
_ItemsBefore = _TempMediaList.Count
added = True
s = nn.ItemF({"source", "url"})
If s.XmlIfNothingValue("/").StringContains({"redgifs.com", "gfycat.com"}) Then
If s.XmlIfNothingValue("/").StringContains({$"{SiteRedGifsKey}.com", $"{SiteGfycatKey}.com"}) Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, s.Value, _PostID(), PostDate,, IsChannel), LNC)
ElseIf Not CreateImgurMedia(s.XmlIfNothingValue, _PostID(), PostDate,, IsChannel) Then
s = nn.ItemF({"media"}).XmlIfNothing
@@ -271,7 +272,7 @@ Namespace API.Reddit
If Not s.IsEmptyString AndAlso TryFile(s.Value) Then
With s.Value.ToLower
Select Case True
Case .Contains("redgifs"), .Contains("gfycat") : tmpType = UTypes.VideoPre
Case .Contains(SiteRedGifsKey), .Contains(SiteGfycatKey) : tmpType = UTypes.VideoPre
Case .Contains("m3u8") : If Settings.UseM3U8 Then tmpType = UTypes.m3u8
Case .Contains(".gif") And TryFile(s.Value) : tmpType = UTypes.GIF
Case TryFile(s.Value) : tmpType = UTypes.Picture
@@ -329,7 +330,7 @@ Namespace API.Reddit
If ChannelPostsNames.Contains(PostID) Then
If ViewMode = CView.New Then ExistsDetected = True Else NewPostDetected = True 'bypass
Continue For 'Exit Sub
Continue For
End If
If DownloadLimitCount.HasValue AndAlso _TotalPostsDownloaded >= DownloadLimitCount.Value Then Exit Sub
If Not DownloadLimitPost.IsEmptyString AndAlso DownloadLimitPost = PostID Then Exit Sub
@@ -377,8 +378,6 @@ Namespace API.Reddit
ElseIf Not s.Value({"media", "reddit_video"}, "fallback_url").IsEmptyString Then
tmpUrl = s.Value({"media", "reddit_video"}, "fallback_url")
If SaveToCache Then
'TODELETE: Reddit thumbnail -> GetVideoRedditPreview
'tmpUrl = s.Value("thumbnail")
tmpUrl = GetVideoRedditPreview(s)
If Not tmpUrl.IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, tmpUrl, PostID, PostDate, _UserID, IsChannel, False), LNC)
@@ -388,7 +387,6 @@ Namespace API.Reddit
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, s.Value({"media", "reddit_video"}, "hls_url"),
PostID, PostDate, _UserID, IsChannel), LNC)
Else
'_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre + UTypes.m3u8, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
@@ -418,19 +416,6 @@ Namespace API.Reddit
End Sub
#End Region
#Region "Download Base Functions"
Private Function ImgurPicture(ByVal Source As EContainer, ByVal Value As String) As String
Try
Dim e As EContainer = Source({"source", "url"}).XmlIfNothing
If Not e.IsEmptyString AndAlso e.Value.ToLower.Contains("imgur") Then
Return e.Value
Else
Return Value
End If
Catch ex As Exception
LogError(ex, "[ImgurPicture]")
Return Value
End Try
End Function
Private Function CreateImgurMedia(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _UserID As String = "", Optional ByVal IsChannel As Boolean = False) As Boolean
If Not _URL.IsEmptyString AndAlso _URL.Contains("imgur") Then
@@ -449,8 +434,33 @@ Namespace API.Reddit
ElseIf _URL.Contains(".gif") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.GIF, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
Else
If Not TryFile(_URL) Then _URL &= ".jpg"
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
Dim obj As IEnumerable(Of UserMedia) = Imgur.Envir.GetVideoInfo(_URL, EDP.ReturnValue)
If Not obj.ListExists Then
If Not TryFile(_URL) Then _URL &= ".jpg"
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, _URL, PostID, PostDate, _UserID, IsChannel), LNC)
Else
Dim ut As UTypes
Dim m As UserMedia
For Each data As UserMedia In obj
With data
If Not .URL.IsEmptyString Then
If Not .File.IsEmptyString Then
Select Case .File.Extension
Case "jpg", "png", "jpeg" : ut = UTypes.Picture
Case "gifv" : ut = IIf(SaveToCache, UTypes.Picture, UTypes.Video)
Case "mp4" : ut = UTypes.Video
Case "gif" : ut = UTypes.GIF
Case Else : ut = UTypes.Picture : .File.Extension = "jpg"
End Select
m = MediaFromData(ut, _URL, PostID, PostDate, _UserID, IsChannel)
m.URL = .URL
m.File = .File.File
_TempMediaList.ListAddValue(m, LNC)
End If
End If
End With
Next
End If
End If
Return True
Else
@@ -512,20 +522,37 @@ Namespace API.Reddit
End Try
End Function
Protected Overrides Sub ReparseVideo(ByVal Token As CancellationToken)
Dim RedGifsResponser As Response = Nothing
Try
ThrowAny(Token)
Const v2 As UTypes = UTypes.VideoPre + UTypes.m3u8
If _TempMediaList.Count > 0 AndAlso _TempMediaList.Exists(Function(p) p.Type = UTypes.VideoPre Or p.Type = v2) Then
Dim r$, v$
Dim e As New ErrorsDescriber(EDP.ReturnValue)
Dim m As UserMedia
Dim m As UserMedia, m2 As UserMedia
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey)
RedGifsResponser = RedGifsHost.Responser.Copy
For i% = _TempMediaList.Count - 1 To 0 Step -1
ThrowAny(Token)
If _TempMediaList(i).Type = UTypes.VideoPre Or _TempMediaList(i).Type = v2 Then
m = _TempMediaList(i)
If _TempMediaList(i).Type = UTypes.VideoPre Then
If m.URL.Contains("gfycat.com") Then
If m.URL.Contains($"{SiteGfycatKey}.com") Then
r = Gfycat.Envir.GetVideo(m.URL)
ElseIf m.URL.Contains(SiteRedGifsKey) Then
m2 = RedGifs.UserData.GetDataFromUrlId(m.URL, False, RedGifsResponser, RedGifsHost)
If m2.State = UStates.Missing Then
m.State = UStates.Missing
_ContentList.Add(m)
_TempMediaList.RemoveAt(i)
ElseIf m2.State = RedGifs.UserData.DataGone Then
_TempMediaList.RemoveAt(i)
Else
m2.URL_BASE = m.URL
m2.Post = m.Post
_TempMediaList(i) = m2
End If
Continue For
Else
r = Responser.GetResponse(m.URL,, e)
End If
@@ -546,60 +573,34 @@ Namespace API.Reddit
End If
Catch ex As Exception
ProcessException(ex, Token, "video reparsing error", False)
Finally
If Not RedGifsResponser Is Nothing Then RedGifsResponser.Dispose()
End Try
End Sub
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Dim RedGifsResponser As Response = Nothing
Try
If _ContentList.Exists(MissingFinder) Then
Dim m As UserMedia
Dim j As EContainer, ss As EContainer
Dim r$, tmpUrl$, PostDate$, _UserID$
Dim err As New ErrorsDescriber(EDP.ReturnValue)
Dim node As Object() = {"data", "children", 0, "data"}
Dim eCount As Predicate(Of EContainer) = Function(e) e.Count > 0
Dim cItems As Predicate(Of EContainer) = Function(e) If(e.ItemF(node)?.Count, 0) > 0
If Not ChannelInfo Is Nothing Or SaveToCache Then Exit Sub
If ContentMissingExists Then
Dim RedGifsHost As SettingsHost = Settings(RedGifs.RedGifsSiteKey)
RedGifsResponser = RedGifsHost.Responser.Copy
Dim m As UserMedia, m2 As UserMedia
For i% = 0 To _ContentList.Count - 1
m = _ContentList(i)
If m.State = UStates.Missing AndAlso Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
r = Responser.GetResponse($"https://www.reddit.com/comments/{m.Post.ID.Split("_").LastOrDefault}/.json",, err)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r, err)
If Not j Is Nothing Then
If j.Contains(cItems) Then
With j.ItemF({cItems}).ItemF(node)
If .Contains("created") Then PostDate = .Item("created").Value Else PostDate = String.Empty
_UserID = .Value("author")
tmpUrl = .Value("url")
If Not tmpUrl.IsEmptyString AndAlso tmpUrl.StringContains({"redgifs.com", "gfycat.com"}) Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, tmpUrl, m.Post.ID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
ElseIf Not .Value({"media", "reddit_video"}, "fallback_url").IsEmptyString Then
tmpUrl = .Value({"media", "reddit_video"}, "fallback_url")
If UseM3U8 AndAlso Not .Value({"media", "reddit_video"}, "hls_url").IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, .Value({"media", "reddit_video"}, "hls_url"),
m.Post.ID, PostDate, _UserID, IsChannel), LNC)
Else
'_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre + UTypes.m3u8, tmpUrl, PostID, PostDate, _UserID, IsChannel), LNC)
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, tmpUrl, m.Post.ID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
ElseIf CreateImgurMedia(tmpUrl, m.Post.ID, PostDate, _UserID, IsChannel) Then
_TotalPostsDownloaded += 1
ElseIf If(.Item("media_metadata")?.Count, 0) > 0 Then
DownloadGallery(.Self, m.Post.ID, PostDate, _UserID, SaveToCache)
_TotalPostsDownloaded += 1
ElseIf .Contains("preview") Then
ss = .ItemF({"preview", "images", eCount, "source", "url"}).XmlIfNothing
If Not ss.Value.IsEmptyString Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Picture, ss.Value, m.Post.ID, PostDate, _UserID, IsChannel), LNC)
_TotalPostsDownloaded += 1
End If
End If
End With
End If
j.Dispose()
If Not m.URL.IsEmptyString AndAlso m.URL.Contains(SiteRedGifsKey) Then
m2 = RedGifs.UserData.GetDataFromUrlId(m.URL, False, RedGifsResponser, RedGifsHost)
If m2.State = RedGifs.UserData.DataGone Then
rList.Add(i)
ElseIf Not m2.Type = UTypes.Undefined And Not m2.State = UStates.Missing Then
m.Type = m2.Type
m.File = m2.File
m.URL_BASE = m.URL
m.URL = m2.URL
rList.Add(i)
_TempMediaList.ListAddValue(m, LNC)
End If
End If
End If
@@ -608,26 +609,77 @@ Namespace API.Reddit
Catch ex As Exception
ProcessException(ex, Token, "missing data downloading error")
Finally
If Not RedGifsResponser Is Nothing Then RedGifsResponser.Dispose()
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(rList(i)) : Next
rList.Clear()
End If
End Try
End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response) As IEnumerable(Of UserMedia)
Private Sub ParsePost(ByVal URL As String)
Try
If Not URL.IsEmptyString AndAlso URL.Contains("redgifs") Then
If Not URL.IsEmptyString Then
Dim __id$ = RegexReplace(URL, RParams.DMS("comments/([^/]+)", 1, EDP.ReturnValue))
If Not __id.IsEmptyString Then
URL = $"https://www.reddit.com/comments/{__id.Split("_").LastOrDefault}/.json"
Dim r$ = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r).XmlIfNothing
With j.ItemF({0, "data", "children", 0, "data"})
If .ListExists Then
If .Contains({"media"}, "reddit_video") Then
With .Item({"media"}, "reddit_video")
If UseM3U8 AndAlso .Item("hls_url").XmlIfNothingValue("/").ToLower.Contains("m3u8") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.m3u8, .Value("hls_url"), __id, String.Empty), LNC)
ElseIf Not UseM3U8 AndAlso .Item("fallback_url").XmlIfNothingValue("/").ToLower.Contains("mp4") Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.Video, .Value("fallback_url"), __id, String.Empty), LNC)
End If
End With
ElseIf Not .Value("url").IsEmptyString Then
If .Value("url").StringContains({$"{SiteRedGifsKey}.com", $"{SiteGfycatKey}.com"}) Then
_TempMediaList.ListAddValue(MediaFromData(UTypes.VideoPre, .Value("url"), __id, String.Empty), LNC)
Else
CreateImgurMedia(.Value("url"), __id, String.Empty)
End If
End If
End If
End With
End Using
End If
End If
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"API.Reddit.ParsePost({URL})")
End Try
End Sub
Private Class AbsProgress : Inherits PersonalUtilities.Forms.Toolbars.MyProgress
Public Overrides Sub Perform(Optional ByVal Value As Double = 1)
End Sub
End Class
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response, ByVal f As SFile, ByVal SpecialFolder As String) As IEnumerable(Of UserMedia)
Try
If Not URL.IsEmptyString Then
Using r As New UserData
r._TempMediaList.Add(MediaFromData(UTypes.VideoPre, URL, String.Empty, String.Empty,, False))
r.Responser = New Response
r.Responser.Copy(resp)
r.ReparseVideo(Nothing)
If r._TempMediaList.ListExists Then Return {r._TempMediaList(0)}
r.ParsePost(URL)
If r._TempMediaList.Count > 0 Then
r.ReparseVideo(Nothing)
If r._TempMediaList.Count > 0 Then
r._ContentNew.AddRange(r._TempMediaList)
r.Progress = New AbsProgress
r.User.File.Path = f.Path
r.SeparateVideoFolder = False
r.DownloadContent(Nothing)
If r._ContentNew.Exists(Function(c) c.State = UStates.Downloaded) Then _
Return {New UserMedia With {.State = UStates.Downloaded, .SpecialFolder = SpecialFolder}}
End If
End If
End Using
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Video searching error")
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.Reddit.UserData.GetVideoInfo({URL})]")
End Try
End Function
#End Region
@@ -659,6 +711,7 @@ Namespace API.Reddit
End Function
#End Region
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
Dim RedGifsResponser As Response = Nothing
Try
Const _RFN$ = "RedditVideo"
Const RFN$ = _RFN & "{0}"
@@ -668,6 +721,7 @@ Namespace API.Reddit
If _ContentNew.Count > 0 Then
_ContentNew.RemoveAll(Function(c) c.URL.IsEmptyString)
If _ContentNew.Count > 0 Then
RedGifsResponser = Settings(RedGifs.RedGifsSiteKey).Responser.Copy
MyFile.Exists(SFO.Path)
Dim MissingErrorsAdd As Boolean = Settings.AddMissingErrorsToLog
Dim IsImgurStuff As Boolean
@@ -689,6 +743,7 @@ Namespace API.Reddit
Dim vsf As Boolean = SeparateVideoFolderF
Dim UseMD5 As Boolean = Not IsChannel Or (Not cached And Settings.ChannelsRegularCheckMD5)
Dim bDP As New ErrorsDescriber(EDP.None)
Dim RGRERROR As New ErrorsDescriber(EDP.ThrowException)
Dim ImgurUrls As New List(Of String)
Dim TryBytes As Func(Of String, Imaging.ImageFormat, String) =
Function(ByVal __URL As String, ByVal ImgFormat As Imaging.ImageFormat) As String
@@ -761,7 +816,7 @@ Namespace API.Reddit
If (Not m.IsEmptyString AndAlso Not HashList.Contains(m)) Or Not (v.Type = UTypes.Picture Or
v.Type = UTypes.GIF) Or Not UseMD5 Or ImgurUrls.Count > 0 Then
isImgurStuff = ImgurUrls.Count > 0
IsImgurStuff = ImgurUrls.Count > 0
Do
If Not cached And Not m.IsEmptyString Then HashList.Add(m)
v.MD5 = m
@@ -788,6 +843,8 @@ Namespace API.Reddit
f = M3U8.Download(v.URL, f)
ElseIf ImgurUrls.Count > 0 Then
w.DownloadFile(ImgurUrls(0), f.ToString)
ElseIf v.URL.Contains(SiteRedGifsKey) Then
RedGifsResponser.DownloadFile(v.URL, f, RGRERROR)
Else
w.DownloadFile(v.URL, f.ToString)
End If
@@ -838,7 +895,8 @@ Namespace API.Reddit
HasError = True
End Try
End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.Forbidden Then

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,14 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.RedGifs
Friend Module Declarations
Friend Const RedGifsSiteKey As String = "AndyProgram_RedGifs"
Friend Const RedGifsSite As String = "RedGifs"
Friend ReadOnly DateProvider As New CustomProvider(Function(v, d, p, n, e) ADateTime.ParseUnicode(v, n, e))
Friend ReadOnly WatchIDRegex As RParams = RParams.DMS(".+?watch/([^\?&""/]+)", 1, EDP.ReturnValue)
Friend ReadOnly ThumbsIDRegex As RParams = RParams.DMS("([^/\?&""]+?)(-\w+?|)\.(mp4|jpg)", 1, EDP.ReturnValue,
Function(v) If(CStr(v).IsEmptyString, String.Empty, CStr(v).ToLower.Trim))
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
@@ -6,41 +6,85 @@
'
' 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 SCrawler.API.Base
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.RedGifs
<Manifest("AndyProgram_RedGifs"), UseClassAsIs>
<Manifest(RedGifsSiteKey)>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.RedGifsIcon
Return My.Resources.SiteResources.RedGifsIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.RedGifsPic32
Return My.Resources.SiteResources.RedGifsPic_32
End Get
End Property
<PropertyOption(AllowNull:=False, ControlText:="Token", ControlToolTip:="Bearer token")>
Friend Property Token As PropertyValue
Private Const TokenName As String = "authorization"
Friend Sub New()
MyBase.New(RedGifsSite, "redgifs.com")
Dim t$ = String.Empty
With Responser
Dim b As Boolean = Not .UseWebClient Or Not .UseWebClientCookies Or Not .UseWebClientAdditionalHeaders
.UseWebClient = True
.UseWebClientCookies = True
.UseWebClientAdditionalHeaders = True
If .Headers.Count > 0 AndAlso .Headers.ContainsKey(TokenName) Then t = .Headers(TokenName)
If b Then .SaveSettings()
End With
Token = New PropertyValue(t, GetType(String), Sub(v) UpdateResponse(v))
UrlPatternUser = "https://www.redgifs.com/users/{0}/"
UserRegex = RParams.DMS("[htps:/]{7,8}.*?redgifs.com/users/([^/]+)", 1)
ImageVideoContains = "redgifs"
End Sub
Private Sub UpdateResponse(ByVal Value As String)
With Responser.Headers
If .Count = 0 OrElse Not .ContainsKey(TokenName) Then .Add(TokenName, Value) Else .Item(TokenName) = Value
Responser.SaveSettings()
End With
End Sub
Friend Overrides Function GetInstance(ByVal What As ISiteSettings.Download) As IPluginContentProvider
Return New UserData
End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Return Reddit.UserData.GetVideoInfo(URL, Nothing)
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
If BaseAuthExists() Then
Using resp As Response = Responser.Copy
Dim m As UserMedia = UserData.GetDataFromUrlId(URL, False, resp, Settings(RedGifsSiteKey))
If Not m.State = UStates.Missing And Not m.State = UserData.DataGone And (m.Type = UTypes.Picture Or m.Type = UTypes.Video) Then
Try
Dim spf$ = String.Empty
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
If f.IsEmptyString Then
f = m.File.File
Else
f.Name = m.File.Name
f.Extension = m.File.Extension
End If
resp.DownloadFile(m.URL, f, EDP.ThrowException)
m.State = UStates.Downloaded
m.SpecialFolder = spf
Return {m}
Catch ex As Exception
ErrorsDescriber.Execute(EDP.SendInLog, ex, $"Redgifs standalone download error: [{URL}]")
End Try
End If
End Using
End If
Return Nothing
End Function
Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
Return $"https://www.redgifs.com/watch/{PostID}"
End Function
Friend Overrides Function Available(ByVal What As ISiteSettings.Download, ByVal Silent As Boolean) As Boolean
'PENDING: RedGifs SiteSettings Available FALSE
Return False
Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 AndAlso ACheck(Token.Value)
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,20 +6,29 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.RedGifs
Friend Class UserData : Inherits UserDataBase
Friend Sub New()
End Sub
Friend Const DataGone As HttpStatusCode = HttpStatusCode.Gone
Private Const PostDataUrl As String = "https://api.redgifs.com/v2/gifs/{0}?views=yes&users=yes"
#Region "Base declarations"
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
#Region "Initializer"
Friend Sub New()
UseResponserClient = True
End Sub
#End Region
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
ReparseMissing(Token)
DownloadData(1, Token)
@@ -28,7 +37,7 @@ Namespace API.RedGifs
Dim URL$ = String.Empty
Try
URL = $"https://api.redgifs.com/v2/users/{Name}/search?order=recent&page={Page}"
Dim r$ = Responser.GetResponse(URL,, EDP.ThrowException)
Dim r$ = Responser.DownloadString(URL, EDP.ThrowException)
Dim postDate$, postID$
Dim pTotal% = 0
If Not r.IsEmptyString Then
@@ -53,25 +62,37 @@ Namespace API.RedGifs
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
#End Region
#Region "Media obtain, extract"
Private Sub ObtainMedia(ByVal j As EContainer, ByVal PostID As String,
Optional ByVal PostDateStr As String = Nothing, Optional ByVal PostDateDate As Date? = Nothing,
Optional ByVal State As UStates = UStates.Unknown)
With j("urls")
If .ListExists Then
Dim u$ = If(.Item("hd"), .Item("sd")).XmlIfNothingValue
If Not u.IsEmptyString Then
Dim ut As UTypes = UTypes.Undefined
'Type 1: video
'Type 2: image
Select Case j.Value("type").FromXML(Of Integer)(0)
Case 1 : ut = UTypes.Video
Case 2 : ut = UTypes.Picture
End Select
If Not ut = UTypes.Undefined Then _TempMediaList.ListAddValue(MediaFromData(ut, u, PostID, PostDateStr, PostDateDate, State))
End If
End If
End With
Dim tMedia As UserMedia = ExtractMedia(j)
If Not tMedia.Type = UTypes.Undefined Then _
_TempMediaList.ListAddValue(MediaFromData(tMedia.Type, tMedia.URL, PostID, PostDateStr, PostDateDate, State))
End Sub
Private Shared Function ExtractMedia(ByVal j As EContainer) As UserMedia
If Not j Is Nothing Then
With j("urls")
If .ListExists Then
Dim u$ = If(.Item("hd"), .Item("sd")).XmlIfNothingValue
If Not u.IsEmptyString Then
Dim ut As UTypes = UTypes.Undefined
'Type 1: video
'Type 2: image
Select Case j.Value("type").FromXML(Of Integer)(0)
Case 1 : ut = UTypes.Video
Case 2 : ut = UTypes.Picture
End Select
Return New UserMedia(u, ut)
End If
End If
End With
End If
Return Nothing
End Function
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Try
@@ -84,7 +105,7 @@ Namespace API.RedGifs
ThrowAny(Token)
u = _ContentList(i)
If Not u.Post.ID.IsEmptyString Then
url = $"https://api.redgifs.com/v2/gifs/{u.Post.ID}?views=yes&users=yes"
url = String.Format(PostDataUrl, u.Post.ID.ToLower)
Try
r = Responser.GetResponse(url,, EDP.ThrowException)
If Not r.IsEmptyString Then
@@ -115,14 +136,74 @@ Namespace API.RedGifs
End If
End Try
End Sub
#End Region
#Region "Downloader"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
#End Region
#Region "Get post data statics"
''' <summary>
''' https://thumbs4.redgifs.com/abcde-large.jpg?expires -> abcde<br/>
''' https://thumbs4.redgifs.com/abcde.mp4?expires -> abcde<br/>
''' https://www.redgifs.com/watch/abcde?rel=a -> abcde
''' </summary>
Friend Shared Function GetVideoIdFromUrl(ByVal URL As String) As String
If Not URL.IsEmptyString Then
Return RegexReplace(URL, If(URL.Contains("/watch/"), WatchIDRegex, ThumbsIDRegex))
Else
Return String.Empty
End If
End Function
Friend Shared Function GetDataFromUrlId(ByVal Obj As String, ByVal ObjIsID As Boolean, ByVal Responser As Response,
ByVal Host As Plugin.Hosts.SettingsHost) As UserMedia
Dim URL$ = String.Empty
Try
If Obj.IsEmptyString Then Return Nothing
If Not ObjIsID Then
Obj = GetVideoIdFromUrl(Obj)
If Not Obj.IsEmptyString Then Return GetDataFromUrlId(Obj, True, Responser, Host)
Else
If Host Is Nothing Then Host = Settings(RedGifsSiteKey)
If Host.Source.Available(Plugin.ISiteSettings.Download.Main, True) Then
If Responser Is Nothing Then Responser = Host.Responser.Copy
URL = String.Format(PostDataUrl, Obj.ToLower)
Dim r$ = Responser.DownloadString(URL, EDP.ThrowException)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If Not j Is Nothing Then
Dim tm As UserMedia = ExtractMedia(j("gif"))
tm.Post.ID = Obj
tm.File = CStr(RegexReplace(tm.URL, FilesPattern))
If tm.File.IsEmptyString Then
tm.File.Name = Obj
Select Case tm.Type
Case UTypes.Picture : tm.File.Extension = "jpg"
Case UTypes.Video : tm.File.Extension = "mp4"
End Select
End If
Return tm
End If
End Using
End If
Else
Return New UserMedia With {.State = UStates.Missing}
End If
End If
Return Nothing
Catch ex As Exception
If Not Responser Is Nothing AndAlso Responser.Client.StatusCode = DataGone Then _
Return New UserMedia With {.State = DataGone}
Return ErrorsDescriber.Execute(EDP.SendInLog, ex, $"[API.RedGifs.UserData.GetDataFromUrlId({URL})]", New UserMedia)
End Try
End Function
#End Region
#Region "Create media"
Private Shared Function MediaFromData(ByVal t As UTypes, ByVal _URL As String, ByVal PostID As String,
ByVal PostDateStr As String, ByVal PostDateDate As Date?, ByVal State As UStates) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, t) With {.Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern)) : m.URL_BASE = m.URL
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
If Not PostDateStr.IsEmptyString Then
m.Post.Date = AConvert(Of Date)(PostDateStr, DateProvider, Nothing)
ElseIf PostDateDate.HasValue Then
@@ -133,7 +214,10 @@ Namespace API.RedGifs
m.State = State
Return m
End Function
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
#End Region
#Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False
Else
@@ -142,5 +226,6 @@ Namespace API.RedGifs
End If
Return 1
End Function
#End Region
End Class
End Namespace

View File

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

View File

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

View File

@@ -0,0 +1,93 @@
' 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
Namespace API.TikTok
Friend Class UserData : Inherits UserDataBase
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
Friend Sub New()
SeparateVideoFolder = False
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
Dim PostIDs As List(Of String)
Dim PostDate As Date? = Nothing
Dim PostURL$ = String.Empty
Dim r$
URL = $"https://www.tiktok.com/@{Name}"
r = Responser.GetResponse(URL,, EDP.ThrowException)
PostIDs = RegexEnvir.GetIDList(r)
If PostIDs.ListExists Then
For Each __id$ In PostIDs
If Not _TempPostsList.Contains(__id) Then
_TempPostsList.Add(__id)
If RegexEnvir.GetVideoData(r, __id, PostURL, PostDate) Then
Select Case CheckDatesLimit(PostDate, CheckDateProvider)
Case DateResult.Skip : Continue For
Case DateResult.Exit : Exit Sub
End Select
If ID.IsEmptyString And Not PostURL.IsEmptyString Then ID = RegexEnvir.ExtractUserID(PostURL)
_TempMediaList.ListAddValue(MediaFromData(PostURL, __id, PostDate))
End If
Else
Exit Sub
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, $"data downloading error [{URL}]")
End Try
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal Responser As Response, Optional ByVal e As ErrorsDescriber = Nothing) As IEnumerable(Of UserMedia)
Try
If Not URL.IsEmptyString Then
Dim PostId$ = String.Empty
Dim PostDate As Date? = Nothing
Dim PostURL$ = String.Empty
Dim r$
PostId = RegexEnvir.ExtractPostID(URL)
If Not PostId.IsEmptyString Then
Using resp As Response = Responser.Copy() : r = resp.GetResponse(URL,, EDP.ThrowException) : End Using
If Not r.IsEmptyString Then
If RegexEnvir.GetVideoData(r, PostId, PostURL, PostDate) Then Return {MediaFromData(PostURL, PostId, PostDate)}
End If
End If
End If
Return Nothing
Catch ex As Exception
If Not e.Exists Then e = New ErrorsDescriber(EDP.ShowMainMsg + EDP.SendInLog)
Return ErrorsDescriber.Execute(e, ex, $"TikTok standalone downloader: fetch media error ({URL})")
End Try
End Function
Private Shared Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As Date?) As UserMedia
_URL = LinkFormatterSecure(RegexReplace(_URL.Replace("\", String.Empty), LinkPattern))
Dim m As New UserMedia(_URL, UserMedia.Types.Video) With {.Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = $"{PostID}.mp4"
If PostDate.HasValue Then m.Post.Date = PostDate
Return m
End Function
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
UserExists = False
Return 1
Else
Return 0
End If
End Function
End Class
End Namespace

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
@@ -12,18 +12,18 @@ Imports SCrawler.Plugin.Attributes
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.Twitter
<Manifest("AndyProgram_Twitter"), SavedPosts, UseClassAsIs>
<Manifest("AndyProgram_Twitter"), SavedPosts>
Friend Class SiteSettings : Inherits SiteSettingsBase
Friend Const Header_Authorization As String = "authorization"
Friend Const Header_Token As String = "x-csrf-token"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.TwitterIcon
Return My.Resources.SiteResources.TwitterIcon_32
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.TwitterPic400
Return My.Resources.SiteResources.TwitterPic_400
End Get
End Property
<PropertyOption(AllowNull:=False, ControlText:="Authorization",
@@ -100,11 +100,14 @@ Namespace API.Twitter
Return New UserData
End If
End Function
Friend Overrides Function GetSpecialDataF(ByVal URL As String) As IEnumerable(Of UserMedia)
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
Return UserData.GetVideoInfo(URL, Responser)
End Function
Friend Overrides Function GetUserPostUrl(ByVal UserID As String, ByVal PostID As String) As String
Return $"https://twitter.com/{UserID}/status/{PostID}"
End Function
Friend Overrides Function BaseAuthExists() As Boolean
Return If(Responser.Cookies?.Count, 0) > 0 And ACheck(Token.Value) And ACheck(Auth.Value)
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,26 +6,27 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports System.Net
Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports UStates = SCrawler.API.Base.UserMedia.States
Namespace API.Twitter
Friend Class UserData : Inherits UserDataBase
Private Const SinglePostUrl As String = "https://api.twitter.com/1.1/statuses/show.json?id={0}&tweet_mode=extended"
#Region "Declarations"
Private ReadOnly _DataNames As List(Of String)
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#End Region
#Region "Initializer"
Friend Sub New()
_DataNames = New List(Of String)
End Sub
#End Region
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
#Region "Download functions"
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
If IsSavedPosts Then
@@ -34,8 +35,6 @@ Namespace API.Twitter
Else
If _ContentList.Count > 0 Then _DataNames.ListAddList(_ContentList.Select(Function(c) c.File.File), LAP.ClearBeforeAdd, LAP.NotContainsOnly)
DownloadData(String.Empty, Token)
'PENDING: Twitter ReparseMissing (DownloadDataF)
'ReparseMissing(Token)
End If
End Sub
Private Overloads Sub DownloadData(ByVal POST As String, ByVal Token As CancellationToken)
@@ -44,12 +43,11 @@ Namespace API.Twitter
Dim NextCursor$ = String.Empty
Dim __NextCursor As Predicate(Of EContainer) = Function(e) e.Value({"content", "operation", "cursor"}, "cursorType") = "Bottom"
Dim PostID$ = String.Empty
Dim PostDate$ ', dName$
Dim nn As EContainer, s As EContainer ', m As EContainer
Dim PostDate$
Dim nn As EContainer, s As EContainer
Dim NewPostDetected As Boolean = False
Dim ExistsDetected As Boolean = False
Dim PicNode As Predicate(Of EContainer) = Function(e) e.Count > 0 AndAlso e.Contains("media_url")
Dim UID As Func(Of EContainer, String) = Function(e) e.XmlIfNothing.Item({"user", "id"}).XmlIfNothingValue
If IsSavedPosts Then
@@ -100,27 +98,11 @@ Namespace API.Twitter
Continue For
End If
If IsSavedPosts OrElse Not ParseUserMediaOnly OrElse (Not nn.Contains("retweeted_status") OrElse
(Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)) Then
'TODELETE: Twitter ObtainMedia
'If Not CheckVideoNode(nn, PostID, PostDate) Then
' s = nn.ItemF({"extended_entities", "media"})
' If s Is Nothing OrElse s.Count = 0 Then s = nn.ItemF({"retweeted_status", "extended_entities", "media"})
' If Not s Is Nothing AndAlso s.Count > 0 Then
' For Each m In s
' If m.Count > 0 AndAlso m.Contains("media_url") Then
' dName = UrlFile(m("media_url").Value)
' If Not dName.IsEmptyString AndAlso Not _DataNames.Contains(dName) Then
' _DataNames.Add(dName)
' _TempMediaList.ListAddValue(MediaFromData(m("media_url").Value,
' PostID, PostDate, GetPictureOption(m)), LNC)
' End If
' End If
' Next
' End If
'End If
ObtainMedia(nn, PostID, PostDate)
End If
If IsSavedPosts OrElse Not ParseUserMediaOnly OrElse
(
Not nn.Contains("retweeted_status") OrElse
(Not ID.IsEmptyString AndAlso UID(nn("retweeted_status")) = ID)
) Then ObtainMedia(nn, PostID, PostDate)
End If
Next
@@ -144,8 +126,10 @@ Namespace API.Twitter
ProcessException(ex, Token, $"data downloading error{IIf(IsSavedPosts, " (Saved Posts)", String.Empty)} [{URL}]")
End Try
End Sub
#End Region
#Region "Obtain media"
Private Sub ObtainMedia(ByVal e As EContainer, ByVal PostID As String, ByVal PostDate As String, Optional ByVal State As UStates = UStates.Unknown)
If Not CheckVideoNode(e, PostID, PostDate) Then
If Not CheckVideoNode(e, PostID, PostDate, State) Then
Dim s As EContainer = e.ItemF({"extended_entities", "media"})
If s Is Nothing OrElse s.Count = 0 Then s = e.ItemF({"retweeted_status", "extended_entities", "media"})
If If(s?.Count, 0) > 0 Then
@@ -162,111 +146,16 @@ Namespace API.Twitter
End If
End If
End Sub
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
'PENDING: Twitter ReparseMissing verify
Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
Private Function CheckVideoNode(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal State As UStates = UStates.Unknown) As Boolean
Try
If ContentMissingExists Then
Dim m As UserMedia
Dim r$, PostDate$
Dim j As EContainer
For i% = 0 To _ContentList.Count - 1
If _ContentList(i).State = UStates.Missing Then
m = _ContentList(i)
If Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
URL = $"https://api.twitter.com/1.1/statuses/show.json?id={m.Post.ID}"
r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
PostDate = String.Empty
If j.Contains("created_at") Then PostDate = j("created_at").Value Else PostDate = String.Empty
ObtainMedia(j, m.Post.ID, PostDate, UStates.Missing)
rList.Add(i)
End If
End If
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, $"ReparseMissing error [{URL}]")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(i) : Next
rList.Clear()
End If
End Try
End Sub
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response) As IEnumerable(Of UserMedia)
Try
If URL.Contains("twitter") Then
Dim PostID$ = RegexReplace(URL, RParams.DM("(?<=/)\d+", 0))
If Not PostID.IsEmptyString Then
Dim r$ = DirectCast(resp.Copy(), Response).GetResponse($"https://api.twitter.com/1.1/statuses/show.json?id={PostID}",, EDP.ReturnValue)
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
Dim u$ = GetVideoNodeURL(j)
If Not u.IsEmptyString Then Return {MediaFromData(u, PostID, String.Empty)}
End If
End Using
End If
End If
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, "Video searching error")
End Try
End Function
#Region "Picture options"
Private Function GetPictureOption(ByVal w As EContainer) As String
Const P4K As String = "4096x4096"
Try
Dim ww As EContainer = w("sizes")
If ww.ListExists Then
Dim l As New List(Of Sizes)
Dim Orig As Sizes? = New Sizes(w.Value({"original_info"}, "height").FromXML(Of Integer)(-1), P4K)
If Orig.Value.Value = -1 Then Orig = Nothing
Dim LargeContained As Boolean = ww.Contains("large")
For Each v As EContainer In ww
If v.Count > 0 AndAlso v.Contains("h") Then l.Add(New Sizes(v.Value("h"), v.Name))
Next
If l.Count > 0 Then
l.Sort()
If Orig.HasValue AndAlso l(0).Value < Orig.Value.Value Then
Return P4K
ElseIf l(0).Data.IsEmptyString Then
Return P4K
Else
Return l(0).Data
End If
Else
Return P4K
End If
ElseIf Not w.Value({"original_info"}, "height").IsEmptyString Then
Return P4K
Else
Return String.Empty
End If
Catch ex As Exception
LogError(ex, "[API.Twitter.UserData.GetPictureOption]")
Return String.Empty
End Try
End Function
#End Region
#Region "Video options"
Private Function CheckVideoNode(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String) As Boolean
Try
If CheckForGif(w, PostID, PostDate) Then Return True
If CheckForGif(w, PostID, PostDate, State) Then Return True
Dim URL$ = GetVideoNodeURL(w)
If Not URL.IsEmptyString Then
Dim f$ = UrlFile(URL)
If Not f.IsEmptyString AndAlso Not _DataNames.Contains(f) Then
_DataNames.Add(f)
_TempMediaList.ListAddValue(MediaFromData(URL, PostID, PostDate), LNC)
_TempMediaList.ListAddValue(MediaFromData(URL, PostID, PostDate,, State), LNC)
End If
Return True
End If
@@ -276,7 +165,8 @@ Namespace API.Twitter
Return False
End Try
End Function
Private Function CheckForGif(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String) As Boolean
Private Function CheckForGif(ByVal w As EContainer, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal State As UStates = UStates.Unknown) As Boolean
Try
Dim gifUrl As Predicate(Of EContainer) = Function(e) Not e.Value("content_type").IsEmptyString AndAlso
e.Value("content_type").Contains("mp4") AndAlso
@@ -293,7 +183,7 @@ Namespace API.Twitter
ff = UrlFile(url)
If Not ff.IsEmptyString Then
If Not _DataNames.Contains(ff) Then
m = MediaFromData(url, PostID, PostDate)
m = MediaFromData(url, PostID, PostDate,, State)
f = m.File
If Not f.IsEmptyString Then f.Name = $"GIF_{f.Name}" : m.File = f
_TempMediaList.ListAddValue(m, LNC)
@@ -332,6 +222,107 @@ Namespace API.Twitter
End If
Return String.Empty
End Function
#End Region
#Region "ReparseMissing"
Protected Overrides Sub ReparseMissing(ByVal Token As CancellationToken)
Dim rList As New List(Of Integer)
Dim URL$ = String.Empty
Try
If ContentMissingExists Then
Dim m As UserMedia
Dim r$, PostDate$
Dim j As EContainer
For i% = 0 To _ContentList.Count - 1
If _ContentList(i).State = UStates.Missing Then
m = _ContentList(i)
If Not m.Post.ID.IsEmptyString Then
ThrowAny(Token)
URL = String.Format(SinglePostUrl, m.Post.ID)
r = Responser.GetResponse(URL,, EDP.ReturnValue)
If Not r.IsEmptyString Then
j = JsonDocument.Parse(r)
If Not j Is Nothing Then
PostDate = String.Empty
If j.Contains("created_at") Then PostDate = j("created_at").Value Else PostDate = String.Empty
ObtainMedia(j, m.Post.ID, PostDate, UStates.Missing)
rList.Add(i)
End If
End If
End If
End If
Next
End If
Catch ex As Exception
ProcessException(ex, Token, $"ReparseMissing error [{URL}]")
Finally
If rList.Count > 0 Then
For i% = rList.Count - 1 To 0 Step -1 : _ContentList.RemoveAt(i) : Next
rList.Clear()
End If
End Try
End Sub
#End Region
#Region "Get video static"
Friend Shared Function GetVideoInfo(ByVal URL As String, ByVal resp As Response) As IEnumerable(Of UserMedia)
Try
If URL.Contains("twitter") Then
Dim PostID$ = RegexReplace(URL, RParams.DM("(?<=/)\d+", 0))
If Not PostID.IsEmptyString Then
Dim r$
Using rc As Response = resp.Copy() : r = rc.GetResponse(String.Format(SinglePostUrl, PostID),, EDP.ReturnValue) : End Using
If Not r.IsEmptyString Then
Using j As EContainer = JsonDocument.Parse(r)
If j.ListExists Then
Dim u$ = GetVideoNodeURL(j)
If Not u.IsEmptyString Then Return {MediaFromData(u, PostID, String.Empty)}
End If
End Using
End If
End If
End If
Return Nothing
Catch ex As Exception
Return ErrorsDescriber.Execute(EDP.ShowMainMsg + EDP.SendInLog, ex, $"Twitter standalone downloader: fetch media error ({URL})")
End Try
End Function
#End Region
#Region "Picture options"
Private Function GetPictureOption(ByVal w As EContainer) As String
Const P4K As String = "4096x4096"
Try
Dim ww As EContainer = w("sizes")
If ww.ListExists Then
Dim l As New List(Of Sizes)
Dim Orig As Sizes? = New Sizes(w.Value({"original_info"}, "height").FromXML(Of Integer)(-1), P4K)
If Orig.Value.Value = -1 Then Orig = Nothing
Dim LargeContained As Boolean = ww.Contains("large")
For Each v As EContainer In ww
If v.Count > 0 AndAlso v.Contains("h") Then l.Add(New Sizes(v.Value("h"), v.Name))
Next
If l.Count > 0 Then
l.Sort()
If Orig.HasValue AndAlso l(0).Value < Orig.Value.Value Then
Return P4K
ElseIf l(0).Data.IsEmptyString Then
Return P4K
Else
Return l(0).Data
End If
Else
Return P4K
End If
ElseIf Not w.Value({"original_info"}, "height").IsEmptyString Then
Return P4K
Else
Return String.Empty
End If
Catch ex As Exception
LogError(ex, "[API.Twitter.UserData.GetPictureOption]")
Return String.Empty
End Try
End Function
#End Region
#Region "UrlFile"
Private Function UrlFile(ByVal URL As String) As String
Try
Dim f As SFile = CStr(RegexReplace(LinkFormatterSecure(RegexReplace(URL.Replace("\", String.Empty), LinkPattern)), FilesPattern))
@@ -341,6 +332,7 @@ Namespace API.Twitter
End Try
End Function
#End Region
#Region "Create media"
Private Shared Function MediaFromData(ByVal _URL As String, ByVal PostID As String, ByVal PostDate As String,
Optional ByVal _PictureOption As String = Nothing,
Optional ByVal State As UStates = UStates.Unknown) As UserMedia
@@ -348,17 +340,21 @@ Namespace API.Twitter
Dim m As New UserMedia(_URL) With {.PictureOption = _PictureOption, .Post = New UserPost With {.ID = PostID}}
If Not m.URL.IsEmptyString Then m.File = CStr(RegexReplace(m.URL, FilesPattern))
If Not m.PictureOption.IsEmptyString And Not m.File.IsEmptyString And Not m.URL.IsEmptyString Then
m.URL_BASE = $"{m.URL.Replace($".{m.File.Extension}", String.Empty)}?format={m.File.Extension}&name={m.PictureOption}"
m.URL = $"{m.URL.Replace($".{m.File.Extension}", String.Empty)}?format={m.File.Extension}&name={m.PictureOption}"
End If
If Not PostDate.IsEmptyString Then m.Post.Date = AConvert(Of Date)(PostDate, Declarations.DateProvider, Nothing) Else m.Post.Date = Nothing
m.State = State
Return m
End Function
#End Region
#Region "Downloader"
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
DownloadContentDefault(Token)
End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
#End Region
#Region "Exception"
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
If Responser.StatusCode = HttpStatusCode.NotFound Then
UserExists = False
ElseIf Responser.StatusCode = HttpStatusCode.Unauthorized Then
@@ -373,9 +369,12 @@ Namespace API.Twitter
End If
Return 1
End Function
#End Region
#Region "IDisposable support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue And disposing Then _DataNames.Clear()
MyBase.Dispose(disposing)
End Sub
#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,17 +6,20 @@
'
' 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.Functions.XML
Imports PersonalUtilities.Functions.Messaging
Imports System.Threading
Imports SCrawler.API.Base
Namespace API
Friend Class UserDataBind : Inherits UserDataBase : Implements ICollection(Of IUserData), IMyEnumerator(Of IUserData)
#Region "Events"
Friend Event OnCollectionSelfRemoved(ByVal Collection As IUserData)
Friend Event OnUserRemoved(ByVal User As IUserData)
#End Region
#Region "Declarations"
Friend ReadOnly Property Collections As List(Of IUserData)
#Region "Base class overrides"
Private _CollectionName As String = String.Empty
Friend Overrides Property CollectionName As String
Get
@@ -30,6 +33,10 @@ Namespace API
ChangeCollectionName(NewName, True)
End Set
End Property
Friend Overrides Sub ChangeCollectionName(ByVal NewName As String, ByVal UpdateSettings As Boolean)
_CollectionName = NewName
If Count > 0 Then Collections.ForEach(Sub(c) c.CollectionName = NewName)
End Sub
Friend Overrides Property Name As String
Get
Return CollectionName
@@ -38,6 +45,21 @@ Namespace API
CollectionName = NewCollectionName
End Set
End Property
Friend Overrides Property FriendlyName As String
Get
If Count > 0 Then
Return Collections(0).FriendlyName
Else
Return String.Empty
End If
End Get
Set(ByVal NewName As String)
If Count > 0 Then Collections.ForEach(Sub(c)
c.FriendlyName = NewName
c.UpdateUserInformation()
End Sub)
End Set
End Property
Friend Overrides Property UserExists As Boolean
Get
Return Count > 0 AndAlso Collections.Exists(Function(c) c.Exists)
@@ -52,25 +74,6 @@ Namespace API
Set(ByVal s As Boolean)
End Set
End Property
Friend Overrides Sub ChangeCollectionName(ByVal NewName As String, ByVal UpdateSettings As Boolean)
_CollectionName = NewName
If Count > 0 Then Collections.ForEach(Sub(c) c.CollectionName = NewName)
End Sub
Friend Overrides Property FriendlyName As String
Get
If Count > 0 Then
Return Collections(0).FriendlyName
Else
Return String.Empty
End If
End Get
Set(ByVal NewName As String)
If Count > 0 Then Collections.ForEach(Sub(c)
c.FriendlyName = NewName
c.UpdateUserInformation()
End Sub)
End Set
End Property
#Region "Images"
Friend Overrides Sub SetPicture(ByVal f As SFile)
If Count > 0 Then Collections.ForEach(Sub(c) c.SetPicture(f))
@@ -97,15 +100,6 @@ Namespace API
Return Count > 0 AndAlso Collections.Exists(Function(c) DirectCast(c, UserDataBase).ContentMissingExists)
End Get
End Property
Friend ReadOnly Property Count As Integer Implements ICollection(Of IUserData).Count, IMyEnumerator(Of IUserData).MyEnumeratorCount
Get
If Collections Is Nothing Then
Return 0
Else
Return Collections.Count
End If
End Get
End Property
Friend Overrides Property MyFile As SFile
Get
If Count > 0 Then Return Collections(0).File Else Return Nothing
@@ -190,7 +184,7 @@ Namespace API
End Property
Friend Overrides Function GetUserInformation() As String
Dim OutStr$ = String.Empty
If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c, UserDataBase).GetUserInformation(), $"{vbCrLf}{vbCrLf}"))
If Count > 0 Then Collections.ForEach(Sub(c) OutStr.StringAppendLine(DirectCast(c, UserDataBase).GetUserInformation(), vbNewLine.StringDup(2)))
Return OutStr
End Function
Friend Overrides Property LastUpdated As Date?
@@ -224,6 +218,7 @@ Namespace API
End Sub)
End Set
End Property
#End Region
#Region "Context buttons"
Friend ReadOnly Property ContextDown As ToolStripMenuItem()
Get
@@ -276,7 +271,6 @@ Namespace API
Friend Sub New()
_IsCollection = True
Collections = New List(Of IUserData)
'ImageHandler(Me, True)
End Sub
Friend Sub New(ByVal _Name As String)
Me.New
@@ -299,24 +293,48 @@ Namespace API
#Region "Download"
Friend Overrides Property DownloadTopCount As Integer?
Get
If Count > 0 Then
Return Collections(0).DownloadTopCount
Else
Return Nothing
End If
Return If(Count > 0, Item(0).DownloadTopCount, Nothing)
End Get
Set(ByVal NewLimit As Integer?)
If Count > 0 Then Collections.ForEach(Sub(c) c.DownloadTopCount = NewLimit)
End Set
End Property
Friend Overrides Property IncludeInTheFeed As Boolean
Get
Return If(Count > 0, DirectCast(Item(0), UserDataBase).IncludeInTheFeed, Nothing)
End Get
Set(ByVal Include As Boolean)
If Count > 0 Then Collections.ForEach(Sub(c) DirectCast(c, UserDataBase).IncludeInTheFeed = Include)
End Set
End Property
Friend Overrides Property DownloadDateFrom As Date?
Get
Return If(Count > 0, Item(0).DownloadDateFrom, Nothing)
End Get
Set(ByVal d As Date?)
If Count > 0 Then Collections.ForEach(Sub(c) c.DownloadDateFrom = d)
End Set
End Property
Friend Overrides Property DownloadDateTo As Date?
Get
Return If(Count > 0, Item(0).DownloadDateTo, Nothing)
End Get
Set(ByVal d As Date?)
If Count > 0 Then Collections.ForEach(Sub(c) c.DownloadDateTo = d)
End Set
End Property
Friend Overrides Sub DownloadData(ByVal Token As CancellationToken)
If Count > 0 Then Downloader.AddRange(Collections)
If Count > 0 Then Downloader.AddRange(Collections, True)
End Sub
Friend Overloads Sub DownloadData(ByVal Token As CancellationToken, ByVal __IncludedInTheFeed As Boolean)
If Count > 0 Then Downloader.AddRange(Collections, __IncludedInTheFeed)
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
End Sub
Protected Overrides Sub DownloadContent(ByVal Token As CancellationToken)
End Sub
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False) As Integer
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal s As Object = Nothing) As Integer
Return 0
End Function
Private Sub User_OnUserUpdated(ByVal User As IUserData)
@@ -336,19 +354,30 @@ Namespace API
End Sub
#End Region
#Region "ICollection Support"
Default Friend ReadOnly Property Item(ByVal Index As Integer) As IUserData Implements IMyEnumerator(Of IUserData).MyEnumeratorObject
Get
Return Collections(Index)
End Get
End Property
Private ReadOnly Property IsReadOnly As Boolean Implements ICollection(Of IUserData).IsReadOnly
Get
Return False
End Get
End Property
Private Sub CopyTo(ByVal _Array() As IUserData, ByVal _ArrayIndex As Integer) Implements ICollection(Of IUserData).CopyTo
Throw New NotImplementedException("[CopyTo] method does not supported in collections context")
Throw New NotImplementedException("The [CopyTo] method is not supported in a collection context")
End Sub
#End Region
#Region "Item, Count, Clear"
Default Friend ReadOnly Property Item(ByVal Index As Integer) As IUserData Implements IMyEnumerator(Of IUserData).MyEnumeratorObject
Get
Return Collections(Index)
End Get
End Property
Friend ReadOnly Property Count As Integer Implements ICollection(Of IUserData).Count, IMyEnumerator(Of IUserData).MyEnumeratorCount
Get
If Collections Is Nothing Then
Return 0
Else
Return Collections.Count
End If
End Get
End Property
Friend Sub Clear() Implements ICollection(Of IUserData).Clear
Collections.ListClearDispose
End Sub
@@ -396,7 +425,7 @@ Namespace API
Try
With DirectCast(User, UserDataBase)
If IsAdd Then
.CreateButtons(Count - 1)
.CreateButtons()
AddHandler .BTT_CONTEXT_DELETE.Click, AddressOf DeleteRemoveUserFromCollection
Else
RemoveHandler .BTT_CONTEXT_DELETE.Click, AddressOf DeleteRemoveUserFromCollection
@@ -466,89 +495,91 @@ Namespace API
Return Collections.Remove(_Item)
End If
End Function
Friend Overrides Function Delete() As Integer
Friend Overrides Function Delete(Optional ByVal Multiple As Boolean = False) As Integer
If Count > 0 Then
Const MsgTitle$ = "Deleting a collection"
Dim f As SFile
If MsgBoxE({$"Collection may contain data{vbCr}Do you really want to delete collection and all of it files?", "Collection deleting"},
MsgBoxStyle.Exclamation + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
f = Collections(0).File.CutPath(IIf(DataMerging, 1, 2)).PathWithSeparator
Settings.Users.Remove(Me)
Collections.ForEach(Sub(c) c.Delete())
Downloader.UserRemove(Me)
MainFrameObj.ImageHandler(Me, False)
Collections.ListClearDispose
Dispose(False)
f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog)
Return 2
Else
If DataMerging Then
MsgBoxE($"Collection [{CollectionName}] data are already merged{vbCr}Cannot split merged collection{vbCr}Operation canceled", MsgBoxStyle.Exclamation)
Return 0
End If
If MsgBoxE({"Do you want to delete only the collection and split users' profiles??" & vbCr &
"Users will be removed from the collection and split by sites." & vbCr &
"All user data will remain.", "Collection deleting"},
MsgBoxStyle.Question + MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
f = Collections(0).File.CutPath(2)
Dim m As New MMessage($"Collection [{CollectionName} (number of profiles: {Count})] may contain data" & vbCr &
"Are you sure you want to delete the collection and all of its files?", MsgTitle,
{New MsgBoxButton("Delete") With {.ToolTip = "Delete the collection and all files"},
New MsgBoxButton("Split") With {
.ToolTip = "Users will be removed from the collection and will be displayed in the program as separate users." & vbCr &
"All user data will remain."},
"Cancel"}, vbExclamation)
Select Case If(Multiple, 0, MsgBoxE(m).Index)
Case 0
f = Collections(0).File.CutPath(IIf(DataMerging, 1, 2)).PathWithSeparator
Settings.Users.Remove(Me)
Collections.ForEach(Sub(c)
c.MoveFiles(String.Empty)
MainFrameObj.ImageHandler(c)
End Sub)
Collections.Clear()
f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog)
Collections.ForEach(Sub(c) c.Delete())
Downloader.UserRemove(Me)
MainFrameObj.ImageHandler(Me, False)
Collections.ListClearDispose
Dispose(False)
Return 3
Else
MsgBoxE("Operation canceled")
End If
End If
f.Delete(SFO.Path, SFODelete.EmptyOnly + Settings.DeleteMode, EDP.SendInLog)
Return 2
Case 1
If DataMerging Then
MsgBoxE({$"Collection [{CollectionName}] data merged{vbCr}Unable to split merged collection{vbCr}Operation canceled", MsgTitle}, vbExclamation)
Return 0
Else
f = Collections(0).File.CutPath(2)
Settings.Users.Remove(Me)
Collections.ForEach(Sub(c)
c.MoveFiles(String.Empty)
MainFrameObj.ImageHandler(c)
End Sub)
Collections.Clear()
f.Delete(SFO.Path, SFODelete.Default + Settings.DeleteMode, EDP.SendInLog)
Downloader.UserRemove(Me)
MainFrameObj.ImageHandler(Me, False)
Dispose(False)
Return 3
End If
Case Else : If Not Multiple Then MsgBoxE({"Operation canceled", MsgTitle})
End Select
End If
Return 0
End Function
Private Sub DeleteRemoveUserFromCollection(sender As Object, e As EventArgs)
With DirectCast(sender, ToolStripMenuItem)
Dim i% = AConvert(Of Integer)(.Tag, -1)
If i >= 0 Then
Dim n$ = Collections(i).Name
Dim s$ = Collections(i).Site.ToString
Dim RemoveMeIfNull As Action = Sub()
If Count = 0 Then
Settings.Users.Remove(Me)
MainFrameObj.ImageHandler(Me, False)
RaiseEvent OnCollectionSelfRemoved(Me)
Dispose(False)
End If
End Sub
Select Case MsgBoxE({$"Are you sure you want to remove user profile [{n}] of site [{s}] from collection [{Name}]?" & vbCr &
"You can remove a user from the collection while keeping data (Remove) or deleting the data (Delete)" & vbCr &
"Deleting this profile will remove it from the collection and all its data will be erased." & vbCr &
"Removing this profile will remove it from the collection and all its data will remain." &
"This user will still appear in the program, but not in the collection.",
"Deleting a user"}, vbExclamation,,,
{
New MsgBoxButton("Remove") With {
.ToolTip = "Remove a user from the collection only. All its data will remain. The user will appear in the program."},
New MsgBoxButton("Delete") With {
.ToolTip = "Delete a user from the collection and erase their data."},
"Cancel"
}).Index
Case 0
Remove(Collections(i))
MsgBoxE($"User [{s} - {n}] has been removed from the collection. Now it should be displayed in the program.")
RemoveMeIfNull.Invoke
Case 1
Collections(i).Delete()
Collections(i).Dispose()
Collections.RemoveAt(i)
MsgBoxE($"User profile [{n}] of site [{s}] has been deleted")
RemoveMeIfNull.Invoke
Case Else : MsgBoxE("Operation canceled")
End Select
End If
End With
Dim obj As IUserData = DirectCast(sender, ToolStripMenuItem).Tag
Dim i% = Collections.IndexOf(obj)
If i >= 0 Then
Dim n$ = Collections(i).Name
Dim s$ = Collections(i).Site.ToString
Dim RemoveMeIfNull As Action = Sub()
If Count = 0 Then
Settings.Users.Remove(Me)
MainFrameObj.ImageHandler(Me, False)
RaiseEvent OnCollectionSelfRemoved(Me)
Dispose(False)
End If
End Sub
Select Case MsgBoxE({$"Are you sure you want to remove user profile [{n}] of site [{s}] from collection [{Name}]?" & vbCr &
"You can remove a user from the collection while keeping data (Remove) or deleting the data (Delete)" & vbCr &
"Deleting this profile will remove it from the collection and all its data will be erased." & vbCr &
"Removing this profile will remove it from the collection and all its data will remain." &
"This user will still appear in the program, but not in the collection.",
"Deleting a user"}, vbExclamation,,,
{
New MsgBoxButton("Remove") With {
.ToolTip = "Remove a user from the collection only. All its data will remain. The user will appear in the program."},
New MsgBoxButton("Delete") With {
.ToolTip = "Delete a user from the collection and erase their data."},
"Cancel"
}).Index
Case 0
Remove(Collections(i))
MsgBoxE($"User [{s} - {n}] has been removed from the collection. Now it should be displayed in the program.")
RemoveMeIfNull.Invoke
Case 1
Collections(i).Delete()
Collections(i).Dispose()
Collections.RemoveAt(i)
MsgBoxE($"User profile [{n}] of site [{s}] has been deleted")
RemoveMeIfNull.Invoke
Case Else : MsgBoxE("Operation canceled")
End Select
End If
End Sub
#End Region
#Region "Copy"
@@ -569,18 +600,18 @@ Namespace API
Return GetEnumerator()
End Function
#End Region
#Region "IEquatable support"
Friend Overrides Function Equals(ByVal Other As UserDataBase) As Boolean
If Other.IsCollection Then
Return CollectionName = Other.CollectionName
Else
Return Count > 0 AndAlso Collections.Exists(Function(u) u.Equals(Other))
Return False
End If
End Function
#End Region
#Region "IDisposable Support"
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If Not disposedValue Then
If disposing Then Collections.ListClearDispose
End If
If Not disposedValue And disposing Then Collections.ListClearDispose
MyBase.Dispose(disposing)
End Sub
#End Region

View File

@@ -0,0 +1,19 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports PersonalUtilities.Functions.RegularExpressions
Namespace API.XVIDEOS
Friend Module Declarations
Friend Const XvideosSiteKey As String = "AndyProgram_XVIDEOS"
Friend ReadOnly Property M3U8Regex As RParams = RParams.DM("http.+?.m3u8.*?(?=')", 0)
Friend ReadOnly Property VideoTitleRegex As RParams = RParams.DMS("html5player.setVideoTitle\('(.+)(?='\);)", 1)
Friend ReadOnly Property VideoID As RParams = RParams.DMS(".*?www.xvideos.com/(video\d+).*", 1)
Friend ReadOnly Property M3U8Reparse As RParams = RParams.DM("NAME=""(\d+).*?""[\r\n]*?(.+)(?=(|[\r\n]+?))", 0, RegexReturn.List)
Friend ReadOnly Property M3U8Appender As RParams = RParams.DM("(.+)(?=/.+?\.m3u8.*?)", 0)
End Module
End Namespace

View File

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

View File

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

View File

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

View File

@@ -0,0 +1,130 @@
' 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
Namespace API.XVIDEOS
<Manifest(XvideosSiteKey), SpecialForm(True)>
Friend Class SiteSettings : Inherits SiteSettingsBase
#Region "Images"
Friend Overrides ReadOnly Property Icon As Icon
Get
Return My.Resources.SiteResources.XvideosIcon_48
End Get
End Property
Friend Overrides ReadOnly Property Image As Image
Get
Return My.Resources.SiteResources.XvideosPic_32
End Get
End Property
#End Region
#Region "Declarations"
<PXML("Domains")> Private Property SiteDomains As PropertyValue
<PropertyOption(ControlText:="Download UHD", ControlToolTip:="Download UHD (4K) content"), PXML>
Public Property DownloadUHD As PropertyValue
Friend ReadOnly Property Domains As List(Of String)
Private Const DomainsDefault As String = "xvideos.com|xnxx.com"
Private _Initialized As Boolean = False
#End Region
#Region "Initializer"
Friend Sub New()
MyBase.New("XVIDEOS", "www.xvideos.com")
Domains = New List(Of String)
SiteDomains = New PropertyValue(DomainsDefault, GetType(String), Sub(s) UpdateDomains())
DownloadUHD = New PropertyValue(False)
End Sub
Friend Overrides Sub EndInit()
_Initialized = True
UpdateDomains()
End Sub
#End Region
#Region "Update"
Private _DomainsUpdateInProgress As Boolean = False
Friend Sub UpdateDomains()
If Not _Initialized Then Exit Sub
If Not _DomainsUpdateInProgress Then
_DomainsUpdateInProgress = True
If Not ACheck(SiteDomains.Value) Then SiteDomains.Value = DomainsDefault
Domains.ListAddList(CStr(SiteDomains.Value).Split("|"), LAP.NotContainsOnly, LAP.ClearBeforeAdd)
Domains.ListAddList(DomainsDefault.Split("|"), LAP.NotContainsOnly)
SiteDomains.Value = Domains.ListToString("|")
_DomainsUpdateInProgress = False
End If
End Sub
Friend Overrides Sub Update()
UpdateDomains()
Responser.SaveSettings()
End Sub
#End Region
#Region "Download"
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 Settings.UseM3U8
End Function
#End Region
#Region "User: get, check"
Friend Overrides Function GetUserUrl(ByVal UserName As String, ByVal Channel As Boolean) As String
Dim user$ = UserName.Split("_").FirstOrDefault
user &= $"/{UserName.Replace($"{user}_", String.Empty)}"
Return user
End Function
Private Const UserRegexDefault As String = "/(profiles|[\w]*?[-]{0,1}channels)/([^/]+)(\Z|.*?)"
Private Const URD As String = ".*?{0}{1}"
Friend Overrides Function IsMyUser(ByVal UserURL As String) As ExchangeOptions
If Not UserURL.IsEmptyString Then
If Domains.Count > 0 Then
Dim uName$, uOpt$, fStr$
For i% = 0 To Domains.Count - 1
fStr = String.Format(URD, Domains(i), UserRegexDefault)
uName = RegexReplace(UserURL, RParams.DMS(fStr, 2))
If Not uName.IsEmptyString Then
uOpt = RegexReplace(UserURL, RParams.DMS(fStr, 1))
If Not uOpt.IsEmptyString Then Return New ExchangeOptions(Site, $"{uOpt}_{uName}")
End If
Next
End If
End If
Return Nothing
End Function
#End Region
#Region "Settings"
Friend Overrides Sub OpenSettingsForm()
Using f As New SettingsForm(Me) : f.ShowDialog() : End Using
End Sub
#End Region
#Region "Get special data"
Friend Overrides Function IsMyImageVideo(ByVal URL As String) As ExchangeOptions
If Not URL.IsEmptyString And Domains.Count > 0 Then
If Domains.Exists(Function(d) URL.Contains(d)) Then Return New ExchangeOptions With {.UserName = URL, .Exists = True}
End If
Return Nothing
End Function
Friend Overrides Function GetSpecialData(ByVal URL As String, ByVal Path As String, ByVal AskForPath As Boolean) As IEnumerable
If Not URL.IsEmptyString And Settings.UseM3U8 Then
Dim spf$ = String.Empty
Dim f As SFile = GetSpecialDataFile(Path, AskForPath, spf)
f.Name = "video"
f.Extension = "mp4"
Using resp As Response = Responser.Copy
Using user As New UserData With {.HOST = Settings(XvideosSiteKey)}
DirectCast(user, UserDataBase).User.File = f
Dim p As UserMedia = user.Download(URL, resp, DownloadUHD.Value, String.Empty)
If p.State = UserMedia.States.Downloaded Then p.SpecialFolder = spf : Return {p}
End Using
End Using
End If
Return Nothing
End Function
#End Region
End Class
End Namespace

View File

@@ -0,0 +1,185 @@
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports SCrawler.API.Base
Imports PersonalUtilities.Functions.XML
Imports PersonalUtilities.Functions.RegularExpressions
Imports PersonalUtilities.Tools.WEB
Imports PersonalUtilities.Tools.WebDocuments.JSON
Imports UStates = SCrawler.API.Base.UserMedia.States
Imports UTypes = SCrawler.API.Base.UserMedia.Types
Namespace API.XVIDEOS
Friend Class UserData : Inherits UserDataBase
Private ReadOnly Property MySettings As SiteSettings
Get
Return DirectCast(HOST.Source, SiteSettings)
End Get
End Property
Protected Overrides Sub LoadUserInformation_OptionalFields(ByRef Container As XmlFile, ByVal Loading As Boolean)
End Sub
Friend Sub New()
SeparateVideoFolder = False
UseInternalM3U8Function = True
End Sub
Protected Overrides Sub DownloadDataF(ByVal Token As CancellationToken)
Dim URL$ = String.Empty
Try
If Not Settings.UseM3U8 Then
If Not Settings.OS64 Then
MyMainLOG = $"XVIDEOS [{ToStringForLog()}]: The plugin only works with x64 OS."
Else
MyMainLOG = $"{ToStringForLog()}: File [ffmpeg.exe] not found"
End If
Exit Sub
End If
Dim NextPage% = 0
Dim r$
Dim jj As EContainer
Dim e As ErrorsDescriber = EDP.ThrowException
Dim user$ = MySettings.GetUserUrl(Name, False)
Dim p As UserMedia
Dim EnvirSet As Boolean = False
Do
ThrowAny(Token)
URL = $"https://www.xvideos.com/{user}/videos/new/{If(NextPage = 0, String.Empty, NextPage)}"
r = Responser.GetResponse(URL,, e)
If Not r.IsEmptyString Then
If Not EnvirSet Then UserExists = True : UserSuspended = False : EnvirSet = True
With JsonDocument.Parse(r).XmlIfNothing
If .Contains("videos") Then
With .Item("videos")
If .Count > 0 Then
NextPage += 1
For Each jj In .Self
p = New UserMedia With {
.Post = New UserPost With {.ID = jj.Value("id")},
.URL = $"https://www.xvideos.com{jj.Value("u")}"
}
If Not p.Post.ID.IsEmptyString And Not jj.Value("u").IsEmptyString Then
If Not _TempPostsList.Contains(p.Post.ID) Then
_TempPostsList.Add(p.Post.ID)
_TempMediaList.Add(p)
Else
.Dispose()
Exit Do
End If
End If
Next
Else
.Dispose()
Exit Do
End If
End With
Else
.Dispose()
Exit Do
End If
.Dispose()
End With
Else
Exit Do
End If
Loop
If _TempMediaList.Count > 0 Then
For i% = 0 To _TempMediaList.Count - 1
ThrowAny(Token)
With _TempMediaList(i) : _TempMediaList(i) = GetVideoData(.URL, Responser, MySettings.DownloadUHD.Value, .Post.ID) : End With
Next
_TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End If
Catch oex As OperationCanceledException
Catch dex As ObjectDisposedException
Catch ex As Exception
If Responser.StatusCode = Net.HttpStatusCode.NotFound Then
UserExists = False
Else
ProcessException(ex, Token, $"data downloading error [{URL}]")
End If
Finally
If _TempMediaList.ListExists Then _TempMediaList.RemoveAll(Function(m) m.URL.IsEmptyString)
End Try
End Sub
Private Function GetVideoData(ByVal URL As String, ByVal resp As Response, ByVal DownloadUHD As Boolean, ByVal ID As String) As UserMedia
Try
If Not URL.IsEmptyString Then
Dim r$ = resp.GetResponse(URL,, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim m$ = RegexReplace(r, M3U8Regex)
If Not m.IsEmptyString Then
Dim appender$ = RegexReplace(m, M3U8Appender)
Dim t$ = RegexReplace(r, VideoTitleRegex)
r = resp.GetResponse(m,, EDP.ThrowException)
If Not r.IsEmptyString Then
Dim ls As List(Of Sizes) = RegexFields(Of Sizes)(r, {M3U8Reparse}, {1, 2})
If ls.ListExists And Not DownloadUHD Then ls.RemoveAll(Function(v) Not v.Value.ValueBetween(1, 1080))
If ls.ListExists Then
ls.Sort()
m = $"{appender}/{ls(0).Data}"
ls.Clear()
Dim pID$ = ID
If pID.IsEmptyString Then pID = RegexReplace(r, VideoID)
If pID.IsEmptyString Then pID = "0"
If Not t.IsEmptyString Then t = t.StringRemoveWinForbiddenSymbols(" ")
If t.IsEmptyString Then
t = pID
Else
If t.Length > 100 Then t = Left(t, 100)
End If
If Not m.IsEmptyString Then
Return New UserMedia With {
.Type = UTypes.m3u8,
.Post = New UserPost With {.ID = pID},
.URL = m,
.File = $"{t}.mp4",
.PictureOption = appender
}
End If
End If
End If
End If
End If
End If
Return Nothing
Catch ex As Exception
LogError(ex, $"[XVIDEOS.UserData.GetVideoData({URL})]")
Return Nothing
End Try
End Function
Friend Function Download(ByVal URL As String, ByVal resp As Response, ByVal DownloadUHD As Boolean, ByVal ID As String)
Dim m As UserMedia = GetVideoData(URL, resp, DownloadUHD, ID)
If Not m.URL.IsEmptyString Then
Dim f As SFile = m.File
f.Path = MyFile.PathNoSeparator
m.State = UStates.Tried
Try
f = M3U8.Download(m.URL, m.PictureOption, Settings.FfmpegFile, f)
m.File = f
m.State = UStates.Downloaded
Catch ex As Exception
m.State = UStates.Missing
End Try
End If
Return m
End Function
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(Media.URL, Media.PictureOption, Settings.FfmpegFile, DestinationFile)
End Function
Protected Overrides Function DownloadingException(ByVal ex As Exception, ByVal Message As String, Optional ByVal FromPE As Boolean = False,
Optional ByVal EObj As Object = Nothing) As Integer
Return 0
End Function
End Class
End Namespace

View File

@@ -1,4 +1,12 @@
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
' 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
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
@@ -17,7 +25,6 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
Dim SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_1 As System.Windows.Forms.ToolStripSeparator
Dim CONTEXT_SEP_2 As System.Windows.Forms.ToolStripSeparator
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(ChannelViewForm))
Me.TT_MAIN = New System.Windows.Forms.ToolTip(Me.components)
Me.ToolbarTOP = New System.Windows.Forms.ToolStrip()
Me.BTT_DOWNLOAD = New System.Windows.Forms.ToolStripButton()
@@ -69,7 +76,7 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
'BTT_DOWNLOAD
'
Me.BTT_DOWNLOAD.AutoToolTip = False
Me.BTT_DOWNLOAD.Image = Global.SCrawler.My.Resources.Resources.StartPic_01_Green_16
Me.BTT_DOWNLOAD.Image = Global.SCrawler.My.Resources.Resources.StartPic_Green_16
Me.BTT_DOWNLOAD.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_DOWNLOAD.Name = "BTT_DOWNLOAD"
Me.BTT_DOWNLOAD.Size = New System.Drawing.Size(104, 22)
@@ -78,7 +85,7 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
'BTT_STOP
'
Me.BTT_STOP.Enabled = False
Me.BTT_STOP.Image = Global.SCrawler.My.Resources.Resources.Delete
Me.BTT_STOP.Image = Global.SCrawler.My.Resources.Resources.DeletePic_24
Me.BTT_STOP.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_STOP.Name = "BTT_STOP"
Me.BTT_STOP.Size = New System.Drawing.Size(51, 22)
@@ -87,7 +94,7 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
'
'BTT_ADD_USERS
'
Me.BTT_ADD_USERS.Image = Global.SCrawler.My.Resources.Resources.PlusPIC
Me.BTT_ADD_USERS.Image = Global.SCrawler.My.Resources.Resources.PlusPic_24
Me.BTT_ADD_USERS.ImageTransparentColor = System.Drawing.Color.Magenta
Me.BTT_ADD_USERS.Name = "BTT_ADD_USERS"
Me.BTT_ADD_USERS.Size = New System.Drawing.Size(49, 22)
@@ -177,7 +184,7 @@ Partial Friend Class ChannelViewForm : Inherits System.Windows.Forms.Form
Me.Controls.Add(Me.LIST_POSTS)
Me.Controls.Add(Me.ToolbarBOTTOM)
Me.Controls.Add(Me.ToolbarTOP)
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.Icon = Global.SCrawler.My.Resources.SiteResources.RedditIcon_128
Me.KeyPreview = True
Me.MinimumSize = New System.Drawing.Size(760, 500)
Me.Name = "ChannelViewForm"

File diff suppressed because it is too large Load Diff

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' 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,21 +6,23 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
Imports System.Threading
Imports System.ComponentModel
Imports SCrawler.API.Base
Imports SCrawler.API.Reddit
Imports SCrawler.Plugin.Hosts
Imports PersonalUtilities.Forms
Imports PersonalUtilities.Forms.Toolbars
Imports PersonalUtilities.Forms.Controls
Imports PersonalUtilities.Forms.Controls.Base
Imports PersonalUtilities.Tools
Imports System.ComponentModel
Imports System.Threading
Imports SCrawler.API.Base
Imports SCrawler.API.Reddit
Imports SCrawler.Plugin.Hosts
Imports ADB = PersonalUtilities.Forms.Controls.Base.ActionButton.DefaultButtons
Imports RButton = PersonalUtilities.Forms.Toolbars.RangeSwitcherToolbar.ControlItem
Friend Class ChannelViewForm : Implements IChannelLimits
#Region "Events"
Friend Event OnUsersAdded(ByVal StartIndex As Integer)
Friend Event OnDownloadDone As NotificationEventHandler
#End Region
#Region "Appended user structure"
Private Structure PendingUser
Friend ID As String
@@ -138,7 +140,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End If
End Function
#End Region
#Region "Initializer and form methods"
#Region "Initializer"
Friend Sub New()
InitializeComponent()
MyDefs = New DefaultFormOptions
@@ -212,6 +214,8 @@ Friend Class ChannelViewForm : Implements IChannelLimits
AddHandler Settings.ChannelsImagesColumns.OnValueChanged, AddressOf ImagesCountChanged
AddHandler Settings.ChannelsImagesRows.OnValueChanged, AddressOf ImagesCountChanged
End Sub
#End Region
#Region "Form handlers"
Private Sub ChannelViewForm_Load(sender As Object, e As EventArgs) Handles Me.Load
MyDefs.MyViewInitialize(Me, Settings.Design)
RefillChannels(Settings.LatestSelectedChannel.Value)
@@ -265,6 +269,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
If b Then LIST_POSTS.Select() : e.Handled = True
End Sub
#End Region
#Region "Refill"
Private Sub RefillChannels(Optional ByVal SelectedChannel As String = Nothing)
CMB_CHANNELS.BeginUpdate()
Dim indx%? = Nothing
@@ -277,11 +282,13 @@ Friend Class ChannelViewForm : Implements IChannelLimits
CMB_CHANNELS.Items.Add(.Item(i).ID)
If .Item(i).ID = t Then indx = i
Next
If indx >= 0 And indx <= CMB_CHANNELS.Count - 1 Then CMB_CHANNELS.SelectedIndex = indx
If indx.HasValue AndAlso indx.Value.ValueBetween(0, CMB_CHANNELS.Count - 1) Then CMB_CHANNELS.SelectedIndex = indx
End If
End With
CMB_CHANNELS.EndUpdate()
End Sub
#End Region
#Region "User add, append"
Private Sub AppendPendingUsers()
If LIST_POSTS.CheckedIndices.Count > 0 Then
Dim c As Channel = GetCurrentChannel(False)
@@ -293,6 +300,84 @@ Friend Class ChannelViewForm : Implements IChannelLimits
If ToolbarTOP.InvokeRequired Then ToolbarTOP.Invoke(a) Else a.Invoke
End If
End Sub
Private Sub BTT_ADD_USERS_Click(sender As Object, e As EventArgs) Handles BTT_ADD_USERS.Click
AppendPendingUsers()
Dim i%
If LIST_POSTS.CheckedItems.Count > 0 Then
For i = 0 To LIST_POSTS.Items.Count - 1
If LIST_POSTS.Items(i).Checked Then LIST_POSTS.Items(i).Checked = False
Next
End If
If PendingUsers.Count > 0 Then
Dim Added% = 0, Skipped% = 0
Dim StartIndex% = Settings.Users.Count
Dim f As SFile
Dim umo As Boolean = HOST.GetUserMediaOnly
Settings.Labels.Add(CannelsLabelName)
Settings.Labels.Add(LabelsKeeper.NoParsedUser)
Dim rUsers$() = UserBanned(PendingUsers.Select(Function(u) u.ID).ToArray)
If rUsers.ListExists Then PendingUsers.RemoveAll(Function(u) rUsers.Contains(u))
If PendingUsers.Count > 0 Then
Dim c As New ListAddParams(LAP.NotContainsOnly)
Dim cn$
Dim tmpUser As IUserData
With PendingUsers.Select(Function(u) New UserInfo(u, HOST))
For i = 0 To .Count - 1
If Not Settings.UsersList.Contains(.ElementAt(i)) Then
f = PendingUsers(i).File
cn = If(PendingUsers(i).Channel?.Name, String.Empty)
Settings.UpdateUsersList(.ElementAt(i))
tmpUser = HOST.GetInstance(Plugin.ISiteSettings.Download.Main, .ElementAt(i), False)
With DirectCast(tmpUser, UserData)
.Temporary = Settings.ChannelsDefaultTemporary
.CreatedByChannel = True
.ReadyForDownload = Settings.ChannelsDefaultReadyForDownload
.ParseUserMediaOnly = umo
End With
Settings.Users.Add(tmpUser)
With Settings.Users.Last
.Labels.Add(CannelsLabelName)
.UpdateUserInformation()
If Settings.FromChannelCopyImageToUser And Not f.IsEmptyString And Not .File.IsEmptyString Then _
CopyFile(ListAddValue(Nothing, New ChannelsCollection.ChannelImage(cn, f)).ListAddList(Settings.Channels.GetUserFiles(.Name), c), .File)
End With
Added += 1
Else
Skipped += 1
End If
Next
End With
End If
PendingUsers.Clear()
BTT_ADD_USERS.Text = "Add"
MsgBoxE($"Added users: {Added.ToString(CProvider)}{vbCr}Skipped users: {Skipped.ToString(CProvider)}{vbCr}Total: {PendingUsers.Count.ToString(CProvider)}")
RaiseEvent OnUsersAdded(StartIndex)
Settings.Channels.UpdateUsersStats()
Else
MsgBoxE("No user has been selected to add to the collection")
End If
End Sub
Private Sub CopyFile(ByVal Source As IEnumerable(Of ChannelsCollection.ChannelImage), ByVal Destination As SFile)
Try
If Source.ListExists And Not Destination.IsEmptyString Then
Destination = Destination.CutPath.PathWithSeparator & "ChannelImage\"
Dim f As SFile
Dim i% = 0
If Destination.Exists(SFO.Path) Then
For Each ff As ChannelsCollection.ChannelImage In Source
f = Destination
f.Extension = ff.File.Extension
f.Name = $"{IIf(i = 0, "!", String.Empty)}{ff.Channel}_{ff.File.Name}"
If ff.File.Exists Then IO.File.Copy(ff.File, f)
i += 1
Next
End If
End If
Catch ex As Exception
End Try
End Sub
#End Region
#Region "List images"
Friend Function GetImageSize() As Size
Const mhw% = 256
Dim s As Size = LIST_POSTS.Size
@@ -313,7 +398,12 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End With
Return s
End Function
#Region "Toolbar controls"
Private Sub ImagesCountChanged(ByVal Sender As Object, ByVal _Name As String, ByVal _Value As Object)
AppendPendingUsers()
MyRange.Limit = ImagesInRow * ImagesRows
MyRange.GoTo(0)
End Sub
#End Region
#Region "Downloader"
Private TokenSource As CancellationTokenSource
Private Token As CancellationToken
@@ -357,7 +447,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Settings.Channels.SetLimit(Me)
Await Task.Run(Sub() Settings.Channels.DownloadData(Token, CH_HIDE_EXISTS_USERS.Checked, CProgress))
Settings.Channels.UpdateUsersStats()
RaiseEvent OnDownloadDone("All channels downloaded")
RaiseEvent OnDownloadDone(SettingsCLS.NotificationObjects.Channels, "All channels downloaded")
Token.ThrowIfCancellationRequested()
c = GetCurrentChannel()
Else
@@ -367,7 +457,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
c.SetLimit(Me)
Await Task.Run(Sub() c.DownloadData(Token, CH_HIDE_EXISTS_USERS.Checked, CProgress))
c.UpdateUsersStats()
RaiseEvent OnDownloadDone($"Channel [{c.Name}] downloaded")
RaiseEvent OnDownloadDone(SettingsCLS.NotificationObjects.Channels, $"Channel [{c.Name}] downloaded")
Token.ThrowIfCancellationRequested()
End If
End If
@@ -424,82 +514,6 @@ Friend Class ChannelViewForm : Implements IChannelLimits
If Not TokenSource Is Nothing Then TokenSource.Cancel() : BTT_STOP.Enabled = False
End Sub
#End Region
Private Sub BTT_ADD_USERS_Click(sender As Object, e As EventArgs) Handles BTT_ADD_USERS.Click
AppendPendingUsers()
Dim i%
If LIST_POSTS.CheckedItems.Count > 0 Then
For i = 0 To LIST_POSTS.Items.Count - 1
If LIST_POSTS.Items(i).Checked Then LIST_POSTS.Items(i).Checked = False
Next
End If
If PendingUsers.Count > 0 Then
Dim Added% = 0, Skipped% = 0
Dim StartIndex% = Settings.Users.Count
Dim f As SFile
Dim umo As Boolean = HOST.GetUserMediaOnly
Settings.Labels.Add(CannelsLabelName)
Settings.Labels.Add(LabelsKeeper.NoParsedUser)
Dim rUsers$() = UserBanned(PendingUsers.Select(Function(u) u.ID).ToArray)
If rUsers.ListExists Then PendingUsers.RemoveAll(Function(u) rUsers.Contains(u))
If PendingUsers.Count > 0 Then
Dim c As New ListAddParams(LAP.NotContainsOnly)
Dim cn$
Dim tmpUser As IUserData
With PendingUsers.Select(Function(u) New UserInfo(u, HOST))
For i = 0 To .Count - 1
If Not Settings.UsersList.Contains(.ElementAt(i)) Then
f = PendingUsers(i).File
cn = If(PendingUsers(i).Channel?.Name, String.Empty)
Settings.UpdateUsersList(.ElementAt(i))
tmpUser = HOST.GetInstance(Plugin.ISiteSettings.Download.Main, .ElementAt(i), False)
With DirectCast(tmpUser, UserData)
.Temporary = Settings.ChannelsDefaultTemporary
.CreatedByChannel = True
.ReadyForDownload = Settings.ChannelsDefaultReadyForDownload
.ParseUserMediaOnly = umo
End With
Settings.Users.Add(tmpUser)
With Settings.Users.Last
.Labels.Add(CannelsLabelName)
.UpdateUserInformation()
If Settings.FromChannelCopyImageToUser And Not f.IsEmptyString And Not .File.IsEmptyString Then _
CopyFile(ListAddValue(Nothing, New ChannelsCollection.ChannelImage(cn, f)).ListAddList(Settings.Channels.GetUserFiles(.Name), c), .File)
End With
Added += 1
Else
Skipped += 1
End If
Next
End With
End If
PendingUsers.Clear()
BTT_ADD_USERS.Text = "Add"
MsgBoxE($"Added users: {Added.ToString(CProvider)}{vbCr}Skipped users: {Skipped.ToString(CProvider)}{vbCr}Total: {PendingUsers.Count.ToString(CProvider)}")
RaiseEvent OnUsersAdded(StartIndex)
Settings.Channels.UpdateUsersStats()
Else
MsgBoxE("No one users selected for add to collection")
End If
End Sub
Private Sub CopyFile(ByVal Source As IEnumerable(Of ChannelsCollection.ChannelImage), ByVal Destination As SFile)
Try
If Source.ListExists And Not Destination.IsEmptyString Then
Destination = Destination.CutPath.PathWithSeparator & "ChannelImage\"
Dim f As SFile
Dim i% = 0
If Destination.Exists(SFO.Path) Then
For Each ff As ChannelsCollection.ChannelImage In Source
f = Destination
f.Extension = ff.File.Extension
f.Name = $"{IIf(i = 0, "!", String.Empty)}{ff.Channel}_{ff.File.Name}"
If ff.File.Exists Then IO.File.Copy(ff.File, f)
i += 1
Next
End If
End If
Catch ex As Exception
End Try
End Sub
#Region "Limits changer"
Private Sub OPT_LIMITS_DEFAULT_CheckedChanged(sender As Object, e As EventArgs) Handles OPT_LIMITS_DEFAULT.CheckedChanged
If OPT_LIMITS_DEFAULT.Checked Then
@@ -624,19 +638,20 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End If
End Sub
Private Sub AddNewChannel()
Dim c$ = InputBoxE("Enter Reddit channel:", "New channel")
Const MsgTitle$ = "Add channel"
Dim c$ = InputBoxE("Enter Reddit channel ID:", "New channel")
If Not c.IsEmptyString Then
Dim cc As New Channel With {.Name = c, .ID = c}
If Settings.Channels.Count = 0 OrElse Not Settings.Channels.Contains(cc) Then
Settings.Channels.Add(cc)
Settings.Channels.Last.Save()
RefillChannels()
MsgBoxE($"Channel [{c}] added")
MsgBoxE({$"Channel [{c}] added", MsgTitle})
Else
MsgBoxE($"Channel [{c}] already exists")
MsgBoxE({$"Channel [{c}] already exists", MsgTitle})
End If
Else
MsgBoxE("You doesn't enter channel name. Operation canceled.", MsgBoxStyle.Exclamation)
MsgBoxE({"You didn't enter a channel name. Operation canceled.", MsgTitle}, MsgBoxStyle.Exclamation)
End If
End Sub
Private Sub ChangeComboIndex(ByVal Appender As Integer)
@@ -651,7 +666,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
Else
If i < 0 Then i = 0
i += Appender
If i >= 0 And i <= CMB_CHANNELS.Count - 1 And Not CMB_CHANNELS.SelectedIndex = i Then CMB_CHANNELS.SelectedIndex = i
If i.ValueBetween(0, CMB_CHANNELS.Count - 1) And Not CMB_CHANNELS.SelectedIndex = i Then CMB_CHANNELS.SelectedIndex = i
End If
i = CMB_CHANNELS.SelectedIndex
Dim c% = CMB_CHANNELS.Count - 1
@@ -665,6 +680,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End Try
End Sub
#End Region
#Region "Toolbar controls"
Private Sub CH_HIDE_EXISTS_USERS_CheckedChanged(sender As Object, e As EventArgs) Handles CH_HIDE_EXISTS_USERS.CheckedChanged
If Not MyDefs.Initializing Then
Settings.ChannelsHideExistsUser.Value = CH_HIDE_EXISTS_USERS.Checked
@@ -726,9 +742,9 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End If
End With
If uRemoved Then
MsgBoxE($"User [{u}] was successfully removed")
MsgBoxE($"User [{u}] has been successfully removed")
Else
MsgBoxE($"User [{u}] was not added to selected users")
MsgBoxE($"User [{u}] is not added to the selected users")
End If
BTT_ADD_USERS.Text = $"Add ({PendingUsers.Count.ToString(CProvider)})"
Else
@@ -770,6 +786,7 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End Try
End Sub
#End Region
#Region "Additional functions: OpenPostPicture, GetPostBySelected"
Private Sub OpenPostPicture()
Dim f As SFile = GetPostBySelected().CachedFile
If f.Exists Then f.Open() Else MsgBoxE($"Picture file [{f}] not found", MsgBoxStyle.Critical)
@@ -790,15 +807,13 @@ Friend Class ChannelViewForm : Implements IChannelLimits
End Try
Return p
End Function
#End Region
#Region "List handlers"
Private Sub LIST_POSTS_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles LIST_POSTS.MouseDoubleClick
OpenPostPicture()
End Sub
#End Region
#Region "MyRange"
Private Sub ImagesCountChanged(ByVal Sender As Object, ByVal _Name As String, ByVal _Value As Object)
AppendPendingUsers()
MyRange.Limit = ImagesInRow * ImagesRows
MyRange.GoTo(0)
End Sub
Private Sub MyRange_IndexChanged(ByVal Sender As Object, ByVal e As EventArgs) Handles MyRange.IndexChanged
Try
If MyDefs.Initializing Then Exit Sub

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,7 +6,6 @@
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Friend Class ChannelsStatsForm : Inherits System.Windows.Forms.Form
<System.Diagnostics.DebuggerNonUserCode()>
@@ -42,7 +41,7 @@ Partial Friend Class ChannelsStatsForm : Inherits System.Windows.Forms.Form
'CONTAINER_MAIN.ContentPanel
'
CONTAINER_MAIN.ContentPanel.Controls.Add(Me.CMB_CHANNELS)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(384, 261)
CONTAINER_MAIN.ContentPanel.Size = New System.Drawing.Size(384, 236)
CONTAINER_MAIN.Dock = System.Windows.Forms.DockStyle.Fill
CONTAINER_MAIN.LeftToolStripPanelVisible = False
CONTAINER_MAIN.Location = New System.Drawing.Point(0, 0)
@@ -82,7 +81,7 @@ Partial Friend Class ChannelsStatsForm : Inherits System.Windows.Forms.Form
Me.CMB_CHANNELS.ListMultiSelect = True
Me.CMB_CHANNELS.Location = New System.Drawing.Point(0, 0)
Me.CMB_CHANNELS.Name = "CMB_CHANNELS"
Me.CMB_CHANNELS.Size = New System.Drawing.Size(386, 262)
Me.CMB_CHANNELS.Size = New System.Drawing.Size(386, 237)
Me.CMB_CHANNELS.TabIndex = 0
'
'ChannelsStatsForm
@@ -91,7 +90,7 @@ Partial Friend Class ChannelsStatsForm : Inherits System.Windows.Forms.Form
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(384, 261)
Me.Controls.Add(CONTAINER_MAIN)
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.Icon = Global.SCrawler.My.Resources.SiteResources.RedditIcon_128
Me.KeyPreview = True
Me.MinimizeBox = False
Me.MinimumSize = New System.Drawing.Size(400, 300)

File diff suppressed because it is too large Load Diff

View File

@@ -1,4 +1,4 @@
' Copyright (C) 2022 Andy
' Copyright (C) 2023 Andy https://github.com/AAndyProgram
' This program is free software: you can redistribute it and/or modify
' 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,25 +32,26 @@ Friend Class ChannelsStatsForm
End If
End Sub
Private Sub MyDefs_ButtonDeleteClickOC(ByVal Sender As Object, ByVal e As KeyHandleEventArgs) Handles MyDefs.ButtonDeleteClickOC
Const MsgTitle$ = "Deleting channels"
Try
Dim c As List(Of String) = CMB_CHANNELS.Items.CheckedItems.Select(Function(cc) CStr(cc.Value(1))).ListIfNothing
If c.ListExists Then
If MsgBoxE({$"The following channels will be deleted:{vbCr}{c.ListToString(vbCr)}", "Deleting channels"}, vbExclamation,,, {"Confirm", "Cancel"}) = 0 Then
If MsgBoxE({$"The following channels will be deleted:{vbCr}{c.ListToString(vbCr)}", MsgTitle}, vbExclamation,,, {"Confirm", "Cancel"}) = 0 Then
For Each CID$ In c : Settings.Channels.Remove(Settings.Channels.Find(CID)) : Next
MyMainLOG = $"Deleted channels:{vbNewLine}{c.ListToString(vbNewLine)}"
MsgBoxE("Channels deleted")
MsgBoxE({"Channels deleted", MsgTitle})
DeletedChannels += c.Count
c.Clear()
MyDefs.ChangesDetected = False
RefillList()
Else
MsgBoxE("Operation canceled")
MsgBoxE({"Operation canceled", MsgTitle})
End If
Else
MsgBoxE("No one channel checked", vbExclamation)
MsgBoxE({"No channels marked for deletion", MsgTitle}, vbExclamation)
End If
Catch ex As Exception
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, "Deleting channels")
ErrorsDescriber.Execute(EDP.LogMessageValue, ex, MsgTitle)
End Try
End Sub
Private Sub CMB_CHANNELS_ActionOnChangeDetected(ByVal c As Boolean) Handles CMB_CHANNELS.ActionOnChangeDetected

View File

Before

Width:  |  Height:  |  Size: 29 KiB

After

Width:  |  Height:  |  Size: 29 KiB

View File

Before

Width:  |  Height:  |  Size: 2.8 KiB

After

Width:  |  Height:  |  Size: 2.8 KiB

View File

Before

Width:  |  Height:  |  Size: 4.2 KiB

After

Width:  |  Height:  |  Size: 4.2 KiB

View File

Before

Width:  |  Height:  |  Size: 9.4 KiB

After

Width:  |  Height:  |  Size: 9.4 KiB

View File

Before

Width:  |  Height:  |  Size: 147 KiB

After

Width:  |  Height:  |  Size: 147 KiB

View File

Before

Width:  |  Height:  |  Size: 4.2 KiB

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 21 KiB

View File

Before

Width:  |  Height:  |  Size: 4.2 KiB

After

Width:  |  Height:  |  Size: 4.2 KiB

View File

Before

Width:  |  Height:  |  Size: 66 KiB

After

Width:  |  Height:  |  Size: 66 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

View File

Before

Width:  |  Height:  |  Size: 481 B

After

Width:  |  Height:  |  Size: 481 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 17 KiB

View File

Before

Width:  |  Height:  |  Size: 25 KiB

After

Width:  |  Height:  |  Size: 25 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 157 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 384 B

View File

Before

Width:  |  Height:  |  Size: 1.5 KiB

After

Width:  |  Height:  |  Size: 1.5 KiB

View File

Before

Width:  |  Height:  |  Size: 3.7 KiB

After

Width:  |  Height:  |  Size: 3.7 KiB

View File

Before

Width:  |  Height:  |  Size: 929 B

After

Width:  |  Height:  |  Size: 929 B

Binary file not shown.

After

Width:  |  Height:  |  Size: 179 B

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